[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 sudoku, only numbers are used, and like tetris, the goal is to merge those numbers. The web-based "official version of 2048" is at http://gabrielecirulli.github.io/2048/ 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. ====== # 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 equeal numbers, to reach 1024" set Prg(Msg) "Press up/down,left/right." 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 { Start } bind all { Fill_Test } ;# Test bind all { exit } # Cursorkeys: bind all { Move 1 } bind all { Move 2 } bind all { Move 3 } bind all { Move 4 } # Keypad-Cursorkeys: bind all { Move 1 } bind all { Move 2 } bind all { Move 3 } bind all { Move 4 } } InitGUI # bind all {console show} # catch {console show} # catch {wm withdraw .} #. ====== <> Games