Changeset 20 for trunk


Ignore:
Timestamp:
Oct 5, 2019, 2:00:50 PM (5 years ago)
Author:
chronos
Message:
  • Added: Player can undo last move.
  • Modified: Optimized code of TGame.CanMove method.
Location:
trunk
Files:
10 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormMain.lfm

    r11 r20  
    2020      Caption = 'Game'
    2121      object MenuItemNew: TMenuItem
    22         Action = Core.AGameNew
     22        Action = Core.ANew
     23      end
     24      object MenuItem2: TMenuItem
     25        Action = Core.AUndo
    2326      end
    2427      object MenuItem1: TMenuItem

  • trunk/Forms/UFormMain.pas

    r19 r20  
    1616    MainMenu1: TMainMenu;
    1717    MenuItem1: TMenuItem;
     18    MenuItem2: TMenuItem;
    1819    MenuItemNew: TMenuItem;
    1920    MenuItemExit: TMenuItem;
    … …  
    4849
    4950procedure TFormMain.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    50 var
    51   MovedCount: Integer;
    5251begin
    5352  if Core.Game.Running and not Core.Game.Moving then begin
    54     MovedCount := 0;
    5553    case Key of
    56       37: MovedCount := Core.Game.MoveAll(drLeft);
    57       38: MovedCount := Core.Game.MoveAll(drUp);
    58       39: MovedCount := Core.Game.MoveAll(drRight);
    59       40: MovedCount := Core.Game.MoveAll(drDown);
     54      37: Core.Game.MoveAll(drLeft);
     55      38: Core.Game.MoveAll(drUp);
     56      39: Core.Game.MoveAll(drRight);
     57      40: Core.Game.MoveAll(drDown);
    6058    end;
    61     if MovedCount > 0 then Core.Game.FillRandomTile;
    62     if not Core.Game.CanMove and (Core.Game.Board.GetEmptyTilesCount = 0) then
    63       Core.Game.GameOver;
    64     if (not Core.Game.Won) and (Core.Game.Board.GetHighestTileValue >= 2048) then
    65       Core.Game.Win;
    6659  end;
    6760end;

  • trunk/Forms/UFormNew.lfm

    r15 r20  
    2525    ItemHeight = 0
    2626    Items.Strings = (
     27      '2 x 2'
    2728      '3 x 3'
    2829      '4 x 4'

  • trunk/Forms/UFormNew.pas

    r17 r20  
    4545procedure TFormNew.Load(Game: TGame);
    4646begin
    47   ComboBoxSize.ItemIndex := Game.Board.Size.X - 3;
     47  ComboBoxSize.ItemIndex := Game.Board.Size.X - 2;
    4848end;
    4949
    5050procedure TFormNew.Save(Game: TGame);
    5151begin
    52   Game.Board.Size := Point(3 + ComboBoxSize.ItemIndex, 3 + ComboBoxSize.ItemIndex);
     52  Game.Board.Size := Point(2 + ComboBoxSize.ItemIndex, 2 + ComboBoxSize.ItemIndex);
    5353end;
    5454

  • trunk/Languages/Game2048.cs.po

    r19 r20  
    2222msgstr "Ukončít"
    2323
    24 #: tcore.agamenew.caption
    25 msgctxt "tcore.agamenew.caption"
     24#: tcore.anew.caption
     25#, fuzzy
     26msgctxt "tcore.anew.caption"
    2627msgid "New..."
    2728msgstr "Nová..."
    … …  
    3132msgid "Settings"
    3233msgstr "Nastavení"
     34
     35#: tcore.aundo.caption
     36msgid "Undo"
     37msgstr ""
    3338
    3439#: tformabout.buttonclose.caption
    … …  
    149154msgid "You won! Do you want to continue to play?"
    150155msgstr "Vyhrál jsi! Chceš pokračovat ve hře?"
     156

  • trunk/Languages/Game2048.po

    r19 r20  
    1212msgstr ""
    1313
    14 #: tcore.agamenew.caption
    15 msgctxt "tcore.agamenew.caption"
     14#: tcore.anew.caption
     15msgctxt "tcore.anew.caption"
    1616msgid "New..."
    1717msgstr ""
    … …  
    2020msgctxt "tcore.asettings.caption"
    2121msgid "Settings"
     22msgstr ""
     23
     24#: tcore.aundo.caption
     25msgid "Undo"
    2226msgstr ""
    2327

  • trunk/UCore.lfm

    r18 r20  
    4343    left = 420
    4444    top = 184
    45     object AGameNew: TAction
     45    object ANew: TAction
    4646      Caption = 'New...'
    47       OnExecute = AGameNewExecute
     47      OnExecute = ANewExecute
     48      ShortCut = 113
    4849    end
    4950    object AExit: TAction
    … …  
    5859      Caption = 'Settings'
    5960      OnExecute = ASettingsExecute
     61      ShortCut = 120
     62    end
     63    object AUndo: TAction
     64      Caption = 'Undo'
     65      OnExecute = AUndoExecute
     66      ShortCut = 114
    6067    end
    6168  end

  • trunk/UCore.lrj

    r11 r20  
    11{"version":1,"strings":[
    2 {"hash":88908046,"name":"tcore.agamenew.caption","sourcebytes":[78,101,119,46,46,46],"value":"New..."},
     2{"hash":88908046,"name":"tcore.anew.caption","sourcebytes":[78,101,119,46,46,46],"value":"New..."},
    33{"hash":315140,"name":"tcore.aexit.caption","sourcebytes":[69,120,105,116],"value":"Exit"},
    44{"hash":4691652,"name":"tcore.aabout.caption","sourcebytes":[65,98,111,117,116],"value":"About"},
    5 {"hash":213582195,"name":"tcore.asettings.caption","sourcebytes":[83,101,116,116,105,110,103,115],"value":"Settings"}
     5{"hash":213582195,"name":"tcore.asettings.caption","sourcebytes":[83,101,116,116,105,110,103,115],"value":"Settings"},
     6{"hash":378031,"name":"tcore.aundo.caption","sourcebytes":[85,110,100,111],"value":"Undo"}
    67]}

  • trunk/UCore.pas

    r19 r20  
    1515  TCore = class(TDataModule)
    1616    AAbout: TAction;
     17    AUndo: TAction;
    1718    ASettings: TAction;
    1819    ActionList1: TActionList;
    1920    AExit: TAction;
    20     AGameNew: TAction;
     21    ANew: TAction;
    2122    ApplicationInfo1: TApplicationInfo;
    2223    PersistentForm1: TPersistentForm;
    … …  
    2526    procedure AAboutExecute(Sender: TObject);
    2627    procedure AExitExecute(Sender: TObject);
    27     procedure AGameNewExecute(Sender: TObject);
     28    procedure ANewExecute(Sender: TObject);
    2829    procedure ASettingsExecute(Sender: TObject);
     30    procedure AUndoExecute(Sender: TObject);
    2931    procedure DataModuleCreate(Sender: TObject);
    3032    procedure DataModuleDestroy(Sender: TObject);
    … …  
    3335  public
    3436    Game: TGame;
     37    procedure UpdateInterface;
    3538    procedure LoadConfig;
    3639    procedure SaveConfig;
    … …  
    6871end;
    6972
     73procedure TCore.AUndoExecute(Sender: TObject);
     74begin
     75  Game.Undo;
     76end;
     77
    7078procedure TCore.AAboutExecute(Sender: TObject);
    7179begin
    … …  
    8492end;
    8593
    86 procedure TCore.AGameNewExecute(Sender: TObject);
     94procedure TCore.ANewExecute(Sender: TObject);
    8795begin
    8896  FormNew := TFormNew.Create(nil);
    … …  
    107115begin
    108116  FormMain.Redraw;
     117  UpdateInterface;
     118end;
     119
     120procedure TCore.UpdateInterface;
     121begin
     122  AUndo.Enabled := Game.CanUndo;;
    109123end;
    110124

  • trunk/UGame.pas

    r19 r20  
    5555    FRunning: Boolean;
    5656    FScore: Integer;
     57    FCanUndo: Boolean;
     58    FBoardUndo: TBoard;
     59    function CanMoveDirection(Direction: TDirection): Boolean;
    5760    function GetTileColor(Value: Integer): TColor;
    5861    procedure SetScore(AValue: Integer);
    5962    procedure DoChange;
    6063    procedure RenderTile(Canvas: TCanvas; Tile: TTile; TileRect: TRect);
     64    procedure GameOver;
     65    procedure Win;
     66    function FillRandomTile: Integer;
    6167  public
    6268    Board: TBoard;
    6369    TopScore: Integer;
    6470    AnimationDuration: Integer;
    65     Won: Boolean;
    66     procedure GameOver;
    67     procedure Win;
    68     function FillRandomTile: Integer;
     71    WinScore: Integer;
     72    function CanUndo: Boolean;
     73    procedure Undo;
    6974    function CanMove: Boolean;
    7075    procedure Assign(Source: TGame);
    … …  
    146151    CurrentContext := RegContext;
    147152
     153    WriteInteger('SizeX', Size.X);
     154    WriteInteger('SizeY', Size.Y);
    148155    Value := '';
    149156    for Y := 0 to Size.Y - 1 do begin
    … …  
    171178    CurrentContext := RegContext;
    172179
     180    Size := Point(ReadIntegerWithDefault('SizeX', 4), ReadIntegerWithDefault('SizeY', 4));
    173181    Items := TStringList.Create;
    174182    Items.Delimiter := ',';
    … …  
    257265procedure TGame.Win;
    258266begin
    259   if not Won then begin
    260     Won := True;
    261     if MessageDlg(SWinCaption, SWinMessage, mtConfirmation,
    262     mbYesNo, 0) = mrNo then begin
    263       Running := False;
    264     end;
     267  if MessageDlg(SWinCaption, SWinMessage, mtConfirmation,
     268  mbYesNo, 0) = mrNo then begin
     269    Running := False;
    265270  end;
    266271end;
    … …  
    281286
    282287function TGame.CanMove: Boolean;
    283 var
    284   TempGame: TGame;
    285 begin
    286   Result := False;
    287   TempGame := TGame.Create;
    288   try
    289     TempGame.Assign(Self);
    290     TempGame.AnimationDuration := 0;
    291     Result := TempGame.MoveAll(drDown) > 0;
    292     if Result then Exit;
    293     Result := TempGame.MoveAll(drUp) > 0;
    294     if Result then Exit;
    295     Result := TempGame.MoveAll(drRight) > 0;
    296     if Result then Exit;
    297     Result := TempGame.MoveAll(drLeft) > 0;
    298   finally
    299     TempGame.Free;
    300   end;
     288begin
     289  Result := CanMoveDirection(drLeft) or CanMoveDirection(drRight) or
     290    CanMoveDirection(drUp) or CanMoveDirection(drDown);
    301291end;
    302292
    303293procedure TGame.Assign(Source: TGame);
    304 var
    305   X, Y: Integer;
    306294begin
    307295  FScore := Source.FScore;
    308296  TopScore := Source.TopScore;
    309297  AnimationDuration := Source.AnimationDuration;
    310   Won := Source.Won;
    311298  Board.Assign(Source.Board);
    312299end;
    … …  
    316303  I: Integer;
    317304begin
     305  FCanUndo := False;
    318306  Board.Clear;
    319307  Score := 0;
    320   Won := False;
    321308  Running := True;
    322309  for I := 0 to 1 do FillRandomTile;
    … …  
    413400end;
    414401
     402function TGame.CanUndo: Boolean;
     403begin
     404  Result := FCanUndo;
     405end;
     406
     407procedure TGame.Undo;
     408begin
     409  if CanUndo then begin
     410    Board.Assign(FBoardUndo);
     411    FCanUndo := False;
     412    FRunning := CanMove;
     413    DoChange;
     414  end;
     415end;
     416
     417function TGame.CanMoveDirection(Direction: TDirection): Boolean;
     418var
     419  StartPoint: TPoint;
     420  AreaSize: TPoint;
     421  Increment: TPoint;
     422  P: TPoint;
     423  PNew: TPoint;
     424  PI: TPoint;
     425begin
     426  Result := False;
     427  case Direction of
     428    drLeft: begin
     429      StartPoint := Point(1, 0);
     430      AreaSize := Point(Board.Size.X - 2, Board.Size.Y - 1);
     431      Increment := Point(1, 1);
     432    end;
     433    drUp: begin
     434      StartPoint := Point(0, 1);
     435      AreaSize := Point(Board.Size.X - 1, Board.Size.Y - 2);
     436      Increment := Point(1, 1);
     437    end;
     438    drRight: begin
     439      StartPoint := Point(Board.Size.X - 2, 0);
     440      AreaSize := Point(Board.Size.X - 2, Board.Size.Y - 1);
     441      Increment := Point(-1, 1);
     442    end;
     443    drDown: begin
     444      StartPoint := Point(0, Board.Size.Y - 2);
     445      AreaSize := Point(Board.Size.X - 1, Board.Size.Y - 2);
     446      Increment := Point(1, -1);
     447    end;
     448  end;
     449
     450  PI.Y := 0;
     451  while PI.Y <= AreaSize.Y do begin
     452    PI.X := 0;
     453    while PI.X <= AreaSize.X do begin
     454      P := Point(StartPoint.X + PI.X * Increment.X, StartPoint.Y + PI.Y * Increment.Y);
     455      PNew.X := P.X + DirectionDiff[Direction].X;
     456      PNew.Y := P.Y + DirectionDiff[Direction].Y;
     457      if IsValidPos(PNew) then begin
     458        if (Board.Tiles[P.Y, P.X].Value <> 0) then begin
     459          if (Board.Tiles[PNew.Y, PNew.X].Value = 0) or
     460          (Board.Tiles[PNew.Y, PNew.X].Value = Board.Tiles[P.Y, P.X].Value) then begin
     461            Result := True;
     462            Break;
     463          end;
     464        end;
     465        P.X := PNew.X;
     466        P.Y := PNew.Y;
     467        PNew.X := P.X + DirectionDiff[Direction].X;
     468        PNew.Y := P.Y + DirectionDiff[Direction].Y;
     469      end;
     470      Inc(PI.X);
     471    end;
     472    if Result then Break;
     473    Inc(PI.Y);
     474  end;
     475end;
    415476
    416477function TGame.MoveAll(Direction: TDirection): Integer;
    … …  
    430491  Time: TDateTime;
    431492  Part: Double;
     493  HighestValue: Integer;
    432494begin
    433495  FMoving := True;
     496  HighestValue := Board.GetHighestTileValue;
     497  FBoardUndo.Assign(Board);
     498  FCanUndo := True;
    434499  //Diff := DirectionDiff[Direction];
    435500  case Direction of
    … …  
    535600  end;
    536601  Result := MovedCount;
     602
     603  // Update state after move
     604  if MovedCount > 0 then FillRandomTile;
     605  if not CanMove and (Board.GetEmptyTilesCount = 0) then
     606    GameOver;
     607  if (HighestValue < WinScore) and
     608  (Board.GetHighestTileValue >= WinScore) then Win;
     609
    537610  FMoving := False;
    538611end;
    … …  
    560633    WriteInteger('TopScore', TopScore);
    561634    WriteInteger('AnimationDuration', AnimationDuration);
    562     WriteInteger('SizeX', Board.Size.X);
    563     WriteInteger('SizeY', Board.Size.Y);
    564635    WriteInteger('Score', Score);
    565636    WriteBool('GameRunning', FRunning);
    566     WriteBool('Won', Won);
     637    WriteBool('CanUndo', FCanUndo);
    567638  finally
    568639    Free;
    569640  end;
    570   Board.SaveToRegistry(RegContext);
     641  FBoardUndo.SaveToRegistry(TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo'));
     642  Board.SaveToRegistry(TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board'));
    571643end;
    572644
    … …  
    576648  try
    577649    CurrentContext := RegContext;
    578     Board.Size := Point(ReadIntegerWithDefault('SizeX', 4), ReadIntegerWithDefault('SizeY', 4));
    579650    AnimationDuration := ReadIntegerWithDefault('AnimationDuration', 30);
    580651    TopScore := ReadIntegerWithDefault('TopScore', 0);
    581652    Score := ReadIntegerWithDefault('Score', 0);
    582653    FRunning := ReadBoolWithDefault('GameRunning', False);
    583     Won := ReadBoolWithDefault('Won', False);
     654    FCanUndo := ReadBoolWithDefault('CanUndo', False);
    584655  finally
    585656    Free;
    586657  end;
    587   Board.LoadFromRegistry(RegContext);
     658  FBoardUndo.LoadFromRegistry(TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo'));
     659  Board.LoadFromRegistry(TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board'));
    588660end;
    589661
    … …  
    591663begin
    592664  AnimationDuration := 30;
     665  WinScore := 2048;
    593666  Board := TBoard.Create;
     667  FBoardUndo := TBoard.Create;
    594668end;
    595669
    596670destructor TGame.Destroy;
    597671begin
     672  FreeAndNil(FBoardUndo);
    598673  FreeAndNil(Board);
    599674  inherited;
Note: See TracChangeset for help on using the changeset viewer.