package require Tk
proc main {} {
global xm ym spinning
set xm 118 ; set ym 135
set spinning 0
pack [canvas .c]
# .c create text 120 10 -text "Hit any key to spin, and assign task"
.c create text 90 10 -text "Hit any key to spin, and assign task"
button .c.s -text "Spin" -command {spin .c spin}
button .c.x -text X -command exit
.c create window 220 10 -window .c.x
.c create window 86 10 -window .c.s
spinarrow .c $xm $ym -tag spin -fill red
bind . <Key> {spin .c spin}
cdial .c $xm $ym 85 {A B C D E F G H
I J K L M N O P R S T U V W Y Z}
.c create text 120 255 -tag task -font {Tahoma 12 bold}
}
set tasks {
animal plant city river country profession {girl's name} {boy's name}
mountain food {famous person}
}# Draw and place the spinning arrow proc spinarrow {w x y args} {
set id [eval $w create poly {\
30 0 0 50 20 45 20 135 0 155\
0 200 30 170 60 200 60 155\
40 135 40 45 60 50} $args]
$w move $id [expr $x-30] [expr $y-100]
$w scale $id $x $y .8 .8
}
proc spin {w tag {angle ""}} {
global xm ym spinning
if {$angle==""} {
if $spinning return
incr spinning
set angle [expr rand()*0.4+.4]
$w itemconfig task -text [? $::tasks]?
}
rotate $w $tag $angle $xm $ym
set angle [expr {$angle*.99-0.01}]
if {$angle>0} {
after 40 spin $w $tag $angle
} else {set spinning 0}
}
proc rotate {w tag angle xm ym} {
set coords {}
foreach {x y} [$w coords $tag] {
set r [expr {hypot($x-$xm,$y-$ym)}]
set a [expr {atan2($y-$ym,$x-$xm)+$angle}]
lappend coords \
[expr {$xm+cos($a)*$r}] \
[expr {$ym+sin($a)*$r}]
}
$w coords $tag $coords
#-- fix drifting during rotation
foreach {x0 y0 x1 y1} [$w bbox $tag] break
set dx [expr {$xm-($x0+$x1)/2.}]
set dy [expr {$ym-($y0+$y1)/2.}]
$w move $tag $dx $dy
}# Draw a circular "dial" proc cdial {w x y r data} {
set da [expr {2*acos(-1)/[llength $data]}]
set th 0.0
set th2 [expr {$da/2.}]
set r2 [expr {$r+20}]
set r3 [expr {($r+$r2)/2.}]
set outside {}
foreach el $data {
set x1 [expr {$x+cos($th)*$r}]
set y1 [expr {$y+sin($th)*$r}]
set x2 [expr {$x+cos($th)*$r2}]
set y2 [expr {$y+sin($th)*$r2}]
$w create line $x1 $y1 $x2 $y2
lappend outside $x2 $y2
set x3 [expr {$x+cos($th2)*$r3}]
set y3 [expr {$y+sin($th2)*$r3}]
$w create text $x3 $y3 -text $el
set th [expr {$th + $da}]
set th2 [expr {$th2 + $da}]
}
eval lappend outside [lrange $outside 0 1]
$w create line $outside -smooth 1
}# Select random element from a list proc ? L {
lindex $L [expr {int(rand()*[llength $L])}]
}#----------------- Let's go!main wm geometry . 240x268+0+0 ;# iPaq
Category Games | Arts and crafts of Tcl-Tk programming