if 0 {[Richard Suchenwirth] 2003-11-23 - This game was marketed as "The
a-Maze-ing Labyrinth" - here's my Tcl approximation to it.

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

The maze is a 7*7 grid of cards, 16 of which are fixed on the board, 34
are movable - 33 on the board, and one "off-board" card. You can insert
this card at any place where an orange arrow is displayed, and shift
the cards in that row or column by one position. Rotate the off-board
card by right-clicking.

'''WARNING:''' This is still under development - shifting cards works in the good case, but can easily go wrong on other mouse movements. Fixes welcome!

[DKF]: Hmm.  I've not encountered this game before; what's the winning condition(s)?

[AK]: Each player has a colored token to move. Start locations for the tokens are in the four corners. Each player has a set of cards showing treasures (hide them from other the players). Some pieces of the board (fixed, and moveable) show the same treasures. Each player looks at the topmost treasure card he has, and whenever it is his turn he tries to shift the labyrinth so that his token can move from the current place to the treasure without hitting a wall. He can also move the token (even if the treasure is not hit). When a player was able place his token on a treasure the treasure card is made visible, and the player can work on getting to the next treasure in his set of cards. When a player has visited all treasures on his cards he has to shift the labyrinth so that he can get his token back to his start location. When he reaches the start location again, and is the first to do so, he wins.
}

----
 proc main {} {
    global g
    set g(size) 40
    set side [expr $g(size)*9]
    pack [canvas .c -width $side -height [expr $g(size)*10] -bg purple]
    #------- fixed cards
    card .c L 2  1 1
    card .c T 0  3 1
    card .c T 0  5 1
    card .c L 1  7 1
    
    card .c T 1  1 3
    card .c T 1  3 3
    card .c T 0  5 3
    card .c T 3  7 3
    
    card .c T 1  1 5
    card .c T 2  3 5
    card .c T 3  5 5
    card .c T 3  7 5

    card .c L 3  1 7
    card .c T 2  3 7
    card .c T 2  5 7
    card .c L 0  7 7
    #--- arrows
    set y0 [expr $g(size)*0.7]
    set y1 [expr $g(size)*8]
    set y2 [expr $g(size)*8.3]
    foreach x {2.5 4.5 6.5} {
        set x0 [expr $x*$g(size)]
        foreach line [list [list $x0 $y0 $x0 $g(size)] \
            [list $x0 $y2 $x0 $y1] [list $y0 $x0 $g(size) $x0]\
            [list $y2 $x0 $y1 $x0]] {
            .c create line $line -arrow last -width 5 \
                -fill orange -tag arrow
        }
    }
    #--- movable cards
    set cards [split [rep I 13][rep L 15][rep T 6] ""]
    set y 1
    foreach row {
        {0 1 0 1 0 1 0}
        {1 1 1 1 1 1 1}
        {0 1 0 1 0 1 0} 
        {1 1 1 1 1 1 1}
        {0 1 0 1 0 1 0} 
        {1 1 1 1 1 1 1}
        {0 1 0 1 0 1 0}
    } {
        set x 1
        foreach col $row {
            if $col {
                card .c [ldraw cards] [lpick {0 1 2 3}] $x $y
            }
            incr x
        }
        incr y
    }
    #--- the last card is off-board
    card .c $cards 0  4 9 mvcard
    movable .c mvcard
 }
 proc card {w shape rot x y {tag ""}} {
    global g
    $w create rect [expr {$x*$g(size)}] [expr {$y*$g(size)}] \
        [expr {($x+1)*$g(size)}] [expr {($y+1)*$g(size)}] \
        -fill brown -tag $tag
    switch -- $shape {
        I {set coo {0 0.3 1 0.3 1 0.7 0 0.7}}
        L {set coo {0.3 1 0.3 0.3 1 0.3 1 0.7 0.7 0.7 0.7 1}}
        T {set coo {0 .7 0 .3 .3 .3 .3 0 .7 0 .7 .3 1 .3 1 .7}}
    }
    set id [$w create poly $coo -fill beige -tag $tag]
    rotate $w $id $rot 0.5 0.5
    $w scale $id 0 0 $g(size) $g(size)
    $w move $id [expr {$x*$g(size)}] [expr {$y*$g(size)}]
 }
 interp alias {} rep {} string repeat
 proc rotate {w tag rot xm ym} {
    set coords {}
    foreach {x y} [$w coords $tag] {
        set r [expr hypot($xm-$x,$ym-$y)]
        set a [expr atan2($ym-$y,$xm-$x)-$rot/2.*acos(-1)]
        set x2 [expr $xm+cos($a)*$r]
        set y2 [expr $ym+sin($a)*$r]
        lappend coords $x2 $y2
    }
    $w coords $tag $coords
 }
 proc rotate2 {w tag rot} {
    foreach id [$w find withtag $tag] {
        if {[$w type $id]=="polygon"} {set poly $id; break}
    }
    foreach {x0 y0 x1 y1} [$w bbox $tag] break
    set xm [expr {($x1+$x0)/2.}]
    set ym [expr {($y1+$y0)/2.}]
    rotate $w $poly $rot $xm $ym
 }
 proc movable {w tag} {
    $w bind $tag <1> {set g(x) %x; set g(y) %y}
    $w bind $tag <B1-Motion>       [list move %W $tag %x %y]
    $w bind $tag <ButtonRelease-1> [list release %W $tag]
    set poly {}
    $w bind $tag <3> [list rotate2 $w $tag 3]
 }
 proc move {w tag x y} {
    global g
    $w move $tag [expr {$x-$g(x)}] [expr {$y-$g(y)}]
    array set g [list x $x y $y]
 }
 proc release {w tag} {
    global g
    #--- snap card in exact place
    foreach {x y - -} [$w bbox $tag] break
    set s2 [expr {$g(size)/2.}]
    set dx [expr -round($x-$s2)%$g(size)-$s2-1]
    set dy [expr -round($y-$s2)%$g(size)-$s2-1]
    $w move $tag $dx $dy
    #--- on arrow?
    foreach {x0 y0 x1 y1} [$w bbox $tag] break
    set ok 0
    foreach item [$w find overlapping $x0 $y0 $x1 $y1] {
        if {[$w type $item] eq "line"} {incr ok; break}
    }
    if !$ok return
    set dir {0 0}
    if {$x0==-1} {set x1 [expr $g(size)*8+1]; set dir {1 0}}
    if {$x0==$g(size)*8-1} {set x0 -1;        set dir {-1 0}}
    if {$y0==-1} {set y1 [expr $g(size)*8+1]; set dir {0 1}}
    if {$y0==$g(size)*8-1} {set y0 -1;        set dir {0 -1}}
    if {$dir ne {0 0}} {
        foreach {dx dy} $dir break
        foreach item [$w find enclosed $x0 $y0 $x1 $y1] {
            if {[$w type $item] eq "line"} continue
            $w move $item [expr $dx*$g(size)] [expr $dy*$g(size)]
        }
        $w dtag $tag
    }
    #--- find out-shifted card
    switch -- $dir {
        {0 1}  {set y0 [expr $g(size)*8-1]}
        {0 -1} {set y1 [expr $g(size)-1]}
        {1 0}  {set x0 [expr $g(size)*8-1]}
        {-1 0} {set x1 [expr $g(size)-1]}
    }
    $w addtag $tag overlapping $x0 $y0 $x1 $y1
    $w dtag arrow $tag 
    movable $w $tag
    $w raise $tag
 }
#--- General utilities: 
 proc ldraw listVar {
    upvar 1 $listVar list
    set pos [expr {int(rand()*[llength $list])}]
    K [lindex $list $pos] [set list [lreplace $list $pos $pos]]
 }
 proc K {a b} {set a}
 proc lpick list {lindex $list [expr {int(rand()*[llength $list])}]}
 
 bind . <F1> {console show}
 main
 bind . <Escape> {exec wish $argv0 &; exit}