unit Game;

interface

uses
  Classes, SysUtils, Dialogs, Generics.Collections, Graphics, Types, Forms, Math, DateUtils,
  Controls, RegistryEx, Tile, Board, History;

type
  TGame = class;
  TColorPalette = (cpOrangeYellow, cpGreenYellow, cpPinkBlue, cpBlueCyan,
    cpGreenCyan, cpPinkRed);

  { TArea }

  TArea = record
    P1, P2: TPoint;
    function Increment: TPoint;
    class function Create(P1, P2: TPoint): TArea; static; overload;
    class function Create(X1, Y1, X2, Y2: Integer): TArea; static; overload;
  end;

  TTileSkin = (tsLinear, tsPowerOfTwo, tsAlpha, tsRoman, tsBinary);

  { TGame }

  TGame = class
  private
    FMoves: Integer;
    FMoving: Boolean;
    FUnmergeableTilesCount: Integer;
    FOnChange: TNotifyEvent;
    FOnGameOver: TNotifyEvent;
    FOnPaint: TNotifyEvent;
    FOnWin: TNotifyEvent;
    FRecordHistory: Boolean;
    FRunning: Boolean;
    FScore: Integer;
    FCanUndo: Boolean;
    FBoardUndo: TBoard;
    FColorPalette: TColorPalette;
    FSkin: TTileSkin;
    FDisabledTilesCount: Integer;
    FUsedUndos: Integer;
    function GetTileColor(Value: Integer): TColor;
    procedure SetRecordHistory(AValue: Boolean);
    procedure SetScore(AValue: Integer);
    procedure DoChange;
    procedure DoPaint;
    procedure RenderTile(Canvas: TCanvas; Tile: TTile; TileRect: TRect; WithText: Boolean);
    procedure RenderControls(Canvas: TCanvas; Rect: TRect; Horizontal: Boolean);
    function RenderTextBox(Canvas: TCanvas; Pos: TPoint; Title, Value: string): TSize;
    procedure GameOver;
    procedure SetColorPalette(AValue: TColorPalette);
    procedure SetSkin(AValue: TTileSkin);
    procedure Win;
    function FillRandomTile: TTile;
    function FillUnmergeableRandomTile: TTile;
    function DisableRandomTile: TTile;
    function GetMoveArea(Direction: TMoveDirection): TArea;
    procedure MoveAllAnimate(Direction: TMoveDirection);
    function CanMergeTile(Value1, Value2: Integer): Boolean;
    function MergeTile(Value1, Value2: Integer): Integer;
    procedure AnimateTiles;
  public
    Board: TBoard;
    InitialBoard: TBoard;
    TopScore: Integer;
    AnimationDuration: Integer;
    AnimationTick: Integer;
    WinTileValue: Integer;
    UndoEnabled: Boolean;
    History: THistory;
    BackgroundColor: TColor;
    Value2Chance: Double;
    StartTime: TDateTime;
    procedure Replay(History: THistory; Step: Integer);
    function CanUndo: Boolean;
    procedure Undo;
    function CanMergeDirection(Direction: TMoveDirection): Boolean;
    function CanMoveDirection(Direction: TMoveDirection): Boolean;
    function CanMove: Boolean;
    procedure Assign(Source: TGame);
    procedure Reset;
    procedure New;
    procedure Restart;
    procedure Render(Canvas: TCanvas; CanvasSize: TPoint);
    procedure MoveAll(Direction: TMoveDirection; Animation: Boolean);
    procedure MoveAllAndUpdate(Direction: TMoveDirection; Animation: Boolean);
    procedure MoveTile(SourceTile, TargetTile: TTile);
    function IsValidPos(Pos: TPoint): Boolean;
    procedure SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
    procedure LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
    function GetTileSkinValue(Value: Integer): string;
    function GetTileSkinScore(Value: Integer): Integer;
    constructor Create;
    destructor Destroy; override;
    property Score: Integer read FScore write SetScore;
    property Moves: Integer read FMoves;
    property UsedUndos: Integer read FUsedUndos;
    property Running: Boolean read FRunning write FRunning;
    property Moving: Boolean read FMoving;
    property RecordHistory: Boolean read FRecordHistory write SetRecordHistory;
    property Skin: TTileSkin read FSkin write SetSkin;
    property ColorPalette: TColorPalette read FColorPalette write SetColorPalette;
    property DisabledTilesCount: Integer read FDisabledTilesCount write FDisabledTilesCount;
    property UnmergeableTilesCount: Integer read FUnmergeableTilesCount write FUnmergeableTilesCount;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
    property OnWin: TNotifyEvent read FOnWin write FOnWin;
    property OnGameOver: TNotifyEvent read FOnGameOver write FOnGameOver;
  end;

  TGames = class(TObjectList<TGame>)
  end;

var
  SkinText: array[TTileSkin] of string;
  ColorPaletteText: array[TColorPalette] of string;

const
  DirectionDiff: array[TMoveDirection] of TPoint = (
    (X: 0; Y: 0), (X: -1; Y: 0), (X: 0; Y: -1), (X: 1; Y: 0), (X: 0; Y: 1)
  );
  DirectionText: array[TMoveDirection] of string = ('None', 'Left', 'Up', 'Right', 'Down');
  InitialTileCount = 2;
  BoxFontSize = 10;

resourcestring
  SScore = 'Score';
  STopScore = 'Best';
  SSkinLinear = 'Linear';
  SSkinPowerOfTwo = 'Power of two';
  SSkinAlpha = 'Alpha';
  SSkinRoman = 'Roman';
  SSkinBinary = 'Binary';
  STileShouldBeEmpty = 'Tile should be empty';

  // Color palette
  SOrangeYellow = 'Orange - yellow';
  SGreenYellow = 'Green - yellow';
  SPinkBlue = 'Pink - blue';
  SBlueCyan = 'Blue - cyan';
  SGreenCyan = 'Green - cyan';
  SPinkRed = 'Pink - red';

procedure Translate;


implementation

uses
  Core, MetaCanvas, PixelPointer, Theme;

procedure Translate;
begin
  SkinText[tsLinear] := SSkinLinear;
  SkinText[tsPowerOfTwo] := SSkinPowerOfTwo;
  SkinText[tsAlpha] := SSkinAlpha;
  SkinText[tsRoman] := SSkinRoman;
  SkinText[tsBinary] := SSkinBinary;

  ColorPaletteText[cpOrangeYellow] := SOrangeYellow;
  ColorPaletteText[cpGreenYellow] := SGreenYellow;
  ColorPaletteText[cpPinkBlue] := SPinkBlue;
  ColorPaletteText[cpBlueCyan] := SBlueCyan;
  ColorPaletteText[cpGreenCyan] := SGreenCyan;
  ColorPaletteText[cpPinkRed] := SPinkRed;
end;

{ TArea }

function TArea.Increment: TPoint;
begin
  Result := Point(Sign(P2.X - P1.X), Sign(P2.Y - P1.Y));
  if Result.X = 0 then Result.X := 1;
  if Result.Y = 0 then Result.Y := 1;
end;

class function TArea.Create(P1, P2: TPoint): TArea;
begin
  Result.P1 := P1;
  Result.P2 := P2;
end;

class function TArea.Create(X1, Y1, X2, Y2: Integer): TArea;
begin
  Result.P1 := Point(X1, Y1);
  Result.P2 := Point(X2, Y2);
end;

{ TGame }

procedure TGame.DoChange;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TGame.DoPaint;
begin
  if Assigned(FOnPaint) then FOnPaint(Self);
end;

procedure TGame.GameOver;
begin
  if Running and Assigned(FOnGameOver) then FOnGameOver(Self);
  Running := False;
end;

procedure TGame.SetColorPalette(AValue: TColorPalette);
begin
  if FColorPalette = AValue then Exit;
  FColorPalette := AValue;
  DoPaint;
end;

procedure TGame.SetSkin(AValue: TTileSkin);
begin
  if FSkin = AValue then Exit;
  FSkin := AValue;
  DoPaint;
end;

procedure TGame.Win;
begin
  if Assigned(FOnWin) then FOnWin(Self);
end;

function TGame.FillRandomTile: TTile;
var
  EmptyTiles: TTiles;
  NewValue: Integer;
begin
  Result := nil;
  EmptyTiles := TTiles.Create(False);
  try
    Board.GetEmptyTiles(EmptyTiles);
    if EmptyTiles.Count > 0 then begin
      if Random < Value2Chance then NewValue := 2 else NewValue := 1;
      Result := EmptyTiles[Random(EmptyTiles.Count)];
      Result.Value := NewValue;
      Result.Action := taAppear;
    end;
  finally
    EmptyTiles.Free;
  end;
end;

function TGame.FillUnmergeableRandomTile: TTile;
var
  EmptyTiles: TTiles;
begin
  Result := nil;
  EmptyTiles := TTiles.Create(False);
  try
    Board.GetEmptyTiles(EmptyTiles);
    if EmptyTiles.Count > 0 then begin
      Result := EmptyTiles[Random(EmptyTiles.Count)];
      Result.Value := 1;
      Result.Action := taNone;
      Result.Unmergeable := True;
    end;
  finally
    EmptyTiles.Free;
  end;
end;

function TGame.DisableRandomTile: TTile;
var
  EmptyTiles: TTiles;
begin
  Result := nil;
  EmptyTiles := TTiles.Create(False);
  try
    Board.GetEmptyTiles(EmptyTiles);
    if EmptyTiles.Count > 0 then begin
      Result := EmptyTiles[Random(EmptyTiles.Count)];
      Result.Disabled := True;
    end;
  finally
    EmptyTiles.Free;
  end;
end;

function TGame.GetMoveArea(Direction: TMoveDirection): TArea;
begin
  case Direction of
    drNone: Result := TArea.Create(0, 0, 0, 0);
    drLeft: Result := TArea.Create(1, 0, Board.Size.X - 1, Board.Size.Y - 1);
    drUp: Result := TArea.Create(0, 1, Board.Size.X - 1, Board.Size.Y - 1);
    drRight: Result := TArea.Create(Board.Size.X - 2, 0, 0, Board.Size.Y - 1);
    drDown: Result := TArea.Create(0, Board.Size.Y - 2, Board.Size.X - 1, 0);
  end;
end;

function TGame.CanMove: Boolean;
begin
  Result := CanMoveDirection(drLeft) or CanMoveDirection(drRight) or
    CanMoveDirection(drUp) or CanMoveDirection(drDown);
end;

procedure TGame.Assign(Source: TGame);
begin
  Board.Assign(Source.Board);
  FBoardUndo.Assign(Source.FBoardUndo);
  FCanUndo := Source.FCanUndo;
  TopScore := Source.TopScore;
  AnimationDuration := Source.AnimationDuration;
  WinTileValue := Source.WinTileValue;
  UndoEnabled := Source.UndoEnabled;
  FScore := Source.FScore;
  FRunning := Source.FRunning;
  Skin := Source.Skin;
  ColorPalette := Source.ColorPalette;
  RecordHistory := Source.RecordHistory;
  DisabledTilesCount := Source.DisabledTilesCount;
  UnmergeableTilesCount := Source.UnmergeableTilesCount;
  //History.Assign(Source.History);
end;

procedure TGame.Reset;
const
  Difficulty = 0.7;
begin
  FUsedUndos := 0;
  FMoves := 0;
  FCanUndo := False;
  Board.Clear;
  WinTileValue := Round((Board.Size.X * Board.Size.Y) * Difficulty);
  Score := 0;
  Running := True;
  History.Clear;
end;

procedure TGame.New;
var
  I: Integer;
  Tile: TTile;
begin
  Reset;

  if RecordHistory then begin
    for I := 0 to DisabledTilesCount - 1 do begin
      SetLength(History.DisabledTiles, Length(History.DisabledTiles) + 1);
      History.DisabledTiles[Length(History.DisabledTiles) - 1] := DisableRandomTile.Index;
    end;
    for I := 0 to InitialTileCount - 1 do begin
      SetLength(History.InitialTiles, Length(History.InitialTiles) + 1);
      Tile := FillRandomTile;
      History.InitialTiles[Length(History.InitialTiles) - 1].Pos := Tile.Index;
      History.InitialTiles[Length(History.InitialTiles) - 1].Value := Tile.Value;
    end;
    for I := 0 to UnmergeableTilesCount - 1 do begin
      SetLength(History.InitialTiles, Length(History.InitialTiles) + 1);
      Tile := FillUnmergeableRandomTile;
      History.InitialTiles[Length(History.InitialTiles) - 1].Pos := Tile.Index;
      History.InitialTiles[Length(History.InitialTiles) - 1].Value := Tile.Value;
      History.InitialTiles[Length(History.InitialTiles) - 1].Unmergable := Tile.Unmergeable;
    end;
  end else begin
    for I := 0 to DisabledTilesCount - 1 do
      DisableRandomTile;
    for I := 0 to InitialTileCount - 1 do
      FillRandomTile;
    for I := 0 to UnmergeableTilesCount - 1 do
      FillUnmergeableRandomTile;
  end;
  InitialBoard.Assign(Board);
  StartTime := Now;
  AnimateTiles;
  DoChange;
  DoPaint;
end;

procedure TGame.Restart;
begin
  Reset;
  Board.Assign(InitialBoard);
  StartTime := Now;
  AnimateTiles;
  DoChange;
  DoPaint;
end;

procedure TGame.Render(Canvas: TCanvas; CanvasSize: TPoint);
var
  X, Y: Integer;
  TileSize: TPoint;
  Frame: TRect;
  TileRect: TRect;
  TopBarHeight: Integer;
  LeftBarWidth: Integer;
  TileMargin: Integer;
  TileCenter: TPoint;
  S: TPoint;
  MetaCanvas: TMetaCanvas;
  BorderSize: Integer;
  ControlsRect: TRect;
  BoardRect: TRect;
  Horizontal: Boolean;
  Tile: TTile;
begin
  // Form.Canvas.Width and Form.Canvas.Height is not working correctly under Windows.
  // So dimensions are provided by CanvasSize parameter.

  MetaCanvas := TMetaCanvas.Create;
  MetaCanvas.Size := Point(Canvas.Width, Canvas.Height);

  // Clear background
  MetaCanvas.Brush.Style := bsSolid;
  MetaCanvas.Brush.Color := Core.Core.ThemeManager1.ActualTheme.ColorControl;
  MetaCanvas.FillRect(0, 0, MetaCanvas.Width, MetaCanvas.Height);

  TopBarHeight := ScaleY(65, 96);
  LeftBarWidth := ScaleY(100, 96);
  if CanvasSize.X - LeftBarWidth < Canvas.Height then begin
    ControlsRect := Rect(0, 0, CanvasSize.X, TopBarHeight);
    BoardRect := Rect(0, TopBarHeight, CanvasSize.X, CanvasSize.Y);
    Horizontal := True;
  end else begin
    ControlsRect := Rect(0, 0, LeftBarWidth, CanvasSize.Y);
    BoardRect := Rect(LeftBarWidth, 0, CanvasSize.X, CanvasSize.Y);
    Horizontal := False;
  end;

  RenderControls(MetaCanvas, ControlsRect, Horizontal);

  BorderSize := ScaleY(2, 96);
  Frame := Rect(BoardRect.Left + BorderSize, BoardRect.Top + BorderSize,
    BoardRect.Right - BorderSize, BoardRect.Bottom - BorderSize);

  TileSize := Point(Frame.Width div Board.Size.X, Frame.Height div Board.Size.Y);
  if TileSize.X < TileSize.Y then TileSize.Y := TileSize.X;
  if TileSize.Y < TileSize.X then TileSize.X := TileSize.Y;
  Frame := Rect(Frame.Left + Frame.Width div 2 - (Board.Size.X * TileSize.X) div 2,
    Frame.Top + Frame.Height div 2 - (Board.Size.Y * TileSize.Y) div 2,
    Frame.Left + Frame.Width div 2 + (Board.Size.X * TileSize.X) div 2,
    Frame.Top + Frame.Height div 2 + (Board.Size.Y * TileSize.Y) div 2);

  TileMargin := Round(Frame.Width / Board.Size.X * 0.03);

  MetaCanvas.Brush.Style := bsSolid;
  MetaCanvas.Brush.Color := clGray;
  MetaCanvas.Pen.Style := psClear;
  MetaCanvas.RoundRect(Frame, ScaleX(Frame.Width div (20 * Board.Size.X), 96),
    ScaleY(Frame.Height div (20 * Board.Size.Y), 96));

  Frame := Rect(Frame.Left + TileMargin, Frame.Top + TileMargin,
    Frame.Right - TileMargin, Frame.Bottom - TileMargin);
  TileSize := Point(Frame.Width div Board.Size.X, Frame.Height div Board.Size.Y);

  MetaCanvas.Font.Color := clBlack;

  // Draw static tiles
  for Y := 0 to Board.Size.Y - 1 do
    for X := 0 to Board.Size.X - 1 do begin
      Tile := Board.Tiles[Y, X];
      if (Tile.Action <> taNone) then MetaCanvas.Brush.Color := GetTileColor(0)
        else MetaCanvas.Brush.Color := GetTileColor(Tile.Value);
      if Tile.Disabled then MetaCanvas.Brush.Style := bsClear
        else MetaCanvas.Brush.Style := bsSolid;
      TileRect := Bounds(
        Frame.Left + X * TileSize.X + TileMargin,
        Frame.Top + Y * TileSize.Y + TileMargin,
        TileSize.X - 2 * TileMargin, TileSize.Y - 2 * TileMargin);
      RenderTile(MetaCanvas, Tile, TileRect, Tile.Action = taNone);
    end;

  // Draw moving tiles
  for Y := 0 to Board.Size.Y - 1 do
    for X := 0 to Board.Size.X - 1 do begin
      Tile := Board.Tiles[Y, X];
      if Tile.Action = taMove then begin
        MetaCanvas.Brush.Color := GetTileColor(Tile.Value);
        MetaCanvas.Brush.Style := bsSolid;
        TileRect := Bounds(
          Frame.Left + X * TileSize.X + Trunc(Tile.Shift.X / 100 * TileSize.X + TileMargin),
          Frame.Top + Y * TileSize.Y + Trunc(Tile.Shift.Y / 100 * TileSize.Y + TileMargin),
          TileSize.X - 2 * TileMargin, TileSize.Y - 2 * TileMargin);
        RenderTile(MetaCanvas, Tile, TileRect, True);
      end;
    end;

  // Draw appearing tiles
  for Y := 0 to Board.Size.Y - 1 do
    for X := 0 to Board.Size.X - 1 do begin
      Tile := Board.Tiles[Y, X];
      if Tile.Action = taAppear then begin
        MetaCanvas.Brush.Color := GetTileColor(Tile.Value);
        MetaCanvas.Brush.Style := bsSolid;
        TileRect := Bounds(
          Frame.Left + X * TileSize.X + TileMargin,
          Frame.Top + Y * TileSize.Y + TileMargin,
          TileSize.X - 2 * TileMargin,
          TileSize.Y - 2 * TileMargin);
        TileCenter := TileRect.CenterPoint;
        S := Point(
          Trunc(Tile.Shift.X / 100 * (TileSize.X - TileMargin)),
          Trunc(Tile.Shift.Y / 100 * (TileSize.Y - TileMargin))
        );
        TileRect := Rect(TileCenter.X - S.X div 2, TileCenter.Y - S.Y div 2,
          TileCenter.X + S.X div 2, TileCenter.Y + S.Y div 2);
        RenderTile(MetaCanvas, Tile, TileRect, True);
      end;
    end;

  // Draw merging tiles
  for Y := 0 to Board.Size.Y - 1 do
    for X := 0 to Board.Size.X - 1 do begin
      Tile := Board.Tiles[Y, X];
      if Tile.Action = taMerge then begin
        MetaCanvas.Brush.Color := GetTileColor(Tile.Value);
        MetaCanvas.Brush.Style := bsSolid;
        TileRect := Bounds(
          Frame.Left + X * TileSize.X + TileMargin,
          Frame.Top + Y * TileSize.Y + TileMargin,
          TileSize.X - 2 * TileMargin,
          TileSize.Y - 2 * TileMargin);
        S := Point(
          Trunc((50 - Abs(Tile.Shift.X - 50)) / 50 * TileMargin),
          Trunc((50 - Abs(Tile.Shift.Y - 50)) / 50 * TileMargin)
        );
        TileRect := Rect(TileRect.Left - S.X, TileRect.Top - S.Y,
          TileRect.Right + S.X, TileRect.Bottom + S.Y);
        RenderTile(MetaCanvas, Tile, TileRect, True);
      end;
    end;

  MetaCanvas.DrawTo(Canvas);
  MetaCanvas.Free;
end;

procedure TGame.MoveAll(Direction: TMoveDirection; Animation: Boolean);
var
  P: TPoint;
  PNew: TPoint;
  I: Integer;
  Area: TArea;
  DstTile: TTile;
  SrcTile: TTile;
  TileMoved: Boolean;
begin
  Inc(FMoves);
  if Animation then begin
    MoveAllAnimate(Direction);
    Exit;
  end;
  if Direction = drNone then Exit;
  if not CanMoveDirection(Direction) then Exit;
  FMoving := True;
  FBoardUndo.Assign(Board);
  FCanUndo := True;
  Area := GetMoveArea(Direction);
  Board.ClearMerged;
  for I := 0 to Max(Board.Size.X, Board.Size.Y) - 1 do begin
    TileMoved := False;
    P := Area.P1;
    while P.Y <> Area.P2.Y + Area.Increment.Y do begin
      P.X := Area.P1.X;
      while P.X <> Area.P2.X + Area.Increment.X do begin
        PNew := P + DirectionDiff[Direction];
        if IsValidPos(PNew) and not Board.Tiles[PNew.Y, PNew.X].Disabled then begin
          SrcTile := Board.Tiles[P.Y, P.X];
          DstTile := Board.Tiles[PNew.Y, PNew.X];
          if SrcTile.Value <> 0 then begin
            if DstTile.Value = 0 then begin
              DstTile.Value := SrcTile.Value;
              DstTile.Merged := SrcTile.Merged;
              DstTile.Unmergeable := SrcTile.Unmergeable;
              SrcTile.Value := 0;
              SrcTile.Merged := False;
              SrcTile.Unmergeable := False;
              TileMoved := True;
            end else
            if (not SrcTile.Merged) and (not DstTile.Merged) and
            CanMergeTile(DstTile.Value, SrcTile.Value) and
            not SrcTile.Unmergeable and not DstTile.Unmergeable then begin
              DstTile.Value := MergeTile(DstTile.Value, SrcTile.Value);
              DstTile.Merged := True;
              SrcTile.Value := 0;
              SrcTile.Merged := False;
              Score := Score + GetTileSkinScore(SrcTile.Value);
              TileMoved := True;
            end;
          end;
        end;
        Inc(P.X, Area.Increment.X);
      end;
      Inc(P.Y, Area.Increment.Y);
    end;
    if not TileMoved then Break;
  end;
  DoPaint;
  FMoving := False;
end;

procedure TGame.RenderTile(Canvas: TCanvas; Tile: TTile; TileRect: TRect; WithText: Boolean);
var
  ValueStr: string;
  TextSize: TSize;
  CrossBorder: Integer;
  FontHeightMultiplicator: Double;
begin
  // TODO: Why the fonts set with Height have different size across platforms?
  {$IFDEF UNIX}
  FontHeightMultiplicator := 72 / 96;
  {$ELSE}
  FontHeightMultiplicator := 1;
  {$ENDIF}

  if Canvas.Brush.Style = bsClear then Exit;

  Canvas.Pen.Style := psClear;
  Canvas.RoundRect(TileRect, ScaleX(TileRect.Width div 20, 96), ScaleY(TileRect.Height div 20, 96));

{  if Tile.Unmergeable then begin
    CrossBorder := ScaleX(Trunc(TileRect.Width / 50), 96);
    Canvas.Pen.Width := ScaleX(Trunc(TileRect.Width / 30), 96);
    Canvas.Pen.Style := psSolid;
    Canvas.Pen.Color := Canvas.Font.Color;
    Canvas.Line(TileRect.Left + CrossBorder, TileRect.Top + CrossBorder,
      TileRect.Right - CrossBorder, TileRect.Bottom - CrossBorder);
    Canvas.Line(TileRect.Right - CrossBorder, TileRect.Top + CrossBorder,
      TileRect.Left + CrossBorder, TileRect.Bottom - CrossBorder);
  end;
  }

  if WithText and (Tile.Value <> 0) then begin
    if Tile.Disabled then ValueStr := '@'
      else if Tile.Unmergeable then ValueStr := ''
      else ValueStr := GetTileSkinValue(Tile.Value);
    Canvas.Brush.Style := bsClear;
    Canvas.Font.Height := Trunc(TileRect.Height * FontHeightMultiplicator);
    TextSize := Canvas.TextExtent(ValueStr);
    if TextSize.Width > TileRect.Width then
      Canvas.Font.Height := Trunc(Canvas.Font.Height / TextSize.Width * TileRect.Width);
    TextSize := Canvas.TextExtent(ValueStr);
    Canvas.TextOut(TileRect.Left + TileRect.Width div 2 - TextSize.Width div 2,
      TileRect.Top + TileRect.Height div 2 - TextSize.Height div 2, ValueStr);
  end;
end;

procedure TGame.RenderControls(Canvas: TCanvas; Rect: TRect; Horizontal: Boolean);
var
  Pos: TPoint;
  Size: TSize;
begin
  if Horizontal then Pos := Point(ScaleY(16, 96), ScaleY(4, 96))
    else Pos := Point(ScaleY(4, 96), ScaleY(16, 96));

  Size := RenderTextBox(Canvas, Pos, SScore, IntToStr(Score));

  if Horizontal then Pos := Point(ScaleY(16 + 16, 96) + Size.Width, ScaleY(4, 96))
    else Pos := Point(ScaleY(4, 96), ScaleY(16 + 16, 96) + Size.Height);

  Size := RenderTextBox(Canvas, Pos, STopScore, IntToStr(TopScore));
end;

function TGame.RenderTextBox(Canvas: TCanvas; Pos: TPoint; Title, Value: string
  ): TSize;
var
  BoxSize: TSize;
begin
  with Canvas do begin
    Font.Color := Core.Core.ThemeManager1.ActualTheme.ColorControlText;
    Font.Size := Trunc(ScaleX(BoxFontSize, 96));

    BoxSize := Size(TextWidth(Title), TextHeight(Title) + TextHeight(Value));
    if BoxSize.Width < TextWidth(Value) then BoxSize.Width := TextWidth(Value);
    BoxSize := Size(Round(BoxSize.Width * 1.2), Round(BoxSize.Height * 1));

    Brush.Style := bsSolid;
    Brush.Color := Core.Core.ThemeManager1.ActualTheme.ColorWindow;
    FillRect(Pos.X, Pos.Y, Pos.X + BoxSize.Width, Pos.Y + BoxSize.Height);

    Brush.Style := bsClear;
    TextOut(Pos.X + (BoxSize.Width - TextWidth(Title)) div 2, Pos.Y, Title);

    Brush.Style := bsClear;
    Font.Color := Core.Core.ThemeManager1.ActualTheme.ColorControlText;
    Font.Size := Trunc(ScaleX(BoxFontSize, 96));
    TextOut(Pos.X + (BoxSize.Width - TextWidth(Value)) div 2,
      Pos.Y + TextHeight(Title), Value);
  end;

  Result := BoxSize;
end;

function TGame.CanUndo: Boolean;
begin
  Result := UndoEnabled and FCanUndo;
end;

procedure TGame.Undo;
begin
  if UndoEnabled and CanUndo then begin
    Board.Assign(FBoardUndo);
    FCanUndo := False;
    Inc(FUsedUndos);
    FRunning := CanMove;
    if RecordHistory then History.Moves.Delete(History.Moves.Count - 1);
    DoChange;
    DoPaint;
  end;
end;

function TGame.CanMergeDirection(Direction: TMoveDirection): Boolean;
var
  P: TPoint;
  PNew: TPoint;
  I: Integer;
  Area: TArea;
begin
  Result := False;
  if Direction = drNone then Exit;
  Area := GetMoveArea(Direction);
  for I := 0 to Max(Board.Size.X, Board.Size.Y) - 1 do begin
    P := Area.P1;
    while P.Y <> Area.P2.Y + Area.Increment.Y do begin
      P.X := Area.P1.X;
      while P.X <> Area.P2.X + Area.Increment.X do begin
        PNew := P + DirectionDiff[Direction];
        if IsValidPos(PNew) then begin
          if (Board.Tiles[PNew.Y, PNew.X].Value = 0) then begin
            Board.Tiles[PNew.Y, PNew.X].Value := Board.Tiles[P.Y, P.X].Value;
            Board.Tiles[P.Y, P.X].Value := 0;
          end else
          if (Board.Tiles[P.Y, P.X].Value <> 0) then begin
            if CanMergeTile(Board.Tiles[PNew.Y, PNew.X].Value, Board.Tiles[P.Y, P.X].Value) then begin
              Result := True;
              Break;
            end;
          end;
        end;
        Inc(P.X, Area.Increment.Y);
      end;
      if Result then Break;
      Inc(P.Y, Area.Increment.Y);
    end;
  end;
end;

function TGame.CanMoveDirection(Direction: TMoveDirection): Boolean;
var
  P: TPoint;
  PNew: TPoint;
  Area: TArea;
begin
  Result := False;
  if Direction = drNone then Exit;
  Area := GetMoveArea(Direction);
  P := Area.P1;
  while P.Y <> Area.P2.Y + Area.Increment.Y do begin
    P.X := Area.P1.X;
    while P.X <> Area.P2.X + Area.Increment.X do begin
      PNew := P + DirectionDiff[Direction];
      if IsValidPos(PNew) then begin
        if (Board.Tiles[P.Y, P.X].Value <> 0) then begin
          if ((Board.Tiles[PNew.Y, PNew.X].Value = 0) or
          CanMergeTile(Board.Tiles[PNew.Y, PNew.X].Value, Board.Tiles[P.Y, P.X].Value)) and
          not Board.Tiles[PNew.Y, PNew.X].Disabled then begin
            Result := True;
            Break;
          end;
        end;
      end;
      Inc(P.X, Area.Increment.X);
    end;
    if Result then Break;
    Inc(P.Y, Area.Increment.Y);
  end;
end;

procedure TGame.MoveAllAnimate(Direction: TMoveDirection);
var
  P: TPoint;
  PNew: TPoint;
  X, Y: Integer;
  I: Integer;
  StartTime: TDateTime;
  EndTime: TDateTime;
  Time: TDateTime;
  Part: Double;
  Area: TArea;
  TileMoved: Boolean;
  SrcTile: TTile;
  DstTile: TTile;
  Tile: TTile;
begin
  if Direction = drNone then Exit;
  if not CanMoveDirection(Direction) then Exit;
  FMoving := True;
  FBoardUndo.Assign(Board);
  FCanUndo := True;
  Area := GetMoveArea(Direction);
  Board.ClearMerged;
  for I := 0 to Max(Board.Size.X, Board.Size.Y) - 1 do begin
    // Init new values
    for Y := 0 to Board.Size.Y - 1 do
      for X := 0 to Board.Size.X - 1 do begin
        Tile := Board.Tiles[Y, X];
        Tile.NewValue := Tile.Value;
        Tile.NewUnmergeable := Tile.Unmergeable;
        Tile.Action := taNone;
      end;

    TileMoved := False;
    P := Area.P1;
    while P.Y <> Area.P2.Y + Area.Increment.Y do begin
      P.X := Area.P1.X;
      while P.X <> Area.P2.X + Area.Increment.X do begin
        PNew := P + DirectionDiff[Direction];
        if IsValidPos(PNew) and not Board.Tiles[PNew.Y, PNew.X].Disabled then begin
          SrcTile := Board.Tiles[P.Y, P.X];
          DstTile := Board.Tiles[PNew.Y, PNew.X];
          if (SrcTile.NewValue <> 0) then begin
            if (DstTile.NewValue = 0) then begin
              SrcTile.Action := taMove;
              DstTile.NewValue := SrcTile.NewValue;
              DstTile.Merged := SrcTile.Merged;
              DstTile.NewUnmergeable := SrcTile.NewUnmergeable;
              SrcTile.NewValue := 0;
              SrcTile.Merged := False;
              SrcTile.NewUnmergeable := False;
              TileMoved := True;
            end else
            if (not SrcTile.Merged) and (not DstTile.Merged) and
            CanMergeTile(DstTile.NewValue, SrcTile.NewValue) and
            not SrcTile.NewUnmergeable and not DstTile.NewUnmergeable then begin
              SrcTile.Action := taMove;
              DstTile.NewValue := MergeTile(DstTile.NewValue, SrcTile.NewValue);
              DstTile.Merged := True;
              SrcTile.NewValue := 0;
              SrcTile.Merged := False;
              Score := Score + GetTileSkinScore(DstTile.NewValue);
              TileMoved := True;
            end;
          end;
        end;
        Inc(P.X, Area.Increment.X);
      end;
      Inc(P.Y, Area.Increment.Y);
    end;
    if not TileMoved then Break;

    // Animate tiles move
    StartTime := Now;
    EndTime := StartTime + AnimationDuration / 300 * OneSecond / Max(Board.Size.X, Board.Size.Y);
    if AnimationDuration > 0 then
    repeat
      Time := Now;
      Part := (Time - StartTime) / (EndTime - StartTime);
      if Part > 1 then Part := 1;
      for Y := 0 to Board.Size.Y - 1 do
        for X := 0 to Board.Size.X - 1 do begin
          if Board.Tiles[Y, X].Action = taMove then
            Board.Tiles[Y, X].Shift := Point(Trunc(Part * DirectionDiff[Direction].X * 100),
              Trunc(Part * DirectionDiff[Direction].Y * 100));
        end;
      DoPaint;
      //Application.ProcessMessages;
      Sleep(AnimationTick);
    until Time > EndTime;

    // Set final tiles values
    for Y := 0 to Board.Size.Y - 1 do
      for X := 0 to Board.Size.X - 1 do begin
        Tile := Board.Tiles[Y, X];
        Tile.Value := Tile.NewValue;
        Tile.Unmergeable := Tile.NewUnmergeable;
      end;
  end;

  // Set final tiles values
  for Y := 0 to Board.Size.Y - 1 do
    for X := 0 to Board.Size.X - 1 do begin
      Tile := Board.Tiles[Y, X];
      if Tile.Merged then
        Tile.Action := taMerge;
      Tile.Shift := Point(0, 0);
      if Tile.Action = taMove then begin
        Tile.Action := taNone;
      end;
      Tile.Value := Tile.NewValue;
    end;
  DoPaint;
  FMoving := False;
end;

function TGame.CanMergeTile(Value1, Value2: Integer): Boolean;
begin
  Result := MergeTile(Value1, Value2) <> -1;
end;

function TGame.MergeTile(Value1, Value2: Integer): Integer;
begin
  if Value1 = Value2 then Result := Value1 + 1
  else Result := -1;
end;

procedure TGame.AnimateTiles;
var
  StartTime: TDateTime;
  EndTime: TDateTime;
  Time: TDateTime;
  Part: Double;
  X, Y: Integer;
begin
  FMoving := True;

  // Animate tiles move
  StartTime := Now;
  EndTime := StartTime + AnimationDuration / 300 * OneSecond / Max(Board.Size.X, Board.Size.Y);
  if AnimationDuration > 0 then
  repeat
    Time := Now;
    Part := (Time - StartTime) / (EndTime - StartTime);
    if Part > 1 then Part := 1;
    for Y := 0 to Board.Size.Y - 1 do
      for X := 0 to Board.Size.X - 1 do begin
        if Board.Tiles[Y, X].Action = taAppear then
          Board.Tiles[Y, X].Shift := Point(Trunc(Part * 100), Trunc(Part * 100));
        if Board.Tiles[Y, X].Action = taMerge then
          Board.Tiles[Y, X].Shift := Point(Trunc(Part * 100), Trunc(Part * 100));
      end;
    DoPaint;
    //Application.ProcessMessages;
    Sleep(AnimationTick);
  until Time > EndTime;

  for Y := 0 to Board.Size.Y - 1 do
    for X := 0 to Board.Size.X - 1 do
      if Board.Tiles[Y, X].Action <> taNone then begin
        Board.Tiles[Y, X].Action := taNone;
        Board.Tiles[Y, X].Shift := Point(0, 0);
      end;
  DoPaint;
  FMoving := False;
end;

procedure TGame.Replay(History: THistory; Step: Integer);
var
  I: Integer;
begin
  Board.Clear;
  Score := 0;
  for I := 0 to Length(History.InitialTiles) - 1 do begin
    Board.Tiles[History.InitialTiles[I].Pos.Y, History.InitialTiles[I].Pos.X].Value := History.InitialTiles[I].Value;
    Board.Tiles[History.InitialTiles[I].Pos.Y, History.InitialTiles[I].Pos.X].Unmergeable := History.InitialTiles[I].Unmergable;
  end;
  for I := 0 to Length(History.DisabledTiles) - 1 do begin
    Board.Tiles[History.DisabledTiles[I].Y, History.DisabledTiles[I].X].Disabled := True;
  end;
  for I := 0 to Step - 1 do
    with History.Moves[I] do begin
      MoveAll(Direction, False);
      if Board.Tiles[NewItemPos.Y, NewItemPos.X].Value = 0 then
        Board.Tiles[NewItemPos.Y, NewItemPos.X].Value := NewItemValue
        else raise Exception.Create(STileShouldBeEmpty);
    end;
end;

function IntToStrRoman(Num: Integer): string;
const
  Nvals = 13;
  Vals: array [1..Nvals] of Word =
    (1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000);
  Roms: array [1..Nvals] of string[2] =
    ('I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M');
var
  B: 1..Nvals;
begin
  Result := '';
  B := Nvals;
  while Num > 0 do
  begin
    while Vals[b] > Num do
      Dec(B);
    Dec(Num, Vals[B]);
    Result := Result + Roms[B];
  end;
end;

function IntToBin(Num: Integer): string;
begin
  Result := '';
  while Num > 0 do begin
    Result := IntToStr(Num mod 2) + Result;
    Num := Num shr 1;
  end;
end;

function TGame.GetTileSkinValue(Value: Integer): string;
begin
  case FSkin of
    tsLinear: Result := IntToStr(Value);
    tsPowerOfTwo: Result := IntToStr(1 shl Value);
    tsAlpha: Result := Chr(Ord('A') + Value - 1);
    tsRoman: Result := IntToStrRoman(Value);
    tsBinary: Result := IntToBin(Value);
    else Result := IntToStr(Value);
  end;
end;

function TGame.GetTileSkinScore(Value: Integer): Integer;
begin
  case FSkin of
    tsLinear: Result := 1 shl Value;
    tsPowerOfTwo: Result := 1 shl Value;
    tsAlpha: Result := 1 shl Value;
    tsRoman: Result := 1 shl Value;
    tsBinary: Result := 1 shl Value;
    else Result := 1 shl Value;
  end;
end;

procedure TGame.MoveAllAndUpdate(Direction: TMoveDirection; Animation: Boolean);
var
  HighestValue: Integer;
  HistoryMove: THistoryMove;
  NewTile: TTile;
  X, Y: Integer;
begin
  if CanMoveDirection(Direction) then begin
    HighestValue := Board.GetHighestTileValue;
    MoveAll(Direction, Animation);

    NewTile := FillRandomTile;
    if Animation then AnimateTiles else begin
      for Y := 0 to Board.Size.Y - 1 do
        for X := 0 to Board.Size.X - 1 do
          if Board.Tiles[Y, X].Action <> taNone then begin
            Board.Tiles[Y, X].Action := taNone;
            Board.Tiles[Y, X].Shift := Point(0, 0);
          end;
      DoPaint;
    end;

    if RecordHistory and Assigned(NewTile) then begin
      HistoryMove := THistoryMove.Create;
      HistoryMove.Direction := Direction;
      HistoryMove.NewItemPos := NewTile.Index;
      HistoryMove.NewItemValue := NewTile.Value;
      History.Moves.Add(HistoryMove);
    end;

    if not CanMove and (Board.GetEmptyTilesCount = 0) then
      GameOver;
    if (HighestValue < WinTileValue) and
    (Board.GetHighestTileValue >= WinTileValue) then Win;
    DoChange;
  end;
end;

procedure TGame.MoveTile(SourceTile, TargetTile: TTile);
begin
  TargetTile.Value := SourceTile.Value;
  SourceTile.Value := 0;
  TargetTile.Merged := SourceTile.Merged;
  SourceTile.Merged := False;
end;

function TGame.IsValidPos(Pos: TPoint): Boolean;
begin
  Result := (Pos.X >= 0) and (Pos.X < Board.Size.X) and
    (Pos.Y >= 0) and (Pos.Y < Board.Size.Y);
end;

procedure TGame.SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
begin
  with Reg do begin
    CurrentContext := RegContext;

    WriteInteger('TopScore', TopScore);
    WriteInteger('AnimationDuration', AnimationDuration);
    WriteInteger('Score', Score);
    WriteBool('GameRunning', FRunning);
    WriteBool('CanUndo', FCanUndo);
    WriteBool('UndoEnabled', UndoEnabled);
    WriteBool('RecordHistory', RecordHistory);
    WriteInteger('Skin', Integer(Skin));
    WriteInteger('ColorPalette', Integer(ColorPalette));
    WriteInteger('DisabledTilesCount', DisabledTilesCount);
    WriteInteger('UnmergeableTilesCount', UnmergeableTilesCount);
    WriteInteger('Moves', FMoves);
    WriteInteger('UsedUndos', FUsedUndos);
    WriteDateTime('StartTime', StartTime);
    FBoardUndo.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo'));
    Board.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board'));
    InitialBoard.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\InitialBoard'));
    History.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\History'));
  end;
end;

procedure TGame.LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext
  );
begin
  with Reg do begin
    CurrentContext := RegContext;
    AnimationDuration := ReadIntegerWithDefault('AnimationDuration', 30);
    TopScore := ReadIntegerWithDefault('TopScore', 0);
    Score := ReadIntegerWithDefault('Score', 0);
    FRunning := ReadBoolWithDefault('GameRunning', False);
    FCanUndo := ReadBoolWithDefault('CanUndo', False);
    UndoEnabled := ReadBoolWithDefault('UndoEnabled', True);
    RecordHistory := ReadBoolWithDefault('RecordHistory', False);
    Skin := TTileSkin(ReadIntegerWithDefault('Skin', Integer(tsPowerOfTwo)));
    ColorPalette := TColorPalette(ReadIntegerWithDefault('ColorPalette', Integer(cpOrangeYellow)));
    DisabledTilesCount := ReadIntegerWithDefault('DisabledTilesCount', DisabledTilesCount);
    UnmergeableTilesCount := ReadIntegerWithDefault('UnmergeableTilesCount', UnmergeableTilesCount);
    FMoves := ReadIntegerWithDefault('Moves', FMoves);
    FUsedUndos := ReadIntegerWithDefault('UsedUndos', FUsedUndos);
    StartTime := ReadDateTimeWithDefault('StartTime', StartTime);
    FBoardUndo.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo'));
    Board.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board'));
    InitialBoard.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\InitialBoard'));
    History.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\History'));
  end;
  DoChange;
  DoPaint;
end;

constructor TGame.Create;
begin
  AnimationDuration := 30;
  AnimationTick := 10; // ms
  WinTileValue := 11; // 2^11 = 2048
  Board := TBoard.Create;
  InitialBoard := TBoard.Create;
  FBoardUndo := TBoard.Create;
  History := THistory.Create;
  Value2Chance := 0.1;
end;

destructor TGame.Destroy;
begin
  FreeAndNil(History);
  FreeAndNil(FBoardUndo);
  FreeAndNil(Board);
  FreeAndNil(InitialBoard);
  inherited;
end;

function TGame.GetTileColor(Value: Integer): TColor;
var
  Color: TPixel32;
begin
  if (Core.Core.ThemeManager1.ActualTheme.Name = ThemeNameDark) or
  ((Core.Core.ThemeManager1.ActualTheme.Name = ThemeNameSystem) and
  Core.Core.ThemeManager1.IsDarkTheme)
  then begin
    case Value of
      0: Result := $222629;
      1: Result := $dae4ee;
      2: Result := $c8e0ed;
      3: Result := $79b1f2;
      4: Result := $6395f5;
      5: Result := $5f7cf6;
      6: Result := $3b5ef6;
      7: Result := $72cfed;
      8: Result := $61cced;
      9: Result := $50c8ed;
      10: Result := $3fc5ed;
      11: Result := $2ec2ed;
      else Result := $323a3c;
    end;
  end else begin
    case Value of
      0: Result := $f2f6f9;
      1: Result := $dae4ee;
      2: Result := $c8e0ed;
      3: Result := $79b1f2;
      4: Result := $6395f5;
      5: Result := $5f7cf6;
      6: Result := $3b5ef6;
      7: Result := $72cfed;
      8: Result := $61cced;
      9: Result := $50c8ed;
      10: Result := $3fc5ed;
      11: Result := $2ec2ed;
      else Result := $323a3c;
    end;
  end;

  Color.RGB := Result;
  case ColorPalette of
    cpOrangeYellow: Result := TColor(TPixel32.CreateRGB(Color.R, Color.G, Color.B));
    cpGreenYellow: Result := TColor(TPixel32.CreateRGB(Color.R, Color.B, Color.G));
    cpPinkBlue: Result := TColor(TPixel32.CreateRGB(Color.B, Color.R, Color.G));
    cpBlueCyan: Result := TColor(TPixel32.CreateRGB(Color.B, Color.G, Color.R));
    cpGreenCyan: Result := TColor(TPixel32.CreateRGB(Color.G, Color.B, Color.R));
    cpPinkRed: Result := TColor(TPixel32.CreateRGB(Color.G, Color.R, Color.B));
  end;
end;

procedure TGame.SetRecordHistory(AValue: Boolean);
begin
  if FRecordHistory = AValue then Exit;
  FRecordHistory := AValue;
  if not FRecordHistory then History.Clear;
end;

procedure TGame.SetScore(AValue: Integer);
begin
  if FScore = AValue then Exit;
  FScore := AValue;
  if FScore > TopScore then TopScore := FScore;
end;

initialization
  Translate;

end.