[Keith Vetter] 2004-09-13 : Rush Hour is a block sliding puzzle originally by
Nob Yoshigahara [http://www.puzzles.com/products/rushhour.htm]. 
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.

[http://mini.net/files/rushhour.gif]

This version has only 12 levels to play with. There are versions out on
the web with thousands of levels available.

[AK]:
   1. This needs a reset button, to get to the starting position if you have jammed yourself into a corner.
   1. We might also wish to ask the referenced site to add a link to this implementation, with image. They already link to many other implementations.
   1. These thousands of levels, do they use a common data format ? Something we can write a reader for ? Maybe some hardwired urls where to find them, with automatic download ?

[KPV] Okay, I've added a reset button (although the functionality was already there if you
set the level back to itself) and I've emailed off to the main Rush Hour page asking for a link.

As to the 15,000 levels, I started to look into this but decided to go to bed instead. Here's
what I found out: there's a Gnome version of this game called gtraffic [http://linux.tucows.com/preview/58021.html] for which someone wrote a level generator called gtlevel [http://alpha.luc.ac.be/Research/Algebra/Members/Gtlevel/gtlevel.html]. There's also
an existing tcl version of this game [http://alpha.luc.ac.be/Research/Algebra/Members/Ttraffic/ttraffic.html] that comes with 15,000 levels built by gtlevel but in a proprietary binary format. I was trying to decipher this convoluted format when I decided to give up and go to bed.

If anyone wants to help decipher them, I'll be willing to set up some kind of automatic
download or whatever.

[AK]: Thanks for the Reset button, and for submitting the link. The other way of getting the reset, well, I never thought of that. I also know a version of Traffic for my Palm pilot, however the levels seem to be hardwired into the app, maybe a resource. As for the TTraffic binary file ... The application code is open, so it should be possible to determine the format by looking at this code. To avoid the GPL trap we would however have to document the format first, and then write our own reader, completely independent. ... Ok, I thought about using gtlevel directly, but it seems to be by the same person, and uses the same data format. :( Which means that this is also the data format of gtraffic. On the other hand, you can tell to generate only one level. Together with looking what [[gt]]traffic makes of it this will also help in deciphering the format ... Ok, enough with the random musings and ramblings. I might have a go and looking at the ttraffic code, or not. Thanks Keith, for this nice little gem/game.

[AK]: Found a bit more, after reading the gtlevel README. It seems that it is able to generate ASCII levels as well. And there is a wee bit documentation for the gtraffic level format in the gtlevel distribution as well.

----
See also [Rush Hour (PocketPC)]
----
 ##+##########################################################################
 #
 # Rush Hour -- a sliding block puzzle
 # by Keith Vetter, September 2004
 #
 # http://www.puzzles.com/products/rushhour.htm
 # gtlevel: http://alpha.luc.ac.be/Research/Algebra/Members/Gtlevel/gtlevel.html
 # 
 
 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
    option add *Button.font [.lvl cget -font]
    
    button .reset -text "Reset" -command LoadLevel
    button .next -text "Next Level" -command NextLevel
    button .help -text "Help" -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 .reset .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
 
    if {$lvl == {}} {set lvl $G(lvl)}
    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 \
            -capstyle butt
        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

----

[Category Games] | [Category Application] | [Tcl/Tk Games]