HJG This variation of Lotto by RS writes a log of each drawing to the console, compares the drawing to the tip, and counts the matching numbers.
Todo:
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
RS: For the question of how to identify the number under the cursor: canvas items receive unique integer identifiers, starting from 1. So if the 49 numbers are the first items created, their identifiers are the same as their numeric values, and the number under the cursor can be retrieved by
$w find withtag current
(as the current tag goes temporarily to the item under the cursor). A more robust way, not depending on canvas object creation order, might be
$w itemcget current -text
which of course returns the displayed string of a text item (and throws an error on others).