- Timestamp:
- Aug 17, 2014, 2:10:09 PM (10 years ago)
- Location:
- trunk
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormMain.pas
r46 r52 299 299 if Assigned(Cell) then begin 300 300 Core.Game.CurrentPlayer.View.FocusedCell := Cell; 301 StatusBar1.Panels[0].Text := '[' + IntToStr(Cell.Pos .X) + ', ' + IntToStr(Cell.Pos.Y) +301 StatusBar1.Panels[0].Text := '[' + IntToStr(Cell.PosPx.X) + ', ' + IntToStr(Cell.PosPx.Y) + 302 302 '] (' + IntToStr(Cell.MovesFrom.Count) + ', ' + IntToStr(Cell.MovesTo.Count) + ')'; 303 303 end else begin -
trunk/UGame.pas
r51 r52 36 36 procedure SetPower(AValue: Integer); 37 37 public 38 Pos : TPoint;38 PosPx: TPoint; 39 39 Polygon: TPointArray; 40 40 Terrain: TTerrainType; … … 43 43 MovesTo: TObjectList; // TList<TMove> 44 44 Neighbors: TObjectList; // TList<TCell> 45 procedure Assign(Source: TCell); 45 46 function GetColor: TColor; 46 47 function GetAvialPower: Integer; … … 119 120 THexMap = class(TMap) 120 121 private 121 function IsCells Neighbor2(Cell1, Cell2: TCell): Boolean;122 function GetCell Neighbors2(Cell: TCell): TCellArray;122 function IsCellsPosNeighbor(CellPos1, CellPos2: TPoint): Boolean; 123 function GetCellPosNeighbors(CellPos: TPoint): TCellArray; 123 124 function GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPointArray; 124 125 public … … 127 128 procedure SaveToFile(FileName: string); override; 128 129 function IsValidIndex(Index: TPoint): Boolean; override; 129 function PosToCell(Pos: TPoint; View: TView): TCell; override;130 function CellToPos(Cell: TCell): TPoint; override;131 130 function GetPixelRect: TRect; override; 132 131 procedure Paint(Canvas: TCanvas; View: TView); override; … … 140 139 TSquareMap = class(TMap) 141 140 private 142 function IsCellsNeighbor2(Cell1, Cell2: TCell): Boolean;143 function GetCellNeighbors2(Cell: TCell): TCellArray;144 141 function GetSquarePolygon(Pos: TPoint; Size: TPoint): TPointArray; 145 142 public 146 143 function IsValidIndex(Index: TPoint): Boolean; override; 147 function PosToCell(Pos: TPoint; View: TView): TCell; override;148 function CellToPos(Cell: TCell): TPoint; override;149 144 function GetPixelRect: TRect; override; 150 145 procedure Paint(Canvas: TCanvas; View: TView); override; … … 344 339 for X := 0 to FSize.X - 1 do begin 345 340 NewCell := TCell.Create; 346 NewCell.Pos := Point(X, Y); 341 NewCell.PosPx := Point(Trunc(X * DefaultCellSize.X * SquareCellMulX), 342 Trunc(Y * DefaultCellSize.Y * SquareCellMulY)); 343 NewCell.Polygon := GetSquarePolygon(NewCell.PosPx, DefaultCellSize); 347 344 Cells[Y * FSize.X + X] := NewCell; 348 345 end; 349 // Generate neigh tbours346 // Generate neighbours 350 347 for Y := 0 to FSize.Y - 1 do 351 348 for X := 0 to FSize.X - 1 do 352 349 with TCell(Cells[Y * FSize.X + X]) do begin 353 NeighCells := GetCellNeighbors2(TCell(Cells[Y * FSize.X + X])); 354 for I := 0 to Length(NeighCells) - 1 do 355 Neighbors.Add(NeighCells[I]); 356 Polygon := GetSquarePolygon(Point(Trunc(X * DefaultCellSize.X * SquareCellMulX), 357 Trunc(Y * DefaultCellSize.Y * SquareCellMulY)), DefaultCellSize); 358 end; 359 end; 360 361 function TSquareMap.IsCellsNeighbor2(Cell1, Cell2: TCell): Boolean; 362 var 363 DX: Integer; 364 DY: Integer; 365 MinY: Integer; 366 begin 367 if Cell1.Pos.Y < Cell2.Pos.Y then MinY:= Cell1.Pos.Y 368 else MinY := Cell2.Pos.Y; 369 DX := Cell2.Pos.X - Cell1.Pos.X; 370 DY := Cell2.Pos.Y - Cell1.Pos.Y; 371 Result := (Abs(DX) <= 1) and (Abs(DY) <= 1); 372 Result := Result and not (Cell1 = Cell2); 350 if IsValidIndex(Point(Y + 0, X + 1)) then 351 Neighbors.Add(TCell(Cells[(Y + 0) * FSize.X + (X + 1)])); 352 if IsValidIndex(Point(Y + 1, X + 0)) then 353 Neighbors.Add(TCell(Cells[(Y + 1) * FSize.X + (X + 0)])); 354 if IsValidIndex(Point(Y + 0, X - 1)) then 355 Neighbors.Add(TCell(Cells[(Y + 0) * FSize.X + (X - 1)])); 356 if IsValidIndex(Point(Y - 1, X + 0)) then 357 Neighbors.Add(TCell(Cells[(Y - 1) * FSize.X + (X + 0)])); 358 end; 373 359 end; 374 360 … … 377 363 Result := (Index.X >= 0) and (Index.X < Size.X) and 378 364 (Index.Y >= 0) and (Index.Y < Size.Y); 379 end;380 381 function TSquareMap.PosToCell(Pos: TPoint; View: TView): TCell;382 var383 CX, CY: Integer;384 X, Y: Double;385 HexSize: TFloatPoint;386 CellSize: TFloatPoint;387 Frame: TRect;388 begin389 // TODO: This is implemented as simple sequence lookup. Needs some faster algorithm390 Result := nil;391 CellSize := FloatPoint(DefaultCellSize.X * SquareCellMulX, DefaultCellSize.Y * SquareCellMulX);392 HexSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);393 with View do394 for CY := Trunc(SourceRect.Top / CellSize.Y) to Trunc(SourceRect.Bottom / CellSize.Y) + 1 do395 for CX := Trunc(SourceRect.Left / CellSize.X) to Trunc(SourceRect.Right / CellSize.X) + 1 do begin396 X := CX;397 Y := CY;398 if (CX >= 0) and (CY >= 0) and (CY < Size.Y) and (CX < Size.X) then399 if TCell(Cells[CY * FSize.X + CX]).Terrain <> ttVoid then begin400 Frame := Rect(Trunc(X * CellSize.X - HexSize.X / 2),401 Trunc(Y * CellSize.Y - HexSize.Y / 2),402 Trunc(X * CellSize.X + HexSize.X / 2),403 Trunc(Y * CellSize.Y + HexSize.Y / 2));404 if PtInRect(Frame, Pos) then begin405 Result := TCell(Cells[CY * FSize.X + CX]);406 Exit;407 end;408 end;409 end;410 end;411 412 function TSquareMap.CellToPos(Cell: TCell): TPoint;413 var414 CX, CY: Integer;415 X, Y: Double;416 HexSize: TFloatPoint;417 CellSize: TFloatPoint;418 Points: array of TPoint;419 begin420 CellSize := FloatPoint(DefaultCellSize.X * SquareCellMulX, DefaultCellSize.Y * SquareCellMulX);421 HexSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);422 X := Cell.Pos.X;423 Y := Cell.Pos.Y;424 425 Result.X := Trunc(X * CellSize.X);426 Result.Y := Trunc(Y * CellSize.Y);427 end;428 429 function TSquareMap.GetCellNeighbors2(Cell: TCell): TCellArray;430 var431 X, Y: Integer;432 begin433 SetLength(Result, 0);434 for Y := -1 to 1 do435 for X := -1 to 1 do436 if IsValidIndex(Point(Cell.Pos.X + X, Cell.Pos.Y + Y)) and437 IsCellsNeighbor2(Cell, TCell(Cells[(Cell.Pos.Y + Y) * FSize.X + (Cell.Pos.X + X)])) then begin438 SetLength(Result, Length(Result) + 1);439 Result[Length(Result) - 1] := TCell(Cells[(Cell.Pos.Y + Y) * FSize.X + (Cell.Pos.X + X)]);440 end;441 365 end; 442 366 … … 586 510 587 511 procedure TMap.Assign(Source: TMap); 512 var 513 I: Integer; 588 514 begin 589 515 MaxPower := Source.MaxPower; … … 591 517 Size := Source.Size; 592 518 DefaultCellSize := Source.DefaultCellSize; 519 FSize := Source.Size; 520 521 // Copy all cells 522 Cells.Count := 0; 523 Cells.Count := Source.Cells.Count; 524 for I := 0 to Cells.Count - 1 do begin 525 Cells[I] := TCell.Create; 526 TCell(Cells[I]).Assign(TCell(Source.Cells[I])); 527 end; 593 528 end; 594 529 … … 604 539 605 540 function TMap.PosToCell(Pos: TPoint; View: TView): TCell; 541 var 542 I: Integer; 606 543 begin 607 544 Result := nil; 545 for I := 0 to Cells.Count - 1 do 546 if TCell(Cells[I]).Terrain <> ttVoid then begin 547 if PtInPoly(TCell(Cells[I]).Polygon, Pos) then begin 548 Result := TCell(Cells[I]); 549 Exit; 550 end; 551 end; 608 552 end; 609 553 610 554 function TMap.CellToPos(Cell: TCell): TPoint; 611 555 begin 612 Result := Point(0, 0);556 Result := Cell.PosPx; 613 557 end; 614 558 … … 707 651 for X := 0 to FSize.X - 1 do begin 708 652 NewCell := TCell.Create; 709 NewCell.Pos := Point(X, Y);653 NewCell.PosPx := Point(X, Y); 710 654 Cells[Y * FSize.X + X] := NewCell; 711 655 end; … … 878 822 raise Exception.Create('Not allowed to substract power under zero do negative value'); 879 823 FPower := AValue; 824 end; 825 826 procedure TCell.Assign(Source: TCell); 827 begin 828 PosPx := Source.PosPx; 829 Terrain := Source.Terrain; 830 Polygon := Source.Polygon; 831 // TODO: How to copy neighbours and moves list 880 832 end; 881 833 … … 1478 1430 end; 1479 1431 1480 function THexMap.IsCells Neighbor2(Cell1, Cell2: TCell): Boolean;1432 function THexMap.IsCellsPosNeighbor(CellPos1, CellPos2: TPoint): Boolean; 1481 1433 var 1482 1434 DX: Integer; … … 1484 1436 MinY: Integer; 1485 1437 begin 1486 if Cell 1.Pos.Y < Cell2.Pos.Y then MinY:= Cell1.Pos.Y1487 else MinY := Cell 2.Pos.Y;1488 DX := Cell 2.Pos.X - Cell1.Pos.X;1489 DY := Cell 2.Pos.Y - Cell1.Pos.Y;1438 if CellPos1.Y < CellPos2.Y then MinY:= CellPos1.Y 1439 else MinY := CellPos2.Y; 1440 DX := CellPos2.X - CellPos1.X; 1441 DY := CellPos2.Y - CellPos1.Y; 1490 1442 Result := (Abs(DX) <= 1) and (Abs(DY) <= 1) and 1491 1443 ((((MinY mod 2) = 1) and … … 1495 1447 not ((DX = -1) and (DY = -1)) and 1496 1448 not ((DX = 1) and (DY = 1)))); 1497 Result := Result and not ( Cell1 = Cell2);1449 Result := Result and not ((CellPos1.X = CellPos2.X) and (CellPos1.Y = CellPos2.Y)); 1498 1450 end; 1499 1451 … … 1539 1491 end; 1540 1492 1541 function THexMap.GetCell Neighbors2(Cell: TCell): TCellArray;1493 function THexMap.GetCellPosNeighbors(CellPos: TPoint): TCellArray; 1542 1494 var 1543 1495 X, Y: Integer; … … 1546 1498 for Y := -1 to 1 do 1547 1499 for X := -1 to 1 do 1548 if IsValidIndex(Point(Cell .Pos.X + X, Cell.Pos.Y + Y)) and1549 IsCells Neighbor2(Cell, TCell(Cells[(Cell.Pos.Y + Y) * FSize.X + (Cell.Pos.X + X)])) then begin1500 if IsValidIndex(Point(CellPos.X + X, CellPos.Y + Y)) and 1501 IsCellsPosNeighbor(CellPos, Point((CellPos.X + X), (CellPos.Y + Y))) then begin 1550 1502 SetLength(Result, Length(Result) + 1); 1551 Result[Length(Result) - 1] := TCell(Cells[(Cell.Pos.Y + Y) * FSize.X + (Cell.Pos.X + X)]); 1552 end; 1553 end; 1554 1555 function THexMap.PosToCell(Pos: TPoint; View: TView): TCell; 1556 var 1557 CX, CY: Integer; 1558 X, Y: Double; 1559 HexSize: TFloatPoint; 1560 CellSize: TFloatPoint; 1561 begin 1562 // TODO: This is implemented as simple sequence lookup. Needs some faster algorithm 1563 Result := nil; 1564 CellSize := FloatPoint(DefaultCellSize.X / HexCellMulX, DefaultCellSize.Y / HexCellMulY); 1565 HexSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y); 1566 with View do 1567 for CY := Trunc(SourceRect.Top / CellSize.Y) to Trunc(SourceRect.Bottom / CellSize.Y) + 1 do 1568 for CX := Trunc(SourceRect.Left / CellSize.X) to Trunc(SourceRect.Right / CellSize.X) + 1 do begin 1569 X := CX; 1570 Y := CY; 1571 if (CY and 1) = 1 then begin 1572 X := X + 0.5; 1573 //Y := Y + 0.5; 1574 end; 1575 if (CX >= 0) and (CY >= 0) and (CY < Size.Y) and (CX < Size.X) then 1576 if TCell(Cells[CY * FSize.X + CX]).Terrain <> ttVoid then begin 1577 if PtInPoly(TCell(Cells[CY * FSize.X + CX]).Polygon, Pos) then begin 1578 Result := TCell(Cells[CY * FSize.X + CX]); 1579 Exit; 1580 end; 1581 end; 1582 end; 1583 end; 1584 1585 function THexMap.CellToPos(Cell: TCell): TPoint; 1586 var 1587 CX, CY: Integer; 1588 X, Y: Double; 1589 HexSize: TFloatPoint; 1590 CellSize: TFloatPoint; 1591 Points: array of TPoint; 1592 begin 1593 CellSize := FloatPoint(DefaultCellSize.X / HexCellMulX, DefaultCellSize.Y / HexCellMulY); 1594 HexSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y); 1595 X := Cell.Pos.X; 1596 Y := Cell.Pos.Y; 1597 if (Cell.Pos.Y and 1) = 1 then begin 1598 X := X + 0.5; 1599 //Y := Y + 0.5; 1600 end; 1601 1602 Result.X := Trunc(X * CellSize.X); 1603 Result.Y := Trunc(Y * CellSize.Y); 1503 Result[Length(Result) - 1] := TCell(Cells[(CellPos.Y + Y) * FSize.X + (CellPos.X + X)]); 1504 end; 1604 1505 end; 1605 1506 … … 1681 1582 for X := 0 to FSize.X - 1 do begin 1682 1583 NewCell := TCell.Create; 1683 NewCell.Pos := Point(X, Y);1684 Cells[Y * FSize.X + X] := NewCell;1685 end;1686 // Generate neightbours1687 for Y := 0 to FSize.Y - 1 do1688 for X := 0 to FSize.X - 1 do1689 with TCell(Cells[Y * FSize.X + X]) do begin1690 NeighCells := GetCellNeighbors2(TCell(Cells[Y * FSize.X + X]));1691 Neighbors.Count := Length(NeighCells);1692 for I := 0 to Length(NeighCells) - 1 do1693 Neighbors[I] := NeighCells[I];1694 1584 PX := X; 1695 1585 PY := Y; … … 1698 1588 //Y := Y + 0.5; 1699 1589 end; 1700 Polygon := GetHexagonPolygon(Point(Trunc(PX * DefaultCellSize.X / HexCellMulX), 1701 Trunc(PY * DefaultCellSize.Y / HexCellMulY)), DefaultCellSize); 1590 NewCell.PosPx := Point(Trunc(PX * DefaultCellSize.X / HexCellMulX), 1591 Trunc(PY * DefaultCellSize.Y / HexCellMulY)); 1592 NewCell.Polygon := GetHexagonPolygon(NewCell.PosPx, DefaultCellSize); 1593 Cells[Y * FSize.X + X] := NewCell; 1594 end; 1595 1596 // Generate neightbours 1597 for Y := 0 to FSize.Y - 1 do 1598 for X := 0 to FSize.X - 1 do 1599 with TCell(Cells[Y * FSize.X + X]) do begin 1600 NeighCells := GetCellPosNeighbors(Point(X, Y)); 1601 Neighbors.Count := Length(NeighCells); 1602 for I := 0 to Length(NeighCells) - 1 do 1603 Neighbors[I] := NeighCells[I]; 1702 1604 end; 1703 1605 end;
Note:
See TracChangeset
for help on using the changeset viewer.