# Some GUI stuff (canvas and buttons)

package require Tk
canvas .c -width 600 -height 500 -background white
grid .c -row 0 -column 0 -columnspan 3
button .bfs -text "BFS" -command {enable 0; bfs 0; enable 1}
button .rst -text "Reset" -command {reset}
button .dfs -text "DFS" -command {enable 0; dfs 0; enable 1}
grid .bfs .rst .dfs -row 1


# I used an array for storing vertices and another array for storing edges.

# I keep x,y positions inside the vertices array, just a sa convenience (I'm thinking of doing another demo on weighted graphs, and the position could be used to automatically calculate the weight across nodes)

# the edges are stored in the array, as a unique key $a:$b where $a and $b are the vertex identifiers

# the addEdge proc can make both directed and undirected edges, and accepts a weight argument (if 'auto' it will compute the weight from $x,$y position of the vertex

proc addVertex {x y} {
    if {![info exists ::seq]} {set ::seq 0}
    set ::vertex($::seq) [list $x $y]
    set r 9
    .c create oval \
        [expr {$x-$r}] [expr {$y-$r}] \
        [expr {$x+$r}] [expr {$y+$r}] \
        -fill green -outline black \
        -tags [list vertex vertex:$::seq]
    .c create text $x $y -text [expr {1+$::seq}] \
        -tags [list vertex_id vertex_id:$::seq]
    return [expr {[incr ::seq]-1}]
}
 
proc addEdge {a b {bidi 1} {weight auto}} {
    if {$a == $b} {return}
    set dx [expr {[lindex $::vertex($b) 0]-[lindex $::vertex($a) 0]}]
    set dy [expr {[lindex $::vertex($b) 1]-[lindex $::vertex($a) 1]}]
    set ::edge($a:$b) $weight
    if $bidi {set ::edge($b:$a) $weight}
    .c create line \
        [lindex $::vertex($a) 0] [lindex $::vertex($a) 1] \
        [lindex $::vertex($b) 0] [lindex $::vertex($b) 1] \
        -fill gray
    .c raise vertex
    .c raise vertex_id
    if {$weight == "auto"} {
        set weight [expr {sqrt($dx*$dx+$dy*$dy)}]
    } elseif {$weight == 0} {
        return
    }
    .c create text \
        [expr {[lindex $::vertex($a) 0]+$dx/2}] \
        [expr {[lindex $::vertex($a) 1]+$dy/2}] \
        -text [expr {int($weight)}]
}

# getting the adjacent vertices (very easy). note that I preprocess the results by splitting on the ':' character used in the array key

proc adj v {
    set r {}
    foreach v [array names ::edge $v:*] {lappend r [lindex [split $v :] 1]}
    return $r
}

# the BFS is non-recursive, and uses a queue (implemented with plain lists) to store the vertices to visit:

proc bfs {s {v {}}} {
    variable busy
    set bfsseq 0

    if {$s != {}} {
        set pop [lindex $s 0]
        set s [lrange $s 1 end]

        foreach adj [adj $pop] {
            if {[lsearch -exact $v $adj] < 0} {
                lappend s $adj
            }
        }

        if {[lsearch -exact $v $pop] < 0} {
            lappend v $pop
            visit $pop [incr bfsseq]
            set wait 400
        } else {
            set wait 0
        }
        set busy [after $wait [list after idle [list [namespace current]::bfs $s $v]]]
    }
}

# also the DFS is non-recursive, but uses a stack (also implemented with plain lists) to store vertices to visit

proc dfs {s {v {}}} {
    variable busy
    set dfsseq 0

    if {$s != {}} {
        set pop [lindex $s 0]
        set s [lrange $s 1 end]

        foreach adj [adj $pop] {
            if {[lsearch -exact $v $adj] < 0} {
                set s [linsert $s 0 $adj]
            }
        }

        if {[lsearch -exact $v $pop] < 0} {
            lappend v $pop
            visit $pop [incr dfsseq]
            set wait 400
        } else {
            set wait 0
        }
        set busy [after $wait [list after idle [list [namespace current]::dfs $s $v]]]
    }
}

# the visit consists of just visually marking the vertex, and showing the time of visit (sequential number)

proc visit {s seq} {
    .c itemconfigure vertex:$s -fill black
    .c itemconfigure vertex_id:$s -fill white
    .c create text \
        [expr {10+[lindex $::vertex($s) 0]}] [lindex $::vertex($s) 1] \
        -text $seq -fill blue -anchor w -tags visit
}

# other GUI stuff follows:

proc reset {} {
    variable busy
    after cancel $busy
    .c delete visit
    .c itemconfigure vertex -fill green
    .c itemconfigure vertex_id -fill black
}

proc enable {b} {
    if $b {set b active} {set b disabled}
    foreach w {.bfs .dfs .rst} {$w configure -state $b}
}

proc initGraph {x y} {
    set Q 150 ; set off 0
    for {set h 0} {$h < 3} {incr h} {
        set t [expr {$h*atan(1)*8.0/3}]
        set xx [expr {$x+cos($t+atan(1)*6)*$Q}]
        set yy [expr {$y+sin($t+atan(1)*6)*$Q}]
        set R {25 50 80 120} ; set O {0.5 0.5 1.5 1.5}
        for {set n 0} {$n < [llength $R]} {incr n} {
            set r [lindex $R $n] ; set o [lindex $O $n]
            for {set i 0} {$i < 5} {incr i} {
                set t [expr {$i*atan(1)*8.0/5}]
                set xxx [expr {$xx+cos($t+atan(1)*$o*4)*$r}]
                set yyy [expr {$yy+sin($t+atan(1)*$o*4)*$r}]
                addVertex $xxx $yyy
            }
        }
        for {set j 0} {$j < 5} {incr j} {
            foreach {z1 z2 w} {0 0 1 0 5 0 10 15 0 15 15 1 5 10 3 5 10 2} {
                addEdge [expr {$z1+$off+$j}] [expr {$z2+$off+($j+$w)%5}] 1 0
            }
        }
        incr off 20
    }
    addEdge 19 55 1 0 ; addEdge 16 35 1 0
}

initGraph 300 290