Changeset 165


Ignore:
Timestamp:
Nov 22, 2017, 4:48:33 PM (7 years ago)
Author:
chronos
Message:
  • Added: Optimization phase for voronoi map generation.
Location:
trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/Packages/Common/UGeometry.pas

    r164 r165  
    1414
    1515  TLine = record
     16  private
     17    function GetDistance: Double;
     18    procedure SetDistance(AValue: Double);
     19  public
    1620    P1: TPoint;
    1721    P2: TPoint;
    1822    function Create(P1, P2: TPoint): TLine;
    19     function Distance: Double;
    2023    function GetMiddle: TPoint;
    2124    function GetAngle: Double;
     
    2528    procedure Rotate(Angle: Double);
    2629    class operator Equal(A, B: TLine): Boolean;
     30    property Distance: Double read GetDistance write SetDistance;
    2731  end;
    2832
     
    5660function PointInRect(P: TPoint; aRect: TRect): Boolean;
    5761function HalfDistancePoint(P1, P2: TPoint): TPoint;
     62function NormalizeAngle(Angle: Double): Double;
     63function SubAngle(A1, A2: Double): Double;
    5864
    5965implementation
     
    208214begin
    209215  Result := Point(P1.X + (P2.X - P1.X) div 2, P1.Y + (P2.Y - P1.Y) div 2)
     216end;
     217
     218function NormalizeAngle(Angle: Double): Double;
     219begin
     220  if Angle < 0 then Result := Angle + (Trunc(Angle / (2 * Pi)) + 1) * (2 * Pi)
     221  else if Angle > 2 * Pi then Result := Angle - Trunc(Angle / (2 * Pi)) * (2 * Pi)
     222  else Result := Angle;
     223end;
     224
     225function SubAngle(A1, A2: Double): Double;
     226begin
     227  A1 := NormalizeAngle(A1);
     228  A2 := NormalizeAngle(A2);
     229  if A1 < A2 then Result := A1 + 2 * Pi - A2
     230    else Result := A1 - A2;
    210231end;
    211232
     
    310331      end else begin
    311332        // Crossing line, end polygon. If point NewPolygonStarted, the use polygon as result
     333        NewPoly.AddPoint(Points[I]);
    312334        NewPoly.AddPoint(Intersection);
    313335        if NewPoly.IsPointInside(PointInside) then begin
     
    326348    if PointsChecked > 2 * Length(Points) then Break;
    327349  end;
    328   if Success then Points := NewPoly.Points
    329     else Clear;
     350  if Success then Points := NewPoly.Points;
    330351end;
    331352
    332353{ TLine }
     354
     355function TLine.GetDistance: Double;
     356begin
     357  Result := Sqrt(Sqr(P2.X - P1.X) + Sqr(P2.Y - P1.Y));
     358end;
     359
     360procedure TLine.SetDistance(AValue: Double);
     361var
     362  Angle: Double;
     363begin
     364  Angle := GetAngle;
     365  P2 := Point(Round(P1.X + Cos(Angle) * AValue),
     366    Round(P1.Y + Sin(Angle) * AValue));
     367end;
    333368
    334369function TLine.Create(P1, P2: TPoint): TLine;
     
    336371  Result.P1 := P1;
    337372  Result.P2 := P2;
    338 end;
    339 
    340 function TLine.Distance: Double;
    341 begin
    342   Result := Sqrt(Sqr(P2.X - P1.X) + Sqr(P2.Y - P1.Y));
    343373end;
    344374
  • trunk/UGame.pas

    r164 r165  
    77uses
    88  Classes, SysUtils, ExtCtrls, Graphics, XMLConf, XMLRead, XMLWrite,
    9   DOM, Math, LazFileUtils, UXMLUtils, Dialogs, Types, LCLType, LCLIntf, fgl;
     9  DOM, Math, LazFileUtils, UXMLUtils, Dialogs, Types, LCLType, LCLIntf, fgl,
     10  UGeometry;
    1011
    1112const
     
    6061    Mark: Boolean; // Temporary value
    6162    Weight: Integer; // Temporary value
     63    Angle: Double; // Temporary value
    6264    Links: TCellLinks;
     65    procedure ConnectTo(Cell: TCell);
     66    procedure DisconnectFrom(Cell: TCell);
    6367    procedure Check;
    6468    function NeighboringToVoid: Boolean;
     
    9397    procedure ClearMark;
    9498    procedure ClearWeight;
     99    function ToString: ansistring; override;
    95100  end;
    96101
     
    115120    procedure LoadFromNode(Node: TDOMNode);
    116121    procedure SaveToNode(Node: TDOMNode);
     122  end;
     123
     124  { TCellLinkParams }
     125
     126  TCellLinkParams = class
     127    Cell1: TCell;
     128    Cell2: TCell;
     129    Distance: Double;
     130    Angle: Double;
    117131  end;
    118132
     
    187201    FNewCellId: Integer;
    188202    function GetNewCellId: Integer; virtual;
     203    procedure SortNeighborsByAngle;
    189204  public
    190205    Game: TGame;
     
    10321047        Player.Game.Map.PaintCell(Canvas, Cell.MapCell.PosPx, '', View, Cell.MapCell);
    10331048      end;
    1034 
    1035       {// Draw links to neighbors
     1049    end;
     1050
     1051{    // Draw links to neighbors
     1052    for Cell in Cells do begin
    10361053      for NeighCell in Cell.MapCell.Neighbors do begin
    10371054        Pen.Color := clYellow;
     
    10391056        LineTo(View.CellToCanvasPos(NeighCell.PosPx));
    10401057      end;
    1041       }
    1042     end;
    1043 
     1058
     1059      Font.Color := clRed;
     1060      Brush.Style := bsClear;
     1061      TextOut(View.CellToCanvasPos(Cell.MapCell.PosPx).X,
     1062        View.CellToCanvasPos(Cell.MapCell.PosPx).Y, IntToStr(Cell.MapCell.Id));
     1063    end;
     1064 }
    10441065    // Draw arrows
    10451066    Pen.Color := clCream;
     
    11661187end;
    11671188
     1189function TCells.ToString: ansistring;
     1190var
     1191  C: TCell;
     1192begin
     1193  Result := '';
     1194  for C in Self do
     1195    Result := Result + IntToStr(C.Id) + ', ';
     1196end;
     1197
    11681198{ TPlayers }
    11691199
     
    13531383    FSize := AValue;
    13541384    if FUpdateCount = 0 then Generate;
     1385  end;
     1386end;
     1387
     1388function CompareCellAngle(const C1, C2: TCell): Integer;
     1389begin
     1390  if C1.Angle < C2.Angle then Result := -1
     1391  else if C1.Angle > C2.Angle then Result := 1
     1392  else Result := 0;
     1393end;
     1394
     1395procedure TMap.SortNeighborsByAngle;
     1396var
     1397  Cell: TCell;
     1398  NeighborCell: TCell;
     1399begin
     1400  for Cell in Cells do begin
     1401    for NeighborCell in Cell.Neighbors do
     1402      NeighborCell.Angle := ArcTan2Point(Point(
     1403        NeighborCell.PosPx.X - Cell.PosPx.X,
     1404        NeighborCell.PosPx.Y - Cell.PosPx.Y));
     1405
     1406    Cell.Neighbors.Sort(CompareCellAngle);
    13551407  end;
    13561408end;
     
    18961948  FPower := AValue;
    18971949  //Check;
     1950end;
     1951
     1952procedure TCell.ConnectTo(Cell: TCell);
     1953begin
     1954  Cell.Neighbors.Add(Self);
     1955  Neighbors.Add(Cell);
     1956end;
     1957
     1958procedure TCell.DisconnectFrom(Cell: TCell);
     1959var
     1960  I: Integer;
     1961begin
     1962  I := Cell.Neighbors.IndexOf(Self);
     1963  if I >= 0 then Cell.Neighbors.Delete(I) else
     1964    raise Exception.Create('Can''t disconnect neigboring cells.');
     1965  I := Neighbors.IndexOf(Cell);
     1966  if I >= 0 then Neighbors.Delete(I)
     1967    else Exception.Create('Can''t disconnect neigboring cells.');
    18981968end;
    18991969
  • trunk/UMap.pas

    r164 r165  
    271271  Intersection: TPoint;
    272272  CellDistance: TCellsDistance;
    273   R1, R2: TRect;
    274273  Cell: TCell;
    275   CellsAngle: TObjectList; // TObjecTList<TCellsDistance>
    276   CellAngle: TCellsDistance;
    277   NextCellAngle: TCellsDistance;
    278274  L1, L2: TLine;
    279275  MP: TPoint;
    280276  LinkLine: TLine;
    281277  Polygon: TPolygon;
     278  //LeftLink: TCellsDistance;
     279  //CenterLink: TCellsDistance;
     280  //RightLink: TCellsDistance;
     281  LeftClosingLine1: TLine;
     282  LeftClosingLine2: TLine;
     283  RightClosingLine1: TLine;
     284  RightClosingLine2: TLine;
     285  CurrentAngle: Double;
     286  LeftAngle: Double;
     287  RightAngle: Double;
     288  CenterCell: TCell;
     289  LeftCell: TCell;
     290  RightCell: TCell;
     291  LeftIndex: Integer;
     292  RightIndex: Integer;
     293  LeftCenterCell: TCell;
     294  RightCenterCell: TCell;
     295  ChangesCount: Integer;
     296  LeftCellCommon: TCell;
     297  RightCellCommon: TCell;
     298  LeftText: string;
     299  RightText: string;
    282300begin
    283301  Clear;
    284 
    285   // Allocate and init new
     302  RandSeed := 1234;
     303
     304  // Allocate and init new cells
    286305  Cells.Count := Size.Y * Size.X;
    287306  for Y := 0 to Size.Y - 1 do
     
    325344        TCellsDistance(SelectedCells[J]).Cell2.PosPx);
    326345      if LineIntersect(L1, L2, Intersection) then begin
    327           R1 := PointsToRect(TCellsDistance(CellsDistance[I]).Cell1.PosPx,
    328             TCellsDistance(CellsDistance[I]).Cell2.PosPx);
    329           R2 := PointsToRect(TCellsDistance(SelectedCells[J]).Cell1.PosPx,
    330             TCellsDistance(SelectedCells[J]).Cell2.PosPx);
    331           if PointInRect(Intersection, R1) and PointInRect(Intersection, R2) then begin
    332             Intersected := True;
    333             Break;
    334           end;
     346        if PointInRect(Intersection, L1.ToRect) and
     347        PointInRect(Intersection, L2.ToRect) then begin
     348          Intersected := True;
     349          Break;
    335350        end;
     351      end;
    336352    end;
    337353    if not Intersected then SelectedCells.Add(CellsDistance[I]);
     
    348364  FreeAndNil(SelectedCells);
    349365  FreeAndNil(CellsDistance);
     366  SortNeighborsByAngle;
     367
     368  while True do begin
     369  ChangesCount := 0;
     370  // Optimize link lines for lower angle
     371  for Cell in Cells do begin
     372    // Change link if lower angle can be achieved
     373    for I := 0 to Cell.Neighbors.Count - 1 do begin
     374      LeftCell := Cell.Neighbors[I];
     375      RightCell := Cell.Neighbors[(I + 1) mod Cell.Neighbors.Count];
     376      LeftText := LeftCell.Neighbors.ToString;
     377      RightText := RightCell.Neighbors.ToString;
     378      LeftIndex := LeftCell.Neighbors.IndexOf(Cell);
     379      RightIndex := RightCell.Neighbors.IndexOf(Cell);
     380      LeftCellCommon := LeftCell.Neighbors[(LeftIndex + LeftCell.Neighbors.Count - 1) mod LeftCell.Neighbors.Count];
     381      RightCellCommon := RightCell.Neighbors[(RightIndex + 1) mod RightCell.Neighbors.Count];
     382      if (LeftCellCommon = RightCell) and
     383      (RightCellCommon = LeftCell) then begin
     384        LeftCenterCell := LeftCell.Neighbors[(LeftIndex + LeftCell.Neighbors.Count - 2) mod LeftCell.Neighbors.Count];
     385        RightCenterCell := RightCell.Neighbors[(RightIndex + 2) mod RightCell.Neighbors.Count];
     386
     387        if LeftCenterCell = RightCenterCell then begin
     388          CenterCell := LeftCenterCell;
     389
     390          LeftClosingLine1 := TLine.Create(LeftCell.PosPx, Cell.PosPx);
     391          LeftClosingLine2 := TLine.Create(LeftCell.PosPx,
     392            CenterCell.PosPx);
     393          LeftAngle := SubAngle(LeftClosingLine1.GetAngle,
     394            LeftClosingLine2.GetAngle);
     395
     396          RightClosingLine1 := TLine.Create(RightCell.PosPx, Cell.PosPx);
     397          RightClosingLine2 := TLine.Create(RightCell.PosPx,
     398            CenterCell.PosPx);
     399          RightAngle := SubAngle(RightClosingLine2.GetAngle,
     400            RightClosingLine1.GetAngle);
     401
     402          LeftClosingLine1 := TLine.Create(Cell.PosPx, LeftCell.PosPx);
     403          RightClosingLine1 := TLine.Create(Cell.PosPx, RightCell.PosPx);
     404          CurrentAngle := SubAngle(RightClosingLine1.GetAngle,
     405            LeftClosingLine1.GetAngle);
     406          if (CurrentAngle > LeftAngle) and (CurrentAngle > RightAngle) then begin
     407            LeftCell.DisconnectFrom(RightCell);
     408            Cell.ConnectTo(CenterCell);
     409            SortNeighborsByAngle;
     410            Inc(ChangesCount);
     411          end;
     412        end;
     413        //end;
     414      end;
     415    end;
     416  end;
     417  if ChangesCount = 0 then Break;
     418  end;
    350419
    351420  // Compute polygon around cells with sequence sorted by link angle
    352421  for Cell in Cells do begin
    353     CellsAngle := TObjectList.Create;
    354     for I := 0 to Cell.Neighbors.Count - 1 do begin
    355       CellAngle := TCellsDistance.Create;
    356       CellAngle.Cell1 := Cell;
    357       CellAngle.Cell2 := TCell(Cell.Neighbors[I]);
    358       CellAngle.Distance := ArcTan2Point(Point(
    359         CellAngle.Cell2.PosPx.X - CellAngle.Cell1.PosPx.X,
    360         CellAngle.Cell2.PosPx.Y - CellAngle.Cell1.PosPx.Y));
    361       CellsAngle.Add(CellAngle);
    362     end;
    363     CellsAngle.Sort(CompareDistance);
    364 
    365422    // Use whole map first for cell polygon
    366     if CellsAngle.Count > 0 then begin
     423    if Cell.Neighbors.Count > 0 then begin
    367424      Polygon := TPolygon.Create(Rect(0, 0,
    368425        Size.X * DefaultCellSize.X, Size.Y * DefaultCellSize.Y));
    369       for I := 0 to CellsAngle.Count - 1 do begin
    370         CellAngle := TCellsDistance(CellsAngle[I]);
    371         LinkLine := TLine.Create(CellAngle.Cell1.PosPx,
    372           CellAngle.Cell2.PosPx);
     426      for I := 0 to Cell.Neighbors.Count - 1 do begin
     427        LinkLine := TLine.Create(Cell.PosPx,
     428          Cell.Neighbors[I].PosPx);
     429        LinkLine.Distance := LinkLine.Distance - 4;
    373430        MP := LinkLine.GetMiddle;
    374431        // Create half plane vector
    375         L1 := TLine.Create(MP, Point(MP.X + LinkLine.GetSize.X, MP.Y + LinkLine.GetSize.Y));
     432        L1 := TLine.Create(MP, Point(MP.X + LinkLine.GetSize.X,
     433          MP.Y + LinkLine.GetSize.Y));
    376434
    377435        Polygon.CutLine(L1, Cell.PosPx);
     
    379437      Cell.Polygon := Polygon.Points;
    380438    end else SetLength(Cell.Polygon, 0);
    381 
    382     FreeAndNil(CellsAngle);
    383439  end;
    384440
  • trunk/xtactics.lpr

    r148 r165  
    88  {$ENDIF}
    99  Interfaces, // this includes the LCL widgetset
    10   Forms, tachartlazaruspkg, UGame, UCore, Common, CoolTranslator,
    11   TemplateGenerics, UFormPlayer
     10  Forms, tachartlazaruspkg, UGame, UCore, Common,
     11  CoolTranslator, TemplateGenerics, UFormPlayer
    1212  { you can add units after this },
    1313  SysUtils, UFormMain, UFormMove, UFormNew, UFormCharts, UFormUnitMoves;
Note: See TracChangeset for help on using the changeset viewer.