[HJG] 2014-04-04 - Work in progress / Playable, but highscore is not saved yet. Also, no options yet.

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.
Like tetris, new items keep coming in, and the player has to get rid of them
(i.e. merge those numbers to make room for more).

Rules:
   * The playfield has tiles with numbers.
   * With the arrow-keys all tiles move.
   * Tiles with the same number merge.
   * The goal is to reach a high number, e.g. 1024 or 2048.
   * After every move, a new low number appears on a free tile.
   * The game is over when there is no free tile to create a new number.


There are several variants, some of them only for iOS or Android:
   * The web-based "official version" of [http://gabrielecirulli.github.io/2048%|%2048 by Gabriele Cirulli%|%], with code at https://github.com/gabrielecirulli/2048
   * [https://itunes.apple.com/us/app/1024!/id823499224%|%1024%|%] by [http://www.veewo.com%|%Veewo Studio%|%]
   * [https://play.google.com/store/apps/details?id=com.veewo.a1024%|%1024%|%]
   * [http://asherv.com/threes/%|%Threes by Asher Vollmer%|%]
   * [http://saming.fr/p/2048%|%Saming's 2048 %|%]

[AMG]: Discussion of clones of this game: [http://techcrunch.com/2014/03/24/clones-clones-everywhere-1024-2048-and-other-copies-of-popular-paid-game-threes-fill-the-app-stores/]. Apparently Threes came first.

[HJG]: Actually, the first place I heard about this game was at http://xkcd.com/1344
(, which made no sense to me, so I had to go to http://www.explainxkcd.com/wiki/index.php/1344 :)

There is also a portable version at http://portableapps.com/news/2014-04-17--2048-portable-2.1-released

With a download-size of 20 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 tclkit / starkit.

I noticed there are several ways to interpret the rules 
for moving and joining, so I'm going to put in a menu for user-options...

======
  # http://wiki.tcl.tk/39566
  # 1k-p11.tcl

if 0 {
  A small game of moving and combining numbers,
  like 1024 by Veewo Studio,
  2048 by Gabriele Cirulli,
  or Threes by Asher Vollmer.

  TODO:
  * Random new tiles
  * Score, Highscore-file
  * 2048-movement
  * Select play-variant
  * cheat / tutorial - mode
}

  package require Tk

  global Prg
  set Prg(Title)    "1K-Puzzle"
  set Prg(Version)  "v0.11"
  set Prg(Date)     "2014-03-25"
  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."

  set Prg(Dbg)      "Test"    
  set Prg(OptDebug)   0
  
  set Prg(OptSkin)    1
  set Prg(OptMove)    1
  set Prg(OptNew1)    1
  set Prg(OptNew2)    1
  set Prg(OptGoal)    1024

  set Prg(OptStart)   1
  set Prg(UserMoves)  0  
  set Prg(TileMoves)  0
  set Prg(TilesFree)  0
  set Prg(TileMerges) 0
  set Prg(Score)      0
  set Prg(HiScore)    457
      
  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_1 {} {
  ## TODO: random start
  if 1 {
      SetCell 1 1  1
      SetCell 1 2  1
      incr ::Prg(Score) 2
  }
  if 0 {
      SetCell 1 1  1
      SetCell 1 2  1
      SetCell 1 3  1
      SetCell 1 4  1

      SetCell 2 1  2
      SetCell 2 2  2
      SetCell 2 4  1

      SetCell 3 1  1
      SetCell 3 3  1
      SetCell 3 4  1

      SetCell 4 2  1
      SetCell 4 4  1
      incr ::Prg(Score) 12
  }
  if 0 { 
      SetCell 1 4  1
  
      SetCell 2 2  1
      SetCell 2 3  1
      
      SetCell 3 2  1
      SetCell 3 4  1

      SetCell 4 1  1
      SetCell 4 2  1
      SetCell 4 3  1
      SetCell 4 4  1
      incr ::Prg(Score) 9
  }
  }

  proc Fill_2 {} {
    global Prg
    
    set i $Prg(OptStart)
    incr i 1
    puts "Fill_2 : $i"

    switch $i {
      1 {
        SetCell 1 1  1
        SetCell 1 2  1
        set ::Prg(Score) 2
      }
      2 {
        SetCell 2 3  1
        SetCell 3 2  1
        set ::Prg(Score) 2
      }
      3 {
        SetCell 3 3  1
        SetCell 4 1  1
        set ::Prg(Score) 2
      }
      default {
        SetCell 2 3  1
        SetCell 4 2  2
        set ::Prg(Score) 3

        set i 0
      }
    }
    set Prg(OptStart) $i
  # puts "Fill_2 = $Prg(OptStart)"
  }

  # Test:

  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 Ping1 { r c } {
  # set v 99
    set v [.b$r$c cget -text]
    set ::Prg(Dbg)  "Ping: $r $c = $v"
  }
  proc Ping { r c } {
    set v [.b$r$c cget -text]
    set ::Prg(Dbg)  "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
  }

  #---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+

  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 Mv { r1 c1 r2 c2 } {
    global Prg
    
    set v1 [.b$r1$c1 cget -text]
    set v2 [.b$r2$c2 cget -text]

    set Prg(Dbg)  "Mv: $r1 $c1 - $r2 $c2 = $v1,$v2"
    puts $::Prg(Dbg)

    if {$v1 ne " "} {
      if {$v2 == $v1 } {  ;# matching tiles: merge tile #1 + #2
        SetCell $r2 $c2 [expr $v1+$v2]
        SetCell $r1 $c1 0
        incr Prg(TileMerges) 1
      }
      if {$v2 == " "} {  ;# destination is free: move tile #1
        SetCell $r2 $c2 $v1
        SetCell $r1 $c1 0
        incr Prg(TileMoves) 1
      }
    }

  }

  proc Move { dir } {
    global Prg
    
    set   Prg(Dbg)  "Button pressed: $dir"
    puts $Prg(Dbg)

## TODO: "original" 2048 movement
## TODO: better move-algorithm

    set Prg(TileMoves)    0
    set Prg(TileMerges)   0

  # "single-step" movement :
if 0 {  
    if { $dir == 1 }  {
    Mv 2 1  1 1;  Mv 3 1  2 1;  Mv 4 1  3 1
    Mv 2 2  1 2;  Mv 3 2  2 2;  Mv 4 2  3 2
    Mv 2 3  1 3;  Mv 3 3  2 3;  Mv 4 3  3 3
    Mv 2 4  1 4;  Mv 3 4  2 4;  Mv 4 4  3 4
  }
  if { $dir == 2 }  {
    Mv 3 1  4 1;  Mv 2 1  3 1;  Mv 1 1  2 1
    Mv 3 2  4 2;  Mv 2 2  3 2;  Mv 1 2  2 2
    Mv 3 3  4 3;  Mv 2 3  3 3;  Mv 1 3  2 3
    Mv 3 4  4 4;  Mv 2 4  3 4;  Mv 1 4  2 4
  }
  if { $dir == 3 }  {
    Mv 1 2  1 1;  Mv 1 3  1 2;  Mv 1 4  1 3
    Mv 2 2  2 1;  Mv 2 3  2 2;  Mv 2 4  2 3
    Mv 3 2  3 1;  Mv 3 3  3 2;  Mv 3 4  3 3
    Mv 4 2  4 1;  Mv 4 3  4 2;  Mv 4 4  4 3
  }
  if { $dir == 4 }  {
    Mv 1 3  1 4;  Mv 1 2  1 3;  Mv 1 1  1 2
    Mv 2 3  2 4;  Mv 2 2  2 3;  Mv 2 1  2 2
    Mv 3 3  3 4;  Mv 3 2  3 3;  Mv 3 1  3 2
    Mv 4 3  4 4;  Mv 4 2  4 3;  Mv 4 1  4 2
  }
}

  ###
  
  # "greedy" movement :
if 1 {
  if { $dir == 1 }  {
    Mv 2 1  1 1;  Mv 3 1  2 1;  Mv 4 1  3 1
    Mv 2 1  1 1;  Mv 3 1  2 1;  
    Mv 2 1  1 1;  
                                     
    Mv 2 2  1 2;  Mv 3 2  2 2;  Mv 4 2  3 2
    Mv 2 2  1 2;  Mv 3 2  2 2;  
    Mv 2 2  1 2;  
                                     
    Mv 2 3  1 3;  Mv 3 3  2 3;  Mv 4 3  3 3
    Mv 2 3  1 3;  Mv 3 3  2 3;  
    Mv 2 3  1 3;  
                                     
    Mv 2 4  1 4;  Mv 3 4  2 4;  Mv 4 4  3 4
    Mv 2 4  1 4;  Mv 3 4  2 4; 
    Mv 2 4  1 4;  
  }
  if { $dir == 2 }  {
    Mv 3 1  4 1;  Mv 2 1  3 1;  Mv 1 1  2 1
    Mv 3 1  4 1;  Mv 2 1  3 1;  
    Mv 3 1  4 1;  
        
    Mv 3 2  4 2;  Mv 2 2  3 2;  Mv 1 2  2 2
    Mv 3 2  4 2;  Mv 2 2  3 2; 
    Mv 3 2  4 2;  
                                     
    Mv 3 3  4 3;  Mv 2 3  3 3;  Mv 1 3  2 3
    Mv 3 3  4 3;  Mv 2 3  3 3;
    Mv 3 3  4 3;  
                                     
    Mv 3 4  4 4;  Mv 2 4  3 4;  Mv 1 4  2 4
    Mv 3 4  4 4;  Mv 2 4  3 4;
    Mv 3 4  4 4;  
  }
  if { $dir == 3 }  {
    Mv 1 2  1 1;  Mv 1 3  1 2;  Mv 1 4  1 3
    Mv 1 2  1 1;  Mv 1 3  1 2
    Mv 1 2  1 1

    Mv 2 2  2 1;  Mv 2 3  2 2;  Mv 2 4  2 3
    Mv 2 2  2 1;  Mv 2 3  2 2
    Mv 2 2  2 1

    Mv 3 2  3 1;  Mv 3 3  3 2;  Mv 3 4  3 3
    Mv 3 2  3 1;  Mv 3 3  3 2
    Mv 3 2  3 1

    Mv 4 2  4 1;  Mv 4 3  4 2;  Mv 4 4  4 3
    Mv 4 2  4 1;  Mv 4 3  4 2
    Mv 4 2  4 1
  }
  if { $dir == 4 }  {
    Mv 1 3  1 4;  Mv 1 2  1 3;  Mv 1 1  1 2
    Mv 1 3  1 4;  Mv 1 2  1 3
    Mv 1 3  1 4

    Mv 2 3  2 4;  Mv 2 2  2 3;  Mv 2 1  2 2
    Mv 2 3  2 4;  Mv 2 2  2 3
    Mv 2 3  2 4

    Mv 3 3  3 4;  Mv 3 2  3 3;  Mv 3 1  3 2
    Mv 3 3  3 4;  Mv 3 2  3 3
    Mv 3 3  3 4

    Mv 4 3  4 4;  Mv 4 2  4 3;  Mv 4 1  4 2
    Mv 4 3  4 4;  Mv 4 2  4 3
    Mv 4 3  4 4
  }
}
    set  Prg(Dbg)  "Moves: $Prg(TileMoves) \nMerges: $Prg(TileMerges) "
    puts $::Prg(Dbg)
    
    set  a $Prg(TileMoves)
    incr a $Prg(TileMerges)

    if {$a == 0 } {
      set Prg(Dbg) "No Move"
      puts $::Prg(Dbg)
    } else {  
      incr ::Prg(UserMoves)  1      ;# Move was successful
      # Find free tile(s), check for game over, create new tile:
      set freeTiles 0
      set r0 0
      set c0 0
      for {set r 1} {$r<=4} {incr r} {
        for {set c 1} {$c<=4} {incr c} {
          set v [.b$r$c cget -text]
          if {$v == " "} {
            incr freeTiles 1
            set r0 $r
            set c0 $c
          }
        }
      }
      set Prg(TilesFree)  $freeTiles
      set Prg(Dbg) "Free: $freeTiles"
      puts $::Prg(Dbg)
  
      ## TODO:  select (random) new number and position
      
      if {$freeTiles < 1} {    
        set Prg(Msg) "GAME OVER !\n Score $Prg(Score)"
        puts $::Prg(Msg)
      } else {
          after 150 SetCell $r0 $c0 1
          incr ::Prg(Score)         1
      }
    }    
  }

  #---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+

  proc Start { i } {
      set ::Prg(UserMoves)  0
      set ::Prg(Score)      0
      
      .fB       configure -bg gray80  ;# cyan
      .fJ       configure -bg cyan
      .bt_start configure -fg red
      .bt_quit  configure -fg red
          
      # Fill_Test
      # after 1000  { Fill_Zero }
      Fill_Zero
      
      if {$i == 0} { 
        Fill_1 
      } else {
        Fill_2
      }
  }

  proc ButtonInvoke { w } {
    event generate $w <1>
    event generate $w <ButtonRelease-1>
#   after 100 {event generate $w <ButtonRelease-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

      frame .fS  -background LightYellow1                ;# Score-Display

      label .lb_1 -text   $Prg(Title) -width 10 -bg DeepPink1 -pady 8
      label .lb_2 -textvar Prg(Msg)   -width 30 -bg grey      -pady 8 -height 2 

    # label .lb_F -textvar Prg(TilesFree) -width 8 -bg cyan -padx 6 -pady 2
      label .lb_S -textvar Prg(Score)     -width 8 -bg pink -padx 6 -pady 4
      label .lb_H -textvar Prg(HiScore)   -width 8 -bg cyan -padx 6 -pady 4
                 
      # rows of playfield:
      frame .f1  -background red
      frame .f2  -background yellow
      frame .f3  -background green
      frame .f4  -background blue
      # buttons:
      frame .fJ  -background grey80   -pady 8  -padx 8   ;# Joystick-Buttons
      frame .fB  -background cyan     -pady 2            ;# Start/Quit-Buttons

      pack .lb_1            -in .f0   -pady 5
      pack .fS              -in .f0   -pady 5 
      pack .lb_S  .lb_H     -in .fS   -side left -padx 2 -pady 2

      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 "
          button .b$r$c -text " " 
        }
      }

      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 "New " -command { Start  1 }
      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 1 }
  ##  bind all <Return>   { Fill_Test }     ;# Test
      bind all <Escape>   { exit  }
      
      ;# button-animation :
      bind all <<Click>> {
          event generate %W <1>
          after 50 {event generate %W <ButtonRelease-1>}
      }
      # Cursorkeys:                             
      bind all <KeyPress-Up>    { .b1 invoke; event generate .b1 <<Click>> }
      bind all <KeyPress-Down>  { .b2 invoke; event generate .b2 <<Click>> }
      bind all <KeyPress-Left>  { .b3 invoke; event generate .b3 <<Click>> }
      bind all <KeyPress-Right> { .b4 invoke; event generate .b4 <<Click>> }

      # Keypad-Cursorkeys:
      bind all <Key-KP_8>       { .b1 invoke; event generate .b1 <<Click>>  }
      bind all <Key-KP_2>       { .b2 invoke; event generate .b2 <<Click>>  }
      bind all <Key-KP_4>       { .b3 invoke; event generate .b3 <<Click>>  }
      bind all <Key-KP_6>       { .b4 invoke; event generate .b4 <<Click>>  }

  }

  InitGUI
  Start 0

# bind all <Key-F2> {console show}
# catch {console show}
# catch {wm withdraw .}


#.
======

See also:
   * [Colors with Names]
   * [event generate] - animated button-click
   * [Techniques for reading and writing application configuration files]
   * [Loading and Saving Application Configuration Files]
   * [gridDemo-Pack]

<<categories>> Games