[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

If the blocks are too small, change the blocksize (in pixels) variable near the top.  
The whole table will be adjusted.

'''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 definitely 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
----

[uniquename] 2013aug01

Surprisingly good for such a small amount of code. It deserves an image:

[tinyTetris_screenshot_345x423.jpg]

[Category Games]