#: 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.