[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:

[http://mini.net/files/tangram.jpg]

   * 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]