source: trunk/Game.pas

Last change on this file was 90, checked in by chronos, 3 months ago
  • Modified: Snap package updated to core22.
  • Modified: Calculate different win tile value for different board sizes.
File size: 39.1 KB
Line 
1unit Game;
2
3interface
4
5uses
6 Classes, SysUtils, Dialogs, Generics.Collections, Graphics, Types, Forms, Math, DateUtils,
7 Controls, RegistryEx;
8
9type
10 TGame = class;
11 TMoveDirection = (drNone, drLeft, drUp, drRight, drDown);
12 TTileAction = (taNone, taMove, taMerge, taAppear);
13 TColorPalette = (cpOrangeYellow, cpGreenYellow, cpPinkBlue, cpBlueCyan,
14 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;
30
31 { TArea }
32
33 TArea = record
34 P1, P2: TPoint;
35 function Increment: TPoint;
36 class function Create(P1, P2: TPoint): TArea; static; overload;
37 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;
95 end;
96
97 TTileSkin = (tsLinear, tsPowerOfTwo, tsAlpha, tsRoman, tsBinary);
98
99 { TGame }
100
101 TGame = class
102 private
103 FMoving: Boolean;
104 FOnChange: TNotifyEvent;
105 FOnGameOver: TNotifyEvent;
106 FOnPaint: TNotifyEvent;
107 FOnWin: TNotifyEvent;
108 FRecordHistory: Boolean;
109 FRunning: Boolean;
110 FScore: Integer;
111 FCanUndo: Boolean;
112 FBoardUndo: TBoard;
113 FColorPalette: TColorPalette;
114 FSkin: TTileSkin;
115 function GetTileColor(Value: Integer): TColor;
116 procedure SetRecordHistory(AValue: Boolean);
117 procedure SetScore(AValue: Integer);
118 procedure DoChange;
119 procedure DoPaint;
120 procedure RenderTile(Canvas: TCanvas; Tile: TTile; TileRect: TRect; WithText: Boolean);
121 procedure GameOver;
122 procedure SetColorPalette(AValue: TColorPalette);
123 procedure SetSkin(AValue: TTileSkin);
124 procedure Win;
125 function FillRandomTile: TTile;
126 function GetMoveArea(Direction: TMoveDirection): TArea;
127 procedure MoveAllAnimate(Direction: TMoveDirection);
128 function CanMergeTile(Value1, Value2: Integer): Boolean;
129 function MergeTile(Value1, Value2: Integer): Integer;
130 procedure AnimateTiles;
131 public
132 Board: TBoard;
133 TopScore: Integer;
134 AnimationDuration: Integer;
135 AnimationTick: Integer;
136 WinTileValue: Integer;
137 UndoEnabled: Boolean;
138 History: THistory;
139 BackgroundColor: TColor;
140 Value2Chance: Double;
141 function CanUndo: Boolean;
142 procedure Undo;
143 function CanMergeDirection(Direction: TMoveDirection): Boolean;
144 function CanMoveDirection(Direction: TMoveDirection): Boolean;
145 function CanMove: Boolean;
146 procedure Assign(Source: TGame);
147 procedure New;
148 procedure Render(Canvas: TCanvas; CanvasSize: TPoint);
149 procedure MoveAll(Direction: TMoveDirection; Animation: Boolean);
150 procedure MoveAllAndUpdate(Direction: TMoveDirection; Animation: Boolean);
151 procedure MoveTile(SourceTile, TargetTile: TTile);
152 function IsValidPos(Pos: TPoint): Boolean;
153 procedure SaveToRegistry(RegContext: TRegistryContext);
154 procedure LoadFromRegistry(RegContext: TRegistryContext);
155 function GetTileSkinValue(Value: Integer): string;
156 function GetTileSkinScore(Value: Integer): Integer;
157 constructor Create;
158 destructor Destroy; override;
159 property Score: Integer read FScore write SetScore;
160 property Running: Boolean read FRunning write FRunning;
161 property OnChange: TNotifyEvent read FOnChange write FOnChange;
162 property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
163 property OnWin: TNotifyEvent read FOnWin write FOnWin;
164 property OnGameOver: TNotifyEvent read FOnGameOver write FOnGameOver;
165 property Moving: Boolean read FMoving;
166 property RecordHistory: Boolean read FRecordHistory write SetRecordHistory;
167 property Skin: TTileSkin read FSkin write SetSkin;
168 property ColorPalette: TColorPalette read FColorPalette write SetColorPalette;
169 end;
170
171 TGames = class(TObjectList<TGame>)
172 end;
173
174var
175 SkinText: array[TTileSkin] of string;
176 ColorPaletteText: array[TColorPalette] of string;
177
178const
179 DirectionDiff: array[TMoveDirection] of TPoint = (
180 (X: 0; Y: 0), (X: -1; Y: 0), (X: 0; Y: -1), (X: 1; Y: 0), (X: 0; Y: 1)
181 );
182 DirectionText: array[TMoveDirection] of string = ('None', 'Left', 'Up', 'Right', 'Down');
183 InitialTileCount = 2;
184
185resourcestring
186 SScore = 'Score';
187 STopScore = 'Top score';
188 SSkinLinear = 'Linear';
189 SSkinPowerOfTwo = 'Power of two';
190 SSkinAlpha = 'Alpha';
191 SSkinRoman = 'Roman';
192 SSkinBinary = 'Binary';
193 STileShouldBeEmpty = 'Tile should be empty';
194
195 // Color palette
196 SOrangeYellow = 'Orange - yellow';
197 SGreenYellow = 'Green - yellow';
198 SPinkBlue = 'Pink - blue';
199 SBlueCyan = 'Blue - cyan';
200 SGreenCyan = 'Green - cyan';
201 SPinkRed = 'Pink - red';
202
203procedure Translate;
204
205
206implementation
207
208uses
209 Core, MetaCanvas, PixelPointer;
210
211procedure Translate;
212begin
213 SkinText[tsLinear] := SSkinLinear;
214 SkinText[tsPowerOfTwo] := SSkinPowerOfTwo;
215 SkinText[tsAlpha] := SSkinAlpha;
216 SkinText[tsRoman] := SSkinRoman;
217 SkinText[tsBinary] := SSkinBinary;
218
219 ColorPaletteText[cpOrangeYellow] := SOrangeYellow;
220 ColorPaletteText[cpGreenYellow] := SGreenYellow;
221 ColorPaletteText[cpPinkBlue] := SPinkBlue;
222 ColorPaletteText[cpBlueCyan] := SBlueCyan;
223 ColorPaletteText[cpGreenCyan] := SGreenCyan;
224 ColorPaletteText[cpPinkRed] := SPinkRed;
225end;
226
227{ THistoryMoves }
228
229procedure THistoryMoves.SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
230var
231 I: Integer;
232begin
233 with Reg do begin
234 CurrentContext := RegContext;
235 WriteInteger('Count', Count);
236 for I := 0 to Count - 1 do begin
237 Items[I].SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\' + IntToStr(I)));
238 end;
239 end;
240end;
241
242procedure THistoryMoves.LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
243var
244 I: Integer;
245begin
246 with Reg do begin
247 CurrentContext := RegContext;
248 Count := ReadIntegerWithDefault('Count', 0);
249 for I := 0 to Count - 1 do begin
250 Items[I] := THistoryMove.Create;
251 THistoryMove(Items[I]).LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\' + IntToStr(I)));
252 end;
253 end;
254end;
255
256{ THistoryMove }
257
258procedure THistoryMove.SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
259begin
260 with Reg do begin
261 CurrentContext := RegContext;
262 WriteInteger('Direction', Integer(Direction));
263 WriteInteger('NewItemPosX', NewItemPos.X);
264 WriteInteger('NewItemPosY', NewItemPos.Y);
265 WriteInteger('NewItemValue', NewItemValue);
266 end;
267end;
268
269procedure THistoryMove.LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
270begin
271 with Reg do begin
272 CurrentContext := RegContext;
273 Direction := TMoveDirection(ReadIntegerWithDefault('Direction', Integer(drNone)));
274 NewItemPos := Point(ReadIntegerWithDefault('NewItemPosX', 0),
275 ReadIntegerWithDefault('NewItemPosY', 0));
276 NewItemValue := ReadIntegerWithDefault('NewItemValue', 0);
277 end;
278end;
279
280{ THistory }
281
282procedure THistory.GetStep(GameStep: TGame; Step: Integer);
283var
284 I: Integer;
285begin
286 GameStep.Board.Size := Game.Board.Size;
287 GameStep.Board.Clear;
288 GameStep.Skin := Game.Skin;
289 GameStep.ColorPalette := Game.ColorPalette;
290 GameStep.Score := 0;
291 for I := 0 to Length(InitialTiles) - 1 do
292 GameStep.Board.Tiles[InitialTiles[I].Pos.Y, InitialTiles[I].Pos.X].Value := InitialTiles[I].Value;
293 for I := 0 to Step - 1 do
294 with Moves[I] do begin
295 GameStep.MoveAll(Direction, False);
296 if GameStep.Board.Tiles[NewItemPos.Y, NewItemPos.X].Value = 0 then
297 GameStep.Board.Tiles[NewItemPos.Y, NewItemPos.X].Value := NewItemValue
298 else raise Exception.Create(STileShouldBeEmpty);
299 end;
300end;
301
302procedure THistory.Clear;
303begin
304 Moves.Clear;
305 SetLength(InitialTiles, 0);
306end;
307
308constructor THistory.Create;
309begin
310 Moves := THistoryMoves.Create;
311end;
312
313destructor THistory.Destroy;
314begin
315 FreeAndNil(Moves);
316 inherited;
317end;
318
319procedure THistory.SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
320var
321 I: Integer;
322begin
323 with Reg do begin
324 CurrentContext := TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\InitialTilesPos');
325 WriteInteger('Count', Length(InitialTiles));
326 for I := 0 to Length(InitialTiles) - 1 do begin
327 WriteInteger('X' + IntToStr(I), InitialTiles[I].Pos.X);
328 WriteInteger('Y' + IntToStr(I), InitialTiles[I].Pos.Y);
329 WriteInteger('Value' + IntToStr(I), InitialTiles[I].Value);
330 end;
331 Moves.SaveToRegistry(Reg, RegContext);
332 end;
333end;
334
335procedure THistory.LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
336var
337 I: Integer;
338begin
339 with Reg do begin
340 CurrentContext := TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\InitialTilesPos');
341 SetLength(InitialTiles, ReadIntegerWithDefault('Count', 0));
342 for I := 0 to Length(InitialTiles) - 1 do begin
343 InitialTiles[I].Pos := Point(ReadIntegerWithDefault('X' + IntToStr(I), 0),
344 ReadIntegerWithDefault('Y' + IntToStr(I), 0));
345 InitialTiles[I].Value := ReadIntegerWithDefault('Value' + IntToStr(I), 0);
346 end;
347 end;
348 Moves.LoadFromRegistry(Reg, RegContext);
349end;
350
351{ TArea }
352
353function TArea.Increment: TPoint;
354begin
355 Result := Point(Sign(P2.X - P1.X), Sign(P2.Y - P1.Y));
356 if Result.X = 0 then Result.X := 1;
357 if Result.Y = 0 then Result.Y := 1;
358end;
359
360class function TArea.Create(P1, P2: TPoint): TArea;
361begin
362 Result.P1 := P1;
363 Result.P2 := P2;
364end;
365
366class function TArea.Create(X1, Y1, X2, Y2: Integer): TArea;
367begin
368 Result.P1 := Point(X1, Y1);
369 Result.P2 := Point(X2, Y2);
370end;
371
372{ TBoard }
373
374procedure TBoard.SetSize(AValue: TPoint);
375var
376 X, Y: Integer;
377begin
378 if FSize = AValue then Exit;
379 for Y := 0 to FSize.Y - 1 do
380 for X := 0 to FSize.X - 1 do
381 Tiles[Y, X].Free;
382 FSize := AValue;
383 SetLength(Tiles, FSize.Y, FSize.X);
384 for Y := 0 to FSize.Y - 1 do
385 for X := 0 to FSize.X - 1 do begin
386 Tiles[Y, X] := TTile.Create;
387 Tiles[Y, X].Index := Point(X, Y);
388 end;
389end;
390
391procedure TBoard.Assign(Source: TBoard);
392var
393 X, Y: Integer;
394begin
395 Size := Source.Size;
396 for Y := 0 to Size.Y - 1 do
397 for X := 0 to Size.X - 1 do
398 Tiles[Y, X].Assign(Source.Tiles[Y, X]);
399end;
400
401procedure TBoard.GetEmptyTiles(EmptyTiles: TTiles);
402var
403 X, Y: Integer;
404begin
405 EmptyTiles.Clear;
406 for Y := 0 to Size.Y - 1 do
407 for X := 0 to Size.X - 1 do
408 if Tiles[Y, X].Value = 0 then
409 EmptyTiles.Add(Tiles[Y, X]);
410end;
411
412procedure TBoard.SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
413var
414 X, Y: Integer;
415 Value: string;
416begin
417 with Reg do begin
418 CurrentContext := RegContext;
419
420 WriteInteger('SizeX', Size.X);
421 WriteInteger('SizeY', Size.Y);
422 Value := '';
423 for Y := 0 to Size.Y - 1 do begin
424 for X := 0 to Size.X - 1 do begin
425 Value := Value + IntToStr(Tiles[Y, X].Value);
426 if X < Size.X - 1 then Value := Value + ',';
427 end;
428 if Y < Size.Y - 1 then Value := Value + ';'
429 end;
430 WriteString('TileValues', Value);
431 end;
432end;
433
434procedure TBoard.LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
435var
436 X, Y: Integer;
437 Items: TStringList;
438 Lines: TStringList;
439 Number: Integer;
440begin
441 with Reg do begin
442 CurrentContext := RegContext;
443
444 Size := Point(ReadIntegerWithDefault('SizeX', 4), ReadIntegerWithDefault('SizeY', 4));
445 Items := TStringList.Create;
446 Items.Delimiter := ',';
447 Lines := TStringList.Create;
448 Lines.Delimiter := ';';
449 Lines.DelimitedText := ReadStringWithDefault('TileValues', '');
450 for Y := 0 to Lines.Count - 1 do begin
451 Items.DelimitedText := Lines[Y];
452 for X := 0 to Items.Count - 1 do begin
453 if TryStrToInt(Items[X], Number) and (X < Size.X) and (Y < Size.Y) then
454 Tiles[Y, X].Value := Number;
455 end;
456 end;
457 Lines.Free;
458 Items.Free;
459 end;
460end;
461
462destructor TBoard.Destroy;
463begin
464 Size := Point(0, 0);
465 inherited;
466end;
467
468procedure TBoard.ClearMerged;
469var
470 X, Y: Integer;
471begin
472 for Y := 0 to Size.Y - 1 do
473 for X := 0 to Size.X - 1 do
474 Tiles[Y, X].Merged := False;
475end;
476
477function TBoard.GetValueSum: Integer;
478var
479 X, Y: Integer;
480begin
481 Result := 0;
482 for Y := 0 to Size.Y - 1 do
483 for X := 0 to Size.X - 1 do
484 Inc(Result, Tiles[Y, X].Value);
485end;
486
487function TBoard.GetEmptyTilesCount: Integer;
488var
489 X, Y: Integer;
490begin
491 Result := 0;
492 for Y := 0 to Size.Y - 1 do
493 for X := 0 to Size.X - 1 do
494 if Tiles[Y, X].Value = 0 then
495 Inc(Result);
496end;
497
498function TBoard.GetHighestTileValue: Integer;
499var
500 X, Y: Integer;
501begin
502 Result := 0;
503 for Y := 0 to Size.Y - 1 do
504 for X := 0 to Size.X - 1 do
505 if Result < Tiles[Y, X].Value then Result := Tiles[Y, X].Value;
506end;
507
508procedure TBoard.Clear;
509var
510 X, Y: Integer;
511begin
512 for Y := 0 to Size.Y - 1 do
513 for X := 0 to Size.X - 1 do
514 Tiles[Y, X].Value := 0;
515end;
516
517
518{ TTile }
519
520procedure TTile.Assign(Source: TTile);
521begin
522 Value := Source.Value;
523 Merged := Source.Merged;
524end;
525
526{ TGame }
527
528procedure TGame.DoChange;
529begin
530 if Assigned(FOnChange) then FOnChange(Self);
531end;
532
533procedure TGame.DoPaint;
534begin
535 if Assigned(FOnPaint) then FOnPaint(Self);
536end;
537
538procedure TGame.GameOver;
539begin
540 if Running and Assigned(FOnGameOver) then FOnGameOver(Self);
541 Running := False;
542end;
543
544procedure TGame.SetColorPalette(AValue: TColorPalette);
545begin
546 if FColorPalette = AValue then Exit;
547 FColorPalette := AValue;
548 DoPaint;
549end;
550
551procedure TGame.SetSkin(AValue: TTileSkin);
552begin
553 if FSkin = AValue then Exit;
554 FSkin := AValue;
555 DoPaint;
556end;
557
558procedure TGame.Win;
559begin
560 if Assigned(FOnWin) then FOnWin(Self);
561end;
562
563function TGame.FillRandomTile: TTile;
564var
565 EmptyTiles: TTiles;
566 NewValue: Integer;
567begin
568 Result := nil;
569 EmptyTiles := TTiles.Create(False);
570 Board.GetEmptyTiles(EmptyTiles);
571 if EmptyTiles.Count > 0 then begin
572 if Random < Value2Chance then NewValue := 2 else NewValue := 1;
573 Result := EmptyTiles[Random(EmptyTiles.Count)];
574 Result.Value := NewValue;
575 Result.Action := taAppear;
576 end;
577 EmptyTiles.Free;
578end;
579
580function TGame.GetMoveArea(Direction: TMoveDirection): TArea;
581begin
582 case Direction of
583 drNone: Result := TArea.Create(0, 0, 0, 0);
584 drLeft: Result := TArea.Create(1, 0, Board.Size.X - 1, Board.Size.Y - 1);
585 drUp: Result := TArea.Create(0, 1, Board.Size.X - 1, Board.Size.Y - 1);
586 drRight: Result := TArea.Create(Board.Size.X - 2, 0, 0, Board.Size.Y - 1);
587 drDown: Result := TArea.Create(0, Board.Size.Y - 2, Board.Size.X - 1, 0);
588 end;
589end;
590
591function TGame.CanMove: Boolean;
592begin
593 Result := CanMoveDirection(drLeft) or CanMoveDirection(drRight) or
594 CanMoveDirection(drUp) or CanMoveDirection(drDown);
595end;
596
597procedure TGame.Assign(Source: TGame);
598begin
599 Board.Assign(Source.Board);
600 FBoardUndo.Assign(Source.FBoardUndo);
601 FCanUndo := Source.FCanUndo;
602 TopScore := Source.TopScore;
603 AnimationDuration := Source.AnimationDuration;
604 WinTileValue := Source.WinTileValue;
605 UndoEnabled := Source.UndoEnabled;
606 FScore := Source.FScore;
607 FRunning := Source.FRunning;
608 Skin := Source.Skin;
609 ColorPalette := Source.ColorPalette;
610end;
611
612procedure TGame.New;
613var
614 I: Integer;
615 Tile: TTile;
616const
617 Difficulty = 0.7;
618begin
619 FCanUndo := False;
620 Board.Clear;
621 WinTileValue := Round((Board.Size.X * Board.Size.Y) * Difficulty);
622 Score := 0;
623 Running := True;
624 History.Clear;
625 if RecordHistory then begin
626 for I := 0 to InitialTileCount - 1 do begin
627 SetLength(History.InitialTiles, Length(History.InitialTiles) + 1);
628 Tile := FillRandomTile;
629 History.InitialTiles[Length(History.InitialTiles) - 1].Pos := Tile.Index;
630 History.InitialTiles[Length(History.InitialTiles) - 1].Value := Tile.Value;
631 end;
632 end else begin
633 for I := 0 to InitialTileCount - 1 do
634 FillRandomTile;
635 end;
636 AnimateTiles;
637 DoChange;
638 DoPaint;
639end;
640
641procedure TGame.Render(Canvas: TCanvas; CanvasSize: TPoint);
642var
643 X, Y: Integer;
644 TileSize: TPoint;
645 ValueStr: string;
646 Frame: TRect;
647 TileRect: TRect;
648 TopBarHeight: Integer;
649 TileMargin: Integer;
650 TileCenter: TPoint;
651 S: TPoint;
652 MetaCanvas: TMetaCanvas;
653begin
654 MetaCanvas := TMetaCanvas.Create;
655 MetaCanvas.Size := Point(Canvas.Width, Canvas.Height);
656
657 TopBarHeight := ScaleY(24, 96);
658 MetaCanvas.Brush.Style := bsSolid;
659 MetaCanvas.Brush.Color := Core.Core.ThemeManager1.Theme.ColorControl;
660 MetaCanvas.FillRect(0, 0, MetaCanvas.Width, MetaCanvas.Height);
661
662 ValueStr := SScore + ': ' + IntToStr(Score);
663 MetaCanvas.Brush.Style := bsClear;
664 MetaCanvas.Font.Color := Core.Core.ThemeManager1.Theme.ColorControlText;
665 MetaCanvas.Font.Height := Trunc(TopBarHeight * 0.7);
666 MetaCanvas.TextOut(ScaleY(16, 96), (TopBarHeight - MetaCanvas.TextHeight(ValueStr)) div 2, ValueStr);
667
668 ValueStr := STopScore + ': ' + IntToStr(TopScore);
669 MetaCanvas.Font.Color := Core.Core.ThemeManager1.Theme.ColorControlText;
670 MetaCanvas.Font.Height := Trunc(TopBarHeight * 0.7);
671 MetaCanvas.TextOut(ScaleY(136, 96), (TopBarHeight - MetaCanvas.TextHeight(ValueStr)) div 2, ValueStr);
672
673 // Form.Canvas.Width and Form.Canvas.Height is not working correctly under Windows.
674 // So dimensions are provided by CanvasSize parameter.
675 Frame := Rect(2, TopBarHeight, CanvasSize.X - 2, CanvasSize.Y - 2);
676 TileSize := Point(Frame.Width div Board.Size.X, Frame.Height div Board.Size.Y);
677 if TileSize.X < TileSize.Y then TileSize.Y := TileSize.X;
678 if TileSize.Y < TileSize.X then TileSize.X := TileSize.Y;
679 Frame := Rect(Frame.Width div 2 - (Board.Size.X * TileSize.X) div 2,
680 Frame.Top + Frame.Height div 2 - (Board.Size.Y * TileSize.Y) div 2,
681 Frame.Width div 2 + (Board.Size.X * TileSize.X) div 2,
682 Frame.Top + Frame.Height div 2 + (Board.Size.Y * TileSize.Y) div 2);
683
684 TileMargin := Round(Frame.Width / Board.Size.X * 0.03);
685
686 MetaCanvas.Brush.Style := bsSolid;
687 MetaCanvas.Brush.Color := clGray;
688 MetaCanvas.Pen.Style := psClear;
689 MetaCanvas.RoundRect(Frame, ScaleX(Frame.Width div (20 * Board.Size.X), 96),
690 ScaleY(Frame.Height div (20 * Board.Size.Y), 96));
691
692 Frame := Rect(Frame.Left + TileMargin, Frame.Top + TileMargin,
693 Frame.Right - TileMargin, Frame.Bottom - TileMargin);
694 TileSize := Point(Frame.Width div Board.Size.X, Frame.Height div Board.Size.Y);
695
696 MetaCanvas.Font.Color := clBlack;
697
698 // Draw static tiles
699 for Y := 0 to Board.Size.Y - 1 do
700 for X := 0 to Board.Size.X - 1 do begin
701 if (Board.Tiles[Y, X].Action <> taNone) then MetaCanvas.Brush.Color := GetTileColor(0)
702 else MetaCanvas.Brush.Color := GetTileColor(Board.Tiles[Y, X].Value);
703 MetaCanvas.Brush.Style := bsSolid;
704 TileRect := Bounds(
705 Frame.Left + X * TileSize.X + TileMargin,
706 Frame.Top + Y * TileSize.Y + TileMargin,
707 TileSize.X - 2 * TileMargin, TileSize.Y - 2 * TileMargin);
708 RenderTile(MetaCanvas, Board.Tiles[Y, X], TileRect, Board.Tiles[Y, X].Action = taNone);
709 end;
710
711 // Draw moving tiles
712 for Y := 0 to Board.Size.Y - 1 do
713 for X := 0 to Board.Size.X - 1 do
714 if Board.Tiles[Y, X].Action = taMove then begin
715 MetaCanvas.Brush.Color := GetTileColor(Board.Tiles[Y, X].Value);
716 MetaCanvas.Brush.Style := bsSolid;
717 TileRect := Bounds(
718 Frame.Left + X * TileSize.X + Trunc(Board.Tiles[Y, X].Shift.X / 100 * TileSize.X + TileMargin),
719 Frame.Top + Y * TileSize.Y + Trunc(Board.Tiles[Y, X].Shift.Y / 100 * TileSize.Y + TileMargin),
720 TileSize.X - 2 * TileMargin, TileSize.Y - 2 * TileMargin);
721 RenderTile(MetaCanvas, Board.Tiles[Y, X], TileRect, True);
722 end;
723
724 // Draw appearing tiles
725 for Y := 0 to Board.Size.Y - 1 do
726 for X := 0 to Board.Size.X - 1 do
727 if Board.Tiles[Y, X].Action = taAppear then begin
728 MetaCanvas.Brush.Color := GetTileColor(Board.Tiles[Y, X].Value);
729 MetaCanvas.Brush.Style := bsSolid;
730 TileRect := Bounds(
731 Frame.Left + X * TileSize.X + TileMargin,
732 Frame.Top + Y * TileSize.Y + TileMargin,
733 TileSize.X - 2 * TileMargin,
734 TileSize.Y - 2 * TileMargin);
735 TileCenter := TileRect.CenterPoint;
736 S := Point(
737 Trunc(Board.Tiles[Y, X].Shift.X / 100 * (TileSize.X - TileMargin)),
738 Trunc(Board.Tiles[Y, X].Shift.Y / 100 * (TileSize.Y - TileMargin))
739 );
740 TileRect := Rect(TileCenter.X - S.X div 2, TileCenter.Y - S.Y div 2,
741 TileCenter.X + S.X div 2, TileCenter.Y + S.Y div 2);
742 RenderTile(MetaCanvas, Board.Tiles[Y, X], TileRect, True);
743 end;
744
745 // Draw merging tiles
746 for Y := 0 to Board.Size.Y - 1 do
747 for X := 0 to Board.Size.X - 1 do
748 if Board.Tiles[Y, X].Action = taMerge then begin
749 MetaCanvas.Brush.Color := GetTileColor(Board.Tiles[Y, X].Value);
750 MetaCanvas.Brush.Style := bsSolid;
751 TileRect := Bounds(
752 Frame.Left + X * TileSize.X + TileMargin,
753 Frame.Top + Y * TileSize.Y + TileMargin,
754 TileSize.X - 2 * TileMargin,
755 TileSize.Y - 2 * TileMargin);
756 S := Point(
757 Trunc((50 - Abs(Board.Tiles[Y, X].Shift.X - 50)) / 50 * TileMargin),
758 Trunc((50 - Abs(Board.Tiles[Y, X].Shift.Y - 50)) / 50 * TileMargin)
759 );
760 TileRect := Rect(TileRect.Left - S.X, TileRect.Top - S.Y,
761 TileRect.Right + S.X, TileRect.Bottom + S.Y);
762 RenderTile(MetaCanvas, Board.Tiles[Y, X], TileRect, True);
763 end;
764
765 MetaCanvas.DrawTo(Canvas);
766 MetaCanvas.Free;
767end;
768
769procedure TGame.MoveAll(Direction: TMoveDirection; Animation: Boolean);
770var
771 P: TPoint;
772 PNew: TPoint;
773 I: Integer;
774 Area: TArea;
775 DstTile: TTile;
776 SrcTile: TTile;
777 TileMoved: Boolean;
778begin
779 if Animation then begin
780 MoveAllAnimate(Direction);
781 Exit;
782 end;
783 if Direction = drNone then Exit;
784 if not CanMoveDirection(Direction) then Exit;
785 FMoving := True;
786 FBoardUndo.Assign(Board);
787 FCanUndo := True;
788 Area := GetMoveArea(Direction);
789 Board.ClearMerged;
790 for I := 0 to Max(Board.Size.X, Board.Size.Y) - 1 do begin
791 TileMoved := False;
792 P := Area.P1;
793 while P.Y <> Area.P2.Y + Area.Increment.Y do begin
794 P.X := Area.P1.X;
795 while P.X <> Area.P2.X + Area.Increment.X do begin
796 PNew := P + DirectionDiff[Direction];
797 if IsValidPos(PNew) then begin
798 SrcTile := Board.Tiles[P.Y, P.X];
799 DstTile := Board.Tiles[PNew.Y, PNew.X];
800 if SrcTile.Value <> 0 then begin
801 if DstTile.Value = 0 then begin
802 DstTile.Value := SrcTile.Value;
803 DstTile.Merged := SrcTile.Merged;
804 SrcTile.Value := 0;
805 SrcTile.Merged := False;
806 TileMoved := True;
807 end else
808 if (not SrcTile.Merged) and (not DstTile.Merged) and
809 CanMergeTile(DstTile.Value, SrcTile.Value) then begin
810 DstTile.Value := MergeTile(DstTile.Value, SrcTile.Value);
811 DstTile.Merged := True;
812 SrcTile.Value := 0;
813 SrcTile.Merged := False;
814 Score := Score + GetTileSkinScore(SrcTile.Value);
815 TileMoved := True;
816 end;
817 end;
818 end;
819 Inc(P.X, Area.Increment.X);
820 end;
821 Inc(P.Y, Area.Increment.Y);
822 end;
823 if not TileMoved then Break;
824 end;
825 DoPaint;
826 FMoving := False;
827end;
828
829procedure TGame.RenderTile(Canvas: TCanvas; Tile: TTile; TileRect: TRect; WithText: Boolean);
830var
831 ValueStr: string;
832 TextSize: TSize;
833begin
834 Canvas.Pen.Style := psClear;
835 Canvas.RoundRect(TileRect, ScaleX(TileRect.Width div 20, 96), ScaleY(TileRect.Height div 20, 96));
836 if WithText and (Tile.Value <> 0) then begin
837 ValueStr := GetTileSkinValue(Tile.Value);
838 Canvas.Brush.Style := bsClear;
839 Canvas.Font.Height := Trunc(TileRect.Height * 0.7);
840 TextSize := Canvas.TextExtent(ValueStr);
841 if TextSize.Width > TileRect.Width then
842 Canvas.Font.Height := Trunc(Canvas.Font.Height / TextSize.Width * TileRect.Width);
843 TextSize := Canvas.TextExtent(ValueStr);
844 Canvas.TextOut(TileRect.Left + TileRect.Width div 2 - TextSize.Width div 2,
845 TileRect.Top + TileRect.Height div 2 - TextSize.Height div 2, ValueStr);
846 end;
847end;
848
849function TGame.CanUndo: Boolean;
850begin
851 Result := UndoEnabled and FCanUndo;
852end;
853
854procedure TGame.Undo;
855begin
856 if UndoEnabled and CanUndo then begin
857 Board.Assign(FBoardUndo);
858 FCanUndo := False;
859 FRunning := CanMove;
860 if RecordHistory then History.Moves.Delete(History.Moves.Count - 1);
861 DoChange;
862 DoPaint;
863 end;
864end;
865
866function TGame.CanMergeDirection(Direction: TMoveDirection): Boolean;
867var
868 P: TPoint;
869 PNew: TPoint;
870 I: Integer;
871 Area: TArea;
872begin
873 Result := False;
874 if Direction = drNone then Exit;
875 Area := GetMoveArea(Direction);
876 for I := 0 to Max(Board.Size.X, Board.Size.Y) - 1 do begin
877 P := Area.P1;
878 while P.Y <> Area.P2.Y + Area.Increment.Y do begin
879 P.X := Area.P1.X;
880 while P.X <> Area.P2.X + Area.Increment.X do begin
881 PNew := P + DirectionDiff[Direction];
882 if IsValidPos(PNew) then begin
883 if (Board.Tiles[PNew.Y, PNew.X].Value = 0) then begin
884 Board.Tiles[PNew.Y, PNew.X].Value := Board.Tiles[P.Y, P.X].Value;
885 Board.Tiles[P.Y, P.X].Value := 0;
886 end else
887 if (Board.Tiles[P.Y, P.X].Value <> 0) then begin
888 if CanMergeTile(Board.Tiles[PNew.Y, PNew.X].Value, Board.Tiles[P.Y, P.X].Value) then begin
889 Result := True;
890 Break;
891 end;
892 end;
893 end;
894 Inc(P.X, Area.Increment.Y);
895 end;
896 if Result then Break;
897 Inc(P.Y, Area.Increment.Y);
898 end;
899 end;
900end;
901
902function TGame.CanMoveDirection(Direction: TMoveDirection): Boolean;
903var
904 P: TPoint;
905 PNew: TPoint;
906 Area: TArea;
907begin
908 Result := False;
909 if Direction = drNone then Exit;
910 Area := GetMoveArea(Direction);
911 P := Area.P1;
912 while P.Y <> Area.P2.Y + Area.Increment.Y do begin
913 P.X := Area.P1.X;
914 while P.X <> Area.P2.X + Area.Increment.X do begin
915 PNew := P + DirectionDiff[Direction];
916 if IsValidPos(PNew) then begin
917 if (Board.Tiles[P.Y, P.X].Value <> 0) then begin
918 if (Board.Tiles[PNew.Y, PNew.X].Value = 0) or
919 CanMergeTile(Board.Tiles[PNew.Y, PNew.X].Value, Board.Tiles[P.Y, P.X].Value) then begin
920 Result := True;
921 Break;
922 end;
923 end;
924 end;
925 Inc(P.X, Area.Increment.X);
926 end;
927 if Result then Break;
928 Inc(P.Y, Area.Increment.Y);
929 end;
930end;
931
932procedure TGame.MoveAllAnimate(Direction: TMoveDirection);
933var
934 P: TPoint;
935 PNew: TPoint;
936 X, Y: Integer;
937 I: Integer;
938 StartTime: TDateTime;
939 EndTime: TDateTime;
940 Time: TDateTime;
941 Part: Double;
942 Area: TArea;
943 TileMoved: Boolean;
944begin
945 if Direction = drNone then Exit;
946 if not CanMoveDirection(Direction) then Exit;
947 FMoving := True;
948 FBoardUndo.Assign(Board);
949 FCanUndo := True;
950 Area := GetMoveArea(Direction);
951 Board.ClearMerged;
952 for I := 0 to Max(Board.Size.X, Board.Size.Y) - 1 do begin
953 for Y := 0 to Board.Size.Y - 1 do
954 for X := 0 to Board.Size.X - 1 do begin
955 Board.Tiles[Y, X].NewValue := Board.Tiles[Y, X].Value;
956 Board.Tiles[Y, X].Action := taNone;
957 end;
958
959 TileMoved := False;
960 P := Area.P1;
961 while P.Y <> Area.P2.Y + Area.Increment.Y do begin
962 P.X := Area.P1.X;
963 while P.X <> Area.P2.X + Area.Increment.X do begin
964 PNew := P + DirectionDiff[Direction];
965 if IsValidPos(PNew) then begin
966 if (Board.Tiles[P.Y, P.X].NewValue <> 0) then begin
967 if (Board.Tiles[PNew.Y, PNew.X].NewValue = 0) then begin
968 Board.Tiles[P.Y, P.X].Action := taMove;
969 Board.Tiles[PNew.Y, PNew.X].NewValue := Board.Tiles[P.Y, P.X].NewValue;
970 Board.Tiles[PNew.Y, PNew.X].Merged := Board.Tiles[P.Y, P.X].Merged;
971 Board.Tiles[P.Y, P.X].NewValue := 0;
972 Board.Tiles[P.Y, P.X].Merged := False;
973 TileMoved := True;
974 end else
975 if (not Board.Tiles[P.Y, P.X].Merged) and (not Board.Tiles[PNew.Y, PNew.X].Merged) and
976 CanMergeTile(Board.Tiles[PNew.Y, PNew.X].NewValue, Board.Tiles[P.Y, P.X].NewValue) then begin
977 Board.Tiles[P.Y, P.X].Action := taMove;
978 Board.Tiles[PNew.Y, PNew.X].NewValue := MergeTile(Board.Tiles[PNew.Y, PNew.X].NewValue, Board.Tiles[P.Y, P.X].NewValue);
979 Board.Tiles[PNew.Y, PNew.X].Merged := True;
980 Board.Tiles[P.Y, P.X].NewValue := 0;
981 Board.Tiles[P.Y, P.X].Merged := False;
982 Score := Score + GetTileSkinScore(Board.Tiles[PNew.Y, PNew.X].NewValue);
983 TileMoved := True;
984 end;
985 end;
986 end;
987 Inc(P.X, Area.Increment.X);
988 end;
989 Inc(P.Y, Area.Increment.Y);
990 end;
991 if not TileMoved then Break;
992
993 // Animate tiles move
994 StartTime := Now;
995 EndTime := StartTime + AnimationDuration / 300 * OneSecond / Max(Board.Size.X, Board.Size.Y);
996 if AnimationDuration > 0 then
997 repeat
998 Time := Now;
999 Part := (Time - StartTime) / (EndTime - StartTime);
1000 if Part > 1 then Part := 1;
1001 for Y := 0 to Board.Size.Y - 1 do
1002 for X := 0 to Board.Size.X - 1 do begin
1003 if Board.Tiles[Y, X].Action = taMove then
1004 Board.Tiles[Y, X].Shift := Point(Trunc(Part * DirectionDiff[Direction].X * 100),
1005 Trunc(Part * DirectionDiff[Direction].Y * 100));
1006 end;
1007 DoPaint;
1008 //Application.ProcessMessages;
1009 Sleep(AnimationTick);
1010 until Time > EndTime;
1011
1012 // Set final tiles values
1013 for Y := 0 to Board.Size.Y - 1 do
1014 for X := 0 to Board.Size.X - 1 do begin
1015 Board.Tiles[Y, X].Value := Board.Tiles[Y, X].NewValue;
1016 end;
1017 end;
1018
1019 // Set final tiles values
1020 for Y := 0 to Board.Size.Y - 1 do
1021 for X := 0 to Board.Size.X - 1 do begin
1022 if Board.Tiles[Y, X].Merged then
1023 Board.Tiles[Y, X].Action := taMerge;
1024 Board.Tiles[Y, X].Shift := Point(0, 0);
1025 if Board.Tiles[Y, X].Action = taMove then begin
1026 Board.Tiles[Y, X].Action := taNone;
1027 end;
1028 Board.Tiles[Y, X].Value := Board.Tiles[Y, X].NewValue;
1029 end;
1030 DoPaint;
1031 FMoving := False;
1032end;
1033
1034function TGame.CanMergeTile(Value1, Value2: Integer): Boolean;
1035begin
1036 Result := MergeTile(Value1, Value2) <> -1;
1037end;
1038
1039function TGame.MergeTile(Value1, Value2: Integer): Integer;
1040begin
1041 if Value1 = Value2 then Result := Value1 + 1
1042 else Result := -1;
1043end;
1044
1045procedure TGame.AnimateTiles;
1046var
1047 StartTime: TDateTime;
1048 EndTime: TDateTime;
1049 Time: TDateTime;
1050 Part: Double;
1051 X, Y: Integer;
1052begin
1053 FMoving := True;
1054
1055 // Animate tiles move
1056 StartTime := Now;
1057 EndTime := StartTime + AnimationDuration / 300 * OneSecond / Max(Board.Size.X, Board.Size.Y);
1058 if AnimationDuration > 0 then
1059 repeat
1060 Time := Now;
1061 Part := (Time - StartTime) / (EndTime - StartTime);
1062 if Part > 1 then Part := 1;
1063 for Y := 0 to Board.Size.Y - 1 do
1064 for X := 0 to Board.Size.X - 1 do begin
1065 if Board.Tiles[Y, X].Action = taAppear then
1066 Board.Tiles[Y, X].Shift := Point(Trunc(Part * 100), Trunc(Part * 100));
1067 if Board.Tiles[Y, X].Action = taMerge then
1068 Board.Tiles[Y, X].Shift := Point(Trunc(Part * 100), Trunc(Part * 100));
1069 end;
1070 DoPaint;
1071 //Application.ProcessMessages;
1072 Sleep(AnimationTick);
1073 until Time > EndTime;
1074
1075 for Y := 0 to Board.Size.Y - 1 do
1076 for X := 0 to Board.Size.X - 1 do
1077 if Board.Tiles[Y, X].Action <> taNone then begin
1078 Board.Tiles[Y, X].Action := taNone;
1079 Board.Tiles[Y, X].Shift := Point(0, 0);
1080 end;
1081 DoPaint;
1082 FMoving := False;
1083end;
1084
1085function IntToStrRoman(Num: Integer): string;
1086const
1087 Nvals = 13;
1088 Vals: array [1..Nvals] of Word =
1089 (1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000);
1090 Roms: array [1..Nvals] of string[2] =
1091 ('I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M');
1092var
1093 B: 1..Nvals;
1094begin
1095 Result := '';
1096 B := Nvals;
1097 while Num > 0 do
1098 begin
1099 while Vals[b] > Num do
1100 Dec(B);
1101 Dec(Num, Vals[B]);
1102 Result := Result + Roms[B];
1103 end;
1104end;
1105
1106function IntToBin(Num: Integer): string;
1107begin
1108 Result := '';
1109 while Num > 0 do begin
1110 Result := IntToStr(Num mod 2) + Result;
1111 Num := Num shr 1;
1112 end;
1113end;
1114
1115function TGame.GetTileSkinValue(Value: Integer): string;
1116begin
1117 case FSkin of
1118 tsLinear: Result := IntToStr(Value);
1119 tsPowerOfTwo: Result := IntToStr(1 shl Value);
1120 tsAlpha: Result := Chr(Ord('A') + Value - 1);
1121 tsRoman: Result := IntToStrRoman(Value);
1122 tsBinary: Result := IntToBin(Value);
1123 else Result := IntToStr(Value);
1124 end;
1125end;
1126
1127function TGame.GetTileSkinScore(Value: Integer): Integer;
1128begin
1129 case FSkin of
1130 tsLinear: Result := 1 shl Value;
1131 tsPowerOfTwo: Result := 1 shl Value;
1132 tsAlpha: Result := 1 shl Value;
1133 tsRoman: Result := 1 shl Value;
1134 tsBinary: Result := 1 shl Value;
1135 else Result := 1 shl Value;
1136 end;
1137end;
1138
1139procedure TGame.MoveAllAndUpdate(Direction: TMoveDirection; Animation: Boolean);
1140var
1141 HighestValue: Integer;
1142 HistoryMove: THistoryMove;
1143 NewTile: TTile;
1144 X, Y: Integer;
1145begin
1146 if CanMoveDirection(Direction) then begin
1147 HighestValue := Board.GetHighestTileValue;
1148 MoveAll(Direction, Animation);
1149
1150 NewTile := FillRandomTile;
1151 if Animation then AnimateTiles else begin
1152 for Y := 0 to Board.Size.Y - 1 do
1153 for X := 0 to Board.Size.X - 1 do
1154 if Board.Tiles[Y, X].Action <> taNone then begin
1155 Board.Tiles[Y, X].Action := taNone;
1156 Board.Tiles[Y, X].Shift := Point(0, 0);
1157 end;
1158 DoPaint;
1159 end;
1160
1161 if RecordHistory then begin
1162 HistoryMove := THistoryMove.Create;
1163 HistoryMove.Direction := Direction;
1164 HistoryMove.NewItemPos := NewTile.Index;
1165 HistoryMove.NewItemValue := NewTile.Value;
1166 History.Moves.Add(HistoryMove);
1167 end;
1168
1169 if not CanMove and (Board.GetEmptyTilesCount = 0) then
1170 GameOver;
1171 if (HighestValue < WinTileValue) and
1172 (Board.GetHighestTileValue >= WinTileValue) then Win;
1173 DoChange;
1174 end;
1175end;
1176
1177procedure TGame.MoveTile(SourceTile, TargetTile: TTile);
1178begin
1179 TargetTile.Value := SourceTile.Value;
1180 SourceTile.Value := 0;
1181 TargetTile.Merged := SourceTile.Merged;
1182 SourceTile.Merged := False;
1183end;
1184
1185function TGame.IsValidPos(Pos: TPoint): Boolean;
1186begin
1187 Result := (Pos.X >= 0) and (Pos.X < Board.Size.X) and
1188 (Pos.Y >= 0) and (Pos.Y < Board.Size.Y);
1189end;
1190
1191procedure TGame.SaveToRegistry(RegContext: TRegistryContext);
1192var
1193 Reg: TRegistryEx;
1194begin
1195 Reg := TRegistryEx.Create;
1196 with Reg do
1197 try
1198 CurrentContext := RegContext;
1199
1200 WriteInteger('TopScore', TopScore);
1201 WriteInteger('AnimationDuration', AnimationDuration);
1202 WriteInteger('Score', Score);
1203 WriteBool('GameRunning', FRunning);
1204 WriteBool('CanUndo', FCanUndo);
1205 WriteBool('UndoEnabled', UndoEnabled);
1206 WriteBool('RecordHistory', RecordHistory);
1207 WriteInteger('Skin', Integer(Skin));
1208 WriteInteger('ColorPalette', Integer(ColorPalette));
1209 FBoardUndo.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo'));
1210 Board.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board'));
1211 History.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\History'));
1212 finally
1213 Free;
1214 end;
1215end;
1216
1217procedure TGame.LoadFromRegistry(RegContext: TRegistryContext);
1218var
1219 Reg: TRegistryEx;
1220begin
1221 Reg := TRegistryEx.Create;
1222 with Reg do
1223 try
1224 CurrentContext := RegContext;
1225 AnimationDuration := ReadIntegerWithDefault('AnimationDuration', 30);
1226 TopScore := ReadIntegerWithDefault('TopScore', 0);
1227 Score := ReadIntegerWithDefault('Score', 0);
1228 FRunning := ReadBoolWithDefault('GameRunning', False);
1229 FCanUndo := ReadBoolWithDefault('CanUndo', False);
1230 UndoEnabled := ReadBoolWithDefault('UndoEnabled', True);
1231 RecordHistory := ReadBoolWithDefault('RecordHistory', False);
1232 Skin := TTileSkin(ReadIntegerWithDefault('Skin', Integer(tsPowerOfTwo)));
1233 ColorPalette := TColorPalette(ReadIntegerWithDefault('ColorPalette', Integer(cpOrangeYellow)));
1234 FBoardUndo.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo'));
1235 Board.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board'));
1236 History.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\History'));
1237 finally
1238 Free;
1239 end;
1240 DoChange;
1241 DoPaint;
1242end;
1243
1244constructor TGame.Create;
1245begin
1246 AnimationDuration := 30;
1247 AnimationTick := 10; // ms
1248 WinTileValue := 11; // 2^11 = 2048
1249 Board := TBoard.Create;
1250 FBoardUndo := TBoard.Create;
1251 History := THistory.Create;
1252 History.Game := Self;
1253 Value2Chance := 0.1;
1254end;
1255
1256destructor TGame.Destroy;
1257begin
1258 FreeAndNil(History);
1259 FreeAndNil(FBoardUndo);
1260 FreeAndNil(Board);
1261 inherited;
1262end;
1263
1264function TGame.GetTileColor(Value: Integer): TColor;
1265var
1266 Color: TPixel32;
1267begin
1268 if Core.Core.ThemeManager1.Theme.Name = 'Dark' then begin
1269 case Value of
1270 0: Result := $222629;
1271 1: Result := $dae4ee;
1272 2: Result := $c8e0ed;
1273 3: Result := $79b1f2;
1274 4: Result := $6395f5;
1275 5: Result := $5f7cf6;
1276 6: Result := $3b5ef6;
1277 7: Result := $72cfed;
1278 8: Result := $61cced;
1279 9: Result := $50c8ed;
1280 10: Result := $3fc5ed;
1281 11: Result := $2ec2ed;
1282 else Result := $323a3c;
1283 end;
1284 end else begin
1285 case Value of
1286 0: Result := $f2f6f9;
1287 1: Result := $dae4ee;
1288 2: Result := $c8e0ed;
1289 3: Result := $79b1f2;
1290 4: Result := $6395f5;
1291 5: Result := $5f7cf6;
1292 6: Result := $3b5ef6;
1293 7: Result := $72cfed;
1294 8: Result := $61cced;
1295 9: Result := $50c8ed;
1296 10: Result := $3fc5ed;
1297 11: Result := $2ec2ed;
1298 else Result := $323a3c;
1299 end;
1300 end;
1301
1302 Color.RGB := Result;
1303 case ColorPalette of
1304 cpOrangeYellow: Result := TColor(TPixel32.CreateRGB(Color.R, Color.G, Color.B));
1305 cpGreenYellow: Result := TColor(TPixel32.CreateRGB(Color.R, Color.B, Color.G));
1306 cpPinkBlue: Result := TColor(TPixel32.CreateRGB(Color.B, Color.R, Color.G));
1307 cpBlueCyan: Result := TColor(TPixel32.CreateRGB(Color.B, Color.G, Color.R));
1308 cpGreenCyan: Result := TColor(TPixel32.CreateRGB(Color.G, Color.B, Color.R));
1309 cpPinkRed: Result := TColor(TPixel32.CreateRGB(Color.G, Color.R, Color.B));
1310 end;
1311end;
1312
1313procedure TGame.SetRecordHistory(AValue: Boolean);
1314begin
1315 if FRecordHistory = AValue then Exit;
1316 FRecordHistory := AValue;
1317 if not FRecordHistory then History.Clear;
1318end;
1319
1320procedure TGame.SetScore(AValue: Integer);
1321begin
1322 if FScore = AValue then Exit;
1323 FScore := AValue;
1324 if FScore > TopScore then TopScore := FScore;
1325end;
1326
1327initialization
1328 Translate;
1329
1330end.
1331
Note: See TracBrowser for help on using the repository browser.