Tangram

Richard Suchenwirth 2004-05-07 - Tangram is an old game, supposed to be from China, very simple yet fascinating. Following a colleague's challenge, here's a little Tcl implementation, with the following instructions:

• move a tan (a piece) with left mouse button down
• rotate a tan 45 degrees by right-clicking
• reset the original arrangement with middle click.

Enjoy!

See also Puzzle blocks

``` package require Tk
set tcl_precision 17

proc main argv {
canvas .c -width 200 -height 200 -scrollregion {-50 -50 50 50}
pack .c -fill both -expand yes;# by AvL
reset .c
bind .c <2> {reset .c}
}
proc reset w {
\$w delete all
tan \$w 0 0    0 100  50 50
tan \$w 0 100  50 50  100 100
tan \$w 0 0    25 25  75 25   50 0
tan \$w 50 0   100 0  100 50
tan \$w 25 25  75 25  50 50
tan \$w 50 50  75 25  100 50  75 75
tan \$w 75 75  100 50 100 100
\$w bind tan <1> {set ::X %x; set ::Y %y; %W raise current}
\$w bind tan <B1-Motion> {
%W move current [expr %x-\$::X] [expr %y-\$::Y]
set ::X %x
set ::Y %y
}
\$w bind tan <3> {rotate %W current 45}
}
proc tan {w args} {
\$w create poly \$args -fill lightblue -outline blue -tag tan
}
proc rotate {w tag angle} {
set xsum 0; set ysum 0; set n 0
foreach {x y} [\$w coords \$tag] {
set xsum [expr \$xsum+\$x]
set ysum [expr \$ysum+\$y]
incr n
}
set xm [expr \$xsum/\$n]
set ym [expr \$ysum/\$n]
set coords {}
set angle [expr {\$angle*acos(-1)/180}]
foreach {x y} [\$w coords \$tag] {
set r [expr {hypot(\$x-\$xm,\$y-\$ym)}]
set a [expr {atan2(\$y-\$ym,\$x-\$xm)+\$angle}]
lappend coords \
[expr {\$xm+cos(\$a)*\$r}] \
[expr {\$ym+sin(\$a)*\$r}]
}
\$w coords \$tag \$coords
}
main \$argv```

 Arts and Crafts of Tcl-Tk Programming Category Games Category Whizzlet