Version 7 of TinyTetris
Updated 2013-08-02 06:45:10 by uniquenameBHE - 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::builduniquename 2013aug01
Surprisingly good for such a small amount of code. It deserves an image:
