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

##----------------------------------------------------------------------
## tetris.tcl
##
## Copyright (c) 1995-2002 Jeffrey Hobbs
## Started: Sat Aug 11 15:27:32 PDT 1995
##
## jeff@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
##
## Tetris with multiplayer mode (Netris!).  Requires Tcl/Tk 8.0+.
## Works either in Tk plugin or stand-alone.
## See HTML docs for more info.
##----------------------------------------------------------------------

package require Tk
namespace eval Tetris {;

variable tetris
variable block
variable players
variable stats
variable pmap
variable piece
variable widget

## VERSION:
set tetris(version) 3.3

set tetris(WWW) [info exists embed_args]
if {$tetris(WWW)} { 
    proc bell args {}
    proc Usage {} {}
} else {
    wm withdraw .

    proc Usage {} {
	global argv0
	puts stderr "Usage: [file tail $argv0] ?-info? ?-blocksize #pixels?\
		?-autopause 0/1? ?-color\[0-6\] rgbcolor?\
		?-maxinterval #usecs? ?-shownext 0/1?\
		?-(left|right|rotleft|rotright|drop|slide) binding?"
	exit
    }

    proc About {} {
	variable tetris
	tk_messageBox -icon info -title "About Tetris v$tetris(version)" \
		-type ok -message $tetris(info) -parent $tetris(root)
    }
}

proc ParseArgs {} {
    variable tetris
    variable keys
    variable color

    if {$tetris(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 tetris(autoPause)	[regexp -nocase $truth $val] }
	    b*		{ set tetris(blocksize)	$val }
	    color[0-6] {
		if {[regexp {([0-6])} $key junk num]} {
		    set color($num) $val
		}
	    }
	    dr*		{ set keys(Drop)	$val }
	    growi*	{ set tetris(growing)	[regexp -nocase $truth $val] }
	    growl*	{ set tetris(growLevel)	$val }
	    growm*	{ set tetris(growMax)	$val }
	    ma*		{ set tetris(maxInterval)	$val }
	    lef*	{ set keys(Left)	$val }
	    lev*	{ set tetris(initLevel)	$val }
	    ri*		{ set keys(Right)	$val }
	    rotl*	{ set "keys(Rotate Left)"	$val }
	    rotr*	{ set "keys(Rotate Right)"	$val }
	    sha*	{ set tetris(shadow)	[regexp -nocase $truth $val] }
	    sho*	{ set tetris(showNext)	[regexp -nocase $truth $val] }
	    sl*		{ set keys(Slide)	$val }

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

	    help - info - default Usage
	}
    }
}

proc Init {{base {}}} {
    variable tetris
    variable widget
    variable keys
    variable color
    variable games

    set tetris(name) [namespace current]::
    array set tetris {
	blocksize	15
	maxInterval	500
	initLevel	0
	autoPause	0
	showNext	1
	shadow		1
	growing		0
	growLevel	0
	growMax		26
	startRows	0
	game		standard

	highband	1
	multi		1
	port		15141
	con,port	15141
	sockets		0
	sync		0

	maxbrick 0 numplayers 0 deaths 0
	growRows 0 growInterval idle

	info	"(c) Jeffrey Hobbs 1995-2002\njeff@hobbs.org"
    }
    array set color {
	0		\#FF0000
	1		\#00FF00
	2		\#0000FF
	3		\#FFFF00
	4		\#FF00FF
	5		\#00FFFF
	6		\#FFFFFF
    }
    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>
	GameTypes	<Control-g>
	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

    # Do this next, to get the parsed values in
    array set games [list \
	    standard	[list 0 $tetris(showNext) $tetris(shadow) \
	    0 0 $tetris(growMax) 0] \
	    speed	[list 15 1 0 0  0 $tetris(growMax) 0] \
	    row		[list 10 1 1 1 10 10 20] \
	    rowfast	[list 10 1 1 1 10 20 11] \
	    wizard	[list 10 0 0 1 15 20 15] \
	    ]

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

    set bs $tetris(blocksize)
    array set tetris [list root $base base $base host [info hostname] \
	    con,host	[info hostname] myip 127.0.0.1 \
	    width	[expr {10*$bs}] \
	    height	[expr {30*$bs}]]
    if {[string match {} $base]} { set tetris(root) . }

    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 $widget(socks) -sticky news

    canvas $widget(board) -width $tetris(width) -height $tetris(height) \
	    -bg gray
    canvas $widget(shadow) -width $tetris(width) -height $bs \
	    -bg gray

    bind $widget(board) <1> [list focus $widget(board)]

    # 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 "Tetris v$tetris(version)" -relief ridge -bd 2
    label $left.lnext -text "Next Object" -anchor c
    canvas $widget(next) -width [expr {$bs*4+10}] -height [expr {$bs*2+10}]
    button $left.start -textvariable $tetris(name)tetris(start) \
	    -command [namespace code ToggleState]
    button $left.reset -text "Reset" -un 0 -command [namespace code {
	Reset
	if {$tetris(numplayers)} {
	    incr tetris(deaths)
	    TellPlayers update 0 $tetris(maxbrick) $tetris(deaths)
	}
    }
    ]
    button $left.addrow -text "Add Random Row" -underline 0 \
	    -command [namespace code {AddRows 1}]

    if {!$tetris(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 $tetris(name)tetris(autoPause) \
		-command [namespace code AutoPause]

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

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

    checkbutton $left.show -text "Show Next" -anchor w \
	    -variable $tetris(name)tetris(showNext) \
	    -command [namespace code ShowNext]
    checkbutton $left.shadow -text "Shadow Piece" -anchor w \
	    -variable $tetris(name)tetris(shadow) \
	    -command [namespace code Shadow]
    checkbutton $left.grow -text "Growing Rows" -anchor w \
	    -variable $tetris(name)tetris(growing) \
	    -command [namespace code GrowRows]
    label $left.glbl -text "Grow Speed:" -anchor w
    button $left.gup -text "^" -padx 0 -pady 0 -command [namespace code \
	    {set tetris(growLevel) [expr {($tetris(growLevel)+1)%16}]}]
    label $left.gval -textvariable $tetris(name)tetris(growLevel) -anchor e
    label $left.mlbl -text "Grow To Max:" -anchor w
    button $left.mup -text "^" -padx 0 -pady 0 -command [namespace code \
	    {set tetris(growMax) [expr {($tetris(growMax)+1)%27}]}]
    label $left.mval -textvariable $tetris(name)tetris(growMax) -anchor e

    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 $tetris(name)tetris(score) -anchor e
    label $left.vlvl -textvariable $tetris(name)tetris(level) -anchor e
    label $left.vrows -textvariable $tetris(name)tetris(rows) -anchor e
    button $left.ilvl -text "^" -padx 0 -pady 0 -command [namespace code \
	    {SetIntervalLevel [incr tetris(level)]}]

    bind $tetris(root) <<Start>> [list $left.start invoke]
    bind $tetris(root) <<Reset>> [list $left.reset invoke]
    bind $tetris(root) <<AddRow>> [list $left.addrow invoke]
    bind $tetris(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

    if {!$tetris(WWW)} {
	grid $left.opts		- - -sticky new
	grid $left.quit		- - -sticky new
	grid $left.pause	- - -sticky new
    }
    grid $left.show	- - -sticky new
    grid $left.shadow	- - -sticky new
    grid $left.grow	- - -sticky new
    grid $left.glbl $left.gup $left.gval -sticky new
    grid $left.mlbl $left.mup $left.mval -sticky new

    grid configure $left.llvl $left.ilvl $left.gup $left.mup \
	    $left.lrows $left.lscore -sticky nw

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

    ## Don't touch this - the returned canvas id numbers are important
    for {set j 0} {$j < 30} {incr j} {
	for {set i 0} {$i < 10} {incr i} {
	    set x [expr {int(($i+.5)*$bs)}]
	    set y [expr {int(($j+.5)*$bs-1)}]
	    $widget(board) create line $x $y $x [incr y 2] \
		    -tags back -fill $color(0)
	    if {$j == 0} {
		$widget(shadow) create rect [expr {$i*$bs}] 0 \
			[expr {($i+1)*$bs}] $bs -outline {}
	    }
	}
    }
    focus $widget(board)

    Reset
    InitPieces $bs
    if {$tetris(WWW)} {
	Stats
	Keys
    } else {
	wm resizable $tetris(root) 0 0
	wm deiconify $tetris(root)
    }
    AutoPause
    if {!$tetris(WWW) && $tetris(multi)} {
	if {[catch SocketInit msg]} { bgerror $msg }
    }
}

proc SocketInit {} {
    variable tetris
    variable widget

    set port $tetris(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 {$tetris(port)+50}]} {
		set tetris(multi) 0
		return -code error "unable to find available port"
	    }
	} else {
	    set tetris(multi) 0
	    return -code error $msg
	}
    }
    set tetris(port) $port

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

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

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

proc SocketRead {sock} {
    if {[eof $sock] || ([gets $sock line] == -1)} {
	SocketShutdown $sock
	return
    }
    variable tetris
    variable players
    set peer [fconfigure $sock -peer]
    set id "[lindex $peer 0] [lindex $peer 2]"
    ## Line should be of the form:
    ## Tetris<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 {$tetris(sync)} {after 4}
    if {$tetris(sync)} {vwait tetris(sync)}
    switch -exact -- [lindex $line 3] {
	pause {
	    Pause
	    set tetris(message) $line
	}
	start {
	    if {$tetris(break)} {
		Resume
		set tetris(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 tetris(message) [lreplace $line 0 0] }
	goodbye { SocketShutdown $sock }
	default {}
    }
}

proc SocketConnect {host port} {
    variable tetris
    variable players

    set id "(127\.0\.0\.1|$tetris(myip)|$tetris(host)|localhost)"
    if {[regexp "$id $tetris(port)" "$host $port"]} {
	return -code error "don't touch yourself"
    }
    if {[catch {socket -myaddr $tetris(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 tetris
    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) tetris($id,maxbrick)}
    }
    set tetris(numplayers) [llength [array names players *,sock]]

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

proc NewPlayer {sock host ip port} {
    variable tetris
    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 $tetris(name)players($id,maxbrick)
    pack $widget($sock) $w.s -fill y -expand 1
    pack [label $w.l -textvariable $tetris(name)players($id,deaths)] -fill both

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

    UpdatePlayers
}

proc TellPlayers {args} {
    variable tetris
    variable players

    foreach p [array names players *,sock] {
	if {[catch {
	    set msg "Tetris3 $tetris(host) $tetris(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 tetris
    variable widget

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

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

	label $w.conhl -text "New Host:" -anchor w -width 8
	entry $w.conhe -width 12 -textvariable $tetris(name)tetris(con,host)
	label $w.conpl -text "Port:" -anchor w -width 8
	entry $w.conpe -width 8 -textvariable $tetris(name)tetris(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 $tetris(name)tetris(message) \
		-relief ridge -bd 2

	checkbutton $w.high -text "High Bandwidth" \
		-variable $tetris(name)tetris(highband)
	button $w.con -text Connect -command [namespace code {
	    SocketConnect $tetris(con,host) $tetris(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 $tetris(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 SetIntervalLevel {n} {
    variable tetris

    set i [expr {round($tetris(maxInterval)-($tetris(maxInterval)/20*$n))}]
    if {$i<8} { set i 8 }
    set tetris(interval) $i
    set tetris(growInterval) [expr {$tetris(maxInterval) * \
	    (25-$tetris(growLevel))}]
}

proc ToggleState {} {
    variable tetris

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

proc AutoPause {} {
    variable tetris

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

proc Pause {} {
    variable tetris
    variable keys

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

proc Resume {} {
    variable tetris
    variable keys
    variable widget

    set tetris(break) 0
    set tetris(start) "Pause"
    bind $tetris(root) <<Left>>		[namespace code Left]
    bind $tetris(root) <<Right>>	[namespace code Right]
    bind $tetris(root) <<RotateLeft>>	[namespace code {Rotate Left}]
    bind $tetris(root) <<RotateRight>>	[namespace code {Rotate Right}]
    bind $tetris(root) <<Slide>>	[namespace code Slide]
    bind $tetris(root) <<Drop>>		[namespace code Drop]
    focus $widget(board)
    GrowRows
    Fall
}

proc GameOver {} {
    variable tetris
    variable widget

    if {$tetris(numplayers)} {
	Reset
    } else {
	foreach i [after info] { after cancel $i }
	set tetris(break) 1
	set tetris(start) "Game Over"
	$widget(board) delete piece
    }
}

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

    Pause
    array set tetris [list start "Start" level $tetris(initLevel) \
	    rows 0 next [random 7] maxbrick 0]
    SetIntervalLevel $tetris(level)
    $widget(board) delete piece struc
    $widget(board) itemconfig back -fill $color([expr {$tetris(level)%7}])
    $widget(next) delete all
    $widget(shadow) dtag shadow
    $widget(shadow) itemconfig all -fill gray
    for {set i -30} {$i < 300} {incr i} { set block($i) 0 }
    for {}          {$i < 310} {incr i} { set block($i) 1 }
    for {set i 0}   {$i < 7}   {incr i} { set stats($i) 0 }
    if {$tetris(startRows)} {
	set i $tetris(startRows)
	while {$i > 4} {
	    AddRows 4
	    # a little anim effect
	    update idletasks
	    incr i -4
	}
	AddRows $i
    }
    if {$tetris(numplayers)} {
	incr tetris(deaths)
	Resume
	TellPlayers update 0 $tetris(maxbrick) $tetris(deaths)
    } else {
	set tetris(score) 0
    }
}

proc Options {} {
    variable tetris
    variable widget

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

    set w $widget(opts)
    if {![winfo exists $w]} {
	toplevel $w
	wm withdraw $w
	wm title $w "Tetris v$tetris(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.games -text "Game Types" -command [namespace code GameTypes]
	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.games -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 $tetris(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 {$tetris(multi)} {
	$w.multi configure -state normal
    }
    if {[string compare normal [wm state $w]]} {
	wm deiconify $w
    } else {
	raise $w
	focus $w
    }
}

proc SetKey {key var} {
    variable keys
    variable tetris

    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 {$tetris(WWW)} {
	focus $tetris(root)
    }
}

proc Keys {} {
    variable tetris
    variable widget
    variable keys

    set w $widget(keys)
    if {![winfo exists $w]} {
	if {$tetris(WWW)} {
	    grid [frame $w] - - - - -sticky new
	} else {
	    toplevel $w
	    wm withdraw $w
	    wm title $w "Tetris v$tetris(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 $tetris(name)keys(Left)
	entry $w.emr -textvariable $tetris(name)keys(Right)
	entry $w.erl -textvariable "$tetris(name)keys(Rotate Left)"
	entry $w.err -textvariable "$tetris(name)keys(Rotate Right)"
	entry $w.esl -textvariable $tetris(name)keys(Slide)
	entry $w.edr -textvariable $tetris(name)keys(Drop)

	bind $w.eml <Any-Key> [namespace code {SetKey %K Left; break}]
	bind $w.emr <Any-Key> [namespace code {SetKey %K 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 {!$tetris(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 $tetris(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

	    frame $w.sep -height 2 -bd 2 -relief ridge
	    button $w.dis -text "Dismiss" -command [list wm withdraw $w]
	    grid $w.sep - - - -sticky ew
	    grid $w.dis - - - -sticky ew -padx 4 -pady 4
	    wm resizable $w 0 0
	    update idletasks
	    set a $tetris(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 {!$tetris(WWW)} {
	if {[string compare normal [wm state $w]]} {
	    wm deiconify $w
	} else {
	    wm withdraw $w
	}
    }
}

proc GameTypes {} {
    variable tetris
    variable widget

    if {$tetris(WWW)} {
	## Use of pre-defined game types is only for
	## non-plugin users.  Takes up too much screen space
	return
    }
    set w $widget(games)
    if {![winfo exists $w]} {
	toplevel $w
	wm withdraw $w
	wm title $w "Tetris v$tetris(version) Game Types"

	label $w.l -justify center \
		-text "Game Types: Can you master them all?"
	frame $w.left

	# the right side is the info box
	text $w.info -width 24 -height 4 -wrap word \
		-yscrollcommand [list $w.sy set]
	scrollbar $w.sy -orient v -takefocus 0 -bd 1 \
		-command [list $w.info yview]

	$w.info insert end \
		"The following games provide different challenges " {} \
		"from the traditional Tetris environment.  " {} \
		"The point, as always, is to play until the " {} \
		"blocks reach the top, but these pre-set " {} \
		"variations offer further (faster?) ways in which " {} \
		"you can meet your doom!"

	grid $w.l - -sticky ew
	grid $w.left $w.info $w.sy -sticky news
	grid rowconfigure $w 1 -weight 1
	grid columnconfigure $w 1 -weight 1

	radiobutton $w.b0 -text "Standard Tetris" -anchor w \
		-variable $tetris(name)tetris(game) -value "standard" \
		-command [namespace code SetGame]
	radiobutton $w.b1 -text "I'm on Speeeeed" -anchor w \
		-variable $tetris(name)tetris(game) -value "speed" \
		-command [namespace code SetGame]
	radiobutton $w.b2 -text "Row, Row, Row your boat" -anchor w \
		-variable $tetris(name)tetris(game) -value "row" \
		-command [namespace code SetGame]
	radiobutton $w.b3 -text "Row faster ..." -anchor w \
		-variable $tetris(name)tetris(game) -value "rowfast" \
		-command [namespace code SetGame]
	radiobutton $w.b4 -text "I'm the Pinball Wizard" -anchor w \
		-variable $tetris(name)tetris(game) -value "wizard" \
		-command [namespace code SetGame]

	grid $w.b0 -in $w.left -stick ew
	grid $w.b1 -in $w.left -stick ew
	grid $w.b2 -in $w.left -stick ew
	grid $w.b3 -in $w.left -stick ew
	grid $w.b4 -in $w.left -stick ew

	frame $w.sep -height 2 -bd 2 -relief ridge
	button $w.b -text "Dismiss" -command [list wm withdraw $w]
	grid $w.sep - -sticky ew
	grid $w.b - -sticky ew -padx 4 -pady 4

	update idletasks
	set a $tetris(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 {[string compare normal [wm state $w]]} {
	wm deiconify $w
    } else {
	wm withdraw $w
    }
}

proc SetGame {{type {}}} {
    variable tetris
    variable games

    if {![string compare {} $type]} {
	set type $tetris(game)
    }
    if {![info exists games($type)]} {
	set type "standard"
    }
    set tetris(game) $type
    foreach {
	tetris(initLevel) tetris(showNext) tetris(shadow)
	tetris(growing) tetris(growMax) tetris(growLevel) tetris(startRows)
    } $games($type) {
	break
    }
    Reset
}

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

    set w $widget(stats)
    if {![winfo exists $w]} {
	if {$tetris(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 "Tetris v$tetris(version) Stats"
	}
	set bs $tetris(blocksize)
	grid [label $w.l -text "Piece Statistics"] -sticky ew
	grid [canvas $w.c -bd 2 -width [expr {$bs*9.5}] \
		-height [expr {$bs*22.5}]] -sticky news
	label $w.c.s -text "Session"
	label $w.c.g -text "Game"
	$w.c create window 5 5 -window $w.c.s -anchor nw
	$w.c create window [expr {7*$bs}] 5 \
		-window $w.c.g -anchor nw
	for {set i 0} {$i < 7} {incr i} {
	    foreach p $pmap($i) {
		$w.c create rectangle [lindex $p 0] [lindex $p 1] \
			[lindex $p 2] [lindex $p 3] -tags "p$i piece"
	    }
	    # Oh my gosh, a cheat!
	    $w.c bind piece <<Cheater>> [namespace code {Cheat %W}]
	    foreach {x0 y0 x y} [$w.c bbox p$i] {set x [expr {int($x-$x0)}]}
	    set y [expr {(3*$i+2)*$bs}]
	    $w.c move p$i [expr {int(($bs*9.5-$x)/2-$x0)}] $y
	    $w.c itemconfig p$i -fill $color($i)
	    label $w.c.g$i -textvariable $tetris(name)stats(g$i) -anchor w
	    $w.c create window [expr {.75*$bs}] $y \
		    -window $w.c.g$i -anchor nw
	    label $w.c.$i -textvariable $tetris(name)stats($i) -anchor w
	    $w.c create window [expr {7.5*$bs}] $y \
		    -window $w.c.$i -anchor nw
	}
	if {$tetris(WWW)} {
	    grid [label $w.about -font fixed -text $tetris(info)] -sticky news
	} else {
	    button $w.b -text "Dismiss" -command [list wm withdraw $w]
	    grid $w.b -sticky ew -padx 4 -pady 4
	    wm resizable $w 0 0
	    update idletasks
	    set a $tetris(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 {!$tetris(WWW)} {
	if {[string compare normal [wm state $w]]} {
	    wm deiconify $w
	} else {
	    wm withdraw $w
	}
    }
}

proc InitPieces size {
    variable stats
    variable pmap

    ## Block
    set pmap(0) "{[expr {4*$size}] 0 [expr {5*$size}] $size 4} \
	    {[expr {5*$size}] 0 [expr {6*$size}] $size 5} \
	    {[expr {4*$size}] $size [expr {5*$size}] [expr {2*$size}] 14} \
	    {[expr {5*$size}] $size [expr {6*$size}] [expr {2*$size}] 15}"
    ## L
    set pmap(1) "{[expr {3*$size}] 0 [expr {4*$size}] $size 3} \
	    {[expr {4*$size}] 0 [expr {5*$size}] $size 4} \
	    {[expr {5*$size}] 0 [expr {6*$size}] $size 5} \
	    {[expr {5*$size}] $size [expr {6*$size}] [expr {2*$size}] 15}"
    ## Mirror L
    set pmap(2) "{[expr {3*$size}] 0 [expr {4*$size}] $size 3} \
	    {[expr {4*$size}] 0 [expr {5*$size}] $size 4} \
	    {[expr {5*$size}] 0 [expr {6*$size}] $size 5} \
	    {[expr {3*$size}] $size [expr {4*$size}] [expr {2*$size}] 13}"
    ## Shift One
    set pmap(3) "{[expr {4*$size}] 0 [expr {5*$size}] $size 4} \
	    {[expr {5*$size}] 0 [expr {6*$size}] $size 5} \
	    {[expr {5*$size}] $size [expr {6*$size}] [expr {2*$size}] 15} \
	    {[expr {6*$size}] $size [expr {7*$size}] [expr {2*$size}] 16}"
    ## Shift Two
    set pmap(4) "{[expr {5*$size}] 0 [expr {6*$size}] $size 5} \
	    {[expr {6*$size}] 0 [expr {7*$size}] $size 6} \
	    {[expr {4*$size}] $size [expr {5*$size}] [expr {2*$size}] 14} \
	    {[expr {5*$size}] $size [expr {6*$size}] [expr {2*$size}] 15}"
    ## Bar
    set pmap(5) "{[expr {3*$size}] 0 [expr {4*$size}] $size 3} \
	    {[expr {4*$size}] 0 [expr {5*$size}] $size 4} \
	    {[expr {5*$size}] 0 [expr {6*$size}] $size 5} \
	    {[expr {6*$size}] 0 [expr {7*$size}] $size 6}"
    ## T
    set pmap(6) "{[expr {4*$size}] 0 [expr {5*$size}] $size 4} \
	    {[expr {5*$size}] 0 [expr {6*$size}] $size 5} \
	    {[expr {6*$size}] 0 [expr {7*$size}] $size 6} \
	    {[expr {5*$size}] $size [expr {6*$size}] [expr {2*$size}] 15}"

    for {set i 0} {$i < 7} {incr i} { array set stats "$i 0 g$i 0" }
}

proc ShowNext {} {
    variable tetris
    variable widget
    variable color

    $widget(next) delete all
    if {$tetris(showNext) && [string compare $tetris(start) "Start"]} {
	variable pmap
	foreach i $pmap($tetris(next)) {
	    $widget(next) create rectangle [lindex $i 0] [lindex $i 1] \
		    [lindex $i 2] [lindex $i 3]
	}
	# 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($tetris(next))
    }
}

proc CreatePiece {} {
    variable tetris
    variable widget
    variable piece
    variable pmap
    variable stats
    variable block
    variable color

    if {$tetris(growRows)} {
	AddRows $tetris(growRows)
	set tetris(growRows) 0
    }
    set p $tetris(next)
    set j 0
    foreach i $pmap($p) {
	if {$block([set piece($j) [lindex $i 4]])} {
	    GameOver
	    return
	}
	set piece(_$j) [$widget(board) create rectangle \
		[lindex $i 0] [lindex $i 1] [lindex $i 2] [lindex $i 3] \
		-tags "p$p piece"]
	incr j
    }
    incr stats($p)
    incr stats(g$p)
    $widget(board) itemconfig p$p -fill $color($p)
    set tetris(next) [random 7]

    ShowNext
    Shadow
}

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

proc Fall {{a {}}} {
    variable tetris

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

proc Shadow {} {
    variable tetris
    variable widget
    variable piece

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

proc GrowRows {{now 0}} {
    variable tetris

    if {$tetris(growing) && !$tetris(break)} {
	if {$now && ($tetris(maxbrick) < $tetris(growMax))} {
	    incr tetris(growRows)
	}
	after $tetris(growInterval) [namespace code {GrowRows 1}]
    }
}

proc CementPiece {} {
    variable tetris
    variable widget
    variable piece
    variable block

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

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

proc Drop {} {
    variable tetris
    variable piece
    variable block
    variable widget

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

proc Left {} {
    variable tetris
    variable piece
    variable block
    variable widget

    if {[string match {} [set ix [$widget(board) bbox piece]]] || \
	    [lindex $ix 0] <= 0} return
    if {
	$block([expr {$piece(0)-1}]) || $block([expr {$piece(1)-1}]) ||
	$block([expr {$piece(2)-1}]) || $block([expr {$piece(3)-1}])
    } {
	return
    } else {
	incr piece(0) -1
	incr piece(1) -1
	incr piece(2) -1
	incr piece(3) -1
	$widget(board) move piece -$tetris(blocksize) 0
	Shadow
	update idletasks
    }
}

proc Right {} {
    variable tetris
    variable piece
    variable block
    variable widget

    if {[string match {} [set ix [$widget(board) bbox piece]]] || \
	    [lindex $ix 2] >= $tetris(width)} return
    if {
	$block([expr {$piece(0)+1}]) || $block([expr {$piece(1)+1}]) ||
	$block([expr {$piece(2)+1}]) || $block([expr {$piece(3)+1}])
    } {
	return
    } else {
	incr piece(0)
	incr piece(1)
	incr piece(2)
	incr piece(3)
	$widget(board) move piece $tetris(blocksize) 0
	Shadow
	update idletasks
    }
}

proc Rotate dir {
    variable tetris
    variable piece
    variable block
    variable widget
    variable coords

    if {[string match {} [set ix [$widget(board) find with piece]]]} return
    foreach {x0 y0 xn yn} [$widget(board) bbox piece] {
	set x [$widget(board) canvasx [expr {($xn+$x0)/2}] $tetris(blocksize)]
	set y [$widget(board) canvasy [expr {($yn+$y0)/2}] $tetris(blocksize)]
    }
    set flag 1
    foreach i $ix {
	set p [$widget(board) coords $i]
	if {[string compare Left $dir]} {
	    set cd "[expr {-[lindex $p 1]+$x+$y}]\
		    [expr { [lindex $p 0]-$x+$y}]\
		    [expr {-[lindex $p 3]+$x+$y}]\
		    [expr { [lindex $p 2]-$x+$y}]"
	} else {
	    set cd "[expr { [lindex $p 1]+$x-$y}]\
		    [expr {-[lindex $p 0]+$x+$y}]\
		    [expr { [lindex $p 3]+$x-$y}]\
		    [expr {-[lindex $p 2]+$x+$y}]"
	}
	if {[string match {} \
		[set n [eval $widget(board) find enclosed $cd]]] || \
		$block([incr n -1])} {
	    set flag 0
	    break
	}
	set m [eval $widget(board) find enclosed $p]
	incr m -1
	array set coords "$m {$i $cd} _$m $n"
    }
    if {$flag} {
	foreach i {0 1 2 3} {
	    eval $widget(board) coords $coords($piece($i))
	    set piece($i) $coords(_$piece($i))
	}
	Shadow
	update idletasks
    }
}

proc DropRows {} {
    variable tetris
    variable block
    variable piece
    variable widget
    variable color

    set full {}
    foreach {i j} [array get piece {[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 tetris(score) [expr {round(pow($i,2))*($tetris(level)+1)}]
	incr tetris(rows)  $i
	incr tetris(maxbrick) -$i
	if {($tetris(rows)/10) > $tetris(level)} {
	    ## Move to the next level
	    incr tetris(level)
	    $widget(board) itemconfig back \
		    -fill $color([expr {$tetris(level)%7}])
	    bell
	    SetIntervalLevel $tetris(level)
	}
	TellPlayers update [incr i -1] $tetris(maxbrick) $tetris(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 $tetris(blocksize)
		$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 {$tetris(highband) && $tetris(numplayers)} {
	TellPlayers brick $tetris(maxbrick)
    }
}

proc AddRows {num} {
    variable tetris
    variable block
    variable widget
    variable piece

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

    ## Move pieces
    set bs $tetris(blocksize)

    ## Check if the piece will be moved off the board, if so, we delete it
    set shift [expr {$num*-$bs}]
    $w move piece 0 $shift
    set y [lindex [$w bbox piece] 1]
    if {![string compare {} $y]} {
	# no piece
    } elseif {$y < -2} {
	$w delete piece
    } else {
	set i [expr {$num*-10}]
	incr piece(0) $i
	incr piece(1) $i
	incr piece(2) $i
	incr piece(3) $i
    }

    $w move struc 0 $shift
    for {set i 0} {$i < 31} {incr i} {
	$w addtag row[expr {$i-$num}] with row$i
	$w dtag row$i
    }
    TellPlayers brick [incr tetris(maxbrick) $num]
    if {$tetris(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
    set numblocks 0
    for {set i [expr {300-$move}]} {$i < 300} {incr i} {
	if {[random]} {
	    set block($i) 1
	    set row [expr {$i/10}]
	    $w create rectangle [expr {($i%10)*$bs}] [expr {$row*$bs}] \
		    [expr {($i%10+1)*$bs}] [expr {($row+1)*$bs}] \
		    -tags "row$row struc" -fill black
	    incr numblocks
	}
	if {$numblocks == 9} {
	    ## jump one block for every nine that we add.
	    ## this ensures that we don't make a whole row of new blocks
	    set numblocks 0
	    incr i
	}
    }
    $w itemconfig struc -stipple gray50
}

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

Init

}; # end namespace Tetris