[Keith Vetter] 2016-03-25 - I've been wasting too much time playing the app 1010! on my
smart phone so I decided to write my own version of it.
[1010! screenshot2]----
[Jeff Smith] 2019-05-03 : Below is an online demo using [CloudTk]
[Jeff Smith] 2020-08-19 : This demo has been changed to run "1010!" in an Alpine Linux Docker Container. It is a 27.4MB image which is made up of Alpine Linux + tclkit + 1010.kit + + libx11 + libxft + fontconfig + ttf-linux-libertine. It is run under a user account in the Container. The Container is restrictive with permissions for "Other" removed for "execute" and "read" for certain directories.
<<inlinehtml>>
<iframe height="710" width="480" src="https://cloudtk-app.tcl-lang.org/cloudtk/VNC?session=new&Tk=1010" allowfullscreen></iframe>
<<inlinehtml>>
----
======
##+##########################################################################
#
# 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
======
<<categories>>Games | Application