HJG 2014-03-25 - Work in progress / GUI + Demo
This is a nice little game with numbers, also suitable for small displays, e.g. mobile-phones.
Like 15-puzzle and sudoku, only numbers are used, and like tetris, the goal is to merge those numbers.
Rules:
There are several variants, some of them only for iOS or Android:
There is also a portable version at http://portableapps.com/news/2014-03-20--2048-portable-1.0-released .
With a download-size of nearly 18 MB (as it contains the node-webkit browser engine), this strikes me as quite a bit of bloat.
So, I decided to try a more frugal version in tcl.
When finished, it would be nice to make this into a selfcontained starkit.
# http://wiki.tcl.tk/39566
# 1k-p07.tcl
# A small game with numbers,
# like 1024 by Veewo Studio, 2048 by Gabriele Cirulli, or Threes by Asher Vollmer.
package require Tk
global Prg
set Prg(Title) "1K-Puzzle"
set Prg(Version) "v0.07"
set Prg(Date) "2014-03-23"
set Prg(Author) "Hans-Joachim Gurt"
set Prg(Contact) [string map -nocase {: @ ! .} gurt:gmx!de]
set Prg(About) "Combine equal numbers, to reach 1024"
set Prg(Msg) "Press up/down/left/right\nto move the numbers."
proc Start {} {
# Fill_Test
# after 1000 { Fill_Zero }
Fill_Zero
Fill_1
}
array set colors {
0 white
1 PeachPuff1
2 Goldenrod1
4 Orange2
8 Salmon1
16 IndianRed1
32 FireBrick1
64 PaleGreen1
128 MediumSpringGreen
256 Green1
512 SteelBlue1
1024 RoyalBlue1
2048 DeepPink1
4096 SlateBlue1
8192 Gold1
16384 SpringGreen1
}
# ...
# MistyRose1 Azure1 SlateBlue1 RoyalBlue1 DodgerBlue1 SteelBlue1
# DeepSkyBlue1 SkyBlue1 LightSkyBlue1 SlateGray1 LightBlue1
# LightCyan1 PaleTurquoise1 CadetBlue1 Turquoise1 Cyan1
# DarkSlateGray1
# AquaMarine1 DarkSeaGreen1 SeaGreen1 PaleGreen1 SpringGreen1
# Green1 Chartreuse1 OliveDrab1 DarkOliveGreen1
# Khaki LightGoldenrod1 LightYellow1 Yellow1 Gold1
# Goldenrod1 DarkGoldenrod1
# RosyBrown1 IndianRed1 Sienna1 BurlyWood1 Wheat1 Tan1
# Chocolate1 FireBrick1 Brown1 Salmon1 LightSalmon1
# Orange1 DarkOrange1 Coral1 Tomato1 OrangeRed1 Red1
# DeepPink1 HotPink1 Pink1 LightPink1
# PaleVioletRed1 Maroon1 VioletRed1 Magenta1 Orchid1 Plum1
# MediumOrchid1 DarkOrchid1 Purple1 MediumPurple1 Thistle1
# ...
proc Fill_Zero {} {
for {set r 1} {$r<=4} {incr r} {
for {set c 1} {$c<=4} {incr c} {
.b$r$c configure -text " " -bg white ;# -bg SystemButtonFace ;# -bg grey83
}
}
}
proc Fill_Test {} {
set cNr 0
for {set r 1} {$r<=4} {incr r} {
for {set c 1} {$c<=4} {incr c} {
SetCell $r $c $cNr
if { $cNr==0 } { set cNr 1 } else { set cNr [expr $cNr+$cNr] }
}
}
}
proc Fill_1 {} {
## TODO: random start
SetCell 1 1 1
SetCell 1 2 1
}
proc Ping1 { r c } {
# set v 99
set v [.b$r$c cget -text]
set ::Prg(Msg) "Ping: $r $c = $v"
}
proc Ping { r c } {
set v [.b$r$c cget -text]
set ::Prg(Msg) "Ping: $r $c = $v"
if { $v == " " } { set v 1 } else { set v [expr $v+$v] }
if { $v == "16384" } { set v 0 }
SetCell $r $c $v
}
proc SetCell { r c v } {
set color black
set val " "
if { $v > 0 } { set val $v }
#puts "SetCell $r $c $v "
set color $::colors($v)
puts "SetCell $r $c $v : $color"
.b$r$c configure -text $val -bg $color
}
proc Move { dir } {
set ::Prg(Msg) "Button pressed: $dir"
puts $::Prg(Msg)
## TODO ...
#Dummy:
if { $dir == 3 } { SetCell 1 1 2; SetCell 1 2 0; SetCell 2 3 1 }
if { $dir == 2 } { SetCell 4 1 2; SetCell 1 1 0
SetCell 4 3 1; SetCell 2 3 0; SetCell 1 4 1 }
if { $dir == 4 } { SetCell 4 1 0; SetCell 4 4 1; SetCell 2 2 1;
SetCell 4 3 2; SetCell 1 1 0; SetCell 4 4 1 }
}
proc InitGUI {} {
global Prg
wm title . "$Prg(Title) $Prg(Version)"
puts "$Prg(Title) $Prg(Version)"
frame .f0 -background grey ;# Outer frame
pack .f0 -padx 10 -pady 10
label .lb_1 -text $Prg(Title) -width 10 -bg DeepPink1 -pady 8
label .lb_2 -textvariable Prg(Msg) -width 30 -bg grey -pady 8
# rows:
frame .f1 -background red
frame .f2 -background yellow
frame .f3 -background green
frame .f4 -background blue
frame .fJ -background grey80 -pady 8 ;# Joystick-Buttons
frame .fB -background cyan -pady 2 ;# Start/Quit-Buttons
pack .lb_1 -in .f0 -pady 5
pack .f1 .f2 .f3 .f4 -in .f0
pack .lb_2 -in .f0 -pady 5
pack .fJ
pack .fB
option add *Button.width 4
option add *Button.height 2
for {set r 1} {$r<=4} {incr r} {
for {set c 1} {$c<=4} {incr c} {
button .b$r$c -text " " -command " Ping $r $c "
}
}
option add *Button.width 1
option add *Button.height 1
button .b1 -text "^" -command { Move 1 }
button .b2 -text "v" -command { Move 2 }
button .b3 -text "<" -command { Move 3 }
button .b4 -text ">" -command { Move 4 }
label ._ -text "+"
option add *Button.width 6
option add *Button.height 1
button .bt_start -text "Start" -command { Start }
button .bt_quit -text "Quit" -command { exit }
pack .b11 .b12 .b13 .b14 -in .f1 -side left -padx 0
pack .b21 .b22 .b23 .b24 -in .f2 -side left -padx 0
pack .b31 .b32 .b33 .b34 -in .f3 -side left -padx 0
pack .b41 .b42 .b43 .b44 -in .f4 -side left -padx 0
pack .b1 -in .fJ -side top
pack .b2 -in .fJ -side bottom
pack .b3 -in .fJ -side left
pack ._ -in .fJ -side left
pack .b4 -in .fJ -side right
pack .bt_start .bt_quit -in .fB -side left -padx 18 -pady 2
# bind all <Return> { Start }
bind all <Return> { Fill_Test } ;# Test
bind all <Escape> { exit }
# Cursorkeys:
bind all <KeyPress-Up> { Move 1 }
bind all <KeyPress-Down> { Move 2 }
bind all <KeyPress-Left> { Move 3 }
bind all <KeyPress-Right> { Move 4 }
# Keypad-Cursorkeys:
bind all <Key-KP_8> { Move 1 }
bind all <Key-KP_2> { Move 2 }
bind all <Key-KP_4> { Move 3 }
bind all <Key-KP_6> { Move 4 }
}
InitGUI
# bind all <Key-F2> {console show}
# catch {console show}
# catch {wm withdraw .}
#.