Changeset 49 for trunk/UGame.pas


Ignore:
Timestamp:
Nov 3, 2019, 11:45:03 AM (5 years ago)
Author:
chronos
Message:
  • Added: Support for selectable skins of tiles. Tile values are now representing normal sequence of numbers. If power of two is selected, values are recalculated for rendering and score.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/UGame.pas

    r48 r49  
    5454  end;
    5555
     56  TTilePosValue = record
     57    Pos: TPoint;
     58    Value: Integer;
     59  end;
     60
    5661  { THistory }
    5762
    … …  
    5964    Game: TGame;
    6065    Moves: THistoryMoves;
    61     InitialTilesPos: array of TPoint;
     66    InitialTiles: array of TTilePosValue;
    6267    procedure GetStep(GameStep: TGame; Step: Integer);
    6368    procedure Clear;
    … …  
    8994  end;
    9095
     96  TTileSkin = (tsLinear, tsPowerOfTwo);
     97
    9198  { TGame }
    9299
    … …  
    102109    FCanUndo: Boolean;
    103110    FBoardUndo: TBoard;
     111    FSkin: TTileSkin;
    104112    function GetTileColor(Value: Integer): TColor;
    105113    procedure SetRecordHistory(AValue: Boolean);
    … …  
    108116    procedure RenderTile(Canvas: TCanvas; Tile: TTile; TileRect: TRect; WithText: Boolean);
    109117    procedure GameOver;
     118    procedure SetSkin(AValue: TTileSkin);
    110119    procedure Win;
    111120    function FillRandomTile(Value4Change: Double = 0.1): TTile;
    112121    function GetMoveArea(Direction: TMoveDirection): TArea;
    113122    procedure MoveAllAnimate(Direction: TMoveDirection);
     123    function CanMergeTile(Value1, Value2: Integer): Boolean;
     124    function MergeTile(Value1, Value2: Integer): Integer;
    114125  public
    115126    Board: TBoard;
    116127    TopScore: Integer;
    117128    AnimationDuration: Integer;
    118     WinScore: Integer;
     129    WinTileValue: Integer;
    119130    UndoEnabled: Boolean;
    120131    History: THistory;
    … …  
    133144    procedure SaveToRegistry(RegContext: TRegistryContext);
    134145    procedure LoadFromRegistry(RegContext: TRegistryContext);
     146    function GetTileSkinValue(Value: Integer): Integer;
    135147    constructor Create;
    136148    destructor Destroy; override;
    … …  
    142154    property Moving: Boolean read FMoving;
    143155    property RecordHistory: Boolean read FRecordHistory write SetRecordHistory;
     156    property Skin: TTileSkin read FSkin write SetSkin;
    144157  end;
    145158
    146159  TGames = class(TFPGObjectList<TGame>)
    147160  end;
     161
     162var
     163  SkinText: array[TTileSkin] of string;
    148164
    149165const
    … …  
    157173  SScore = 'Score';
    158174  STopScore = 'Top score';
     175  SSkinLinear = 'Linear';
     176  SSkinPowerOfTwo = 'Power of two';
     177  STileShouldBeEmpty = 'Tile should be empty';
     178
     179procedure Translate;
     180
    159181
    160182implementation
     183
     184procedure Translate;
     185begin
     186  SkinText[tsLinear] := SSkinLinear;
     187  SkinText[tsPowerOfTwo] := SSkinPowerOfTwo;
     188end;
    161189
    162190{ THistoryMoves }
    … …  
    221249  GameStep.Board.Size := Game.Board.Size;
    222250  GameStep.Board.Clear;
     251  GameStep.Skin := Game.Skin;
    223252  GameStep.Score := 0;
    224   for I := 0 to Length(InitialTilesPos) - 1 do
    225     GameStep.Board.Tiles[InitialTilesPos[I].Y, InitialTilesPos[I].X].Value := 2;
     253  for I := 0 to Length(InitialTiles) - 1 do
     254    GameStep.Board.Tiles[InitialTiles[I].Pos.Y, InitialTiles[I].Pos.X].Value := InitialTiles[I].Value;
    226255  for I := 0 to Step - 1 do
    227256  with Moves[I] do begin
    … …  
    229258    if GameStep.Board.Tiles[NewItemPos.Y, NewItemPos.X].Value = 0 then
    230259      GameStep.Board.Tiles[NewItemPos.Y, NewItemPos.X].Value := NewItemValue
    231       else raise Exception.Create('Tile should be empty');
     260      else raise Exception.Create(STileShouldBeEmpty);
    232261  end;
    233262end;
    … …  
    236265begin
    237266  Moves.Clear;
    238   SetLength(InitialTilesPos, 0);
     267  SetLength(InitialTiles, 0);
    239268end;
    240269
    … …  
    256285  with Reg do begin
    257286    CurrentContext := TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\InitialTilesPos');
    258     WriteInteger('Count', Length(InitialTilesPos));
    259     for I := 0 to Length(InitialTilesPos) - 1 do begin
    260       WriteInteger('X' + IntToStr(I), InitialTilesPos[I].X);
    261       WriteInteger('Y' + IntToStr(I), InitialTilesPos[I].Y);
     287    WriteInteger('Count', Length(InitialTiles));
     288    for I := 0 to Length(InitialTiles) - 1 do begin
     289      WriteInteger('X' + IntToStr(I), InitialTiles[I].Pos.X);
     290      WriteInteger('Y' + IntToStr(I), InitialTiles[I].Pos.Y);
     291      WriteInteger('Value' + IntToStr(I), InitialTiles[I].Value);
    262292    end;
    263293    Moves.SaveToRegistry(Reg, RegContext);
    … …  
    271301  with Reg do begin
    272302    CurrentContext := TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\InitialTilesPos');
    273     SetLength(InitialTilesPos, ReadIntegerWithDefault('Count', 0));
    274     for I := 0 to Length(InitialTilesPos) - 1 do begin
    275       InitialTilesPos[I] := Point(ReadIntegerWithDefault('X' + IntToStr(I), 0),
     303    SetLength(InitialTiles, ReadIntegerWithDefault('Count', 0));
     304    for I := 0 to Length(InitialTiles) - 1 do begin
     305      InitialTiles[I].Pos := Point(ReadIntegerWithDefault('X' + IntToStr(I), 0),
    276306        ReadIntegerWithDefault('Y' + IntToStr(I), 0));
     307      InitialTiles[I].Value := ReadIntegerWithDefault('Value' + IntToStr(I), 0);
    277308    end;
    278309  end;
    … …  
    466497end;
    467498
     499procedure TGame.SetSkin(AValue: TTileSkin);
     500begin
     501  if FSkin = AValue then Exit;
     502  FSkin := AValue;
     503  DoChange;
     504end;
     505
    468506procedure TGame.Win;
    469507begin
    … …  
    480518  Board.GetEmptyTiles(EmptyTiles);
    481519  if EmptyTiles.Count > 0 then begin
    482     if Random < Value4Change then NewValue := 4 else NewValue := 2;
     520    if Random < Value4Change then NewValue := 2 else NewValue := 1;
    483521    Result := EmptyTiles[Random(EmptyTiles.Count)];
    484522    Result.Value := NewValue;
    … …  
    511549  TopScore := Source.TopScore;
    512550  AnimationDuration := Source.AnimationDuration;
    513   WinScore := Source.WinScore;
     551  WinTileValue := Source.WinTileValue;
    514552  UndoEnabled := Source.UndoEnabled;
    515553  FScore := Source.FScore;
    516554  FRunning := Source.FRunning;
     555  Skin := Source.Skin;
    517556end;
    518557
    … …  
    520559var
    521560  I: Integer;
     561  Tile: TTile;
    522562begin
    523563  FCanUndo := False;
    … …  
    528568  if RecordHistory then begin
    529569    for I := 0 to InitialTileCount - 1 do begin
    530       SetLength(History.InitialTilesPos, Length(History.InitialTilesPos) + 1);
    531       History.InitialTilesPos[Length(History.InitialTilesPos) - 1] := FillRandomTile(0).Index;
     570      SetLength(History.InitialTiles, Length(History.InitialTiles) + 1);
     571      Tile := FillRandomTile(0);
     572      History.InitialTiles[Length(History.InitialTiles) - 1].Pos := Tile.Index;
     573      History.InitialTiles[Length(History.InitialTiles) - 1].Value := Tile.Value;
    532574    end;
    533575  end else begin
    … …  
    642684            end else
    643685            if (not Board.Tiles[P.Y, P.X].Merged) and (not Board.Tiles[PNew.Y, PNew.X].Merged) and
    644             (Board.Tiles[PNew.Y, PNew.X].Value = Board.Tiles[P.Y, P.X].Value) then begin
     686            CanMergeTile(Board.Tiles[PNew.Y, PNew.X].Value, Board.Tiles[P.Y, P.X].Value) then begin
    645687              Board.Tiles[P.Y, P.X].Moving := True;
    646               Board.Tiles[PNew.Y, PNew.X].Value := Board.Tiles[PNew.Y, PNew.X].Value + Board.Tiles[P.Y, P.X].Value;
     688              Board.Tiles[PNew.Y, PNew.X].Value := MergeTile(Board.Tiles[PNew.Y, PNew.X].Value, Board.Tiles[P.Y, P.X].Value);
    647689              Board.Tiles[PNew.Y, PNew.X].Merged := True;
    648690              Board.Tiles[P.Y, P.X].Value := 0;
    649691              Board.Tiles[P.Y, P.X].Merged := False;
    650               Score := Score + Board.Tiles[PNew.Y, PNew.X].Value;
     692              Score := Score + GetTileSkinValue(Board.Tiles[PNew.Y, PNew.X].Value);
    651693            end;
    652694          end;
    … …  
    669711  Canvas.RoundRect(TileRect, ScaleX(TileRect.Width div 20, 96), ScaleY(TileRect.Height div 20, 96));
    670712  if WithText and (Tile.Value <> 0) then begin
    671     ValueStr := IntToStr(Tile.Value);
     713    ValueStr := IntToStr(GetTileSkinValue(Tile.Value));
    672714    Canvas.Brush.Style := bsClear;
    673715    Canvas.Font.Height := Trunc(TileRect.Height * 0.7);
    … …  
    719761          end else
    720762          if (Board.Tiles[P.Y, P.X].Value <> 0) then begin
    721             if Board.Tiles[PNew.Y, PNew.X].Value = Board.Tiles[P.Y, P.X].Value then begin
     763            if CanMergeTile(Board.Tiles[PNew.Y, PNew.X].Value, Board.Tiles[P.Y, P.X].Value) then begin
    722764              Result := True;
    723765              Break;
    … …  
    750792        if (Board.Tiles[P.Y, P.X].Value <> 0) then begin
    751793          if (Board.Tiles[PNew.Y, PNew.X].Value = 0) or
    752           (Board.Tiles[PNew.Y, PNew.X].Value = Board.Tiles[P.Y, P.X].Value) then begin
     794          CanMergeTile(Board.Tiles[PNew.Y, PNew.X].Value, Board.Tiles[P.Y, P.X].Value) then begin
    753795            Result := True;
    754796            Break;
    … …  
    807849            end else
    808850            if (not Board.Tiles[P.Y, P.X].Merged) and (not Board.Tiles[PNew.Y, PNew.X].Merged) and
    809             (Board.Tiles[PNew.Y, PNew.X].NewValue = Board.Tiles[P.Y, P.X].NewValue) then begin
     851            CanMergeTile(Board.Tiles[PNew.Y, PNew.X].NewValue, Board.Tiles[P.Y, P.X].NewValue) then begin
    810852              Board.Tiles[P.Y, P.X].Moving := True;
    811               Board.Tiles[PNew.Y, PNew.X].NewValue := Board.Tiles[PNew.Y, PNew.X].NewValue + Board.Tiles[P.Y, P.X].NewValue;
     853              Board.Tiles[PNew.Y, PNew.X].NewValue := MergeTile(Board.Tiles[PNew.Y, PNew.X].NewValue, Board.Tiles[P.Y, P.X].NewValue);
    812854              Board.Tiles[PNew.Y, PNew.X].Merged := True;
    813855              Board.Tiles[P.Y, P.X].NewValue := 0;
    814856              Board.Tiles[P.Y, P.X].Merged := False;
    815               Score := Score + Board.Tiles[PNew.Y, PNew.X].NewValue;
     857              Score := Score + GetTileSkinValue(Board.Tiles[PNew.Y, PNew.X].NewValue);
    816858              TileMoved := True;
    817859            end;
    … …  
    861903end;
    862904
     905function TGame.CanMergeTile(Value1, Value2: Integer): Boolean;
     906begin
     907  Result := MergeTile(Value1, Value2) <> -1;
     908end;
     909
     910function TGame.MergeTile(Value1, Value2: Integer): Integer;
     911begin
     912  if Value1 = Value2 then Result := Value1 + 1
     913  else Result := -1;
     914end;
     915
     916function TGame.GetTileSkinValue(Value: Integer): Integer;
     917begin
     918  if FSkin = tsPowerOfTwo then Result := 1 shl Value
     919  else Result := Value;
     920end;
     921
    863922procedure TGame.MoveAllAndUpdate(Direction: TMoveDirection; Animation: Boolean);
    864923var
    … …  
    882941    if not CanMove and (Board.GetEmptyTilesCount = 0) then
    883942      GameOver;
    884     if (HighestValue < WinScore) and
    885     (Board.GetHighestTileValue >= WinScore) then Win;
     943    if (HighestValue < WinTileValue) and
     944    (Board.GetHighestTileValue >= WinTileValue) then Win;
    886945  end;
    887946end;
    … …  
    917976    WriteBool('UndoEnabled', UndoEnabled);
    918977    WriteBool('RecordHistory', RecordHistory);
     978    WriteInteger('Skin', Integer(Skin));
    919979    FBoardUndo.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo'));
    920980    Board.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board'));
    … …  
    9401000    UndoEnabled := ReadBoolWithDefault('UndoEnabled', True);
    9411001    RecordHistory := ReadBoolWithDefault('RecordHistory', False);
     1002    Skin := TTileSkin(ReadIntegerWithDefault('Skin', Integer(tsPowerOfTwo)));
    9421003    FBoardUndo.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo'));
    9431004    Board.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board'));
    … …  
    9521013begin
    9531014  AnimationDuration := 30;
    954   WinScore := 2048;
     1015  WinTileValue := 11; // 2^11 = 2048
    9551016  Board := TBoard.Create;
    9561017  FBoardUndo := TBoard.Create;
    … …  
    9711032  case Value of
    9721033    0: Result := $f2f6f9;
    973     2: Result := $dae4ee;
    974     4: Result := $c8e0ed;
    975     8: Result := $79b1f2;
    976     16: Result := $6395f5;
    977     32: Result := $5f7cf6;
    978     64: Result := $3b5ef6;
    979     128: Result := $72cfed;
    980     256: Result := $61cced;
    981     512: Result := $50c8ed;
    982     1024: Result := $3fc5ed;
    983     2048: Result := $2ec2ed;
     1034    1: Result := $dae4ee;
     1035    2: Result := $c8e0ed;
     1036    3: Result := $79b1f2;
     1037    4: Result := $6395f5;
     1038    5: Result := $5f7cf6;
     1039    6: Result := $3b5ef6;
     1040    7: Result := $72cfed;
     1041    8: Result := $61cced;
     1042    9: Result := $50c8ed;
     1043    10: Result := $3fc5ed;
     1044    11: Result := $2ec2ed;
    9841045    else Result := $323a3c;
    9851046  end;
Note: See TracChangeset for help on using the changeset viewer.