#!/bin/sh
# the next line starts with wish, don't remove the slash --> \
# exec wish "$0" ${1+"$@"}

##----------------------------------------------------------------------
## hextris.tcl
##
## Copyright (c) 1998 Jeffrey Hobbs
## Started: Thu Jul  9 13:36:25 MET DST 1998
##
## jeff at hobbs org
##
## If you'd like to discuss any aspects of the program, I welcome your email.
## If anyone improves upon this, please email changes to me.
##
## source standard_disclaimer.tcl
## source bourbon_ware.tcl
##
## Hextris with multiplayer mode (Nextris!).  Requires Tcl/Tk 8.0+.
## Works either in Tk plugin or stand-alone.
## See HTML docs for more info.
##----------------------------------------------------------------------

## CHANGES (newest at top)

# changed Left/Right border routine to use $hextris(blockedge) as the
# fudge factor, accurate for all block sizes.

# ---- v1.0 August 14, 1998 ----

# modified rotate routines to handle border cases

# added 10th piece (the lovely U)

# fixed up the left/right movement

# added options for round pieces/board

# ---- First Public Release v0.9 August 12, 1998 ----

package require Tk
namespace eval ::Hextris {;

variable hextris
variable block
variable players
variable stats
variable pmap
variable p
variable widget

## VERSION:
set hextris(version) 1.1

set hextris(WWW) [info exists embed_args]
if {$hextris(WWW)} { 
    proc bell args {}
    proc Usage {} {}
} else {
    proc Usage {} {
	global argv0
	puts stderr "Usage: [file tail $argv0] ?-info? ?-blockedge #pixels?\
		?-autopause 0/1? ?-color\[0-9\] rgbcolor?\
		?-maxinterval #usecs? ?-shownext 0/1?\
		?-(left|right|rotleft|rotright|drop|slide) binding?"
	exit
    }

    proc About {} {
	variable hextris
	tk_dialog $hextris(base).about "About Hextris v$hextris(version)" \
		$hextris(info) questhead 0 OK
    }
}

proc ParseArgs {} {
    variable hextris
    variable keys
    variable color

    if {$hextris(WWW)} {
	global embed_args
	set args [array get embed_args]
    } else {
	global argv
	set args $argv
    }
    set truth {^(1|yes|true|on)$}
    for {set i 0; set argc [llength $args]} {$i<$argc} {incr i} {
	set key [string tolower [string triml [lindex $args $i] -]]
	set val [lindex $args [incr i]]
	switch -glob $key {
	    width - height - src { continue }
	    a*		{ set hextris(autoPause) [regexp -nocase $truth $val] }
	    b*		{ set hextris(blockedge) $val }
	    color[0-9] {
		if {[regexp {([0-9])} $key junk num]} {
		    set color($num) $val
		}
	    }
	    dr*		{ set keys(Drop)	$val }
	    ma*		{ set hextris(maxInterval)	$val }
	    lef*	{ set keys(Left)	$val }
	    lev*	{ set hextris(initLevel)	$val }
	    ri*		{ set keys(Right)	$val }
	    rotl*	{ set keys(Rotate Left)	$val }
	    rotr*	{ set keys(Rotate Right)	$val }
	    sha*	{ set hextris(shadow)	[regexp -nocase $truth $val] }
	    sho*	{ set hextris(showNext)	[regexp -nocase $truth $val] }
	    sl*		{ set keys(Slide)	$val }

	    mu*		{ set hextris(multi)	[regexp -nocase $truth $val] }
	    hi*		{ set hextris(highband)	[regexp -nocase $truth $val] }
	    ho*		{ array set hextris [list host $val con,host $val] }
	    p*		{ array set hextris [list port $val con,port $val] }

	    help - info - default Usage
	}
    }
}

proc Init {{base {}}} {
    variable hextris
    variable widget
    variable keys
    variable color
    variable stats

    set hextris(name) [namespace current]::
    array set hextris {
	blockedge	9
	maxInterval	500
	initLevel	0
	autoPause	0
	showNext	1
	shadow		1

	highband	1
	multi		1
	port		15141
	con,port	15141
	sockets		0
	sync		0
	smoothb		0
	smoothp		1
	pieces		10

	maxbrick 0 numplayers 0 deaths 0

	info	"(c) Jeffrey Hobbs 1998\njeff at hobbs org"
    }
    array set color {
	0		\#FF0000
	1		\#00DD00
	2		\#0000CD
	3		\#bdb76b
	4		\#c71585
	5		\#FFFF00
	6		\#000000
	7		\#ff1493
	8		\#ff7f00
	9		\#007fff
    }
    array set keys {
	Left		<Key-Left>
	Right		<Key-Right>
	"Rotate Left"	<Key-Up>
	"Rotate Right"	<Key-Down>
	Slide		<Key-Return>
	Drop		<Key-space>
	Options		<Key-o>
	Quit		<Control-q>
	Start		<Key-s>
	Reset		<Key-r>
	AddRow		<Key-a>
	Faster		<Key-f>
	MultiPlayer	<Control-m>
	Stats		<Control-s>
	About		<Control-a>
	Keys		<Control-k>
    }

    option add *Button.takeFocus	0 startup
    option add *Button*highlightThickness 1 startup
    option add *Canvas*highlightThickness 0 startup
    option add *Canvas.borderWidth	1 startup
    option add *Canvas.relief		ridge startup

    ParseArgs

    foreach i [array names keys] {
	regsub { } $i {} event
	event add <<$event>> $keys($i)
    }

    set be $hextris(blockedge)
    set b  [set hextris(block)  [expr {sqrt(($be*$be)/5)}]]
    set bx [set hextris(blockx) [expr {int($be+2*$b)}]]
    set by [set hextris(blocky) [expr {int(4*$b)}]]
    array set hextris [list root $base base $base host [info hostname] \
	    con,host	[info hostname] myip	127.0.0.1 \
	    width	[expr {10*($b+$be)+$b+1}] \
	    height	[expr {30*$by+($by/2)+1}]]
    if {[string match {} $base]} { set hextris(root) . }
    if {!$hextris(WWW)} {
	wm withdraw $hextris(root)
	wm title $hextris(root) "Hextris v$hextris(version)"
    }

    set left [frame $base.l]
    set right [frame $base.r]
    array set widget [list board	$right.board \
	    stats	$base.stats	shadow	$right.shade \
	    next	$left.next	opts	$base.opts \
	    multi	$base.multi	player	$base.multi.pla \
	    socks	$base.socks	keys	$base.keys \
	    games	$base.game \
	    ]
    frame $widget(socks)

    grid $left $right $widget(socks) -sticky new
    grid configure $right -padx 4
    grid configure $widget(socks) -sticky news

    canvas $widget(board) -width $hextris(width) -height $hextris(height) \
	    -bd 0
    canvas $widget(shadow) -width $hextris(width) -height [expr {$by+($by/2)}]\
	    -bd 0
    $widget(board) xview moveto 0
    $widget(board) yview moveto 0
    $widget(shadow) xview moveto 0
    $widget(shadow) yview moveto 0

    # Oh my gosh, a cheat!
    $widget(board) bind piece <<Cheater>> [namespace code {Cheat %W}]
    $widget(board) bind struc <<Cheater>> [namespace code {Cheat %W}]
    event add <<Cheater>> <Triple-1>

    label $left.title -text "Hextris v$hextris(version)" -relief ridge -bd 2
    label $left.lnext -text "Next Object" -anchor c
    canvas $widget(next) -width [expr {$hextris(blockx)*4+10}] \
	    -height [expr {$hextris(blocky)*3}]
    button $left.start -textvariable $hextris(name)hextris(start) \
	    -command [namespace code ToggleState]
    button $left.reset -text "Reset" -un 0 -command [namespace code {
	Reset
	if {$hextris(numplayers)} {
	    incr hextris(deaths)
	    TellPlayers update 0 $hextris(maxbrick) $hextris(deaths)
	}
    }
    ]
    button $left.addrow -text "Add Random Row" -underline 0 \
	    -command [namespace code {AddRows 1}]

    if {!$hextris(WWW)} {
	button $left.quit  -text "Quit" -underline 0 \
		-command [namespace code exit]
	button $left.opts -text "Options" -underline 0 \
		-command [namespace code Options]
	checkbutton $left.pause -text "Auto Pause" -anchor w \
		-variable $hextris(name)hextris(autoPause) \
		-command [namespace code AutoPause]

	bind $hextris(root) <<Options>>		[list $left.opts invoke]
	bind $hextris(root) <<Quit>>		[list $left.quit invoke]

	foreach i {MultiPlayer Stats About Keys} {
	    bind $hextris(root) <<$i>>	[namespace code $i]
	}
    }

    checkbutton $left.show -text "Show Next" -anchor w \
	    -variable $hextris(name)hextris(showNext) \
	    -command [namespace code ShowNext]
    checkbutton $left.shadow -text "Shadow Piece" -anchor w \
	    -variable $hextris(name)hextris(shadow) \
	    -command [namespace code Shadow]
    checkbutton $left.smb -text "Round Board" -anchor w \
	    -variable $hextris(name)hextris(smoothb) \
	    -command [namespace code Smoothy]
    checkbutton $left.smp -text "Round Pieces" -anchor w \
	    -variable $hextris(name)hextris(smoothp) \
	    -command [namespace code Smoothy]

    label $left.lscore -text Score: -anchor w
    label $left.llvl -text Level: -anchor w
    label $left.lrows -text Rows:   -anchor w
    label $left.vscore -textvariable $hextris(name)hextris(score) -anchor e
    label $left.vlvl -textvariable $hextris(name)hextris(level) -anchor e
    label $left.vrows -textvariable $hextris(name)hextris(rows) -anchor e
    button $left.ilvl -text "^" -padx 0 -pady 0 \
	    -command [namespace code {set hextris(interval) [GetInterval [incr hextris(level)]]}]

    bind $hextris(root) <<Start>> [list $left.start invoke]
    bind $hextris(root) <<Reset>> [list $left.reset invoke]
    bind $hextris(root) <<AddRow>> [list $left.addrow invoke]
    bind $hextris(root) <<Faster>> [list $left.ilvl invoke]

    grid $left.title	- - -sticky new
    grid $left.lnext	- - -sticky new
    grid $widget(next)	- - -sticky n
    grid $left.lscore $left.vscore - -sticky new
    grid $left.llvl   $left.ilvl $left.vlvl -sticky new
    grid $left.lrows  $left.vrows - -sticky new
    grid $left.start	- - -sticky new
    grid $left.reset	- - -sticky new
    grid $left.addrow	- - -sticky new
    grid configure $left.llvl $left.ilvl $left.lrows $left.lscore -sticky nw

    if {!$hextris(WWW)} {
	grid $left.opts		- - -sticky new
	grid $left.quit		- - -sticky new
	grid $left.pause	- - -sticky new
    } else {
	grid [label $left.about -font fixed -text $hextris(info)] - - \
		-sticky new
    }
    grid $left.show	- - -sticky new
    grid $left.shadow	- - -sticky new
    grid $left.smb	- - -sticky new
    grid $left.smp	- - -sticky new

    grid $widget(board) -sticky news
    grid $widget(shadow) -sticky news

    ## Don't touch this - the returned canvas id numbers are important
    ## Could be altered to use more tags, but this seems more efficient
    for {set j 0} {$j < 30} {incr j} {
	for {set i 0} {$i < 10} {incr i} {
	    set P [MakePiece $widget(board) [expr {$i+($j*10)}]]
	    if {$j%2} {
		$widget(board) itemconfig $P -tags back -stipple gray25
	    } else {
		$widget(board) itemconfig $P -tags back
	    }
	    if {$j == 0} {
		$widget(shadow) itemconfig \
			[MakePiece $widget(shadow) [expr {$i+($j*10)}]] \
			-outline black
	    }
	}
    }
    $widget(board) itemconfig back -outline $color(0) -fill white
    focus $widget(board)

    Reset
    InitPieces
    Smoothy
    for {set i 0} {$i < $hextris(pieces)} {incr i} {
	array set stats "$i 0 g$i 0"
    }
    if {$hextris(WWW)} {
	Stats
	Keys
    } else {
	wm resizable $hextris(root) 0 0
	wm deiconify $hextris(root)
    }
    AutoPause
    if {!$hextris(WWW) && $hextris(multi)} {
	if {[catch SocketInit msg]} { bgerror $msg }
    }
}

proc Smoothy {} {
    variable widget
    variable hextris

    $widget(board) itemconfig back -smooth $hextris(smoothb)
    $widget(board) itemconfig struc -smooth $hextris(smoothb)
    $widget(board) itemconfig piece -smooth $hextris(smoothp)
    $widget(shadow) itemconfig all -smooth $hextris(smoothb)
    $widget(next) itemconfig all -smooth $hextris(smoothp)
    if {[winfo exists $widget(stats).c]} {
	$widget(stats).c itemconfig piece -smooth $hextris(smoothp)
    }
}

proc SocketInit {} {
    variable hextris
    variable widget

    set port $hextris(port)
    ## Tries to connect to the specified port or any of the 50 above it
    while {[catch {socket -server [namespace code SocketAccept] $port} msg]} {
	if {[string match {*address already in use} $msg]} {
	    if {[incr port]>[expr {$hextris(port)+50}]} {
		set hextris(multi) 0
		return -code error "unable to find available port"
	    }
	} else {
	    set hextris(multi) 0
	    return -code error $msg
	}
    }
    set hextris(port) $port

    ## Capture our ip/port by sending ourselves a message
    set hextris(sockettest) 1
    set sock [socket -myaddr $hextris(host) $hextris(host) $hextris(port)]
    catch {close $sock}
}

proc SocketAccept {sock ipaddr port} {
    variable hextris
    variable players

    if {[info exists hextris(sockettest)]} {
	unset hextris(sockettest)
	set hextris(myip) $ipaddr
	catch {close $sock}
	return
    }
    set newhost [lindex [fconfigure $sock -peer] 1]
    if {[tk_dialog $hextris(base).socket "Socket Connection" \
	    "$hextris(port): Accept new connection from $newhost ($ipaddr)?" \
	    questhead 0 "You bet" "Kick 'em off"]} {
	puts $sock "Hextris0 $hextris(host) $hextris(port) goodbye"
	flush $sock
	catch {close $sock}
	return
    } else {
	set id "(127\.0\.0\.1|$hextris(host)|localhost)"
	if {[regexp $id $ipaddr]} { set $ipaddr $hextris(myip) }
	NewPlayer $sock $newhost $ipaddr $port
    }
}

proc SocketRead {sock} {
    if {[eof $sock] || ([gets $sock line] == -1)} {
	SocketShutdown $sock
	return
    }
    variable hextris
    variable players
    set peer [fconfigure $sock -peer]
    set id "[lindex $peer 0] [lindex $peer 2]"
    ## Line should be of the form:
    ## Hextris<VERSION> <PLAYERHOST> <PLAYERPORT> <SWITCH> args
    ## The sync occurs in Drop, where we don't want to lose our
    ## piece and have the next immediately drop
    #while {$hextris(sync)} { after 5 }
    if {$hextris(sync)} {vwait hextris(sync)}
    switch -exact -- [lindex $line 3] {
	pause {
	    Pause
	    set hextris(message) $line
	}
	start {
	    if {$hextris(break)} {
		Resume
		set hextris(message) [lreplace $line 0 0]
	    }
	}
	brick { set players($id,maxbrick) [lindex $line 4] }
	update {
	    if {[scan [lrange $line 4 end] "%d %d %d" \
		    addrows height deaths]==3} {
		AddRows $addrows
		set players($id,maxbrick) $height
		set players($id,deaths) $deaths
	    }
	}
	says { set hextris(message) [lreplace $line 0 0] }
	goodbye { SocketShutdown $sock }
	default {}
    }
}

proc SocketConnect {host port} {
    variable hextris
    variable players

    set id "(127\.0\.0\.1|$hextris(myip)|$hextris(host)|localhost)"
    if {[regexp "$id $hextris(port)" "$host $port"]} {
	return -code error "don't touch yourself"
    }
    if {[catch {socket -myaddr $hextris(host) $host $port} sock]} {
	return -code error $sock
    } else {
	set peer [fconfigure $sock -peer]
	NewPlayer $sock [lindex $peer 1] [lindex $peer 0] $port
    }
}

proc SocketShutdown sock {
    variable hextris
    variable players
    variable widget

    catch {close $sock}

    ## Delete multi-player info
    catch {
	set id $players(sock,$sock)
	catch {pack forget $widget($sock)}
	destroy $widget($sock)
	unset players(sock,$sock) widget($sock)
	catch {unset players($id,sock) players($id,name) hextris($id,maxbrick)}
    }
    set hextris(numplayers) [llength [array names players *,sock]]

    UpdatePlayers
    Pause
    tk_dialog $hextris(base).goodbye "Player left" \
	    "Someone departed..." warning 0 Bummer
    Resume
}

proc NewPlayer {sock host ip port} {
    variable hextris
    variable players
    variable widget

    set id [list $ip $port]
    set players(sock,$sock) $id
    set players($id,sock) $sock
    set players($id,name) [list $host $ip $port]
    fconfigure $sock -blocking 0 -translation {auto crlf}
    fileevent $sock readable [namespace code [list SocketRead $sock]]

    set players($id,maxbrick) 0
    set players($id,deaths) 0

    set widget($sock) $widget(socks).$sock
    destroy $widget($sock)
    set w [frame $widget($sock)]
    scale $w.s -orient v -from 30 -to 0 -state disabled -showvalue yes \
	    -variable $hextris(name)players($id,maxbrick)
    pack $widget($sock) $w.s -fill y -expand 1
    pack [label $w.l -textvariable $hextris(name)players($id,deaths)] -fill both

    set hextris(numplayers) [llength [array names players *,sock]]

    UpdatePlayers
}

proc TellPlayers {args} {
    variable hextris
    variable players

    foreach p [array names players *,sock] {
	if {[catch {
	    set msg "Hextris0 $hextris(host) $hextris(port) $args"
	    puts $players($p) $msg
	    flush $players($p)
	} err]} {
	    SocketShutdown $players($p)
	}
    }
}

proc UpdatePlayers {args} {
    variable players
    variable widget

    if {[winfo exists $widget(player)]} {
	$widget(player) delete 0 end
	foreach p [array names players *,name] {
	    $widget(player) insert end $players($p)
	}
    }
}

proc MultiPlayer {} {
    variable hextris
    variable widget

    set w $widget(multi)
    if {![winfo exists $w]} {
	toplevel $w
	wm withdraw $w
	wm title $w "Hextris v$hextris(version) MultiPlayer"

	label $w.hostl -text "My Host:" -anchor w -width 8
	label $w.host  -textvariable $hextris(name)hextris(host) -anchor e
	label $w.ip    -textvariable $hextris(name)hextris(myip) -anchor w
	label $w.portl -text "My Port:" -anchor w -width 8
	label $w.port  -text $hextris(port) -anchor e -width 8

	label $w.conhl -text "New Host:" -anchor w -width 8
	entry $w.conhe -width 12 -textvariable $hextris(name)hextris(con,host)
	label $w.conpl -text "Port:" -anchor w -width 8
	entry $w.conpe -width 8 -textvariable $hextris(name)hextris(con,port)

	set widget(player) [listbox $w.pla -height 3]
	label $w.lsay -text Message:
	entry $w.say
	bind $w.say <Return> [namespace code { TellPlayers says [%W get] }]
	label $w.msg -textvariable $hextris(name)hextris(message) \
		-relief ridge -bd 2

	checkbutton $w.high -text "High Bandwidth" \
		-variable $hextris(name)hextris(highband)
	button $w.con -text Connect -command [namespace code {
	    SocketConnect $hextris(con,host) $hextris(con,port)
	}]
	button $w.gby -text Disconnect -command [namespace code {
	    TellPlayers goodbye
	}]
	button $w.dis -text Dismiss -command [list wm withdraw $w]

	grid $w.hostl $w.host $w.ip $w.portl $w.port -sticky news
	grid $w.conhl $w.conhe - $w.conpl $w.conpe -sticky news
	grid $w.con - - $w.high - -sticky news
	grid $w.pla - - - - -sticky news
	grid $w.lsay $w.say - - - -sticky news
	grid $w.msg - - - - -sticky news
	grid $w.gby - x $w.dis - -sticky news
	update idletasks
	set a $hextris(root)
	wm transient $w $a
	wm group $w $a
	wm geometry $w +[expr {[winfo rootx $a]+([winfo width $a]\
		-[winfo reqwidth $w])/2}]+[expr {[winfo rooty $a]\
		+([winfo height $a]-[winfo reqheight $w])/2}]
    }
    UpdatePlayers

    if {[string comp normal [wm state $w]]} {
	wm deiconify $w
    } else {
	wm withdraw $w
    }
}

proc GetInterval {n} {
    variable hextris

    set i [expr {round($hextris(maxInterval)-($hextris(maxInterval)/20*$n))}]
    if {$i<8} { return 8 }
    return $i
}

proc ToggleState {} {
    variable hextris

    if {[string match $hextris(start) "Pause"]} {
	Pause
	TellPlayers pause
    } elseif {[string match $hextris(start) "Game Over"]} {
	Reset
    } else {
	Resume
	TellPlayers start
    }
}

proc AutoPause {} {
    variable hextris

    if {$hextris(autoPause) && !$hextris(WWW)} {
	## Not available for WWW play
	bind $hextris(root) <Unmap> [namespace code {
	    if {[string match $hextris(start) "Pause"]} { Pause }
	}]
	bind $hextris(root) <Map>   [namespace code {
	    if {[string match $hextris(start) "Resume"]} { Resume }
	}]
	## These are not available for during multiplayer mode
	## (would potentially require way too much communication)
	bind $hextris(root) <FocusOut> [namespace code {
	    if {[string match %d NotifyAncestor] && \
		    [string match $hextris(start) "Pause"]} {
		if {!$hextris(numplayers)} { Pause }
	    }
	}]
	bind $hextris(root) <FocusIn>  [namespace code {
	    if {[string match %d NotifyAncestor] && \
		    [string match $hextris(start) "Resume"]} {
		if {$hextris(numplayers)} { Resume }
	    }
	}]
    } else {
	foreach i {Unmap Map FocusOut FocusIn} { bind $hextris(root) <$i> {} }
    }
}

proc b {} {
    variable hextris

    bind $hextris(root) <<Left>>	[namespace code {Move Left}]
    bind $hextris(root) <<Right>>	[namespace code {Move Right}]
    bind $hextris(root) <<RotateLeft>>	[namespace code {Rotate Left}]
    bind $hextris(root) <<RotateRight>>	[namespace code {Rotate Right}]
    bind $hextris(root) <<Slide>>	[namespace code Slide]
    bind $hextris(root) <<Drop>>	[namespace code Drop]
}

proc Pause {} {
    variable hextris

    set hextris(break) 1
    foreach i [after info] { after cancel $i }
    set hextris(start) "Resume"
    bind $hextris(root) <<Left>>	{}
    bind $hextris(root) <<Right>>	{}
    bind $hextris(root) <<RotateLeft>>	{}
    bind $hextris(root) <<RotateRight>>	{}
    bind $hextris(root) <<Slide>>	{}
    bind $hextris(root) <<Drop>>	{}
}

proc Resume {} {
    variable hextris

    set hextris(break) 0
    set hextris(start) "Pause"
    bind $hextris(root) <<Left>>	[namespace code {Move Left}]
    bind $hextris(root) <<Right>>	[namespace code {Move Right}]
    bind $hextris(root) <<RotateLeft>>	[namespace code {Rotate Left}]
    bind $hextris(root) <<RotateRight>>	[namespace code {Rotate Right}]
    bind $hextris(root) <<Slide>>	[namespace code Slide]
    bind $hextris(root) <<Drop>>	[namespace code Drop]
    Fall
}

proc GameOver {} {
    variable hextris
    variable widget

    if {$hextris(numplayers)} {
	Reset
    } else {
	set hextris(break) 1
	set hextris(start) "Game Over"
	$widget(board) delete piece
    }
}

proc Reset {} {
    variable hextris
    variable block
    variable stats
    variable widget
    variable color

    Pause
    array set hextris [list start "Start" level $hextris(initLevel) \
	    rows 0 next [random $hextris(pieces)] maxbrick 0]
    set hextris(interval) [GetInterval $hextris(level)]
    $widget(board) delete piece struc
    $widget(board) itemconfig back -outline $color([expr {$hextris(level)%7}])
    $widget(next) delete all
    $widget(shadow) dtag shadow
    $widget(shadow) itemconfig all -fill gray
    for {set i -30} {$i < 0}   {incr i} { set block($i) 1 }
    for {}	    {$i < 300} {incr i} { set block($i) 0 }
    for {}          {$i < 310} {incr i} { set block($i) 1 }
    for {set i 0}   {$i < 9}   {incr i} { set stats($i) 0 }
    if {$hextris(numplayers)} {
	incr hextris(deaths)
	Resume
	TellPlayers update 0 $hextris(maxbrick) $hextris(deaths)
    } else {
	set hextris(score) 0
    }
}

proc Options {} {
    variable hextris
    variable widget

    ## These optional windows are already displayed when this is a tclet
    if {$hextris(WWW)} { return }

    set w $widget(opts)
    if {![winfo exists $w]} {
	toplevel $w
	wm withdraw $w
	wm title $w "Hextris v$hextris(version) Options"

	button $w.stats -text "Stats" -command [namespace code Stats]
	button $w.keys -text "Keys Bindings" -command [namespace code Keys]
	button $w.multi -text "Multi Player" -state disabled \
		-command [namespace code MultiPlayer]
	button $w.about -text "About" -command [namespace code About]
	frame $w.sep -height 2 -bd 2 -relief ridge

	button $w.dis -text "Dismiss" -command [list wm withdraw $w]

	grid $w.stats -sticky ew -pad 2
	grid $w.keys  -sticky ew -pad 2
	grid $w.multi -sticky ew -pad 2
	grid $w.about -sticky ew -pad 2
	grid $w.sep -sticky ew
	grid $w.dis -sticky ew -padx 4 -pady 4
	grid columnconfig $w 0 -weight 1

	wm resizable $w 1 0
	update idletasks
	set a $hextris(root)
	wm transient $w $a
	wm group $w $a
	wm geometry $w +[expr {[winfo rootx $a]+([winfo width $a]\
		-[winfo reqwidth $w])/2}]+[expr {[winfo rooty $a]\
		+([winfo height $a]-[winfo reqheight $w])/2}]
    }
    ## Only allow multiplayer mode if it was specified and
    ## we succeeded in getting a port
    if {$hextris(multi)} {
	$w.multi configure -state normal
    }
    if {[string compare normal [wm state $w]]} {
	wm deiconify $w
    } else {
	raise $w
    }
}

proc SetKey {key var} {
    variable keys
    variable hextris

    regsub { } $var {} event
    set newevent <Key-$key>

    if {[catch {event add <<$event>> $newevent} err]} {
	bgerror $err
    } else {
	event delete <<$event>> $keys($var)
	set keys($var) $newevent
    }
    if {$hextris(WWW)} {
	focus $hextris(root)
    }
}

proc Keys {} {
    variable hextris
    variable widget
    variable keys

    set w $widget(keys)
    if {![winfo exists $w]} {
	if {$hextris(WWW)} {
	    grid [frame $w] - - - - -sticky new
	} else {
	    toplevel $w
	    wm withdraw $w
	    wm title $w "Hextris v$hextris(version) Keys"
	}
	label $w.l -justify center \
		-text "Key Bindings: Click in widget and hit a key to change"

	label $w.ml -text "Move Left:" -anchor e
	label $w.mr -text "Move Right:" -anchor e
	label $w.rl -text "Rotate Left:" -anchor e
	label $w.rr -text "Rotate Right:" -anchor e
	label $w.sl -text "Slide:" -anchor e
	label $w.dr -text "Drop:" -anchor e

	entry $w.eml -textvariable $hextris(name)keys(Left)
	entry $w.emr -textvariable $hextris(name)keys(Right)
	entry $w.erl -textvariable "$hextris(name)keys(Rotate Left)"
	entry $w.err -textvariable "$hextris(name)keys(Rotate Right)"
	entry $w.esl -textvariable $hextris(name)keys(Slide)
	entry $w.edr -textvariable $hextris(name)keys(Drop)

	bind $w.eml <Any-Key> [namespace code {SetKey %K "Move Left"; break}]
	bind $w.emr <Any-Key> [namespace code {SetKey %K "Move Right"; break}]
	bind $w.erl <Any-Key> [namespace code {SetKey %K "Rotate Left"; break}]
	bind $w.err <Any-Key> [namespace code {SetKey %K "Rotate Right"; break}]
	bind $w.esl <Any-Key> [namespace code {SetKey %K Slide; break}]
	bind $w.edr <Any-Key> [namespace code {SetKey %K Drop; break}]

	grid $w.l - - - -sticky ew
	grid $w.ml $w.eml $w.rl $w.erl -sticky ew
	grid $w.mr $w.emr $w.rr $w.err -sticky ew
	grid $w.sl $w.esl $w.dr $w.edr -sticky ew

	if {!$hextris(WWW)} {
	    foreach i {AddRow Faster Start Reset Options Quit} {
		set n [string tolower [string index $i 0]]
		label $w.$n -text "$i:" -anchor e
		entry $w.e$n -textvariable $hextris(name)keys($i)
		bind $w.e$n <Any-Key> [namespace code "SetKey %K $i; break"]
	    }

	    grid $w.a $w.ea $w.f $w.ef -sticky ew
	    grid $w.s $w.es $w.r $w.er -sticky ew
	    grid $w.o $w.eo $w.q $w.eq -sticky ew

	    button $w.dis -text "Dismiss" -command [list wm withdraw $w]
	    grid $w.dis - - - -sticky ew
	    wm resizable $w 0 0
	    update idletasks
	    set a $hextris(root)
	    wm transient $w $a
	    wm group $w $a
	    wm geometry $w +[expr {[winfo rootx $a]+([winfo width $a]\
		    -[winfo reqwidth $w])/2}]+[expr {[winfo rooty $a]\
		    +([winfo height $a]-[winfo reqheight $w])/2}]
	}
    }
    if {!$hextris(WWW)} {
	if {[string compare normal [wm state $w]]} {
	    wm deiconify $w
	} else {
	    wm withdraw $w
	}
    }
}

proc Stats {} {
    variable hextris
    variable widget
    variable pmap
    variable stats
    variable color

    set w $widget(stats)
    if {![winfo exists $w]} {
	if {$hextris(WWW)} {
	    grid [frame $w] -sticky new -row 0 \
		    -column [lindex [grid size [winfo parent $w]] 0]
	} else {
	    toplevel $w
	    wm withdraw $w
	    wm title $w "Hextris v$hextris(version) Stats"
	}
	grid [label $w.l -text "Piece Statistics"] -sticky ew
	grid [canvas $w.c -bd 2 -width $hextris(width) -height \
		[expr {$hextris(height)}]] -sticky news
	label $w.c.s -text "Session"
	label $w.c.g -text "Game"
	$w.c create text 5 5 -text "Session" -anchor nw
	$w.c create text [expr {5*$hextris(blockx)}] 5 -text "Game" -anchor nw
	for {set P 0} {$P < $hextris(pieces)} {incr P} {
	    foreach i $pmap($P) {
		$w.c itemconfig [MakePiece $w.c $i] -tags "p$P piece"
	    }
	    # Oh my gosh, a cheat!
	    $w.c bind piece <<Cheater>> [namespace code {Cheat %W}]
	    foreach {x0 y0 x y} [$w.c bbox p$P] {set x [expr {int($x-$x0)}]}
	    set y [expr {(3*$P+1)*$hextris(blocky)}]
	    $w.c move p$P [expr {int(($hextris(width)-$x)/2-$x0)}] $y
	    $w.c itemconfig p$P -fill $color($P)
	    label $w.c.g$P -textvariable $hextris(name)stats(g$P) -anchor w
	    $w.c create window $hextris(blockedge) $y \
		    -window $w.c.g$P -anchor nw
	    label $w.c.$P -textvariable $hextris(name)stats($P) -anchor w
	    $w.c create window [expr {6*$hextris(blockx)}] $y \
		    -window $w.c.$P -anchor nw
	}
	if {!$hextris(WWW)} {
	    button $w.b -text "Dismiss" -command [list wm withdraw $w]
	    grid $w.b -sticky ew
	    wm resizable $w 0 0
	    update idletasks
	    set a $hextris(root)
	    wm transient $w $a
	    wm group $w $a
	    wm geometry $w +[expr {[winfo rootx $a]+([winfo width $a]\
		    -[winfo reqwidth $w])/2}]+[expr {[winfo rooty $a]\
		    +([winfo height $a]-[winfo reqheight $w])/2}]
	}
    }
    if {!$hextris(WWW)} {
	if {[string compare normal [wm state $w]]} {
	    wm deiconify $w
	} else {
	    wm withdraw $w
	}
    }
}

proc MakePiece {w id} {
    variable hextris
    set be $hextris(blockedge)
    set b  $hextris(block)

    if {$id>=10} {
	set xb [expr {($id%10)*$hextris(blockx)}]
	set yb [expr {int($id/100.0*10)*$hextris(blocky)}]
    } else {
	set xb [expr {$id*$hextris(blockx)}]
	set yb 0
    }
    set P [$w create poly \
	    [expr {$xb+$b}]	$yb \
	    $xb			[expr {$yb+2*$b}] \
	    [expr {$xb+$b}]	[expr {$yb+4*$b}] \
	    [expr {$xb+$b+$be}]	[expr {$yb+4*$b}] \
	    [expr {$xb+2*$b+$be}] [expr {$yb+2*$b}] \
	    [expr {$xb+$b+$be}]	$yb \
	    -outline black -fill {} -smooth $hextris(smoothp)]
    $w move $P [expr {-$b*($id%10)}] [expr {($id%2)?(2*$b):0}]
    return $P
}

proc ShowNext {{next -1}} {
    variable hextris
    variable widget
    variable color

    if {$next >= 0} { set hextris(next) $next }
    $widget(next) delete all
    if {$hextris(showNext) && [string compare $hextris(start) "Start"]} {
	variable pmap
	foreach i $pmap($hextris(next)) { MakePiece $widget(next) $i }
	# make sure it is centered
	foreach {x0 y0 x y} [$widget(next) bbox all] {
	    set x [expr {$x-$x0}]
	    set y [expr {$y-$y0}]
	}
	$widget(next) move all \
		[expr {int(([winfo width $widget(next)]-$x)/2-$x0)}] \
		[expr {int(([winfo height $widget(next)]-$y)/2-$y0)}]
	$widget(next) itemconfig all -fill $color($hextris(next))
    }
}

proc CreatePiece {} {
    variable hextris
    variable widget
    variable p
    variable pmap
    variable stats
    variable block
    variable color

    set n $hextris(next)
    set j 0
    foreach i $pmap($n) {
	if {$block([set p($j) $i])} {
	    GameOver
	    return
	}
	set p(_$j) [MakePiece $widget(board) $i]
	$widget(board) itemconfig $p(_$j) -tags "p$n piece"
	incr j
    }
    array set p "type $n state 0 states $pmap($n,states) ledge 3 redge 3"
    incr stats($n)
    incr stats(g$n)
    $widget(board) itemconfig p$n -fill $color($n)
    set hextris(next) [random $hextris(pieces)]

    ShowNext
    Shadow
}

proc Cheat {w} {
    if {[regexp {p([0-9])} [$w gettags current] junk i]} {
	variable hextris
	set hextris(next) $i
	ShowNext
    }
}

proc Fall {{a {}}} {
    variable hextris

    if {!$hextris(break)} {
	after $hextris(interval) [namespace code Fall]
	Slide
    }
}

proc Shadow {} {
    variable hextris
    variable widget
    variable p

    $widget(shadow) dtag shadow
    $widget(shadow) itemconfig all -fill gray
    if {$hextris(shadow) && [string compare {} [$widget(board) bbox piece]]} {
	$widget(shadow) addtag shadow with [expr {$p(0)%10+1}]
	$widget(shadow) addtag shadow with [expr {$p(1)%10+1}]
	$widget(shadow) addtag shadow with [expr {$p(2)%10+1}]
	$widget(shadow) addtag shadow with [expr {$p(3)%10+1}]
	$widget(shadow) itemconfig shadow -fill black
    }
}

proc CementPiece {} {
    variable hextris
    variable widget
    variable p
    variable block

    foreach i {0 1 2 3} {
	set block($p($i)) 1
	set row [expr {$p($i)/10}]
	$widget(board) addtag row$row with $p(_$i)
	if {(30-$row)>$hextris(maxbrick)} {
	    set hextris(maxbrick) [expr {30-$row}]
	}
    }
    $widget(board) addtag struc with piece
    $widget(board) itemconfig struc -stipple gray75 -smooth $hextris(smoothb)
    $widget(board) dtag piece
    incr hextris(score) 5
    DropRows
}

proc Slide {} {
    variable hextris
    variable p
    variable block
    variable widget
    
    if {[string match [$widget(board) bbox piece] {}]} {
	CreatePiece
    } else {
	if {
	    $block([expr {$p(0)+10}]) || $block([expr {$p(1)+10}]) ||
	    $block([expr {$p(2)+10}]) || $block([expr {$p(3)+10}])
	} {
	    CementPiece
	    update idletasks
	} else {
	    incr p(0) 10
	    incr p(1) 10
	    incr p(2) 10
	    incr p(3) 10
	    $widget(board) move piece 0 $hextris(blocky)
	}
    }
}

proc Drop {} {
    variable hextris
    variable p
    variable block
    variable widget

    set hextris(sync) 1
    if {[string match [$widget(board) bbox piece] {}]} return
    set move 0
    while {1} {
	if {
	    $block([expr {$p(0)+10}]) || $block([expr {$p(1)+10}]) ||
	    $block([expr {$p(2)+10}]) || $block([expr {$p(3)+10}])
	} {
	    break
	} else {
	    incr p(0) 10
	    incr p(1) 10
	    incr p(2) 10
	    incr p(3) 10
	    incr move $hextris(blocky)
	}
    }
    $widget(board) move piece 0 $move
    CementPiece
    set hextris(sync) 0
}

proc Move {dir} {
    variable hextris
    variable p
    variable block
    variable widget
    variable ptmap

    if {[string match {} [set ix [$widget(board) bbox piece]]]} { return 0 }
    set dir [string index $dir 0]
    set bit [expr {$p(0)%2}]
    ## FIX: optimize the double $bit tertiary exprs
    if {[string match L $dir]} {
	## first try to shift up when p(0) is on a even-numbered piece
	if {[lindex $ix 0] <= $hextris(blockedge)} { return 0 } elseif {
	    $block([set a [expr {$p(0)-1+($bit?10:-10)}]]) ||
	    $block([set b [expr {$p(1)-1+(($p(1)%2==$bit)?($bit?10:-10):0)}]]) ||
	    $block([set c [expr {$p(2)-1+(($p(2)%2==$bit)?($bit?10:-10):0)}]]) ||
	    $block([set d [expr {$p(3)-1+(($p(3)%2==$bit)?($bit?10:-10):0)}]])
	} {
	    ## otherwise see if down is OK
	    if {
		$block([set a [expr {$p(0)+(-1)}]]) ||
		$block([set b [expr {$p(1)+($bit?-11:9)+(($p(1)%2==$bit)?($bit?10:-10):0)}]]) ||
		$block([set c [expr {$p(2)+($bit?-11:9)+(($p(2)%2==$bit)?($bit?10:-10):0)}]]) ||
		$block([set d [expr {$p(3)+($bit?-11:9)+(($p(3)%2==$bit)?($bit?10:-10):0)}]])
	    } {
		return 0
	    }
	}
    } else {
	if {[lindex $ix 2] > $hextris(width)-$hextris(blockedge)} {
	    return 0
	} elseif {
	    $block([set a [expr {$p(0)+1+($bit?10:-10)}]]) ||
	    $block([set b [expr {$p(1)+1+(($p(1)%2==$bit)?($bit?10:-10):0)}]]) ||
	    $block([set c [expr {$p(2)+1+(($p(2)%2==$bit)?($bit?10:-10):0)}]]) ||
	    $block([set d [expr {$p(3)+1+(($p(3)%2==$bit)?($bit?10:-10):0)}]])
	} {
	    if {
		$block([set a [expr {$p(0)+(1)}]]) ||
		$block([set b [expr {$p(1)+($bit?-9:11)+(($p(1)%2==$bit)?($bit?10:-10):0)}]]) ||
		$block([set c [expr {$p(2)+($bit?-9:11)+(($p(2)%2==$bit)?($bit?10:-10):0)}]]) ||
		$block([set d [expr {$p(3)+($bit?-9:11)+(($p(3)%2==$bit)?($bit?10:-10):0)}]])
	    } {
		return 0
	    }
	}
    }
    set p(ledge) [modmin "$a $b $c $d"]
    set p(redge) [expr {9-[modmax "$a $b $c $d"]}]
    array set p "0 $a 1 $b 2 $c 3 $d"
    eval $widget(board) coords $p(_0) [$widget(board) coords [expr {$a+1}]]
    eval $widget(board) coords $p(_1) [$widget(board) coords [expr {$b+1}]]
    eval $widget(board) coords $p(_2) [$widget(board) coords [expr {$c+1}]]
    eval $widget(board) coords $p(_3) [$widget(board) coords [expr {$d+1}]]
    Shadow
    update idletasks
    return 1
}

proc Rotate dir {
    variable hextris
    variable p
    variable block
    variable widget
    variable ptmap

    if {[string match {} [set ix [$widget(board) bbox piece]]]} { return }
    set dir [string index $dir 0]
    if {($p(ledge) < $ptmap($p(type),$dir$p(state),lbuf)) || \
	    ($p(redge) < $ptmap($p(type),$dir$p(state),rbuf))} {
	return 0
    }
    foreach {a b c d} $ptmap($p(type)$dir$p(state),[expr {$p(0)%2}]) {break}
    if {
	$block([set a [expr {$p(0)+$a}]]) || 
	$block([set b [expr {$p(1)+$b}]]) ||
	$block([set c [expr {$p(2)+$c}]]) ||
	$block([set d [expr {$p(3)+$d}]])
    } {
	return 0
    }
    set p(ledge) [modmin "$a $b $c $d"]
    set p(redge) [expr {9-[modmax "$a $b $c $d"]}]
    array set p "0 $a 1 $b 2 $c 3 $d"
    eval $widget(board) coords $p(_0) [$widget(board) coords [expr {$a+1}]]
    eval $widget(board) coords $p(_1) [$widget(board) coords [expr {$b+1}]]
    eval $widget(board) coords $p(_2) [$widget(board) coords [expr {$c+1}]]
    eval $widget(board) coords $p(_3) [$widget(board) coords [expr {$d+1}]]
    set p(state) [expr {($p(state)+([string compare R $dir]?1:-1)) \
	    % $p(states)}]
    Shadow
    update idletasks
    return 1
}

proc DropRows {} {
    variable hextris
    variable block
    variable p
    variable widget
    variable color

    set full {}
    foreach {i j} [array get p {[0-3]}] {
	if {[set j [expr {$j/10}]]} { set tmp($j) {} }
    }
    foreach i [array names tmp] {
	if {
	    $block(${i}0) && $block(${i}1) && $block(${i}2) && $block(${i}3) &&
	    $block(${i}4) && $block(${i}5) && $block(${i}6) && $block(${i}7) &&
	    $block(${i}8) && $block(${i}9)
	} {
	    lappend full $i
	    array set block "${i}0 0 ${i}1 0 ${i}2 0 ${i}3 0 \
		    ${i}4 0 ${i}5 0 ${i}6 0 ${i}7 0 ${i}8 0 ${i}9 0"
	}
    }
    if {[set i [llength $full]]} {
	incr hextris(score) [expr {round(pow($i,2))*($hextris(level)+1)}]
	incr hextris(rows)  $i
	incr hextris(maxbrick) -$i
	if {($hextris(rows)/10) > $hextris(level)} {
	    ## Move to the next level
	    incr hextris(level)
	    $widget(board) itemconfig back \
		    -outline $color([expr {$hextris(level)%7}])
	    bell
	    set hextris(interval) [GetInterval $hextris(level)]
	}
	TellPlayers update [incr i -1] $hextris(maxbrick) $hextris(deaths)

	foreach row [lsort -integer $full] {
	    $widget(board) delete row$row
	    for {set i $row; incr i -1} {$i > 0} {incr i -1} {
		$widget(board) move row$i 0 $hextris(blocky)
		$widget(board) addtag row[expr {$i+1}] with row$i
		$widget(board) dtag row$i
	    }
	    update idletasks
	    for {set i ${row}0} {$i > 0} {incr i -1} {
		if {$block($i)} {
		    set block([expr {$i+10}]) 1
		    set block($i) 0
		}
	    }
	}
	update
    } elseif {$hextris(highband) && $hextris(numplayers)} {
	TellPlayers brick $hextris(maxbrick)
    }
}

proc AddRows {num} {
    variable hextris
    variable block
    variable widget

    if {$num>4 || $num<1} return
    set w $widget(board)
    $w delete piece

    ## Move pieces
    set by $hextris(blocky)
    $w move struc 0 [expr {$num*-$by}]
    for {set i 0} {$i < 31} {incr i} {
	$w addtag row[expr {$i-$num}] with row$i
	$w dtag row$i
    }
    TellPlayers brick [incr hextris(maxbrick) $num]
    if {$hextris(maxbrick)>29} {
	GameOver
	return
    }
    ## Reassign block vars
    set move ${num}0
    for {set i 0} {$i<300} {incr i} {
	if {$block($i)} {
	    set block([expr {$i-$move}]) 1
	    set block($i) 0
	}
    }
    ## Add random black structure blocks
    ## make sure that we don't make a whole row of new blocks
    set numblocks 0
    for {set i [expr {300-$move}]} {$i < 300} {incr i} {
	if {[random] && $numblocks < 10} {
	    set block($i) 1
	    set row [expr {$i/10}]
	    $w itemconfig [MakePiece $w $i] -tags "row$row struc" -fill black
	    incr numblocks
	}
    }
    $w itemconfig struc -stipple gray75
}

expr {srand([clock clicks]%65536)}
proc random {{range 2}} {
    return [expr {int(rand()*$range)}]
}

proc modmin {list {mod 10}} {
    set m $mod
    foreach i $list { if {($i % $mod) < $m} { set m [expr {$i%$mod}] } }
    return $m
}

proc modmax {list {mod 10}} {
    set m 0
    foreach i $list { if {($i % $mod) > $m} { set m [expr {$i%$mod}] } }
    return $m
}

proc InitPieces {} {
    variable hextris
    variable pmap
    variable ptmap

    ## Each 4-block  piece map is of the form defines what block id
    ## in the 10x30 grid that a piece will occupy
    ## Block
    set pmap(0) {3 4 5 14}
    set pmap(0,states) 3

    set ptmap(0L0,0) {-9	10	8	-1}
    set ptmap(0L0,1) {1		10	8	-11}
    set ptmap(0L1,0) {0	-9	2	11}
    set ptmap(0L1,1) {0		1	2	1}
    set ptmap(0L2,0) {-1	-1	-10	0}
    set ptmap(0L2,1) {9	-11	-10	0}
    set ptmap(0R0,0) {-9	11	10	0}
    set ptmap(0R0,1) {1		1	10	0}
    set ptmap(0R1,0) {-1	-10	-8	11}
    set ptmap(0R1,1) {9	-10	-8	1}
    set ptmap(0R2,0) {0		9	-2	-11}
    set ptmap(0R2,1) {0	-1	-2	-1}
    set ptmap(0,L1,rbuf) 1
    set ptmap(0,R1,rbuf) 1
    set ptmap(0,L2,lbuf) 1
    set ptmap(0,R2,lbuf) 1

    ## L, rotates around 2
    set pmap(1) {2 3 14 5}
    set pmap(1,states) 6

    set ptmap(1L0,0) {20	10	0	-1}
    set ptmap(1L0,1) {20	10	0	-11}
    set ptmap(1R1,0) {-20	-10	0	1}
    set ptmap(1R1,1) {-20	-10	0	11}
    set ptmap(1L1,0) {12	11	0	-1}
    set ptmap(1L1,1) {12	1	0	9}
    set ptmap(1R2,0) {-12	-11	0	1}
    set ptmap(1R2,1) {-12	-1	0	-9}
    set ptmap(1L2,0) {-8	-9	0	10}
    set ptmap(1L2,1) {-8	1	0	10}
    set ptmap(1R3,0) {8		9	0	-10}
    set ptmap(1R3,1) {8		-1	0	-10}
    set ptmap(1L3,0) {-20	-10	0	11}
    set ptmap(1L3,1) {-20	-10	0	1}
    set ptmap(1R4,0) {20	10	0	-11}
    set ptmap(1R4,1) {20	10	0	-1}
    set ptmap(1L4,0) {-12	-1	0	-9}
    set ptmap(1L4,1) {-12	-11	0	1}
    set ptmap(1R5,0) {12	1	0	9}
    set ptmap(1R5,1) {12	11	0	-1}
    set ptmap(1L5,0) {8		-1	0	-10}
    set ptmap(1L5,1) {8		9	0	-10}
    set ptmap(1R0,0) {-8	1	0	10}
    set ptmap(1R0,1) {-8	-9	0	10}
    set ptmap(1,R1,rbuf) 1
    set ptmap(1,R2,lbuf) 1
    set ptmap(1,L2,rbuf) 2
    set ptmap(1,R4,lbuf) 1
    set ptmap(1,L5,lbuf) 2
    set ptmap(1,R5,rbuf) 1

    ## Mirror L, rotates around 2
    set pmap(2) {12 3 4 5}
    set pmap(2,states) 6

    set ptmap(2L0,0) {12	11	0	-10}
    set ptmap(2L0,1) {12	1	0	-10}
    set ptmap(2R1,0) {-12	-11	0	10}
    set ptmap(2R1,1) {-12	-1	0	10}
    set ptmap(2L1,0) {-8	-9	0	-1}
    set ptmap(2L1,1) {-8	1	0	-11}
    set ptmap(2R2,0) {8		9	0	1}
    set ptmap(2R2,1) {8	-1	0	11}
    set ptmap(2L2,0) {-20	-10	0	-1}
    set ptmap(2L2,1) {-20	-10	0	9}
    set ptmap(2R3,0) {20	10	0	1}
    set ptmap(2R3,1) {20	10	0	-9}
    set ptmap(2L3,0) {-12	-1	0	10}
    set ptmap(2L3,1) {-12	-11	0	10}
    set ptmap(2R4,0) {12	1	0	-10}
    set ptmap(2R4,1) {12	11	0	-10}
    set ptmap(2L4,0) {8		-1	0	11}
    set ptmap(2L4,1) {8		9	0	1}
    set ptmap(2R5,0) {-8	1	0	-11}
    set ptmap(2R5,1) {-8	-9	0	-1}
    set ptmap(2L5,0) {20	10	0	-9}
    set ptmap(2L5,1) {20	10	0	1}
    set ptmap(2R0,0) {-20	-10	0	9}
    set ptmap(2R0,1) {-20	-10	0	-1}
    set ptmap(2,L1,rbuf) 1
    set ptmap(2,R1,lbuf) 2
    set ptmap(2,L2,lbuf) 1
    set ptmap(2,L4,lbuf) 1
    set ptmap(2,R4,rbuf) 2
    set ptmap(2,L5,rbuf) 1

    ## Snake One, rotates around 1
    set pmap(3) {2 3 4 5}
    set pmap(3,states) 6

    set ptmap(3L0,0) {10	0	-11	-11}
    set ptmap(3L0,1) {10	0	-1	-21}
    set ptmap(3R1,0) {-10	0	11	11}
    set ptmap(3R1,1) {-10	0	1	21}
    set ptmap(3L1,0) {1		0	9	-2}
    set ptmap(3L1,1) {11	0	-1	-2}
    set ptmap(3R2,0) {-11	0	1	2}
    set ptmap(3R2,1) {-1	0	-9	2}
    set ptmap(3L2,0) {-9	0	10	19}
    set ptmap(3L2,1) {1		0	10	9}
    set ptmap(3R3,0) {-1	0	-10	-9}
    set ptmap(3R3,1) {9		0	-10	-19}
    set ptmap(3L3,0) {-10	0	1	21}
    set ptmap(3L3,1) {-10	0	11	11}
    set ptmap(3R4,0) {10	0	-1	-21}
    set ptmap(3R4,1) {10	0	-11	-11}
    set ptmap(3L4,0) {-11	0	1	2}
    set ptmap(3L4,1) {-1	0	-9	2}
    set ptmap(3R5,0) {1		0	9	-2}
    set ptmap(3R5,1) {11	0	-1	-2}
    set ptmap(3L5,0) {-1	0	-10	-9}
    set ptmap(3L5,1) {9		0	-10	-19}
    set ptmap(3R0,0) {-9	0	10	19}
    set ptmap(3R0,1) {1		0	10	9}
    set ptmap(3,R1,rbuf) 1
    set ptmap(3,L2,lbuf) 1
    set ptmap(3,L2,lbuf) 1
    set ptmap(3,R2,rbuf) 1
    set ptmap(3,R4,lbuf) 1
    set ptmap(3,L5,lbuf) 1
    set ptmap(3,L5,rbuf) 1
    set ptmap(3,R5,lbuf) 1

    ## Snake Two, rotates around 1
    set pmap(4) {3 4 5 6}
    set pmap(4,states) 6

    set ptmap(4L0,0) {1		0	-10	-11}
    set ptmap(4L0,1) {11	0	-10	-21}
    set ptmap(4R1,0) {-11	0	10	21}
    set ptmap(4R1,1) {-1	0	10	11}
    set ptmap(4L1,0) {-9	0	-1	-2}
    set ptmap(4L1,1) {1		0	-11	-2}
    set ptmap(4R2,0) {-1	0	11	2}
    set ptmap(4R2,1) {9		0	1	2}
    set ptmap(4L2,0) {-10	0	9	9}
    set ptmap(4L2,1) {-10	0	-1	19}
    set ptmap(4R3,0) {10	0	-9	-9}
    set ptmap(4R3,1) {10	0	1	-19}
    set ptmap(4L3,0) {-11	0	10	21}
    set ptmap(4L3,1) {-1	0	10	11}
    set ptmap(4R4,0) {1		0	-10	-11}
    set ptmap(4R4,1) {11	0	-10	-21}
    set ptmap(4L4,0) {-1	0	11	2}
    set ptmap(4L4,1) {9		0	1	2}
    set ptmap(4R5,0) {-9	0	-1	-2}
    set ptmap(4R5,1) {1		0	-11	-2}
    set ptmap(4L5,0) {10	0	1	-19}
    set ptmap(4L5,1) {10	0	-9	-9}
    set ptmap(4R0,0) {-10	0	-1	19}
    set ptmap(4R0,1) {-10	0	9	9}
    set ptmap(4,L1,lbuf) 1
    set ptmap(4,R1,lbuf) 1
    set ptmap(4,R1,rbuf) 1
    set ptmap(4,L2,lbuf) 1
    set ptmap(4,L4,rbuf) 1
    set ptmap(4,R4,lbuf) 1
    set ptmap(4,R4,lbuf) 1
    set ptmap(4,L5,rbuf) 1

    ## Bar, rotates around 1
    set pmap(5) {2 3 14 15}
    set pmap(5,states) 6

    set ptmap(5L0,0) {10	0	-10	-20}
    set ptmap(5L0,1) {10	0	-10	-20}
    set ptmap(5R1,0) {-10	0	10	20}
    set ptmap(5R1,1) {-10	0	10	20}
    set ptmap(5L1,0) {1		0	-11	-12}
    set ptmap(5L1,1) {11	0	-1	-12}
    set ptmap(5R2,0) {-11	0	1	12}
    set ptmap(5R2,1) {-1	0	11	12}
    set ptmap(5L2,0) {-9	0	-1	8}
    set ptmap(5L2,1) {1		0	9	8}
    set ptmap(5R3,0) {-1	0	-9	-8}
    set ptmap(5R3,1) {9		0	1	-8}
    set ptmap(5L3,0) {-10	0	10	20}
    set ptmap(5L3,1) {-10	0	10	20}
    set ptmap(5R4,0) {10	0	-10	-20}
    set ptmap(5R4,1) {10	0	-10	-20}
    set ptmap(5L4,0) {-11	0	1	12}
    set ptmap(5L4,1) {-1	0	11	12}
    set ptmap(5R5,0) {1		0	-11	-12}
    set ptmap(5R5,1) {11	0	-1	-12}
    set ptmap(5L5,0) {-1	0	-9	-8}
    set ptmap(5L5,1) {9		0	1	-8}
    set ptmap(5R0,0) {-9	0	-1	8}
    set ptmap(5R0,1) {1		0	9	8}
    set ptmap(5,L2,lbuf) 2
    set ptmap(5,L2,rbuf) 1
    set ptmap(5,R2,lbuf) 1
    set ptmap(5,R2,rbuf) 2
    set ptmap(5,L5,lbuf) 1
    set ptmap(5,L5,rbuf) 2
    set ptmap(5,R5,lbuf) 2
    set ptmap(5,R5,rbuf) 1

    ## T, rotates around 1	(center)
    set pmap(6) {4 5 6 15}
    set pmap(6,states) 2

    set ptmap(6L0,0) {10	0	-11	1}
    set ptmap(6L0,1) {10	0	-1	-9}
    set ptmap(6R1,0) {-10	0	11	-1}
    set ptmap(6R1,1) {-10	0	1	9}
    set ptmap(6L1,0) {-10	0	11	-1}
    set ptmap(6L1,1) {-10	0	1	9}
    set ptmap(6R0,0) {10	0	-11	1}
    set ptmap(6R0,1) {10	0	-1	-9}

    ## Humpback One, rotates around 1	(center)
    set pmap(7) {4 5 6 14}
    set pmap(7,states) 6

    set ptmap(7L0,0) {10	0	-11	1}
    set ptmap(7L0,1) {10	0	-1	11}
    set ptmap(7R1,0) {-10	0	11	-1}
    set ptmap(7R1,1) {-10	0	1	-11}
    set ptmap(7L1,0) {1		0	9	1}
    set ptmap(7L1,1) {11	0	-1	-9}
    set ptmap(7R2,0) {-11	0	1	9}
    set ptmap(7R2,1) {-1	0	-9	-1}
    set ptmap(7L2,0) {-9	0	10	-10}
    set ptmap(7L2,1) {1		0	10	-10}
    set ptmap(7R3,0) {-1	0	-10	10}
    set ptmap(7R3,1) {9		0	-10	10}
    set ptmap(7L3,0) {-10	0	1	-11}
    set ptmap(7L3,1) {-10	0	11	-1}
    set ptmap(7R4,0) {10	0	-1	11}
    set ptmap(7R4,1) {10	0	-11	1}
    set ptmap(7L4,0) {-11	0	1	9}
    set ptmap(7L4,1) {-1	0	-9	-1}
    set ptmap(7R5,0) {1		0	9	1}
    set ptmap(7R5,1) {11	0	-1	-9}
    set ptmap(7L5,0) {-1	0	-10	10}
    set ptmap(7L5,1) {9		0	-10	10}
    set ptmap(7R0,0) {-9	0	10	-10}
    set ptmap(7R0,1) {1		0	10	-10}
    set ptmap(7,L1,rbuf) 1
    set ptmap(7,R1,rbuf) 1
    set ptmap(7,L4,lbuf) 1
    set ptmap(7,R4,lbuf) 1

    ## Humpback Two, rotates around 1	(center)
    set pmap(8) {4 5 6 16}
    set pmap(8,states) 6

    set ptmap(8L0,0) {10	0	-11	-10}
    set ptmap(8L0,1) {10	0	-1	-10}
    set ptmap(8R1,0) {-10	0	11	10}
    set ptmap(8R1,1) {-10	0	1	10}
    set ptmap(8L1,0) {1		0	9	-11}
    set ptmap(8L1,1) {11	0	-1	-1}
    set ptmap(8R2,0) {-11	0	1	1}
    set ptmap(8R2,1) {-1	0	-9	11}
    set ptmap(8L2,0) {-9	0	10	-1}
    set ptmap(8L2,1) {1		0	10	9}
    set ptmap(8R3,0) {-1	0	-10	-9}
    set ptmap(8R3,1) {9		0	-10	1}
    set ptmap(8L3,0) {-10	0	1	10}
    set ptmap(8L3,1) {-10	0	11	10}
    set ptmap(8R4,0) {10	0	-1	-10}
    set ptmap(8R4,1) {10	0	-11	-10}
    set ptmap(8L4,0) {-11	0	1	1}
    set ptmap(8L4,1) {-1	0	-9	11}
    set ptmap(8R5,0) {1		0	9	-11}
    set ptmap(8R5,1) {11	0	-1	-1}
    set ptmap(8L5,0) {-1	0	-10	-9}
    set ptmap(8L5,1) {9		0	-10	1}
    set ptmap(8R0,0) {-9	0	10	-1}
    set ptmap(8R0,1) {1		0	10	9}
    set ptmap(8,L2,rbuf) 1
    set ptmap(8,R2,rbuf) 1
    set ptmap(8,L5,lbuf) 1
    set ptmap(8,R5,lbuf) 1

    ## U, rotates around center
    set pmap(9) {13 3 4 5}
    set pmap(9,states) 6

    set ptmap(9L0,0) {1		10	9	-11}
    set ptmap(9L0,1) {11	10	-1	-1}
    set ptmap(9R1,0) {-11	-10	1	1}
    set ptmap(9R1,1) {-1	-10	-9	11}
    set ptmap(9L1,0) {-9	11	10	-1}
    set ptmap(9L1,1) {1		1	10	9}
    set ptmap(9R2,0) {-1	-1	-10	-9}
    set ptmap(9R2,1) {9		-11	-10	1}
    set ptmap(9L2,0) {-10	1	1	10}
    set ptmap(9L2,1) {-10	-9	11	10}
    set ptmap(9R3,0) {10	-1	-1	-10}
    set ptmap(9R3,1) {10	9	-11	-10}
    set ptmap(9L3,0) {-11	-10	1	1}
    set ptmap(9L3,1) {-1	-10	-9	11}
    set ptmap(9R4,0) {1		10	9	-11}
    set ptmap(9R4,1) {11	10	-1	-1}
    set ptmap(9L4,0) {-1	-1	-10	-9}
    set ptmap(9L4,1) {9		-11	-10	1}
    set ptmap(9R5,0) {-9	11	10	-1}
    set ptmap(9R5,1) {1		1	10	9}
    set ptmap(9L5,0) {10	9	-11	-10}
    set ptmap(9L5,1) {10	-1	-1	-10}
    set ptmap(9R0,0) {-10	-9	11	10}
    set ptmap(9R0,1) {-10	1	1	10}
    set ptmap(9,L1,rbuf) 1
    set ptmap(9,R1,rbuf) 1
    set ptmap(9,L4,lbuf) 1
    set ptmap(9,R4,lbuf) 1

    for {set i 0} {$i < $hextris(pieces)} {incr i} {
	for {set s 0} {$s < $pmap($i,states)} {incr s} {
	    foreach d {L R} {
		if {![info exists ptmap($i,$d$s,lbuf)]} {
		    set ptmap($i,$d$s,lbuf) 0
		}
		if {![info exists ptmap($i,$d$s,rbuf)]} {
		    set ptmap($i,$d$s,rbuf) 0
		}
	    }
	}
    }

    return
}

if {![info exists hextris(info)]} { Init }

}; # end namespace Hextris

