Updated 2016-04-25 20:53:20 by gold

Summary edit

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.

Code edit


 ##-##########################################################################
 # Lotto2.tcl - 2005-06-06 / 2005-06-17
 #
 # Todo:
 # * use a text-widget or listview for the log
 # * Statistics (frequency of drawn numbers, winnings...)

  proc main {} {
     set dx 15
     set dy 15
     pack [canvas .c -width [expr {$dx*8}] -height [expr {$dy*8}] -bg gray77]
     set x $dx; set y $dy
     foreach i [iota1 49] {
         if [lsearch $::MyTip $i]>=0 {
         .c create text $x $y -text $i -fill white
         } else {
         .c create text $x $y -text $i -fill black
         }
         if {$i%7} {
             incr x $dx
         } else {set x $dx; incr y $dy}
     }
     button .b1 -text "Clear"      -padx 2            -command {clearAllTips .c}
     button .b2 -text "Draw"       -padx 2 -bg green2 -command {draw .c} 
     button .b3 -text "Log"        -padx 2            -command {LogToggle}
     pack   .b1 .b2 .b3 -side left -fill x -expand 1 
     bind .c  <1> {click .c}
    #bind .c  <d> {click .c}
  }
 #############################################################################
  proc LogToggle {} {
    if { $::Cons == 1} {
      set ::Cons 0; console hide
    } else {
      set ::Cons 1; console show
    }
    focus -force .
  }
 #############################################################################
  proc click w {
    set t [$w itemcget current -tag ]  ;# circles: "marked" / numbers: "current"
    if {$t ne "current"} {return}      ;# ignore click on circle
    set i [$w itemcget current -text]
    if {$i ne ""} {
      set p [lsearch $::MyTip $i]
      if $p>=0 {
        clearTip $w $i
      } else {
        newTip $i
        $w itemconfigure current -fill white
      }
      puts "MyTip: $::MyTip"
    }
  }
 #############################################################################
  proc newTip tip { 
    set p [lsearch $::MyTip 99]
    if $p>=0 {
      lset    ::MyTip $p $tip
    } else {
      lappend ::MyTip $tip
    }
  }
 #############################################################################
  proc clearTip {w tip} { 
    set p [lsearch $::MyTip $tip]
    $w itemconfigure $tip -fill black
   #lset ::MyTip $p 99
    set  ::MyTip [lreplace $::MyTip $p $p]
  }
  proc clearAllTips w { 
    foreach i $::MyTip { clearTip $w $i }
  }
 #############################################################################
  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 $n] red
         update idletasks
         after  50
     }
     set lucky [lsort -integer $lucky]

     set n [ldraw numbers]
     lappend lucky $n
     circle $w [$w bbox $n] yellow
     $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; puts "MyTip: $::MyTip" }
  }
 #############################################################################
  proc circle {w coords color} {
     $w create oval $coords -fill {} -outline $color -width 2 -tag marked
  }

 #--- Generally useful functions: ---###--- see http://wiki.tcl.tk/941 ---#

  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  
  set     Cons 1; catch {console show}
  puts "Lotto"
  puts "MyTip: $MyTip"

  main

Comments edit

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).

HJG Ok, that helps me another step forward. But now I have trouble checking the existance of a variable (proc click), e.g. when the click does not hit one of the text-widgets. -RS: i exists, because you just assigned it a value.. check for {$i ne ""} :)

HJG Finally working as expected... - but the list-handling is somewhat cumbersome. As there is no "ldel"-command, what is the best way to remove an element from a list, other than copying to a new list ?

MG You just lreplace it with nothing. For example:
 % set list [list a b c d e]
 a b c d e
 % set list [lreplace $list 2 2] ;# lreplace $list $first $last ?$with?
 a b d e

HJG I found a small bug: after a draw, when you click and hit the circle instead of the number, an error-message appears: unknown option "-text" while executing "$w itemcget current -text" . How can I identify the number where this circle belongs to?

MG You could just catch it, and do nothing when someone clicks on a circle - that would be easiest. The other options that spring to mind, to actually do what you asked, though, are:

  • Add a tag to the circle, using a pattern like 'circX' where X is the number it's over. Then you can use a regexp, or something like that, to extra the number it's for from $canvas gettags current.
  • Use eval $canvas find overlapping [$canvas bbox current] (or, if you're on 8.5, $canvas find overlapping {expand}[$canvas bbox current]) to find all the items which overlap the circle being clicked. This will, hopefully, be two items - the circle itself, and the text under it. Remove the circle itself (which has the id returned by $canvas find withtag current), and you have the number of the text.

There may be other ways, or easier ways, but those spring to mind for me.

HJG Thanks! Ignoring works, and seem appropriate, because the circle is hit only rarely.

links have expired