Changeset 31 for trunk


Ignore:
Timestamp:
Oct 12, 2019, 10:47:02 PM (5 years ago)
Author:
chronos
Message:
  • Added: New form accessible from menu Tools - Moves history with game moves history.
Location:
trunk
Files:
13 edited

Legend:

Unmodified
Added
Removed
  • trunk/Forms/UFormComputer.pas

    r29 r31  
    1313  TGameTry = class
    1414    Game: TGame;
    15     Moves: array of TDirection;
     15    Moves: array of TMoveDirection;
    1616    constructor Create;
    1717    destructor Destroy; override;
     
    5858function TGameTry.GetFitness: Double;
    5959const
    60   DirWeight: array[TDirection] of Double = (0.25, -10000, 0.5, 0.75);
     60  DirWeight: array[TMoveDirection] of Double = (0, 0.25, -10000, 0.5, 0.75);
    6161var
    6262  I: Integer;
     
    221221procedure TFormComputer.TryAllDirections(GameTries: TGameTries; GameTry: TGameTry);
    222222var
    223   Direction: TDirection;
     223  Direction: TMoveDirection;
    224224  NewTry: TGameTry;
    225225begin
    226   for Direction := Low(TDirection) to High(TDirection) do begin
     226  for Direction := Low(TMoveDirection) to High(TMoveDirection) do begin
    227227    if GameTry.Game.CanMoveDirection(Direction) then begin
    228228      NewTry := TGameTry.Create;
  • trunk/Forms/UFormMain.lfm

    r29 r31  
    3737        Action = Core.AComputer
    3838      end
     39      object MenuItem5: TMenuItem
     40        Action = Core.AHistory
     41      end
    3942    end
    4043    object MenuItemHelp: TMenuItem
  • trunk/Forms/UFormMain.pas

    r29 r31  
    1919    MenuItem3: TMenuItem;
    2020    MenuItem4: TMenuItem;
     21    MenuItem5: TMenuItem;
    2122    MenuItemTools: TMenuItem;
    2223    MenuItemNew: TMenuItem;
  • trunk/Forms/UFormNew.lfm

    r28 r31  
    88  ClientWidth = 487
    99  DesignTimePPI = 144
     10  OnClose = FormClose
    1011  OnCreate = FormCreate
     12  OnShow = FormShow
    1113  LCLVersion = '2.0.2.0'
    1214  object Label1: TLabel
  • trunk/Forms/UFormNew.pas

    r28 r31  
    1919    ComboBoxSize: TComboBox;
    2020    Label1: TLabel;
     21    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    2122    procedure FormCreate(Sender: TObject);
     23    procedure FormShow(Sender: TObject);
    2224  private
    2325
     
    4446end;
    4547
     48procedure TFormNew.FormShow(Sender: TObject);
     49begin
     50  Core.PersistentForm1.Load(Self);
     51end;
     52
     53procedure TFormNew.FormClose(Sender: TObject; var CloseAction: TCloseAction);
     54begin
     55  Core.PersistentForm1.Save(Self);
     56end;
     57
    4658procedure TFormNew.Load(Game: TGame);
    4759begin
  • trunk/Game2048.lpi

    r29 r31  
    8282      </Item2>
    8383    </RequiredPackages>
    84     <Units Count="9">
     84    <Units Count="10">
    8585      <Unit0>
    8686        <Filename Value="Game2048.lpr"/>
     
    140140        <ResourceBaseClass Value="Form"/>
    141141      </Unit8>
     142      <Unit9>
     143        <Filename Value="Forms/UFormHistory.pas"/>
     144        <IsPartOfProject Value="True"/>
     145        <ComponentName Value="FormHistory"/>
     146        <HasResources Value="True"/>
     147        <ResourceBaseClass Value="Form"/>
     148      </Unit9>
    142149    </Units>
    143150  </ProjectOptions>
  • trunk/Game2048.lpr

    r29 r31  
    99  Interfaces, SysUtils,// this includes the LCL widgetset
    1010  Forms, UGame, Common, UFormSettings, UFormMain, UCore, UFormHelp,
    11   UFormComputer
     11  UFormComputer, UFormHistory
    1212  { you can add units after this };
    1313
  • trunk/Languages/Game2048.cs.po

    r29 r31  
    3232msgstr "Nápověda"
    3333
     34#: tcore.ahistory.caption
     35msgctxt "tcore.ahistory.caption"
     36msgid "Moves history"
     37msgstr "Historie pohybů"
     38
    3439#: tcore.anew.caption
    3540msgctxt "tcore.anew.caption"
     
    8186msgstr "Nápověda"
    8287
     88#: tformhistory.caption
     89msgctxt "tformhistory.caption"
     90msgid "Moves history"
     91msgstr "Historie pohybů"
     92
    8393#: tformmain.caption
    8494msgid "2048"
  • trunk/Languages/Game2048.po

    r29 r31  
    2222msgstr ""
    2323
     24#: tcore.ahistory.caption
     25msgctxt "tcore.ahistory.caption"
     26msgid "Moves history"
     27msgstr ""
     28
    2429#: tcore.anew.caption
    2530msgctxt "tcore.anew.caption"
     
    7176msgstr ""
    7277
     78#: tformhistory.caption
     79msgctxt "tformhistory.caption"
     80msgid "Moves history"
     81msgstr ""
     82
    7383#: tformmain.caption
    7484msgid "2048"
  • trunk/UCore.lfm

    r29 r31  
    7676      ShortCut = 115
    7777    end
     78    object AHistory: TAction
     79      Caption = 'Moves history'
     80      OnExecute = AHistoryExecute
     81    end
    7882  end
    7983end
  • trunk/UCore.lrj

    r29 r31  
    66{"hash":378031,"name":"tcore.aundo.caption","sourcebytes":[85,110,100,111],"value":"Undo"},
    77{"hash":322608,"name":"tcore.ahelp.caption","sourcebytes":[72,101,108,112],"value":"Help"},
    8 {"hash":1113,"name":"tcore.acomputer.caption","sourcebytes":[65,73],"value":"AI"}
     8{"hash":1113,"name":"tcore.acomputer.caption","sourcebytes":[65,73],"value":"AI"},
     9{"hash":191263657,"name":"tcore.ahistory.caption","sourcebytes":[77,111,118,101,115,32,104,105,115,116,111,114,121],"value":"Moves history"}
    910]}
  • trunk/UCore.pas

    r29 r31  
    1616    AAbout: TAction;
    1717    AComputer: TAction;
     18    AHistory: TAction;
    1819    AHelp: TAction;
    1920    AUndo: TAction;
     
    3031    procedure AExitExecute(Sender: TObject);
    3132    procedure AHelpExecute(Sender: TObject);
     33    procedure AHistoryExecute(Sender: TObject);
    3234    procedure ANewExecute(Sender: TObject);
    3335    procedure ASettingsExecute(Sender: TObject);
     
    5456
    5557uses
    56   UFormMain, UFormSettings, UFormAbout, UFormNew, UFormHelp, UFormComputer;
     58  UFormMain, UFormSettings, UFormAbout, UFormNew, UFormHelp, UFormComputer,
     59  UFormHistory;
    5760
    5861resourcestring
     
    131134end;
    132135
     136procedure TCore.AHistoryExecute(Sender: TObject);
     137begin
     138  FormHistory := TFormHistory.Create(nil);
     139  try
     140    FormHistory.ShowModal;
     141  finally
     142    FreeAndNil(FormHistory);
     143  end;
     144end;
     145
    133146procedure TCore.ANewExecute(Sender: TObject);
    134147begin
  • trunk/UGame.pas

    r30 r31  
    1010
    1111type
     12  TGame = class;
     13  TMoveDirection = (drNone, drLeft, drUp, drRight, drDown);
    1214
    1315  { TTile }
    1416
    1517  TTile = class
     18    Index: TPoint;
    1619    Value: Integer;
    1720    NewValue: Integer;
     
    3235    function Create(P1, P2: TPoint): TArea; overload;
    3336    function Create(X1, Y1, X2, Y2: Integer): TArea; overload;
     37  end;
     38
     39  { THistoryMove }
     40
     41  THistoryMove = class
     42    Direction: TMoveDirection;
     43    NewItemPos: TPoint;
     44    NewItemValue: Integer;
     45    procedure SaveToRegistry(RegContext: TRegistryContext);
     46    procedure LoadFromRegistry(RegContext: TRegistryContext);
     47  end;
     48
     49  { THistoryMoves }
     50
     51  THistoryMoves = class(TFPGObjectList<THistoryMove>)
     52    procedure SaveToRegistry(RegContext: TRegistryContext);
     53    procedure LoadFromRegistry(RegContext: TRegistryContext);
     54  end;
     55
     56  { THistory }
     57
     58  THistory = class
     59    Game: TGame;
     60    Moves: THistoryMoves;
     61    InitialTilesPos: array of TPoint;
     62    procedure GetStep(GameStep: TGame; Step: Integer);
     63    constructor Create;
     64    destructor Destroy; override;
     65    procedure SaveToRegistry(RegContext: TRegistryContext);
     66    procedure LoadFromRegistry(RegContext: TRegistryContext);
    3467  end;
    3568
     
    5588  end;
    5689
    57   TDirection = (drLeft, drUp, drRight, drDown);
    58 
    5990  { TGame }
    6091
     
    75106    procedure GameOver;
    76107    procedure Win;
    77     function FillRandomTile(Value4Change: Double = 0.1): Integer;
    78     function GetMoveArea(Direction: TDirection): TArea;
     108    function FillRandomTile(Value4Change: Double = 0.1): TTile;
     109    function GetMoveArea(Direction: TMoveDirection): TArea;
    79110  public
    80111    Board: TBoard;
     
    83114    WinScore: Integer;
    84115    UndoEnabled: Boolean;
     116    History: THistory;
    85117    function CanUndo: Boolean;
    86118    procedure Undo;
    87     function CanMergeDirection(Direction: TDirection): Boolean;
    88     function CanMoveDirection(Direction: TDirection): Boolean;
     119    function CanMergeDirection(Direction: TMoveDirection): Boolean;
     120    function CanMoveDirection(Direction: TMoveDirection): Boolean;
    89121    function CanMove: Boolean;
    90122    procedure Assign(Source: TGame);
    91123    procedure New;
    92124    procedure Render(Canvas: TCanvas; CanvasSize: TPoint);
    93     procedure MoveAll(Direction: TDirection);
    94     procedure MoveAllAndUpdate(Direction: TDirection);
     125    procedure MoveAll(Direction: TMoveDirection);
     126    procedure MoveAllAndUpdate(Direction: TMoveDirection);
    95127    procedure MoveTile(SourceTile, TargetTile: TTile);
    96128    function IsValidPos(Pos: TPoint): Boolean;
     
    111143
    112144const
    113   DirectionDiff: array[TDirection] of TPoint = (
    114     (X: -1; Y: 0), (X: 0; Y: -1), (X: 1; Y: 0), (X: 0; Y: 1)
     145  DirectionDiff: array[TMoveDirection] of TPoint = (
     146    (X: 0; Y: 0), (X: -1; Y: 0), (X: 0; Y: -1), (X: 1; Y: 0), (X: 0; Y: 1)
    115147  );
    116   DirectionText: array[TDirection] of string = ('Left', 'Up', 'Right', 'Down');
     148  DirectionText: array[TMoveDirection] of string = ('None', 'Left', 'Up', 'Right', 'Down');
    117149
    118150resourcestring
     
    121153
    122154implementation
     155
     156{ THistoryMoves }
     157
     158procedure THistoryMoves.SaveToRegistry(RegContext: TRegistryContext);
     159var
     160  I: Integer;
     161begin
     162  with TRegistryEx.Create do
     163  try
     164    CurrentContext := RegContext;
     165    WriteInteger('Count', Count);
     166    for I := 0 to Count - 1 do begin
     167      Items[I].SaveToRegistry(TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '/' + IntToStr(I)));
     168    end;
     169  finally
     170    Free;
     171  end;
     172end;
     173
     174procedure THistoryMoves.LoadFromRegistry(RegContext: TRegistryContext);
     175var
     176  I: Integer;
     177  C: Integer;
     178  HistoryMove: THistoryMove;
     179begin
     180  with TRegistryEx.Create do
     181  try
     182    CurrentContext := RegContext;
     183    C := ReadIntegerWithDefault('Count', 0);
     184    for I := 0 to C - 1 do begin
     185      HistoryMove := THistoryMove.Create;
     186      Add(HistoryMove);
     187      HistoryMove.LoadFromRegistry(TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '/' + IntToStr(I)));
     188    end;
     189  finally
     190    Free;
     191  end;
     192end;
     193
     194{ THistoryMove }
     195
     196procedure THistoryMove.SaveToRegistry(RegContext: TRegistryContext);
     197begin
     198  with TRegistryEx.Create do
     199  try
     200    CurrentContext := RegContext;
     201    WriteInteger('Direction', Integer(Direction));
     202    WriteInteger('NewItemPosX', NewItemPos.X);
     203    WriteInteger('NewItemPosY', NewItemPos.Y);
     204    WriteInteger('NewItemValue', NewItemValue);
     205  finally
     206    Free;
     207  end;
     208end;
     209
     210procedure THistoryMove.LoadFromRegistry(RegContext: TRegistryContext);
     211begin
     212  with TRegistryEx.Create do
     213  try
     214    CurrentContext := RegContext;
     215    Direction := TMoveDirection(ReadIntegerWithDefault('Direction', Integer(drNone)));
     216    NewItemPos := Point(ReadIntegerWithDefault('NewItemPosX', 0),
     217      ReadIntegerWithDefault('NewItemPosY', 0));
     218    NewItemValue := ReadIntegerWithDefault('NewItemValue', 0);
     219  finally
     220    Free;
     221  end;
     222end;
     223
     224{ THistory }
     225
     226procedure THistory.GetStep(GameStep: TGame; Step: Integer);
     227var
     228  I: Integer;
     229begin
     230  GameStep.Board.Size := Game.Board.Size;
     231  GameStep.Board.Clear;
     232  GameStep.Score := 0;
     233  for I := 0 to Length(InitialTilesPos) - 1 do
     234    GameStep.Board.Tiles[InitialTilesPos[I].Y, InitialTilesPos[I].X].Value := 2;
     235  for I := 0 to Step - 1 do
     236  with Moves[I] do begin
     237    GameStep.MoveAll(Direction);
     238    if GameStep.Board.Tiles[NewItemPos.Y, NewItemPos.X].Value = 0 then
     239      GameStep.Board.Tiles[NewItemPos.Y, NewItemPos.X].Value := NewItemValue
     240      else raise Exception.Create('Tile should be empty');
     241  end;
     242end;
     243
     244constructor THistory.Create;
     245begin
     246  Moves := THistoryMoves.Create;
     247end;
     248
     249destructor THistory.Destroy;
     250begin
     251  FreeAndNil(Moves);
     252  inherited Destroy;
     253end;
     254
     255procedure THistory.SaveToRegistry(RegContext: TRegistryContext);
     256var
     257  I: Integer;
     258begin
     259  with TRegistryEx.Create do
     260  try
     261    CurrentContext := TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\InitialTilesPos');
     262    WriteInteger('Count', Length(InitialTilesPos));
     263    for I := 0 to Length(InitialTilesPos) - 1 do begin
     264      WriteInteger('X' + IntToStr(I), InitialTilesPos[I].X);
     265      WriteInteger('Y' + IntToStr(I), InitialTilesPos[I].Y);
     266    end;
     267  finally
     268    Free;
     269  end;
     270  Moves.SaveToRegistry(RegContext);
     271end;
     272
     273procedure THistory.LoadFromRegistry(RegContext: TRegistryContext);
     274var
     275  I: Integer;
     276begin
     277  with TRegistryEx.Create do
     278  try
     279    CurrentContext := TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\InitialTilesPos');
     280    SetLength(InitialTilesPos, ReadIntegerWithDefault('Count', 0));
     281    for I := 0 to Length(InitialTilesPos) - 1 do begin
     282      InitialTilesPos[I] := Point(ReadIntegerWithDefault('X' + IntToStr(I), 0),
     283        ReadIntegerWithDefault('Y' + IntToStr(I), 0));
     284    end;
     285  finally
     286    Free;
     287  end;
     288  Moves.LoadFromRegistry(RegContext);
     289end;
    123290
    124291{ TArea }
     
    154321  SetLength(Tiles, FSize.Y, FSize.X);
    155322  for Y := 0 to FSize.Y - 1 do
    156     for X := 0 to FSize.X - 1 do
     323    for X := 0 to FSize.X - 1 do begin
    157324      Tiles[Y, X] := TTile.Create;
     325      Tiles[Y, X].Index := Point(X, Y);
     326    end;
    158327end;
    159328
     
    228397      end;
    229398    end;
     399    Lines.Free;
     400    Items.Free;
    230401  finally
    231402    Free;
     
    315486end;
    316487
    317 function TGame.FillRandomTile(Value4Change: Double = 0.1): Integer;
     488function TGame.FillRandomTile(Value4Change: Double = 0.1): TTile;
    318489var
    319490  EmptyTiles: TTiles;
    320491  NewValue: Integer;
    321492begin
    322   Result := 0;
     493  Result := nil;
    323494  EmptyTiles := TTiles.Create(False);
    324495  Board.GetEmptyTiles(EmptyTiles);
    325496  if EmptyTiles.Count > 0 then begin
    326497    if Random < Value4Change then NewValue := 4 else NewValue := 2;
    327     EmptyTiles[Random(EmptyTiles.Count)].Value := NewValue;
    328     Result := 1;
     498    Result := EmptyTiles[Random(EmptyTiles.Count)];
     499    Result.Value := NewValue;
    329500  end;
    330501  EmptyTiles.Free;
    331502end;
    332503
    333 function TGame.GetMoveArea(Direction: TDirection): TArea;
     504function TGame.GetMoveArea(Direction: TMoveDirection): TArea;
    334505begin
    335506  case Direction of
     
    371542var
    372543  I: Integer;
     544  NewTile: TTile;
    373545begin
    374546  FCanUndo := False;
     
    376548  Score := 0;
    377549  Running := True;
    378   for I := 0 to 1 do FillRandomTile(0);
     550  with History do begin
     551    Moves.Clear;
     552
     553    SetLength(InitialTilesPos, 0);
     554    for I := 0 to 1 do begin
     555      NewTile := FillRandomTile(0);
     556      SetLength(InitialTilesPos, Length(InitialTilesPos) + 1);
     557      InitialTilesPos[Length(InitialTilesPos) - 1] := NewTile.Index;
     558    end;
     559  end;
    379560  DoChange;
    380561end;
     
    484665end;
    485666
    486 function TGame.CanMergeDirection(Direction: TDirection): Boolean;
     667function TGame.CanMergeDirection(Direction: TMoveDirection): Boolean;
    487668var
    488669  P: TPoint;
     
    495676  for I := 0 to Max(Board.Size.X, Board.Size.Y) - 1 do begin
    496677    P := Area.P1;
    497     while P.Y <> Area.P2.Y do begin
     678    while P.Y <> Area.P2.Y + Area.Increment.Y do begin
    498679      P.X := Area.P1.X;
    499       while P.X <> Area.P2.X do begin
     680      while P.X <> Area.P2.X + Area.Increment.X do begin
    500681        PNew := P + DirectionDiff[Direction];
    501682        if IsValidPos(PNew) then begin
     
    519700end;
    520701
    521 function TGame.CanMoveDirection(Direction: TDirection): Boolean;
     702function TGame.CanMoveDirection(Direction: TMoveDirection): Boolean;
    522703var
    523704  P: TPoint;
     
    548729end;
    549730
    550 procedure TGame.MoveAll(Direction: TDirection);
     731procedure TGame.MoveAll(Direction: TMoveDirection);
    551732var
    552733  P: TPoint;
     
    560741  Area: TArea;
    561742begin
     743  if Direction = drNone then Exit;
    562744  if not CanMoveDirection(Direction) then Exit;
    563745  FMoving := True;
     
    634816end;
    635817
    636 procedure TGame.MoveAllAndUpdate(Direction: TDirection);
     818procedure TGame.MoveAllAndUpdate(Direction: TMoveDirection);
    637819var
    638820  HighestValue: Integer;
     821  HistoryMove: THistoryMove;
     822  NewTile: TTile;
    639823begin
    640824  HighestValue := Board.GetHighestTileValue;
    641825  MoveAll(Direction);
    642   FillRandomTile;
     826
     827  NewTile := FillRandomTile;
     828  HistoryMove := THistoryMove.Create;
     829  HistoryMove.Direction := Direction;
     830  HistoryMove.NewItemPos := NewTile.Index;
     831  HistoryMove.NewItemValue := NewTile.Value;
     832  History.Moves.Add(HistoryMove);
     833
    643834  if not CanMove and (Board.GetEmptyTilesCount = 0) then
    644835    GameOver;
     
    678869  FBoardUndo.SaveToRegistry(TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo'));
    679870  Board.SaveToRegistry(TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board'));
     871  History.SaveToRegistry(TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\History'));
    680872end;
    681873
     
    696888  FBoardUndo.LoadFromRegistry(TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo'));
    697889  Board.LoadFromRegistry(TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board'));
     890  History.LoadFromRegistry(TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\History'));
    698891  DoChange;
    699892end;
     
    705898  Board := TBoard.Create;
    706899  FBoardUndo := TBoard.Create;
     900  History := THistory.Create;
     901  History.Game := Self;
    707902end;
    708903
    709904destructor TGame.Destroy;
    710905begin
     906  FreeAndNil(History);
    711907  FreeAndNil(FBoardUndo);
    712908  FreeAndNil(Board);
Note: See TracChangeset for help on using the changeset viewer.