[Keith Vetter] 2008-04-29 - Here's an enhancement to my recent
[Tk Robots] game. The main difference is a new type of robot,
which I'm calling an alien, which moves twice as fast as a 
normal robot.

New Features in 2.0:
   * faster alien robots
   * 5 levels of difficulty
   * show safe moves mode
   * high scores saved and displayed (see [High Score Package])
   * 6 new human character images
----
======
##+##########################################################################
#
# robots2.tcl -- Plays the old Unix game Robots w/ some new features
# by Keith Vetter, April 2008
#
# New Features:
#  o twice as fast robots (aliens)
#  o 5 levels of difficulty
#  o show safe mode
#  o high scores
#  o 6 new human images

package require Tk 8.5
#package require highscore (included in this source)

set S(title) "Tk Robots2"
set S(clrs) {\#7590AE \#5d738b}
set S(delay,dead) 2000
set S(delay,high) 500
set S(delay,round) 1000
set S(delay,splat) 1000
set S(delay,wait) 200
set S(w,org) 35
set S(h,org) 25
set S(maxSafe) 10
set S(score,A) 20
set S(score,R) 10

# TYPE: robots aliens canPush safeTeleports canSafeteleport
array set T {
    "Classic" {10 0 0 0 0}
    "Safe Classic" {10 0 1 3 1}
    "Robots2" {8 2 1 3 1}
    "Hard" {5 5 1 3 1}
    "Killer" {2 8 1 3 1}
}
set T(names) {"Classic" "Safe Classic" "Robots2" "Hard" "Killer"}
foreach t $T(names) { set HIGH($t) {} }

set G(type) Robots2
set G(p,full) 1
set G(p,push) 1
set G(p,safe) 1
set G(p,safeTeleport) 1
set G(p,showSafe) 1
set G(state) dead


##+##########################################################################
#
# Init -- Sets up the size of everything based off of image size
#
proc Init {} {
    global S

    # All sizes based off of image size
    set S(sz) [image width ::img::R]
    set S(w) $S(w,org)
    set S(h) $S(h,org)
    set W [winfo screenwidth .]
    set H [winfo screenheight .]

    set rows [expr {($H - 200) / $S(sz)}]
    if {$S(h) > $rows} { set S(h) $rows}
    set cols [expr {($W - 100) / $S(sz)}]
    if {$S(w) > $cols} { set S(w) $cols}

    set S(cw) [expr {$S(sz)*$S(w)}]
    set S(ch) [expr {$S(sz)*$S(h)}]

    set S(w2) [expr {$S(w)/2}]
    set S(h2) [expr {$S(h)/2}]
    set S(maxRobots) [expr {$S(w)*$S(h)*2/3}]

    ::HighScore::Init $::T(names)
}
##+##########################################################################
#
# DoDisplay -- Sets up our game display
#
proc DoDisplay {} {
    global S

    wm title . $S(title)
    wm resizable . 0 0
    if {[lsearch [font names] doneFont] == -1} {
        label .dummy
        set font [font actual [.dummy cget -font]]
        destroy .dummy
        eval font create doneFont "$font -weight bold -size 18"
        eval font create splatFont "$font -weight bold"
        eval font create lblFont "$font -weight bold"
        option add *Label.font lblFont
    }

    frame .btns -bd 2 -relief sunken
    LabelLabel .btns.rem "Remaining:" G(left,pretty) 12
    LabelLabel .btns.safe "Safe Teleports:" G(safeTeleports) 5
    LabelLabel .btns.score "Score:" G(score,pretty) 10
    LabelLabel .btns.lvl "Level:" G(lvl) 5
    LabelLabel .btns.type "Type:" G(type) 10
    eval pack [winfo child .btns] -side right

    frame .f -bd 2 -relief ridge
    canvas .c -width $S(cw) -height $S(ch) -bd 0 -highlightthickness 0
    .c config -bg [lindex $S(clrs) 0]

    pack .btns -side bottom -fill x
    pack .f -side top
    pack .c -in .f -side top -fill both -expand 1
    DrawGrid
    DoMenus
    DoBindings
}
##+##########################################################################
#
# LabelLabel -- Creates sunken frame with 2 labels inside
#
proc LabelLabel {w lbl var width} {
    frame $w -bd 2 -relief sunken
    label $w.a -text $lbl -bd 0
    label $w.b -textvariable $var -width $width
    pack $w.a -side left -fill x -expand 1 -padx {3 0}
    pack $w.b -side left -fill x -expand 1
    return $w
}
##+##########################################################################
#
# DoMenus -- Puts up our menus
#
proc DoMenus {} {
    menu .m -tearoff 0
    . configure -menu .m                        ;# Attach menu to main window
    .m add cascade -menu .m.file -label "File" -underline 0
    .m add cascade -menu .m.pref -label "Preferences" -underline 0
    .m add cascade -menu .m.xhelp -label "Help" -underline 0

    menu .m.file -tearoff 0
    .m.file add command -label "New Game" -underline 0 -command NewGame -acc F2
    .m.file add command -label "High Scores" -underline 0 -command ShowHighScore
    .m.file add separator
    .m.file add command -label Exit -underline 1 -command exit

    menu .m.pref -tearoff 0
    .m.pref add cascade -label "Game Type" -underline 0 -menu .m.pref.type
    .m.pref add separator
    .m.pref add checkbutton -label "Full Size" -underline 0 -var G(p,full) \
        -command Resize
    .m.pref add checkbutton -label "Safe Mode" -underline 0 -var G(p,safe)
    .m.pref add checkbutton -label "Show Moves" -underline 5 \
        -var G(p,showSafe) -command CanMoveSafely
    .m.pref add separator
    .m.pref add command -label "Save Settings" -command {SaveConfig config}

    menu .m.pref.type -tearoff 0
    foreach lbl $::T(names) {
        .m.pref.type add radiobutton -label $lbl -command NewGameType \
            -variable G(type) -value $lbl
    }

    menu .m.xhelp -tearoff 0
    .m.xhelp add command -label "$::S(title) Help" -underline 10 -command Help
    .m.xhelp add command -label "About $::S(title)" -underline 0 -command About
}
##+##########################################################################
#
# DoBindings -- Sets up our keyboard bindings. Different between systems.
#
proc DoBindings {} {
    focus .c

    set win32 {
        <Key-End>         <Key-End>        <Shift-Key-End>   <Shift-Key-End>
        <Key-Down>        <Key-Down>       <Shift-Key-Down>  <Shift-Key-Down>
        <Key-Next>        <Key-Next>       <Shift-Key-Next>  <Shift-Key-Next>
        <Key-Left>        <Key-Left>       <Shift-Key-Left>  <Shift-Key-Left>
        <Key-Clear>       <Key-Clear>      <Shift-Key-Clear> <Shift-Key-Clear>
        <Key-Right>       <Key-Right>      <Shift-Key-Right> <Shift-Key-Right>
        <Key-Home>        <Key-Home>       <Shift-Key-Home>  <Shift-Key-Home>
        <Key-Up>          <Key-Up>         <Shift-Key-Up>    <Shift-Key-Up>
        <Key-Prior>       <Key-Prior>      <Shift-Key-Prior> <Shift-Key-Prior>
        <Key-Return>      <Key-Return>
        <Key-asterisk>    <Key-asterisk>
        <Key-plus>        <Key-plus>
        <Key-slash>       <Key-slash>
    }
    set x11 {
        <Key-End>         <Key-KP_End>     <Shift-Key-End>   <Shift-Key-KP_1>
        <Key-Down>        <Key-KP_Down>    <Shift-Key-Down>  <Shift-Key-KP_2>
        <Key-Next>        <Key-KP_Next>    <Shift-Key-Next>  <Shift-Key-KP_3>
        <Key-Left>        <Key-KP_Left>    <Shift-Key-Left>  <Shift-Key-KP_4>
        <Key-Clear>       <Key-KP_Begin>   <Shift-Key-Clear> <Shift-Key-KP_5>
        <Key-Right>       <Key-KP_Right>   <Shift-Key-Right> <Shift-Key-KP_6>
        <Key-Home>        <Key-KP_Home>    <Shift-Key-Home>  <Shift-Key-KP_7>
        <Key-Up>          <Key-KP_Up>      <Shift-Key-Up>    <Shift-Key-KP_8>
        <Key-Prior>       <Key-KP_Prior>   <Shift-Key-Prior> <Shift-Key-KP_9>
        <Key-Return>      <Key-KP_Enter>
        <Key-asterisk>    <Key-KP_Multiply>
        <Key-plus>        <Key-KP_Add>
        <Key-slash>       <Key-KP_Divide>
    }
    array set K $win32
    if {[tk windowingsystem] eq "x11"} {
        array set K $x11
    }

    bind .c $K(<Key-Up>)           [list MoveMan -1  0 0]
    bind .c $K(<Shift-Key-Up>)     [list MoveMan -1  0 1]
    bind .c $K(<Key-Down>)         [list MoveMan  1  0 0]
    bind .c $K(<Shift-Key-Down>)   [list MoveMan  1  0 1]
    bind .c $K(<Key-Left>)         [list MoveMan  0 -1 0]
    bind .c $K(<Shift-Key-Left>)   [list MoveMan  0 -1 1]
    bind .c $K(<Key-Right>)        [list MoveMan  0  1 0]
    bind .c $K(<Shift-Key-Right>)  [list MoveMan  0  1 1]
    bind .c $K(<Key-Prior>)        [list MoveMan -1  1 0]
    bind .c $K(<Shift-Key-Prior>)  [list MoveMan -1  1 1]
    bind .c $K(<Key-Home>)         [list MoveMan -1 -1 0]
    bind .c $K(<Shift-Key-Home>)   [list MoveMan -1 -1 1]
    bind .c $K(<Key-Next>)         [list MoveMan  1  1 0]
    bind .c $K(<Shift-Key-Next>)   [list MoveMan  1  1 1]
    bind .c $K(<Key-End>)          [list MoveMan  1 -1 0]
    bind .c $K(<Shift-Key-End>)    [list MoveMan  1 -1 1]
    bind .c $K(<Key-Clear>)        [list MoveMan  0  0 0]
    bind .c $K(<Shift-Key-Clear>)  [list MoveMan  0  0 1]

    bind .c $K(<Key-Return>)       [list SpecialMove wait]
    bind .c $K(<Key-asterisk>)     [list SpecialMove transport]
    bind .c $K(<Key-plus>)         [list SpecialMove safetransport]
    bind .c $K(<Key-slash>)        [list ShowSafeMoves]

    bind .c <F2> NewGame
    bind all <F3> {console show}

    return
    destroy .top
    toplevel .top
    proc foo {args} {
        foreach {a b} $args { puts -nonewline "$a: '$b' "}
    }
    bind .top <Key> [list foo %%K %K %%k %k %%A %A %%N %N]
}
##+##########################################################################
#
# SpecialMove -- Handle teleport and Wait player moves
#
proc SpecialMove {how} {
    global B G

    if {$G(state) ne "go"} return

    if {$how eq "transport" || $how eq "safetransport"} {
        set safe 0
        if {$how eq "safetransport"} {
            if {$G(safeTeleports) > 0} {
                incr G(safeTeleports) -1
                incr safe
            }
        }
        set empty [GetEmpty $safe]
        if {$empty eq {}} { set empty [GetEmpty 0] } ;# No safe places
        foreach {r c} [lindex [Shuffle $empty] 0] break
        foreach {r0 c0} $B(man) break
        set B($r0,$c0) ""
        set B($r,$c) M
        set B(man) [list $r $c]
        set G(state) transport
    } elseif {$how eq "wait"} {
        if {$G(p,safe) && ! [eval IsSafe $B(man)]} return
        set G(state) wait
        set G(thisWait) $G(left)
        puts $G(left)
    } else {
        DIE "Bad SpecialMove '$how'"
    }
    MoveRobots
    if {$G(state) eq "transport"} {
        FlashMan
        set G(state) go
    }
    CanMoveSafely
}
##+##########################################################################
#
# MoveMan -- Moves player one unit
#
proc MoveMan {dr dc forever} {
    global B G

    if {! $G(p,safe) && $forever eq "1"} return ;# Unsafe => no auto move

    if {$forever eq "auto"} {
        foreach {dr dc} $G(auto) break
    } elseif {$G(state) ne "go"} return

    set G(auto) [list $dr $dc]

    foreach {r0 c0} $B(man) break
    set r1 [expr {$r0 + $dr}]
    set c1 [expr {$c0 + $dc}]

    set legal [IsLegal $r0 $c0 $dr $dc]
    if {$legal == 0} { set G(state) go; return };# Can't move, turn off auto
    if {$legal == 2} {                          ;# Scrap
        if {! [MoveScrap $r1 $c1 $dr $dc]} {    ;# Can't move, turn off auto
            set G(state) go
            return
        }
    } elseif {$G(p,safe) && ! [IsSafe $r1 $c1]} { set G(state) go; return }

    set B($r0,$c0) ""
    set B($r1,$c1) M
    set B(man) [list $r1 $c1]

    if {$forever ne "0"} {
        set G(state) auto
    } else {
        set G(state) go
    }
    MoveRobots
    CanMoveSafely
}
##+##########################################################################
#
# MoveScrap -- Tries moving scrap at r1,c1 in direction dr,dc
#
proc MoveScrap {r1 c1 dr dc} {
    global G B S

    if {[GetCell $r1 $c1] ne "S"} { return 0 }  ;# Not pushing scrap
    if {! $G(p,push)} { return 0}               ;# Not legal to move scrap
    set r2 [expr {$r1 + $dr}]
    set c2 [expr {$c1 + $dc}]
    set what [GetCell $r2 $c2]
    if {$what ne "" && $what ne "R" && $what ne "A"} { return 0 } ;# Not empty

    # So we can push scrap, is it safe?
    set B($r1,$c1) ""
    set B($r2,$c2) S
    if {$G(p,safe) && ! [IsSafe $r1 $c1]} {
        set B($r1,$c1) S
        set B($r2,$c2) $what
        return 0
    }
    if {$what eq "R" || $what eq "A"} {
        ldelete B(where,$what) [list $r2 $c2]
        incr G(score) $S(score,$what)
        incr G(score) $S(score,$what)
        ShowSplat $r2 $c2
    }

    return 1
}
##+##########################################################################
#
# GetEmpty -- Returns list of empty (and optionally safe) board positions
#
proc GetEmpty {safeOnly} {
    global S B

    set empty {}
    for {set row 0} {$row < $S(h)} {incr row} {
        for {set col 0} {$col < $S(w)} {incr col} {
            if {$B($row,$col) eq ""} {
                if {$safeOnly && ! [IsSafe $row $col]} continue
                lappend empty [list $row $col]
            }
        }
    }
    return $empty
}
##+##########################################################################
#
# Shuffle -- Randomizes a list
#
proc Shuffle {l} {
    set len [llength $l]
    set len2 $len
    for {set i 0} {$i < $len-1} {incr i} {
        set n [expr {int($i + $len2 * rand())}]
        incr len2 -1

        set temp [lindex $l $i]                 ;# Swap elements at i & n
        lset l $i [lindex $l $n]
        lset l $n $temp
    }
    return $l
}
##+##########################################################################
#
# IsSafe -- Is it safe to move to this square
#
proc IsSafe {r c} {
    set sMINI [MakeMiniBoard $r $c]
    set n [IsSafe2 $sMINI]
    return $n
}
##+##########################################################################
#
# IsSafe2 -- Determines is a position given by MINI board is safe
# MINI board is 5x5 board
#
proc IsSafe2 {b} {
    # MINI is 5x5 grid w/ player in the middle
    array set MINI $b

    foreach r {-1 0 1} {
        foreach c {-1 0 1} {
            if {$r == 0 && $c == 0} continue
            if {$MINI($r,$c) eq "R" || $MINI($r,$c) eq "A"} { return 0 }
        }
    }

    foreach a {-2 -1 0 1 2} {
        foreach pos [list 2,$a -2,$a $a,2 $a,-2] {
            if {$MINI($pos) ne "A"} continue
            set inner [string map {2 1 -1 0 1 0} $pos]
            if {$MINI($inner) eq "S"} continue  ;# Scrap blocks alien

            set cnt 0
            set outer1 [string map {1 2 0 -1} $inner]
            set outer2 [string map {1 2 0 0} $inner]
            set outer3 [string map {1 2 0 1} $inner]
            foreach outer [lsort -unique [list $outer1 $outer2 $outer3]] {
                if {$MINI($outer) eq "R" || $MINI($outer) eq "A"} { incr cnt }
            }
            if {$cnt == 0} { DIE "bad IsSafe2" }
            if {$cnt == 1} { return 0 }         ;# Alien can get you
        }
    }
    return 1
}
##+##########################################################################
#
# IsLegal -- checks for legal move from r,c in direction dr,dc
#   0 if not legal
#   1 if ok (maybe not safe)
#   2 if push scrap
#
proc IsLegal {r c dr dc} {
    set r1 [expr {$r + $dr}]
    set c1 [expr {$c + $dc}]
    set what [GetCell $r1 $c1]
    if {$what eq "X"} { return 0 }              ;# Off the board
    if {$what eq "R" || $what eq "A"} { return 0 }
    if {$what ne "S"} { return 1 }              ;# Legal, but maybe not safe

    # Hit scrap, see if we can push it
    if {! $::G(p,push)} { return 0}             ;# Forbidden
    set r2 [expr {$r1 + $dr}]
    set c2 [expr {$c1 + $dc}]
    set what [GetCell $r2 $c2]
    if {$what eq "X" || $what eq "S"} { return 0 }
    return 2
}
##+##########################################################################
#
# GetCell -- Get contents of a board position, X for off the board
#
proc GetCell {r c} {
    if {! [info exists ::B($r,$c)]} { return "X" } ;# Off the board
    return $::B($r,$c)
}
##+##########################################################################
#
# Cell2CanvasBox -- Returns l,t,r,b of a cell
#
proc Cell2CanvasBox {row col} {
    global S
    set x0 [expr {$S(sz)*$col}]
    set y0 [expr {$S(sz)*$row}]
    set x1 [expr {$x0 + $S(sz)}]
    set y1 [expr {$y0 + $S(sz)}]
    return [list $x0 $y0 $x1 $y1]
}
##+##########################################################################
#
# Cell2Canvas -- Returns x,y of center of cell
#
proc Cell2Canvas {row col} {
    set x0 [expr {$::S(sz)*$col + $::S(sz)/2}]
    set y0 [expr {$::S(sz)*$row + $::S(sz)/2}]
    return [list $x0 $y0]
}
##+##########################################################################
#
# DrawGrid -- Draws our playing grid
#
proc DrawGrid {} {
    global S

    set clr [lindex $S(clrs) 1]
    for {set row 0} {$row < $S(h)} {incr row} {
        set left [expr {($row & 1) ? 1 : 0}]
        for {set col $left} {$col < $S(w)} {incr col 2} {
            set xy [Cell2CanvasBox $row $col]
            .c create rect $xy -fill $clr -outline {} -width 0 -tag ggrid
        }
    }
}
##+##########################################################################
#
# NewGame -- Starts a new game
#
proc NewGame {} {
    global G S T

    foreach aid [after info] {
        after cancel $aid
    }
    ::HighScore::_TearDown
    if {$G(state) ne "dead" && $G(moves) > 0} {
        set msg "Quit current games?"
        set ans [tk_messageBox -icon question -type yesno -message $msg  -title $S(title)]
        if {$ans ne "yes"} return
    }
    ::img::M blank
    ::img::M copy [lpick [info commands ::img::org::_M*]]
    ::img::A blank
    ::img::A copy [lpick [info commands ::img::org::_A*]]

    foreach {G(t,R) G(t,A) G(p,push) G(safeTeleports) G(p,safeTeleport)}  $T($G(type)) break
    set G(lvl) 0
    set G(score) 0
    set G(score,pretty) 0
    set G(longestWait) 0
    set G(thisWait) 0
    set G(moves) 0
    NextLevel
}
##+##########################################################################
#
# NewGameType -- Changes game type and starts a new game
#
proc NewGameType {} {
    set ::G(state) dead
    NewGame
}
##+##########################################################################
#
# NextLevel -- Initiates next level of play
#
proc NextLevel {} {
    global G S B

    incr G(lvl)
    set lvl [expr {min($G(lvl),$S(maxRobots)/($G(t,R)+$G(t,A)))}]
    set R [expr {$lvl * $G(t,R)}]
    set A [expr {$lvl * $G(t,A)}]

    set G(left) [expr {$R + $A}]
    CreateRobots $R $A
    set G(left,pretty) "[llength $B(where,R)]+[llength $B(where,A)]=$G(left)"
    DrawBoard
    set G(state) go
    CanMoveSafely
}
##+##########################################################################
#
# FinishLevel -- GUI for finishing a level
#
proc FinishLevel {} {
    global G B S
    if {$G(thisWait) > $G(longestWait)} { set G(longestWait) $G(thisWait)}
    set G(state) finished
    ShowMessage $B(man) "Finished Round" done
    after $S(delay,round) NextLevel
}
##+##########################################################################
#
# ShowSplat -- GUI for displaying splat'd robots
#
proc ShowSplat {r c} {
    ShowMessage [list $r $c] Splat! splat
    after $::S(delay,splat) .c delete splat
}
##+##########################################################################
#
# ShowMessage -- Displays a message on our game board, handles clipping
#
proc ShowMessage {xy txt tag} {
    global G B S

    .c delete $tag
    foreach {r c} $xy break
    if {$r < 2} {
        incr r
        set anchor n
    } else {
        incr r -1
        set anchor s
    }
    foreach {x y} [Cell2Canvas $r $c] break

    set n [.c create text $x $y -text $txt -font ${tag}Font -fill red  -tag $tag -anchor $anchor]
    set xy [.c bbox $n]
    set xy2 {}
    foreach val $xy dxy {-10 -10 10 10} { lappend xy2 [expr {$val + $dxy}]}
    set what [expr {$tag eq "splat" ? "oval" : "rect"}]
    set n2 [.c create $what $xy2 -fill white -outline black -width 3 -tag $tag]
    .c raise $n $n2

    # Remove left/right clipping
    foreach {x0 . x1 .} [.c bbox $tag] break
    if {$x0 < 0} { .c move $tag [expr {0 - $x0}] 0 }
    if {$x1 > $S(cw)} { .c move $tag [expr {$S(cw) - $x1}] 0}
}
##+##########################################################################
#
# CreateRobots -- Puts N robots on the board
#
proc CreateRobots {rCnt aCnt} {
    global B S

    unset -nocomplain B

    set empty {}
    for {set row 0} {$row < $S(h)} {incr row} {
        for {set col 0} {$col < $S(w)} {incr col} {
            set B($row,$col) ""
            lappend empty [list $row $col]
        }
    }
    set B(man) [list $S(h2) $S(w2)]
    set B($S(h2),$S(w2)) "M"
    ldelete empty $B(man)

    set empty [Shuffle $empty]

    set B(where,R) {}
    set B(where,A) {}
    for {set i 0} {$i < $rCnt+$aCnt} {incr i} {
        foreach {r c} [lindex $empty $i] break
        if {$B($r,$c) ne ""} {DIE "Bad empty list" }

        set who [expr {$i >= $rCnt ? "A" : "R"}]
        set B($r,$c) $who
        lappend B(where,$who) [list $r $c]
    }
}
##+##########################################################################
#
# DrawBoard -- Displays the current game board
#
proc DrawBoard {} {
    global S B
    .c delete R M S D A done flash

    for {set row 0} {$row < $S(h)} {incr row} {
        for {set col 0} {$col < $S(w)} {incr col} {
            if {$B($row,$col) ne ""} { DrawItem $row $col $B($row,$col)}
        }
    }
    .c raise splat
}
##+##########################################################################
#
# DrawItem -- Draws one item on the board
#
proc DrawItem {row col what} {
    if {$what eq ""} return
    set xy [Cell2Canvas $row $col]
    set img "::img::$what"
    if {[info commands $img] ne ""} {
        .c create image $xy -tag $what -image $img -anchor c
    } else {
        .c create text $xy -tag $what -anchor c -text $what -fill white
    }
}
##+##########################################################################
#
# StepBoard -- Moves all robots one step
#
proc StepBoard {onlyAliens} {
    global B G S

    set raList [MakeRobotList]
    foreach {who r c} $raList {
        set B($r,$c) ""
    }

    foreach {r0 c0} $B(man) break
    set dead 0
    set new(R) {}
    set new(A) {}
    foreach {who r c} $raList {
        if {$who == "A" || ! $onlyAliens} {
            set dr [expr {$r > $r0 ? -1 : $r < $r0 ? 1 : 0}]
            set dc [expr {$c > $c0 ? -1 : $c < $c0 ? 1 : 0}]
            incr r $dr
            incr c $dc
        }

        set what $B($r,$c)
        if {$what eq ""} {
            set B($r,$c) $who
            lappend new($who) [list $r $c]
        } elseif {$what eq "S"} {
            incr G(score) $S(score,$who)
            if {$G(p,safeTeleport) && $G(state) eq "wait" && $G(safeTeleports) < $S(maxSafe)} {
                incr G(safeTeleports)
            }
        } elseif {$what eq "R" || $what eq "A"} {
            set B($r,$c) S
            ldelete new($what) [list $r $c]
            incr G(score) $S(score,$who)
            incr G(score) $S(score,$what)
            if {$G(p,safeTeleport) && $G(state) eq "wait" && $G(safeTeleports) < $S(maxSafe)} {
                incr G(safeTeleports)
            }
            if {$G(p,safeTeleport) && $G(state) eq "wait" && $G(safeTeleports) < $S(maxSafe)} {
                incr G(safeTeleports)
            }
        } elseif {$what eq "M" || $what eq "D"} {
            set B($r,$c) D
            set dead 1
        } else {
            DIE "bad square: $r $c '$what'"
        }
    }

    set B(where,R) $new(R)
    set B(where,A) $new(A)
    set G(left) [expr {[llength $B(where,R)] + [llength $B(where,A)]}]
    set G(left,pretty) "[llength $B(where,R)]+[llength $B(where,A)]=$G(left)"
    set G(score,pretty) [comma $G(score)]
    return $dead
}
##+##########################################################################
#
# MakeRobotList -- Makes a list of all robots and aliens
#
proc MakeRobotList {} {
    global B

    set raList {}
    foreach arg {R A} {
        if {$B(where,$arg) eq {}} continue
        set thisList "$arg [join $B(where,$arg) \ $arg\ ]"
        set raList [concat $raList $thisList]
    }
    return $raList
}
##+##########################################################################
#
# MoveRobots -- Handles high-level of moving all robots
#
proc MoveRobots {} {
    global G B S

    incr G(moves)
    set n [StepBoard 0]
    DrawBoard
    update idletasks
    if {! $n} {
        set n [StepBoard 1]
        DrawBoard
    }

    if {$n} {
        GameOver
    } elseif {$B(where,R) eq {} && $B(where,A) eq {}} {
        FinishLevel
    } elseif {$G(state) eq "wait"} {
        after $S(delay,wait) MoveRobots
    } elseif {$G(state) eq "auto"} {
        after $S(delay,wait) MoveMan - - auto
    }
}
##+##########################################################################
#
# GameOver -- End of game stuff
#
proc GameOver {} {
    global B G S
    set G(state) dead
    set n [Add2Highscore]
    ShowMessage $B(man) "You died!" done
    after $S(delay,high) ShowHighScore $n
    after $S(delay,dead) PlayAgain

}
##+##########################################################################
#
# PlayAgain -- After handler for playing again
#
proc PlayAgain {} {
    global G S

    .c delete done
    set msg "Level: $G(lvl)\n"
    append msg "Score: $G(score,pretty)\n"
    append msg "Wait: $G(longestWait)\n"
    append msg "Moves: [comma $G(moves)]\n"
    append msg "\n"
    append msg "Play Again?"
    set ans [tk_messageBox -icon question -type yesno -message $msg  -title $S(title)]
    if {$ans eq "yes"} NewGame
}
##+##########################################################################
#
# FlashMan -- Flashes our player after a teleport so you can find it
#
proc FlashMan {} {
    global B G

    set n [CanMoveSafely]
    if {$G(p,showSafe) && $n} return
    set clr [expr {$n ? "yellow" : "red"}]


    set xy [eval Cell2CanvasBox $B(man)]
    .c delete flash
    .c create rect $xy -tag flash -fill white
    .c raise M flash

    for {set i 0} {$i < 3} {incr i} {
        .c itemconfig flash -fill white
        update idletasks; after 100
        .c itemconfig flash -fill $clr
        update idletasks; after 100
    }
    .c delete flash
}
##+##########################################################################
#
# CanMoveSafely -- Determines if a player has a safe move to make
#
proc CanMoveSafely {} {
    global B G

    .c delete flash
    foreach {r0 c0} $B(man) break
    if {$B($r0,$c0) eq "D"} return              ;# Already dead

    set safeties {}
    foreach dr {-1 0 1} {
        foreach dc {-1 0 1} {
            set r1 [expr {$r0+$dr}]
            set c1 [expr {$c0+$dc}]
            set n [IsLegal $r0 $c0 $dr $dc]
            if {$n == 0} continue

            array set MINI [MakeMiniBoard $r1 $c1]
            if {$n == 2} {                      ;# Update w/ pushed scrap
                set MINI($dr,$dc) S
            }
            if {[IsSafe2 [array get MINI]]} {
                lappend safeties [list $r1 $c1]
            }
        }
    }
    set B(safeties) $safeties
    if {$safeties ne {}} {
        if {$G(p,showSafe) && $G(state) eq "go"} ShowSafeMoves
        return 1
    }
    set xy [eval Cell2CanvasBox $B(man)]
    .c create rect $xy -tag flash -fill red
    .c raise M flash
    return 0
}
##+##########################################################################
#
# About -- Simple about dialog
#
proc About {} {
    set msg "$::S(title)\nby Keith Vetter April 2008\n\n"
    append msg "A tk implementation of the hoary Robots game."
    tk_messageBox -message $msg -icon info
}
##+##########################################################################
#
# comma -- Puts commas into a number
#
proc comma {num} {
    while {[regsub {^([-+]?[0-9]+)([0-9][0-9][0-9])} $num {\1,\2} num]} {}
    return $num
}
##+##########################################################################
#
# ldelete -- deletes element from a list
#
proc ldelete {listName elem} {
    upvar 1 $listName myList
    set n [lsearch $myList $elem]
    set myList [lreplace $myList $n $n]
    return $myList
}
##+##########################################################################
#
# lpick -- Picks an element from a list at random
#
proc lpick {l} {
    return [lindex $l [expr {int(rand()*[llength $l])}]]
}
##+##########################################################################
#
# DIE -- Our error handler
#
proc DIE {msg} {
    puts "$msg"
    error $msg
    set ::G(state) error
}
##+##########################################################################
#
# FullSize -- Installs full size images
#
proc FullSize {} {
    foreach img [info commands ::img::org::*] {
        set name [lindex [split $img ":"] end]
        set iname "::img::$name"
        catch {image delete $iname}
        image create photo $iname
        $iname copy $img
    }
}
##+##########################################################################
#
# HalfSize -- Installs half sized images
#
proc HalfSize {} {
    foreach img [info commands ::img::org::*] {
        set name [lindex [split $img ":"] end]
        set iname "::img::$name"
        catch {image delete $iname}
        image create photo $iname
        $iname copy $img -subsample 2 2
    }
}
##+##########################################################################
#
# Resize -- Toggles between half and full size
#
proc Resize {} {
    global S G

    if {$G(state) ne "dead" && $G(moves) > 0} {
        set msg "Quit current games?"
        set ans [tk_messageBox -icon question -type yesno -message $msg  -title $S(title)]
        if {$ans ne "yes"} return
    }
    if {$G(p,full)} {
        FullSize
    } else {
        HalfSize
    }

    set G(state) dead
    eval destroy [winfo child .]
    wm geom . {}
    . config -width 200 -height 200
    Init
    DoDisplay
    NewGame
}
################################################################
image create photo ::img::org::_A0 -data {
    R0lGODlhIgAiALMAAAQKJAT+BFdVTa4CBGZvoiYkHpmWiXp1bNzWxO/t5qesxDEzRVQCBERLa/wC
    BLSunCH5BAEAAAEALAAAAAAiACIAAwT/MMhJKxus6s3rcEMnjgFwACRZrGxxIEfLphIAPHiu7/hK
    moigcBhMIBJGI6IwAghs0KhUKmCKnICFtsFtEL4JBVe7cFo7TkN20fWCxQ0twLD8PdTs7pcQHs8f
    dU0Hd3lce31xBoBngg8AbYdwN4E0JmpTUXSMlTyKO5uVBqKjpKOgNDKpPjRXAgcGp6wbUbGsKDUm
    gwiwZ7WzJyWuAjkJBjEllI0ADCbDOsUFzC++EyYP0c07u9iD1BIXGCWYUAHgGT/k5QPr7OHiNj+6
    TNk62yXyjdfBB86AovOD9F3hJ9AJPzoGntQgSC2blXG3HP4oU01hjSrVKMr65k7duY0VH4Dcuodg
    JMh7OEqiBGRyowktju7BbCkriw2KNm2OiAAAOw== }
image create photo ::img::org::_A1 -data {
    R0lGODlhIgAkALMAAAQCFAT+BD9FP4SChLTGuFxiXCQpJairqdvu405XVDo+PKy+tGx5c+z+9IyZ
    ksPSxCH5BAEAAAEALAAAAAAiACQAAwT/MMhJq704B8W7V1q4LURjnicoXsqCvulaKU/DOHieM82j
    yhtHw0EoGo1Cx0+m4AlhpuRy1RwKANgsQCBkTEVNByOrICiyNy9wsmWMBaXG1X1dswUnRByBMNXt
    EgBxBAcCBycEAIBsOCUCjw0EOIqLAQA3JQAGAJFilIuaRA2anJKblWxaWpUdWJuqrgayBkwNfAAL
    Dpu7oQu4NbQhLQu3Cw/Htj3IAA8LLsEZCjlXxsguxzUACc0N0BiyAq8JKDwosQZfFQYIsljO7+98
    utoJCOkUmu0GOPDvOK/tQuTbJctBgoMIZ8X6hGEglgMGBhyYOHGAgQNZAmo4k1GTRIoHUCwCKKBK
    WDstB+Ah8HVSo4YslrKozBiT4QpVtDLKQmUgHq2exNih0rLT1UFvdvY5EwqUD9I1Son9dBD0qYye
    VKUGMJAgqFBAs8JuDbsTFaoIADs= }
image create photo ::img::org::_M0 -data {
    R0lGODlhIgAiALMAADwXF8qYR2tXJrIUDG9yepmMjw44WJF2MUg2HgT+BOvbftTWNNza1IxGJOBY
    NB1qnSH5BAEAAAkALAAAAAAiACIAAwT/MMlJJbo4180rEkcQXIIgIl3qlUfrtC2qrs10NHeL7w51
    gClSaUgsNY5I5EWVaTqfstkE8SuyolLOJ6AIlLiBAzZbKSkQXS76R9Z6RXD44dz2hBX4ORdPr1Oo
    e2Z8An4eIQJpCoiKhYYjJWiMjY58kpOGeoSXf1BjdRgFBQMApAUOBAUIR34IXAQMBQADA6YDrwVc
    NWStIrcBsrMCvrm7Ig3DpCa3vLpSrSgGsCIAcLcJDQHNM88JBqFxvQwo2NpMI90GBuABBATj2bvu
    FiQLCwIYFmJZvDIGDw8wAvwzYOGeJw98lqT7x/BBugQX9hycUgmaw3QYHULsgmcixTMWKTV2GwiR
    374lI0X6E4mvEIAPMl7e2yRBZkyYNF+2lDnzEqmfNX8CmBEBADs= }
image create photo ::img::org::_M1 -data {
    R0lGODlhIgAiALMAABEOF5SSBEtHE6imqB8maDctFGFcTUE8KAT+BObVg9TKBODh4KmbYvz0vfHo
    BHRmFCH5BAEAAAgALAAAAAAiACIAAwT/EMlJpbgY1823CIojOkmTCF1afUobiqWDqinruC/ZyHTH
    vq6RaNaj/Fqi4EhBLCIy0OjFOSkACgxGYsstMawF6uSa3R4S51LCKh5jD/Bz/MxuI86MBWChze+3
    YXYHZQ0NBiaFJl92ElhaaHBdgYwFBo9ZjwkMB4xVlptwj5OdB5WZgJykBgMCpltfAgMGqWJnBgsC
    c3EEC4e0RWm3ApjEAr0lvyqDW6sLA14lDQPHyMB9zQvZ2tmyBmbWkAPi4+SyB97JHYNZB9Pb7+to
    1uzu5drrm0UFAg8F7c7cAi4oxW9UigIP+gFYyLAhQ4T99BUEQKCixYsErhR0UqAjRYsMLC9e6Wjn
    Y0UACExm7JRSZEuQLFWilBkzw8x9F1AyApCBjUYMOts4XJhyqIoIADs= }
image create photo ::img::org::_M2 -data {
    R0lGODlhIgAiALMAABwaFa2fPjE/f11JIo6UkoJqPjwwJDEzR0hIRgT+BOzfrObUV+nr30hWtamu
    qaSObCH5BAEAAAkALAAAAAAiACIAQwT/MMlJk7Em61u7n8YQBEtpagP3rdNQkOYysCtgAxmi77xx
    A7SKgeAoOhAWArGIDHY2mYKrUNA9VM7WYrRgBBjbEmmWxSByvR2xV5YYBI34YR6PC9qUjGuQ0g8e
    KXggKSMjIXxUgYIhAXwuC1J8jVhtBlxbl1uUWQY9UJ08ZTefpBo2QSKNCQcCCnWvdgCpZFmsdXcH
    r3eCbn4Feg+/vCBRUgaJBsGbThqFh1S/wouEJgGHKYp4jDADMiUKk7ySDAAMBVvkXnziltx81Qi0
    gqmNklvy2igvYik7eDugzkBxwCCUExsaeJxRKNDHwVEBGZ75gWoMjgwESvm4gc+Do1WuGGDpSvCx
    jS07q0YOEwAHZa5bw0hhgMIiAgA7 }
image create photo ::img::org::_M3 -data {
    R0lGODlhIgAiALMAAEYVG7WKTQQC/CBGIyQuTBwtHKxGhDllNXRaHPzutOy2NO3DdXErMvz89ppG
    RpQ2dCH5BAEAAAIALAAAAAAiACIAQwT/UMhJqwDY6k2ZA8EijkvgMVw6Yc4YfGpaFNIQBMpxK7Qw
    x5vBYTgREoEcgOfDcsCQls9N5GCERAkPdFIYFgKI8CGMCMyOW+5w7U1zEApyyF1Rfhh4JR7/THsA
    Cw0ADYGDJXh0EgAOIQ+OIi+JPjoFkFMLBTkDbl0SMwUEAwSfngdbDCKlbG0CqAuJXasHPZIrIAoL
    GbW2t7m6knpLi05VAIl/IXl7JlV0fwtOIS8tJ3RVVyKEWFkodItTN9gmu98G5iUOu583xDcFA5uc
    QwE2JCUDOQfxUJ3vQ0Lw2nTaIkTVqh4DkThBuCbAmh5LTqWbJAviRDqxDu6S0MLBp44bB+HBKyJS
    RQQAOw== }
image create photo ::img::org::_M4 -data {
    R0lGODlhIgAiALMAAEkaBa6bQE1DKmdJbT43QUoqE8ZJE8yK/HwvDQT+BPz+xOTORIJuLMGyPHte
    e/zqVSH5BAEAAAkALAAAAAAiACIAQwT/MMlJayqYiWK7lwIhjiQhfChgrAYyvC/CGgBaATi+Ik7f
    yzSArGaj5I6JY67oARQagYYSx2B6CozG4xHobh8MjlWiagkRLthAhhCuiONCiSAnjTtYgQBX0Af2
    dxUCWQtfXwt9gRMCDw0wDQoPjw8niotZhgxVimVoOz4/LEBwKSydoA6jnqQeAg2vG3NzrrB3dSMX
    JZYUGINOAgEMOLtJSoOae6x3Gw2Fhg+IlZaDzVzWDwoau4MDBwAHA5Le4NqKe69bfYxbDXrE1A0Y
    BQFgm5ZH8A2aSHdloqhATFnp5CmNgxg7RjHxdwoUmzM0Fpr65PDNqiKutiTDoWYAvhzSGj7oOXFL
    logEIwOVJJDLzq6VLXHdm1JMyYcIADs= }
image create photo ::img::org::_M5 -data {
    R0lGODlhIgAiALMAAA0LHLOOVyUvfnRZNzwuG0k5JZl3SBsfVOy6fAT+BOTm5PzafERKzOy6dKyq
    rFxaXCH5BAEAAAkALAAAAAAiACIAQwT/MMlJJSk448o7JY2hAErQBKPSNITnAscBCLHjAIB9CDwD
    uJSCaVHAGY9HTIMIrCBxieev2bkQDKtsAGvYUD2EQSBAKJtYX+dOAIPxcDz2mp2ewNY/97vOsZb/
    ZQNdfB9XZyAgSywthBYGh2VZaI1Rd2EBCAhjBGxTaXp6CiMkCjtuPl+gOzKdbDxrMoR3bzgxe5RR
    tnR6dLgJZRkDggYDBb6/BQRnBl1/XoRlzJJZC4uU0YCLkWXXW0sLA9UL4yeMjZcrY2flxwDokmS4
    bTEHgGVrqJ+wr6IYonMC8jXhFQqHgjj0eg3EY4rWGxpxPLko8OCBAzn0jiAUUNGBsSYZHXIBjLMn
    JJ9Zu+ZIlKUrj0pfKPPMuNVISiUkQCIAADs= }
image create photo ::img::org::D -data {
    R0lGODlhIAAgAPQQAAAAABISEi9PT0VFRVRUVHh4eLIiIv8AAP9jR4AAgIeHh6urq7y8vMzMzN3d
    3ebm+v///////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEA
    ABEALAAAAAAgACAAAAX+ICCOZGmeJgSJRys2agw1DdseAKOShM4AOJhsOAMacDuCKKZ7EZ815GoH
    GAKET2KNuJRVs9BvrCDS7bDg4Vb1IzXT2iJkITKw7F24TFFbBBIHeDd2eloAAUcGeAhHUoUqfACJ
    LkCMjo80komLLYQEjxAEUQYIlAeWhE8OWZqliiKlgUg1IgMwqw0DIzCap4EsqFUkAwIKEAq6IgoA
    D4i+rwCWgZ8jCg4DEKvJ1lUEis/AryoDfNdYuQ0OANgrz5wuKrnrMDX0A/fxRrHhs1x58UXcwZL1
    L58SNEUknToCjCCATzF01WA3rs7CX9EmiXAgCtInAsZm2MqhkJGgRjhpCs5QU0bdIBsiqF2BQ4vB
    KpgxvayoQm8lrysBVsUgQYTOTgjYkh4NEECMCjpOQ3XJhbTqzAaIxNjcKYaOIgEPAEZYOYNAAnFs
    RszZcXZalgbevokpwHXBnF4tOsagEbcTALpUUAgeXCIEADs= }
image create photo ::img::org::R -data {
    R0lGODlhIgAiALMAAAUEBo6NjgQC/KJSCFEnBkhISc/P0CoqK21ubaipqPj6+NVsBhwYFlVWWLi5
    uG81BCH5BAEAAAIALAAAAAAiACIAAwT/UMhJW6FY2MxzAQzTHeDRnQKQKEAHGEaLckwTyBmD3LML
    XBwEAIDodRAMWADRQCQMh4LDeAoNrUMclQM4BAyKsENo2maI4bQCDNWa0WpFYxhQHMpmRkGRYBzA
    QksvMWYSAGEADXp2CGFRCjxbBw1rLwEHCgx1CgV7LG8OYVaNDQcODgCbnVsMaQYFlGsMQ56QIlSY
    cWoBK2kJbii5usMKqJLExMa4bGHMzmuRHbNZ1Fmz09XZQBNEAYIED+HiXTve5nflBXiGrgADC/AL
    Aw8qwwi1fRiHze7xA0ONhllIE+AWNzCV3sEj0ArZPYLrUqRB9W7Av03DHHQiaNAQwhgWYK8g1PXr
    B0R97QYQONCL2AGGsWzp62QhS0tdBn7N02PhDgYSQH/cjFOSwIIHfroQwYDAFABUI4e9VEigQYI/
    wJAo+uXEWwKv5gAQmIfUhg5gN7o4wJatLRFUIArJnVsoAgA7 }
image create photo ::img::org::S -data {
    R0lGODlhIAAgALMAAMwyBPyaNMxmBPz+/PxmNPyaZPxmBAAAAOAB32IA2hYAQQAAfujEAGLuABYS
    AAAAACH5BAEAAAMALAAAAAAgACAAAwTecMhJq7046827/6AnUIABeMB4AefApl8JT+UkpG33Vrv7
    5hsc7za0qEKbmwlpOpJ+GUAA6LqxKs1cTWIgFGQU5cBZ5eEAhECaQCSRMYCCN+6dGyptjXQ9Vfup
    RlR0cnImhHVycFc2fGk4fnyAA02Mh00EhpiIMzRmayxTaFZ7fxkCc0qDbHSnhDJkKY2gkX8so2on
    sa2Iq4e7h8C5pI2htMSyl8B2vDfKwXu2ssdTVsexcs3MvJY4WV97N5B/4saQaCVzwUrb6bxZpMOn
    5JDy1ru/qsq/2z/9/v8AX0QAADs= }
image create photo ::img::M
image create photo ::img::A
##+##########################################################################
#
# Help -- Simple help screen
#
proc Help {} {
    catch {destroy .helper}
    toplevel .helper
    wm transient .helper .
    wm title .helper "$::S(title) Help"
    if {[regexp {(\+[0-9]+)(\+[0-9]+)$} [wm geom .] => wx wy]} {
        wm geom .helper "+[expr {$wx+35}]+[expr {$wy+35}]"
    }
    set w .helper.t
    scrollbar .helper.sb -command [list $w yview]
    text $w -wrap word -width 70 -height 29 -pady 10  -yscrollcommand [list .helper.sb set]

    button .helper.quit -text Dismiss -command {catch {destroy .helper}}
    pack .helper.quit -side bottom -pady 10
    pack .helper.sb -side right -fill y
    pack $w -side left -fill both -expand 1

    $w tag config title -justify center -font {{Times Roman} 18 bold}
    $w tag config red -foreground red
    $w tag config header -font {{Times Roman} 12 bold} -lmargin1 5

    #$w tag config n -lmargin1 5 -lmargin2 5
    $w tag config n -lmargin1 .25i
    set lm2 [expr {15 + [font measure [$w cget -font] " o "]}]
    $w tag config b -lmargin1 15 -lmargin2 $lm2

    $w insert end "$::S(title)" {title red} "\nby Keith Vetter\n" title
    $w insert end "April 2008\n\n" title

    # Objective
    set txt "The object of the game is to avoid being overrun by \n"
    append txt "rampaging robots who's only goal is to kill you.\n\n"
    append txt "Your player starts in the middle of a rectangular grid\n"
    append txt "with robots placed at random locations. Your turn consist\n"
    append txt "of moving up, down, left, right, diagonally or staying put,\n"
    append txt "followed by every robot moving one square closer to you.\n\n"
    append txt "If you collide with a robot, you die and the game ends.\n"
    append txt "However, if two robots collide they both die and leave behind\n"
    append txt "a scrap heap. Also, if a robot hits a scrap heap, it dies.\n\n"
    $w insert end "Objective\n" header $txt n

    # Game Types
    set txt "The different game types select between different ratios of\n"
    append txt "robots to alients, whether you can safe teleport and whether\n"
    append txt "you can push scrap piles around.\n\n"
    $w insert end "Game Types\n" header $txt n

    # Players
    set txt "Your player is the human (one of six possible characters). The\n"
    append txt "robots come in two flavors: robots, who move one unit at\n"
    append txt "a time, and aliens, who move twice as fast.\n\n"
    $w insert end "The Characters\n" header $txt n

    # Teleport
    set txt "A player can also teleport--jump to a different place on the\n"
    append txt "grid. Beware, the location selected is random and you might\n"
    append txt "land next to a robot and die. However, there are a limited\n"
    append txt "number of 'safe' teleports which are guaranteed to land you\n"
    append txt "safely (see 'WAIT' below).\n\n"
    $w insert end "Teleport\n" header $txt n

    # Moving
    set txt "You move your player by using the 1-9 keys on the numeric\n"
    append txt "keypad (the 5 key stays in place). Holding down the shift\n"
    append txt "key while pressing a movement key will auto-repeat that move\n"
    append txt "while it's safe to do so.\n\n"
    $w insert end "Moving\n" header $txt n

    set txt " o the '*' key teleports randomly\n"
    $w insert end $txt b
    set txt " o the '+' key teleports safely\n"
    $w insert end $txt b
    set txt " o the '/' key shows all save moves\n"
    $w insert end $txt b
    set txt " o the 'Enter' key is the 'WAIT' button\n\n"
    $w insert end $txt b

    # Wait
    set txt "When you press the 'WAIT' button, you will no longer be able\n"
    append txt "to move until all the robots are dead or you are killed.\n"
    append txt "Doing so is dangerous, but you earn an extra safe teleport\n"
    append txt "for every robot that dies, up to a maximum of ten.\n\n"
    $w insert end "Wait\n" header $txt n

    # Scoring
    set txt "You get 10 points for every robot death and 20 points for every\n"
    append txt "alien death, double if push a scrap heap on top of one.\n\n"
    $w insert end "Scoring\n" header $txt n

    $w insert end "Preferences\n" header
    set txt " o 'Full Size' toggles screen size\n"
    $w insert end $txt b
    set txt " o 'Safe Mode' won't let you move into the path of a robot\n"
    $w insert end $txt b
    set txt " o 'Show Safe Moves' highlights your legal moves\n"
    $w insert end $txt b

    $w config -state disabled
    focus $w
}
##+##########################################################################
#
# Add2Highscore -- Adds current score to high score list and saves it
#
proc Add2Highscore {} {
    set n [::HighScore::Add2HighScore $::S(title) $::G(type) $::env(USERNAME) \
               $::G(score) $::G(lvl) [clock seconds]]
    return $n
}
##+##########################################################################
#
# ShowHighScore -- Puts up our high score dialog
#
proc ShowHighScore {{n -1}} {
    ::HighScore::ShowHighScore .high $::S(title) $::G(type) $n
    wm transient .high .
    CenterWindow .high .
}
proc CenterWindow {w {W .}} {
    wm withdraw $w
    update idletasks                            ;# Need to get geometry correct
    set wh [winfo reqheight $w]        ; set ww [winfo reqwidth $w]
    set sw [winfo width $W]            ; set sh [winfo height $W]
    set sy [winfo y $W]                ; set sx [winfo x $W]
    set x [expr {$sx + ($sw - $ww)/2}] ; set y [expr {$sy + ($sh - $wh)/2}]

    incr y -130
    if {$x < 0} { set x 0 }            ; if {$y < 0} {set y 0}

    wm geometry $w +$x+$y
    wm deiconify $w
}
##+##########################################################################
#
# MakeMiniBoard -- grabs 5x5 section of the board around r,c
#
proc MakeMiniBoard {r c} {
    unset -nocomplain MINI
    foreach dr {-2 -1 0 1 2} {
        foreach dc {-2 -1 0 1 2} {
            set r1 [expr {$r + $dr}]
            set c1 [expr {$c + $dc}]
            set MINI($dr,$dc) [GetCell $r1 $c1]
        }
    }
    return [array get MINI]
}
##+##########################################################################
#
# ShowSafeMoves -- Highlights all legal moves
#
proc ShowSafeMoves {} {
    global B

    if {$B(safeties) eq {}} return

    .c delete flash
    foreach pos $B(safeties) {
        set xy [eval Cell2CanvasBox $pos]
        .c create rect $xy -tag flash -fill yellow
    }
    .c lower flash
    .c lower ggrid
}
##+##########################################################################
#
# ReadConfig -- Reads either config or high score file
#
proc ReadConfig {what} {
    set fname [GetConfigFileName $what]
    if {! [file readable $fname]} return
    if {$n} {
        set msg "ERROR: Cannot read settings:\n$emsg"
        tk_messageBox -message $msg -icon error -title "Tk Robots Error"
        return
    }
    catch {interp delete myInterp}
    interp create -safe myInterp
    myInterp invokehidden source $fname
    array set ::G [myInterp eval array get G]
}
##+##########################################################################
#
# SaveConfig -- Saves either our configuration or our high score
#
proc SaveConfig {what} {
    global G HIGH

    set fname [GetConfigFileName $what]
    set n [catch {set fout [open $fname w]} emsg]
    if {$n} {
        if {$what eq "config"} {
            set msg "ERROR: Cannot save settings:\n$emsg"
            tk_messageBox -message $msg -icon error -title "Tk Robots Error"
        }
        return
    }
    if {$what eq "config"} {
        foreach arr {type p,safe p,full p,showSafe} {
            puts $fout "set G($arr) $G($arr)"
        }
    } else {
        puts $fout "array set HIGH { [array get HIGH] }"
    }
    close $fout
}
##+##########################################################################
#
# GetConfigFileName -- Returns name of either our config or high score file
#
proc GetConfigFileName {what} {
    global env

    set baseName [string tolower [string map {" " ""} $::S(title)]]
    if {$::tcl_platform(platform) eq "windows"} {
        append baseName [expr {$what eq "high" ? ".hs" : ".cfg"}]
    } else {
        append baseName [expr {$what eq "high" ? "_hs" : "_rc"}]
        set baseName ".$baseName"
    }

    set fname [file join ~ $baseName]
    if {[info exists env(APPDATA)]} {
        set fname [file join $env(APPDATA) $baseName]
    }
    return $fname
}
################################################################
##+##########################################################################
#
# highScore.tcl -- package for showing, adding to and saving high scores
# by Keith Vetter, April 28
#
# This package provides routines for showing, adding to and saving high scores.
# It supports multiple high score tables for different skill levels (buts
# works fine with only one table).
#
# A high score entry consists of: username, score, level reached and date,
# and sorts entries first by score, then by level. Changing this is easy
# but requires code changes.
#
# The scores are kept in a file based on the application name and stored in
# either APPDATA or HOME directory.
#
# Three procs are exported:
# ::HighScore::ShowHighScore toplevel appName ?skillLevel? ?highlight?
#      toplevel    -- name for the dialog's toplevel window
#      appName     -- for locating correct highscore data file
#      skillLevel  -- which table to show initially
#      ?highlight? -- if > 0,  which entry to high and to say Congratulations
#
# ::HighScore::Add2HighScore appName skillLevel name score lvl date
#    appName    -- for locating correct highscore data file
#    skillLevel -- which high score table to add to
#    name       -- name value for table
#    score      -- score value for table
#    level      -- level value for table
#    date       -- usually just [clock seconds]
#
# ::HighScore::GetHighScoreFileName appName
#      appName    -- for locating correct highscore data file

package require Tk 8.5
package provide highscore 1.0

namespace eval ::HighScore {
    variable W .highscores
    variable HIGH {}
    variable which                              ;# Which table to display
    variable skillLevels {}
    variable headers {Name Score Level Date}
    variable headerWidths {100 60 50 85}

    namespace export ShowHighScore Add2HighScore GetHighScoreFileName

    foreach t [trace info variable which] {     ;# For easier debugging
        trace remove variable which {*}$t
    }
}
##+##########################################################################
#
# ::HighScore::Init -- Lets you fix the ordering of skillLevels
#
proc ::HighScore::Init {skillLevels} {
    set ::HighScore::skillLevels $skillLevels
}
##+##########################################################################
#
# ::HighScore::ShowHighScore -- Puts up the high score dialog
#    toplevel   -- name for the dialog's toplevel window
#    appName    -- for locating correct highscore data file
#    skillLevel -- which table to show initially
#    highlight  -- if > 0,  which entry to high and to say Congratulations
#
proc ::HighScore::ShowHighScore {top appName {skillLevel ""} {highlight -1}} {
    variable W $top
    variable HIGH
    variable which

    ::HighScore::_ReadHighScores $appName

    ::HighScore::_TearDown
    toplevel $W
    wm title $W "$appName Scores"
    wm protocol $W WM_DELETE_WINDOW ::HighScore::_TearDown

    # Allow a game to have several high score tables
    set keys [dict keys $HIGH]
    if {$skillLevel eq ""} { set skillLevel [lindex $keys 0] }
    if {$skillLevel ni $keys} {
        set msg "ERROR: unknown skill level '$skillLevel'"
        tk_messageBox -icon error -title "High Score Error" -message $msg
        return
    }
    set which $skillLevel

    set WV $W.variants
    ::ttk::frame $WV
    ::ttk::label $WV.l -text "Skill Level:"
    ::ttk::menubutton $WV.opt -textvariable ::HighScore::which -menu $WV.menu \
        -direction flush
    menu $WV.menu -tearoff 0
    foreach i $keys {
        $WV.menu add radiobutton -label $i -variable ::HighScore::which
    }
    trace variable ::HighScore::which w ::HighScore::_Tracer
    pack $WV.l -side left
    pack $WV.opt -side left ;#-fill both -expand 1

    ::HighScore::MakeIcon
    ::ttk::label $W.icon -image ::highscore::icon
    label $W.title -text "$appName High Scores" -bd 2 -relief sunken \
        -font {Helvetica 12 bold}
    frame $W.buttons -bd 2 -relief ridge
    ::ttk::button $W.buttons.quit -text "Close" -command ::HighScore::_TearDown
    ::ttk::frame $W.table

    label $W.congrats1 -text "Congratulations!" -font {Helvetica 12 bold}
    label $W.congrats2 -text "You score has made the top ten."

    pack $W.buttons -side bottom -fill x -pady {.1i 0}
    pack $W.icon -side left -anchor n -pady .1i -padx .1i
    pack $W.title -side top -fill x -pady .1i -padx {0 .1i}
    if {$highlight > -1} {
        pack $W.congrats1 -side top -fill x
        pack $W.congrats2 -side top -fill x -padx {0 .1i}
    }
    if {[llength $keys] > 1} {
        pack $W.variants -side top -fill x -pady .1i -padx {0 .1i}
    }
    pack $W.buttons.quit -side bottom -expand 1 -pady .1i
    pack $W.table -side top -fill both -expand 1 -padx {0 .1i}

    set which $which                            ;# Fire the trace
    set tag "tag_${which}_$highlight"
    $W.table.tree tag config $tag -background cyan
    return $W
}
##+##########################################################################
#
# ::HighScore::GetHighScoreFileName -- Returns the highscore filename
#     appname -- used to construct the filename
#       Windows: => $env(APPDATA)/$appName.hs
#       Unix: => ~/.$appName_hs
#
proc ::HighScore::GetHighScoreFileName {appName} {
    global env

    set baseName [string tolower [string map {" " ""} $appName]]
    if {$::tcl_platform(platform) eq "windows"} {
        append baseName ".hs"
    } else {
        append baseName "_hs"
        set baseName ".$baseName"
    }

    set fname [file join ~ $baseName]
    if {[info exists env(APPDATA)]} {
        set fname [file join $env(APPDATA) $baseName]
    }
    return $fname
}
##+##########################################################################
#
# ::HighScore::Add2HighScore -- Adds entry to high score--if good enough
#    appName    -- for locating correct highscore data file
#    skillLevel -- which high score table to add to
#    name       -- name value for table
#    score      -- score value for table
#    level      -- level value for table
#    date       -- usually just [clock seconds]
#
#  returns: position in the top 10 (base 1)
#
proc ::HighScore::Add2HighScore {appName skillLevel name score level date} {
    variable HIGH

    ::HighScore::_ReadHighScores $appName

    set item [list $name $score $level $date]
    set data {}
    if {[dict exists $HIGH $skillLevel]} {
        set data [dict get $HIGH $skillLevel]
    }

    lappend data $item
    set data [lrange [lsort -dec -integer -index 2 $data] 0 9]
    set data [lsort -dec -integer -index 1 $data]
    set n [lsearch $data $item]
    if {$n > -1} {
        dict set HIGH $skillLevel $data
        ::HighScore::_SaveHighScore $appName
    }
    return [incr n]                             ;# Top 10 position (base 1)
}
##+##########################################################################
#
# ::HighScore::_CreateTable -- Creates high score table using tile treeview
#
proc ::HighScore::_CreateTable {W} {
    if {! [winfo exists $W]} return

    set WTREE $W.tree
    set data [::HighScore::_MassageData]

    if {! [winfo exists $WTREE]} {
        ::ttk::treeview $WTREE -columns $::HighScore::headers -show headings \
            -height 10 -yscroll "$W.vsb set" -xscroll "$W.hsb set" \
            -selectmode none
        scrollbar $W.vsb -orient vertical -command "$WTREE yview"
        scrollbar $W.hsb -orient horizontal -command "$WTREE xview"

        grid $WTREE $W.vsb -sticky nsew
        grid $W.hsb          -sticky nsew
        grid column $W 0 -weight 1
        grid row    $W 0 -weight 1
    }
    $WTREE delete [$WTREE children {}]
    foreach col $::HighScore::headers width $::HighScore::headerWidths {
        set name [string totitle $col]
        $WTREE heading $col -text $name
        $WTREE column $col -anchor c -width $width
    }
    $WTREE column Score -anchor e

    set lnum 0
    foreach datum $data {
        set tag "tag_${::HighScore::which}_[incr lnum]"
        $WTREE insert {} end -values $datum -tag $tag
    }
}
##+##########################################################################
#
# ::HighScore::_TearDown -- Cleans up traces from our dialog
#
proc ::HighScore::_TearDown {} {
    foreach t [trace info variable ::HighScore::which] {
        eval trace remove variable ::HighScore::which $t
    }
    destroy $::HighScore::W
}
##+##########################################################################
#
# ::HighScore::MakeIcon -- Makes our icon for our dialog
#
proc ::HighScore::MakeIcon {} {
    if {"::highscore::icon" in [image names]} return
    image create photo ::highscore::icon -format gif -data {
    R0lGODlhZABgALMAAAsDBbOYIKimhPzOBQQC/G5SI/j6d5ubYvz9ZWpkYvz+zEsyIdW1Gcy+RJNz
    EcTGlCH5BAEAAAQALAAAAABkAGAAQwT/kMhJq704a7KA/2Aojt52hYWirmzrvvD6HB1pj0+8hicY
    h4OgcEgsDhHIpNKQNDQOiWiCiRTeXrzKrcj4LIzg8FFJLieto+GHlZ2QvmgB2yOug81ktWf3EdYA
    LQIgbiIqfwBoCS19dmJ4VUMBHjkKIAxCDmsvB1mFLQ8hAUOZhyCijmZGpTeaMaAiEiEtCwc6tnOM
    YCJyMYI3C66DFD63Kx0LvLYFQEQjxVgAwLbChK3PLAkjC5eNQQwBDgkODqd6ALXXLtTDssUgcAMf
    ZAf09fYHAlRlIEbtOrAmqrHi160gEUkDRwTMkLChw4ceFkhcIIWeAEq4AGLwt+gXOYMg/+t4gtGG
    HTFOW4RIWcmypcuVBxogoKKvDBpEzT4kq/TBAglze3zhDHOvqD0B+R7ZvKnCCyZrh0z+ZDonZJGa
    j4ZIBGToA7d4e6CViMXxVa4wmYYWzJozmphDPzpxhLEKmVi1BQ+hS8cTAEY+PQVyzYjiojuCIkHs
    5dt3cEYtxAKNUHRtVZGEjP8FlpoZRAE/AwsEmInHgKXL1g5v9slqMbMg8pSSebIqBLybJJAqXMgb
    MsTfN3oLZw28uHGHvBNS3Jm5ufOuJX2nlnG8uo0FaSPfBdBjOmA6VsMXyQNWu7roBOYqqC2EQZQA
    X+18e0m/JZObAxDOjSpdW87b4o0h2/9SsHngQD9hNbUaWWnghlh43xhFD1YEplWKOSzwJ9gHnxWY
    YA0gHRAfEQOeQVVjuLGwzIIpDVBDRyMGOCCGCoLn4V1STWLWUC+q6EE5VpUYSYLZePCVed9xl14I
    ybyWHwou2hhkKkOsOEJ8XpAkl3k7AmhEF1KGoRSCABwYhnrUwTLSLMV5SaKJRegXVpEhUPaMRmg+
    11iMRmQXTTo7eteYkgwmCJg0mVkmRp7QOaPCXx2NVahjkl3Ry4NfMnoLCMx9J52dCi4AqXOYHoKo
    nppJOqkto75AZ4uRFLCVDa0ytk6hmQUqBgO1JdQWAKBec2uhnaY6VJ0U1mSAAPckYSX/XlF+sJix
    hBInwgGtHmIOGRSWaNpZDuog1IIbFffrcQt0GEavNgyXAbteMSCvvGB8I6t1w7qrb3es7OvvvxsE
    9y6+1S3gLsEIJ0xuueimm4BhqKIa6MITlFJAsRFf88AMz76hmqoVlPLPw7W68IAACXSsMJKRgiwY
    XehGk24BBYxjcwA44/wNn7poit6SHwSbZIBEC0GFh4LWSC6jTgbYLXlBkEYeCUKvh16eHRcd9RIz
    1CfF0Ug7Spi1lNpg5gBep612FAcYgBV+3ngBLAs7ks2V3G7pt2sA9LRET85ClIgH3Kg5NiwrhfMc
    nuBQlxdRW4/1945WF2o9AONKAPWg/zXRkXC2DYoPIS/OCUhYVFJj3qjtiYNKLmVk4BZhej3xPU2l
    40qnaMytNjz1Jx/qai2474N5BRqlKIHcOxp/FWl54EoZQCOKHp6qQN05Osl5mOLZDmd53x1PqdLZ
    28Z6X0QPf+LmhkY+6d3GFwhp7AbNOD37AGC8JexnwSvj4JCz2llYNiglralpA7CZHkJXh9vdxAGr
    0912DDgXBJKpILbjQjSgda648GBNSnOLEVTmpjc50EFGIoKfxseCcfUEhCGECAMJNIrffOyFmoKX
    Z6hnFT9ZTwXZqJqCtmMwoCUtEHei36IIaItxbSdHGWtZ8Mh0RLrZIAYaMiKlevQcEf8skYkFtM00
    VqMeJnXGgoVjIWEoYsXftQyKLVAZCUqGKTDISY0fa9U6NLUCOY7xA2fT3CSaA0be6SSK2zkXHqNo
    yIhUyjMlayKm/IRID1ZLizGgE8Ze4MI6NoSRLAJjMV4lAonULJDd+EYVP9af5pSihERggBzf8SOg
    kGppq0xkEWZ5HQcc4FlpjOQTWwkogtigAN5DgtuS4Jk0LrJlLsNkEnMRmybMrh6oYyb9+BhDDKxC
    mM8qRzWRYI9kksFKVHwmKU3AimBpzwOY49YdU6hIN+7uZ/zymAJIua0mNCABOmSFl4AzHOBMEYLa
    mEi6xgEfejVihQkB2PuWpzUGIBQZIhL9l20aElCMZjSjK7tOET9K0pKadCERAAA7}
}
##+##########################################################################
#
# ::HighScore::_MassageData -- Puts data into pretty format for display
#
proc ::HighScore::_MassageData {} {
    set data {}
    foreach datum [dict get $::HighScore::HIGH $::HighScore::which] {
        if {$datum eq ""} break
        foreach {who score lvl when} $datum break
        lset datum 1 [::HighScore::_Comma $score]
        lset datum 3 [clock format $when -format "%b %d, %Y"]
        lappend data $datum
    }
    return $data
}
##+##########################################################################
#
# ::HighScore::_Tracer -- Handles trace on which skill level to display
#
proc ::HighScore::_Tracer {var1 var2 op} {
    ::HighScore::_CreateTable $::HighScore::W.table
}
proc ::HighScore::_Comma {num} {
    while {[regsub {^([-+]?[0-9]+)([0-9][0-9][0-9])} $num {\1,\2} num]} {}
    return $num
}
##+##########################################################################
#
# ::HighScore::_ReadHighScores -- Reads our high score config file
#    appName    -- for locating correct highscore data file
#
proc ::HighScore::_ReadHighScores {appName} {
    variable HIGH
    variable skillLevels

    unset -nocomplain HIGH
    set HIGH {}
    foreach lvl $skillLevels { dict set HIGH $lvl {}}

    set fname [::HighScore::GetHighScoreFileName $appName]
    if {! [file readable $fname]} { return "No File" }

    catch {interp delete myInterp}              ;# Easier debugging
    interp create -safe myInterp
    myInterp invokehidden source $fname
    set HIGH [myInterp eval set HIGH]
    interp delete myInterp
    return ""
}
##+##########################################################################
#
# ::HighScore::_SaveHighScore -- Saves our high score config file
#    appName    -- for locating correct highscore data file
#
proc ::HighScore::_SaveHighScore {appName} {
    variable HIGH

    set fname [::HighScore::GetHighScoreFileName $appName]
    set n [catch {set fout [open $fname w]} emsg]
    if {$n} {
        set msg "ERROR: cannot save high scores\n$fname:\n$emsg"
        tk_messageBox -icon error -title "High Score Error" -message $msg
        return
    }
    puts $fout "set HIGH {"
    dict for {key value} $HIGH {
        puts $fout "    [list $key] [list $value]"
    }
    puts $fout "}"
    close $fout
}

################################################################
ReadConfig config
if {$G(p,full)} {
    FullSize
} else {
    HalfSize
}
Init
DoDisplay
NewGame
return

======
----

[uniquename] 2013aug01

This image shows one of the human character types (in the middle of the board), as well as a couple of robot types.

[vetter_TkRobots2_gameBoard_screenshot_926x629.jpg]

!!!!!!
%| [Category Games] | [Category Application] | [Category Graphics] |%
!!!!!!