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.


with Ada.Text_IO; use Ada.Text_IO;
with System.Random_Numbers;
procedure Play_2048 is
   -- ----- Keyboard management
   type t_Keystroke is (Up, Down, Right, Left, Quit, Restart, Invalid);
   -- Redefining this standard procedure as function to allow Get_Keystroke as an expression function
   function Get_Immediate return Character is
   begin
      return Answer : Character do Ada.Text_IO.Get_Immediate(Answer);
      end return;
   end Get_Immediate;
   Arrow_Prefix : constant Character := Character'Val(224); -- works for windows
   function Get_Keystroke return t_Keystroke is
     (case Get_Immediate is
         when 'Q' | 'q' => Quit,
         when 'R' | 'r' => Restart,
         when 'W' | 'w' => Left,
         when 'A' | 'a' => Up,
         when 'S' | 's' => Down,
         when 'D' | 'd' => Right,
         -- Windows terminal
         when Arrow_Prefix => (case Character'Pos(Get_Immediate) is
                                  when 72 => Up,
                                  when 75 => Left,
                                  when 77 => Right,
                                  when 80 => Down,
                                  when others => Invalid),
         -- Unix escape sequences
         when ASCII.ESC => (case Get_Immediate is
                               when '[' => (case Get_Immediate is
                                               when 'A' => Up,
                                               when 'B' => Down,
                                               when 'C' => Right,
                                               when 'D' => Left,
                                               when others => Invalid),
                               when others => Invalid),
         when others => Invalid);
 
   -- ----- Game data
   function Random_Int is new System.Random_Numbers.Random_Discrete(Integer);
   type    t_List  is array (Positive range <>) of Natural;
   subtype t_Row   is t_List (1..4);
   type    t_Board is array  (1..4) of t_Row;
   Board     : t_Board;
   New_Board : t_Board;
   Blanks    : Natural;
   Score     : Natural;
   Generator : System.Random_Numbers.Generator;
 
   -- ----- Displaying the board
   procedure Display_Board is
      Horizontal_Rule : constant String := "+----+----+----+----+";
      function Center (Value : in String) return String is
        ((1..(2-(Value'Length-1)/2) => ' ') & -- Add leading spaces
         Value(Value'First+1..Value'Last)   & -- Trim the leading space of the raw number image
         (1..(2-Value'Length/2) => ' '));     -- Add trailing spaces
   begin
      Put_Line (Horizontal_Rule);
      for Row of Board loop
         for Cell of Row loop
            Put('|' & (if Cell = 0 then "    " else Center(Cell'Img)));
         end loop;
         Put_Line("|");
         Put_Line (Horizontal_Rule);
      end loop;
      Put_Line("Score =" & Score'Img);
   end Display_Board;
 
   -- ----- Game mechanics
   procedure Add_Block is
      Block_Offset : Positive := Random_Int(Generator, 1, Blanks);
   begin
      Blanks := Blanks-1;
      for Row of Board loop
         for Cell of Row loop
            if Cell = 0 then
               if Block_Offset = 1 then
                  Cell := (if Random_Int(Generator,1,10) = 1 then 4 else 2);
                  return;
               else
                  Block_Offset := Block_Offset-1;
               end if;
            end if;
         end loop;
      end loop;
   end Add_Block;
 
   procedure Reset_Game is
   begin
      Board  := (others => (others => 0));
      Blanks := 16;
      Score  := 0;
      Add_Block;
      Add_Block;
   end Reset_Game;
 
   -- Moving and merging will always be performed leftward, hence the following transforms
   function HFlip (What : in t_Row) return t_Row is
     (What(4),What(3),What(2),What(1));
   function VFlip (What : in t_Board) return t_Board is
     (HFlip(What(1)),HFlip(What(2)),HFlip(What(3)),HFlip(What(4)));
   function Transpose (What : in t_Board) return t_Board is
   begin
      return Answer : t_Board do
         for Row in t_Board'Range loop
            for Column in t_Row'Range loop
               Answer(Column)(Row) := What(Row)(Column);
            end loop;
         end loop;
      end return;
   end Transpose;
 
   -- For moving/merging, recursive expression functions will be used, but they
   -- can't contain statements, hence the following sub-function used by Merge
   function Add_Blank (Delta_Score : in Natural) return t_List is
   begin
      Blanks := Blanks+1;
      Score  := Score+Delta_Score;
      return (1 => 0);
   end Add_Blank;
 
   function Move_Row (What : in t_List) return t_List is
     (if What'Length = 1 then What
      elsif What(What'First) = 0
      then Move_Row(What(What'First+1..What'Last)) & (1 => 0)
      else (1 => What(What'First)) & Move_Row(What(What'First+1..What'Last)));
 
   function Merge (What : in t_List) return t_List is
     (if What'Length <= 1 or else What(What'First) = 0 then What
      elsif What(What'First) = What(What'First+1)
      then (1 => 2*What(What'First)) & Merge(What(What'First+2..What'Last)) & Add_Blank(What(What'First))
      else (1 => What(What'First)) & Merge(What(What'First+1..What'Last)));
 
   function Move (What : in t_Board) return t_Board is
     (Merge(Move_Row(What(1))),Merge(Move_Row(What(2))),Merge(Move_Row(What(3))),Merge(Move_Row(What(4))));
 
begin
   System.Random_Numbers.Reset(Generator);
 
   Main_Loop: loop
      Reset_Game;
      Game_Loop: loop    
         Display_Board;
         case Get_Keystroke is
            when Restart => exit Game_Loop;
            when Quit    => exit Main_Loop;
            when Left    => New_Board := Move(Board);
            when Right   => New_Board := VFlip(Move(VFlip(Board)));
            when Up      => New_Board := Transpose(Move(Transpose(Board)));
            when Down    => New_Board := Transpose(VFlip(Move(VFlip(Transpose(Board)))));
            when others  => null;
         end case;
 
         if New_Board = Board then
            Put_Line ("Invalid move...");
         elsif (for some Row of New_Board => (for some Cell of Row => Cell = 2048)) then
            Display_Board;
            Put_Line ("Win !");
            exit Main_Loop;
         else
            Board := New_Board;
            Add_Block; -- OK since the board has changed
            if Blanks = 0
               and then (for all Row in 1..4 =>
                           (for all Column in 1..3 =>
                                (Board(Row)(Column) /= Board(Row)(Column+1))))
               and then (for all Row in 1..3 =>
                           (for all Column in 1..4 =>
                                (Board(Row)(Column) /= Board(Row+1)(Column)))) then
               Display_Board;
               Put_Line ("Lost !");
               exit Main_Loop;
            end if;
         end if;
      end loop Game_Loop;
   end loop Main_Loop;
end Play_2048;
 