[HJG] This variation of [Lotto] by [RS] writes a log of each drawing to the console, compares the drawing to a tip, and counts the matching numbers. Todo: clicking on the numbers should set/reset the numbers in the tip. ---- proc main {} { set dx 15 set dy 15 # pack [canvas .c -width [expr {$dx*8}] -height [expr {$dy*9}]] pack [canvas .c -width [expr {$dx*8}] -height [expr {$dy*8}] -bg gray77] set x $dx; set y $dy foreach i [iota1 49] { # .c create text $x $y -text $i if [lsearch $::MyTip $i]>=0 { .c create text $x $y -text $i -fill white } else { .c create text $x $y -text $i -fill black } # puts "$i : $x $y" ;# debug if {$i%7} { incr x $dx } else {set x $dx; incr y $dy} } # bind .c <1> {draw .c} button .b -text "Draw" -command {draw .c} pack .b bind .c <1> {click .c} } proc click w { puts "Click: [winfo pointerx $w] [winfo pointery $w]" # ?? better way to identify the number unter the cursor ?? set dx 15 set dy 15 #set x [winfo pointerx .] #set y [winfo pointery .] set x [winfo pointerx $w] set y [winfo pointery $w] set c [expr {$x / $dx}] set r [expr {$y / $dy}] set n [expr {($r * 7 ) + $c}] #puts "Click: $x $y : $c $r ==> $n" } proc draw w { global DrawNr MyTip incr DrawNr $w delete marked set numbers [iota1 49] foreach i [iota1 6] { set n [ldraw numbers] lappend lucky $n #circle $w [$w bbox [ldraw numbers]] red circle $w [$w bbox $n] red update idletasks #after 500 after 50 } set lucky [lsort -integer $lucky] set n [ldraw numbers] lappend lucky $n circle $w [$w bbox $n] yellow #puts "$n: [$w bbox $n]" ;#debug $w lower marked puts -nonewline "[ format "%5d: " $DrawNr ]" for {set i 0} {$i<=6} {incr i} { puts -nonewline "[format [expr {$i==6 ? "- %2d" : "%2d "}] [lindex $lucky $i] ]" } #puts -nonewline " Matches: " set win 0 for {set i 0} {$i<=6} {incr i} { set z [lindex $lucky $i] if [lsearch $::MyTip $z]>=0 { # puts -nonewline "[format "%2d " $z]" incr win } } #puts " Win: $win ." puts " Win: [string repeat [string index "_...*!$$$" $win] $win]" if $win>3 { bell } } proc circle {w coords color} { $w create oval $coords -fill {} -outline $color -width 2 -tag marked } #------------------ Generally useful functions: proc iota1 n { set res {} for {set i 1} {$i<=$n} {incr i} {lappend res $i} set res } proc ldraw _list { upvar 1 $_list list set pos [expr {int(rand()*[llength $list])}] K [lindex $list $pos] [set list [lreplace $list $pos $pos]] } proc K {a b} {set a} #---------------------------------------------------- lappend MyTip 1 8 11 15 47 49 16 set DrawNr 0 catch {console show} puts "Lotto" puts "MyTip: $MyTip" main ---- [Category Toys]