source: tags/1.1.0/UGame.pas

unit UGame;

{$mode delphi}{$H+}

interface

uses
  Classes, SysUtils, Dialogs, fgl, Graphics, Types, Forms, Math, DateUtils,
  Controls, URegistry;

type
  TGame = class;
  TMoveDirection = (drNone, drLeft, drUp, drRight, drDown);

  { TTile }

  TTile = class
    Index: TPoint;
    Value: Integer;
    NewValue: Integer;
    Merged: Boolean;
    Moving: Boolean;
    Shift: TPoint;
    procedure Assign(Source: TTile);
  end;

  TTiles = class(TFPGObjectList<TTile>)
  end;

  { TArea }

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

  { THistoryMove }

  THistoryMove = class
    Direction: TMoveDirection;
    NewItemPos: TPoint;
    NewItemValue: Integer;
    procedure SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
    procedure LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
  end;

  { THistoryMoves }

  THistoryMoves = class(TFPGObjectList<THistoryMove>)
    procedure SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
    procedure LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
  end;

  { THistory }

  THistory = class
    Game: TGame;
    Moves: THistoryMoves;
    InitialTilesPos: array of TPoint;
    procedure GetStep(GameStep: TGame; Step: Integer);
    procedure Clear;
    constructor Create;
    destructor Destroy; override;
    procedure SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
    procedure LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
  end;

  { TBoard }

  TBoard = class
  private
    FSize: TPoint;
    procedure SetSize(AValue: TPoint);
  public
    Tiles: array of array of TTile;
    procedure Assign(Source: TBoard);
    procedure Clear;
    procedure ClearMerged;
    function GetValueSum: Integer;
    function GetHighestTileValue: Integer;
    function GetEmptyTilesCount: Integer;
    procedure GetEmptyTiles(EmptyTiles: TTiles);
    procedure SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
    procedure LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
    destructor Destroy; override;
    property Size: TPoint read FSize write SetSize;
  end;

  { TGame }

  TGame = class
  private
    FMoving: Boolean;
    FOnChange: TNotifyEvent;
    FOnGameOver: TNotifyEvent;
    FOnWin: TNotifyEvent;
    FRecordHistory: Boolean;
    FRunning: Boolean;
    FScore: Integer;
    FCanUndo: Boolean;
    FBoardUndo: TBoard;
    function GetTileColor(Value: Integer): TColor;
    procedure SetRecordHistory(AValue: Boolean);
    procedure SetScore(AValue: Integer);
    procedure DoChange;
    procedure RenderTile(Canvas: TCanvas; Tile: TTile; TileRect: TRect; WithText: Boolean);
    procedure GameOver;
    procedure Win;
    function FillRandomTile(Value4Change: Double = 0.1): TTile;
    function GetMoveArea(Direction: TMoveDirection): TArea;
    procedure MoveAllAnimate(Direction: TMoveDirection);
  public
    Board: TBoard;
    TopScore: Integer;
    AnimationDuration: Integer;
    WinScore: Integer;
    UndoEnabled: Boolean;
    History: THistory;
    function CanUndo: Boolean;
    procedure Undo;
    function CanMergeDirection(Direction: TMoveDirection): Boolean;
    function CanMoveDirection(Direction: TMoveDirection): Boolean;
    function CanMove: Boolean;
    procedure Assign(Source: TGame);
    procedure New;
    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(RegContext: TRegistryContext);
    procedure LoadFromRegistry(RegContext: TRegistryContext);
    constructor Create;
    destructor Destroy; override;
    property Score: Integer read FScore write SetScore;
    property Running: Boolean read FRunning write FRunning;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnWin: TNotifyEvent read FOnWin write FOnWin;
    property OnGameOver: TNotifyEvent read FOnGameOver write FOnGameOver;
    property Moving: Boolean read FMoving;
    property RecordHistory: Boolean read FRecordHistory write SetRecordHistory;
  end;

  TGames = class(TFPGObjectList<TGame>)
  end;

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;

resourcestring
  SScore = 'Score';
  STopScore = 'Top score';

implementation

{ THistoryMoves }

procedure THistoryMoves.SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
var
  I: Integer;
begin
  with Reg do begin
    CurrentContext := RegContext;
    WriteInteger('Count', Count);
    for I := 0 to Count - 1 do begin
      Items[I].SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '/' + IntToStr(I)));
    end;
  end;
end;

procedure THistoryMoves.LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
var
  I: Integer;
begin
  with Reg do begin
    CurrentContext := RegContext;
    Count := ReadIntegerWithDefault('Count', 0);
    for I := 0 to Count - 1 do begin
      Items[I] := THistoryMove.Create;
      THistoryMove(Items[I]).LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '/' + IntToStr(I)));
    end;
  end;
end;

{ THistoryMove }

procedure THistoryMove.SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
begin
  with Reg do begin
    CurrentContext := RegContext;
    WriteInteger('Direction', Integer(Direction));
    WriteInteger('NewItemPosX', NewItemPos.X);
    WriteInteger('NewItemPosY', NewItemPos.Y);
    WriteInteger('NewItemValue', NewItemValue);
  end;
end;

procedure THistoryMove.LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
begin
  with Reg do begin
    CurrentContext := RegContext;
    Direction := TMoveDirection(ReadIntegerWithDefault('Direction', Integer(drNone)));
    NewItemPos := Point(ReadIntegerWithDefault('NewItemPosX', 0),
      ReadIntegerWithDefault('NewItemPosY', 0));
    NewItemValue := ReadIntegerWithDefault('NewItemValue', 0);
  end;
end;

{ THistory }

procedure THistory.GetStep(GameStep: TGame; Step: Integer);
var
  I: Integer;
begin
  GameStep.Board.Size := Game.Board.Size;
  GameStep.Board.Clear;
  GameStep.Score := 0;
  for I := 0 to Length(InitialTilesPos) - 1 do
    GameStep.Board.Tiles[InitialTilesPos[I].Y, InitialTilesPos[I].X].Value := 2;
  for I := 0 to Step - 1 do
  with Moves[I] do begin
    GameStep.MoveAll(Direction, False);
    if GameStep.Board.Tiles[NewItemPos.Y, NewItemPos.X].Value = 0 then
      GameStep.Board.Tiles[NewItemPos.Y, NewItemPos.X].Value := NewItemValue
      else raise Exception.Create('Tile should be empty');
  end;
end;

procedure THistory.Clear;
begin
  Moves.Clear;
  SetLength(InitialTilesPos, 0);
end;

constructor THistory.Create;
begin
  Moves := THistoryMoves.Create;
end;

destructor THistory.Destroy;
begin
  FreeAndNil(Moves);
  inherited Destroy;
end;

procedure THistory.SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
var
  I: Integer;
begin
  with Reg do begin
    CurrentContext := TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\InitialTilesPos');
    WriteInteger('Count', Length(InitialTilesPos));
    for I := 0 to Length(InitialTilesPos) - 1 do begin
      WriteInteger('X' + IntToStr(I), InitialTilesPos[I].X);
      WriteInteger('Y' + IntToStr(I), InitialTilesPos[I].Y);
    end;
    Moves.SaveToRegistry(Reg, RegContext);
  end;
end;

procedure THistory.LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
var
  I: Integer;
begin
  with Reg do begin
    CurrentContext := TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\InitialTilesPos');
    SetLength(InitialTilesPos, ReadIntegerWithDefault('Count', 0));
    for I := 0 to Length(InitialTilesPos) - 1 do begin
      InitialTilesPos[I] := Point(ReadIntegerWithDefault('X' + IntToStr(I), 0),
        ReadIntegerWithDefault('Y' + IntToStr(I), 0));
    end;
  end;
  Moves.LoadFromRegistry(Reg, RegContext);
end;

{ TArea }

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

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

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

{ TBoard }

procedure TBoard.SetSize(AValue: TPoint);
var
  X, Y: Integer;
begin
  if FSize = AValue then Exit;
  for Y := 0 to FSize.Y - 1 do
    for X := 0 to FSize.X - 1 do
      Tiles[Y, X].Free;
  FSize := AValue;
  SetLength(Tiles, FSize.Y, FSize.X);
  for Y := 0 to FSize.Y - 1 do
    for X := 0 to FSize.X - 1 do begin
      Tiles[Y, X] := TTile.Create;
      Tiles[Y, X].Index := Point(X, Y);
    end;
end;

procedure TBoard.Assign(Source: TBoard);
var
  X, Y: Integer;
begin
  Size := Source.Size;
  for Y := 0 to Size.Y - 1 do
    for X := 0 to Size.X - 1 do
      Tiles[Y, X].Assign(Source.Tiles[Y, X]);
end;

procedure TBoard.GetEmptyTiles(EmptyTiles: TTiles);
var
  X, Y: Integer;
begin
  EmptyTiles.Clear;
  for Y := 0 to Size.Y - 1 do
    for X := 0 to Size.X - 1 do
      if Tiles[Y, X].Value = 0 then
        EmptyTiles.Add(Tiles[Y, X]);
end;

procedure TBoard.SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
var
  X, Y: Integer;
  Value: string;
begin
  with Reg do begin
    CurrentContext := RegContext;

    WriteInteger('SizeX', Size.X);
    WriteInteger('SizeY', Size.Y);
    Value := '';
    for Y := 0 to Size.Y - 1 do begin
      for X := 0 to Size.X - 1 do begin
        Value := Value + IntToStr(Tiles[Y, X].Value);
        if X < Size.X - 1 then Value := Value + ',';
      end;
      if Y < Size.Y - 1 then Value := Value + ';'
    end;
    WriteString('TileValues', Value);
  end;
end;

procedure TBoard.LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
var
  X, Y: Integer;
  Items: TStringList;
  Lines: TStringList;
  Number: Integer;
begin
  with Reg do begin
    CurrentContext := RegContext;

    Size := Point(ReadIntegerWithDefault('SizeX', 4), ReadIntegerWithDefault('SizeY', 4));
    Items := TStringList.Create;
    Items.Delimiter := ',';
    Lines := TStringList.Create;
    Lines.Delimiter := ';';
    Lines.DelimitedText := ReadStringWithDefault('TileValues', '');
    for Y := 0 to Lines.Count - 1 do begin
      Items.DelimitedText := Lines[Y];
      for X := 0 to Items.Count - 1 do begin
        if TryStrToInt(Items[X], Number) and (X < Size.X) and (Y < Size.Y) then
          Tiles[Y, X].Value := Number;
      end;
    end;
    Lines.Free;
    Items.Free;
  end;
end;

destructor TBoard.Destroy;
begin
  Size := Point(0, 0);
  inherited Destroy;
end;

procedure TBoard.ClearMerged;
var
  X, Y: Integer;
begin
  for Y := 0 to Size.Y - 1 do
    for X := 0 to Size.X - 1 do
      Tiles[Y, X].Merged := False;
end;

function TBoard.GetValueSum: Integer;
var
  X, Y: Integer;
begin
  Result := 0;
  for Y := 0 to Size.Y - 1 do
    for X := 0 to Size.X - 1 do
      Inc(Result, Tiles[Y, X].Value);
end;

function TBoard.GetEmptyTilesCount: Integer;
var
  X, Y: Integer;
begin
  Result := 0;
  for Y := 0 to Size.Y - 1 do
    for X := 0 to Size.X - 1 do
      if Tiles[Y, X].Value = 0 then
        Inc(Result);
end;

function TBoard.GetHighestTileValue: Integer;
var
  X, Y: Integer;
begin
  Result := 0;
  for Y := 0 to Size.Y - 1 do
    for X := 0 to Size.X - 1 do
      if Result < Tiles[Y, X].Value then Result := Tiles[Y, X].Value;
end;

procedure TBoard.Clear;
var
  X, Y: Integer;
begin
  for Y := 0 to Size.Y - 1 do
    for X := 0 to Size.X - 1 do
      Tiles[Y, X].Value := 0;
end;


{ TTile }

procedure TTile.Assign(Source: TTile);
begin
  Value := Source.Value;
  Merged := Source.Merged;
end;

{ TGame }

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

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

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

function TGame.FillRandomTile(Value4Change: Double = 0.1): TTile;
var
  EmptyTiles: TTiles;
  NewValue: Integer;
begin
  Result := nil;
  EmptyTiles := TTiles.Create(False);
  Board.GetEmptyTiles(EmptyTiles);
  if EmptyTiles.Count > 0 then begin
    if Random < Value4Change then NewValue := 4 else NewValue := 2;
    Result := EmptyTiles[Random(EmptyTiles.Count)];
    Result.Value := NewValue;
  end;
  EmptyTiles.Free;
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;
  WinScore := Source.WinScore;
  UndoEnabled := Source.UndoEnabled;
  FScore := Source.FScore;
  FRunning := Source.FRunning;
end;

procedure TGame.New;
var
  I: Integer;
begin
  FCanUndo := False;
  Board.Clear;
  Score := 0;
  Running := True;
  History.Clear;
  if RecordHistory then begin
    for I := 0 to InitialTileCount - 1 do begin
      SetLength(History.InitialTilesPos, Length(History.InitialTilesPos) + 1);
      History.InitialTilesPos[Length(History.InitialTilesPos) - 1] := FillRandomTile(0).Index;
    end;
  end else begin
    for I := 0 to InitialTileCount - 1 do
      FillRandomTile(0);
  end;
  DoChange;
end;

procedure TGame.Render(Canvas: TCanvas; CanvasSize: TPoint);
var
  X, Y: Integer;
  TileSize: TPoint;
  ValueStr: string;
  Frame: TRect;
  TileRect: TRect;
  TopBarHeight: Integer;
  TileMargin: Integer;
begin
  TopBarHeight := ScaleY(24, 96);
  TileMargin := Round(CanvasSize.X / Board.Size.X * 0.02);
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := clBlack;
  Canvas.FillRect(0, 0, Canvas.Width, Canvas.Height);

  ValueStr := SScore + ': ' + IntToStr(Score);
  Canvas.Font.Color := clWhite;
  Canvas.Font.Height := Trunc(TopBarHeight * 0.7);
  Canvas.TextOut(ScaleY(16, 96), (TopBarHeight - Canvas.TextHeight(ValueStr)) div 2, ValueStr);

  ValueStr := STopScore + ': ' + IntToStr(TopScore);
  Canvas.Font.Color := clWhite;
  Canvas.Font.Height := Trunc(TopBarHeight * 0.7);
  Canvas.TextOut(ScaleY(136, 96), (TopBarHeight - Canvas.TextHeight(ValueStr)) div 2, ValueStr);

  // Form.Canvas.Width and Form.Canvas.Height is not working correctly under Windows.
  // So dimensions are provided by CanvasSize parameter.
  Frame := Rect(2, TopBarHeight, CanvasSize.X - 2, CanvasSize.Y - 2);
  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.Width div 2 - (Board.Size.X * TileSize.X) div 2,
    Frame.Top + Frame.Height div 2 - (Board.Size.Y * TileSize.Y) div 2,
    Frame.Width div 2 + (Board.Size.X * TileSize.X) div 2,
    Frame.Top + Frame.Height div 2 + (Board.Size.Y * TileSize.Y) div 2);

  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := clGray;
  Canvas.FillRect(Frame);

  Canvas.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
      if Board.Tiles[Y, X].Moving then Canvas.Brush.Color := GetTileColor(0)
        else Canvas.Brush.Color := GetTileColor(Board.Tiles[Y, X].Value);
      Canvas.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(Canvas, Board.Tiles[Y, X], TileRect, not Board.Tiles[Y, X].Moving);
    end;

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

procedure TGame.MoveAll(Direction: TMoveDirection; Animation: Boolean);
var
  P: TPoint;
  PNew: TPoint;
  I: Integer;
  Area: TArea;
begin
  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
    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) then begin
              Board.Tiles[P.Y, P.X].Moving := True;
              Board.Tiles[PNew.Y, PNew.X].Value := Board.Tiles[P.Y, P.X].Value;
              Board.Tiles[PNew.Y, PNew.X].Merged := Board.Tiles[P.Y, P.X].Merged;
              Board.Tiles[P.Y, P.X].Value := 0;
              Board.Tiles[P.Y, P.X].Merged := False;
            end else
            if (not Board.Tiles[P.Y, P.X].Merged) and (not Board.Tiles[PNew.Y, PNew.X].Merged) and
            (Board.Tiles[PNew.Y, PNew.X].Value = Board.Tiles[P.Y, P.X].Value) then begin
              Board.Tiles[P.Y, P.X].Moving := True;
              Board.Tiles[PNew.Y, PNew.X].Value := Board.Tiles[PNew.Y, PNew.X].Value + Board.Tiles[P.Y, P.X].Value;
              Board.Tiles[PNew.Y, PNew.X].Merged := True;
              Board.Tiles[P.Y, P.X].Value := 0;
              Board.Tiles[P.Y, P.X].Merged := False;
              Score := Score + Board.Tiles[PNew.Y, PNew.X].Value;
            end;
          end;
        end;
        Inc(P.X, Area.Increment.X);
      end;
      Inc(P.Y, Area.Increment.Y);
    end;
    DoChange;
  end;
  FMoving := False;
end;

procedure TGame.RenderTile(Canvas: TCanvas; Tile: TTile; TileRect: TRect; WithText: Boolean);
var
  ValueStr: string;
  TextSize: TSize;
begin
  Canvas.FillRect(TileRect);
  if WithText and (Tile.Value <> 0) then begin
    ValueStr := IntToStr(Tile.Value);
    Canvas.Brush.Style := bsClear;
    Canvas.Font.Height := Trunc(TileRect.Height * 0.7);
    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;

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;
    FRunning := CanMove;
    History.Moves.Delete(History.Moves.Count - 1);
    DoChange;
  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 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
          (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.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;
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
    for Y := 0 to Board.Size.Y - 1 do
      for X := 0 to Board.Size.X - 1 do begin
        Board.Tiles[Y, X].NewValue := Board.Tiles[Y, X].Value;
        Board.Tiles[Y, X].Moving := False;
      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) then begin
          if (Board.Tiles[P.Y, P.X].NewValue <> 0) then begin
            if (Board.Tiles[PNew.Y, PNew.X].NewValue = 0) then begin
              Board.Tiles[P.Y, P.X].Moving := True;
              Board.Tiles[PNew.Y, PNew.X].NewValue := Board.Tiles[P.Y, P.X].NewValue;
              Board.Tiles[PNew.Y, PNew.X].Merged := Board.Tiles[P.Y, P.X].Merged;
              Board.Tiles[P.Y, P.X].NewValue := 0;
              Board.Tiles[P.Y, P.X].Merged := False;
              TileMoved := True;
            end else
            if (not Board.Tiles[P.Y, P.X].Merged) and (not Board.Tiles[PNew.Y, PNew.X].Merged) and
            (Board.Tiles[PNew.Y, PNew.X].NewValue = Board.Tiles[P.Y, P.X].NewValue) then begin
              Board.Tiles[P.Y, P.X].Moving := True;
              Board.Tiles[PNew.Y, PNew.X].NewValue := Board.Tiles[PNew.Y, PNew.X].NewValue + Board.Tiles[P.Y, P.X].NewValue;
              Board.Tiles[PNew.Y, PNew.X].Merged := True;
              Board.Tiles[P.Y, P.X].NewValue := 0;
              Board.Tiles[P.Y, P.X].Merged := False;
              Score := Score + Board.Tiles[PNew.Y, PNew.X].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].Moving then
            Board.Tiles[Y, X].Shift := Point(Trunc(Part * DirectionDiff[Direction].X * 100),
              Trunc(Part * DirectionDiff[Direction].Y * 100));
        end;
      DoChange;
      Application.ProcessMessages;
      Sleep(1);
    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
        Board.Tiles[Y, X].Value := Board.Tiles[Y, X].NewValue;
      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
      Board.Tiles[Y, X].Shift := Point(0, 0);
      Board.Tiles[Y, X].Moving := False;
      Board.Tiles[Y, X].Value := Board.Tiles[Y, X].NewValue;
    end;
  DoChange;
  FMoving := False;
end;

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

    NewTile := FillRandomTile;
    if RecordHistory 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 < WinScore) and
    (Board.GetHighestTileValue >= WinScore) then Win;
  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(RegContext: TRegistryContext);
var
  Reg: TRegistryEx;
begin
  Reg := TRegistryEx.Create;
  with Reg do
  try
    CurrentContext := RegContext;

    WriteInteger('TopScore', TopScore);
    WriteInteger('AnimationDuration', AnimationDuration);
    WriteInteger('Score', Score);
    WriteBool('GameRunning', FRunning);
    WriteBool('CanUndo', FCanUndo);
    WriteBool('UndoEnabled', UndoEnabled);
    WriteBool('RecordHistory', RecordHistory);
    FBoardUndo.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo'));
    Board.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board'));
    History.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\History'));
  finally
    Free;
  end;
end;

procedure TGame.LoadFromRegistry(RegContext: TRegistryContext);
var
  Reg: TRegistryEx;
begin
  Reg := TRegistryEx.Create;
  with Reg do
  try
    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);
    FBoardUndo.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo'));
    Board.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board'));
    History.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\History'));
  finally
    Free;
  end;
  DoChange;
end;

constructor TGame.Create;
begin
  AnimationDuration := 30;
  WinScore := 2048;
  Board := TBoard.Create;
  FBoardUndo := TBoard.Create;
  History := THistory.Create;
  History.Game := Self;
end;

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

function TGame.GetTileColor(Value: Integer): TColor;
begin
  case Value of
    0: Result := $f2f6f9;
    2: Result := $dae4ee;
    4: Result := $c8e0ed;
    8: Result := $79b1f2;
    16: Result := $6395f5;
    32: Result := $5f7cf6;
    64: Result := $3b5ef6;
    128: Result := $72cfed;
    256: Result := $61cced;
    512: Result := $50c8ed;
    1024: Result := $3fc5ed;
    2048: Result := $2ec2ed;
    else Result := $323a3c;
  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;

end.