## Roulette

``` #: 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, but I haven't looked yet into Rotate text on a canvas. Otherwise, it would look somewhat like the Alphabet Wheel...

Category Toys