Version 2 of Domino
Updated 2004-11-14 18:17:22if 0 {Richard Suchenwirth 2004-11-14 - Domino is a popular game. In this weekend fun project, I wanted to have it in Tcl/Tk too.
The real multiplayer game can't be implemented, as there's no way for one player to see a piece, while another doesn't - but at least one can use this for mathematical games with dominoes, as described in Martin Gardner's "Mathematical Circus". Drag a piece with left mouse button down, rotate it (counterclockwise 90 degrees) with right-click. }
package require Tk
namespace eval domino {
variable bg black fg white size 30
#-- "Visual" definition of dot patterns - "sugared lists"
variable pattern
array set pattern {
0 {0 0 0
0
0 0 0}
1 {0 0 0
1
0 0 0}
2 {1 0 0
0
0 0 1}
3 {1 0 0
1
0 0 1}
4 {1 0 1
0
1 0 1}
5 {1 0 1
1
1 0 1}
6 {1 1 1
0
1 1 1}
}
variable points {1 1 1 2 1 3 2 2 3 1 3 2 3 3}
}if 0 {This "constructor" creates a domino piece on the canvas w, landscape oriented, with top left corner at x/y and the specified two point values (0..6). For allowing motion, all canvas items belonging to a piece with values p|q are tagged with
- mv (so motion bindings have a common target)
- d-$p$q for unique identification (assuming no duplicate pieces)
The bd-$p$q tags aren't used yet - in future one might use them for reverting a piece, i.e. raising or lowering the rectangle. }
proc domino::create {w x y val1 val2} {
variable bg; variable fg; variable size
set tags [list mv d-$val1$val2]
set x1 [expr {$x+$size-0.5}]
set y1 [expr {$y+$size}]
$w create rect $x $y [expr {$x+2*$size}] $y1 \
-fill $bg -tags [linsert $tags 0 bd-$val1$val2]
$w create line $x1 $y $x1 $y1 -fill $fg -tags $tags
dots $w $x $y $val1 $tags
dots $w [expr {$x+$size}] $y $val2 $tags
}if 0 {Dots are drawn for a given value as ovals:}
proc domino::dots {w x y val tags} {
variable fg; variable size; variable points; variable pattern
set d [expr {$size/4.}]
foreach bit $pattern($val) {y0 x0} $points {
if $bit {
$w create oval [expr {$x+($x0-0.5)*$d}] [expr {$y+($y0-0.5)*$d}] \
[expr {$x+($x0+0.5)*$d}] [expr {$y+($y0+0.5)*$d}] -fill $fg \
-tags $tags
}
}
}if 0 {Pieces are rotated around the center of their bounding box with the usual "convert to polar coordinates, adjust angle, convert back to Cartesian coordinates" algorithm. Due to rounding problems, sometimes the line in the middle of a piece comes slightly crooked:}
proc domino::rotate w {
foreach tag [$w gettags current] {
if [regexp ^(d-.+) $tag -> this] break
}
foreach {x0 y0 x1 y1} [$w bbox $this] break
set xm [expr {($x0+$x1)/2.}]
set ym [expr {($y0+$y1)/2.}]
set da [expr {acos(-1)/2.}]
foreach item [$w find withtag $this] {
set coords {}
foreach {x y} [$w coords $item] {
set r [expr {hypot($y-$ym, $x-$xm)}]
set a [expr {abs($x-$xm)<1e-17? 0:
atan2($y-$ym, $x-$xm)-$da}]
set x [expr {$xm+$r*cos($a)}]
set y [expr {$ym+$r*sin($a)}]
lappend coords $x $y
}
$w coords $item $coords
}
}if 0 {Clicking on a piece records the click position, and its "catch-all" tag, in global variables:}
proc mv'1 {w x y} {
set ::_x $x; set ::_y $y
foreach tag [$w gettags current] {
if [regexp ^(d-.+) $tag -> ::_tag] break
}
}if 0 {Moving the mouse with button 1 down moves the items with the "catch-all" tag with the mouse pointer:}
proc mv'motion {w x y} {
$w raise $::_tag
$w move $::_tag [expr {$x-$::_x}] [expr {$y-$::_y}]
set ::_x $x; set ::_y $y
}#-- The main routine makes a board and the classic 28 pieces:
pack [canvas .c -bg darkgreen -width 500 -height 350] -fill both -expand 1
for {set left 0} {$left<=6} {incr left} {
for {set right $left} {$right<=6} {incr right} {
domino::create .c [expr $left*65+10] [expr $right*35+100] $left $right
}
}
.c bind mv <1> {mv'1 %W %x %y}
.c bind mv <B1-Motion> {mv'motion %W %x %y}
.c bind mv <3> {domino::rotate %W}#-- Little development helpers (optional):
bind . <Escape> {exec wish $argv0 &; exit}
bind . <F1> {console show}if 0 { rdt Boy, RS does good work.