Summary edit

• 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.

• The web-based "official version" of 2048 by Gabriele Cirulli, with code at https://github.com/gabrielecirulli/2048
• 1024 by Veewo Studio
• 1024
• Threes by Asher Vollmer
• Saming's 2048
• 2048 at RosettaCode.org

http://xkcd.com/1344

http://www.explainxkcd.com/wiki/index.php/1344

http://portableapps.com/news/2014-04-17--2048-portable-2.1-released

1. the "new" button always has the focus during the game, so if one inadvertently touches the space bar, your hiscore is down the drain :-(
2. I guess you didn't realize, but as the program lacks the randomness of 2k, it's in fact possible to reach the 32768 tile. Unfortunately, the Colors array only has entries up to 16384...

Developer's comments edit

• Download a Tclkit: e.g. http://tclkit.googlecode.com/files/tclkit-8.5.8-win32.upx.exe (1.3 MB)
• download the above script into a textfile "1k.tcl", i.e. the part between "package require Tk" and "#." (30 KB)
• put both files into the same directory (the desktop should be fine, but I recommand a fresh directory, e.g. in the user's home)
• Drop the script 1k.tcl onto the runtime tclkit*.exe --> program should run now

Code edit

  # http://wiki.tcl.tk/39566
  # 1k-p32.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 highscores for each play-variant
  * a few more records, e.g. lowscore / fastfill
}

  package require Tk

  global Prg Colors

  set Prg(Title)      "1K-Puzzle"
  set Prg(Version)    "v0.32"
  set Prg(Date)       "2014-04-21"
  set Prg(Author)     "Hans-Joachim Gurt"
  set Prg(Contact)    [string map -nocase {: @ ! .} gurt:gmx!de]

  set Prg(About)      "A small game, moving around and combining numbers."
  set Prg(Msg)        "$Prg(Title)  $Prg(Version)\nby $Prg(Author)"
  set Prg(Help1)      "Press up/down/left/right\nto move the numbers."
  set Prg(Help2)      "Combine equal numbers,\nto reach value 1024."

  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(GameVar)   "GL1"    ;# Move=Greedy  NewTile=Last  New=1

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

  set Prg(HiScoreFN)  $filepath

  set Prg(DateTime)   "Now"
  set Prg(FinalMoves) 0
  set Prg(LowMoves)   999     ;# 79
  set Prg(MaxTile)    0
  set Prg(HiTile)     0       ;# 512
  set Prg(Score)      0
  set Prg(HiScore)    0       ;# 7550

  set Prg(State)      0       ;# 0=Init 1,2=Start 6=play 9=GameOver
  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(LastMoves)  {}

  array set Colors {
      BgO  grey
    HdrBg  DeepPink1
    HdrFg  black

   Msg0bg  grey60
   Msg0fg  black
   Msg1bg  SlateBlue1
   Msg1fg  black
   Msg2bg  SlateBlue2
   Msg2fg  black
   Msg9bg  red
   Msg9fg  white

      Sc0  LightYellow1
      Sc1  pink
      Sc2  cyan
    BgJ_x  grey80
    BgJ_a  cyan
    BgB_x  grey80
    BgB_a  cyan
     BTx0  black
     BTx1  blue
     BTx9  red

    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 maxi { curr hi }  {
    if { $curr > $hi } { return $curr } else { return $hi }
  }

  proc Now {} {
    set td [clock format [clock seconds] -format "%Y-%m-%d  %H:%M:%S" ]
    return $td
  }

  proc Beep {} {
    # puts "\a"
      bell
  }

  proc sleep { ms } {
      after $ms
  }

  ###

  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
        SetTile 1 1  1
        SetTile 1 2  1
        set ::Prg(NewTiles) 2
      }
      2 {               ;# 2-3
        SetTile 2 3  1
        SetTile 3 2  1
        set ::Prg(NewTiles) 2
      }
      3 {               ;# 3-4
        SetTile 1 3  1
        SetTile 4 4  1
        set ::Prg(NewTiles) 2
      }
      4 {               ;# 1-3
        SetTile 3 3  1
        SetTile 4 1  1
        set ::Prg(NewTiles) 2
      }
      5 {               ;# 1-4
        SetTile 1 1  1
        SetTile 2 2  1
        SetTile 3 4  1
        SetTile 4 3  1
        set ::Prg(NewTiles) 4
      }
      6 {               ;# 2+3
        SetTile 2 3  1
        SetTile 4 2  2
        set ::Prg(NewTiles) 2
      }

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

      default {         ;# 3+4
        SetTile 3 3  2
        SetTile 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} {
          SetTile $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 }
    SetTile $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 SetTile { r c v } {
  # set tile at  row, col to value
    global Prg Colors

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

   #puts "SetTile $r $c $v "
    set color $Colors($v)
    puts "SetTile $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 (and, if possible, merge it with others)
    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]
      # SetTile $r2 $c2 [expr $v1+$v2]
        SetTile $r2 $c2  $sum
        SetTile $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
        SetTile $r2 $c2 $v1
        SetTile $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

    puts "State: $Prg(State)"
    set   Prg(State) [maxi $Prg(State) 6]
    .lb_2  configure  -bg $Colors(Msg0bg)  -fg $Colors(Msg0fg)
    .fJ    configure  -bg $Colors(BgJ_a)
    .fB    configure  -bg $Colors(BgJ_x)
    puts "State: $Prg(State)"

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

    # Debug/Logging;
    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

if 0 {
  # "single-step" movement :
    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
  }
}

  ###

if 1 {
  # "greedy" movement :
  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
  }
}

  ###

if 0 {
  # "original" 2048 movement :
  # 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)
      set Prg(Msg) "invalid move"
      append Prg(LastMoves) "< "
      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

      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)"
      set Prg(Msg) "Moves: $Prg(UserMoves)"
      puts $::Prg(Msg)
    }

    if {$m < 1} {
      set Prg(State) 9
      set Prg(Msg) "GAME OVER !\n "
    # set Prg(Msg) "GAME OVER !\n Score $Prg(Score)"
    # set Prg(Msg) "GAME OVER !\n after $Prg(UserMoves) moves"
      if {$Prg(Score) > $Prg(HiScore)} {
        set    Prg(HiScore) $Prg(Score)
        append Prg(Msg) "New Highscore !"
        HiScoreFile_Write
      } else {
        append Prg(Msg) "after $Prg(UserMoves) moves."
      }
      .lb_2  configure  -bg $Colors(Msg9bg)  -fg $Colors(Msg9fg)
      .fJ    configure  -bg $Colors(BgJ_x)
      .fB    configure  -bg $Colors(BgJ_a)
      puts $::Prg(Msg)

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

  }


  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----+

  ### Test: Autoplay

  proc P3 { } {
  # Fast testgame (~22s) : 79 moves, score 234
    set d 100
  # puts "P234:"
    foreach s { 111111111111111_33333333333333_11111111111111_333333_
                42 13131313 4_13131313 3333 43 13131 .
              } {
      for {set i 0} {$i<=[string length $s] } {incr i} {
        set k [string index $s $i]
        if { [string first $k "_1234."] >= 0 } {
          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
    P4;
  }

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

  proc Tick { state } {
  #: Attractmode
    global Prg Colors

    puts "Tick: $Prg(State) $state"
    if { $Prg(State) > 2 } { return }

    set Prg(State) $state

    if { $state == 1 } {
      set Prg(Msg)  $Prg(Help1)
      .lb_2         configure  -bg $Colors(Msg1bg)  -fg $Colors(Msg1fg)
      .fJ           configure  -bg $Colors(BgJ_a)
      after 3000  { Tick 2 }
    }

    if { $Prg(State) == 2 } {
      set Prg(Msg)  $Prg(Help2)
      .lb_2         configure  -bg $Colors(Msg2bg)  -fg $Colors(Msg2fg)
      after 5000  { Tick 1 }
    }

  }

  proc Start { arg } {
    global Prg Colors

    set Prg(DateTime) [Now]
    puts "Start: $Prg(DateTime)"

    set Prg(State)      1
    set Prg(UserMoves)  0
    set Prg(Score)      0
    set Prg(MaxTile)    0
    set Prg(LastMoves)  {}

    .bt_quit  configure -fg $Colors(BTx9)
    .bt_new   configure -fg $Colors(BTx1)
    .lb_2     configure -bg $Colors(Msg0bg) -fg $Colors(Msg0fg)

    if { $arg==0 } {                #; called from main
      .fJ     configure -bg $Colors(BgJ_x)
      .fB     configure -bg $Colors(BgB_a)
      .bt_new configure -fg $Colors(BTx1)
    } else {                        #; called from button
      .fJ     configure -bg $Colors(BgJ_a)
      .fB     configure -bg $Colors(BgB_x)
      set Prg(Msg)      "New game selected"
    }

    # Fill_Test
    # after 1000  { Fill_Zero }

    Fill_Zero
    Fill_1

    foreach id [after info] {after cancel $id}  ;# cancel all 'after'-commands
    after 7000  { Tick 1 }
  }

  proc HiScoreFile_Read {} {
    set  filepath $::Prg(HiScoreFN)
    puts "Read file $filepath ..."

    if {![file exists $filepath] || [catch { set fh [open $filepath r] } ] } {
      puts "Error: open $filepath"
      return 1
    }

    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 {} {
    set filepath $::Prg(HiScoreFN)
    puts "Write file $filepath ..."

    set fh [open $filepath w]     ;# w / w+
    puts  $fh $::Prg(HiScore)
    close $fh
  }

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

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

      font create fontH -family fixed -weight bold
      label .lb_1 -text   $Prg(Title) -width 10 -font fontH \
                  -bg $Colors(HdrBg)  -fg $Colors(HdrFg)  -pady 8
      label .lb_2 -textvar Prg(Msg)   -width 30 \
                  -bg $Colors(Msg0bg) -fg $Colors(Msg0fg) -pady 8 -height 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 -bg $Colors(BgJ_x) \
                -pady 6 -padx 6       ;# Joystick-Buttons
      frame .fB -bg $Colors(BgB_a) \
                -pady 4               ;# Start/Quit-Buttons

      pack  .lb_1           -in .f0   -pady 4
      pack  .fS             -in .f0   -pady 4
      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 -pady 4
      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 <space>      { Play   }      ;# Test
      bind all <Key-F5>     { Play   }      ;# Test
      bind all <Key-F9>     { P3     }      ;# Test
      bind all <Return>     { Status }      ;# 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>>  }

      focus -f  .bt_new
  }

  InitGUI
  HiScoreFile_Read
  Start 0

  # Test:
  bind all <Key-F2> { catch {console show} }

 # catch {console show}
 # catch {wm withdraw .}

  return

#.

See also edit

• Colors with Names
• event generate - animated button-click
• Techniques for reading and writing application configuration files
• Loading and Saving Application Configuration Files
• gridDemo-Pack
• 2048.tcl

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References