Changeset 104 for trunk/Game.pas


Ignore:
Timestamp:
Dec 9, 2024, 3:42:36 PM (13 days ago)
Author:
chronos
Message:
  • Modified: Board, Tile and History separated from main Game unit.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/Game.pas

    r102 r104  
    55uses
    66  Classes, SysUtils, Dialogs, Generics.Collections, Graphics, Types, Forms, Math, DateUtils,
    7   Controls, RegistryEx;
     7  Controls, RegistryEx, Tile, Board, History;
    88
    99type
    1010  TGame = class;
    11   TMoveDirection = (drNone, drLeft, drUp, drRight, drDown);
    12   TTileAction = (taNone, taMove, taMerge, taAppear);
    1311  TColorPalette = (cpOrangeYellow, cpGreenYellow, cpPinkBlue, cpBlueCyan,
    1412    cpGreenCyan, cpPinkRed);
    15 
    16   { TTile }
    17 
    18   TTile = class
    19     Index: TPoint;
    20     Value: Integer;
    21     NewValue: Integer;
    22     Merged: Boolean;
    23     Action: TTileAction;
    24     Shift: TPoint;
    25     procedure Assign(Source: TTile);
    26   end;
    27 
    28   TTiles = class(TObjectList<TTile>)
    29   end;
    3013
    3114  { TArea }
    … …  
    3619    class function Create(P1, P2: TPoint): TArea; static; overload;
    3720    class function Create(X1, Y1, X2, Y2: Integer): TArea; static; overload;
    38   end;
    39 
    40   { THistoryMove }
    41 
    42   THistoryMove = class
    43     Direction: TMoveDirection;
    44     NewItemPos: TPoint;
    45     NewItemValue: Integer;
    46     procedure SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
    47     procedure LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
    48   end;
    49 
    50   { THistoryMoves }
    51 
    52   THistoryMoves = class(TObjectList<THistoryMove>)
    53     procedure SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
    54     procedure LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
    55   end;
    56 
    57   TTilePosValue = record
    58     Pos: TPoint;
    59     Value: Integer;
    60   end;
    61 
    62   { THistory }
    63 
    64   THistory = class
    65     Game: TGame;
    66     Moves: THistoryMoves;
    67     InitialTiles: array of TTilePosValue;
    68     procedure GetStep(GameStep: TGame; Step: Integer);
    69     procedure Clear;
    70     constructor Create;
    71     destructor Destroy; override;
    72     procedure SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
    73     procedure LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
    74   end;
    75 
    76   { TBoard }
    77 
    78   TBoard = class
    79   private
    80     FSize: TPoint;
    81     procedure SetSize(AValue: TPoint);
    82   public
    83     Tiles: array of array of TTile;
    84     procedure Assign(Source: TBoard);
    85     procedure Clear;
    86     procedure ClearMerged;
    87     function GetValueSum: Integer;
    88     function GetHighestTileValue: Integer;
    89     function GetEmptyTilesCount: Integer;
    90     procedure GetEmptyTiles(EmptyTiles: TTiles);
    91     procedure SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
    92     procedure LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
    93     destructor Destroy; override;
    94     property Size: TPoint read FSize write SetSize;
    9521  end;
    9622
    … …  
    14167    BackgroundColor: TColor;
    14268    Value2Chance: Double;
     69    procedure Replay(History: THistory; Step: Integer);
    14370    function CanUndo: Boolean;
    14471    procedure Undo;
    … …  
    227154end;
    228155
    229 { THistoryMoves }
    230 
    231 procedure THistoryMoves.SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
    232 var
    233   I: Integer;
    234 begin
    235   with Reg do begin
    236     CurrentContext := RegContext;
    237     WriteInteger('Count', Count);
    238     for I := 0 to Count - 1 do begin
    239       Items[I].SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\' + IntToStr(I)));
    240     end;
    241   end;
    242 end;
    243 
    244 procedure THistoryMoves.LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
    245 var
    246   I: Integer;
    247 begin
    248   with Reg do begin
    249     CurrentContext := RegContext;
    250     Count := ReadIntegerWithDefault('Count', 0);
    251     for I := 0 to Count - 1 do begin
    252       Items[I] := THistoryMove.Create;
    253       THistoryMove(Items[I]).LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\' + IntToStr(I)));
    254     end;
    255   end;
    256 end;
    257 
    258 { THistoryMove }
    259 
    260 procedure THistoryMove.SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
    261 begin
    262   with Reg do begin
    263     CurrentContext := RegContext;
    264     WriteInteger('Direction', Integer(Direction));
    265     WriteInteger('NewItemPosX', NewItemPos.X);
    266     WriteInteger('NewItemPosY', NewItemPos.Y);
    267     WriteInteger('NewItemValue', NewItemValue);
    268   end;
    269 end;
    270 
    271 procedure THistoryMove.LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
    272 begin
    273   with Reg do begin
    274     CurrentContext := RegContext;
    275     Direction := TMoveDirection(ReadIntegerWithDefault('Direction', Integer(drNone)));
    276     NewItemPos := Point(ReadIntegerWithDefault('NewItemPosX', 0),
    277       ReadIntegerWithDefault('NewItemPosY', 0));
    278     NewItemValue := ReadIntegerWithDefault('NewItemValue', 0);
    279   end;
    280 end;
    281 
    282 { THistory }
    283 
    284 procedure THistory.GetStep(GameStep: TGame; Step: Integer);
    285 var
    286   I: Integer;
    287 begin
    288   GameStep.Board.Size := Game.Board.Size;
    289   GameStep.Board.Clear;
    290   GameStep.Skin := Game.Skin;
    291   GameStep.ColorPalette := Game.ColorPalette;
    292   GameStep.Score := 0;
    293   for I := 0 to Length(InitialTiles) - 1 do
    294     GameStep.Board.Tiles[InitialTiles[I].Pos.Y, InitialTiles[I].Pos.X].Value := InitialTiles[I].Value;
    295   for I := 0 to Step - 1 do
    296   with Moves[I] do begin
    297     GameStep.MoveAll(Direction, False);
    298     if GameStep.Board.Tiles[NewItemPos.Y, NewItemPos.X].Value = 0 then
    299       GameStep.Board.Tiles[NewItemPos.Y, NewItemPos.X].Value := NewItemValue
    300       else raise Exception.Create(STileShouldBeEmpty);
    301   end;
    302 end;
    303 
    304 procedure THistory.Clear;
    305 begin
    306   Moves.Clear;
    307   SetLength(InitialTiles, 0);
    308 end;
    309 
    310 constructor THistory.Create;
    311 begin
    312   Moves := THistoryMoves.Create;
    313 end;
    314 
    315 destructor THistory.Destroy;
    316 begin
    317   FreeAndNil(Moves);
    318   inherited;
    319 end;
    320 
    321 procedure THistory.SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
    322 var
    323   I: Integer;
    324 begin
    325   with Reg do begin
    326     CurrentContext := TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\InitialTilesPos');
    327     WriteInteger('Count', Length(InitialTiles));
    328     for I := 0 to Length(InitialTiles) - 1 do begin
    329       WriteInteger('X' + IntToStr(I), InitialTiles[I].Pos.X);
    330       WriteInteger('Y' + IntToStr(I), InitialTiles[I].Pos.Y);
    331       WriteInteger('Value' + IntToStr(I), InitialTiles[I].Value);
    332     end;
    333     Moves.SaveToRegistry(Reg, RegContext);
    334   end;
    335 end;
    336 
    337 procedure THistory.LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
    338 var
    339   I: Integer;
    340 begin
    341   with Reg do begin
    342     CurrentContext := TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\InitialTilesPos');
    343     SetLength(InitialTiles, ReadIntegerWithDefault('Count', 0));
    344     for I := 0 to Length(InitialTiles) - 1 do begin
    345       InitialTiles[I].Pos := Point(ReadIntegerWithDefault('X' + IntToStr(I), 0),
    346         ReadIntegerWithDefault('Y' + IntToStr(I), 0));
    347       InitialTiles[I].Value := ReadIntegerWithDefault('Value' + IntToStr(I), 0);
    348     end;
    349   end;
    350   Moves.LoadFromRegistry(Reg, RegContext);
    351 end;
    352 
    353156{ TArea }
    354157
    … …  
    370173  Result.P1 := Point(X1, Y1);
    371174  Result.P2 := Point(X2, Y2);
    372 end;
    373 
    374 { TBoard }
    375 
    376 procedure TBoard.SetSize(AValue: TPoint);
    377 var
    378   X, Y: Integer;
    379 begin
    380   if FSize = AValue then Exit;
    381   for Y := 0 to FSize.Y - 1 do
    382     for X := 0 to FSize.X - 1 do
    383       Tiles[Y, X].Free;
    384   FSize := AValue;
    385   SetLength(Tiles, FSize.Y, FSize.X);
    386   for Y := 0 to FSize.Y - 1 do
    387     for X := 0 to FSize.X - 1 do begin
    388       Tiles[Y, X] := TTile.Create;
    389       Tiles[Y, X].Index := Point(X, Y);
    390     end;
    391 end;
    392 
    393 procedure TBoard.Assign(Source: TBoard);
    394 var
    395   X, Y: Integer;
    396 begin
    397   Size := Source.Size;
    398   for Y := 0 to Size.Y - 1 do
    399     for X := 0 to Size.X - 1 do
    400       Tiles[Y, X].Assign(Source.Tiles[Y, X]);
    401 end;
    402 
    403 procedure TBoard.GetEmptyTiles(EmptyTiles: TTiles);
    404 var
    405   X, Y: Integer;
    406 begin
    407   EmptyTiles.Clear;
    408   for Y := 0 to Size.Y - 1 do
    409     for X := 0 to Size.X - 1 do
    410       if Tiles[Y, X].Value = 0 then
    411         EmptyTiles.Add(Tiles[Y, X]);
    412 end;
    413 
    414 procedure TBoard.SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
    415 var
    416   X, Y: Integer;
    417   Value: string;
    418 begin
    419   with Reg do begin
    420     CurrentContext := RegContext;
    421 
    422     WriteInteger('SizeX', Size.X);
    423     WriteInteger('SizeY', Size.Y);
    424     Value := '';
    425     for Y := 0 to Size.Y - 1 do begin
    426       for X := 0 to Size.X - 1 do begin
    427         Value := Value + IntToStr(Tiles[Y, X].Value);
    428         if X < Size.X - 1 then Value := Value + ',';
    429       end;
    430       if Y < Size.Y - 1 then Value := Value + ';'
    431     end;
    432     WriteString('TileValues', Value);
    433   end;
    434 end;
    435 
    436 procedure TBoard.LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
    437 var
    438   X, Y: Integer;
    439   Items: TStringList;
    440   Lines: TStringList;
    441   Number: Integer;
    442 begin
    443   with Reg do begin
    444     CurrentContext := RegContext;
    445 
    446     Size := Point(ReadIntegerWithDefault('SizeX', 4), ReadIntegerWithDefault('SizeY', 4));
    447     Items := TStringList.Create;
    448     Items.Delimiter := ',';
    449     Lines := TStringList.Create;
    450     Lines.Delimiter := ';';
    451     Lines.DelimitedText := ReadStringWithDefault('TileValues', '');
    452     for Y := 0 to Lines.Count - 1 do begin
    453       Items.DelimitedText := Lines[Y];
    454       for X := 0 to Items.Count - 1 do begin
    455         if TryStrToInt(Items[X], Number) and (X < Size.X) and (Y < Size.Y) then
    456           Tiles[Y, X].Value := Number;
    457       end;
    458     end;
    459     Lines.Free;
    460     Items.Free;
    461   end;
    462 end;
    463 
    464 destructor TBoard.Destroy;
    465 begin
    466   Size := Point(0, 0);
    467   inherited;
    468 end;
    469 
    470 procedure TBoard.ClearMerged;
    471 var
    472   X, Y: Integer;
    473 begin
    474   for Y := 0 to Size.Y - 1 do
    475     for X := 0 to Size.X - 1 do
    476       Tiles[Y, X].Merged := False;
    477 end;
    478 
    479 function TBoard.GetValueSum: Integer;
    480 var
    481   X, Y: Integer;
    482 begin
    483   Result := 0;
    484   for Y := 0 to Size.Y - 1 do
    485     for X := 0 to Size.X - 1 do
    486       Inc(Result, Tiles[Y, X].Value);
    487 end;
    488 
    489 function TBoard.GetEmptyTilesCount: Integer;
    490 var
    491   X, Y: Integer;
    492 begin
    493   Result := 0;
    494   for Y := 0 to Size.Y - 1 do
    495     for X := 0 to Size.X - 1 do
    496       if Tiles[Y, X].Value = 0 then
    497         Inc(Result);
    498 end;
    499 
    500 function TBoard.GetHighestTileValue: Integer;
    501 var
    502   X, Y: Integer;
    503 begin
    504   Result := 0;
    505   for Y := 0 to Size.Y - 1 do
    506     for X := 0 to Size.X - 1 do
    507       if Result < Tiles[Y, X].Value then Result := Tiles[Y, X].Value;
    508 end;
    509 
    510 procedure TBoard.Clear;
    511 var
    512   X, Y: Integer;
    513 begin
    514   for Y := 0 to Size.Y - 1 do
    515     for X := 0 to Size.X - 1 do
    516       Tiles[Y, X].Value := 0;
    517 end;
    518 
    519 
    520 { TTile }
    521 
    522 procedure TTile.Assign(Source: TTile);
    523 begin
    524   Value := Source.Value;
    525   Merged := Source.Merged;
    526175end;
    527176
    … …  
    610259  Skin := Source.Skin;
    611260  ColorPalette := Source.ColorPalette;
     261  RecordHistory := Source.RecordHistory;
     262  //History.Assign(Source.History);
    612263end;
    613264
    … …  
    1142793end;
    1143794
     795procedure TGame.Replay(History: THistory; Step: Integer);
     796var
     797  I: Integer;
     798begin
     799  Board.Clear;
     800  Score := 0;
     801  for I := 0 to Length(History.InitialTiles) - 1 do
     802    Board.Tiles[History.InitialTiles[I].Pos.Y, History.InitialTiles[I].Pos.X].Value := History.InitialTiles[I].Value;
     803  for I := 0 to Step - 1 do
     804  with History.Moves[I] do begin
     805      MoveAll(Direction, False);
     806      if Board.Tiles[NewItemPos.Y, NewItemPos.X].Value = 0 then
     807        Board.Tiles[NewItemPos.Y, NewItemPos.X].Value := NewItemValue
     808        else raise Exception.Create(STileShouldBeEmpty);
     809    end;
     810end;
     811
    1144812function IntToStrRoman(Num: Integer): string;
    1145813const
    … …  
    1309977  FBoardUndo := TBoard.Create;
    1310978  History := THistory.Create;
    1311   History.Game := Self;
    1312979  Value2Chance := 0.1;
    1313980end;
Note: See TracChangeset for help on using the changeset viewer.