Changeset 106 for trunk/Game.pas
- Timestamp:
- Dec 9, 2024, 8:54:41 PM (13 days ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Game.pas
r105 r106 28 28 private 29 29 FMoving: Boolean; 30 FUnmergeableTilesCount: Integer; 30 31 FOnChange: TNotifyEvent; 31 32 FOnGameOver: TNotifyEvent; … … 53 54 procedure Win; 54 55 function FillRandomTile: TTile; 56 function FillUnmergeableRandomTile: TTile; 55 57 function DisableRandomTile: TTile; 56 58 function GetMoveArea(Direction: TMoveDirection): TArea; … … 99 101 property ColorPalette: TColorPalette read FColorPalette write SetColorPalette; 100 102 property DisabledTilesCount: Integer read FDisabledTilesCount write FDisabledTilesCount; 103 property UnmergeableTilesCount: Integer read FUnmergeableTilesCount write FUnmergeableTilesCount; 101 104 end; 102 105 … … 222 225 Result := nil; 223 226 EmptyTiles := TTiles.Create(False); 224 Board.GetEmptyTiles(EmptyTiles); 225 if EmptyTiles.Count > 0 then begin 226 if Random < Value2Chance then NewValue := 2 else NewValue := 1; 227 Result := EmptyTiles[Random(EmptyTiles.Count)]; 228 Result.Value := NewValue; 229 Result.Action := taAppear; 230 end; 231 EmptyTiles.Free; 232 end; 233 234 function TGame.DisableRandomTile: TTile; 227 try 228 Board.GetEmptyTiles(EmptyTiles); 229 if EmptyTiles.Count > 0 then begin 230 if Random < Value2Chance then NewValue := 2 else NewValue := 1; 231 Result := EmptyTiles[Random(EmptyTiles.Count)]; 232 Result.Value := NewValue; 233 Result.Action := taAppear; 234 end; 235 finally 236 EmptyTiles.Free; 237 end; 238 end; 239 240 function TGame.FillUnmergeableRandomTile: TTile; 235 241 var 236 242 EmptyTiles: TTiles; … … 238 244 Result := nil; 239 245 EmptyTiles := TTiles.Create(False); 240 Board.GetEmptyTiles(EmptyTiles); 241 if EmptyTiles.Count > 0 then begin 242 Result := EmptyTiles[Random(EmptyTiles.Count)]; 243 Result.Disabled := True; 244 end; 245 EmptyTiles.Free; 246 try 247 Board.GetEmptyTiles(EmptyTiles); 248 if EmptyTiles.Count > 0 then begin 249 Result := EmptyTiles[Random(EmptyTiles.Count)]; 250 Result.Value := 1; 251 Result.Action := taNone; 252 Result.Unmergeable := True; 253 end; 254 finally 255 EmptyTiles.Free; 256 end; 257 end; 258 259 function TGame.DisableRandomTile: TTile; 260 var 261 EmptyTiles: TTiles; 262 begin 263 Result := nil; 264 EmptyTiles := TTiles.Create(False); 265 try 266 Board.GetEmptyTiles(EmptyTiles); 267 if EmptyTiles.Count > 0 then begin 268 Result := EmptyTiles[Random(EmptyTiles.Count)]; 269 Result.Disabled := True; 270 end; 271 finally 272 EmptyTiles.Free; 273 end; 246 274 end; 247 275 … … 277 305 ColorPalette := Source.ColorPalette; 278 306 RecordHistory := Source.RecordHistory; 307 DisabledTilesCount := Source.DisabledTilesCount; 308 UnmergeableTilesCount := Source.UnmergeableTilesCount; 279 309 //History.Assign(Source.History); 280 310 end; … … 293 323 Running := True; 294 324 History.Clear; 295 for I := 0 to DisabledTilesCount - 1 do 296 DisableRandomTile; 325 297 326 298 327 if RecordHistory then begin 328 for I := 0 to DisabledTilesCount - 1 do begin 329 SetLength(History.DisabledTiles, Length(History.DisabledTiles) + 1); 330 History.DisabledTiles[Length(History.DisabledTiles) - 1] := DisableRandomTile.Index; 331 end; 299 332 for I := 0 to InitialTileCount - 1 do begin 300 333 SetLength(History.InitialTiles, Length(History.InitialTiles) + 1); … … 303 336 History.InitialTiles[Length(History.InitialTiles) - 1].Value := Tile.Value; 304 337 end; 338 for I := 0 to UnmergeableTilesCount - 1 do begin 339 SetLength(History.InitialTiles, Length(History.InitialTiles) + 1); 340 Tile := FillUnmergeableRandomTile; 341 History.InitialTiles[Length(History.InitialTiles) - 1].Pos := Tile.Index; 342 History.InitialTiles[Length(History.InitialTiles) - 1].Value := Tile.Value; 343 History.InitialTiles[Length(History.InitialTiles) - 1].Unmergable := Tile.Unmergeable; 344 end; 305 345 end else begin 346 for I := 0 to DisabledTilesCount - 1 do 347 DisableRandomTile; 306 348 for I := 0 to InitialTileCount - 1 do 307 349 FillRandomTile; 350 for I := 0 to UnmergeableTilesCount - 1 do 351 FillUnmergeableRandomTile; 308 352 end; 309 353 AnimateTiles; … … 328 372 BoardRect: TRect; 329 373 Horizontal: Boolean; 374 Tile: TTile; 330 375 begin 331 376 // Form.Canvas.Width and Form.Canvas.Height is not working correctly under Windows. … … 383 428 for Y := 0 to Board.Size.Y - 1 do 384 429 for X := 0 to Board.Size.X - 1 do begin 385 if (Board.Tiles[Y, X].Action <> taNone) then MetaCanvas.Brush.Color := GetTileColor(0) 386 else MetaCanvas.Brush.Color := GetTileColor(Board.Tiles[Y, X].Value); 387 if Board.Tiles[Y, X].Disabled then MetaCanvas.Brush.Style := bsClear 430 Tile := Board.Tiles[Y, X]; 431 if (Tile.Action <> taNone) then MetaCanvas.Brush.Color := GetTileColor(0) 432 else MetaCanvas.Brush.Color := GetTileColor(Tile.Value); 433 if Tile.Disabled then MetaCanvas.Brush.Style := bsClear 388 434 else MetaCanvas.Brush.Style := bsSolid; 389 435 TileRect := Bounds( … … 391 437 Frame.Top + Y * TileSize.Y + TileMargin, 392 438 TileSize.X - 2 * TileMargin, TileSize.Y - 2 * TileMargin); 393 RenderTile(MetaCanvas, Board.Tiles[Y, X], TileRect, Board.Tiles[Y, X].Action = taNone);439 RenderTile(MetaCanvas, Tile, TileRect, Tile.Action = taNone); 394 440 end; 395 441 396 442 // Draw moving tiles 397 443 for Y := 0 to Board.Size.Y - 1 do 398 for X := 0 to Board.Size.X - 1 do 399 if Board.Tiles[Y, X].Action = taMove then begin 400 MetaCanvas.Brush.Color := GetTileColor(Board.Tiles[Y, X].Value); 401 MetaCanvas.Brush.Style := bsSolid; 402 TileRect := Bounds( 403 Frame.Left + X * TileSize.X + Trunc(Board.Tiles[Y, X].Shift.X / 100 * TileSize.X + TileMargin), 404 Frame.Top + Y * TileSize.Y + Trunc(Board.Tiles[Y, X].Shift.Y / 100 * TileSize.Y + TileMargin), 405 TileSize.X - 2 * TileMargin, TileSize.Y - 2 * TileMargin); 406 RenderTile(MetaCanvas, Board.Tiles[Y, X], TileRect, True); 444 for X := 0 to Board.Size.X - 1 do begin 445 Tile := Board.Tiles[Y, X]; 446 if Tile.Action = taMove then begin 447 MetaCanvas.Brush.Color := GetTileColor(Tile.Value); 448 MetaCanvas.Brush.Style := bsSolid; 449 TileRect := Bounds( 450 Frame.Left + X * TileSize.X + Trunc(Tile.Shift.X / 100 * TileSize.X + TileMargin), 451 Frame.Top + Y * TileSize.Y + Trunc(Tile.Shift.Y / 100 * TileSize.Y + TileMargin), 452 TileSize.X - 2 * TileMargin, TileSize.Y - 2 * TileMargin); 453 RenderTile(MetaCanvas, Tile, TileRect, True); 454 end; 407 455 end; 408 456 409 457 // Draw appearing tiles 410 458 for Y := 0 to Board.Size.Y - 1 do 411 for X := 0 to Board.Size.X - 1 do 412 if Board.Tiles[Y, X].Action = taAppear then begin 413 MetaCanvas.Brush.Color := GetTileColor(Board.Tiles[Y, X].Value); 414 MetaCanvas.Brush.Style := bsSolid; 415 TileRect := Bounds( 416 Frame.Left + X * TileSize.X + TileMargin, 417 Frame.Top + Y * TileSize.Y + TileMargin, 418 TileSize.X - 2 * TileMargin, 419 TileSize.Y - 2 * TileMargin); 420 TileCenter := TileRect.CenterPoint; 421 S := Point( 422 Trunc(Board.Tiles[Y, X].Shift.X / 100 * (TileSize.X - TileMargin)), 423 Trunc(Board.Tiles[Y, X].Shift.Y / 100 * (TileSize.Y - TileMargin)) 424 ); 425 TileRect := Rect(TileCenter.X - S.X div 2, TileCenter.Y - S.Y div 2, 426 TileCenter.X + S.X div 2, TileCenter.Y + S.Y div 2); 427 RenderTile(MetaCanvas, Board.Tiles[Y, X], TileRect, True); 459 for X := 0 to Board.Size.X - 1 do begin 460 Tile := Board.Tiles[Y, X]; 461 if Tile.Action = taAppear then begin 462 MetaCanvas.Brush.Color := GetTileColor(Tile.Value); 463 MetaCanvas.Brush.Style := bsSolid; 464 TileRect := Bounds( 465 Frame.Left + X * TileSize.X + TileMargin, 466 Frame.Top + Y * TileSize.Y + TileMargin, 467 TileSize.X - 2 * TileMargin, 468 TileSize.Y - 2 * TileMargin); 469 TileCenter := TileRect.CenterPoint; 470 S := Point( 471 Trunc(Tile.Shift.X / 100 * (TileSize.X - TileMargin)), 472 Trunc(Tile.Shift.Y / 100 * (TileSize.Y - TileMargin)) 473 ); 474 TileRect := Rect(TileCenter.X - S.X div 2, TileCenter.Y - S.Y div 2, 475 TileCenter.X + S.X div 2, TileCenter.Y + S.Y div 2); 476 RenderTile(MetaCanvas, Tile, TileRect, True); 477 end; 428 478 end; 429 479 430 480 // Draw merging tiles 431 481 for Y := 0 to Board.Size.Y - 1 do 432 for X := 0 to Board.Size.X - 1 do 433 if Board.Tiles[Y, X].Action = taMerge then begin 434 MetaCanvas.Brush.Color := GetTileColor(Board.Tiles[Y, X].Value); 435 MetaCanvas.Brush.Style := bsSolid; 436 TileRect := Bounds( 437 Frame.Left + X * TileSize.X + TileMargin, 438 Frame.Top + Y * TileSize.Y + TileMargin, 439 TileSize.X - 2 * TileMargin, 440 TileSize.Y - 2 * TileMargin); 441 S := Point( 442 Trunc((50 - Abs(Board.Tiles[Y, X].Shift.X - 50)) / 50 * TileMargin), 443 Trunc((50 - Abs(Board.Tiles[Y, X].Shift.Y - 50)) / 50 * TileMargin) 444 ); 445 TileRect := Rect(TileRect.Left - S.X, TileRect.Top - S.Y, 446 TileRect.Right + S.X, TileRect.Bottom + S.Y); 447 RenderTile(MetaCanvas, Board.Tiles[Y, X], TileRect, True); 482 for X := 0 to Board.Size.X - 1 do begin 483 Tile := Board.Tiles[Y, X]; 484 if Tile.Action = taMerge then begin 485 MetaCanvas.Brush.Color := GetTileColor(Tile.Value); 486 MetaCanvas.Brush.Style := bsSolid; 487 TileRect := Bounds( 488 Frame.Left + X * TileSize.X + TileMargin, 489 Frame.Top + Y * TileSize.Y + TileMargin, 490 TileSize.X - 2 * TileMargin, 491 TileSize.Y - 2 * TileMargin); 492 S := Point( 493 Trunc((50 - Abs(Tile.Shift.X - 50)) / 50 * TileMargin), 494 Trunc((50 - Abs(Tile.Shift.Y - 50)) / 50 * TileMargin) 495 ); 496 TileRect := Rect(TileRect.Left - S.X, TileRect.Top - S.Y, 497 TileRect.Right + S.X, TileRect.Bottom + S.Y); 498 RenderTile(MetaCanvas, Tile, TileRect, True); 499 end; 448 500 end; 449 501 … … 487 539 DstTile.Value := SrcTile.Value; 488 540 DstTile.Merged := SrcTile.Merged; 541 DstTile.Unmergeable := SrcTile.Unmergeable; 489 542 SrcTile.Value := 0; 490 543 SrcTile.Merged := False; 544 SrcTile.Unmergeable := False; 491 545 TileMoved := True; 492 546 end else 493 547 if (not SrcTile.Merged) and (not DstTile.Merged) and 494 CanMergeTile(DstTile.Value, SrcTile.Value) then begin 548 CanMergeTile(DstTile.Value, SrcTile.Value) and 549 not SrcTile.Unmergeable and not DstTile.Unmergeable then begin 495 550 DstTile.Value := MergeTile(DstTile.Value, SrcTile.Value); 496 551 DstTile.Merged := True; … … 521 576 Canvas.Pen.Style := psClear; 522 577 Canvas.RoundRect(TileRect, ScaleX(TileRect.Width div 20, 96), ScaleY(TileRect.Height div 20, 96)); 523 if (WithText and (Tile.Value <> 0)) then begin 524 ValueStr := GetTileSkinValue(Tile.Value); 578 if WithText and (Tile.Value <> 0) then begin 579 if Tile.Disabled then ValueStr := '@' 580 else if Tile.Unmergeable then ValueStr := '' 581 else ValueStr := GetTileSkinValue(Tile.Value); 525 582 Canvas.Brush.Style := bsClear; 526 583 Canvas.Font.Height := Trunc(TileRect.Height * 0.7); … … 676 733 Area: TArea; 677 734 TileMoved: Boolean; 735 SrcTile: TTile; 736 DstTile: TTile; 737 Tile: TTile; 678 738 begin 679 739 if Direction = drNone then Exit; … … 685 745 Board.ClearMerged; 686 746 for I := 0 to Max(Board.Size.X, Board.Size.Y) - 1 do begin 747 // Init new values 687 748 for Y := 0 to Board.Size.Y - 1 do 688 749 for X := 0 to Board.Size.X - 1 do begin 689 Board.Tiles[Y, X].NewValue := Board.Tiles[Y, X].Value; 690 Board.Tiles[Y, X].Action := taNone; 750 Tile := Board.Tiles[Y, X]; 751 Tile.NewValue := Tile.Value; 752 Tile.NewUnmergeable := Tile.Unmergeable; 753 Tile.Action := taNone; 691 754 end; 692 755 … … 698 761 PNew := P + DirectionDiff[Direction]; 699 762 if IsValidPos(PNew) and not Board.Tiles[PNew.Y, PNew.X].Disabled then begin 700 if (Board.Tiles[P.Y, P.X].NewValue <> 0) then begin 701 if (Board.Tiles[PNew.Y, PNew.X].NewValue = 0) then begin 702 Board.Tiles[P.Y, P.X].Action := taMove; 703 Board.Tiles[PNew.Y, PNew.X].NewValue := Board.Tiles[P.Y, P.X].NewValue; 704 Board.Tiles[PNew.Y, PNew.X].Merged := Board.Tiles[P.Y, P.X].Merged; 705 Board.Tiles[P.Y, P.X].NewValue := 0; 706 Board.Tiles[P.Y, P.X].Merged := False; 763 SrcTile := Board.Tiles[P.Y, P.X]; 764 DstTile := Board.Tiles[PNew.Y, PNew.X]; 765 if (SrcTile.NewValue <> 0) then begin 766 if (DstTile.NewValue = 0) then begin 767 SrcTile.Action := taMove; 768 DstTile.NewValue := SrcTile.NewValue; 769 DstTile.Merged := SrcTile.Merged; 770 DstTile.NewUnmergeable := SrcTile.NewUnmergeable; 771 SrcTile.NewValue := 0; 772 SrcTile.Merged := False; 773 SrcTile.NewUnmergeable := False; 707 774 TileMoved := True; 708 775 end else 709 if (not Board.Tiles[P.Y, P.X].Merged) and (not Board.Tiles[PNew.Y, PNew.X].Merged) and 710 CanMergeTile(Board.Tiles[PNew.Y, PNew.X].NewValue, Board.Tiles[P.Y, P.X].NewValue) then begin 711 Board.Tiles[P.Y, P.X].Action := taMove; 712 Board.Tiles[PNew.Y, PNew.X].NewValue := MergeTile(Board.Tiles[PNew.Y, PNew.X].NewValue, Board.Tiles[P.Y, P.X].NewValue); 713 Board.Tiles[PNew.Y, PNew.X].Merged := True; 714 Board.Tiles[P.Y, P.X].NewValue := 0; 715 Board.Tiles[P.Y, P.X].Merged := False; 716 Score := Score + GetTileSkinScore(Board.Tiles[PNew.Y, PNew.X].NewValue); 776 if (not SrcTile.Merged) and (not DstTile.Merged) and 777 CanMergeTile(DstTile.NewValue, SrcTile.NewValue) and 778 not SrcTile.NewUnmergeable and not DstTile.NewUnmergeable then begin 779 SrcTile.Action := taMove; 780 DstTile.NewValue := MergeTile(DstTile.NewValue, SrcTile.NewValue); 781 DstTile.Merged := True; 782 SrcTile.NewValue := 0; 783 SrcTile.Merged := False; 784 Score := Score + GetTileSkinScore(DstTile.NewValue); 717 785 TileMoved := True; 718 786 end; … … 747 815 for Y := 0 to Board.Size.Y - 1 do 748 816 for X := 0 to Board.Size.X - 1 do begin 749 Board.Tiles[Y, X].Value := Board.Tiles[Y, X].NewValue; 817 Tile := Board.Tiles[Y, X]; 818 Tile.Value := Tile.NewValue; 819 Tile.Unmergeable := Tile.NewUnmergeable; 750 820 end; 751 821 end; … … 754 824 for Y := 0 to Board.Size.Y - 1 do 755 825 for X := 0 to Board.Size.X - 1 do begin 756 if Board.Tiles[Y, X].Merged then 757 Board.Tiles[Y, X].Action := taMerge; 758 Board.Tiles[Y, X].Shift := Point(0, 0); 759 if Board.Tiles[Y, X].Action = taMove then begin 760 Board.Tiles[Y, X].Action := taNone; 826 Tile := Board.Tiles[Y, X]; 827 if Tile.Merged then 828 Tile.Action := taMerge; 829 Tile.Shift := Point(0, 0); 830 if Tile.Action = taMove then begin 831 Tile.Action := taNone; 761 832 end; 762 Board.Tiles[Y, X].Value := Board.Tiles[Y, X].NewValue;833 Tile.Value := Tile.NewValue; 763 834 end; 764 835 DoPaint; … … 823 894 Board.Clear; 824 895 Score := 0; 825 for I := 0 to Length(History.InitialTiles) - 1 do 896 for I := 0 to Length(History.InitialTiles) - 1 do begin 826 897 Board.Tiles[History.InitialTiles[I].Pos.Y, History.InitialTiles[I].Pos.X].Value := History.InitialTiles[I].Value; 898 Board.Tiles[History.InitialTiles[I].Pos.Y, History.InitialTiles[I].Pos.X].Unmergeable := History.InitialTiles[I].Unmergable; 899 end; 900 for I := 0 to Length(History.DisabledTiles) - 1 do begin 901 Board.Tiles[History.DisabledTiles[I].Y, History.DisabledTiles[I].X].Disabled := True; 902 end; 827 903 for I := 0 to Step - 1 do 828 with History.Moves[I] do begin904 with History.Moves[I] do begin 829 905 MoveAll(Direction, False); 830 906 if Board.Tiles[NewItemPos.Y, NewItemPos.X].Value = 0 then … … 959 1035 WriteInteger('ColorPalette', Integer(ColorPalette)); 960 1036 WriteInteger('DisabledTilesCount', DisabledTilesCount); 1037 WriteInteger('UnmergeableTilesCount', UnmergeableTilesCount); 961 1038 FBoardUndo.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo')); 962 1039 Board.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board')); … … 985 1062 ColorPalette := TColorPalette(ReadIntegerWithDefault('ColorPalette', Integer(cpOrangeYellow))); 986 1063 DisabledTilesCount := ReadIntegerWithDefault('DisabledTilesCount', DisabledTilesCount); 1064 UnmergeableTilesCount := ReadIntegerWithDefault('UnmergeableTilesCount', UnmergeableTilesCount); 987 1065 FBoardUndo.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo')); 988 1066 Board.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board'));
Note:
See TracChangeset
for help on using the changeset viewer.