----
 #: Roulette.tcl - HaJo Gurt - 2005-07-07
 #: French roulette table (only 1 zero)

 #########1#########2#########3#########4#########5#########6#########7#####

  package require Tk

  proc int x {expr int($x)}

  proc Carree {w  x y  w1 h1  txt c} {
  #: Draw large symbols for red and black
    set xr [expr {$w1*0.20}]
    set yr [expr {$h1*0.25}]
    $w create poly [expr {$x-$xr}] $y \
                   $x              [expr {$y+$yr}] \
                   [expr {$x+$xr}] $y              \
                   $x              [expr {$y-$yr}] \
                   -tag $txt  -fill $c
  }

  proc Color {nr} {
  #: Colors of the roulette-numbers
    set c [lindex {G  R - R   - R -   R - R   - - R \
                      - R -   R - R   R - R   - R - \
                      R - R   - - R   - R -   R - R } $nr]
    if {$c=="R"} { return red   }
    if {$c=="-"} { return black }
    if {$c=="G"} { return green } else { return white }
  }

  proc Field {x1 y1  w1 h1  txt} {
  #: Draw one field of the table
    .c create rect $x1 $y1  [expr {$x1 + $w1}] [expr {$y1 + $h1}] -fill SpringGreen4

    set x  [expr {$x1 + $w1*.5}] 
    set y  [expr {$y1 + $h1*.5}]

    switch -regexp -- $txt {
    "Rouge"   { Carree .c  $x $y  $w1 $h1  $txt red   }
    "Noir"    { Carree .c  $x $y  $w1 $h1  $txt black }
    "C"       { .c create text $x $y  -text "  "  -tag $txt  -fill white }
    "[aPMD-]" { .c create text $x $y  -text $txt  -tag $txt  -fill white }
    default   { .c create text $x $y  -text $txt  -tag $txt  -fill [Color $txt] }
    }
  }

 #########1#########2#########3#########4#########5#########6#########7#####

 # Height, Width:  22..50 : 9*40=360 14*40=560
  set W1  30
  set H1  30

  set x0  [expr {$W1 *  3 }]
  set y0  0
  set WW  [expr {$W1 *  9 }]
  set HH  [expr {$H1 * 14 }]

  set xx  [expr {$W1* 9+10}]
  set yy  [expr {$H1*14+10}]
  grid [canvas .c -width $xx -height $yy]
  .c config -scrollregion [list -5 -5 [expr {$xx-5}] [expr {$yy-5}]]

  set  x $x0
  set  y $y0
  set  i 0
  Field $x0 $y [expr {$W1*3}] $H1 0

  incr y $H1
  Field 0              [expr {$H1*1}] $x0            [expr {$H1*4}] "Passe"
  Field [expr {$W1*6}] [expr {$H1*1}] [expr {$W1*3}] [expr {$H1*4}] "Manque"

  Field 0              [expr {$H1*5}] $x0            [expr {$H1*4}] "Pair"
  Field [expr {$W1*6}] [expr {$H1*5}] [expr {$W1*3}] [expr {$H1*4}] "Impair"

  Field 0              [expr {$H1*9}] $x0            [expr {$H1*4}] "Noir"
  Field [expr {$W1*6}] [expr {$H1*9}] [expr {$W1*3}] [expr {$H1*4}] "Rouge"

  # Numbers:
  for { set i 1 } { $i <= 36 } { incr i } {
    Field $x $y $W1 $H1 $i
    if {$i%3 == 0} {
      incr y $H1 
      set  x $x0
    } else {
      incr x $W1
    }
  }

  # Columns:
  set  x $x0
  for { set i 1 } { $i <= 3 } { incr i } {
    Field $x $y $W1 $H1 " Column$i"  ;# Field remains empty 
    incr x $W1
  }

  # Dozens:  (Premier/Medium/Dernier)
  set xR $x
  set xL [expr {$x0 - $W1 }]
  for { set i 1 } { $i <= 3 } { incr i } {
    Field $xL $y $W1 $H1 [lindex [list _ 12D 12M 12P] $i]
    Field $xR $y $W1 $H1 [lindex [list _ 12D 12M 12P] $i]
    incr xL -$W1
    incr xR  $W1
  }

 #########1#########2#########3#########4#########5#########6#########7#####

  bind .c <Motion> {
    set tags [.c itemcget current -tag]
    set p    [string first "current" $tags]
    set tags [string replace $tags $p end]
    wm title . "[int [%W canvasx %x]],[int [%W canvasy %y]] : $tags"
  }
----
[HJG] A simple french roulette table, but no gameplay yet.

To also show the wheel correctly, it would be nessessary to rotate text an arbitary angle.
Otherwise, it would look somewhat like the [Alphabet Wheel].

----
[Category Toys]