#!/bin/sh
# The next line restarts with tclsh.\
exec tclsh "$0" ${1+"$@"}

# The map consists of room names alternating with lists of exits.
#set map {
#    1 {2 3 4}
#    2 {1 4 5}
#    3 {1}
#    4 {}
#    5 {1}
#}

set map {}
set room_count 9
set probability 0.25
for {set i 1} {$i <= $room_count} {incr i} {
    dict set map $i {}
    for {set j 1} {$j <= $room_count} {incr j} {
        if {$i != $j && rand() < $probability} {
            dict lappend map $i $j
        }
    }
}

# Define the names of the start and end rooms.
set start 1
set end 2

# Start at the start room.
set frontier $start
set paths [dict create $start start]

# Perform a breadth-first traversal of the map.  Record return paths.  Stop when
# the end room is reached or when all reachable rooms have been visited.
while {1} {
    # Check if the frontier has emptied out without having reached the end room.
    if {[llength $frontier] == 0} {
        # If so, signal this failure condition by unsetting $room.
        unset -nocomplain room
        break
    }

    # Take the first room off the beginning of the frontier queue and place it
    # into $room.
    set frontier [lassign $frontier room]

    # Check if this is the end room.
    if {$room eq $end} {
        # Stop if it is.  Leave $room set to signal success.
        break
    }

    # Consider each other room that is adjacent to $room.
    foreach exit [dict get $map $room] {
        # Check if it hasn't already been visited.
        if {![dict exists $paths $exit]} {
            # If not, put it at the end of the frontier queue,
            lappend frontier $exit

            # And add it to the table of return paths.
            dict set paths $exit $room
        }
    }
}

# Check if the search succeeded.
if {[info exists room]} {
    # Backtrack from the end room to the start room.
    set path {}
    while {$room ne "start"} {
        # Add the room to the path.
        lappend path $room

        # Go back to the previous room, towards the start.
        set room [dict get $paths $room]
    }

    # Reverse $path to get the path from start to end.
    set path [lreverse $path]

    # The search succeeded, so print the path.
    puts "Shortest path from $start to $end: $path"
} else {
    # If the search failed, complain.
    puts "There is no path from $start to $end"
}

package require Tk

proc coords {room} {
    set i [lsearch -exact $::rooms $room]
    list [expr {250 + cos($i * acos(-1) * 2 / [llength $::rooms]) * 225}]\
         [expr {250 + sin($i * acos(-1) * 2 / [llength $::rooms]) * 225}]
}

proc node {room args} {
    lassign [coords $room] x y
    .c create oval [expr {$x - 10}] [expr {$y - 10}]\
                   [expr {$x + 10}] [expr {$y + 10}] {*}$args
    .c create text $x $y -text $room
}

proc line {from to args} {
    lassign [coords $from] x0 y0
    lassign [coords $to] x1 y1
    set dx [expr {$x1 - $x0}]
    set dy [expr {$y1 - $y0}]
    set len [expr {hypot($dx, $dy)}]
    set x0 [expr {$x0 + 15 * $dx / $len}]
    set y0 [expr {$y0 + 15 * $dy / $len}]
    set x1 [expr {$x1 - 15 * $dx / $len}]
    set y1 [expr {$y1 - 15 * $dy / $len}]
    .c create line $x0 $y0 $x1 $y1 {*}$args
}

pack [canvas .c -width 500 -height 500]
wm resizable . 0 0
set rooms [lsort [dict keys $map]]
foreach room $rooms {
    if {$room eq $start} {
        set color red
    } elseif {$room eq $end} {
        set color green
    } else {
        set color white
    }
    node $room -fill $color
    foreach exit [dict get $map $room] {
        line $room $exit -arrow last
    }
}

if {[info exists path]} {
    set prev [lindex $path 0]
    foreach room [lrange $path 1 end] {
        line $prev $room -arrow last -width 2 -fill red
        set prev $room
    }
}

# vim: set sts=4 sw=4 tw=80 et ft=tcl: