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
