[BHE] - Tetris in 375 lines.  This was the first game engine I came up with so I'm sure it can be shortened quite a bit more.  No real frills here.  It's almost bug free: there are a few times when a piece is able to overlap an existing one.

I originally added this as an easter egg into a program at work which is why the code footprint is small as well as the game itself, =).  Well, it started off under 100 lines like the other easter eggs ... oh well

'''Controls:'''
   * Left and right arrow keys to move the piece
   * Up to rotate it
   * If you hold down the down arrow, it moves down a tad faster than normal ... this could definately be fixed.
   * Spacebar drops the piece
   * F2 starts a new game

 namespace eval tetris {
    variable grid
    variable run
    variable step 0
    variable level 0
    variable score 0
    variable lines 0
    variable piece
    
    variable blocksize 10
    
    variable pieces
    array set pieces {
       0 {lightblue 4 0 2 2 {1 1 1 1}}
       1 {yellow    4 0 4 3 {0 1 0 0 1 0 0 1 0 0 1 0}}
       2 {purple    4 0 3 3 {0 1 0 1 1 0 1 0 0}}
       3 {green     4 0 3 3 {0 1 0 0 1 1 0 0 1}}
       4 {red       4 0 3 3 {0 1 0 1 1 1 0 0 0}}
       5 {blue      4 0 3 3 {0 0 1 1 1 1 0 0 0}}
       6 {orange    4 0 3 3 {1 0 0 1 1 1 0 0 0}}
    }
    
    proc build {} {
       variable blocksize
       
       wm title . "TinyTetris"
       
       # canvas should be 15x20 blocks
       # the game table is 10x20
       # the right 5 blocks are for the nextpiece
       canvas .c -width [expr {$blocksize*15 + 2}] -height [expr {$blocksize*20 + 2}]
       .c create rectangle 0 0 [expr {$blocksize*10 + 2}] [expr {$blocksize*20 + 2}] -fill black -outline red
       
       label .l1 -text "POINTS" -font {courier 8}
       label .l2 -anchor n -font {courier 8} -textvariable tetris::score
       label .l3 -text "LEVEL" -font {courier 8}
       label .l4 -anchor n -font {courier 8} -textvariable tetris::level
       label .l5 -text "LINES" -font {courier 8}
       label .l6 -anchor n -font {courier 8} -textvariable tetris::lines
       
       grid .l1 .c   -sticky w
       grid .l2 ^    -sticky nw
       grid .l3 ^    -sticky w
       grid .l4 ^    -sticky nw
       grid .l5 ^    -sticky w
       grid .l6 ^    -sticky nw
       
       grid rowconfigure . 1 -weight 1
       grid rowconfigure . 3 -weight 1
       grid rowconfigure . 5 -weight 1
       
       set f [frame .debug]
          label $f.d1 -text "step : "
          label $f.d2 -textvariable tetris::step
          label $f.d3 -text "score: "
          label $f.d4 -textvariable tetris::score
          label $f.d5 -text "piece: "
          label $f.d6 -textvariable tetris::piece
          # etc
          button $f.next -text "next" -command tetris::nextStep
          
          grid $f.d1 $f.d2
          grid $f.d3 $f.d4
          grid $f.d5 $f.d6
          grid $f.next
       
       #pack $f -side top
       
       bind . <Up>    "tetris::rotateCW"
       bind . <Left>  "tetris::move left"
       bind . <Right> "tetris::move right"
       bind . <space> "tetris::drop"
       bind . <Down>  "tetris::nextStep"
       bind . <F2>    "tetris::restart"
       
       restart
    }
    
    proc restart {} {
       clearGrid
       variable run 1
       after 1000 tetris::newPiece
    }
    
    proc endGame {} {
       variable run 0
    }
    
    proc clearGrid {} {
       
       variable lines 0
       variable score 0
       variable step 0
       variable level 0
       variable run 1
       variable nextpiece
       
       variable grid
       foreach i {0 1 2 3 4 5 6 7 8 9} {
          for {set j 0} {$j < 20} {incr j} {
             set grid($i,$j) ""
          }
       }
       .c delete block
       set nextpiece [randomPiece]
       cycle
    }
    
    proc cycle {} {
       
       variable level
       variable run
       
       if {!$run} { return }
       nextStep
       
       set speed [expr {100 - 8*$level}]
       if {$speed < 20} { set speed 20 }
       after $speed tetris::cycle
    }
    
    proc newPiece {} {
       variable piece
       variable nextpiece
       variable step 0
       
       variable blocksize
       
       set piece $nextpiece
       set nextpiece [randomPiece]
       
       if {[checkPiece] == 0} {
          endGame
          return
       }
       drawPiece
       
       .c delete nextpiece
       foreach {color X Y h w piecegrid} $nextpiece {}
       for {set j 0} {$j < $h} {incr j} {
          for {set i 0} {$i < $w} {incr i} {
             if {[lindex $piecegrid [expr {$i + $j*$w}]] != 0} {
                set x [expr {12*$blocksize + $i*$blocksize}]
                set y [expr {3*$blocksize + $j*$blocksize}]
                
                set ID [.c create rectangle $x $y [expr {$x+$blocksize}] [expr {$y+$blocksize}] \
                        -fill $color -outline gray25 -tags {block nextpiece}]
                lset nextpiece 5 [expr {$i + $j*$w}] $ID
             }
          }
       }
    }
    
    proc randomPiece {} {
       variable pieces   
       return $pieces([expr {int(rand()*7)}])
    }
    
    proc checkPiece {} {
       variable piece
       variable grid
       
       foreach {color X Y h w piecegrid} $piece {}
       for {set j 0} {$j < $h} {incr j} {
          for {set i 0} {$i < $w} {incr i} {
             if {[lindex $piecegrid [expr {$i + $j*$w}]] == 0} { continue }
             set x [expr {$X+$i}]
             set y [expr {$Y+$j}]
             if {$x < 0} { return 0 }
             if {$x > 9} { return 0 }
             if {$grid($x,$y) != ""} { return 0 }
          }
       }
       return 1
    }
    
    proc drawPiece {} {
       
       variable grid
       variable piece
       variable step
       variable blocksize
       
       .c delete piece
       
       foreach {color X Y h w piecegrid} $piece {}
       for {set j 0} {$j < $h} {incr j} {
          for {set i 0} {$i < $w} {incr i} {
             if {[lindex $piecegrid [expr {$i + $j*$w}]] != 0} {
                set x [expr {($X+$i)*$blocksize + 1}]
                set y [expr {($Y+$j)*$blocksize}]
                if {[expr {$step%$blocksize}] > 0} {
                   incr y [expr {$step%$blocksize - $blocksize}]
                }
                set ID [.c create rectangle $x $y [expr {$x+$blocksize}] [expr {$y+$blocksize}] \
                        -fill $color -outline gray25 -tags {block piece}]
                lset piece 5 [expr {$i + $j*$w}] $ID
             }
          }
       }
    }
    
    proc rotateCCW {} {
       variable grid
       variable piece
       
       if {$piece == ""} { return }
       set oldpiece $piece
       foreach {color X Y h w piecegrid} $piece {}
       set newgrid $piecegrid
       set s [expr {$h-1}]
       for {set j 0} {$j < $h} {incr j} {
          for {set i 0} {$i < $w} {incr i} {
             set id [lindex $piecegrid [expr {$i + $j*$w}]]
             set p $j
             set q [expr {$s-$i}]
             lset newgrid [expr {$p + $q*$h}] $id
          }
       }
       set piece [list $color $X $Y $w $h $newgrid]
       if {[checkPiece]} {
          drawPiece
       } else {
          set piece $oldpiece
       }
    }
    
    proc rotateCW {} {
       variable grid
       variable piece
       
       if {$piece == ""} { return }
       set oldpiece $piece
       foreach {color X Y h w piecegrid} $piece {}
       set newgrid $piecegrid
       set s [expr {$h-1}]
       for {set j 0} {$j < $h} {incr j} {
          for {set i 0} {$i < $w} {incr i} {
             set id [lindex $piecegrid [expr {$i + $j*$w}]]
             set p [expr {$s-$j}]
             set q $i
             lset newgrid [expr {$p + $q*$h}] $id
          }
       }
       set piece [list $color $X $Y $w $h $newgrid]
       if {[checkPiece]} {
          drawPiece
       } else {
          set piece $oldpiece
       }
    }
    
    proc drop {} {
       variable piece
       while {$piece != ""} { nextStep }
    }
    
    proc move {dir} {
       variable piece
       
       variable blocksize
       
       if {$piece == ""} { return }
       foreach {color X Y h w piecegrid} $piece {}
       switch $dir {
          left { set dx -1 }
          right { set dx 1 }
       }
       lset piece 1 [expr {$X + $dx}]
       if {[checkPiece] == 0} {
          lset piece 1 $X
          return
       }
       .c move piece [expr {$dx*$blocksize}] 0
    }
    
    proc nextStep {} {
       variable step
       
       variable piece
       variable grid
       variable blocksize
       
       if {$piece == ""} { return }
       foreach {color X Y h w piecegrid} $piece {}
       
       incr step
       .c move piece 0 1
       set offset [expr {$step%$blocksize}]
       if {$offset == 1} { lset piece 2 [incr Y] }
       if {$offset != 0} {
          return
       }
       
       # foreach block in piece
       #  if Y+1 is a block, call finish
       #  else incr Y
       for {set i 0} {$i < $w} {incr i} {
          for {set j [expr {$h-1}]} {$j >= 0} {incr j -1} {
             if {[lindex $piecegrid [expr {$i + $j*$w}]] != 0} {
                set x [expr {$X+$i}]
                set y [expr {$Y+$j+1}]
                if {$y == 20 || $grid($x,$y) != ""} {
                   finishPiece
                   return
                }
                break
             }
          }
       }
    }
    
    proc finishPiece {} {
       variable grid
       variable piece
       
       variable level
       variable score
       variable lines
       
       foreach {color X Y h w piecegrid} $piece {}
       for {set j 0} {$j < $h} {incr j} {
          for {set i 0} {$i < $w} {incr i} {
             set id [lindex $piecegrid [expr {$i + $j*$w}]]
             if {$id != 0} {
                set grid([expr {$X+$i}],[expr {$Y+$j}]) $id
             }
          }
       }
       .c itemconfig piece -tags {block}
       set nlines 0
       for {set y $Y} {$y < [expr {$Y+$h}]} {incr y} {
          incr nlines [checkLine $y]
       }
       
       incr score [expr {($level+1)*[lindex {0 40 100 300 1200} $nlines]}]
       incr lines $nlines
       set level [expr {$lines/10}]
       set piece {}
       after 500 "tetris::newPiece"
    }
    
    proc checkLine {y} {
       variable grid
       
       variable blocksize
       
       if {$y == 20} { return 0 }
       set ids {}
       for {set x 0} {$x < 10} {incr x} {
          lappend ids $grid($x,$y)
          if {$grid($x,$y) == ""} { return 0 }
       }
       
       foreach id $ids { .c delete $id }
       while {$y > 0} {
          for {set x 0} {$x < 10} {incr x} {
             set id $grid($x,[expr {$y-1}])
             set grid($x,$y) $id
             .c move $id 0 $blocksize
          }
          incr y -1
       }
       for {set x 0} {$x < 10} {incr x} {
          set grid($x,0) ""
       }
       
       return 1
    }
 }
 
 tetris::build

----

[Category Games]