[HJG] 2014-04-22 - Playable now, but only "greedy movement", and no options/variants 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,
which has a number of play-variants.

But 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-p25.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.
  
  Currently only "greedy movement", 
  i.e.   1 1 1 1  -->  _ _ _ 4

  TODO:
  * Options / Menu for selection of play-variant
  ** First fit / Last fit / Random new tiles
  ** singlestep / greedy / 2048-movement
  * more flashy messages / text-effects
  * loadable color-table
  * cheat / tutorial - mode
  * tweak layout for small screen / pocket-pc
  * Joystick-buttons on/off
  * separate highscore for each play-variant
}

  package require Tk

  global Prg Colors

  set Prg(Title)    "1K-Puzzle"
  set Prg(Version)  "v0.25"
  set Prg(Date)     "2014-04-04"
  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)      $Prg(Title)
  set Prg(Help)     "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)   2

  set Prg(UserMoves)  0
  set Prg(NewTiles)   0
  set Prg(TileMoves)  0
  set Prg(TileMerges) 0
  set Prg(TilesFree)  16
  set Prg(TileSum)    0

  set Prg(MaxTile)    0
  set Prg(HiTile)     0   ;# 512
  set Prg(Score)      0
  set Prg(HiScore)    0   ;# 7550
  set Prg(LastMoves)  {}

  set  UserDir $::env(HOME)
 #set  UserDir "D:/Home/HaJo/Games"   ;##
  set  filepath [file join $UserDir 1K_score.dat]

  set Prg(HiScoreFN)  $filepath


  array set Colors {
      BgO  grey
      Hdr  DeepPink1
     Msg0  grey
     Msg1  red
      Sc0  LightYellow1
      Sc1  pink
      Sc2  cyan
      BgJ  grey80
      BgB  cyan
     BTx0  black
     BTx1  blue
    Empty  white
        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 int x  { expr int($x) }

  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
            .b$r$c configure -text " " -bg $::Colors(Empty)
        }
     }
  }

  proc Fill_1 {} {
  # no random start : cycle thru unique starting positions
    global Prg

    set i $Prg(OptStart)
    puts "Fill_1 : $i"

    switch $i {
      1 {               ;# 1-2
        SetCell 1 1  1
        SetCell 1 2  1
        set ::Prg(NewTiles) 2
      }
      2 {               ;# 2-3
        SetCell 2 3  1
        SetCell 3 2  1
        set ::Prg(NewTiles) 2
      }
      3 {               ;# 3-4
        SetCell 1 3  1
        SetCell 4 4  1
        set ::Prg(NewTiles) 2
      }
      4 {               ;# 1-3
        SetCell 3 3  1
        SetCell 4 1  1
        set ::Prg(NewTiles) 2
      }
      5 {               ;# 1-4
        SetCell 1 1  1
        SetCell 2 2  1
        SetCell 3 4  1
        SetCell 4 3  1
        set ::Prg(NewTiles) 4
      }
      6 {               ;# 2+3
        SetCell 2 3  1
        SetCell 4 2  2
        set ::Prg(NewTiles) 2
      }

      9 {               ;# 4+2
        SetCell 1 1  2
        SetCell 2 1  1
        SetCell 3 1  1
        SetCell 4 1  2
        set ::Prg(NewTiles) 4
      }

      default {         ;# 3+4
        SetCell 3 3  2
        SetCell 1 4  1
        set ::Prg(NewTiles) 2

        set i 0
      }
    }
    incr i 1

    set Prg(OptStart) $i
  # puts "Fill_1 = $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
  }

  proc Status { } {
    global Prg

    set Prg(Dbg)  "Last moves:  $Prg(LastMoves) ."
    set Prg(LastMoves) {}
    puts $Prg(Dbg)

    set m [CheckPossibleMoves]
    set ::Prg(Dbg)  "Status:
                     UserMoves $Prg(UserMoves)  NewTiles   $Prg(NewTiles)
                     TileMoves $Prg(TileMoves)  TileMerges $Prg(TileMerges)
                     MaxTile   $Prg(MaxTile)    TileSum    $Prg(TileSum)
                     Free      $Prg(TilesFree)  Score      $Prg(Score) "
    puts $::Prg(Dbg)
    puts "CheckPossibleMoves: $m"
    puts "CheckPossibleMoves: [CheckPossibleMoves]"
  }
  
  #---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+

  proc SetCell { r c v } {
    global Prg Colors

    set color black
    set val " "
    if { $v > 0 } { 
      set val $v 
      incr $Prg(NewTiles) 1
    }

   #puts "SetCell $r $c $v "
    set color $Colors($v)
    puts "SetCell $r $c : $v = $color"

    .b$r$c configure -text $val -bg $color

    incr Prg(TilesFree) -1
    incr Prg(TileSum)   $v

    set  Prg(Dbg) "$Prg(NewTiles)  Free= $Prg(TilesFree) \nTileSum= $Prg(TileSum)"
    puts $::Prg(Dbg)
  }

  proc Mv { r1 c1  r2 c2 } {
  #: Move a single tile
    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
        set sum [expr $v1+$v2]
      # SetCell $r2 $c2 [expr $v1+$v2]
        SetCell $r2 $c2  $sum
        SetCell $r1 $c1 0
        incr Prg(TileMerges) 1

      # SCORE: sum of merged tiles
        incr ::Prg(Score) $sum
        if {$sum > $::Prg(MaxTile)} { set ::Prg(MaxTile) $sum }
      }
      if {$v2 == " "} {  ;# destination is free: move tile #1
        SetCell $r2 $c2 $v1
        SetCell $r1 $c1 0
        incr Prg(TileMoves) 1
      }
    }

  }

  proc Move { dir } {
  #: Process move-commands from player,
  # then check results, generate new tile, or game-over.
    global Prg Colors

    set    Prg(Dbg)  "Button pressed: $dir"
    puts  $Prg(Dbg)
    append Prg(LastMoves) $dir

    if { $dir == "_" }  {
      append Prg(LastMoves) " \n"
      return
    }
    if { $dir == "." }  {
      append Prg(LastMoves) " = $Prg(Score) \n"
      return
    }

 ## 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
  }
}

  # "original" 2048 movement :
if 0 {
  # TODO
}
    set  Prg(Dbg)  "Moves : $Prg(TileMoves) \nMerges: $Prg(TileMerges) "
    puts $::Prg(Dbg)

    set  a $Prg(TileMoves)
    incr a $Prg(TileMerges)

    if {$a == 0 } {
      set m [CheckPossibleMoves]
      set Prg(Dbg) "Move not possible / $m"
      puts $::Prg(Dbg)
      Beep
    } else {
      incr ::Prg(UserMoves)  1      ;# Move was successful

      # Find free tile(s), check for game over, create new tile:
      set freeTiles 0
      set Prg(TileSum) 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
          } else {
            incr Prg(TileSum) [int $v]
          }
        }
      }

      set Prg(TilesFree)  $freeTiles
      set Prg(Dbg) "Free: $freeTiles"
      puts $::Prg(Dbg)

      ## TODO:  select (random) new number and position
      ## TODO:  also check for possible moves

      set m [CheckPossibleMoves]
      puts "CPM=$m"
    # set Prg(Msg) "GAME:  $Prg(UserMoves) $Prg(TilesFree) : $m"
      set Prg(Msg) "Moves:  $Prg(UserMoves) \n Sum  : $Prg(TileSum)"
      puts $::Prg(Msg)
    }

    if {$m < 1} {
    # set Prg(Msg) "GAME OVER !\n Score $Prg(Score)"
      set Prg(Msg) "GAME OVER !\n "
      if {$Prg(Score) > $Prg(HiScore)} {
        set    Prg(HiScore) $Prg(Score)
        append Prg(Msg) "New Highscore !"
        HiScoreFile_Write
      }
      .lb_2  configure -bg  $Colors(Msg1)
      puts $::Prg(Msg)

    } else {
      if  { $a > 0 } {
        after 150  SetCell $r0 $c0 1; 
        after 151  set Prg(Msg) {"Moves:  $Prg(UserMoves) \n Sum  : $Prg(TileSum)"}
      }
    }

  }

  proc Beep {} {
      puts "\a"
  }

  proc sleep { ms } {
      after $ms
  }

  proc CheckPossibleMoves {} {
    # More moves are possible when an empty tile is found,
    # or tiles with the same value at neighboring positions.
    # Returns 0 if no more moves are possible.
    # Shortcut: exits when the first possible move is found.
     set res 0
     # check along rows:
     for {set r 1} {$r<=4} {incr r} {
        set prev " "
        for {set c 1} {$c<=4} {incr c} {
          set v [.b$r$c cget -text]
          if {$v == " "} {
            return 1        ;# free tile found
          } else {
            if { $v==$prev } { incr res 1; return $v }
         ## puts "CPM: $r $c : '$prev'$v' = $res"
          }
          set prev $v
        }
     }
     # check along cols:
     for {set c 1} {$c<=4} {incr c} {
        set prev " "
        for {set r 1} {$r<=4} {incr r} {
          set v [.b$r$c cget -text]
          if {$v ne " "} {
            if { $v==$prev } { incr res 1; return $v }
         ## puts "CPM: $r $c : '$prev'$v' = $res"
          }
          set prev $v
        }
     }

     return $res
  }

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

  proc Start { i } {
      global Prg Colors

      set Prg(UserMoves)  0
      set Prg(Score)      0
      set Prg(MaxTile)    0
      set Prg(LastMoves)  {}
      set Prg(Msg)        $Prg(Help)

      .fJ       configure -bg cyan
      .fB       configure -bg gray80
      .bt_quit  configure -fg red
      .lb_2     configure -bg $Colors(Msg0)

      # Fill_Test
      # after 1000  { Fill_Zero }

      Fill_Zero
      Fill_1
  }

  ### Test: Autoplay

  proc P3 { } {
  # Fast testgame (~24s) : 87 moves, score 304 
    set d 100
    foreach k { 1 2 4 1 3 2 4  1 2 1 2 1 2 4 1 2 1 2 1 2 3 1 2 1 4 3 4
                1 2 1 2 1 2 1 2 1 2 1 2  1 4 2 1 2 1 1 1 4 3
                1 2 1 2 1 2  3 1 2 3  4 1 3 4  1 1 1 1  1 4 3 1 3 4 2  
                1 2 4 3   4 3 2 3  1 2 3 3 2  1 3 3 3 3 3 } {      
      incr d 250
      after $d  Move $k
    }
  }
  
  proc P4 { } {
    # Simple repeat: Up, Left --> gets to score 1020 in 223 moves
    set d 100
    for {set i 1} {$i<=112} {incr i} {
      foreach k { 1 3  } {
        incr d 250
        after $d  Move $k
      }
    }
  }

  proc P9 { } {
    # Roundabout/Repeat:
    set d 100
    for {set i 1} {$i<=101} {incr i} {
      foreach k { 1 4 2 3  } {
        incr d 250
        after $d  Move $k
      }
    }
  }

  proc Play { } {
  #: AutoPlay for testing
    P3;
  }
  
  #---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+

  proc _ButtonInvoke { w } {
    event generate $w <1>
    event generate $w <ButtonRelease-1>
 #  after 100 {event generate $w <ButtonRelease-1>}
  }

  proc HiScoreFile_Read {} {
    set  filepath $::Prg(HiScoreFN)
    puts "Read file $::Prg(HiScoreFN) ..."
    
    if {![file exists $filepath] || [catch { set fh [open $filepath r] } ] } {
           puts "Error: open $filepath"
           return
    }
    
    set i 0
    while {![chan eof $fh]} {
           gets $fh line
           incr i 1
           puts "$i:$line."
           if {$line ne ""} {
             set ::Prg(HiScore) $line
           }
    }
    close $fh
  }

  proc HiScoreFile_Write {} {
    puts "Write file $::Prg(HiScoreFN) ..."
    set filepath $::Prg(HiScoreFN)
    set fh [open $filepath w]     ;# w / w+
    puts  $fh $::Prg(HiScore)
    close $fh
  }
  
  #---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+

  proc InitGUI {} {
      global Prg Colors

      wm title . "$Prg(Title) $Prg(Version)"
      puts       "$Prg(Title) $Prg(Version)"

      frame .f0   -background $Colors(BgO)                ;# Outer frame
      pack  .f0   -padx 10  -pady 10

      frame .fS  -background $Colors(Sc0)                 ;# Score-Display

      label .lb_1 -text   $Prg(Title) -width 10 -bg $Colors(Hdr)  -pady 8
      label .lb_2 -textvar Prg(Msg)   -width 30 -bg $Colors(Msg0) -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 $Colors(Sc1) -padx 6 -pady 4
      label .lb_H -textvar Prg(HiScore)   -width 8 -bg $Colors(Sc2) -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 $Colors(BgJ) -pady 8 -padx 8 ;# Joystick-Buttons
      frame .fB  -background $Colors(BgB) -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_new   -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_new .bt_quit  -in .fB  -side left -padx 18 -pady 2

    # bind all <Return>     { Start 1 }
   ## bind all <Return>     { Fill_Test }   ;# Test
      bind all <Return>     { Status  }     ;# Test
      bind all <space>      { Play   }      ;# Test
      bind all <BackSpace>  { Move . }      ;# 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
  HiScoreFile_Read
  Start 0
  return


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

#.
======


<<categories>> Games