program game2048;
uses Crt;
const
    SIZE_MAP = 4;
    SIZETOPBOT = SIZE_MAP*6+6; (* Calculate the length of the top and bottom to create a box around the game  *)
    NOTHING = 0;
    UP = 93;
    RIGHT = 92;
    LEFT = 91;
    DOWN = 90;
type
    type_vector = array [1..SIZE_MAP] of integer;
    type_game = record
	lin,col:integer;
	map: array [1..SIZE_MAP,1..SIZE_MAP] of integer;
	score:integer;
    end;
    type_coord = record
	lin,col:integer;
    end;

var
    game:type_game;
    end_game,movement:boolean;

procedure Create_Number(var game:type_game);
(* Create the number(2 or 4) in a random position on the map *)
(* The number 4 had a 10% of chance to be created *)
var
    number:integer;
    RanP:type_coord;
begin
    randomize;
    if random(9) = 1 then
	number:=4
    else
	number:=2;
    RanP.lin:=random(game.lin)+1;
    RanP.col:=random(game.col)+1;
    while game.map[RanP.lin,RanP.col] <> NOTHING do
	begin
	    RanP.lin:=random(game.lin)+1;
	    RanP.col:=random(game.col)+1;
	end;
    game.map[RanP.lin,Ranp.Col]:=number;
end;

procedure initializing_game(var game:type_game);
var i,j:integer;
begin
    game.lin:=SIZE_MAP;
    game.col:=SIZE_MAP;
    game.score:=0;
    for i:=1 to game.lin do
	for j:=1 to game.col do
	    game.map[i,j]:=NOTHING;

    Create_Number(game);
    Create_Number(game);
end;

function CountDigit(number:integer):integer;
begin
    if number <> 0 then
	begin
	    CountDigit:=0;
	    while number <> 0 do
		begin
		    CountDigit:=CountDigit+1;
		    number:=number div 10;
		end;
	end
    else
	CountDigit:=1;
end;

procedure print_number(number:integer);
(* Print the number aligned with other numbers in the matrix  *)
var k,hwdigit:integer;
begin
    hwdigit:=CountDigit(number);
    write(' ');
    write(number);
    (* The 4 is used to aling the numbers because the greatest number *)
    (* possible is 2048, which have 4 digits *)
    for k:=1 to 4-hwdigit do
	write(' ');
    write(' ');
end;

procedure print_line(lengthL:integer; ch:string);
var i:integer;
begin
    write('+');
    for i:=1 to (lengthL-2) do
	begin
	    if i mod 7 = 0 then
		write('+')
	    else
		write(ch);
    end;
    writeln;
end;

procedure print_map(var game:type_game);
var i,j:integer;
begin
    print_line(SIZETOPBOT,'-');
    for i:=1 to game.lin do
	begin
	    write('|');
	    for j:=1 to game.col do
		if game.map[i,j] >= 0 then
		    begin
			print_number(game.map[i,j]);
			write('|');
		    end;
	    writeln;
	    print_line(SIZETOPBOT,'-');
	end;
end;

function CanMove(var v_lin:type_vector; i:integer):integer;
(* Returns 1 if the next position is free *)
(* Returns 2 if the next position has an equal number *)
(* Returns 0 if the next position is not free *)
begin
    if v_lin[i-1] = NOTHING then
        CanMove:=1
    else if v_lin[i] = v_lin[i-1] then
        CanMove:=2
    else
        CanMove:=0;
end;

function MoveAndSum(var game:type_game; var v_lin:type_vector; size:integer):boolean;
(* Move and Sum the elements of the vector *)
(* The direction of the move is to the left *)
(* Returns TRUE if a number was moved *)
(* Returns FALSE if a number was not moved *)
var
    i,e,ResultM:integer;
    v:type_vector;
begin
    MoveAndSum:=FALSE;
    (* Initializing the vector *)
    (* This Vector is to know what number sum and what not sum *)
    for i:=1 to size do
        v[i]:=0;

    for i:=2 to size do
        begin
	    if v_lin[i] <> 0 then
		begin
		    (* Move the number in v_lin[i] to the left as much as possible *)
		    e:=i;
		    ResultM:=CanMove(v_lin,e);
		    while (ResultM <> 0)and(e>1) do
			begin
			    case ResultM of
				1:begin
				    v_lin[e-1]:=v_lin[e];
				    v_lin[e]:=NOTHING;
				end;
				2:begin
				    if v[e] = 0 then
					begin
					    v_lin[e-1]:=v_lin[e-1]*2;
					    game.score:=game.score+v_lin[e-1];
					    v_lin[e]:=NOTHING;
					    (* This number will not be sum again *)
					    v[e-1]:=1;
					end;
				end;
			    end;
			    e:=e-1;
			    ResultM:=CanMove(v_lin,e);
			end;
		    if e <> i then
			MoveAndSum:=TRUE;
		    v[e-1]:=1;
		end;
        end;
end;

function move_left(var game:type_game):boolean;
var
    i,j:integer;
    v:type_vector;
begin
    move_left:=FALSE;
    for i:=1 to game.lin do
	begin
	    for j:=1 to game.col do
		v[j]:=game.map[i,j];

	    if MoveAndSum(game,v,game.lin) then
		move_left:=TRUE;

	    for j:=1 to game.col do
		game.map[i,j]:=v[j];
	end;
end;

function move_right(var game:type_game):boolean;
var
    i,j,k:integer;
    v:type_vector;
begin
    move_right:=FALSE;
    for i:=1 to game.lin do
	begin
	    (* The side which will be move had to be at the beginning of the vector *)
	    (* For example, I want to move this line to the right: 0 2 0 3 6 *)
	    (* The procedure "MoveAndSum" has to receive this vector: 6 3 0 2 0 *)
	    k:=1;
	    for j:=game.col downto 1 do
		begin
		    v[k]:=game.map[i,j];
		    k:=k+1;
		end;
	    if MoveAndSum(game,v,game.lin) then
		move_right:=TRUE;
	    (* Copy to the right place in the matrix *)
	    k:=1;
	    for j:=game.col downto 1 do
		begin
		    game.map[i,k]:=v[j];
		    k:=k+1;
		end;
	end;
end;

function move_down(var game:type_game):boolean;
var
    i,j,k:integer;
    v:type_vector;
begin
    move_down:=FALSE;
    for j:=1 to game.col do
	begin
	    k:=1;
	    for i:=game.lin downto 1 do
		begin
		    v[k]:=game.map[i,j];
		    k:=k+1;
		end;
	    if MoveAndSum(game,v,game.lin) then
		move_down:=TRUE;
	    k:=1;
	    for i:=game.lin downto 1 do
		begin
		    game.map[k,j]:=v[i];
		    k:=k+1;
		end;
	end;
end;

function move_up(var game:type_game):boolean;
var
    i,j:integer;
    v:type_vector;
begin
    move_up:=FALSE;
    for j:=1 to game.col do
	begin
	    for i:=1 to game.lin do
		v[i]:=game.map[i,j];
	    if MoveAndSum(game,v,game.lin) then
		move_up:=TRUE;
	    for i:=1 to game.lin do
		game.map[i,j]:=v[i];
	end;
end;

function CheckWinLose(var game:type_game):integer;
(* Returns 2 if the player win the game *)
(* Returns 1 if the player lose the game *)
(* Returns 0 if has a valid move*)
var i,j:integer;
begin
    with game do
	begin
	    CheckWinLose:=1;
	    i:=1;
	    while (i<=game.lin)and(CheckWinLose<>2) do
		begin
		    j:=1;
		    while (j<=game.col)and(CheckWinLose<>2) do
			begin
			    if map[i,j] = 2048 then
				CheckWinLose:=2
			    else
			       if map[i,j] = NOTHING then
				CheckWinLose:=0
			    else
				if (map[i,j] = map[i,j+1])and(j<>col) then
				    CheckWinLose:=0
			    else
				if (map[i,j] = map[i,j-1])and(j<>1) then
				    CheckWinLose:=0
			    else
				if (map[i,j] = map[i+1,j])and(i<>lin) then
				    CheckWinLose:=0
			    else
				if (map[i,j] = map[i-1,j])and(i<>1) then
				    CheckWinLose:=0;
			    j:=j+1;
			end;
		    i:=i+1;
		end;
    end;
end;

begin
    movement:=false;
    end_game:=false;
    initializing_game(game);
    repeat
	ClrScr;
	if movement then
	    Create_Number(game);
	movement:=false;

	writeln('SCORE: ',game.score);
	print_map(game);
	writeln(' Use the arrow keys to move ');
	writeln(' Press ESC to quit the game ');

	case CheckWinLose(game) of
	    1:begin
		print_line(SIZETOPBOT,'-');
		writeln('|         Game Over!        |');
		print_line(SIZETOPBOT,'-');
		end_game:=TRUE;
	    end;
	    2:begin
		print_line(SIZETOPBOT,'-');
		writeln('|          You Win!         |');
		print_line(SIZETOPBOT,'-');
		end_game:=TRUE;
	    end;
	end;

	repeat
	until KeyPressed;
	case ReadKey of
	     #0:begin
		case ReadKey of
		    #72:movement:=move_up(game);
		    #77:movement:=move_right(game);
		    #75:movement:=move_left(game);
		    #80:movement:=move_down(game);
		end;
	    end;
	    #27:end_game:=true;
	end;
    until end_game;
end.


#!/usr/bin/perl

use strict; # https://rosettacode.org/wiki/2048
use warnings;
use Tk;

my $N = shift // 4;
$N < 2 and $N = 2;
my @squares = 1 .. $N*$N;
my %n2ch = (' ' => ' ');
@n2ch{ map 2**$_, 1..26} = 'a'..'z';
my %ch2n = reverse %n2ch;
my $winner = '';
my @arow = 0 .. $N - 1;
my @acol = map $_ * $N, @arow;

my $mw = MainWindow->new;
$mw->geometry( '+300+0' );
$mw->title( 2048 );
$mw->focus;
$mw->bind('<KeyPress-Left>' => sub { arrow($N, @arow) } );
$mw->bind('<KeyPress-Right>' => sub { arrow($N, reverse @arow) } );
$mw->bind('<KeyPress-Up>' => sub { arrow(1, @acol) } );
$mw->bind('<KeyPress-Down>' => sub { arrow(1, reverse @acol) } );
my $grid = $mw->Frame()->pack;
for my $i ( 0 .. $#squares )
  {
  $grid->Label(-textvariable => \$squares[$i],
    -width => 5, -height => 2, -font => 'courierbold 30',
    -relief => 'ridge', -borderwidth => 5,
    )->grid(-row => int $i / $N, -column => $i % $N );
  }
my $buttons = $mw->Frame()->pack(-fill => 'x', -expand => 1);
$buttons->Button(-text => 'Exit', -command => sub {$mw->destroy},
  -font => 'courierbold 14',
  )->pack(-side => 'right');
$buttons->Button(-text => 'New Game', -command => \&newgame,
  -font => 'courierbold 14',
  )->pack(-side => 'left');
$buttons->Label(-textvariable => \$winner,
  -font => 'courierbold 18', -fg => 'red2',
  )->pack;

newgame();
MainLoop;
-M $0 < 0 and exec $0;

sub losecheck
  {
  local $_ = join '', @n2ch{ @squares };
  / / || ($_ ^ substr $_, $N) =~ tr/\0// and return;
  /(.)\1/ and return for /.{$N}/g;
  $winner = 'You Lost';
  }

sub arrow
  {
  $winner and return;                                   # you won, no more play
  my ($inc, @ix) = @_;
  my $oldboard = "@squares";
  for ( 1 .. $N )
    {
    local $_ = join '', @n2ch{ @squares[@ix] };         # extract 4 squares
    tr/ //d;                                            # force left
    s/(\w)\1/ chr 1 + ord $1 /ge;                       # group by twos
    @squares[@ix] = @ch2n{ split //, $_ . ' ' x $N };   # replace
    $_ += $inc for @ix;                                 # next row or col
    }
  $oldboard eq "@squares" and return;
  add2();
  losecheck();
  grep $_ eq 2048, @squares and $winner = 'WINNER !!';
  }

sub add2
  {
  my @blanks = grep $squares[$_] eq ' ', 0 .. $#squares;
  @blanks and $squares[ $blanks[rand @blanks] ] =
    $_[0] // (rand() < 0.1 ? 4 : 2);
  }

sub newgame
  {
  $_ = ' ' for @squares;
  add2(2) for 1, 2;
  $winner = '';
  }


-- demo\rosetta\2048.exw
with javascript_semantics
include pGUI.e

Ihandle canvas, dialog
cdCanvas cddbuffer, cdcanvas

constant tile_colours = {#CCC0B4,   -- blank
                         #EEE4DA,   -- 2
                         #EDE0C8,   -- 4
                         #F2B179,   -- 8
                         #F59563,   -- 16
                         #F67C5F,   -- 32
                         #F65E3B,   -- 64
                         #EDCF72,   -- 128
                         #EDCC61,   -- 256
                         #EDC850,   -- 512
                         #EDC53F,   -- 1024
                         #EDC22E}   -- 2048

-- the 4x4 board.
--  note that values are [1..12] for [blank,2,4,8,..2048].
--  (merging two eights is not 8+8->16 but 4+1->5, internally)
sequence board

integer newgame = 1,
        valid = 0,
        prev, nxt

procedure add_rand(integer count)
-- (nb infinite loop if board is full)
    while count do
        integer x = rand(4),
                y = rand(4)
        if board[y][x]=1 then   -- blank
            board[y][x] = 2+(rand(10)=10)
            count -= 1
        end if
    end while
end procedure

procedure move_x(integer x, y, d)
    integer bxy = board[x][y]
    if bxy!=1 then -- (not blank)
        if bxy=prev then
            board[x][y] = 1
            bxy += 1
            board[x][nxt] = bxy
            nxt += d
            prev = 13
            valid = 1
        else
            if prev=1 -- (blank)
            or y!=nxt then
                if prev!=1
                and prev!=13 then
                    nxt += d
                end if
                if y!=nxt then
                    board[x][y] = 1
                    board[x][nxt] = bxy
                    valid = 1
                end if
            end if
            prev = bxy
        end if
    end if
end procedure

procedure move_y(integer x, y, d)
    integer bxy = board[x][y]
    if bxy!=1 then -- (not blank)
        if bxy=prev then
            board[x][y] = 1
            bxy += 1
            board[nxt][y] = bxy
            nxt += d
            prev = 13
            valid = 1
        else
            if prev=1 -- (blank)
            or x!=nxt then
                if prev!=1
                and prev!=13 then
                    nxt += d
                end if
                if x!=nxt then
                    board[x][y] = 1
                    board[nxt][y] = bxy
                    valid = 1
                end if
            end if
            prev = bxy
        end if
    end if
end procedure

function move(integer key)
-- a non-zero result means it changed something.
    valid = 0
    if key=K_LEFT then
        for x=1 to 4 do
            prev = 13
            nxt = 1
            for y=1 to 4 do
                move_x(x,y,+1)
            end for
        end for
    elsif key=K_UP then
        for y=1 to 4 do
            prev = 13
            nxt = 4
            for x=4 to 1 by -1 do
                move_y(x,y,-1)
            end for
        end for
    elsif key=K_RIGHT then
        for x=1 to 4 do
            prev = 13
            nxt = 4
            for y=4 to 1 by -1 do
                move_x(x,y,-1)
            end for
        end for
    elsif key=K_DOWN then
        for y=1 to 4 do
            prev = 13
            nxt = 1
            for x=1 to 4 do
                move_y(x,y,+1)
            end for
        end for
    end if
    return valid
end function

function game_won()
    for i=1 to length(board) do
        if find(12,board[i]) then return 1 end if
    end for
    return 0
end function

constant valid_keys = {K_LEFT,K_DOWN,K_RIGHT,K_UP}

function no_valid_moves()
    sequence saved_board = deep_copy(board)
    for i=1 to length(valid_keys) do
        if move(valid_keys[i]) then
            board = saved_board
            return 0    -- OK
        end if
    end for
    return 1 -- game over...
end function

function redraw_cb(Ihandle /*ih*/)
    integer ox,oy,              -- top right coords
            os,ts,              -- overall and tile size
            ts2,                -- half tile, for number positioning
            {dw,dh} = IupGetIntInt(canvas, "DRAWSIZE")
    if dw>=dh then
        ox = floor((dw-dh)/2)
        oy = 0
        os = dh
    else
        ox = 0
        oy = floor((dh-dw)/2)
        os = dw
    end if
    ts = floor((os-10)/4-7)
    ts2 = floor(ts/2+5)-10

    if newgame then
        board = repeat(repeat(1,4),4)
        add_rand(2)
        newgame = 0
    end if

    cdCanvasActivate(cddbuffer)
    cdCanvasSetBackground(cddbuffer, #FAF8EF)
    cdCanvasClear(cddbuffer)
    cdCanvasSetForeground(cddbuffer, #BBADA0)
    cdCanvasRoundedBox(cddbuffer, ox+5, ox+os-5, oy+5, oy+os-5, 10, 10)

    integer tx = ox+15
    for y=1 to 4 do
        integer ty = oy+15
        for x=1 to 4 do
            integer bxy = board[x][y]
            cdCanvasSetForeground(cddbuffer, tile_colours[bxy])
            cdCanvasRoundedBox(cddbuffer, tx, tx+ts-10, ty, ty+ts-10, 5, 5)
            if bxy>1 then
                cdCanvasSetForeground(cddbuffer, iff(bxy<=3?#776E65:#F9F6F2))
                cdCanvasFont(cddbuffer, "Calibri", CD_BOLD, iff(bxy>10?32:40))
                cdCanvasText(cddbuffer, tx+ts2, ty+ts2-25-iff(bxy<11?7:0), sprint(power(2,bxy-1)))
            end if
            ty += ts+5
        end for
        tx += ts+5
    end for
    cdCanvasFlush(cddbuffer)
    return IUP_DEFAULT
end function

function map_cb(Ihandle ih)
    cdcanvas = cdCreateCanvas(CD_IUP, ih)
    cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)
    cdCanvasSetTextAlignment(cddbuffer, CD_SOUTH)
    return IUP_DEFAULT
end function

function key_cb(Ihandle /*ih*/, atom c)
    if c=K_ESC then return IUP_CLOSE end if
    if find(c,valid_keys) then
        if move(c) then
            IupUpdate(canvas)
            string mbmsg = ""
            if game_won() then
                mbmsg = "!!!YOU WON!!!\n\nAnother Go?"
            else
                add_rand(1)
                IupUpdate(canvas)
                if no_valid_moves() then
                    mbmsg = "You Lost.\n\nAnother Go?"
                end if
            end if
            if length(mbmsg) then
                if platform()=JS then
                    IupMessage("Game Over",mbmsg);
                    newgame=1
                else
                    if IupAlarm("Game Over",mbmsg,"Yes","No")=1 then
                        newgame=1
                    else
                        return IUP_CLOSE
                    end if
                end if
            end if
        end if
        IupUpdate(canvas)
    end if
    return IUP_CONTINUE
end function

procedure main()

    IupOpen()

    canvas = IupCanvas("RASTERSIZE=520x540")
    IupSetCallback(canvas, "MAP_CB", Icallback("map_cb"))
    IupSetCallback(canvas, "ACTION", Icallback("redraw_cb"))

    dialog = IupDialog(canvas,"MINSIZE=440x450")
    IupSetAttribute(dialog,"TITLE","2048");
    IupSetCallback(dialog, "K_ANY", Icallback("key_cb"));

    IupShow(dialog)
    IupSetAttribute(canvas, "RASTERSIZE", NULL)

    if platform()!=JS then
        IupMainLoop()
        IupClose()
    end if
end procedure
main()


<?php

$game = new Game();

while(true) {
    $game->cycle();
}

class Game {
	private $field;
	private $fieldSize;
	private $command;
	private $error;
	private $lastIndexX, $lastIndexY;
	private $score;
	private $finishScore;

	function __construct() {
		$this->field = array();
		$this->fieldSize = 4;
		$this->finishScore = 2048;
		$this->score = 0;
		$this->addNumber();
		$this->render();
	}

	public function cycle() {
		$this->command = strtolower($this->readchar('Use WASD, q exits'));
		$this->cls();

		if($this->processCommand()) {
			$this->addNumber();
		} else {
			if(count($this->getFreeList()) == 0 ) {
				$this->error = 'No options left!, You Lose!!';
			} else {
				$this->error = 'Invalid move, try again!';
			}
		}
		$this->render();
	}

	private function readchar($prompt) {
		readline_callback_handler_install($prompt, function() {});
		$char = stream_get_contents(STDIN, 1);
		readline_callback_handler_remove();
		return $char;
	}

	/**
	 * Insert a number in an empty spot on the field
	 */
	private function addNumber() {
		$freeList = $this->getFreeList();
		if(count($freeList) == 0) {
			return;
		}
		$index = mt_rand(0, count($freeList)-1);
		$nr = (mt_rand(0,9) == 0)? 4 : 2;
		$this->field[$freeList[$index]['x']][$freeList[$index]['y']] = $nr;
		return;
	}

	/**
	 * @return array(array('x' => <x>, 'y' => <y>)) with empty positions in the field
	 */
	private function getFreeList() {
		$freeList = array();
		for($y =0; $y< $this->fieldSize;$y++) {
			for($x=0; $x < $this->fieldSize; $x++) {
				if(!isset($this->field[$x][$y])) {
					$freeList[] = array('x' => $x, 'y' => $y);
				} elseif($this->field[$x][$y] == $this->finishScore) {
					$this->error = 'You Win!!';
				}
			}
		}
		return $freeList;
	}

	/**
	 * Process a command:
	 * @return is the command valid (Did it cause a change in the field)
	 */
	private function processCommand() {
		if(!in_array($this->command, array('w','a','s','d','q'))) {
			$this->error = 'Invalid Command';
			return false;
		}
		if($this->command == 'q') {
			echo PHP_EOL. 'Bye!'. PHP_EOL;
			exit;
		}

		// Determine over which axis and in which direction we move:
		$axis = 'x';
		$sDir = 1;

		switch($this->command) {
			case 'w':
				$axis = 'y';
				$sDir = -1;
				break;
			case 'a':
				$sDir = -1;
				break;
			case 's':
				$axis = 'y';
				break;
			case 'd':
			break;
		}

		$done = 0;
		// shift all numbers in that direction
		$done += $this->shift($axis, $sDir);
		// merge equal numbers in opposite direction
		$done += $this->merge($axis, $sDir * -1);
		// shift merged numbers in that direction
		$done += $this->shift($axis, $sDir);
		return $done >0;
	}

	private function shift($axis, $dir) {
		$totalDone = 0;
		for($i = 0; $i <$this->fieldSize; $i++) {
			$done = 0;
			foreach($this->iterate($axis,$dir) as $xy) {
				if($xy['vDest'] === NULL && $xy['vSrc'] !== NULL) {
					$this->field[$xy['dX']][$xy['dY']] = $xy['vSrc'];
					$this->field[$xy['sX']][$xy['sY']] = NULL;
					$done++;
				}
			}
			$totalDone += $done;
			if($done == 0) {
				// nothing to shift anymore
				break;
			}
		}
		return $totalDone;
	}

	private function merge($axis, $dir) {
		$done = 0;
		foreach($this->iterate($axis,$dir) as $xy) {
			if($xy['vDest'] !== NULL && $xy['vDest'] === $xy['vSrc']) {
				$this->field[$xy['sX']][$xy['sY']] += $xy['vDest'];
				$this->field[$xy['dX']][$xy['dY']] = NULL;
				$this->score += $this->field[$xy['sX']][$xy['sY']];
				$done ++;
			}
		}
		return $done;
	}

	/**
	 * @return array List of src, dest pairs and their values to iterate over.
	 */
	private function iterate($axis, $dir) {
		$res = array();
		for($y = 0; $y < $this->fieldSize; $y++) {
			for($x=0; $x < $this->fieldSize; $x++) {
				$item = array('sX'=> $x,'sY' => $y, 'dX' => $x, 'dY' => $y, 'vDest' => NULL,'vSrc' => NULL);

				if($axis == 'x') {
					$item['dX'] += $dir;
				} else {
					$item['dY'] += $dir;
				}

				if($item['dX'] >= $this->fieldSize || $item['dY'] >=$this->fieldSize || $item['dX'] < 0 || $item['dY'] < 0) {
					continue;
				}

				$item['vDest'] = (isset($this->field[$item['dX']][$item['dY']]))? $this->field[$item['dX']][$item['dY']] : NULL;
				$item['vSrc'] = (isset($this->field[$item['sX']][$item['sY']]))? $this->field[$item['sX']][$item['sY']] : NULL;
				$res[] = $item;
			}
		}
		if($dir < 0) {
			$res = array_reverse($res);
		}
		return $res;
	}

	/// RENDER ///

	/**
	 * Clear terminal screen
	 */
	private function cls() {
		echo chr(27).chr(91).'H'.chr(27).chr(91).'J';
	}

	private function render() {
		echo $this->finishScore . '! Current score: '. $this->score .PHP_EOL;

		if(!empty($this->error)) {
			echo $this->error . PHP_EOL;
			$this->error = NULL;
		}
		$this->renderField();
	}

	private function renderField() {
		$width = 5;
		$this->renderVSeperator($width);
		for($y =0; $y < $this->fieldSize; $y ++) {
			for($x = 0;$x < $this->fieldSize; $x++) {
				echo '|';
				if(!isset($this->field[$x][$y])) {
					echo str_repeat(' ', $width);
					continue;
				}
				printf('%'.$width.'s', $this->field[$x][$y]);
			}
			echo '|'. PHP_EOL;
			$this->renderVSeperator($width);
		}
	}

	private function renderVSeperator($width) {
		echo str_repeat('+'. str_repeat('-', $width), $this->fieldSize) .'+' .PHP_EOL;
	}

}


(load "@lib/simul.l")

(symbols 'simul 'pico)

(seed (in "/dev/urandom" (rd 8)))

(setq *G (grid 4 4)  *D NIL)

(de cell ()
   (use This
      (while
         (get
            (setq This
               (intern
                  (pack
                     (char (+ 96 (rand 1 4)))
                     (rand 1 4) ) ) )
            'N ) )
      (=: N (if (> 90 (rand 1 100)) 2 4) ) )
   (setq *D (fish '((This) (: N)) *G)) )

(de redraw (G S D)
   # zeroize *G
   (mapc
      '((I)
         (mapc '((This) (=: N NIL)) I) )
      *G )
   # draw again
   (mapc
      '((X This)
         (while (and This X)
            (=: N (pop 'X))
            (setq This (D This)) ) )
      G
      S ) )

(de summ (Lst)
   (mapcar
      '((L)
         (make
            (while L
               (ifn (= (car L) (cadr L))
                  (link (car L))
                  (link (+ (car L) (cadr L)))
                  (pop 'L) )
               (pop 'L) ) ) )
      Lst ) )

(de vertical ()
   (mapcar
      '((X) (extract '((This) (: N)) X))
      *G ) )

(de horizontal ()
   (mapcar
      '((This)
         (make
            (while This
               (when (: N) (link @))
               (setq This (east This)) ) ) )
      (car *G) ) )

(de finish? ()
   (nor
      (fish
         '((This)
            (when (atom This) (= NIL (: N))) )
         *G )
      (find
         '((L)
            (find
               '((This)
                  (when (: N)
                     (find
                        '((D)
                           (= (: N) (get (D This) 'N)) )
                        (quote north south west east) ) ) )
               L ) )
         *G ) ) )

(de board (D)
   (space 3)
   (prin '+)
   (for I G
      (prin (if (D (car I)) "   +" "---+")) )
   (prinl) )

(de display ()
   (let G (mapcar reverse *G)
      (board north)
      (while (caar G)
         (space 3)
         (prin '|)
         (for I G
            (with (car I)
               (prin
                  (if (: N) (align 3 (: N)) "   ")
                  (if (east This) " " '|) ) ) )
         (prinl)
         (board south)
         (map pop G) )
      (do 2
         (prinl) ) ) )

(do 2
   (cell) )
(display)
(loop
   (case
      (pack
         (make
            (link (key))
            (while (key 100)
               (link @) ) ) )
      ("^[[D" #left
         (redraw (summ (horizontal)) '(a1 a2 a3 a4) east) )
      ("^[[C" #rigth
         (redraw
            (summ (mapcar reverse (horizontal)))
            '(d1 d2 d3 d4)
            west) )
      ("^[[B" #down
         (redraw (summ (vertical)) '(a1 b1 c1 d1) north) )
      ("^[[A" #up
         (redraw
            (summ (mapcar reverse (vertical)))
            '(a4 b4 c4 d4)
            south) ) )
   (when (diff *D (fish '((This) (: N)) *G))
      (cell) )
   (display)
   (T (finish?) (println 'Finish))
   (T (fish '((This) (= 512 (: N))) *G)
      (println 'Maximum) ) )
(bye)


use "term"
use "random"
use "time"

interface EdgeRow
  fun val row() : Iterator[U32] ref
  fun val inc() : I32

primitive TopRow is EdgeRow
  fun row() : Iterator[U32] ref => let r : Array[U32] box = [0,1,2,3]
    r.values()
  fun inc() : I32 => 4

primitive LeftRow is EdgeRow
  fun row() : Iterator[U32] ref => let r : Array[U32] box = [0,4,8,12]
    r.values()
  fun inc() : I32 => 1

primitive RightRow is EdgeRow
  fun row() : Iterator[U32] ref => let r : Array[U32] box = [3,7,11,15]
    r.values()
  fun inc() : I32 => -1

primitive BottomRow is EdgeRow
  fun row() : Iterator[U32] ref => let r : Array[U32] box = [12,13,14,15]
    r.values()
  fun inc() : I32 =>  -4

primitive LEFT
primitive RIGHT
primitive UP
primitive DOWN
type Move is (LEFT|RIGHT|UP|DOWN)

class  KeyboardHandler is ANSINotify
   let _game : Game tag
   new iso create(game : Game tag) => _game = game

   fun ref apply(term: ANSITerm ref, input: U8 val) =>
     if input == 113 then
       _game.quit()
       term.dispose()
     end
   fun ref left(ctrl: Bool, alt: Bool, shift: Bool)  => _game.move(LEFT)
   fun ref down(ctrl: Bool, alt: Bool, shift: Bool)  => _game.move(DOWN)
   fun ref up(ctrl: Bool, alt: Bool, shift: Bool)    => _game.move(UP)
   fun ref right(ctrl: Bool, alt: Bool, shift: Bool) => _game.move(RIGHT)

type ROW is (U32,U32,U32,U32)

primitive Merger
  fun tag apply(r : ROW) : ROW =>
    match r
    | (0,0,0,_)            => (r._4,0,0,0)
    | (0,0,_,r._3)         => (r._3<<1,0,0,0)
    | (0,0,_,_)            => (r._3,r._4,0,0)
    | (0,_,r._2,_)         => (r._2<<1,r._4,0,0)
    | (0,_,0,r._2)         => (r._2<<1,0,0,0)
    | (0,_,0,_)            => (r._2,r._4,0,0)
    | (0,_,_,r._3)         => (r._2,r._3<<1,0,0)
    | (0,_,_,_)            => (r._2,r._3,r._4,0)
    | (_, r._1, _, r._3)   => (r._1<<1, r._3<<1, 0, 0)
    | (_, r._1, 0, _)      => (r._1<<1, r._4, 0, 0)
    | (_, r._1, _, _)      => (r._1<<1, r._3, r._4, 0)
    | (_, 0,r._1, _)       => (r._1<<1,r._4,0,0)
    | (_, 0,0, r._1)       => (r._1<<1,0,0,0)
    | (_, 0,0, _)          => (r._1,r._4,0,0)
    | (_, 0,_, r._3)       => (r._1, r._3<<1,0,0)
    | (_, 0,_, _)          => (r._1, r._3,r._4,0)
    | (_,_,r._2,_)         => (r._1, r._2<<1,r._4,0)
    | (_,_,0,r._2)         => (r._1, r._2<<1,0,0)
    | (_,_,0,_)            => (r._1, r._2,r._4,0)
    | (_,_,_,r._3)         => (r._1, r._2,r._3<<1,0)
    else
       r
    end
/**
* Game actor
*/
actor Game
  embed _grid : Array[U32] = Array[U32].init(0, 16)
  let _rand : Random = MT(Time.millis())
  let _env : Env
  let _board : String ref = recover String(1024) end

  new create(env: Env)=>
    _env = env
    _add_block()
    _add_block()
    _draw()

  fun _merge(start : U32, inc : I32) : (ROW | None) =>
    var st = start.i32()
    let rval : ROW = (_get(st),             _get(st + inc),
                      _get(st + (inc * 2)), _get(st + (inc * 3)))
    let rout = Merger(rval)
    if rout is rval then None else rout end

  fun ref _update(start : U32, inc : I32) : Bool =>
    match _merge(start, inc)
    | let rout : ROW =>
        var st = start.i32()
        _set(st,             rout._1)
        _set(st +  inc,      rout._2)
        _set(st + (inc * 2), rout._3)
        _set(st + (inc * 3), rout._4)
        true
    else
      false
    end

  fun ref _shift_to(edge : EdgeRow val) : Bool =>
    var updated = false
    for r in edge.row() do
      if _update(r, edge.inc()) then
        updated = true
      end
    end
    updated

  fun _fmt(i : U32) : String =>
    match i
    | 0 => " __ "
    | 2 => "\x1B[31m  2 \x1B[0m"
    | 4 => "\x1B[32m  4 \x1B[0m"
    | 8 => "\x1B[33m  8 \x1B[0m"
    | 16 => "\x1B[34m 16 \x1B[0m"
    | 32 => "\x1B[35m 32 \x1B[0m"
    | 64 => "\x1B[36m 64 \x1B[0m"
    | 128 => "\x1B[37m128 \x1B[0m"
    | 256 => "\x1B[41m\x1B[37m256 \x1B[0m"
    | 512 => "\x1B[42m\x1B[37m512 \x1B[0m"
    | 1024 => "\x1B[43m\x1B[37m1024\x1B[0m"
    | 2048 => "\x1B[47m\x1B[35m\x1B[1m\x1B[5m2048\x1B[0m"
    else
      i.string()
    end

  fun ref _draw() =>
    let s : String ref = _board
    s.truncate(0)
    var i : U32 = 0
    repeat
      if (i % 4) == 0 then
          s.append("---------------------\n")
      end
      s.append(_fmt(_get(i)))
      s.append(" ")
      i = i + 1
      if (i % 4) == 0 then
          s.append("\n")
      end
    until i==16 end
    _env.out.print(s.string())
    _env.out.print("Arrow keys to move. Press (q)uit key to quit.")

   fun ref _set(i:(I32|U32), v : U32) =>
     try
       _grid.update(i.usize(),v)
     else
       _env.out.print("cant update!")
     end

  fun _count() : U64 =>
     var c : U64 = 0
     for v in _grid.values() do
       c = c + if v == 0 then 0 else 1 end
     end
     c

  fun ref _add_block() =>
    let c = _count()
    if c == 16 then return end

    var hit =  _rand.int(16 - c)
    var i : U32 = 0
    while i < 16 do
      if (_get(i) == 0) then
        if hit == 0 then
          _set(i, if _rand.int(10) > 0 then 2 else 4 end)
          break
        end
        hit = hit - 1
      end
      i = i + 1
    end

  fun _get(i : (I32|U32)) : U32 => try  _grid(i.usize()) else 0  end

  fun _win() : Bool =>
    for v in _grid.values() do
      if v == 2048 then return true end
    end
    false

  fun _no_moves(edge : EdgeRow val) : Bool =>
    for r in edge.row() do
      match _merge(r, edge.inc())
      | let rout : ROW =>
        if (rout._1 == 0) or (rout._2 == 0) or
            (rout._3 == 0) or (rout._4 == 0) then
              return false
        end
      end
    end
    true

  fun _lose() : Bool =>
    (_grid.size() >= 16) and
    _no_moves(LeftRow) and
    _no_moves(RightRow) and
    _no_moves(TopRow) and
    _no_moves(BottomRow)

  be quit()=>
    _env.out.print("Exiting.. some terminals may require <ctrl-c>")
    _env.exitcode(0)
    _env.input.dispose()

  be move(m: Move) =>
    let updated =
      match m
      | LEFT =>  _shift_to(LeftRow)
      | RIGHT => _shift_to(RightRow)
      | UP =>    _shift_to(TopRow)
      | DOWN =>  _shift_to(BottomRow)
      else
        false
      end

    if _win() then
      _draw()
      _env.out.print("You win :)")
      quit()
    else
      if updated then
        _add_block()
        _draw()
      end
      if _lose() then
        _env.out.print("You lose :(")
        quit()
      end
    end

actor Main
  new create(env: Env) =>
    // unit test
    ifdef "test" then
      TestMain(env)
      return
    end
    // else game
    let input : Stdin tag = env.input
    env.out.print("Welcome to ponylang-2048...")
    let game = Game(env)
    let term = ANSITerm(KeyboardHandler(game), input)

    let notify : StdinNotify iso = object iso
        let term: ANSITerm = term
        let _in: Stdin tag = input
        fun ref apply(data: Array[U8] iso) => term(consume data)
        fun ref dispose() => _in.dispose()
    end

    input(consume notify)


/* -------------------------------------------------------------
   Entry point, just create a blank grid and enter a 'game loop'
   -------------------------------------------------------------*/
play_2048 :-
	welcome_msg,
	length(Grid, 16), maplist(=(' '), Grid), % create a blank grid
	play(Grid, yes), !. % don't have to cut here but it makes the exit cleaner

/* -----------------------------------------------
   Messages that will be printed at various points
   -----------------------------------------------*/
welcome_msg :-
	format('~nWelcome to the Prolog version of 2048~n~n'),
	format('To play using w,s,a,d keys for movement, q to quit~n~n').
contrats_msg :- format('Congratulations, you reached 2048!~n~n').
loser_msg :- format('Uh Oh, you could not quite make it to 2048...~n~n').
quit_msg :- format('Bye then!~n~n').

/* -------------------
   End game conditions
   -------------------*/
player_not_won_yet(Grid) :- maplist(dif(2048), Grid).
player_wins(Grid) :- member(2048, Grid).
player_loses(G) :- move(up, G, G), move(down, G, G), move(left, G, G), move(right, G, G).

/* ---------
   Game loop
   ---------*/
% First check if the player has reached the win condition, if not find how many spaces are left
play(Grid, _) :-
	player_wins(Grid),
	draw_grid(Grid),
	contrats_msg.
play(Grid, CreateNewNum) :-
	player_not_won_yet(Grid),
	include(=(' '), Grid, Spaces), length(Spaces, NSpaces), % the number of spaces in the grid
	play(Grid, CreateNewNum, NSpaces).

% knowing the number of spaces, determine if there is a space, and if we need a new number, and generate.
play(Grid, no, _) :- play(Grid).
play(Grid, yes, 0) :- play(Grid).
play(Grid, yes, NSpaces) :-
	dif(NSpaces, 0),
	random_space(NSpaces, Grid, GridWithRandom),
	play(GridWithRandom).

% with the new number on the grid we can tell if the player has lost the game yet
% if not, draw the grid and get the next action by the player
play(Grid) :-
	player_loses(Grid),
	draw_grid(Grid),
	loser_msg.
play(Grid) :-
	\+ player_loses(Grid),
	draw_grid(Grid),
	next_move_by_player(Move),
	player_made_move(Grid, Move).

% determine the result of player move
player_made_move(_, quit).
player_made_move(Grid, Move) :-
	dif(Move, quit),
	move(Move, Grid, Grid), % The move creating the same grid indicates that no merge was done
	play(Grid, no). % don't create a new number
player_made_move(Grid, Move) :-
	dif(Move, quit),
	move(Move, Grid, MovedGrid),
	dif(Grid, MovedGrid),
	play(MovedGrid, yes).

/* ---------------------------------------
   Get the next move from the player input
   ---------------------------------------*/
next_move_by_player(Move) :-
	repeat,
	get_single_char(Char),
	key_move(Char, Move).

% valid keys are: up = 'w', down = 's', left = 'a' right = 'd', quit = 'q'
key_move(119, up). key_move(115, down).	key_move(97, left). key_move(100, right). key_move(113, quit).

/* ------------------
   Draw the Game grid
   ------------------*/
draw_grid([A1,A2,A3,A4,B1,B2,B3,B4,C1,C2,C3,C4,D1,D2,D3,D4]) :-
	format(   '+-------------------+~n'),
	row([A1,A2,A3,A4]),
	row([B1,B2,B3,B4]),
	row([C1,C2,C3,C4]),
	maplist(draw, [D1,D2,D3,D4]),
	format('¦~n+-------------------+~n~n~n').

row([A,B,C,D]) :- maplist(draw, [A,B,C,D]), format('¦~n¦----+----+----+----¦~n').

draw(' ') :- format('¦    ').
draw(X) :- member(X,[2,4,8]), format('¦  ~d ', X).
draw(X) :- member(X,[16,32,64]), format('¦ ~d ', X).
draw(X) :- member(X,[128,256,512]), format('¦ ~d', X).
draw(X) :- member(X,[1024,2048]), format('¦~d', X).

/* ----------------------------------------
   Populate a random space with a new value
   ----------------------------------------*/
random_space(0, G, G).
random_space(1, Grid, GridWithRandom) :-
	four_or_two(V),
	select(' ', Grid, V, GridWithRandom).
random_space(N, Grid, GridWithRandom) :-
	N > 1,
	four_or_two(V),
	random(1, N, P),
	replace_space(P, V, Grid, GridWithRandom).

replace_space(0, V, [' '|T], [V|T]).
replace_space(P, V, [' '|T], [' '|R]) :-	succ(NextP, P),	replace_space(NextP, V, T, R).
replace_space(P, V, [H|T], [H|R]) :-	dif(' ', H), replace_space(P, V, T, R).

four_or_two(V) :- random(1, 10, IsFour), IsFour = 1 -> V = 4 ; V = 2.

/* ------------------------------------------
   Process a game move based on the direction
   ------------------------------------------*/
move(Direction, UnMoved, Moved) :-
	map_move(Direction, UnMoved, UnMovedMapped),
	maplist(combine_row, UnMovedMapped, MovedMapped),
	map_move(Direction, Moved, MovedMapped).

% convert the array to a set of lists that can be moved in the same
% direction. This can be reversed after the move is completed.
map_move(up, [A1,A2,A3,A4,B1,B2,B3,B4,C1,C2,C3,C4,D1,D2,D3,D4], [[D1,C1,B1,A1],[D2,C2,B2,A2],[D3,C3,B3,A3],[D4,C4,B4,A4]]).
map_move(down, [A1,A2,A3,A4,B1,B2,B3,B4,C1,C2,C3,C4,D1,D2,D3,D4], [[A1,B1,C1,D1],[A2,B2,C2,D2],[A3,B3,C3,D3],[A4,B4,C4,D4]]).
map_move(left, [A1,A2,A3,A4,B1,B2,B3,B4,C1,C2,C3,C4,D1,D2,D3,D4], [[A4,A3,A2,A1],[B4,B3,B2,B1],[C4,C3,C2,C1],[D4,D3,D2,D1]]).
map_move(right, [A1,A2,A3,A4,B1,B2,B3,B4,C1,C2,C3,C4,D1,D2,D3,D4], [[A1,A2,A3,A4],[B1,B2,B3,B4],[C1,C2,C3,C4],[D1,D2,D3,D4]]).

% remove all the spaces, then put them at the front of the list
combine_row(UnMoved, Moved) :-
	partition(=(' '), UnMoved, Blank, Set),
	append(Blank, Set, ReadyToMove),
	combine(ReadyToMove, Moved).

% combine based on the rules of the game.
combine([A,B,C,D], [A,B,C,D]) :- dif(A,B), dif(B,C), dif(C,D).
combine([A,A,B,B], [' ',' ',Ad,Bd]) :- dbl(A,Ad), dbl(B,Bd).
combine([A,B,C,C], [' ',A,B,Cd]) :- dif(A,B), dbl(C,Cd).
combine([A,B,B,C], [' ',A,Bd,C]) :-	dif(B,C), dbl(B,Bd).
combine([A,A,B,C], [' ',Ad,B,C]) :- dif(A,B), dif(B,C), dbl(A, Ad).
combine([A,B,C,C], [' ',A,B,Cd]) :- dif(A,B), dif(B,C), dbl(C,Cd).

% this could be done using maths, but it is more prology this way.
dbl(' ', ' ').
dbl(2,4). dbl(4,8). dbl(8,16). dbl(16,32). dbl(32,64). dbl(64,128). dbl(128,256). dbl(256,512). dbl(512,1028). dbl(1028,2048).


#!/usr/bin/env python3

import curses
from random import randrange, choice # generate and place new tile
from collections import defaultdict

letter_codes = [ord(ch) for ch in 'WASDRQwasdrq']
actions = ['Up', 'Left', 'Down', 'Right', 'Restart', 'Exit']
actions_dict = dict(zip(letter_codes, actions * 2))

def get_user_action(keyboard):
	char = "N"
	while char not in actions_dict:
		char = keyboard.getch()
	return actions_dict[char]

def transpose(field):
	return [list(row) for row in zip(*field)]

def invert(field):
	return [row[::-1] for row in field]

class GameField(object):
	def __init__(self, height=4, width=4, win=2048):
		self.height = height
		self.width = width
		self.win_value = win
		self.score = 0
		self.highscore = 0
		self.reset()

	def reset(self):
		if self.score > self.highscore:
			self.highscore = self.score
		self.score = 0
		self.field = [[0 for i in range(self.width)] for j in range(self.height)]
		self.spawn()
		self.spawn()

	def move(self, direction):
		def move_row_left(row):
			def tighten(row): # squeese non-zero elements together
				new_row = [i for i in row if i != 0]
				new_row += [0 for i in range(len(row) - len(new_row))]
				return new_row

			def merge(row):
				pair = False
				new_row = []
				for i in range(len(row)):
					if pair:
						new_row.append(2 * row[i])
						self.score += 2 * row[i]
						pair = False
					else:
						if i + 1 < len(row) and row[i] == row[i + 1]:
							pair = True
							new_row.append(0)
						else:
							new_row.append(row[i])
				assert len(new_row) == len(row)
				return new_row
			return tighten(merge(tighten(row)))

		moves = {}
		moves['Left']  = lambda field:								\
				[move_row_left(row) for row in field]
		moves['Right'] = lambda field:								\
				invert(moves['Left'](invert(field)))
		moves['Up']    = lambda field:								\
				transpose(moves['Left'](transpose(field)))
		moves['Down']  = lambda field:								\
				transpose(moves['Right'](transpose(field)))

		if direction in moves:
			if self.move_is_possible(direction):
				self.field = moves[direction](self.field)
				self.spawn()
				return True
			else:
				return False

	def is_win(self):
		return any(any(i >= self.win_value for i in row) for row in self.field)

	def is_gameover(self):
		return not any(self.move_is_possible(move) for move in actions)

	def draw(self, screen):
		help_string1 = '(W)Up (S)Down (A)Left (D)Right'
		help_string2 = '     (R)Restart (Q)Exit'
		gameover_string = '           GAME OVER'
		win_string = '          YOU WIN!'
		def cast(string):
			screen.addstr(string + '\n')

		def draw_hor_separator():
			top = '┌' + ('┬──────' * self.width + '┐')[1:]
			mid = '├' + ('┼──────' * self.width + '┤')[1:]
			bot = '└' + ('┴──────' * self.width + '┘')[1:]
			separator = defaultdict(lambda: mid)
			separator[0], separator[self.height] = top, bot
			if not hasattr(draw_hor_separator, "counter"):
				draw_hor_separator.counter = 0
			cast(separator[draw_hor_separator.counter])
			draw_hor_separator.counter += 1

		def draw_row(row):
			cast(''.join('│{: ^5} '.format(num) if num > 0 else '|      ' for num in row) + '│')

		screen.clear()
		cast('SCORE: ' + str(self.score))
		if 0 != self.highscore:
			cast('HIGHSCORE: ' + str(self.highscore))
		for row in self.field:
			draw_hor_separator()
			draw_row(row)
		draw_hor_separator()
		if self.is_win():
			cast(win_string)
		else:
			if self.is_gameover():
				cast(gameover_string)
			else:
				cast(help_string1)
		cast(help_string2)

	def spawn(self):
		new_element = 4 if randrange(100) > 89 else 2
		(i,j) = choice([(i,j) for i in range(self.width) for j in range(self.height) if self.field[i][j] == 0])
		self.field[i][j] = new_element

	def move_is_possible(self, direction):
		def row_is_left_movable(row):
			def change(i): # true if there'll be change in i-th tile
				if row[i] == 0 and row[i + 1] != 0: # Move
					return True
				if row[i] != 0 and row[i + 1] == row[i]: # Merge
					return True
				return False
			return any(change(i) for i in range(len(row) - 1))

		check = {}
		check['Left']  = lambda field:								\
				any(row_is_left_movable(row) for row in field)

		check['Right'] = lambda field:								\
				 check['Left'](invert(field))

		check['Up']    = lambda field:								\
				check['Left'](transpose(field))

		check['Down']  = lambda field:								\
				check['Right'](transpose(field))

		if direction in check:
			return check[direction](self.field)
		else:
			return False

def main(stdscr):
	curses.use_default_colors()
	game_field = GameField(win=32)
	state_actions = {} # Init, Game, Win, Gameover, Exit
	def init():
		game_field.reset()
		return 'Game'

	state_actions['Init'] = init

	def not_game(state):
		game_field.draw(stdscr)
		action = get_user_action(stdscr)
		responses = defaultdict(lambda: state)
		responses['Restart'], responses['Exit'] = 'Init', 'Exit'
		return responses[action]

	state_actions['Win'] = lambda: not_game('Win')
	state_actions['Gameover'] = lambda: not_game('Gameover')

	def game():
		game_field.draw(stdscr)
		action = get_user_action(stdscr)
		if action == 'Restart':
			return 'Init'
		if action == 'Exit':
			return 'Exit'
		if game_field.move(action): # move successful
			if game_field.is_win():
				return 'Win'
			if game_field.is_gameover():
				return 'Gameover'
		return 'Game'

	state_actions['Game'] = game

	state = 'Init'
	while state != 'Exit':
		state = state_actions[state]()

curses.wrapper(main)


_DEFINE A-Z AS _INTEGER64
DIM SHARED Grid(0 TO 5, 0 TO 5) AS INTEGER
CONST Left = 19200
CONST Right = 19712
CONST Down = 20480
CONST Up = 18432
CONST ESC = 27
CONST LCtrl = 100306
CONST RCtrl = 100305

Init
MakeNewGame
DO
    _LIMIT 30
    ShowGrid
    CheckInput flag
    IF flag THEN GetNextNumber
    _DISPLAY
LOOP

SUB CheckInput (flag)
flag = 0
k = _KEYHIT
SELECT CASE k
    CASE ESC: SYSTEM
    CASE 83, 115 'S
        IF _KEYDOWN(LCtrl) OR _KEYDOWN(RCtrl) THEN MakeNewGame
    CASE Left
        MoveLeft
        flag = -1 'we hit a valid move key.  Even if we don't move, get a new number
    CASE Up
        MoveUp
        flag = -1
    CASE Down
        MoveDown
        flag = -1
    CASE Right
        MoveRight
        flag = -1
END SELECT
END SUB

SUB MoveDown
'first move everything left to cover the blank spaces
DO
    moved = 0
    FOR y = 4 TO 1 STEP -1
        FOR x = 1 TO 4
            IF Grid(x, y) = 0 THEN 'every point above this moves down
                FOR j = y TO 1 STEP -1
                    Grid(x, j) = Grid(x, j - 1)
                    IF Grid(x, j) <> 0 THEN moved = -1
                NEXT
            END IF
        NEXT
    NEXT
    IF moved THEN y = y + 1 'recheck the same column
LOOP UNTIL NOT moved
FOR y = 4 TO 1 STEP -1
    FOR x = 1 TO 4
        IF Grid(x, y) <> 0 AND Grid(x, y) = Grid(x, y - 1) THEN 'add them together and every point above this moves
            Grid(x, y) = Grid(x, y) * 2
            FOR j = y - 1 TO 1
                Grid(x, j) = Grid(x, j - 1)
            NEXT
        END IF
    NEXT
NEXT
END SUB

SUB MoveLeft
'first move everything to cover the blank spaces
DO
    moved = 0
    FOR x = 1 TO 4
        FOR y = 1 TO 4
            IF Grid(x, y) = 0 THEN 'every point right of this moves left
                FOR j = x TO 4
                    Grid(j, y) = Grid(j + 1, y)
                    IF Grid(j, y) <> 0 THEN moved = -1
                NEXT
            END IF
        NEXT
    NEXT
    IF moved THEN x = x - 1 'recheck the same row
LOOP UNTIL NOT moved
FOR x = 1 TO 4
    FOR y = 1 TO 4
        IF Grid(x, y) <> 0 AND Grid(x, y) = Grid(x + 1, y) THEN 'add them together and every point right of this moves left
            Grid(x, y) = Grid(x, y) * 2
            FOR j = x + 1 TO 4
                Grid(j, y) = Grid(j + 1, y)
            NEXT
        END IF
    NEXT
NEXT
END SUB

SUB MoveUp
'first move everything to cover the blank spaces
DO
    moved = 0
    FOR y = 1 TO 4
        FOR x = 1 TO 4
            IF Grid(x, y) = 0 THEN 'every point below of this moves up
                FOR j = y TO 4
                    Grid(x, j) = Grid(x, j + 1)
                    IF Grid(x, j) <> 0 THEN moved = -1
                NEXT
            END IF
        NEXT
    NEXT
    IF moved THEN y = y - 1 'recheck the same column
LOOP UNTIL NOT moved
FOR y = 1 TO 4
    FOR x = 1 TO 4
        IF Grid(x, y) <> 0 AND Grid(x, y) = Grid(x, y + 1) THEN 'add them together and every point below this moves
            Grid(x, y) = Grid(x, y) * 2
            FOR j = y + 1 TO 4
                Grid(x, j) = Grid(x, j + 1)
            NEXT
            Grid(x, 4) = 0
        END IF
    NEXT
NEXT
END SUB

SUB MoveRight
'first move everything to cover the blank spaces
DO
    moved = 0
    FOR x = 4 TO 1 STEP -1
        FOR y = 1 TO 4
            IF Grid(x, y) = 0 THEN 'every point right of this moves left
                FOR j = x TO 1 STEP -1
                    Grid(j, y) = Grid(j - 1, y)
                    IF Grid(j, y) <> 0 THEN moved = -1
                NEXT
            END IF
        NEXT
    NEXT
    IF moved THEN x = x - 1 'recheck the same row
LOOP UNTIL NOT moved

FOR x = 4 TO 1 STEP -1
    FOR y = 1 TO 4
        IF Grid(x, y) <> 0 AND Grid(x, y) = Grid(x - 1, y) THEN 'add them together and every point right of this moves left
            Grid(x, y) = Grid(x, y) * 2
            FOR j = x - 1 TO 1 STEP -1
                Grid(j, y) = Grid(j - 1, y)
            NEXT
        END IF
    NEXT
NEXT
END SUB

SUB ShowGrid
'SUB MakeBox (Mode AS INTEGER, x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER,
'Caption AS STRING, FontColor AS _UNSIGNED LONG, FontBackground AS _UNSIGNED LONG,
'BoxColor AS _UNSIGNED LONG, BoxHighLight AS _UNSIGNED LONG, XOffset AS INTEGER, YOffset AS INTEGER)
w = 120
h = 120
FOR x = 1 TO 4
    FOR y = 1 TO 4
        t$ = LTRIM$(STR$(Grid(x, y)))
        IF t$ = "0" THEN t$ = ""
        MakeBox 4, (x - 1) * w, (y - 1) * h, w, h, t$, -1, 0, 0, -1, 0, 0
    NEXT
NEXT
END SUB

SUB Init
ws = _NEWIMAGE(480, 480, 32)
SCREEN ws
_DELAY 1
_TITLE "Double Up"
_SCREENMOVE _MIDDLE
RANDOMIZE TIMER
f& = _LOADFONT("C:\Windows\Fonts\courbd.ttf", 32, "MONOSPACE")
_FONT f&

END SUB

SUB MakeNewGame
FOR x = 1 TO 4
    FOR y = 1 TO 4
        Grid(x, y) = 0
    NEXT
NEXT
GetNextNumber
GetNextNumber
END SUB

SUB GetNextNumber
FOR x = 1 TO 4
    FOR y = 1 TO 4
        IF Grid(x, y) = 0 THEN valid = -1
    NEXT
NEXT
IF valid THEN 'If all the grids are full, we can't add any more numbers
    'This doesn't mean the game is over, as the player may be able to
    DO
        x = _CEIL(RND * 4)
        y = _CEIL(RND * 4)
    LOOP UNTIL Grid(x, y) = 0
    Grid(x, y) = 2
END IF
END SUB

SUB MakeBox (Mode AS INTEGER, x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER, Caption AS STRING, FontColor AS _UNSIGNED LONG, FontBackground AS _UNSIGNED LONG, BoxColor AS _UNSIGNED LONG, BoxHighLight AS _UNSIGNED LONG, XOffset AS INTEGER, YOffset AS INTEGER)

'This is an upgrade version of my original Button routine.
'It's more versitile (but complex) than the original.
'Mode 0 (or any unsupported number) will tell the box to size itself from X1,Y1 to X2,Y2
'Mode 1 will tell the box to autosize itself according to whatever text is placed within it.
'Mode 2 will tell the box to use X2 and Y2 as relative coordinates and not absolute coordinates.
'Mode 3 will tell the box to autocenter text with X2, Y2 being absolute coordinates.
'Mode 4 will tell the box to autocenter text with X2, Y2 being relative coordinates.
'Mode otherwise is unused, but available for expanded functionality.
'X1 carries the X location of where we want to place our box on the screen.
'Y2 carries the Y location of where we want to place our box on the screen.
'X2 is the X boundry of our box on the screen, depending on our mode.
'Y2 is the Y boundry of our box on the screen, depending on our mode.

'Caption is the text that we want our box to contain.

'FontColor is our font color for our caption
'FontBackground is the font background color for our caption
'NOTE: IF FONTCOLOR OR FONTBACKGROUND IS SET TO ZERO, THEY WILL **NOT** AFFECT THE COLOR BEHIND THEM.
'This can be used to mimic the function of _KEEPBACKGROUND, _FILLBACKGROUND, or _ONLYBACKGROUND

'BoxColor is our box color
'BoxHighlight is our box highligh colors
'NOTE: SAME WITH BOXCOLOR AND BOXHIGHLIGHT.  IF SET TO ZERO, THEY WILL HAVE **NO** COLOR AT ALL TO THEM, AND WILL NOT AFFECT THE BACKGROUND OF ANYTHING BEHIND THEM.

'XOffset is used to offset our text # pixels from the X1 top.
'YOffset is used to offset our text # pixels from the Y1 top.
'These can be used to place our text wherever we want on our box.
'But remember, if Mode = 3 or 4, the box will autocenter the text and ignore these parameters completely.

DIM BoxBlack AS _UNSIGNED LONG

dc& = _DEFAULTCOLOR: bg& = _BACKGROUNDCOLOR
IF Black <> 0 THEN
    'We have black either as a CONST or a SHARED color
    BoxBlack = Black
ELSE
    'We need to define what Black is for our box.
    BoxBlack = _RGB32(0, 0, 0)
END IF

IF _FONTWIDTH <> 0 THEN cw = _FONTWIDTH * LEN(Caption) ELSE cw = _PRINTWIDTH(Caption)
ch = _FONTHEIGHT

tx1 = x1: tx2 = x2: ty1 = y1: ty2 = y2
SELECT CASE Mode
    CASE 0
        'We use the X2, Y2 coordinates provided as absolute coordinates
    CASE 1
        tx2 = tx1 + cw + 8
        ty2 = ty1 + ch + 8
        XOffset = 5: YOffset = 5
    CASE 2
        tx2 = tx1 + x2
        ty2 = ty1 + y2
    CASE 3
        XOffset = (tx2 - tx1 - cw) \ 2
        YOffset = (ty2 - ty1 - ch) \ 2
    CASE 4
        tx2 = tx1 + x2
        ty2 = ty1 + y2
        XOffset = (tx2 - tx1) \ 2 - cw \ 2
        YOffset = (ty2 - ty1 - ch) \ 2
END SELECT
LINE (tx1, ty1)-(tx2, ty2), BoxBlack, BF
LINE (tx1 + 1, ty1 + 1)-(tx2 - 1, ty2 - 1), BoxHighLight, B
LINE (tx1 + 2, ty1 + 2)-(tx2 - 2, ty2 - 2), BoxHighLight, B
LINE (tx1 + 3, ty1 + 3)-(tx2 - 3, ty2 - 3), BoxBlack, B
LINE (tx1, ty1)-(tx1 + 3, ty1 + 3), BoxBlack
LINE (tx2, ty1)-(tx2 - 3, ty1 + 3), BoxBlack
LINE (tx1, ty2)-(tx1 + 3, ty2 - 3), BoxBlack
LINE (tx2, ty2)-(tx2 - 3, ty2 - 3), BoxBlack
LINE (tx1 + 3, y1 + 3)-(tx2 - 3, ty2 - 3), BoxColor, BF
COLOR FontColor, FontBackground
_PRINTSTRING (tx1 + XOffset, ty1 + YOffset), Caption$
COLOR dc&, bg&
END SUB


GD <- function(vec) {
    c(vec[vec != 0], vec[vec == 0])
}
DG <- function(vec) {
    c(vec[vec == 0], vec[vec != 0])
}

DG_ <- function(vec, v = TRUE) {
    if (v)
        print(vec)
    rev(GD_(rev(vec), v = FALSE))
}

GD_ <- function(vec, v = TRUE) {
    if (v) {
        print(vec)
    }
    vec2 <- GD(vec)
    # on cherche les 2 cote a cote
    pos <- which(vec2 == c(vec2[-1], 9999))
    # put pas y avoir consécutif dans pos
    pos[-1][which(abs(pos - c(pos[-1], 999)) == 1)]
    av <- which(c(0, c(pos[-1], 9) - pos) == 1)
    if (length(av) > 0) {
        pos <- pos[-av]
    }
    vec2[pos] <- vec2[pos] + vec2[pos + 1]
    vec2[pos + 1] <- 0
    GD(vec2)

}

H_ <- function(base) {
    apply(base, MARGIN = 2, FUN = GD_, v = FALSE)
}
B_ <- function(base) {
    apply(base, MARGIN = 2, FUN = DG_, v = FALSE)
}
G_ <- function(base) {
    t(apply(base, MARGIN = 1, FUN = GD_, v = FALSE))
}
D_ <- function(base) {
    t(apply(base, MARGIN = 1, FUN = DG_, v = FALSE))
}

H <- function(base) {
    apply(base, MARGIN = 2, FUN = GD, v = FALSE)
}
B <- function(base) {
    apply(base, MARGIN = 2, FUN = DG, v = FALSE)
}
G <- function(base) {
    t(apply(base, MARGIN = 1, FUN = GD, v = FALSE))
}
D <- function(base) {
    t(apply(base, MARGIN = 1, FUN = DG, v = FALSE))
}

add2or4 <- function(base, p = 0.9) {
    lw <- which(base == 0)
    if (length(lw) > 1) {
        tirage <- sample(lw, 1)
    } else {
        tirage <- lw
    }
    base[tirage] <- sample(c(2, 4), 1, prob = c(p, 1 - p))
    base
}
print.dqh <- function(base) {
    cat("\n\n")
    for (i in 1:nrow(base)) {
        cat(paste("     ", base[i, ], " "))
        cat("\n")
    }
    cat("\n")
}

# -*- coding: utf-8 -*-
#' @encoding UTF-8
#' @title run_2048
#' @description The 2048 game
#' @param nrow nomber of row
#' @param ncol numver of col
#' @param p probability to obtain a 2 (1-p) is the probability to obtain a 4
#' @examples
#' \dontrun{
#' run_2048()
#' }
#' @export

run_2048 <- function(nrow, ncol, p = 0.9) {

    help <- function() {
        cat("   *** KEY BINDING ***  \n\n")
        cat("press ECHAP to quit\n\n")
        cat("choose moove E (up) ; D (down) ; S (left); F (right) \n")
        cat("choose moove 8 (up) ; 2 (down) ; 4 (left); 6 (right) \n")
        cat("choose moove I (up) ; K (down) ; J (left); L (right) \n\n\n")

    }

    if (missing(nrow) & missing(ncol)) {
        nrow <- ncol <- 4
    }
    if (missing(nrow)) {
        nrow <- ncol
    }
    if (missing(ncol)) {
        ncol <- nrow
    }

    base <- matrix(0, nrow = nrow, ncol = ncol)

    while (length(which(base == 2048)) == 0) {
        base <- add2or4(base, p = p)
        # print(base)

        class(base) <- "dqh"
        print(base)
        flag <- sum((base == rbind(base[-1, ], 0)) + (base == rbind(0,
            base[-nrow(base), ])) + (base == cbind(base[, -1], 0)) + (base ==
            cbind(0, base[, -nrow(base)])))
        if (flag == 0) {

            break
        }

        y <- character(0)
        while (length(y) == 0) {
            cat("\n", "choose moove E (up) ; D (down) ; s (left); f (right) OR H for help",
                "\n")  # prompt
            y <- scan(n = 1, what = "character")
        }

        baseSAVE <- base
        base <- switch(EXPR = y, E = H_(base), D = B_(base), S = G_(base),
            F = D_(base), e = H_(base), d = B_(base), s = G_(base), f = D_(base),
            `8` = H_(base), `2` = B_(base), `4` = G_(base), `6` = D_(base),
            H = help(), h = help(), i = H_(base), k = B_(base), j = G_(base),
            l = D_(base), I = H_(base), K = B_(base), J = G_(base), L = D_(base))
        if (is.null(base)) {
            cat(" wrong KEY \n")
            base <- baseSAVE
        }

    }

    if (sum(base >= 2048) > 1) {
        cat("YOU WIN ! \n")
    } else {
        cat("YOU LOOSE \n")
    }
}


;; LICENSE: See License file LICENSE (MIT license)
;;
;; Repository: https://github.com/danprager/2048
;;
;; Copyright 2014: Daniel Prager
;;                 [email protected]
;;
;; This is a largely clean-room, functional implementation in Racket
;; of the game 2048 by Gabriele Cirulli, based on 1024 by Veewo Studio,
;; and conceptually similar to Threes by Asher Vollmer.
;;
;;
;; HOW TO PLAY:
;;   * Use your arrow keys to slide the tiles.
;;   * When two tiles with the same number touch, they merge into one!
;;   * Press <space> to rotate the board.
;;

#lang racket

(require rackunit
         2htdp/image
         (rename-in 2htdp/universe
                    [left left-arrow]
                    [right right-arrow]
                    [up up-arrow]
                    [down down-arrow]))

(define *side* 4)              ; Side-length of the grid
(define *time-limit* #f)       ; Use #f for no time limit, or number of seconds

(define *amber-alert* 60)      ; Time indicator goes orange when less than this number of seconds remaining
(define *red-alert* 10)        ; Time indicator goes red when less than this number of seconds remaining

(define *tile-that-wins* 2048) ; You win when you get a tile = this number
(define *magnification* 2)     ; Scales the game board

(define (set-side! n)
  (set! *side* n))

;;
;; Numbers can be displayed with substiture text. Just edit this table...
;;
(define *text*
  '((0 "")
    (2 "2")))

;; Color scheme
;;
;; From https://github.com/gabrielecirulli/2048/blob/master/style/main.css
;;
(define *grid-color* (color #xbb #xad #xa0))

(define *default-tile-bg-color* (color #x3c #x3a #x32))
(define *default-tile-fg-color* 'white)

(define *tile-bg-colors*
  (map (lambda (x)
         (match-define (list n r g b) x)
         (list n (color r g b)))
       '((0 #xcc #xc0 #xb3)
         (2 #xee #xe4 #xda)
         (4 #xed #xe0 #xc8)
         (8 #xf2 #xb1 #x79)
         (16 #xf5 #x95 #x63)
         (32 #xf6 #x7c #x5f)
         (64 #xf6 #x5e #x3b)
         (128 #xed #xcf #x72)
         (256 #xed #xcc #x61)
         (512 #xed #xc8 #x50)
         (1024 #xed #xc5 #x3f)
         (2048 #xed #xc2 #x2e))))

(define *tile-fg-colors*
  '((0 dimgray)
    (2 dimgray)
    (4 dimgray)
    (8 white)
    (16 white)
    (32 white)
    (64 white)
    (128 white)
    (256 white)
    (512 white)
    (1024 white)
    (2048 white)))

;;--------------------------------------------------------------------
;; Rows may be represented as lists, with 0s representing empty spots.
;;

(define (nonzero? x) (not (zero? x)))

;; Append padding to lst to make it n items long
;;
(define (pad-right lst padding n)
  (append lst (make-list (- n (length lst)) padding)))

;; Slide items towards the head of the list, doubling adjacent pairs
;; when no item is a 0.
;;
;; E.g. (combine '(2 2 2 4 4)) -> '(4 2 8)
;;
(define (combine lst)
  (cond [(<= (length lst) 1) lst]
        [(= (first lst) (second lst))
         (cons (* 2 (first lst)) (combine (drop lst 2)))]
        [else (cons (first lst) (combine (rest lst)))]))

;; Total of new elements introduced by combining.
;;
;; E.g. (combine-total '(2 2 2 4 4)) -> 4 + 8 = 12
;;
(define (combine-total lst)
  (cond [(<= (length lst) 1) 0]
        [(= (first lst) (second lst))
         (+ (* 2 (first lst)) (combine-total (drop lst 2)))]
        [else (combine-total (rest lst))]))

;; Slide towards the head of the list, doubling pairs, 0 are
;; allowed (and slid through), and length is preserved by
;; padding with 0s.
;;
;; E.g. (slide-left '(2 2 2 0 4 4)) -> '(4 2 8 0 0 0)
;;
(define (slide-left row)
  (pad-right (combine (filter nonzero? row)) 0 (length row)))

;; Slide towards the tail of the list:
;;
;; E.g. (slide-right '(2 2 0 0 4 4)) -> '(0 0 0 0 0 4 8)
;;
(define (slide-right row) (reverse (slide-left (reverse row))))

;;--------------------------------------------------------------------
;; We use a sparse representation for transitions in a row.
;;
;; Moves take the form '(value initial-position final-position)
;;
(define (moves-row-left row [last #f] [i 0] [j -1])
  (if (null? row)
      null
      (let ([head (first row)])
        (cond [(zero? head) (moves-row-left (rest row) last (add1 i) j)]
              [(equal? last head)
               (cons (list head i j)
                     (moves-row-left (rest row) #f (add1 i) j))]
              [else (cons (list head i (add1 j))
                          (moves-row-left (rest row) head (add1 i) (add1 j)))]))))

;; Convert a row into the sparse representaiton without any sliding.
;;
;; E.g. (moves-row-none '(0 2 0 4)) -> '((2 1 1) (4 3 3))
;;
(define (moves-row-none row)
  (for/list ([value row]
             [i (in-naturals)]
             #:when (nonzero? value))
    (list value i i)))

;; Reverse all moves so that:
;;
;; '(value initial final) -> '(value (- n initial 1) (- n final 1)
;;
(define (reverse-moves moves n)
  (define (flip i) (- n i 1))
  (map (λ (m)
         (match-define (list a b c) m)
         (list a (flip b) (flip c)))
       moves))

(define (transpose-moves moves)
  (for/list ([m moves])
    (match-define (list v (list a b) (list c d)) m)
    (list v (list b a) (list d c))))

(define (moves-row-right row [n *side*])
  (reverse-moves (moves-row-left (reverse row)) n))

;;--------------------------------------------------------------------
;; Lift the sparse representation for transitions
;; up to two dimensions...
;;
;; '(value initial final) -> '(value (x initial) (x final))
;;
(define (add-row-coord i rows)
  (for/list ([r rows])
    (match-define (list a b c) r)
    (list a (list i b) (list i c))))

(define (transpose lsts)
  (apply map list lsts))

;; Slide the entire grid in the specified direction
;;
(define (left grid)
  (map slide-left grid))

(define (right grid)
  (map slide-right grid))

(define (up grid)
  ((compose transpose left transpose) grid))

(define (down grid)
  ((compose transpose right transpose) grid))

;; Calculate the change to score from sliding the grid left or right.
;;
(define (score-increment grid)
  (apply + (map (λ (row)
                  (combine-total (filter nonzero? row)))
                grid)))

;; Slide the grid in the specified direction and
;; determine the transitions of the tiles.
;;
;; We'll use these operations to animate the sliding of the tiles.
;;
(define (moves-grid-action grid action)
  (let ([n (length (first grid))])
    (apply append
           (for/list ([row grid]
                      [i (in-range n)])
             (add-row-coord i (action row))))))

(define (moves-grid-left grid)
  (moves-grid-action grid moves-row-left))

(define (moves-grid-right grid)
  (moves-grid-action grid moves-row-right))

(define (moves-grid-up grid)
  ((compose transpose-moves moves-grid-left transpose) grid))

(define (moves-grid-down grid)
  ((compose transpose-moves moves-grid-right transpose) grid))

;; Rotating the entire grid doesn't involve sliding.
;; It's a convenience to allow the player to view the grid from a different
;; orientation.
(define (moves-grid-rotate grid)
  (let ([n (length (first grid))])
    (for/list ([item (moves-grid-action grid moves-row-none)])
      (match-define (list v (list i j) _) item)
      (list v (list i j) (list j (- n i 1))))))

;; Chop a list into a list of sub-lists of length n. Used to move from
;; a flat representation of the grid into a list of rows.
;;
;;
(define (chop lst [n *side*])
  (if (<= (length lst) n)
      (list lst)
      (cons (take lst n) (chop (drop lst n) n))))

;; The next few functions are used to determine where to place a new
;; number in the grid...
;;

;; How many zeros in the current state?
;;
(define (count-zeros state)
  (length (filter zero? state)))

;; What is the absolute index of the nth zero in lst?
;;
;; E.g. (index-of-nth-zero '(0 2 0 4) 1 2)) 1) -> 2
;;
(define (index-of-nth-zero lst n)
  (cond [(null? lst) #f]
        [(zero? (first lst))
         (if (zero? n)
             0
             (add1 (index-of-nth-zero (rest lst) (sub1 n))))]
        [else (add1 (index-of-nth-zero (rest lst) n))]))

;; Place the nth zero in the lst with val.
;;
;; E.g. (replace-nth-zero '(0 2 0 4) 1 2)) -> '(0 2 2 4)
;;
(define (replace-nth-zero lst n val)
  (let ([i (index-of-nth-zero lst n)])
    (append (take lst i) (cons val (drop lst (add1 i))))))

;; There's a 90% chance that a new tile will be a two; 10% a four.
;;
(define (new-tile)
  (if (> (random) 0.9) 4 2))

;; Create a random initial game-board with two non-zeros (2 or 4)
;; and the rest 0s.
;;
;; E.g. '(0 0 0 0
;;        0 2 0 0
;;        2 0 0 0
;;        0 0 0 0)
;;
(define (initial-state [side *side*])
  (shuffle (append (list (new-tile) (new-tile))
                   (make-list (- (sqr side) 2) 0))))

;; The game finishes when no matter which way you slide, the board doesn't
;; change.
;;
(define (finished? state [n *side*])
  (let ([grid (chop state n)])
    (for/and ([op (list left right up down)])
      (equal? grid (op grid)))))

;;--------------------------------------------------------------------
;; Graphics
;;
(define *text-size* 30)
(define *max-text-width* 40)
(define *tile-side* 50)
(define *grid-spacing* 5)
(define *grid-side* (+ (* *side* *tile-side*)
                       (* (add1 *side*) *grid-spacing*)))

;; Memoization - caching images takes the strain off the gc
;;
(define-syntax define-memoized
  (syntax-rules ()
    [(_ (f args ...) bodies ...)
     (define f
       (let ([results (make-hash)])
         (lambda (args ...)
           ((λ vals
              (when (not (hash-has-key? results vals))
                (hash-set! results vals (begin bodies ...)))
              (hash-ref results vals))
            args ...))))]))

;; Look-up the (i,j)th element in the flat representation.
;;
(define (square/ij state i j)
  (list-ref state (+ (* *side* i) j)))

;; Linear interpolation between a and b:
;;
;;   (interpolate 0.0 a b) -> a
;;   (interpolate 1.0 a b) -> b
;;
(define (interpolate k a b)
  (+ (* (- 1 k) a)
     (* k b)))

;; Key value lookup with default return - is there an out-of-the-box function
;; for this?
;;
(define (lookup key lst default)
  (let ([value (assoc key lst)])
    (if value (second value) default)))

;; Make a tile without a number on it in the appropriate color.
;;
(define (plain-tile n)
  (square *tile-side*
          'solid
          (lookup n *tile-bg-colors* *default-tile-bg-color*)))

;; Make text for a tile
;;
(define (tile-text n)
  (let* ([t (text (lookup n *text* (number->string n))
                  *text-size*
                  (lookup n *tile-fg-colors* *default-tile-fg-color*))]
         [side (max (image-width t) (image-height t))])
    (scale (if (> side *max-text-width*) (/ *max-text-width* side) 1) t)))

(define-memoized (make-tile n)
  (overlay
   (tile-text n)
   (plain-tile n)))

;; Place a tile on an image of the grid at (i,j)
;;
(define (place-tile/ij tile i j grid-image)
  (define (pos k)
    (+ (* (add1 k) *grid-spacing*)
       (* k *tile-side*)))
  (underlay/xy grid-image (pos j) (pos i) tile))

;; Make an image of the grid from the flat representation
;;
(define *last-state* null) ; Cache the previous grid to avoid
(define *last-grid* null)  ; senseless regeneration

(define (state->image state)
  (unless (equal? state *last-state*)
    (set! *last-grid*
          (for*/fold ([im (square *grid-side* 'solid *grid-color*)])
            ([i (in-range *side*)]
             [j (in-range *side*)])
            (place-tile/ij (make-tile (square/ij state i j))
                           i j
                           im)))
    (set! *last-state* state))
  *last-grid*)

(define *empty-grid-image*
  (state->image (make-list (sqr *side*) 0)))

;; Convert the sparse representation of moves into a single frame in an
;; animation at time k, where k is between 0.0 (start state) and 1.0
;; (final state).
;;
(define (moves->frame moves k)
  (for*/fold ([grid *empty-grid-image*])
    ([m moves])
    (match-define (list value (list i1 j1) (list i2 j2)) m)
    (place-tile/ij (make-tile value)
                   (interpolate k i1 i2) (interpolate k j1 j2)
                   grid)))

;; Animation of simultaneously moving tiles.
;;
(define (animate-moving-tiles state op)
  (let ([grid (chop state)])
    (build-list 9 (λ (i)
                    (λ ()
                      (moves->frame (op grid)
                                    (* 0.1 (add1 i))))))))

;; Animation of a tile appearing in a previously blank square.
;;
(define (animate-appearing-tile state value index)
  (let ([start (state->image state)]
        [tile (make-tile value)]
        [i (quotient index *side*)]
        [j (remainder index *side*)])
    (build-list 4 (λ (m)
                    (λ ()
                      (place-tile/ij (overlay
                                      (scale (* 0.2 (add1 m)) tile)
                                      (plain-tile 0))
                                     i j
                                     start))))))

;;--------------------------------------------------------------
;;
;; The Game
;;

;; an image-procedure is a procedure of no arguments that produces an image

;; a world contains:
;; state is a ?
;; score is a number
;; winning-total is #f or a number, representing the final score <-- is this
;;  necessary?
;; frames is a (list-of image-procedure)
;; start-time is a number, in seconds
(define-struct world (state score winning-total frames start-time) #:transparent)

;; The game is over when any animations have been finished and
;; no more moves are possible.
;;
;; note that winning the game does *not* end the game.
;;
(define (game-over? w)
  (match-define (world state score wt frames start-time) w)
  (and (null? frames) ; Finish animations to reach final state and show the banner
       (or (finished? state)
           (out-of-time? (world-start-time w)))))

;; Is the player out of time?
(define (out-of-time? start-time)
  (and *time-limit* (< (+ start-time *time-limit*) (current-seconds))))

;; Given an arrow key return the operations to change the state and
;; produce the sliding animation.
;;
(define (key->ops a-key)
  (cond
    [(key=? a-key "left")  (list left moves-grid-left)]
    [(key=? a-key "right") (list right moves-grid-right)]
    [(key=? a-key "up")    (list up moves-grid-up)]
    [(key=? a-key "down")  (list down moves-grid-down)]
    [else (list #f #f)]))

;; Respond to a key-press
;;
(define (change w a-key)
  (match-let ([(list op moves-op) (key->ops a-key)]
              [(world st score wt frames start-time) w])
    (cond [(out-of-time? start-time) w] ; Stop accepting key-presses
          [op
           (let* ([grid (chop st)]
                  [slide-state (flatten (op grid))])
             (if (equal? slide-state st)
                 w                       ; sliding had no effect
                 (let* ([replace (random (count-zeros slide-state))]
                        [index (index-of-nth-zero slide-state replace)]
                        [value (new-tile)]
                        [new-state (replace-nth-zero slide-state replace value)]
                        [horizontal? (member a-key (list "left" "right"))])
                   (make-world new-state
                               (+ score (score-increment
                                         (if horizontal? grid (transpose grid))))
                               (cond [wt wt]
                                     [(won-game? new-state)
                                      (apply + (flatten new-state))]
                                     [else #f])
                               (append frames
                                       (animate-moving-tiles st moves-op)
                                       (animate-appearing-tile slide-state value index))
                               start-time))))]
          [(key=? a-key " ")             ; rotate the board
           (make-world ((compose flatten transpose reverse) (chop st))
                       score wt
                       (append frames
                               (animate-moving-tiles st moves-grid-rotate))
                       start-time)]
          [else w])))                    ; unrecognised key - no effect

;; Are we there yet?
;;
(define (won-game? state)
  (= (apply max state) *tile-that-wins*))

;; Banner overlay text: e.g. You won! / Game Over, etc.
;;
(define (banner txt state [color 'black])
  (let ([b-text (text txt 30 color)])
    (overlay
     b-text
     (rectangle (* 1.2 (image-width b-text))
                (* 1.4 (image-height b-text))
                'solid 'white)
     (state->image state))))

;; Convert number of seconds to "h:mm:ss" or "m:ss" format
;;
(define (number->time-string s)
  (define hrs (quotient s 3600))
  (define mins (quotient (remainder s 3600) 60))
  (define secs (remainder s 60))
  (define (xx n)
    (cond [(<= n 0) "00"]
          [(<= n 9) (format "0~a" n)]
          [else (remainder n 60)]))
  (if (>= s 3600)
      (format "~a:~a:~a" hrs (xx mins) (xx secs))
      (format "~a:~a" mins (xx secs))))

(define (time-remaining start)
  (+ *time-limit* start (- (current-seconds))))

(define (time-elapsed start)
  (- (current-seconds) start))

;; Display the grid with score below.
;;
;; If there are frames, show the next one. Otherwise show the steady state.
;;
(define (show-world w)
  (match-define (world state score wt frames start-time) w)
  (let* ([board (if (null? frames)
                    (cond [(finished? state) (banner "Game over" state)]
                          [(out-of-time? start-time) (banner "Out of Time" state 'red)]

                          ;; Q: Why wt (i.e. winning-total) rather than won-game?
                          ;; A: wt allows the keen player to continue playing...
                          [(equal? (apply + (flatten state)) wt) (banner "You won!" state)]
                          [else (state->image state)])
                    ((first frames)))]
         [score-text (text (format "Score: ~a" score) 16 'dimgray)]
         [seconds ((if *time-limit* time-remaining time-elapsed) start-time)]
         [time-text (text (format "Time: ~a"
                                  (number->time-string seconds))
                          16
                          (cond [(or (> seconds *amber-alert*) (not *time-limit*)) 'gray]
                                [(> seconds *red-alert*) 'orange]
                                [else 'red]))])
    (scale *magnification*
           (above
            board
            (rectangle 0 5 'solid 'white)
            (beside
             score-text
             (rectangle (- (image-width board)
                           (image-width score-text)
                           (image-width time-text)) 0 'solid 'white)
             time-text)))))

;; Move to the next frame in the animation.
;;
(define (advance-frame w)
  (match-define (world state score wt frames start-time) w)
  (if (null? frames)
      w
      (make-world state score wt (rest frames) start-time)))

;; Use this state to preview the appearance of all the tiles
;;
(define (all-tiles-state)
  (let ([all-tiles '(0 2 4 8 16 32 64 128 256 512 1024 2048 4096)])
    (append all-tiles (make-list (- (sqr *side*) (length all-tiles)) 0))))

;; The event loop
;;
(define (start)
  (big-bang (make-world (initial-state)
                        ;(all-tiles-state)
                        0 #f null (current-seconds))
            (to-draw show-world)
            (on-key change)
            (on-tick advance-frame 0.01)
            (stop-when game-over? show-world)
            (name "2048 - Racket edition")))

;;
;; TESTS
;;
(module+ test
  (set-side! 4)

  (check-equal? (slide-left '(0 0 0 0)) '(0 0 0 0))
  (check-equal? (slide-left '(1 2 3 4)) '(1 2 3 4))
  (check-equal? (slide-left '(2 0 4 0)) '(2 4 0 0))
  (check-equal? (slide-left '(0 0 2 4)) '(2 4 0 0))
  (check-equal? (slide-left '(2 0 2 0)) '(4 0 0 0))
  (check-equal? (slide-left '(0 8 8 0)) '(16 0 0 0))
  (check-equal? (slide-left '(4 4 8 8)) '(8 16 0 0))
  (check-equal? (slide-right '(4 4 8 8)) '(0 0 8 16))
  (check-equal? (slide-right '(4 4 4 0)) '(0 0 4 8))

  (check-equal? (moves-row-left '(0 0 0 0)) '())
  (check-equal? (moves-row-left '(1 2 3 4))
                '((1 0 0)
                  (2 1 1)
                  (3 2 2)
                  (4 3 3)))

  (check-equal? (moves-row-left '(2 0 4 0)) '((2 0 0)
                                              (4 2 1)))

  (check-equal? (moves-row-right '(2 0 4 0)) '((4 2 3)
                                               (2 0 2)))

  (check-equal? (moves-row-left '(0 0 2 4)) '((2 2 0)
                                              (4 3 1)))

  (check-equal? (moves-row-left '(2 0 2 0)) '((2 0 0)
                                              (2 2 0)))

  (check-equal? (moves-row-left '(2 2 2 0)) '((2 0 0)
                                              (2 1 0)
                                              (2 2 1)))

  (check-equal? (moves-row-right '(2 2 2 0)) '((2 2 3)
                                               (2 1 3)
                                               (2 0 2)))

  (check-equal? (moves-row-left '(2 2 4 4)) '((2 0 0)
                                              (2 1 0)
                                              (4 2 1)
                                              (4 3 1)))

  (check-equal? (moves-row-right '(2 2 4 4)) '((4 3 3)
                                               (4 2 3)
                                               (2 1 2)
                                               (2 0 2)))

  (check-equal? (add-row-coord 7 '((2 0 0)
                                   (2 1 0)
                                   (4 2 1)))
                '((2 (7 0) (7 0))
                  (2 (7 1) (7 0))
                  (4 (7 2) (7 1))))

  (check-equal? (left '(( 0 8 8 0)
                        (16 0 0 0)
                        ( 2 2 4 4)
                        ( 0 2 2 2)))
                '((16 0 0 0)
                  (16 0 0 0)
                  ( 4 8 0 0)
                  ( 4 2 0 0)))
  (check-equal? (right '(( 0 8 8 0)
                         (16 0 0 0)
                         ( 2 2 4 4)
                         ( 0 2 2 2)))
                '((0 0 0 16)
                  (0 0 0 16)
                  (0 0 4  8)
                  (0 0 2  4)))
  (check-equal? (up '((0 16 2 0)
                      (8  0 2 2)
                      (8  0 4 2)
                      (0  0 4 2)))
                '((16 16 4 4)
                  (0  0  8 2)
                  (0  0  0 0)
                  (0  0  0 0)))
  (check-equal? (down '((0 16 2 0)
                        (8  0 2 2)
                        (8  0 4 2)
                        (0  0 4 2)))
                '((0  0  0 0)
                  (0  0  0 0)
                  (0  0  4 2)
                  (16 16 8 4)))

  (check-equal? (left '(( 0 8 8 0)
                        (16 0 0 0)
                        ( 2 2 4 4)
                        ( 0 2 2 2)))
                '((16 0 0 0)
                  (16 0 0 0)
                  ( 4 8 0 0)
                  ( 4 2 0 0)))

  (check-equal? (moves-grid-left '(( 0 8 8 0)
                                   (16 0 0 0)
                                   ( 2 2 4 4)
                                   ( 0 2 2 2)))
                '((8  (0 1) (0 0))
                  (8  (0 2) (0 0))
                  (16 (1 0) (1 0))
                  (2  (2 0) (2 0))
                  (2  (2 1) (2 0))
                  (4  (2 2) (2 1))
                  (4  (2 3) (2 1))
                  (2  (3 1) (3 0))
                  (2  (3 2) (3 0))
                  (2  (3 3) (3 1))))

  (check-equal? (moves-grid-right '(( 0 8 8 0)
                                    (16 0 0 0)
                                    ( 2 2 4 4)
                                    ( 0 2 2 2)))
                '((8  (0 2) (0 3))
                  (8  (0 1) (0 3))
                  (16 (1 0) (1 3))
                  (4  (2 3) (2 3))
                  (4  (2 2) (2 3))
                  (2  (2 1) (2 2))
                  (2  (2 0) (2 2))
                  (2  (3 3) (3 3))
                  (2  (3 2) (3 3))
                  (2  (3 1) (3 2))))

  (check-equal? (moves-grid-up '(( 0 8 8 0)
                                 (16 0 0 0)
                                 ( 2 2 4 4)
                                 ( 0 2 2 2)))
                '((16 (1 0) (0 0))
                  (2  (2 0) (1 0))
                  (8  (0 1) (0 1))
                  (2  (2 1) (1 1))
                  (2  (3 1) (1 1))
                  (8  (0 2) (0 2))
                  (4  (2 2) (1 2))
                  (2  (3 2) (2 2))
                  (4  (2 3) (0 3))
                  (2  (3 3) (1 3))))

  (check-equal? (moves-grid-down '(( 0 8 8 0)
                                   (16 0 0 0)
                                   ( 2 2 4 4)
                                   ( 0 2 2 2)))
                '((2  (2 0) (3 0))
                  (16 (1 0) (2 0))
                  (2  (3 1) (3 1))
                  (2  (2 1) (3 1))
                  (8  (0 1) (2 1))
                  (2  (3 2) (3 2))
                  (4  (2 2) (2 2))
                  (8  (0 2) (1 2))
                  (2  (3 3) (3 3))
                  (4  (2 3) (2 3))))

  (check-equal? (chop '(1 2 3 4 5 6 7 8) 4)
                '((1 2 3 4) (5 6 7 8)))

  (check-equal? (length (initial-state 5)) 25)

  (let* ([initial (initial-state)]
         [initial-sum (apply + initial)]
         [largest-3 (take (sort initial >) 3)])
    (check-equal? (length initial) 16)
    (check-true (or (= initial-sum 4)
                    (= initial-sum 6)
                    (= initial-sum 8)))
    (check-true (or (equal? largest-3  '(2 2 0))
                    (equal? largest-3  '(4 2 0))
                    (equal? largest-3  '(4 4 0)))))

  (check-equal? (count-zeros '(1 0 1 0 0 0 1)) 4)
  (check-equal? (count-zeros '(1 1)) 0)
  (check-equal? (replace-nth-zero '(0 0 0 1 2 0) 2 5)
                '(0 0 5 1 2 0))

  (check-true (finished? '(1 2 3 4) 2))
  (check-false (finished? '(2 2 3 4) 2)))

(start)


use Term::termios;

constant $saved   = Term::termios.new(fd => 1).getattr;
constant $termios = Term::termios.new(fd => 1).getattr;
# raw mode interferes with carriage returns, so
# set flags needed to emulate it manually
$termios.unset_iflags(<BRKINT ICRNL ISTRIP IXON>);
$termios.unset_lflags(< ECHO ICANON IEXTEN ISIG>);
$termios.setattr(:DRAIN);

# reset terminal to original setting on exit
END { $saved.setattr(:NOW) }

constant n    = 4; # board size
constant cell = 6; # cell width
constant ansi = True; # color!

my @board = ( ['' xx n] xx n );
my $save  = '';
my $score = 0;

constant $top = join '─' x cell, '┌', '┬' xx n-1, '┐';
constant $mid = join '─' x cell, '├', '┼' xx n-1, '┤';
constant $bot = join '─' x cell, '└', '┴' xx n-1, '┘';

my %dir = (
   "\e[A" => 'up',
   "\e[B" => 'down',
   "\e[C" => 'right',
   "\e[D" => 'left',
);

my @ANSI = <0 1;97 1;93 1;92 1;96 1;91 1;95 1;94 1;30;47 1;43
    1;42 1;46 1;41 1;45 1;44 1;33;43 1;33;42 1;33;41 1;33;44>;

sub row (@row) { '│' ~ (join '│', @row».&center) ~ '│' }

sub center ($s){
    my $c   = cell - $s.chars;
    my $pad = ' ' x ceiling($c/2);
    my $tile = sprintf "%{cell}s", "$s$pad";
    my $idx = $s ?? $s.log(2) !! 0;
    ansi ?? "\e[{@ANSI[$idx]}m$tile\e[0m" !! $tile;
}

sub draw-board {
    run('clear');
    print qq:to/END/;

	Press direction arrows to move.

	Press q to quit.

	$top
	{ join "\n\t$mid\n\t", map { .&row }, @board }
	$bot

	Score: $score

END
}

sub squash (@c) {
    my @t = grep { .chars }, @c;
    map { combine(@t[$_], @t[$_+1]) if @t[$_] && @t[$_+1] == @t[$_] }, ^@t-1;
    @t = grep { .chars }, @t;
    @t.push: '' while @t < n;
    @t;
}

sub combine ($v is rw, $w is rw) { $v += $w; $w = ''; $score += $v; }

proto sub move (|) {*};

multi move('up') {
    map { @board[*;$_] = squash @board[*;$_] }, ^n;
}

multi move('down') {
    map { @board[*;$_] = reverse squash reverse @board[*;$_] }, ^n;
}

multi move('left') {
    map { @board[$_] = squash @board[$_] }, ^n;
}

multi move('right') {
    map { @board[$_;*] = reverse squash reverse @board[$_] }, ^n;
}

sub another {
    my @empties;
    for @board.kv -> $r, @row {
        @empties.push(($r, $_)) for @row.grep(:k, '');
    }
    my ( $x, $y ) = @empties.roll;
    @board[$x; $y] = (flat 2 xx 9, 4).roll;
}

sub save () { join '|', flat @board».list }

loop {
    another if $save ne save();
    draw-board;
    $save = save();

    # Read up to 4 bytes from keyboard buffer.
    # Page navigation keys are 3-4 bytes each.
    # Specifically, arrow keys are 3.
    my $key = $*IN.read(4).decode;

    move %dir{$key} if so %dir{$key};
    last if $key eq 'q'; # (q)uit
}


Red [Needs: 'View]

random/seed now
board: random [2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0]

; ----------- move engine -----------
tasse: function [b] [
    forall b [while [b/1 = 0] [remove b]]
    head append/dup b 0 4 - length? b
]
somme: function [b] [
    tasse b
    repeat n 3 [
        m: n + 1
        if all [b/:n <> 0 b/:n = b/:m] [
            poke b n b/:n * 2
            poke b m 0
        ]
    ]
    tasse b
]
reshape: function [b d][
    res: copy []
    switch d [
        up    [repeat n 4 [extract/index/into b 4 n res] res]
        down  [repeat n 4 [extract/index/into b 4 n res] reverse res]
        left [res: copy b]
        right  [res: reverse copy b]
    ]
]
mov: function [b d][
    b1: reshape b d
    moved: copy []
    foreach [x y z t] b1 [append moved somme reduce [x y z t]]
    reshape moved d
]

; --------- GUI ---------
colors: [0 gray 2 snow 4 linen 8 brick 16 brown 32 sienna
    64 water 128 teal 256 olive 512 khaki 1024 tanned 2028 wheat]
tsize: 110x110
padsize: 4x4
padlen: 114
mainsize: tsize * 4 + (padsize * 5)
tfont: make font! [size: 30 color: black style: 'bold]

display: does [
    foreach face lay/pane [
        n: face/data
        face/text: either board/:n = 0 [""] [form board/:n]
        face/color: reduce select colors board/:n
    ]
]
lay: layout [
    size mainsize
    title "2048 game"
    backdrop white
    on-key [
        if find [up down left right] d: event/key [
            if board <> newboard: mov board d [
                board: newboard
                if find board 2048 [alert "You win!"]
                until [
                    pos: random 16
                    0 = board/:pos
                ]
                poke board pos either 1 = random 10 [4] [2]
                display
                conds: reduce [not find board 0]
                foreach d [up down left right] [
                    append conds board = mov board d
                ]
                if all conds [alert "You lose!"]
            ]
        ]
    ]
    space padsize
]
repeat n length? board [append lay/pane make face! [
    type: 'base
    offset: padsize + padlen * as-pair (n - 1 % 4) (n - 1 / 4)
    size: tsize
    color: reduce select colors board/:n
    data: n
    font: tfont
]]
display
view lay


/*REXX program lets a user play the  2048  game on an  NxN  grid  (default is 4x4 grid).*/
parse arg N win seed .                           /*obtain optional arguments from the CL*/
if   N=='' |   N==","  then    N=     4          /*Not specified?  Then use the default.*/
if win=='' | win==","  then  win= 2**11          /* "      "         "   "   "      "   */
if datatype(seed, 'W') then call random ,,seed   /*Specified?  Then use seed for RANDOM.*/
L= length(win) + 2                               /*L:  used for displaying the grid #'s.*/
eye=copies("─", 8);  pad=left('', length(eye)+2) /*eye catchers; and perusable perusing.*/
b= ' '                                           /*comfortable readable name for a blank*/
@cls= 'CLS'                                      /*hardcoded command to clear the screen*/
prompt= eye "Please enter a direction  (Up, Down, Right, Left)       ───or───    Quit:"
move= 1;     moves= 0;      score= 0;      ok= 1 /*simulation that a move was performed.*/
@.= b                                            /*define all grid elements to a blank. */
     do  until any(win);  if ok  then call put;   ok= 1;   say;    call showGrid
     say;  say prompt;   parse pull a x . 1 d 2 1 way xx   /*show prompt; obtain answer.*/
     if datatype(a, 'U')     then @cls           /*if uppercase, then clear the screen. */
     if a==''  then do;  ok= 0                   /*the user entered blank(s) or nothing.*/
                         say copies(eye, 5)   'moves:'   moves    eye     "score:"   score
                         iterate                 /* [↑]  display # of moves & the score.*/
                    end
     upper d a x                                 /*uppercase contents of three variables*/
     if x\==''               then call err  "too many arguments entered: "   xx
     if abbrev('QUIT',a,1)   then do;  say;  say eye  "quitting the game".;  exit 1;   end
     good=abbrev('UP',a,1) | abbrev("DOWN",a,1) | abbrev('RIGHT',a,1) | abbrev("LEFT",a,1)
     if \good                then call err  "invalid direction: "       way
     if \ok  then  iterate;       moves= moves + 1;                call mov
     end   /*until*/
say
say translate(eye  "Congrats!!  You've won the"  win  'game!' eye,"═",'─')  "score:" score
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
@:   procedure expose @.;  parse arg row,col;                return @.row.col
any: arg ?; do r=1  for N; do c=1  for N;  if @.r.c==?  then return 1; end; end;  return 0
err: say;   say eye  '***error*** '   arg(1);       say;                  ok=0;   return
o_c: $=;  do k=1  for N; $=$ word(@.k.c .,1); end;  !=space(translate($,,.))==''; return $
o_r: $=;  do k=1  for N; $=$ word(@.r.k .,1); end;  !=space(translate($,,.))==''; return $
put: if \any(b) then call err ,"game over, no more moves."; if move then call two; return
row: if r==0 | r>N  then return copies('═', L);                    return center(@.r.c, L)
ten: if random(9)==4  then return 4;   return 2  /*10% of the time,  use 4 instead of 2.*/
two:   do  until @.p.q==b;  p= random(1,N);  q= random(1,N);  end;   @.p.q= ten();  return
/*──────────────────────────────────────────────────────────────────────────────────────*/
showGrid:     do    r=0  for N+2;    _= '║';                 __= "╠"
                 do c=1  for N;      _= _  ||  row()'║';     __= __  ||  copies("═", L)'╬'
                 end   /*c*/
              if r==0  then _= '╔'translate( substr(_, 2, length(_) - 2),  "╦",  '║')"╗"
              if r >N  then _= '╚'translate( substr(_, 2, length(_) - 2),  "╩",  '║')"╝"
                                 say pad _
              if r<N & r>0  then say pad substr(__, 1, length(__) - 1)"╣"
              end      /*r*/;        return
/*──────────────────────────────────────────────────────────────────────────────────────*/
mov: move= 0;    if d=='R'  then call moveLR N, 1, -1    /*move (slide) numbers    ►    */
                 if d=='L'  then call moveLR 1, N, +1    /*  "     "       "       ◄    */
                 if d=='U'  then call moveUD 1, N, +1    /*  "     "       "       ↑    */
                 if d=='D'  then call moveUD N, 1, -1    /*  "     "       "       ↓    */
     if \move  then call err 'moving '    way    " doesn't change anything.";       return
/*──────────────────────────────────────────────────────────────────────────────────────*/
moveLR: parse arg start, sTo, #                                   /*slide   ◄   or   ►  */
          do   r=1  for N;    old= o_r();      if !  then iterate /*is this row blank?  */
            do N-1;           call packLR                         /*pack    ◄  or   ►   */
            end        /*N-1*/                                    /* [↓]  get new tiles.*/
          new= o_r();              move= move | (old\==new)       /*indicate tiles moved*/
              do c=start  for N-1  by #  while @.r.c\==b          /*slide   ◄  or   ►   */
              if @.r.c\[email protected](r,c+#)  then iterate                   /*not a duplicate ?   */
              @.r.c= @.r.c * 2;    score= score + @.r.c           /*double;  bump score */
              c= c + #        ;    @.r.c= b;         move= 1      /*bump C; blank dup 2.*/
              end      /*c*/                                      /* [↑]  indicate move.*/
          call packLR                                             /*pack    ◄  or    ►  */
          end          /*r*/;                        return
/*──────────────────────────────────────────────────────────────────────────────────────*/
moveUD: parse arg start, Sto, #                                   /*slide   ↑   or   ↓  */
          do   c=1  for N;    old= o_c();      if !  then iterate /*is this col blank?  */
            do N-1;           call packUD                         /*pack  up or down.   */
            end        /*N-1*/                                    /* [↓]  get new tiles.*/
          new= o_c();              move= move | (old\==new)       /*indicate tiles moved*/
              do r=start  for N-1  by #  while @.r.c\==b          /*slide   ↑   or   ↓  */
              if @.r.c\[email protected](r+#,c)  then iterate                   /*not a duplicate ?   */
              @.r.c= @.r.c * 2;    score= score + @.r.c           /*double;  bump score */
              r= r + #        ;    @.r.c= b;         move= 1      /*bump R; blank dup 2.*/
              end      /*r*/                                      /* [↑]  indicate move.*/
          call packUD                                             /*pack    ↑   or   ↓  */
          end          /*c*/;                        return
/*──────────────────────────────────────────────────────────────────────────────────────*/
packLR:   do c=start  for N-1  by #;   if @.r.c\==b  then iterate /*Not a blank?  Skip. */
             do s=c  to sTo  by #;     @.r.s= @(r, s + #)         /*slide   ◄   or   ►  */
             end   /*s*/;              @.r.sTo= b                 /*handle the last one.*/
          end      /*c*/;                            return
/*──────────────────────────────────────────────────────────────────────────────────────*/
packUD:   do r=start  for N-1  by #;   if @.r.c\==b  then iterate /*Not a blank?  Skip. */
             do s=r  to sTo  by #;     @.s.c= @(s + #, c)         /*slide   ↑   or   ↓  */
             end   /*s*/;              @.sTo.c= b                 /*handle the last one.*/
          end      /*r*/;                            return