Changeset 49
- Timestamp:
- Nov 3, 2019, 11:45:03 AM (5 years ago)
- Location:
- trunk
- Files:
-
- 9 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormNew.lfm
r36 r49 78 78 TabOrder = 4 79 79 end 80 object Label2: TLabel 81 Left = 16 82 Height = 26 83 Top = 125 84 Width = 75 85 Caption = 'Tile skin:' 86 ParentColor = False 87 end 88 object ComboBoxSkin: TComboBox 89 Left = 173 90 Height = 38 91 Top = 120 92 Width = 262 93 ItemHeight = 0 94 Items.Strings = ( 95 '' 96 ) 97 Style = csDropDownList 98 TabOrder = 5 99 end 80 100 end -
trunk/Forms/UFormNew.lrj
r36 r49 5 5 {"hash":1339,"name":"tformnew.buttonok.caption","sourcebytes":[79,75],"value":"OK"}, 6 6 {"hash":260260820,"name":"tformnew.checkboxundoenabled.caption","sourcebytes":[85,110,100,111,32,101,110,97,98,108,101,100],"value":"Undo enabled"}, 7 {"hash":146862089,"name":"tformnew.checkboxrecordhistory.caption","sourcebytes":[82,101,99,111,114,100,32,109,111,118,101,115,32,104,105,115,116,111,114,121],"value":"Record moves history"} 7 {"hash":146862089,"name":"tformnew.checkboxrecordhistory.caption","sourcebytes":[82,101,99,111,114,100,32,109,111,118,101,115,32,104,105,115,116,111,114,121],"value":"Record moves history"}, 8 {"hash":125677626,"name":"tformnew.label2.caption","sourcebytes":[84,105,108,101,32,115,107,105,110,58],"value":"Tile skin:"} 8 9 ]} -
trunk/Forms/UFormNew.pas
r36 r49 19 19 CheckBoxUndoEnabled: TCheckBox; 20 20 ComboBoxSize: TComboBox; 21 ComboBoxSkin: TComboBox; 21 22 Label1: TLabel; 23 Label2: TLabel; 22 24 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); 23 25 procedure FormCreate(Sender: TObject); … … 43 45 44 46 procedure TFormNew.FormCreate(Sender: TObject); 47 var 48 I: TTileSkin; 45 49 begin 46 50 Core.Translator1.TranslateComponentRecursive(Self); 51 ComboBoxSkin.Items.Clear; 52 for I := Low(SkinText) to High(SkinText) do 53 ComboBoxSkin.Items.Add(SkinText[I]); 47 54 end; 48 55 … … 62 69 CheckBoxUndoEnabled.Checked := Game.UndoEnabled; 63 70 CheckBoxRecordHistory.Checked := Game.RecordHistory; 71 ComboBoxSkin.ItemIndex := Integer(Game.Skin); 64 72 end; 65 73 … … 69 77 Game.UndoEnabled := CheckBoxUndoEnabled.Checked; 70 78 Game.RecordHistory := CheckBoxRecordHistory.Checked; 79 Game.Skin := TTileSkin(ComboBoxSkin.ItemIndex); 71 80 end; 72 81 -
trunk/Languages/Game2048.cs.po
r44 r49 10 10 "Content-Transfer-Encoding: 8bit\n" 11 11 "Language: cs\n" 12 "X-Generator: Poedit 2.2. 1\n"12 "X-Generator: Poedit 2.2.4\n" 13 13 14 14 #: tcore.aabout.caption … … 143 143 msgstr "Velikost desky:" 144 144 145 #: tformnew.label2.caption 146 msgid "Tile skin:" 147 msgstr "Povrch dlaždic:" 148 145 149 #: tformsettings.buttoncancel.caption 146 150 msgctxt "tformsettings.buttoncancel.caption" … … 230 234 msgstr "Skóre" 231 235 236 #: ugame.sskinlinear 237 msgid "Linear" 238 msgstr "Lineární" 239 240 #: ugame.sskinpoweroftwo 241 msgid "Power of two" 242 msgstr "Mocnina dvou" 243 244 #: ugame.stileshouldbeempty 245 msgid "Tile should be empty" 246 msgstr "Dlaždice by měla být prázdná" 247 232 248 #: ugame.stopscore 233 249 msgid "Top score" 234 250 msgstr "Nejvyšší skóre" 235 -
trunk/Languages/Game2048.po
r38 r49 133 133 msgstr "" 134 134 135 #: tformnew.label2.caption 136 msgid "Tile skin:" 137 msgstr "" 138 135 139 #: tformsettings.buttoncancel.caption 136 140 msgctxt "tformsettings.buttoncancel.caption" … … 220 224 msgstr "" 221 225 226 #: ugame.sskinlinear 227 msgid "Linear" 228 msgstr "" 229 230 #: ugame.sskinpoweroftwo 231 msgid "Power of two" 232 msgstr "" 233 234 #: ugame.stileshouldbeempty 235 msgid "Tile should be empty" 236 msgstr "" 237 222 238 #: ugame.stopscore 223 239 msgid "Top score" -
trunk/UCore.lfm
r44 r49 37 37 object Translator1: TTranslator 38 38 POFilesFolder = 'Languages' 39 OnTranslate = Translator1Translate 39 40 left = 336 40 41 top = 295 -
trunk/UCore.pas
r40 r49 37 37 procedure DataModuleCreate(Sender: TObject); 38 38 procedure DataModuleDestroy(Sender: TObject); 39 procedure Translator1Translate(Sender: TObject); 39 40 private 40 41 procedure GameChange(Sender: TObject); … … 170 171 end; 171 172 173 procedure TCore.Translator1Translate(Sender: TObject); 174 begin 175 UGame.Translate; 176 end; 177 172 178 procedure TCore.GameChange(Sender: TObject); 173 179 begin … … 178 184 procedure TCore.GameWin(Sender: TObject); 179 185 begin 180 MessageDlg(SWinCaption, Format(SWinMessage, [Game. WinScore]), mtInformation, [mbOk], 0);186 MessageDlg(SWinCaption, Format(SWinMessage, [Game.GetTileSkinValue(Game.WinTileValue)]), mtInformation, [mbOk], 0); 181 187 end; 182 188 -
trunk/UGame.pas
r48 r49 54 54 end; 55 55 56 TTilePosValue = record 57 Pos: TPoint; 58 Value: Integer; 59 end; 60 56 61 { THistory } 57 62 … … 59 64 Game: TGame; 60 65 Moves: THistoryMoves; 61 InitialTiles Pos: array of TPoint;66 InitialTiles: array of TTilePosValue; 62 67 procedure GetStep(GameStep: TGame; Step: Integer); 63 68 procedure Clear; … … 89 94 end; 90 95 96 TTileSkin = (tsLinear, tsPowerOfTwo); 97 91 98 { TGame } 92 99 … … 102 109 FCanUndo: Boolean; 103 110 FBoardUndo: TBoard; 111 FSkin: TTileSkin; 104 112 function GetTileColor(Value: Integer): TColor; 105 113 procedure SetRecordHistory(AValue: Boolean); … … 108 116 procedure RenderTile(Canvas: TCanvas; Tile: TTile; TileRect: TRect; WithText: Boolean); 109 117 procedure GameOver; 118 procedure SetSkin(AValue: TTileSkin); 110 119 procedure Win; 111 120 function FillRandomTile(Value4Change: Double = 0.1): TTile; 112 121 function GetMoveArea(Direction: TMoveDirection): TArea; 113 122 procedure MoveAllAnimate(Direction: TMoveDirection); 123 function CanMergeTile(Value1, Value2: Integer): Boolean; 124 function MergeTile(Value1, Value2: Integer): Integer; 114 125 public 115 126 Board: TBoard; 116 127 TopScore: Integer; 117 128 AnimationDuration: Integer; 118 Win Score: Integer;129 WinTileValue: Integer; 119 130 UndoEnabled: Boolean; 120 131 History: THistory; … … 133 144 procedure SaveToRegistry(RegContext: TRegistryContext); 134 145 procedure LoadFromRegistry(RegContext: TRegistryContext); 146 function GetTileSkinValue(Value: Integer): Integer; 135 147 constructor Create; 136 148 destructor Destroy; override; … … 142 154 property Moving: Boolean read FMoving; 143 155 property RecordHistory: Boolean read FRecordHistory write SetRecordHistory; 156 property Skin: TTileSkin read FSkin write SetSkin; 144 157 end; 145 158 146 159 TGames = class(TFPGObjectList<TGame>) 147 160 end; 161 162 var 163 SkinText: array[TTileSkin] of string; 148 164 149 165 const … … 157 173 SScore = 'Score'; 158 174 STopScore = 'Top score'; 175 SSkinLinear = 'Linear'; 176 SSkinPowerOfTwo = 'Power of two'; 177 STileShouldBeEmpty = 'Tile should be empty'; 178 179 procedure Translate; 180 159 181 160 182 implementation 183 184 procedure Translate; 185 begin 186 SkinText[tsLinear] := SSkinLinear; 187 SkinText[tsPowerOfTwo] := SSkinPowerOfTwo; 188 end; 161 189 162 190 { THistoryMoves } … … 221 249 GameStep.Board.Size := Game.Board.Size; 222 250 GameStep.Board.Clear; 251 GameStep.Skin := Game.Skin; 223 252 GameStep.Score := 0; 224 for I := 0 to Length(InitialTiles Pos) - 1 do225 GameStep.Board.Tiles[InitialTiles Pos[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; 226 255 for I := 0 to Step - 1 do 227 256 with Moves[I] do begin … … 229 258 if GameStep.Board.Tiles[NewItemPos.Y, NewItemPos.X].Value = 0 then 230 259 GameStep.Board.Tiles[NewItemPos.Y, NewItemPos.X].Value := NewItemValue 231 else raise Exception.Create( 'Tile should be empty');260 else raise Exception.Create(STileShouldBeEmpty); 232 261 end; 233 262 end; … … 236 265 begin 237 266 Moves.Clear; 238 SetLength(InitialTiles Pos, 0);267 SetLength(InitialTiles, 0); 239 268 end; 240 269 … … 256 285 with Reg do begin 257 286 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); 262 292 end; 263 293 Moves.SaveToRegistry(Reg, RegContext); … … 271 301 with Reg do begin 272 302 CurrentContext := TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\InitialTilesPos'); 273 SetLength(InitialTiles Pos, ReadIntegerWithDefault('Count', 0));274 for I := 0 to Length(InitialTiles Pos) - 1 do begin275 InitialTiles Pos[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), 276 306 ReadIntegerWithDefault('Y' + IntToStr(I), 0)); 307 InitialTiles[I].Value := ReadIntegerWithDefault('Value' + IntToStr(I), 0); 277 308 end; 278 309 end; … … 466 497 end; 467 498 499 procedure TGame.SetSkin(AValue: TTileSkin); 500 begin 501 if FSkin = AValue then Exit; 502 FSkin := AValue; 503 DoChange; 504 end; 505 468 506 procedure TGame.Win; 469 507 begin … … 480 518 Board.GetEmptyTiles(EmptyTiles); 481 519 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; 483 521 Result := EmptyTiles[Random(EmptyTiles.Count)]; 484 522 Result.Value := NewValue; … … 511 549 TopScore := Source.TopScore; 512 550 AnimationDuration := Source.AnimationDuration; 513 Win Score := Source.WinScore;551 WinTileValue := Source.WinTileValue; 514 552 UndoEnabled := Source.UndoEnabled; 515 553 FScore := Source.FScore; 516 554 FRunning := Source.FRunning; 555 Skin := Source.Skin; 517 556 end; 518 557 … … 520 559 var 521 560 I: Integer; 561 Tile: TTile; 522 562 begin 523 563 FCanUndo := False; … … 528 568 if RecordHistory then begin 529 569 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; 532 574 end; 533 575 end else begin … … 642 684 end else 643 685 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 begin686 CanMergeTile(Board.Tiles[PNew.Y, PNew.X].Value, Board.Tiles[P.Y, P.X].Value) then begin 645 687 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); 647 689 Board.Tiles[PNew.Y, PNew.X].Merged := True; 648 690 Board.Tiles[P.Y, P.X].Value := 0; 649 691 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); 651 693 end; 652 694 end; … … 669 711 Canvas.RoundRect(TileRect, ScaleX(TileRect.Width div 20, 96), ScaleY(TileRect.Height div 20, 96)); 670 712 if WithText and (Tile.Value <> 0) then begin 671 ValueStr := IntToStr( Tile.Value);713 ValueStr := IntToStr(GetTileSkinValue(Tile.Value)); 672 714 Canvas.Brush.Style := bsClear; 673 715 Canvas.Font.Height := Trunc(TileRect.Height * 0.7); … … 719 761 end else 720 762 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].Valuethen begin763 if CanMergeTile(Board.Tiles[PNew.Y, PNew.X].Value, Board.Tiles[P.Y, P.X].Value) then begin 722 764 Result := True; 723 765 Break; … … 750 792 if (Board.Tiles[P.Y, P.X].Value <> 0) then begin 751 793 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 begin794 CanMergeTile(Board.Tiles[PNew.Y, PNew.X].Value, Board.Tiles[P.Y, P.X].Value) then begin 753 795 Result := True; 754 796 Break; … … 807 849 end else 808 850 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 begin851 CanMergeTile(Board.Tiles[PNew.Y, PNew.X].NewValue, Board.Tiles[P.Y, P.X].NewValue) then begin 810 852 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); 812 854 Board.Tiles[PNew.Y, PNew.X].Merged := True; 813 855 Board.Tiles[P.Y, P.X].NewValue := 0; 814 856 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); 816 858 TileMoved := True; 817 859 end; … … 861 903 end; 862 904 905 function TGame.CanMergeTile(Value1, Value2: Integer): Boolean; 906 begin 907 Result := MergeTile(Value1, Value2) <> -1; 908 end; 909 910 function TGame.MergeTile(Value1, Value2: Integer): Integer; 911 begin 912 if Value1 = Value2 then Result := Value1 + 1 913 else Result := -1; 914 end; 915 916 function TGame.GetTileSkinValue(Value: Integer): Integer; 917 begin 918 if FSkin = tsPowerOfTwo then Result := 1 shl Value 919 else Result := Value; 920 end; 921 863 922 procedure TGame.MoveAllAndUpdate(Direction: TMoveDirection; Animation: Boolean); 864 923 var … … 882 941 if not CanMove and (Board.GetEmptyTilesCount = 0) then 883 942 GameOver; 884 if (HighestValue < Win Score) and885 (Board.GetHighestTileValue >= Win Score) then Win;943 if (HighestValue < WinTileValue) and 944 (Board.GetHighestTileValue >= WinTileValue) then Win; 886 945 end; 887 946 end; … … 917 976 WriteBool('UndoEnabled', UndoEnabled); 918 977 WriteBool('RecordHistory', RecordHistory); 978 WriteInteger('Skin', Integer(Skin)); 919 979 FBoardUndo.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo')); 920 980 Board.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board')); … … 940 1000 UndoEnabled := ReadBoolWithDefault('UndoEnabled', True); 941 1001 RecordHistory := ReadBoolWithDefault('RecordHistory', False); 1002 Skin := TTileSkin(ReadIntegerWithDefault('Skin', Integer(tsPowerOfTwo))); 942 1003 FBoardUndo.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo')); 943 1004 Board.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board')); … … 952 1013 begin 953 1014 AnimationDuration := 30; 954 Win Score := 2048;1015 WinTileValue := 11; // 2^11 = 2048 955 1016 Board := TBoard.Create; 956 1017 FBoardUndo := TBoard.Create; … … 971 1032 case Value of 972 1033 0: Result := $f2f6f9; 973 2: Result := $dae4ee;974 4: Result := $c8e0ed;975 8: Result := $79b1f2;976 16: Result := $6395f5;977 32: Result := $5f7cf6;978 6 4: Result := $3b5ef6;979 128: Result := $72cfed;980 256: Result := $61cced;981 512: Result := $50c8ed;982 10 24: 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; 984 1045 else Result := $323a3c; 985 1046 end;
Note:
See TracChangeset
for help on using the changeset viewer.