##+##########################################################################
#
# 1010!.tcl -- plays the game 1010!, placing tiles and clearing filled rows
# and columns.
# by Keith Vetter 2016-03-22
#

package require Tk

set S(title) "1010!"
set S(n) 10
set S(box) 40
set S(margin,outside) [expr {$S(box) * 2 / 3}]
set S(margin,between) 2
set S(corner,radius) [expr {$S(box) / 6}]
set S(preview,scaling) .7
set S(explode,delay) 30

set GAME(state) over
set GAME(score) 0
set GAME(difficulty) easy
set GAME(score) 0
set GAME(time,duration) "00:00"

set CLR(empty) gray90
set CLR(box1) #7d8ed4
set CLR(box2) #98dc55
set CLR(box3) #4dd5b1
set CLR(line2) #ffc63e
set CLR(line3) #ed954b
set CLR(line4) #dd6555
set CLR(line5) #dd6555
set CLR(el2) #59cb86
set CLR(el3) #63bbe1
set CLR(box23) yellow
set CLR(t) green
set CLR(T) green
set CLR(z) green
set CLR(h) cyan
set CLR(w) magenta

# How to draw the different pieces
set P(box1) {. }
set P(box2) {. r d l}
set P(box3) {. r r d l l d r r}
set P(line2,h) {. r}
set P(line2,v) {. d}
set P(line3,h) {. r r}
set P(line3,v) {. d d}
set P(line4,h) {. r r r}
set P(line4,v) {. d d d}
set P(line5,h) {. r r r r}
set P(line5,v) {. d d d d}
set P(el2,a) {r d l}
set P(el2,b) {. d r}
set P(el2,c) {. r L d}
set P(el2,d) {. r d}
set P(el3,a) {R r d d l l}
set P(el3,b) {. d d r r}
set P(el3,c) {. r r L L d d}
set P(el3,d) {. r r d d}
set S(pieces,easy) [array names P]
# https://image.apkpure.com/118/92de3b3ceef9c6/air.com.mapacarta.puzle1010-screen-2=x355.jpg
set P(box23,v) {. r d l d r}
set P(box23,h) {. r r d l l}
set P(t,n) {r L d r r}
set P(t,e) {. d r L d}
set P(t,s) {. r r L d}
set P(t,w) {r d l R d}
set P(z,ne) {r d l d}
set P(z,wn) {. r d r}
set P(z,nw) {. d r d}
set P(z,en) {r r D l l}
set S(pieces,moderate) [concat $S(pieces,easy) [array names P]]
set P(T,n) {r d d l R r}
set P(T,e) {. d r r L L d}
set P(T,s) {. r r L d d}
set P(T,w) {R r d l l R R d}
set P(h,v) {. R r d l l d R r}
set P(h,h) {. r r D l L d r r}
set P(w,a) {R r d l L d r r}
set P(w,b) {. d r d l R r}
set P(w,c) {. r r D l l d}
set P(w,d) {. r r d l D r}
set S(pieces,hard) [concat $S(pieces,moderate) [array names P]]


proc DoDisplay {} {
    global S
    
    ComputeSizes
    
    wm title . $S(title)
    wm resizable . 0 0
    canvas .c -width $S(canvas,width) -height $S(canvas,height) -bd 0 -highlightthickness 0 \
        -bg white
    pack .c -side top -fill both -expand 1
    DoDisplayBanner
    DrawConfigButton
    DrawEmptyBoard
    ClockTick
}
proc DoDisplayBanner {} {
    global S GAME
    set y [expr {$S(banner,height) / 2}]
    Logo1010 $S(margin,outside) $y 10
    .c create text [expr {$S(canvas,width) / 2}] $y -anchor c -font {Times 48 bold} \
        -tag score -fill magenta -text $GAME(score)
    .c create text [expr {$S(canvas,width) - $S(margin,outside)}] $y -anchor e \
        -font {Times 32 bold} -tag time -fill magenta -text $GAME(time,duration)

    foreach var {score time,duration} {
        foreach tr [trace info variable GAME($var)] {
            trace remove variable GAME($var) {*}$tr
        }
        trace add variable GAME($var) write UpdateBannerTrace
    }
}
proc UpdateBannerTrace {var1 var2 op} {
    if {$var2 eq "score"} {
        .c itemconfig score -text $::GAME(score)
    } elseif {$var2 eq "time,duration"} {
        .c itemconfig time -text $::GAME(time,duration)
    }
}
proc About {} {
    set msg "$::S(title)\n\nby Keith Vetter\nMarch, 2016"

    set details "Simply try to fit pieces into the grid, be aware some"
    append details " pieces like to make a mess. Complete vertical or horizontal lines"
    append details " to clear blocks. Complete a line either vertically or horizontally"
    append details " and they disappear. Can't fit any more blocks in? Game over.."
    append details "\n\nThe harder levels have more complex blocks."
    
    tk_messageBox -title "About $::S(title)" -message $msg -detail $details -parent .
}
proc ComputeSizes {} {
    global S

    set S(banner,height) [expr {10 + [font metric {Times 48 bold} -linespace]}]
    
    set S(tableau,size) [expr {$S(n) * $S(box) + ($S(n) - 1) * $S(margin,between)}]
    set S(tableau,top) $S(banner,height)
    set S(tableau2,height) [expr {$S(tableau,size) + $S(margin,outside)}]
    set S(preview,top) [expr {$S(tableau,top) + $S(tableau,size) + $S(margin,outside)}]
    set S(preview,size) [expr {round((5 * $S(box) + 4 * $S(margin,between)) * $S(preview,scaling))}]

    set S(canvas,width) [expr {$S(tableau,size) + 2 * $S(margin,outside)}]
    set S(canvas,height) [expr {$S(preview,top) + $S(preview,size) + $S(margin,outside)}]
}
proc BoxToXY {row col {shrink 0}} {
    global S

    set x0 [expr {$S(margin,outside) + $col * ($S(box) + $S(margin,between))}]
    set y0 [expr {$S(tableau,top) + $row * ($S(box) + $S(margin,between))}]
    set x1 [expr {$x0 + $S(box)}]
    set y1 [expr {$y0 + $S(box)}]

    set x0 [expr {$x0 + $shrink}]
    set y0 [expr {$y0 + $shrink}]
    set x1 [expr {$x1 - $shrink}]
    set y1 [expr {$y1 - $shrink}]
    
    return [list $x0 $y0 $x1 $y1]
}
proc BoxToXYMiddle {row col} {
    lassign [BoxToXY $row $col] x0 y0 x1 y1
    return [list [expr {($x0 + $x1)/2}] [expr {($y0 + $y1) / 2}]]
}
proc XYToBox {x y} {
    global S
    set col [expr {round(($x - $S(margin,outside)) / 1.0 / ($S(box) + $S(margin,between)))}]
    set row [expr {round(($y - $S(tableau,top)) / 1.0 / ($S(box) + $S(margin,between)))}]

    return [list $row $col]
}
proc StockPilesToXY {col} {
    global S
    set x [expr {round($S(margin,outside) + $S(tableau,size)/6. + $col * $S(tableau,size) / 3.)}]
    set y [expr {round($S(preview,top) + $S(preview,size)/2.)}]

    return [list $x $y]
}
proc DrawConfigButton {} {
    global S

    set x1 [expr {$S(canvas,width) - 5}]
    set y1 [expr {$S(canvas,height) - 5}]
    set x0 [expr {$x1 - 8}]
    set y0 [expr {$y1 - 20}]
    .c create rect $x0 $y0 $x1 $y1 -tag config -fill sandybrown -width 0
    set id [.c create rect $x0 $y0 $x1 $y1 -tag config -fill sandybrown -width 0]
    .c move $id -10 0

    set id [.c create rect [.c bbox config] -tag config -fill white -outline white]
    .c lower $id

    .c bind config <1> ConfigDialog
}
proc DrawEmptyBoard {} {
    global S CLR

    .c delete rect tile
    for {set row 0} {$row < $S(n)} {incr row} {
        for {set col 0} {$col < $S(n)} {incr col} {
            DrawRect .c $row $col $CLR(empty) rect
        }
    }
}
proc DrawRect {W row col clr tag} {
    # Polygon seem to always have a outline width of 1
    set xy [BoxToXY $row $col 1]
    roundRect $W {*}$xy $::S(corner,radius) -fill $clr -outline $clr -tag $tag -width 0
}
proc roundRect { w x0 y0 x3 y3 radius args } {
    set r [winfo pixels $w $radius]
    set d [expr { 2 * $r }]

    # Make sure that the radius of the curve is less than 3/8
    # size of the box!

    set maxr 0.75

    if { $d > $maxr * ( $x3 - $x0 ) } {
        set d [expr { $maxr * ( $x3 - $x0 ) }]
    }
    if { $d > $maxr * ( $y3 - $y0 ) } {
        set d [expr { $maxr * ( $y3 - $y0 ) }]
    }

    set x1 [expr { $x0 + $d }]
    set x2 [expr { $x3 - $d }]
    set y1 [expr { $y0 + $d }]
    set y2 [expr { $y3 - $d }]

    set cmd [list $w create polygon]
    lappend cmd $x0 $y0 $x1 $y0 $x2 $y0
    lappend cmd $x3 $y0 $x3 $y1 $x3 $y2
    lappend cmd $x3 $y3 $x2 $y3 $x1 $y3
    lappend cmd $x0 $y3 $x0 $y2 $x0 $y1
    lappend cmd -smooth 1
    return [eval $cmd $args]
}

proc DrawTile {who {tag a} {W .c}} {
    global P CLR

    $W delete $tag
    set type [lindex [split $who ","] 0]
    set m [TileToMatrix $who]
    for {set row 0} {$row < 5} {incr row} {
        for {set col 0} {$col < 5} {incr col} {
            if {[dict get $m $row,$col]} {
                DrawRect $W $row $col $CLR($type) [list $tag tile]
            }
        }
    }
}

proc TileToMatrix {who} {
    # Converts tile described by P($who) or PP($who) into a 5x5 matrix
    global P PP
    set m [dict create]
    for {set row 0} {$row < 5} {incr row} {
        for {set col 0} {$col < 5} {incr col} {
            set m [dict set m $row,$col 0]
        }
    }

    set row 0
    set col 0
    set directions [expr {[info exists P($who)] ? $P($who) : $PP($who)}]
    foreach dir $directions {
        if {$dir eq "."} {
            ;
        } elseif {$dir eq "r"} {
            incr col
        } elseif {$dir eq "d"} {
            incr row
        } elseif {$dir eq "l"} {
            incr col -1
        } elseif {$dir eq "R"} {
            incr col
            continue
        } elseif {$dir eq "L"} {
            incr col -1
            continue
        } elseif {$dir eq "D"} {
            incr row
            continue
        } else { error "bad dir: $dir" }
        set m [dict set m $row,$col 1]
    }
    return $m
}
proc PlaceTileAtXY {tag xy anchor {W .c}} {
    lassign $xy x y
    lassign [$W bbox $tag] x0 y0 x1 y1
    if {$anchor eq "nw"} {
        set dx [expr {$x - $x0}]
        set dy [expr {$y - $y0}]
        $W move $tag $dx $dy
    } elseif {$anchor eq "c"} {
        set xc [expr {($x0 + $x1) / 2}]
        set yc [expr {($y0 + $y1) / 2}]
        set dx [expr {$x - $xc}]
        set dy [expr {$y - $yc}]
        $W move $tag $dx $dy
    } else {
        error "unknown anchor '$anchor'"
    }
}
proc PlaceTileOnBoard {tag row col} {
    set xy [BoxToXY $row $col]
    PlaceTileAtXY $tag $xy nw
}
proc PlaceTileOnStockPile {tag col} {
    set xy [StockPilesToXY $col]
    PlaceTileAtXY $tag $xy c
}
proc NewTileOnStockPile {who tag col} {
    global NEW
    set NEW($tag,who) $who
    set NEW($tag,col) $col
    
    DrawTile $who $tag
    AddMoveBindings $tag $tag
    PlaceTileOnStockPile $tag $col
    DrawBackgroundTile $tag
}

proc RandomPiece {} {
    global S GAME

    # set all [array names P]
    set all $S(pieces,$GAME(difficulty))
    set idx [expr {int(rand() * [llength $all])}]
    return [lindex $all $idx]
}

proc RefreshPiles {{force 0}} {
    global NEW GAME

    if {! $force} {
        foreach arr [array names NEW *,done] {
            if {$NEW($arr) == 0} return
        }
    }
    DeleteBackgroundTiles    
    ThreeNewPieces {*}$GAME(preview)
}
proc ThreeNewPieces {args} {
    global NEW S GAME

    set args [MakePilesFit {*}$args [RandomPiece] [RandomPiece] [RandomPiece]]
    for {set i 0} {$i < 3} {incr i} {
        set tag newTile$i
        set NEW($i) $tag
        set NEW($tag,who) [lindex $args $i]
        set NEW($tag,col) $i
        set NEW($tag,done) 0
        NewTileOnStockPile $NEW($tag,who) $tag $NEW($tag,col)
        ScaleUpDown .c $tag c $S(preview,scaling)
    }
    set GAME(preview) [MakePilesFit [RandomPiece] [RandomPiece] [RandomPiece]]
    Preview maybe
}
proc MakePilesFit {left middle right args} {
    # avoid two adjacent line5,h since they overlap visually
    if {$middle ne "line5,h"} { return [list $left $middle $right] }
    if {$left ne "line5,h"} { return [list $middle $left $right] }
    if {$right ne "line5,h"} { return [list $left $right $middle] }
    return [MakePilesFit $left [RandomPiece] $right]
}
proc DrawBackgroundTile {tag} {
    # Create hidden box around tile for better bind target
    set xy [.c bbox $tag]
    set id [.c create rect $xy -fill white -outline white -tag launch]
    .c lower $id
    AddMoveBindings $id $tag
}
proc DeleteBackgroundTiles {} {
    .c delete launch
}
################################################################
proc MouseMove {action tag x y} {
    global S NEW GAME
    if {$GAME(state) eq "starting"} {
        set GAME(time,start) [clock seconds]
        set GAME(state) "playing"
    }
    if {$GAME(state) ne "playing"} return
    if {$NEW($tag,done)} return
    
    if {$action eq "down"} {
        set S(mouse,x) $x
        set S(mouse,y) $y
        .c raise $tag
        ScaleUpDown .c $tag c [expr {1 / $S(preview,scaling)}]
    } elseif {$action eq "move"} {
        set dx [expr {$x - $S(mouse,x)}]
        set dy [expr {$y - $S(mouse,y)}]
        set S(mouse,x) $x
        set S(mouse,y) $y
        .c move $tag $dx $dy
    } elseif {$action eq "up"} {
        lassign [.c bbox $tag] x0 y0 x1 y1
        lassign [XYToBox $x0 $y0] row col
        if {[IsRoomAvailableAt $tag $row $col]} {
            DoMove $tag $row $col
        } else {
            PlaceTileOnStockPile $tag $NEW($tag,col)
            ScaleUpDown .c $tag c $S(preview,scaling)
        }
    }
}
proc AddMoveBindings {targetTag pieceTag} {
    .c bind $targetTag <1> [list MouseMove down $pieceTag %x %y]
    .c bind $targetTag <B1-Motion> [list MouseMove move $pieceTag %x %y]
    .c bind $targetTag <ButtonRelease-1> [list MouseMove up $pieceTag %x %y]
}
proc RemoveTagAndBindings {tag} {
    .c dtag $tag
}
proc DoMove {tag row col} {
    global NEW
    
    PlaceTileOnBoard $tag $row $col
    RemoveTagAndBindings $tag
    MarkBoard $tag $row $col
    set NEW($tag,done) 1
    set countRows [ClearRows $row $col]
    BonusScore $countRows
    RefreshPiles
    if {[CanMove] eq {}} {
        GameOver
    }
}
proc GameOver {} {
    global GAME

    set GAME(state) over

    ::ttk::frame .over -borderwidth 5 -relief ridge -pad 3m
    ::ttk::label .over.msg -text "Game Over" -font "Times 48 bold"
    ::ttk::button .over.new -text "New Game" -command NewGame
    pack .over.msg .over.new -side top
    place .over -in .c -relx .5 -rely .3 -anchor c
}
proc NewGame {} {
    global S GAME BRD

    set BRD [dict create]
    for {set row 0} {$row < $S(n)} {incr row} {
        for {set col 0} {$col < $S(n)} {incr col} {
            dict set BRD $row,$col 0
        }
    }
    set GAME(state) starting
    set GAME(score) 0
    set GAME(preview) [list [RandomPiece] [RandomPiece] [RandomPiece]]
    set GAME(time,start) [clock seconds]
    set GAME(time,duration) "00:00"

    destroy .over
    .c delete tile
    ThreeNewPieces
}

proc CanMove {{listAll 0}} {
    global NEW S

    set all {}
    foreach pile {0 1 2} {
        set tag $NEW($pile)
        if {$NEW($tag,done)} continue
        for {set row 0} {$row < $S(n)} {incr row} {
            for {set col 0} {$col < $S(n)} {incr col} {
                if {[IsRoomAvailableAt $tag $row $col]} {
                    lappend all [list $pile $row $col]
                    if {! $listAll} { return $all }
                }
            }
        }
    }
    return $all
}

proc IsRoomAvailableAt {tag row col} {
    global NEW BRD S

    if {$row < 0 || $row >= $S(n) || $col < 0 || $col >= $S(n)} {
        return false
    }
    
    set m [TileToMatrix $NEW($tag,who)]
    dict for {pos value} $m {
        if {$value == 0} continue
        lassign [split $pos ","] dRow dCol
        set row1 [expr {$row + $dRow}]
        set col1 [expr {$col + $dCol}]
        if {$row1 < 0 || $row1 >= $S(n) || $col1 < 0 || $col1 >= $S(n)} {
            return false
        }
        if {[dict get $BRD $row1,$col1]} {
            return false
        }
    }
    return true
}

proc MarkBoard {tag row col} {
    global NEW BRD GAME
    set m [TileToMatrix $NEW($tag,who)]
    dict for {pos value} $m {
        if {$value == 0} continue
        lassign [split $pos ","] dRow dCol
        set row1 [expr {$row + $dRow}]
        set col1 [expr {$col + $dCol}]
        dict set BRD $row1,$col1 1
        incr GAME(score)
    }
}
proc BonusScore {countRows} {
    global GAME
    array set BONUSES {0 0 1 10 2 30 3 60 4 100 5 150 6 210}
    incr GAME(score) $BONUSES($countRows)
}
proc ClearRows {row col} {
    lassign [FindFullRows $row $col] countRows all
    foreach pos $all {
        lassign $pos row col distance
        ClearCell $row $col $distance
    }
    return $countRows
}
proc ClearCell {row col distance} {
    global BRD

    if {[dict get $BRD $row,$col]} {
        dict set BRD $row,$col 0
        lassign [BoxToXYMiddle $row $col] x y
        set id [.c find closest $x $y]
        ExplodeCell $id $distance 4
    }
}
proc ExplodeCell {tag delay state} {
    global S
    if {$delay} {
        set when [expr {$S(explode,delay) * $delay}]
        after $when ExplodeCell $tag 0 $state
    } elseif {$state <= 0} {
        .c delete $tag
    } else {
        ScaleUpDown .c $tag c .5
        after $S(explode,delay) ExplodeCell $tag 0 [incr state -1]
    }
}
proc FindFullRows {row0 col0} {
    global BRD S

    set allCellsToClear {}
    set countRows 0
    for {set row 0} {$row < $S(n)} {incr row} {
        set full {}
        for {set col 0} {$col < $S(n)} {incr col} {
            if {[dict get $BRD $row,$col] == 0} {
                set full {}
                break
            }
            lappend full [list $row $col [XYDistance $row0 $col0 $row $col]]
        }
        if {$full ne {}} {
            lappend allCellsToClear {*}$full
            incr countRows
        }
    }
    for {set col 0} {$col < $S(n)} {incr col} {
        set full {}
        for {set row 0} {$row < $S(n)} {incr row} {
            if {[dict get $BRD $row,$col] == 0} {
                set full {}
                break
            }
            lappend full [list $row $col [XYDistance $row0 $col0 $row $col]]
        }
        if {$full ne {}} {
            lappend allCellsToClear {*}$full
            incr countRows
        }
    }
    return [list $countRows [lsort -unique $allCellsToClear]]
}
proc XYDistance {row0 col0 row1 col1} {
    return [expr {max(abs($row0 - $row1), abs($col0 - $col1))}]
}

proc ScaleUpDown {W tag anchor amt} {
    lassign [$W bbox $tag] x0 y0 x1 y1
    if {$anchor eq "c"} {
        set x [expr {($x0 + $x1)/2}]
        set y [expr {($y0 + $y1)/2}]
    } elseif {$anchor eq "nw"} {
        set x $x0
        set y $y0
    } elseif {$anchor eq "ne"} {
        set x $x1
        set y $y0
    }
    $W scale $tag $x $y $amt $amt

    # Try to avoid getting "dust"--stray pixels on the screen left
    # over after the item is deleted. May be due to round error.
    set cleanXY {}
    foreach xy [$W coords $tag] {
        lappend cleanXY [expr {round($xy)}]
    }
    $W coords $tag $cleanXY
}

################################################################

proc ConfigDialog {} {
    if {[winfo exists .config]} return
    
    toplevel .config
    wm title .config "$::S(title) Configure"
    ::ttk::frame .config.all -padding {3m 2m 3m 0}
    pack .config.all -fill both -expand 1

    set ::GAME(dialog,difficulty) $::GAME(difficulty)
    ::ttk::labelframe .config.d -text "Difficulty"
    foreach txt {easy moderate hard} {
        set title [string totitle $txt]
        ::ttk::radiobutton .config.d.$txt -text $title -variable ::GAME(dialog,difficulty) \
            -value $txt
        grid .config.d.$txt -sticky w
    }

    ::ttk::frame .config.misc
    ::ttk::button .config.misc.about -text About -command About
    ::ttk::button .config.misc.preview -text Preview -command {Preview toggle}
    ::ttk::button .config.misc.cheat -text "New Blocks" -command {RefreshPiles 1}
    grid .config.misc.about -sticky w
    grid .config.misc.preview -sticky w
    grid .config.misc.cheat -sticky w
    
    ::ttk::frame .config.buttons
    ::ttk::button .config.ok -text "Ok" -command {ConfigDialogDone ok}
    ::ttk::button .config.cancel -text "Cancel" -command {ConfigDialogDone cancel}
    grid .config.ok .config.cancel -in .config.buttons
    grid columnconfigure .config.buttons {0 1} -weight 1

    grid .config.d .config.misc -in .config.all -sticky wn
    grid config .config.d -padx {0 3m}
    grid .config.buttons - -in .config.all -sticky we -pady 5m
    PlaceWindow .config . right
}
proc ConfigDialogDone {how} {
    destroy .config
    if {$how eq "ok"} {
        set ::GAME(difficulty) $::GAME(dialog,difficulty)
        NewGame
    }
}

proc Preview {action} {
    global S GAME
    
    if {$action eq "toggle"} {
        set action [expr {[winfo exists .preview] ? "hide" : "show"}]
    }
    if {$action eq "hide"} {
        destroy .preview
        return
    }
    set width [expr {2 * $S(margin,outside) + 3 * $S(preview,size) + 2 * $S(margin,outside)}]
    set height [expr {2 * $S(margin,outside) + $S(preview,size)}]
    
    if {! [winfo exists .preview]} {
        if {$action ne "show"} return
        toplevel .preview
        wm title .preview "$S(title) Preview"
        wm transient .preview .
        wm protocol .preview {set ::S(preview,geom) [wm geom .preview]}
        canvas .preview.c -width $width -height $height -bd 0 -highlightthickness 0
        pack .preview.c
        PlaceWindow .preview .config bottom
    }

    .preview.c delete all
    foreach col {0 1 2} {
        set who [lindex $GAME(preview) $col]
        if {$who eq ""} continue
        set x [expr {$width * (2 * $col + 1) / 6}]
        set y [expr {$height / 2}]
        set tag preview$col
        DrawTile $who $tag .preview.c
        ScaleUpDown .preview.c $tag c $S(preview,scaling)
        PlaceTileAtXY $tag [list $x $y] c .preview.c
    }
}
proc ClockTick {} {
    global GAME
    if {$GAME(state) eq "playing"} {
        set duration [expr {[clock seconds] - $GAME(time,start)}]
        set GAME(time,duration) [PrettyDuration $duration]

    }
    after 1000 ClockTick
}
proc PrettyDuration {sec} {
    if {$sec < 3600} {
        set time [clock format $sec -gmt 1 -format %M:%S]
    } elseif {$sec < 3600 * 24} {
        set time [clock format $sec -gmt 1 -format %H:%M:%S]
    } else {
        set days [expr {$sec / (3600*24)}]
        set sec [expr {$sec % (3600*24)}]
        if {$days == 1} {
            set time "1 day [clock format $sec -gmt 1 -format %H:%M:%S]"
        } else {
            set time "$days days [clock format $sec -gmt 1 -format %H:%M:%S]"
        }
    }
    return $time
}
proc AutoPlaceOne {strategy} {
    global S NEW GAME
    if {$GAME(state) ni {"starting" "playing"}} return
    
    set all [CanMove 1]
    if {$strategy eq "random"} {
        set move [lindex $all [expr {int(rand() * [llength $all])}]]
    } elseif {$strategy eq "first"} {
        set move [lindex $all 0]
    } elseif {$strategy eq "alternate"} {
        set move [lindex $all [expr {rand() > .5 ? "end" : 0}]]
    }
    lassign $move who row col
    set tag $::NEW($who)
    ScaleUpDown .c $tag c [expr {1 / $::S(preview,scaling)}]
    DoMove $tag $row $col
}
proc Robot {strategy} {
    global S NEW GAME
    if {$GAME(state) ni {"starting" "playing"}} return

    AutoPlaceOne $strategy
    after 200 Robot $strategy
}
proc Logo1010 {x y sz} {
    set interLetter 2
    set intraLetter 1

    set y0 [expr {$y - $sz -$sz/2 - $intraLetter}]
    
    .c delete logo
    set clrs {red sandybrown sandybrown sandybrown green blue blue blue cyan}
    for {set col 0} {$col < 9} {incr col} {
        set clr [lindex $clrs $col]
        set newLetter [expr {$col > 0 && $clr != [lindex $clrs $col-1]}]
        if {$newLetter} { incr x $interLetter }
        set x1 $x
        set x2 [expr {$x + $sz}]
        for {set row 0} {$row < 3} {incr row} {
            if {$row == 1 && ($col == 2 || $col == 6)} continue
            set y1 [expr {$y0 + $row * ($sz + $intraLetter)}]
            set y2 [expr {$y1 + $sz}]

            if {$row == 1 && $col == 8} { incr y1 -1 }
            .c create rect $x1 $y1 $x2 $y2 -fill $clr -width 0 -tag logo
        }
        incr x $sz
        incr x $intraLetter
    }
}
proc PlaceWindow {who parent where} {
    if {! [winfo exists $parent] || ! [winfo exists $who]} return
    set n [scan [wm geom $parent] %dx%d%d%d width height x y]
    if {$n != 4} return
    if {$width == 1} {
        update
        puts "geom2: [wm geom $parent]"
    }        
    
    if {$where eq "right"} {
        incr x $width
        incr x 5
    } elseif {$where eq "bottom"} {
        incr y $height
        incr y 30
    } else return
    wm geom $who +$x+$y
}
################################################################
DoDisplay
NewGame

return