## tktetris
#
## Copyright (c) 1995 by Jeffrey Hobbs
## Sat Sep 30 14:37:48 PDT 1995
##
## jhobbs@cs.uoregon.edu, http://www.cs.uoregon.edu/~jhobbs/
##
## 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
##
## History of changes at end of file

set tk_strictMotif 1
# wm withdraw .

proc TkTetris_ParseArgs arr {
  upvar $arr a
  global argv
  while {[llength $argv] > 0} {
    switch -glob -- [lindex $argv 0] {
      -a* { set a(autoPause) [lindex $argv 1] }
      -b* { set a(blocksize) [lindex $argv 1] }
      -c* {
	set a(Color[expr [lindex $argv 1]%7]) [lindex $argv 2]
	set argv [lreplace $argv 0 0]
      }
      -dr* { set a(KeyDrop) [lindex $argv 1] }
      -m* { set a(maxInterval) [lindex $argv 1] }
      -l* { set a(KeyMoveLeft) [lindex $argv 1] }
      -ri* { set a(KeyMoveRight) [lindex $argv 1] }
      -rotl* { set a(KeyRotLeft) [lindex $argv 1] }
      -rotr* { set a(KeyRotRight) [lindex $argv 1] }
      -sha* { set a(shadow) [lindex $argv 1] }
      -sho* { set a(showNext) [lindex $argv 1] }
      -sl* { set a(KeySlide) [lindex $argv 1] }
    }
    set argv [lreplace $argv 0 1]
  }
}

proc TkTetris_Init {{root {}}} {
  global TkTetris

  array set TkTetris {
    version		0.97
    blocksize		15
    maxInterval		500
    autoPause		1
    showNext		1
    shadow		1
    KeyMoveLeft		<Key-Left>
    KeyMoveRight	<Key-Right>
    KeyRotLeft		<Key-Up>
    KeyRotRight		<Key-Down>
    KeySlide		<Key-Return>
    KeyDrop		<Key-space>
    Color0		#FF0000
    Color1		#00FF00
    Color2		#0000FF
    Color3		#FFFF00
    Color4		#FF00FF
    Color5		#00FFFF
    Color6		#FFFFFF
  }

  TkTetris_ParseArgs TkTetris

  array set TkTetris "
  root		{$root}
  width		[expr 10*$TkTetris(blocksize)]
  height	[expr 30*$TkTetris(blocksize)]
  "

  pack [frame $root.t -height 20] -side top
  pack [frame $root.l] -side left -fill both -padx 2 -pady 2
  pack [frame $root.r] -side right -fill both -exp 1
  pack [canvas $root.r.c -highlightt 0 -width $TkTetris(width) \
      -height $TkTetris(height) -relief ridge -bd 1 -bg gray]
  pack [canvas $root.r.l -width $TkTetris(width) -height $TkTetris(blocksize) \
      -relief ridge -bd 1 -highlightt 0 -bg gray]

  label $root.l.title -text "TkTetris v$TkTetris(version)" -relief ridge -bd 2
  label $root.l.obj -text "Next Object" -anchor c
  canvas $root.l.next -width [expr $TkTetris(blocksize)*4] \
      -height [expr $TkTetris(blocksize)*4] -highlightthickness 0
  frame $root.l.score
  frame $root.l.level
  frame $root.l.rows
  button $root.l.start -textvar TkTetris(start) \
      -command TkTetris_ToggleState -takefocus 0
  button $root.l.new   -text Reset  -un 0 -command TkTetris_Reset -takefocus 0
#  Toplevels do not currently work in safe interpreters, hence I
#  remove these buttons from the interface.
#
#  button $root.l.about -text About  -un 0 -takefocus 0 -command "tk_dialog \
#      $TkTetris(root).about {About TkTetris v$TkTetris(version)} {\
#      Programmed by Jeffrey Hobbs,\nAugust 1995.\njhobbs@cs.uoregon.edu\
#      \nhttp://www.cs.uoregon.edu/~jhobbs/} questhead 0 OK"
#  button $root.l.stats -text Stats -un 1 -command TkTetris_Stats -takefocus 0

  checkbutton $root.l.pause -text "Auto Pause" -variable TkTetris(autoPause) \
      -anchor w -command TkTetris_AutoPause -takefocus 0
  checkbutton $root.l.show  -text "Show Next"  -variable TkTetris(showNext) \
      -anchor w -takefocus 0 -command {
    if !$TkTetris(showNext) {
      $TkTetris(root).l.next delete all
    } elseif {[string comp $TkTetris(start) Start]} TkTetris_ShowNext
  }
  checkbutton $root.l.shadow -text "Shadow Piece" -variable TkTetris(shadow) \
      -anchor w -takefocus 0 -command {
    if $TkTetris(shadow) {
      if [string comp {} [$TkTetris(root).r.c bbox piece]] TkTetris_Shadow
    } else {$TkTetris(root).r.l itemconfig all -fill gray}
  }

  bind all <Control-r> {$TkTetris(root).l.new invoke}
  bind all <Control-s> {$TkTetris(root).l.start invoke}
  bind all <Control-t> {$TkTetris(root).l.stats invoke}
  bind all <Control-a> {$TkTetris(root).l.about invoke}

  pack $root.l.title $root.l.obj $root.l.next $root.l.score $root.l.level \
      $root.l.rows $root.l.start $root.l.new \
      $root.l.pause $root.l.show $root.l.shadow -fill both

  label $root.l.score.l -text Score: -anchor w
  label $root.l.level.l -text Level: -anchor w
  label $root.l.rows.l -text Rows:   -anchor w
  label $root.l.score.r -textvar TkTetris(score) -anchor e
  label $root.l.level.r -textvar TkTetris(level) -anchor e
  label $root.l.rows.r -textvar TkTetris(rows) -anchor e

  pack $root.l.score.l $root.l.level.l $root.l.rows.l -side left -fill x
  pack $root.l.score.r $root.l.level.r $root.l.rows.r -side right -fill x

  set half [expr round($TkTetris(blocksize)/2)]
  for {set j 0; set jb 0} {$j < 30} {incr j; incr jb $TkTetris(blocksize)} {
    for {set i 0; set ib 0} {$i < 10} {incr ib $TkTetris(blocksize); incr i} {
      set x [expr $ib+$half]
      set y [expr $jb+$half]
      $TkTetris(root).r.c create line $x $y [incr x] [incr y] \
	  -tags back -fill $TkTetris(Color0)
      if {$j == 0} {
	$TkTetris(root).r.l create rect $ib 0 \
	    [expr $ib+$TkTetris(blocksize)] $TkTetris(blocksize) -outline {}
      }
    }
  }

  TkTetris_Reset
  TkTetris_InitPieces $TkTetris(blocksize)
  TkTetris_AutoPause
}


proc TkTetris_ToggleState {} {
  global TkTetris

  if {$TkTetris(start) == "Pause"} {
    TkTetris_Pause
  } elseif {$TkTetris(start) == "Game Over"} {
    TkTetris_Reset
  } else {
    TkTetris_Resume
  }
}


proc TkTetris_AutoPause {} {
  global TkTetris

  if {$TkTetris(autoPause)} {
    bind . <Unmap>    {if {$TkTetris(start) == "Pause"} TkTetris_Pause}
    bind . <Map>      {if {$TkTetris(start) == "Resume"} TkTetris_Resume}
#    bind . <FocusOut> {if {"%d" == "NotifyAncestor" && \
#	$TkTetris(start) == "Pause"} TkTetris_Pause}
#    bind . <FocusIn>  {if {"%d" == "NotifyAncestor" && \
#	$TkTetris(start) == "Resume"} TkTetris_Resume}
  } else {
    foreach i {Unmap Map FocusOut FocusIn} { bind . <$i> {} }
  }
}


proc TkTetris_Pause {} {
  global TkTetris

  set TkTetris(break) 1
  catch {eval after cancel [after info]}
  set TkTetris(start) Resume
  foreach name [array names TkTetris Key*] {bind all $TkTetris($name) {}}
}


proc TkTetris_Resume {} {
  global TkTetris

  set TkTetris(break) 0
  set TkTetris(start) Pause
  bind all $TkTetris(KeyMoveLeft)	TkTetris_Left
  bind all $TkTetris(KeyMoveRight)	TkTetris_Right
  bind all $TkTetris(KeyRotLeft)	{TkTetris_Rotate left}
  bind all $TkTetris(KeyRotRight)	{TkTetris_Rotate right}
  bind all $TkTetris(KeySlide)		TkTetris_Slide
  bind all $TkTetris(KeyDrop)		TkTetris_Drop
  TkTetris_Fall
}

proc TkTetris_Reset {} {
  global TkTetris TkTetrisBlock TkTetrisStats

  TkTetris_Pause
  set TkTetris(start) Start
  set TkTetris(score) 0; set TkTetris(level) 0;
  set TkTetris(rows) 0; set TkTetris(next) [random 7];
  set TkTetris(interval) $TkTetris(maxInterval)
  $TkTetris(root).r.c delete piece struc
  $TkTetris(root).l.next delete all
  $TkTetris(root).r.l dtag shadow
  $TkTetris(root).r.l itemconfig all -fill gray
  for {set i -10} {$i < 300} {incr i} { set TkTetrisBlock($i) 0 }
  for {}          {$i < 310} {incr i} { set TkTetrisBlock($i) 1 }
  for {set i 0}   {$i < 7}   {incr i} { set TkTetrisStats($i) 0 }
}

proc TkTetris_Stats {} {
  global TkTetrisStats TkTetris TkTetrisPmap

  if ![winfo exists $TkTetris(root).stats] {
    toplevel $TkTetris(root).stats
    wm withdraw $TkTetris(root).stats
    wm title $TkTetris(root).stats "TkTetris v$TkTetris(version) Stats"
    pack [canvas $TkTetris(root).stats.c -relief sunken -bd 2 \
	-width [expr $TkTetris(blocksize)*9.5] \
	-height [expr $TkTetris(blocksize)*22.5]]
    label $TkTetris(root).stats.c.s -text "Session"
    label $TkTetris(root).stats.c.g -text "Game"
    $TkTetris(root).stats.c create window 5 5 \
	-window $TkTetris(root).stats.c.s -anchor nw
    $TkTetris(root).stats.c create window [expr 7*$TkTetris(blocksize)] 5 \
	-window $TkTetris(root).stats.c.g -anchor nw
    for {set i 0} {$i < 7} {incr i} {
      foreach p $TkTetrisPmap($i) {
	$TkTetris(root).stats.c create rectangle [lindex $p 0] [lindex $p 1] \
	    [lindex $p 2] [lindex $p 3] -tags "p$i"
      }
      set y [expr (3*$i+2)*$TkTetris(blocksize)]
      $TkTetris(root).stats.c move p$i 0 $y
      $TkTetris(root).stats.c itemconfig p$i -fill $TkTetris(Color$i)
      label $TkTetris(root).stats.c.g$i -textvar TkTetrisStats(g$i) -anchor w
      $TkTetris(root).stats.c create window $TkTetris(blocksize) $y \
	  -window $TkTetris(root).stats.c.g$i -anchor nw
      label $TkTetris(root).stats.c.$i -textvar TkTetrisStats($i) -anchor w
      $TkTetris(root).stats.c create window [expr 8*$TkTetris(blocksize)] $y \
	  -window $TkTetris(root).stats.c.$i -anchor nw
    }
    button $TkTetris(root).stats.b -text "Dismiss" \
	-com "wm withdraw $TkTetris(root).stats"
    pack $TkTetris(root).stats.b -fill both
    catch "wm resizable $TkTetris(root).stats 0 0"
    update
    wm transient $TkTetris(root).stats $TkTetris(root)
  }
  if {[wm state $TkTetris(root).stats] != "normal"} {
    wm deiconify $TkTetris(root).stats
  } else { wm withdraw $TkTetris(root).stats }
}

proc TkTetris_InitPieces size {
  global TkTetrisStats TkTetrisPmap
  ## Block
  set TkTetrisPmap(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 TkTetrisPmap(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 TkTetrisPmap(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 TkTetrisPmap(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 TkTetrisPmap(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 TkTetrisPmap(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 TkTetrisPmap(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} {
    set TkTetrisStats($i)	0
    set TkTetrisStats(g$i)	0
  }
}

proc TkTetris_ShowNext {} {
  global TkTetris TkTetrisPmap

  $TkTetris(root).l.next delete all
  foreach i $TkTetrisPmap($TkTetris(next)) {
    $TkTetris(root).l.next create rectangle [lindex $i 0] [lindex $i 1] \
	[lindex $i 2] [lindex $i 3]
  }
  $TkTetris(root).l.next move all -$TkTetris(blocksize) 0
  $TkTetris(root).l.next move all -$TkTetris(blocksize) 0
  $TkTetris(root).l.next itemconfig all -fill $TkTetris(Color$TkTetris(next))
}

proc TkTetris_CreatePiece {} {
  global TkTetrisPiece TkTetrisPmap TkTetris TkTetrisStats TkTetrisBlock

  set p $TkTetris(next)
  set j 0
  foreach i $TkTetrisPmap($p) {
    if $TkTetrisBlock([set TkTetrisPiece($j) [lindex $i 4]]) {
      set TkTetris(break) 1
      set TkTetris(start) "Game Over"
      $TkTetris(root).r.c delete piece
      return
    }
    set TkTetrisPiece(_$j) [$TkTetris(root).r.c create rectangle \
	[lindex $i 0] [lindex $i 1] [lindex $i 2] [lindex $i 3] \
	-tags "p$p piece"]
    incr j
  }
  incr TkTetrisStats($p)
  incr TkTetrisStats(g$p)
  $TkTetris(root).r.c itemconfig p$p -fill $TkTetris(Color$p)
  set TkTetris(next) [random 7]

  if $TkTetris(showNext) TkTetris_ShowNext
  TkTetris_Shadow
}

proc TkTetris_Fall {} {
  global TkTetris

  if !$TkTetris(break) {
    TkTetris_Slide
    after $TkTetris(interval) TkTetris_Fall
  }
}

proc TkTetris_Shadow {} {
  global TkTetrisPiece TkTetris

  if $TkTetris(shadow) {
    $TkTetris(root).r.l dtag shadow
    $TkTetris(root).r.l itemconfig all -fill gray
    $TkTetris(root).r.l addtag shadow withtag [expr $TkTetrisPiece(0)%10+1]
    $TkTetris(root).r.l addtag shadow withtag [expr $TkTetrisPiece(1)%10+1]
    $TkTetris(root).r.l addtag shadow withtag [expr $TkTetrisPiece(2)%10+1]
    $TkTetris(root).r.l addtag shadow withtag [expr $TkTetrisPiece(3)%10+1]
    $TkTetris(root).r.l itemconfig shadow -fill black
  }
}

proc TkTetris_CementPiece {} {
  global TkTetrisBlock TkTetrisPiece TkTetris

  foreach i {0 1 2 3} {
    set TkTetrisBlock($TkTetrisPiece($i)) 1
    $TkTetris(root).r.c addtag "row[expr $TkTetrisPiece($i)/10]" \
	withtag $TkTetrisPiece(_$i)
  }
  $TkTetris(root).r.c addtag struc withtag piece
  $TkTetris(root).r.c itemconfig struc -stipple gray50
  $TkTetris(root).r.c dtag piece
  incr TkTetris(score) 5
  TkTetris_CheckRows
}

proc TkTetris_Slide {} {
  global TkTetris TkTetrisPiece TkTetrisBlock
  
  if {[set ix [$TkTetris(root).r.c bbox piece]] == ""} {
    TkTetris_CreatePiece
  } else {
    if {$TkTetrisBlock([expr $TkTetrisPiece(0)+10]) || \
	$TkTetrisBlock([expr $TkTetrisPiece(1)+10]) || \
	$TkTetrisBlock([expr $TkTetrisPiece(2)+10]) || \
	$TkTetrisBlock([expr $TkTetrisPiece(3)+10])} {
      TkTetris_CementPiece
      update idletasks
    } else {
      incr TkTetrisPiece(0) 10
      incr TkTetrisPiece(1) 10
      incr TkTetrisPiece(2) 10
      incr TkTetrisPiece(3) 10
      $TkTetris(root).r.c move piece 0 $TkTetris(blocksize)
    }
  }
}

proc TkTetris_Drop {} {
  global TkTetris TkTetrisPiece TkTetrisBlock

  if {[set ix [$TkTetris(root).r.c bbox piece]] == {}} return
  while {1} {
    if {$TkTetrisBlock([expr $TkTetrisPiece(0)+10]) || \
	$TkTetrisBlock([expr $TkTetrisPiece(1)+10]) || \
	$TkTetrisBlock([expr $TkTetrisPiece(2)+10]) || \
	$TkTetrisBlock([expr $TkTetrisPiece(3)+10])} {
      TkTetris_CementPiece
      update idletasks
      break
    } else {
      incr TkTetrisPiece(0) 10
      incr TkTetrisPiece(1) 10
      incr TkTetrisPiece(2) 10
      incr TkTetrisPiece(3) 10
      $TkTetris(root).r.c move piece 0 $TkTetris(blocksize)
    }
  }
}

proc TkTetris_Left {} {
  global TkTetris TkTetrisPiece TkTetrisBlock

  if {[set ix [$TkTetris(root).r.c bbox piece]] == {} || \
      [lindex $ix 0] <= 0} return
  if {$TkTetrisBlock([expr $TkTetrisPiece(0)-1]) || \
      $TkTetrisBlock([expr $TkTetrisPiece(1)-1]) || \
      $TkTetrisBlock([expr $TkTetrisPiece(2)-1]) || \
      $TkTetrisBlock([expr $TkTetrisPiece(3)-1])} {
    return
  } else {
    incr TkTetrisPiece(0) -1
    incr TkTetrisPiece(1) -1
    incr TkTetrisPiece(2) -1
    incr TkTetrisPiece(3) -1
    $TkTetris(root).r.c move piece -$TkTetris(blocksize) 0
    TkTetris_Shadow
    update idletasks
  }
}

proc TkTetris_Right {} {
  global TkTetris TkTetrisPiece TkTetrisBlock

  if {[set ix [$TkTetris(root).r.c bbox piece]] == {} || \
      [lindex $ix 2] >= $TkTetris(width)} return
  if {$TkTetrisBlock([expr $TkTetrisPiece(0)+1]) || \
      $TkTetrisBlock([expr $TkTetrisPiece(1)+1]) || \
      $TkTetrisBlock([expr $TkTetrisPiece(2)+1]) || \
      $TkTetrisBlock([expr $TkTetrisPiece(3)+1])} {
    return
  } else {
    incr TkTetrisPiece(0)
    incr TkTetrisPiece(1)
    incr TkTetrisPiece(2)
    incr TkTetrisPiece(3)
    $TkTetris(root).r.c move piece $TkTetris(blocksize) 0
    TkTetris_Shadow
    update idletasks
  }
}

proc TkTetris_Rotate dir {
  global TkTetris TkTetrisPiece TkTetrisBlock

  if {[set ix [$TkTetris(root).r.c find withtag piece]] == {}} return
  set m [$TkTetris(root).r.c bbox piece]
  scan [$TkTetris(root).r.c canvasx [expr ([lindex $m 2]+[lindex $m 0])/2] \
      $TkTetris(blocksize)] "%d" x
  scan [$TkTetris(root).r.c canvasx [expr ([lindex $m 3]+[lindex $m 1])/2] \
      $TkTetris(blocksize)] "%d" y
  set flag 1
  foreach i $ix {
    set p [$TkTetris(root).r.c coords $i]
    if {[string compare $dir left]} {
      set coord "[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 coord "[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 {[set n [eval $TkTetris(root).r.c find enclosed $coord]] == {} || \
	$TkTetrisBlock([incr n -1])} {
      set flag 0
      break
    }
    set m [eval $TkTetris(root).r.c find enclosed $p]
    incr m -1
    set coords($m) "$i $coord"
    set coords(_$m) $n
  }
  if $flag {
    foreach i {0 1 2 3} {
      eval $TkTetris(root).r.c coords $coords($TkTetrisPiece($i))
      set TkTetrisPiece($i) $coords(_$TkTetrisPiece($i))
    }
    TkTetris_Shadow
    update idletasks
  }
}

proc TkTetris_CheckRows {} {
  global TkTetrisBlock
  set full {}
  for {set i 1} {$i < 30} {incr i} {
    if {$TkTetrisBlock(${i}0) && $TkTetrisBlock(${i}1) && \
	$TkTetrisBlock(${i}2) && $TkTetrisBlock(${i}3) && \
	$TkTetrisBlock(${i}4) && $TkTetrisBlock(${i}5) && \
	$TkTetrisBlock(${i}6) && $TkTetrisBlock(${i}7) && \
	$TkTetrisBlock(${i}8) && $TkTetrisBlock(${i}9)} {
      lappend full $i
      set TkTetrisBlock(${i}0) 0
      set TkTetrisBlock(${i}1) 0
      set TkTetrisBlock(${i}2) 0
      set TkTetrisBlock(${i}3) 0
      set TkTetrisBlock(${i}4) 0
      set TkTetrisBlock(${i}5) 0
      set TkTetrisBlock(${i}6) 0
      set TkTetrisBlock(${i}7) 0
      set TkTetrisBlock(${i}8) 0
      set TkTetrisBlock(${i}9) 0
    }
  }
  if {[set i [llength $full]] > 0} {
    global TkTetris
    incr TkTetris(score) [expr round(pow($i,2))*($TkTetris(level)+1)]
    incr TkTetris(rows)  $i
    if {[expr $TkTetris(rows)/10] > $TkTetris(level)} {
      incr TkTetris(level)
      $TkTetris(root).r.c itemconfig back \
	  -fill $TkTetris(Color[expr $TkTetris(level)%7])
      catch {bell}
      set TkTetris(interval) [expr round($TkTetris(maxInterval) \
	  - ($TkTetris(maxInterval)/20*$TkTetris(level)))]
    }

    foreach row $full {
      $TkTetris(root).r.c delete row$row
      for {set i $row; incr i -1} {$i > 0} {incr i -1} {
	$TkTetris(root).r.c move row$i 0 $TkTetris(blocksize)
	$TkTetris(root).r.c addtag row[expr $i+1] withtag row$i
	$TkTetris(root).r.c dtag row$i
      }
      update idletasks
      for {set i ${row}0} {$i > 0} {incr i -1} {
	if $TkTetrisBlock($i) {
	  set TkTetrisBlock([expr $i+10]) 1
	  set TkTetrisBlock($i) 0
	}
      }
    }
    update
  }
}

set _ran [pid]
proc random {range} {
  global _ran
  set _ran [expr ($_ran * 9301 + 49297) % 233280]
  return [expr int($range * ($_ran / double(233280)))]
}

TkTetris_Init
#wm deiconify .
#catch "wm resizable . 0 0"

return