Version 1 of Rush Hour
Updated 2004-09-14 06:09:35Keith Vetter 2004-09-13 : Rush Hour is a block sliding puzzle originally by Nob Yoshigahara. The board game uses various color cars and the goal is to get the red car out of the traffic jam. In this version, the goal is to get the red block out of the grid.
This version has only 12 levels to play with. There are versions out on the web with thousands of levels available.
##+##########################################################################
#
# Rush Hour -- a sliding block puzzle
# by Keith Vetter, September 2004
#
# http://www.puzzles.com/products/rushhour.htm
package require Tk
set L(1) {{v 2 3 2} {h 3 0 0} {v 2 0 4} {v 3 1 5} {h 3 2 1} \
{v 2 4 0} {h 3 5 1} {h 2 5 4}}
set L(2) {{v 2 3 2} {h 3 0 3} {h 3 2 2} {v 2 2 5} {v 2 3 3} {h 2 4 4}}
set L(3) {{v 2 4 2} {v 2 0 0} {v 2 0 1} {h 2 0 2} {h 2 0 4} {h 3 1 2} \
{v 2 2 0} {h 2 2 1} {v 3 2 3} {h 2 3 4} {h 2 4 0} {h 3 5 3}}
set L(4) {{v 2 3 2} {v 3 0 3} {h 2 0 4} {h 3 2 0} {v 3 1 5} {v 2 3 0} \
{h 2 3 3} {h 3 5 0}}
set L(5) {{v 2 2 2} {v 2 0 1} {h 2 0 2} {h 2 1 2} {v 2 0 4} {v 2 2 3} \
{h 2 3 0} {h 2 3 4} {v 2 4 0} {h 2 4 2} {h 2 5 2} {v 2 4 5}}
set L(6) {{v 2 2 2} {v 2 1 0} {h 2 1 1} {h 2 1 3} {v 2 2 3} {v 3 2 4} \
{h 2 3 0} {h 2 4 2}}
set L(7) {{v 2 3 2} {v 3 0 5} {h 3 2 0} {v 3 2 3} {h 2 3 0} {v 2 4 0} {h 3 5 1}}
set L(8) {{v 2 3 2} {v 2 0 0} {h 3 0 1} {v 2 0 4} {v 2 0 5} {h 2 1 2} \
{v 3 2 3} {h 2 2 4} {h 2 3 0} {v 2 4 0} {v 2 4 1} {h 2 4 4} \
{h 3 5 2}}
set L(9) {{v 2 4 2} {v 2 0 1} {h 3 0 3} {v 2 1 3} {v 3 1 4} {h 2 2 0} \
{v 2 2 5} {v 3 3 0} {h 3 3 1} {h 2 4 3} {v 2 4 5} {h 2 5 3}}
set L(10) {{v 2 3 2} {v 3 0 0} {v 2 0 1} {h 3 0 2} {v 3 0 5} {v 2 1 3} \
{h 2 2 1} {h 3 3 3} {v 2 4 0} {v 2 4 4} {h 2 5 2}}
set L(11) {{v 2 4 2} {v 2 0 0} {h 3 0 3} {v 2 1 3} {h 2 1 4} {h 2 2 4} \
{h 3 3 0} {v 2 3 3} {v 2 3 4} {v 3 3 5} {h 2 4 0} {h 2 5 3}}
set L(12) {{v 2 4 2} {v 3 0 0} {h 3 0 2} {v 2 1 3} {h 2 2 1} {v 2 2 4} \
{v 2 2 5} {h 2 3 0} {h 2 3 2} {v 2 4 3} {h 2 4 4} {h 2 5 4}}
proc Init {} {
set ::G(ccnt) 0
set ::G(banner) ""
array set ::B {w 6 h 6 exit,row 0 exit,col 2 m 20 m2 4 wall 20}
set ::B(w2) [expr {$::B(w) / 2}]
set ::B(h2) [expr {$::B(h) / 2}]
wm title . "Rush Hour"
frame .top -bd 2 -relief raised
button .title -text "Rush Hour" -font {Helvetica 18 bold}
canvas .c -width 400 -height 400 -highlightthickness 0 -bd 2 -relief raised
frame .bot -bd 2 -relief ridge
set ::B(lvls) {}
for {set i 1} {$i <= 12} {incr i} {
set lvl "Level $i "
append lvl [expr {$i < 4 ? "Beginner" : $i < 7 ? "Intermediate" : \
$i < 10 ? "Advanced" : "Expert"}]
lappend ::B(lvls) $lvl
}
eval tk_optionMenu .lvl ::G(who) $::B(lvls)
.lvl configure -font "[font actual [.lvl cget -font]] -weight bold"
trace variable ::G(who) w ChangeLevel
button .next -text "Next Level" -font [.lvl cget -font] -command NextLevel
button .help -text "Help" -font [.lvl cget -font] -command Help
pack .top -side top -fill both
pack .bot -side bottom -fill both
pack .c -side top -fill both -expand 1
pack .title -in .top -side left -expand 1 -pady 10
pack .lvl .next -in .bot -side left -expand 1
pack .help -in .bot -side right -padx 5
bind .c <Configure> {ReCenter %W %h %w}
}
proc ReCenter {W h w} { ;# Called by configure event
set h2 [expr {$h / 2}]
set w2 [expr {$w / 2}]
$W config -scrollregion [list -$w2 -$h2 $w2 $h2]
DrawBoard 1
}
proc ChangeLevel {var1 var2 op} {
if {! [scan $::G(who) "Level %d" lvl]} return
LoadLevel $lvl
}
proc NextLevel {} {
global G B
set n [lsearch $B(lvls) $G(who)]
if {$n == -1} return ;# Not found, shouldn't happen
incr n
if {$n >= [llength $B(lvls)]} {incr n -1} ;# Done them all
set G(who) [lindex $B(lvls) $n] ;# Let trace fire
}
proc LoadLevel {lvl} {
global G L
set G(state) 0 ;# Playing
set G(lvl) $lvl
set G(ccnt) [llength $L($lvl)]
set G(banner) ""
set id 0
foreach car $L($lvl) {
incr id
set G(car,$id) $car
}
DrawBoard
}
proc DrawBoard {{redraw 0}} {
global S B G
.c delete car banner banner2
if {$redraw} {
.c delete all
# Determine size of everything
set dw [expr {([winfo width .c] - 4*$B(m)) / $B(w)}]
set dh [expr {([winfo height .c] - 4*$B(m)) / $B(h)}]
set B(cell) [expr {$dw < $dh ? $dw : $dh}]
# Outer wall coordinates
foreach {t l . .} [GetCellXY 0 0] break
foreach {r b . .} [GetCellXY $B(w) $B(h)] break
foreach {x0 . x1 .} [GetCellXY $B(exit,row) $B(exit,col)] break
incr t -$B(wall) ; incr l -$B(wall)
incr r $B(wall) ; incr b $B(wall)
set xy [list $x0 $t $l $t $l $b $r $b $r $t $x1 $t]
.c create line $xy -width $B(wall) -tag wall -joinstyle miter
.c create line $x0 $t $x1 $t -width $B(wall) -tag wall -fill red
set x [expr {($x0 + $x1) / 2}]
.c create text $x $t -anchor c -tag exit -text EXIT \
-font {Helvetica 8 bold} -fill black
for {set row 0} {$row < $B(h)} {incr row} {
for {set col 0} {$col < $B(w)} {incr col} {
set xy [GetCellXY $row $col]
.c create rect $xy
}
}
}
# Now draw all the cars
for {set id 1} {$id <= $G(ccnt)} {incr id} {
DrawCar $id
}
if {$G(banner) != ""} {
.c create text 0 0 -tag banner -text $G(banner) \
-font {Times 36 bold} -fill white
set xy [.c bbox banner]
.c create rect $xy -tag banner2 -fill black -outline gold -width 4
.c raise banner
}
}
proc GetCellXY {row col} {
global B
set row [expr {$row - $B(h2)}]
set col [expr {$col - $B(w2)}]
set x0 [expr {$col * $B(cell) + $B(m2)}]
set y0 [expr {$row * $B(cell) + $B(m2)}]
set x1 [expr {($col+1) * $B(cell) - $B(m2)}]
set y1 [expr {($row+1) * $B(cell) - $B(m2)}]
return [list $x0 $y0 $x1 $y1]
}
proc GetCellRowCol {x y} {
set row [expr {int(floor($y / $::B(cell)) + $::B(h2))}]
set col [expr {int(floor($x / $::B(cell)) + $::B(w2))}]
return [list $row $col]
}
proc DrawCar {id} {
.c delete car,$id
foreach {dir len row col} $::G(car,$id) break
if {$dir eq "v"} { ;# Get ending cell
set row2 [expr {$row + $len - 1}]
set col2 $col
} else {
set row2 $row
set col2 [expr {$col + $len - 1}]
}
foreach {x0 y0 . .} [GetCellXY $row $col] break ;# Get coords
foreach {. . x1 y1} [GetCellXY $row2 $col2] break
set color [expr {$id == 1 ? "red" : $dir eq "v" ? "blue" : "green"}]
.c create rect $x0 $y0 $x1 $y1 -tag [list car car,$id] -width 5 -fill $color
.c bind car,$id <Button-1> [list BDown $id %x %y]
.c bind car,$id <B1-Motion> [list BMove $id %x %y]
.c bind car,$id <ButtonRelease-1> [list BUp $id %x %y]
}
proc BDown {id x y} {
global CAR G
if {$G(state) != 0} return
unset -nocomplain CAR
set CAR(id) $id
set CAR(x) $x
set CAR(y) $y
foreach {CAR(dir) CAR(len) CAR(row) CAR(col)} $G(car,$id) break
if {$CAR(dir) eq "v"} {
for {set row [expr {$CAR(row)-1}]} {1} {incr row -1} {
if {[WhoIsIn $row $CAR(col)] != 0} break
}
set CAR(row,min) [expr {$row + 1}]
for {set row [expr {$CAR(row)+$CAR(len)}]} {1} {incr row} {
if {[WhoIsIn $row $CAR(col)] != 0} break
}
set CAR(row,max) [expr {$row - 1}]
set CAR(col,min) $CAR(col)
set CAR(col,max) $CAR(col)
} else {
set CAR(row,min) $CAR(row)
set CAR(row,max) $CAR(row)
for {set col [expr {$CAR(col)-1}]} {1} {incr col -1} {
if {[WhoIsIn $CAR(row) $col] != 0} break
}
set CAR(col,min) [expr {$col + 1}]
for {set col [expr {$CAR(col)+$CAR(len)}]} {1} {incr col} {
if {[WhoIsIn $CAR(row) $col] != 0} break
}
set CAR(col,max) [expr {$col - 1}]
}
foreach {x0 y0 . .} [GetCellXY $CAR(row,min) $CAR(col,min)] break
foreach {. . x1 y1} [GetCellXY $CAR(row,max) $CAR(col,max)] break
set CAR(xy) [list $x0 $y0 $x1 $y1]
.c itemconfig car,$id -outline white
}
proc BMove {id x y} {
global CAR
if {$::G(state) != 0} return
foreach {cx0 cy0 cx1 cy1} [.c coords car,$id] break ;# Where we are now
foreach {x0 y0 x1 y1} $CAR(xy) break ;# Limit on motion
set dx [expr {$x - $CAR(x)}]
set dy [expr {$y - $CAR(y)}]
set CAR(x) $x
set CAR(y) $y
if {$CAR(dir) eq "v"} {
set dx 0
if {$cy0 + $dy < $y0 || $cy1 + $dy > $y1} return
} else {
if {$cx0 + $dx < $x0 || $cx1 + $dx > $x1} return
set dy 0
}
.c move car,$id $dx $dy
}
proc BUp {id x y} {
global CAR G B
if {$::G(state) != 0} return
.c itemconfig car,$id -outline black
foreach {cx0 cy0 . .} [.c coords car,$id] break ;# Where we are now
set cx0 [expr {$cx0 + $::B(cell) / 2}]
set cy0 [expr {$cy0 + $::B(cell) / 2}]
foreach {row col} [GetCellRowCol $cx0 $cy0] break
lset G(car,$id) 2 $row
lset G(car,$id) 3 $col
DrawCar $id
if {$id == 1 && $row == $B(exit,row) && $col == $B(exit,col)} {
Win
}
}
proc WhoIsIn {row col} {
if {$row < 0 || $col < 0 || $row >= $::B(w) || $col >= $::B(h)} {return 999}
for {set i 1} {$i <= $::G(ccnt)} {incr i} { ;# Loop through all cars
foreach {dir len r c} $::G(car,$i) break;# Get where the car is
if {$dir eq "v"} {
if {$col != $c} continue
if {$row >= $r && $row < $r + $len} { return $i }
} else {
if {$row != $r} continue
if {$col >= $c && $col < $c + $len} { return $i }
}
}
return 0
}
proc Help {} {
set msg "Rush Hour\nby Keith Vetter, September 2004\n\n"
append msg "Rush Hour is a sliding block puzzle created by\n"
append msg "Nob Yoshigahara, and is known by numerous other names\n"
append msg "such as \"Car Jam\" and \"Traffic Jam\".\n\n"
append msg "The object of the game is to move the red block out of\n"
append msg "the grid but to do so you must move the other blocks out\n"
append msg "the way.\n\n"
tk_messageBox -message $msg -title "Rush Hour Help"
}
proc Win {} {
set ::G(state) 1
set ::G(banner) " You Won! "
DrawBoard
set bg [.c cget -bg]
for {set i 0} {$i < 4} {incr i} {
foreach color [list white $bg] {
.c config -bg $color
update
after 100
}
}
.c bind banner <Button-1> NextLevel
.c bind banner2 <Button-1> NextLevel
}
Init
update
LoadLevel 1