- Timestamp:
- Aug 17, 2014, 4:40:08 PM (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/UGame.pas
r53 r54 13 13 HexCellMulX = 1.12; 14 14 HexCellMulY = 1.292; 15 SquareCellMulX = 1.1; 16 SquareCellMulY = 1.1; 15 SquareCellMulX = 1.05; 16 SquareCellMulY = 1.05; 17 TriangleCellMulX = 0.55; 18 TriangleCellMulY = 1.05; 17 19 MaxPlayerCount = 8; 18 20 … … 126 128 function GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPointArray; 127 129 public 128 procedure Assign(Source: TMap); override;129 130 procedure LoadFromFile(FileName: string); override; 130 131 procedure SaveToFile(FileName: string); override; 131 132 function IsValidIndex(Index: TPoint): Boolean; override; 132 function GetPixelRect: TRect; override;133 133 procedure Generate; override; 134 constructor Create; override;135 destructor Destroy; override;136 134 end; 137 135 … … 143 141 public 144 142 function IsValidIndex(Index: TPoint): Boolean; override; 145 function GetPixelRect: TRect; override;146 143 procedure Generate; override; 147 constructor Create; override; 148 destructor Destroy; override; 144 end; 145 146 { TTriangleMap } 147 148 TTriangleMap = class(TMap) 149 private 150 function GetTrianglePolygon(Pos: TPoint; Size: TPoint; Reverse: Boolean): TPointArray; 151 public 152 function IsValidIndex(Index: TPoint): Boolean; override; 153 procedure Generate; override; 149 154 end; 150 155 … … 186 191 FCellFrom: TCell; 187 192 FCellTo: TCell; 188 FDestroying: Boolean;189 193 procedure SetCellFrom(AValue: TCell); 190 194 procedure SetCellTo(AValue: TCell); … … 206 210 TGrowAmount = (gaByOne, gaBySquareRoot); 207 211 TGrowCells = (gcNone, gcPlayerCities, gcPlayerAll); 208 TMapType = (mtNone, mtHexagon, mtSquare );212 TMapType = (mtNone, mtHexagon, mtSquare, mtTriangle); 209 213 TWinObjective = (woDefeatAllOponents, woDefeatAllOponentsCities, 210 214 woSpecialCaptureCell, woStayAliveForDefinedTurns); … … 341 345 end; 342 346 347 { TTriangleMap } 348 349 function TTriangleMap.GetTrianglePolygon(Pos: TPoint; Size: TPoint; 350 Reverse: Boolean): TPointArray; 351 var 352 Rev: Integer; 353 begin 354 if Reverse then Rev := -1 355 else Rev := 1; 356 SetLength(Result, 3); 357 Result[0] := Point(Trunc(Pos.X - Size.X / 2), Trunc(Pos.Y - (Size.Y * 0.8) / 2 * Rev)); 358 Result[1] := Point(Trunc(Pos.X + Size.X / 2), Trunc(Pos.Y - (Size.Y * 0.8) / 2 * Rev)); 359 Result[2] := Point(Trunc(Pos.X), Trunc(Pos.Y + (Size.Y * 1.2) / 2 * Rev)); 360 end; 361 362 function TTriangleMap.IsValidIndex(Index: TPoint): Boolean; 363 begin 364 Result := (Index.X >= 0) and (Index.X < Size.X) and 365 (Index.Y >= 0) and (Index.Y < Size.Y); 366 end; 367 368 procedure TTriangleMap.Generate; 369 var 370 X, Y: Integer; 371 Rev: Integer; 372 Reverse: Boolean; 373 NewCell: TCell; 374 begin 375 inherited; 376 // Free previous 377 Cells.Count := 0; 378 // Allocate and init new 379 Cells.Count := FSize.Y * FSize.X; 380 for Y := 0 to FSize.Y - 1 do 381 for X := 0 to FSize.X - 1 do begin 382 NewCell := TCell.Create; 383 Reverse := Boolean(X mod 2) xor Boolean(Y mod 2); 384 if Reverse then Rev := -1 385 else Rev := 1; 386 NewCell.PosPx := Point(Trunc(X * DefaultCellSize.X * TriangleCellMulX), 387 Trunc((Y * DefaultCellSize.Y * TriangleCellMulY) - (0.1 * Rev * DefaultCellSize.Y))); 388 NewCell.Polygon := GetTrianglePolygon(NewCell.PosPx, DefaultCellSize, Reverse); 389 Cells[Y * FSize.X + X] := NewCell; 390 end; 391 392 // Generate neighbours 393 for Y := 0 to self.FSize.Y - 1 do 394 for X := 0 to FSize.X - 1 do 395 with TCell(Cells[Y * FSize.X + X]) do begin 396 if Boolean(X mod 2) xor Boolean(Y mod 2) then Rev := -1 397 else Rev := 1; 398 if IsValidIndex(Point(X + 1, Y + 0)) then 399 Neighbors.Add(TCell(Cells[(Y + 0) * FSize.X + (X + 1)])); 400 if IsValidIndex(Point(X + 0, Y - 1 * Rev)) then 401 Neighbors.Add(TCell(Cells[(Y - 1 * Rev) * FSize.X + (X + 0)])); 402 if IsValidIndex(Point(X - 1, Y + 0)) then 403 Neighbors.Add(TCell(Cells[(Y + 0) * FSize.X + (X - 1)])); 404 end; 405 end; 406 343 407 { TSquareMap } 344 408 … … 346 410 var 347 411 X, Y: Integer; 348 I: Integer;349 412 NewCell: TCell; 350 NeighCells: TCellArray;351 413 begin 352 414 inherited; … … 367 429 for X := 0 to FSize.X - 1 do 368 430 with TCell(Cells[Y * FSize.X + X]) do begin 369 if IsValidIndex(Point( Y + 0, X + 1)) then431 if IsValidIndex(Point(X + 1, Y + 0)) then 370 432 Neighbors.Add(TCell(Cells[(Y + 0) * FSize.X + (X + 1)])); 371 if IsValidIndex(Point( Y + 1, X + 0)) then433 if IsValidIndex(Point(X + 0, Y + 1)) then 372 434 Neighbors.Add(TCell(Cells[(Y + 1) * FSize.X + (X + 0)])); 373 if IsValidIndex(Point( Y + 0, X - 1)) then435 if IsValidIndex(Point(X - 1, Y + 0)) then 374 436 Neighbors.Add(TCell(Cells[(Y + 0) * FSize.X + (X - 1)])); 375 if IsValidIndex(Point( Y - 1, X + 0)) then437 if IsValidIndex(Point(X + 0, Y - 1)) then 376 438 Neighbors.Add(TCell(Cells[(Y - 1) * FSize.X + (X + 0)])); 377 439 end; … … 391 453 Result[2] := Point(Trunc(Pos.X + Size.X / 2), Trunc(Pos.Y + Size.Y / 2)); 392 454 Result[3] := Point(Trunc(Pos.X - Size.X / 2), Trunc(Pos.Y + Size.Y / 2)); 393 end;394 395 function TSquareMap.GetPixelRect: TRect;396 begin397 Result := Bounds(Trunc(-0.5 * DefaultCellSize.X),398 Trunc(-0.5 * DefaultCellSize.Y),399 Trunc((Size.X + 0.5) * DefaultCellSize.X),400 Trunc(((Size.Y + 0.5) * 0.78) * DefaultCellSize.Y));401 end;402 403 constructor TSquareMap.Create;404 begin405 inherited;406 end;407 408 destructor TSquareMap.Destroy;409 begin410 inherited Destroy;411 455 end; 412 456 … … 484 528 Size := Source.Size; 485 529 DefaultCellSize := Source.DefaultCellSize; 486 FSize := Source.Size;530 //FSize := Source.Size; 487 531 488 532 // Copy all cells … … 530 574 I: Integer; 531 575 Addition: Integer; 532 Cells: TCellArray; 533 begin 534 Cells := GetAllCells; 535 for I := 0 to Length(Cells) - 1 do 576 begin 577 for I := 0 to Cells.Count - 1 do 536 578 with TCell(Cells[I]) do begin 537 579 if (Player = APlayer) and ((Game.GrowCells = gcPlayerAll) or … … 590 632 procedure TMap.ComputePlayerStats; 591 633 var 592 Cells: TCellArray; 593 I: Integer; 594 begin 595 Cells := GetAllCells; 596 for I := 0 to Length(Cells) - 1 do 597 with Cells[I] do begin 634 I: Integer; 635 begin 636 for I := 0 to Cells.Count - 1 do 637 with TCell(Cells[I]) do begin 598 638 if Assigned(Player) then begin 599 639 Player.TotalCells := Player.TotalCells + 1; … … 630 670 DefaultCellSize := Point(62, 62); 631 671 Cells := TObjectList.create; 672 Size := Point(0, 0); 632 673 end; 633 674 … … 650 691 function TMap.GetPixelRect: TRect; 651 692 var 652 Cells: TCellArray; 653 I: Integer; 654 CellPos: TPoint; 693 I: Integer; 694 CellRect: TRect; 655 695 begin 656 696 Result := Rect(0, 0, 0, 0); 657 // This is generic iterative algorithm to determine map pixel size 658 Cells := GetAllCells; 659 for I := 0 to Length(Cells) - 1 do begin 660 CellPos := CellToPos(Cells[I]); 661 if I = 0 then Result := Rect(CellPos.X, CellPos.Y, CellPos.X, CellPos.Y) 697 // This is generic algorithm to determine pixel size of entire map 698 for I := 0 to Cells.Count - 1 do begin 699 CellRect := GetPolygonRect(TCell(Cells[I]).Polygon); 700 if I = 0 then Result := CellRect 662 701 else begin 663 if Cell Pos.X > Result.Right then Result.Right := CellPos.X;664 if Cell Pos.Y > Result.Bottom then Result.Bottom := CellPos.Y;665 if Cell Pos.X < Result.Left then Result.Left := CellPos.X;666 if Cell Pos.Y < Result.Top then Result.Top := CellPos.Y;702 if CellRect.Right > Result.Right then Result.Right := CellRect.Right; 703 if CellRect.Bottom > Result.Bottom then Result.Bottom := CellRect.Bottom; 704 if CellRect.Left < Result.Left then Result.Left := CellRect.Left; 705 if CellRect.Top < Result.Top then Result.Top := CellRect.Top; 667 706 end; 668 707 end; … … 889 928 procedure TPlayer.ComputerTurn; 890 929 var 891 AllCells: T CellArray;930 AllCells: TObjectList; 892 931 Cells: TCellArray; 893 932 X, Y: Integer; … … 899 938 CanAttack: Integer; 900 939 begin 901 AllCells := Game.Map. GetAllCells;902 for C := 0 to Length(AllCells)- 1 do903 with AllCells[C]do begin940 AllCells := Game.Map.Cells; 941 for C := 0 to AllCells.Count - 1 do 942 with TCell(AllCells[C]) do begin 904 943 if (Terrain <> ttVoid) and (Player <> Self) then begin 905 944 // Attack to not owned cell yet 906 945 // Count own possible power 907 Cells := Game.Map.GetCellNeighbors( AllCells[C]);946 Cells := Game.Map.GetCellNeighbors(TCell(AllCells[C])); 908 947 TotalPower := 0; 909 948 for I := 0 to Length(Cells) - 1 do … … 920 959 if Cells[I].GetAvialPower < AttackPower then 921 960 AttackPower := Cells[I].GetAvialPower; 922 Game.SetMove(Cells[I], AllCells[C], AttackPower);961 Game.SetMove(Cells[I], TCell(AllCells[C]), AttackPower); 923 962 TotalAttackPower := TotalAttackPower + AttackPower; 924 963 end; … … 929 968 // We need to move available power to borders to be available for attacks 930 969 // or defense 931 Cells := Game.Map.GetCellNeighbors( AllCells[C]);970 Cells := Game.Map.GetCellNeighbors(TCell(AllCells[C])); 932 971 CanAttack := 0; 933 972 for I := 0 to Length(Cells) - 1 do … … 939 978 // For simplicty just try to balance inner area cells power 940 979 for I := 0 to Length(Cells) - 1 do 941 if (Cells[I].Player = Self) and (Cells[I].Power < AllCells[C].GetAvialPower) then begin942 Game.SetMove( AllCells[C], Cells[I], (AllCells[C].GetAvialPower - Cells[I].Power) div 2);980 if (Cells[I].Player = Self) and (Cells[I].Power < TCell(AllCells[C]).GetAvialPower) then begin 981 Game.SetMove(TCell(AllCells[C]), Cells[I], (TCell(AllCells[C]).GetAvialPower - Cells[I].Power) div 2); 943 982 end; 944 983 end; … … 950 989 var 951 990 NewSelectedCell: TCell; 952 TopLeft: TPoint;953 BottomRight: TPoint;954 991 begin 955 992 NewSelectedCell := Game.Map.PosToCell(CanvasToCellPos(Pos), Self); … … 1090 1127 mtHexagon: Map := THexMap.Create; 1091 1128 mtSquare: Map := TSquareMap.Create; 1129 mtTriangle: Map := TTriangleMap.Create; 1092 1130 else Map := TMap.Create; 1093 1131 end; … … 1422 1460 end; 1423 1461 1424 procedure THexMap.Assign(Source: TMap);1425 begin1426 inherited;1427 end;1428 1429 1462 procedure THexMap.LoadFromFile(FileName: string); 1430 1463 var … … 1560 1593 end; 1561 1594 1562 constructor THexMap.Create;1563 begin1564 inherited;1565 FSize := Point(0, 0);1566 end;1567 1568 destructor THexMap.Destroy;1569 begin1570 inherited Destroy;1571 end;1572 1573 function THexMap.GetPixelRect: TRect;1574 begin1575 Result := Bounds(Trunc(-0.5 * DefaultCellSize.X),1576 Trunc(-0.5 * DefaultCellSize.Y),1577 Trunc((Size.X + 0.5) * DefaultCellSize.X),1578 Trunc(((Size.Y + 0.5) * 0.78) * DefaultCellSize.Y));1579 end;1580 1581 1595 end. 1582 1596
Note:
See TracChangeset
for help on using the changeset viewer.