Changeset 29 for trunk


Ignore:
Timestamp:
Oct 6, 2019, 9:53:39 PM (5 years ago)
Author:
chronos
Message:
  • Added: Computer player accessible from Tools menu in Debug mode. It is not able to win game yet.
Location:
trunk
Files:
7 added
12 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormMain.lfm

    r28 r29  
    3232      end
    3333    end
     34    object MenuItemTools: TMenuItem
     35      Caption = 'Tools'
     36      object MenuItem4: TMenuItem
     37        Action = Core.AComputer
     38      end
     39    end
    3440    object MenuItemHelp: TMenuItem
    3541      Caption = 'Help'

  • trunk/Forms/UFormMain.lrj

    r28 r29  
    22{"hash":217976,"name":"tformmain.caption","sourcebytes":[50,48,52,56],"value":"2048"},
    33{"hash":317493,"name":"tformmain.menuitemgame.caption","sourcebytes":[71,97,109,101],"value":"Game"},
     4{"hash":5989939,"name":"tformmain.menuitemtools.caption","sourcebytes":[84,111,111,108,115],"value":"Tools"},
    45{"hash":322608,"name":"tformmain.menuitemhelp.caption","sourcebytes":[72,101,108,112],"value":"Help"}
    56]}

  • trunk/Forms/UFormMain.pas

    r28 r29  
    1818    MenuItem2: TMenuItem;
    1919    MenuItem3: TMenuItem;
     20    MenuItem4: TMenuItem;
     21    MenuItemTools: TMenuItem;
    2022    MenuItemNew: TMenuItem;
    2123    MenuItemExit: TMenuItem;
    … …  
    3537  public
    3638    procedure Redraw;
     39    procedure UpdateInterface;
    3740  end;
    3841
    … …  
    5356  if Core.Game.Running and not Core.Game.Moving then begin
    5457    case Key of
    55       37: Core.Game.MoveAll(drLeft);
    56       38: Core.Game.MoveAll(drUp);
    57       39: Core.Game.MoveAll(drRight);
    58       40: Core.Game.MoveAll(drDown);
     58      37: Core.Game.MoveAllAndUpdate(drLeft);
     59      38: Core.Game.MoveAllAndUpdate(drUp);
     60      39: Core.Game.MoveAllAndUpdate(drRight);
     61      40: Core.Game.MoveAllAndUpdate(drDown);
    5962    end;
    6063  end;
    … …  
    8588  if not Core.Game.Running then
    8689    Core.Game.New;
     90  UpdateInterface;
    8791end;
    8892
    … …  
    100104end;
    101105
     106procedure TFormMain.UpdateInterface;
     107var
     108  I: Integer;
     109  ToolsVisible: Boolean;
     110begin
     111  ToolsVisible := False;
     112  for I := 0 to MenuItemTools.Count - 1 do
     113    if MenuItemTools.Items[I].Enabled then begin
     114      ToolsVisible := True;
     115      Break;
     116    end;
     117  MenuItemTools.Visible := ToolsVisible;
     118end;
     119
    102120end.
    103121

  • trunk/Game2048.lpi

    r28 r29  
    8282      </Item2>
    8383    </RequiredPackages>
    84     <Units Count="8">
     84    <Units Count="9">
    8585      <Unit0>
    8686        <Filename Value="Game2048.lpr"/>
    … …  
    130130        <IsPartOfProject Value="True"/>
    131131        <ComponentName Value="FormHelp"/>
     132        <HasResources Value="True"/>
    132133        <ResourceBaseClass Value="Form"/>
    133134      </Unit7>
     135      <Unit8>
     136        <Filename Value="Forms/UFormComputer.pas"/>
     137        <IsPartOfProject Value="True"/>
     138        <ComponentName Value="FormComputer"/>
     139        <HasResources Value="True"/>
     140        <ResourceBaseClass Value="Form"/>
     141      </Unit8>
    134142    </Units>
    135143  </ProjectOptions>
    … …  
    173181      </Options>
    174182    </Linking>
     183    <Other>
     184      <CustomOptions Value="-dDEBUG"/>
     185    </Other>
    175186  </CompilerOptions>
    176187  <Debugging>

  • trunk/Game2048.lpr

    r28 r29  
    88  {$ENDIF}
    99  Interfaces, SysUtils,// this includes the LCL widgetset
    10   Forms, UGame, Common, UFormSettings, UFormMain, UCore, UFormHelp
     10  Forms, UGame, Common, UFormSettings, UFormMain, UCore, UFormHelp,
     11  UFormComputer
    1112  { you can add units after this };
    1213

  • trunk/Languages/Game2048.cs.po

    r28 r29  
    1717msgstr "O aplikaci"
    1818
     19#: tcore.acomputer.caption
     20msgctxt "tcore.acomputer.caption"
     21msgid "AI"
     22msgstr "AI"
     23
    1924#: tcore.aexit.caption
    2025msgctxt "tcore.aexit.caption"
    … …  
    6267msgstr "   "
    6368
     69#: tformcomputer.buttonsolve.caption
     70msgid "Solve"
     71msgstr "Vyřešit"
     72
     73#: tformcomputer.caption
     74msgctxt "tformcomputer.caption"
     75msgid "AI"
     76msgstr "AI"
     77
    6478#: tformhelp.caption
    6579msgctxt "tformhelp.caption"
    … …  
    8094msgstr "Nápověda"
    8195
     96#: tformmain.menuitemtools.caption
     97msgid "Tools"
     98msgstr "Nástroje"
     99
    82100#: tformnew.buttoncancel.caption
    83101msgctxt "tformnew.buttoncancel.caption"
    … …  
    125143msgstr "Jazyk:"
    126144
     145#: ucore.sgameovercaption
     146msgctxt "ucore.sgameovercaption"
     147msgid "Lost"
     148msgstr "Prohra"
     149
     150#: ucore.sgameovermessage
     151msgctxt "ucore.sgameovermessage"
     152msgid "Game over!"
     153msgstr "Konec hry!"
     154
     155#: ucore.swincaption
     156msgctxt "ucore.swincaption"
     157msgid "Win"
     158msgstr "Vítězství"
     159
     160#: ucore.swinmessage
     161msgctxt "ucore.swinmessage"
     162msgid "You reached %d and won! You can continue to play to get higher score."
     163msgstr "Dosáhl jsi %d a vyhrál! Můžeš pokračovat ve hře k dosažení vyššího skóre."
     164
    127165#: uformabout.slicense
    128166msgid "License"
    … …  
    165203msgstr "Změna jazyka"
    166204
    167 #: ugame.sgameovercaption
    168 msgid "Lost"
    169 msgstr "Prohra"
    170 
    171 #: ugame.sgameovermessage
    172 msgid "Game over!"
    173 msgstr "Konec hry!"
    174 
    175205#: ugame.sscore
    176206msgid "Score"
    … …  
    180210msgid "Top score"
    181211msgstr "Nejvyšší skóre"
    182 
    183 #: ugame.swincaption
    184 msgid "Win"
    185 msgstr "Vítězství"
    186 
    187 #: ugame.swinmessage
    188 msgid "You reached %d and won! You can continue to play to get higher score."
    189 msgstr "Dosáhl jsi %d a vyhrál! Můžeš pokračovat ve hře k dosažení vyššího skóre."

  • trunk/Languages/Game2048.po

    r28 r29  
    77msgstr ""
    88
     9#: tcore.acomputer.caption
     10msgctxt "tcore.acomputer.caption"
     11msgid "AI"
     12msgstr ""
     13
    914#: tcore.aexit.caption
    1015msgctxt "tcore.aexit.caption"
    … …  
    5257msgstr ""
    5358
     59#: tformcomputer.buttonsolve.caption
     60msgid "Solve"
     61msgstr ""
     62
     63#: tformcomputer.caption
     64msgctxt "tformcomputer.caption"
     65msgid "AI"
     66msgstr ""
     67
    5468#: tformhelp.caption
    5569msgctxt "tformhelp.caption"
    … …  
    7084msgstr ""
    7185
     86#: tformmain.menuitemtools.caption
     87msgid "Tools"
     88msgstr ""
     89
    7290#: tformnew.buttoncancel.caption
    7391msgctxt "tformnew.buttoncancel.caption"
    … …  
    115133msgstr ""
    116134
     135#: ucore.sgameovercaption
     136msgctxt "ucore.sgameovercaption"
     137msgid "Lost"
     138msgstr ""
     139
     140#: ucore.sgameovermessage
     141msgctxt "ucore.sgameovermessage"
     142msgid "Game over!"
     143msgstr ""
     144
     145#: ucore.swincaption
     146msgctxt "ucore.swincaption"
     147msgid "Win"
     148msgstr ""
     149
     150#: ucore.swinmessage
     151msgctxt "ucore.swinmessage"
     152msgid "You reached %d and won! You can continue to play to get higher score."
     153msgstr ""
     154
    117155#: uformabout.slicense
    118156msgid "License"
    … …  
    155193msgstr ""
    156194
    157 #: ugame.sgameovercaption
    158 msgid "Lost"
    159 msgstr ""
    160 
    161 #: ugame.sgameovermessage
    162 msgid "Game over!"
    163 msgstr ""
    164 
    165195#: ugame.sscore
    166196msgid "Score"
    … …  
    171201msgstr ""
    172202
    173 #: ugame.swincaption
    174 msgid "Win"
    175 msgstr ""
    176 
    177 #: ugame.swinmessage
    178 msgid "You reached %d and won! You can continue to play to get higher score."
    179 msgstr ""
    180 

  • trunk/UCore.lfm

    r28 r29  
    7171      ShortCut = 112
    7272    end
     73    object AComputer: TAction
     74      Caption = 'AI'
     75      OnExecute = AComputerExecute
     76      ShortCut = 115
     77    end
    7378  end
    7479end

  • trunk/UCore.lrj

    r28 r29  
    55{"hash":213582195,"name":"tcore.asettings.caption","sourcebytes":[83,101,116,116,105,110,103,115],"value":"Settings"},
    66{"hash":378031,"name":"tcore.aundo.caption","sourcebytes":[85,110,100,111],"value":"Undo"},
    7 {"hash":322608,"name":"tcore.ahelp.caption","sourcebytes":[72,101,108,112],"value":"Help"}
     7{"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"}
    89]}

  • trunk/UCore.pas

    r28 r29  
    77uses
    88  Classes, SysUtils, UTheme, UPersistentForm, UApplicationInfo, UTranslator,
    9   URegistry, UGame, ActnList, Forms, Controls;
     9  URegistry, UGame, ActnList, Forms, Controls, Dialogs;
    1010
    1111type
    … …  
    1515  TCore = class(TDataModule)
    1616    AAbout: TAction;
     17    AComputer: TAction;
    1718    AHelp: TAction;
    1819    AUndo: TAction;
    … …  
    2627    Translator1: TTranslator;
    2728    procedure AAboutExecute(Sender: TObject);
     29    procedure AComputerExecute(Sender: TObject);
    2830    procedure AExitExecute(Sender: TObject);
    2931    procedure AHelpExecute(Sender: TObject);
    … …  
    3537  private
    3638    procedure GameChange(Sender: TObject);
     39    procedure GameWin(Sender: TObject);
     40    procedure GameOver(Sender: TObject);
    3741  public
    3842    Game: TGame;
    … …  
    5054
    5155uses
    52   UFormMain, UFormSettings, UFormAbout, UFormNew, UFormHelp;
     56  UFormMain, UFormSettings, UFormAbout, UFormNew, UFormHelp, UFormComputer;
     57
     58resourcestring
     59  SGameOverCaption = 'Lost';
     60  SGameOverMessage = 'Game over!';
     61  SWinCaption = 'Win';
     62  SWinMessage = 'You reached %d and won! You can continue to play to get higher score.';
    5363
    5464{ TCore }
    … …  
    6676  Game.Board.Size := Point(4, 4);
    6777  Game.OnChange := GameChange;
     78  Game.OnWin := GameWin;
    6879  LoadConfig;
    6980end;
    … …  
    92103  finally
    93104    FreeAndNil(FormAbout);
     105  end;
     106end;
     107
     108procedure TCore.AComputerExecute(Sender: TObject);
     109begin
     110  FormComputer := TFormComputer.Create(nil);
     111  try
     112    FormComputer.ShowModal;
     113  finally
     114    FreeAndNil(FormComputer);
    94115  end;
    95116end;
    … …  
    136157end;
    137158
     159procedure TCore.GameWin(Sender: TObject);
     160begin
     161  MessageDlg(SWinCaption, Format(SWinMessage, [Game.WinScore]), mtInformation, [mbOk], 0);
     162end;
     163
     164procedure TCore.GameOver(Sender: TObject);
     165begin
     166  MessageDlg(SGameOverCaption, SGameOverMessage, mtInformation, [mbOK], 0);
     167end;
     168
    138169procedure TCore.UpdateInterface;
    139170begin
    140171  AUndo.Enabled := Game.CanUndo;
     172  {$IFDEF DEBUG}
     173  AComputer.Enabled := True;
     174  {$ELSE}
     175  AComputer.Enabled := False;
     176  {$ENDIF}
    141177end;
    142178

  • trunk/UGame.pas

    r28 r29  
    3636    procedure Clear;
    3737    procedure ClearMerged;
     38    function GetValueSum: Integer;
    3839    function GetHighestTileValue: Integer;
    3940    function GetEmptyTilesCount: Integer;
    … …  
    5354    FMoving: Boolean;
    5455    FOnChange: TNotifyEvent;
     56    FOnGameOver: TNotifyEvent;
     57    FOnWin: TNotifyEvent;
    5558    FRunning: Boolean;
    5659    FScore: Integer;
    5760    FCanUndo: Boolean;
    5861    FBoardUndo: TBoard;
    59     function CanMoveDirection(Direction: TDirection): Boolean;
    6062    function GetTileColor(Value: Integer): TColor;
    6163    procedure SetScore(AValue: Integer);
    … …  
    7375    function CanUndo: Boolean;
    7476    procedure Undo;
     77    function CanMergeDirection(Direction: TDirection): Boolean;
     78    function CanMoveDirection(Direction: TDirection): Boolean;
    7579    function CanMove: Boolean;
    7680    procedure Assign(Source: TGame);
    … …  
    7882    procedure Render(Canvas: TCanvas; CanvasSize: TPoint);
    7983    procedure MoveAll(Direction: TDirection);
     84    procedure MoveAllAndUpdate(Direction: TDirection);
    8085    procedure MoveTile(SourceTile, TargetTile: TTile);
    8186    function IsValidPos(Pos: TPoint): Boolean;
    … …  
    8792    property Running: Boolean read FRunning write FRunning;
    8893    property OnChange: TNotifyEvent read FOnChange write FOnChange;
     94    property OnWin: TNotifyEvent read FOnWin write FOnWin;
     95    property OnGameOver: TNotifyEvent read FOnGameOver write FOnGameOver;
    8996    property Moving: Boolean read FMoving;
     97  end;
     98
     99  TGames = class(TFPGObjectList<TGame>)
    90100  end;
    91101
    … …  
    94104    (X: -1; Y: 0), (X: 0; Y: -1), (X: 1; Y: 0), (X: 0; Y: 1)
    95105  );
     106  DirectionText: array[TDirection] of string = ('Left', 'Up', 'Right', 'Down');
    96107
    97108resourcestring
    98   SGameOverCaption = 'Lost';
    99   SGameOverMessage = 'Game over!';
    100   SWinCaption = 'Win';
    101   SWinMessage = 'You reached %d and won! You can continue to play to get higher score.';
    102109  SScore = 'Score';
    103110  STopScore = 'Top score';
    … …  
    212219end;
    213220
     221function TBoard.GetValueSum: Integer;
     222var
     223  X, Y: Integer;
     224begin
     225  Result := 0;
     226  for Y := 0 to Size.Y - 1 do
     227    for X := 0 to Size.X - 1 do
     228      Inc(Result, Tiles[Y, X].Value);
     229end;
     230
    214231function TBoard.GetEmptyTilesCount: Integer;
    215232var
    … …  
    260277procedure TGame.GameOver;
    261278begin
    262   if Running then MessageDlg(SGameOverCaption, SGameOverMessage, mtInformation, [mbOK], 0);
     279  if Running and Assigned(FOnGameOver) then FOnGameOver(Self);
    263280  Running := False;
    264281end;
    … …  
    266283procedure TGame.Win;
    267284begin
    268   MessageDlg(SWinCaption, Format(SWinMessage, [WinScore]), mtInformation, [mbOk], 0);
     285  if Assigned(FOnWin) then FOnWin(Self);
    269286end;
    270287
    … …  
    293310procedure TGame.Assign(Source: TGame);
    294311begin
    295   FScore := Source.FScore;
     312  Board.Assign(Source.Board);
     313  FBoardUndo.Assign(Source.FBoardUndo);
     314  FCanUndo := Source.FCanUndo;
    296315  TopScore := Source.TopScore;
    297316  AnimationDuration := Source.AnimationDuration;
    298   Board.Assign(Source.Board);
     317  WinScore := Source.WinScore;
     318  UndoEnabled := Source.UndoEnabled;
     319  FScore := Source.FScore;
     320  FRunning := Source.FRunning;
    299321end;
    300322
    … …  
    412434    FRunning := CanMove;
    413435    DoChange;
     436  end;
     437end;
     438
     439function TGame.CanMergeDirection(Direction: TDirection): Boolean;
     440var
     441  StartPoint: TPoint;
     442  AreaSize: TPoint;
     443  Increment: TPoint;
     444  P: TPoint;
     445  PNew: TPoint;
     446  PI: TPoint;
     447  I: Integer;
     448begin
     449  Result := False;
     450  case Direction of
     451    drLeft: begin
     452      StartPoint := Point(1, 0);
     453      AreaSize := Point(Board.Size.X - 2, Board.Size.Y - 1);
     454      Increment := Point(1, 1);
     455    end;
     456    drUp: begin
     457      StartPoint := Point(0, 1);
     458      AreaSize := Point(Board.Size.X - 1, Board.Size.Y - 2);
     459      Increment := Point(1, 1);
     460    end;
     461    drRight: begin
     462      StartPoint := Point(Board.Size.X - 2, 0);
     463      AreaSize := Point(Board.Size.X - 2, Board.Size.Y - 1);
     464      Increment := Point(-1, 1);
     465    end;
     466    drDown: begin
     467      StartPoint := Point(0, Board.Size.Y - 2);
     468      AreaSize := Point(Board.Size.X - 1, Board.Size.Y - 2);
     469      Increment := Point(1, -1);
     470    end;
     471  end;
     472
     473  for I := 0 to Max(Board.Size.X, Board.Size.Y) - 1 do begin
     474    PI.Y := 0;
     475    while PI.Y <= AreaSize.Y do begin
     476      PI.X := 0;
     477      while PI.X <= AreaSize.X do begin
     478        P := Point(StartPoint.X + PI.X * Increment.X, StartPoint.Y + PI.Y * Increment.Y);
     479        PNew.X := P.X + DirectionDiff[Direction].X;
     480        PNew.Y := P.Y + DirectionDiff[Direction].Y;
     481        if IsValidPos(PNew) then begin
     482          if (Board.Tiles[PNew.Y, PNew.X].Value = 0) then begin
     483            Board.Tiles[PNew.Y, PNew.X].Value := Board.Tiles[P.Y, P.X].Value;
     484            Board.Tiles[P.Y, P.X].Value := 0;
     485          end else
     486          if (Board.Tiles[P.Y, P.X].Value <> 0) then begin
     487            if Board.Tiles[PNew.Y, PNew.X].Value = Board.Tiles[P.Y, P.X].Value then begin
     488              Result := True;
     489              Break;
     490            end;
     491          end;
     492          P.X := PNew.X;
     493          P.Y := PNew.Y;
     494          PNew.X := P.X + DirectionDiff[Direction].X;
     495          PNew.Y := P.Y + DirectionDiff[Direction].Y;
     496        end;
     497        Inc(PI.X);
     498      end;
     499      if Result then Break;
     500      Inc(PI.Y);
     501    end;
    414502  end;
    415503end;
    … …  
    490578  Time: TDateTime;
    491579  Part: Double;
    492   HighestValue: Integer;
    493580begin
    494581  if not CanMoveDirection(Direction) then Exit;
    495582  FMoving := True;
    496   HighestValue := Board.GetHighestTileValue;
    497583  FBoardUndo.Assign(Board);
    498584  FCanUndo := True;
    … …  
    596682    DoChange;
    597683  end;
    598 
    599   // Update state after move
     684  FMoving := False;
     685end;
     686
     687procedure TGame.MoveAllAndUpdate(Direction: TDirection);
     688var
     689  HighestValue: Integer;
     690begin
     691  HighestValue := Board.GetHighestTileValue;
     692  MoveAll(Direction);
    600693  FillRandomTile;
    601694  if not CanMove and (Board.GetEmptyTilesCount = 0) then
    … …  
    603696  if (HighestValue < WinScore) and
    604697  (Board.GetHighestTileValue >= WinScore) then Win;
    605 
    606   FMoving := False;
    607698end;
    608699
Note: See TracChangeset for help on using the changeset viewer.