https://web.archive.org/web/20060615192956/http://anny.kinjo-u.ac.jp:80/~houser/pie/Welcome.html

 package require Tk
 proc piemenu {W args} {
         # draws a pie menu on canvas W
         # array angles contains pairs of
         #        nrbuttons {{button center angle} {button angle extent}}
         # button 0 is always the central one 
 
         array set angles {
                 1 {} 
                 2 {0 359.999} 
                 3 {180 180 0 180} 
                 4 {90 120 210 120 330 120} 
                 5 {90 90 180 90 0 90 270 90} 
                 6 {90 60 150 60 30 60 225 90 -45 90}
                 7 {90 60 150 60 30 60 270 60 -150 60 -30 60}
         }
         array set opt {
                 -r 100 
                 -nrbuttons 2 
                 -width 4 
                 -fill #eeeeee
                 -outline #888888 
                 -activefill #f0ffff
                 -activeoutline #80ffff
                 -selectfill #ffcfcf 
                 -selectoutline #ff8080 
                 -textfill #444444
                 -font {Helvetica -12 bold}
                 -command {}
         } 
 
         array set opt $args
 
         for {set i 0} {$i <= $opt(-nrbuttons)} {incr i} {
                 foreach item {-fill -outline -activefill -activeoutline -selectfill -selectoutline -textfill -font -command} {
                         if {![info exists opt($item$i)]} {
                                 set opt($item$i) $opt($item) 
                         }
                 }
         } 
 
         # set default center in case the user doesn't
         if {![info exists opt(-x)]} {
                 set opt(-x) [expr {$opt(-r) + $opt(-width) / 2.0}]
         }
         if {![info exists opt(-y)]} {
                 set opt(-y) [expr {$opt(-r) + $opt(-width) / 2.0}]
         }
         # ratio of center button to overall pie
         set r 0.45
         # upper left corner
         set x0 [expr {$opt(-x) - $opt(-r)}]
         set y0 [expr {$opt(-y) - $opt(-r)}]
         set cnt 1
         foreach {angle extent} $angles($opt(-nrbuttons)) {  
 
                 set start [expr {$angle - $extent / 2.0}]
                 set item [ \
                   $W create arc $x0 $y0 \
                         [expr {$x0 + 2 * $opt(-r)}] \
                         [expr {$y0 + 2 * $opt(-r)}] \
                         -tags [list __pm$cnt __pm ] \
                         -extent $extent \
                         -start $start \
                         -width $opt(-width) \
                         -fill $opt(-fill$cnt) \
                         -outline $opt(-outline$cnt) \
                 ]
                 $W create text \
                         [expr {$opt(-x) + (1 - 0.66 * $r) * $opt(-r) * cos(0.017453292519943294892 * $angle)}] \
                         [expr {$opt(-y) - (1 - 0.66 * $r) * $opt(-r) * sin(0.017453292519943294892 * $angle)}] \
                         -tags [list __pm$cnt __pm] \
                         -text [expr {[info exists opt(-text$cnt)] ? $opt(-text$cnt) : "__pm$cnt"}] \
                         -font $opt(-font$cnt) \
                         -fill $opt(-textfill$cnt)
 
                 $W bind __pm$cnt <Button-1> [list %W itemconfig $item -fill $opt(-selectfill$cnt)]
                 $W bind __pm$cnt <ButtonRelease-1> [list %W itemconfig $item -fill $opt(-fill$cnt)]
                 $W bind __pm$cnt <Button-1> "+$opt(-command$cnt)"
                 incr cnt
         }
         set x0 [expr {$opt(-x) - $r * $opt(-r)}]
         set y0 [expr {$opt(-y) - $r * $opt(-r)}]
        set item [ \
                 $W create oval $x0 $y0 [expr {$x0 + 2 * $r * $opt(-r)}] [expr {$y0 + 2 * $r * $opt(-r)}] \
                         -tags [list __pm0 __pm] \
                         -width $opt(-width) \
                         -fill $opt(-fill0) \
                         -outline $opt(-outline0) \
                 ]
         $W create text \
                 $opt(-x) \
                 $opt(-y) \
                 -tags [list __pm0 __pm] \
                 -text [expr {[info exists opt(-text0)] ? $opt(-text0) : "__pm0"}] \
                 -font $opt(-font0) \
                 -fill $opt(-textfill0)
 
                 $W bind __pm0 <Button-1> [list %W itemconfig $item -fill $opt(-selectfill0)]
                 $W bind __pm0 <ButtonRelease-1> [list %W itemconfig $item -fill $opt(-fill0)]
                 $W bind __pm0 <Button-1> "+$opt(-command0)"
 }
 #
 # test code
 #
 proc newPiemenu {W x y} {
         global cnt
         piemenu $W \
                 -x $x \
                 -y $y \
                 -nrbuttons [expr {$cnt % 7 + 1}] \
                 -r 75 \
                 -fill0 #ffffff \
                 -text0 Ok \
                 -command0 {bind .c <Button-1> {}; %W delete __pm; incr cnt} \
                 -text1 test \
                 -command1 {puts "Clicked 1"} \
                 -text2 toast \
                 -text3 taste \
                 -text4 toes \
                 -text5 tease \
                 -text6 tees \
                 -width 2
 }
 catch {destroy .c}
 pack [canvas .c -bg white -width 300 -height 300] -fill both -expand 1
 .c create text 10 10 -text "Click Button-3 for context menu" -anchor nw 

 bind .c <Button-3> { %W delete __pm; newPiemenu %W %x %y}
 set cnt 0