Task

Implement a 2D sliding block puzzle game where blocks with numbers are combined to add their values.



Rules of the game

   The rules are that on each turn the player must choose a direction   (up, down, left or right).
   All tiles move as far as possible in that direction, some move more than others. 
   Two adjacent tiles (in that direction only) with matching numbers combine into one bearing the sum of those numbers. 
   A move is valid when at least one tile can be moved,   if only by combination. 
   A new tile with the value of   2   is spawned at the end of each turn at a randomly chosen empty square   (if there is one). 
   Adding a new tile on a blank space.   Most of the time,   a new   2   is to be added,   and occasionally   (10% of the time),   a   4.
   To win,   the player must create a tile with the number   2048. 
   The player loses if no valid moves are possible.


The name comes from the popular open-source implementation of this game mechanic, 2048.



Requirements

   "Non-greedy" movement.   
  The tiles that were created by combining other tiles should not be combined again during the same turn (move).   
  That is to say,   that moving the tile row of:
               [2][2][2][2] 

 to the right should result in: 
               ......[4][4] 

 and not:
               .........[8] 

   "Move direction priority".   
  If more than one variant of combining is possible,   move direction shall indicate which combination will take effect. 
  For example, moving the tile row of:
               ...[2][2][2] 

 to the right should result in:
               ......[2][4] 

 and not:
               ......[4][2] 



   Check for valid moves.   The player shouldn't be able to skip their turn by trying a move that doesn't change the board.
   Check for a  win condition.
   Check for a lose condition.


 
use 'format import '[format].
use 'random.
 
Pos := Object clone tap {
 
  self x := 0.
  self y := 0.
 
  self move := {
    localize.
    case ($1) do {
      when 'left  do { pos (this x - 1, this y). }.
      when 'right do { pos (this x + 1, this y). }.
      when 'down  do { pos (this x, this y + 1). }.
      when 'up    do { pos (this x, this y - 1). }.
    }.
  }.
 
  self == := {
    (self x == $1 x) and (self y == $1 y).
  }.
 
  self inBounds? := {
    (self x >= 0) and (self x < 4) and (self y >= 0) and (self y < 4).
  }.
 
  self toString := {
    format "pos (~S, ~S)" call (self x, self y).
  }.
 
}.
 
pos := {
  takes '[x, y].
  Pos clone tap {
    self x := x.
    self y := y.
  }.
}.
 
allSquares := [] tap {
  localize.
  0 upto 4 visit {
    takes '[y].
    0 upto 4 visit {
      takes '[x].
      this pushBack (pos (x, y)).
    }.
  }.
}.
 
sample := {
  $1 nth (random nextInt mod ($1 length)).
}.
 
Grid ::= Object clone tap {
 
  self grid := 16 times to (Array) map { 0. }.
 
  self clone := {
    Parents above (parent self, 'clone) call tap {
      self grid := self grid clone.
    }.
  }.
 
  toIndex := {
    $1 x + 4 * $1 y.
  }.
 
  self at := {
    self grid nth (toIndex).
  }.
 
  self at= := {
    self grid nth= (toIndex).
  }.
 
  self isBlank? := {
    self at == 0.
  }.
 
  self spawnNew := {
    localize.
    candidates := allSquares filter { this isBlank?. } to (Array).
    if (candidates empty?) then {
      'gameover.
    } else {
      p := sample (candidates).
      this at (p) = if (random nextInt mod 10 == 0) then 4 else 2.
      'okay.
    }.
  }.
 
  canMoveCell := {
    takes '[grid, src, dir].
    dest := src move (dir).
    if (dest inBounds?) then {
      vs := grid at (src).
      vd := grid at (dest).
      (vs /= 0) and ((vd == 0) or (vs == vd)).
    } else {
      False.
    }.
  }.
 
  self canMove := {
    localize.
    takes '[dir].
    allSquares any { canMoveCell (this, $1, dir). }.
  }.
 
  self validMoves := {
    '[left, right, up, down] filter { parent self canMove. } to (Array).
  }.
 
  ;; Calculates the order of iteration for performing the moves
  axisCalc := {
    takes '[dir, major, minor].
    case (dir) do {
      when 'left do { pos (major, minor). }.
      when 'right do { pos (3 - major, minor). }.
      when 'up do { pos (minor, major). }.
      when 'down do { pos (minor, 3 - major). }.
    }.
  }.
 
  moveFrom := {
    takes '[grid, src, dir, locked].
    dest := src move (dir).
    local 'result = Nil.
    dest inBounds? ifTrue {
      locked contains (dest) ifFalse {
        vs := grid at (src).
        vd := grid at (dest).
        cond {
          when (vd == 0) do {
            grid at (dest) = vs.
            grid at (src) = 0.
            result = moveFrom (grid, dest, dir, locked).
          }.
          when (vd == vs) do {
            grid at (dest) = vs + vd.
            grid at (src) = 0.
            result = moveFrom (grid, dest, dir, locked).
            ;; We merged, so lock the final result cell.
            locked pushBack (result).
          }.
        }.
      }.
    }.
    (result) or (src).
  }.
 
  self doMove := {
    localize.
    takes '[dir].
    locked := [].
    0 upto 4 do {
      takes '[major].
      0 upto 4 do {
        takes '[minor].
        src := axisCalc (dir, major, minor).
        moveFrom: this, src, dir, locked.
      }.
    }.
  }.
 
  self pretty := {
    localize.
    lines := [].
    row := "+----+----+----+----+".
    lines pushBack (row).
    0 upto 4 visit {
      takes '[y].
      local 'line = "|".
      0 upto 4 visit {
        takes '[x].
        n := this at (pos (x, y)).
        if (n == 0) then {
          line = line ++ "    |".
        } else {
          line = line ++ n toString padRight (" ", 4) ++ "|".
        }.
      }.
      lines pushBack (line).
      lines pushBack (row).
    }.
    lines joinText "\n".
  }.
 
  self toArray := {
    allSquares map { parent self at. }.
  }.
 
}.
 
grid := Grid clone.
endgame := loop* {
  ;; Check for victory
  (grid toArray any { $1 >= 2048. }) ifTrue {
    last 'victory.
  }.
  ;; Check for game over
  result := grid spawnNew.
  (result == 'gameover) ifTrue {
    last 'gameover.
  }.
  valid := grid validMoves.
  valid empty? ifTrue {
    last 'gameover.
  }.
  $stdout putln: grid pretty.
  move := loop* {
    $stdout puts: "Your move (left, right, up, down)> ".
    move := $stdin readln intern.
    valid contains (move) ifTrue { last (move). }.
  }.
  grid doMove (move).
}.
$stdout putln: grid pretty.
 
if (endgame == 'victory) then {
  $stdout putln: "You win!".
} else {
  $stdout putln: "Better luck next time!".
}.
 