## Version 3 of Playing with matches

Updated 2005-05-07 22:49:23 by suchenwi

if 0 {Richard Suchenwirth 2005-05-07 - Matches (small wooden sticks to light fire) are popular for playing games, too (Martin Gardner devotes chapter 2 in Mathematical Circus to them, for example). Here's matches emulated in Tcl:

At top left you have a matchbox. Left-click on a match to get a duplicate ("clone") which you can drag on the playing field. Right-click on a match to rotate it by 30 degrees. The screenshot shows one of Gardner's simpler challenges (red: move one match to make the equation correct) and the solution (blue). }

``` proc main {} {
pack [canvas .c -background darkgreen] -fill both -expand 1
.c create rect 5 5 45 65 -fill white ;# matchbox
set red [match .c 15 10 55 red]
.c bind \$red <1> {clone .c red %x %y}
set blue [match .c 30 10 55 blue]
.c bind \$blue <1> {clone .c blue %x %y}
.c bind mv <1> {select .c %x %y}
.c bind mv <B1-Motion> {move .c %x %y}
.c bind mv <3> {rotate .c}
}```

#-- Draw a match, return the common ID of its items

``` proc match {w x0 y0 y1 color} {
set id [\$w create poly \
[+ \$x0 1] [+ \$y0 1] [+ \$x0 5] [+ \$y0 1] \
[+ \$x0 5] \$y1 [+ \$x0 1] \$y1 -fill bisque -outline black]
set head [\$w create oval \$x0 \$y0 [+ \$x0 6] [+ \$y0 6] \
-fill \$color]
\$w itemconfig \$id   -tag m\$id
return m\$id
}```

#-- make a duplicate of the current match

``` proc clone {w color x y} {
foreach {x0 y0 x1 y1} [\$w bbox current] break
set id [match \$w \$x0 \$y0  \$y1 \$color]
\$w itemconfig \$id -tags [list mv mv\$id]
}```

#-- Store the current position in two global variables

` proc select {w x y} {set ::X \$x; set ::Y \$y}`

#-- Move the current items set

``` proc move {w x y} {
set id [\$w find withtag current]
set tag [lindex [\$w gettags \$id] 1]
\$w move \$tag [- \$x \$::X] [- \$y \$::Y]
set ::X \$x; set ::Y \$y
}```

#-- rotate the current item set by 30 degrees, clockwise

``` proc rotate w {
set id [\$w find withtag current]
set tag [lindex [\$w gettags \$id] 1]
foreach {x0 y0 x1 y1} [\$w bbox \$tag] break
set xm [expr {(\$x0+\$x1)/2.}]
set ym [expr {(\$y0+\$y1)/2.}]
foreach item [\$w find withtag \$tag] {
set coords {}
foreach {x y} [\$w coords \$item] {
set r [expr {hypot(\$x-\$xm,\$y-\$ym)}]
set a [expr {atan2(\$y-\$ym,\$x-\$xm) + acos(-1)/6.}]
lappend coords [expr {\$xm+\$r*cos(\$a)}] \
[expr {\$ym+\$r*sin(\$a)}]
}
\$w coords \$item \$coords
}
}```

#-- prefix expr operators make the code shorter...

` foreach op {+ -} {proc \$op {a b} "expr {\\$a \$op \\$b}"}`

#-- Let's go!

` main`

if 0 {