Changeset 165 for trunk/UGame.pas

Timestamp:

Nov 22, 2017, 4:48:33 PM (7 years ago)

Author:

chronos

Message:

• Added: Optimization phase for voronoi map generation.

File:

• trunk/UGame.pas (modified) (10 diffs)

trunk/UGame.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, ExtCtrls, Graphics, XMLConf, XMLRead, XMLWrite,
-  DOM, Math, LazFileUtils, UXMLUtils, Dialogs, Types, LCLType, LCLIntf, fgl;
+  DOM, Math, LazFileUtils, UXMLUtils, Dialogs, Types, LCLType, LCLIntf, fgl,
+  UGeometry;
 
 const
@@ -60 +61 @@
     Mark: Boolean; // Temporary value
     Weight: Integer; // Temporary value
+    Angle: Double; // Temporary value
     Links: TCellLinks;
+    procedure ConnectTo(Cell: TCell);
+    procedure DisconnectFrom(Cell: TCell);
     procedure Check;
     function NeighboringToVoid: Boolean;
@@ -93 +97 @@
     procedure ClearMark;
     procedure ClearWeight;
+    function ToString: ansistring; override;
   end;
 
@@ -115 +120 @@
     procedure LoadFromNode(Node: TDOMNode);
     procedure SaveToNode(Node: TDOMNode);
+  end;
+
+  { TCellLinkParams }
+
+  TCellLinkParams = class
+    Cell1: TCell;
+    Cell2: TCell;
+    Distance: Double;
+    Angle: Double;
   end;
 
@@ -187 +201 @@
     FNewCellId: Integer;
     function GetNewCellId: Integer; virtual;
+    procedure SortNeighborsByAngle;
   public
     Game: TGame;
@@ -1032 +1047 @@
         Player.Game.Map.PaintCell(Canvas, Cell.MapCell.PosPx, '', View, Cell.MapCell);
       end;
-
-      {// Draw links to neighbors
+    end;
+
+{    // Draw links to neighbors
+    for Cell in Cells do begin
       for NeighCell in Cell.MapCell.Neighbors do begin
         Pen.Color := clYellow;
@@ -1039 +1056 @@
         LineTo(View.CellToCanvasPos(NeighCell.PosPx));
       end;
-      }
-    end;
-
+
+      Font.Color := clRed;
+      Brush.Style := bsClear;
+      TextOut(View.CellToCanvasPos(Cell.MapCell.PosPx).X,
+        View.CellToCanvasPos(Cell.MapCell.PosPx).Y, IntToStr(Cell.MapCell.Id));
+    end;
+ }
     // Draw arrows
     Pen.Color := clCream;
@@ -1166 +1187 @@
 end;
 
+function TCells.ToString: ansistring;
+var
+  C: TCell;
+begin
+  Result := '';
+  for C in Self do
+    Result := Result + IntToStr(C.Id) + ', ';
+end;
+
 { TPlayers }
 
@@ -1353 +1383 @@
     FSize := AValue;
     if FUpdateCount = 0 then Generate;
+  end;
+end;
+
+function CompareCellAngle(const C1, C2: TCell): Integer;
+begin
+  if C1.Angle < C2.Angle then Result := -1
+  else if C1.Angle > C2.Angle then Result := 1
+  else Result := 0;
+end;
+
+procedure TMap.SortNeighborsByAngle;
+var
+  Cell: TCell;
+  NeighborCell: TCell;
+begin
+  for Cell in Cells do begin
+    for NeighborCell in Cell.Neighbors do
+      NeighborCell.Angle := ArcTan2Point(Point(
+        NeighborCell.PosPx.X - Cell.PosPx.X,
+        NeighborCell.PosPx.Y - Cell.PosPx.Y));
+
+    Cell.Neighbors.Sort(CompareCellAngle);
   end;
 end;
@@ -1896 +1948 @@
   FPower := AValue;
   //Check;
+end;
+
+procedure TCell.ConnectTo(Cell: TCell);
+begin
+  Cell.Neighbors.Add(Self);
+  Neighbors.Add(Cell);
+end;
+
+procedure TCell.DisconnectFrom(Cell: TCell);
+var
+  I: Integer;
+begin
+  I := Cell.Neighbors.IndexOf(Self);
+  if I >= 0 then Cell.Neighbors.Delete(I) else
+    raise Exception.Create('Can''t disconnect neigboring cells.');
+  I := Neighbors.IndexOf(Cell);
+  if I >= 0 then Neighbors.Delete(I)
+    else Exception.Create('Can''t disconnect neigboring cells.');
 end;