Changeset 164

Timestamp:

Nov 21, 2017, 6:39:06 PM (7 years ago)

Author:

chronos

Message:

• Modified: More work on voronoi type map generation.
• Fixed: Do not generate map twice on map config load.

Location:

trunk

Files:

• Packages/Common/Common.lpk (modified) (4 diffs)
• Packages/Common/Common.pas (modified) (1 diff)
• Packages/Common/UGeometry.pas (added)
• UGame.pas (modified) (9 diffs)
• UMap.pas (modified) (6 diffs)

trunk/Packages/Common/Common.lpk

@@ -4 +4 @@
     <PathDelim Value="\"/>
     <Name Value="Common"/>
+    <Type Value="RunAndDesignTime"/>
     <AddToProjectUsesSection Value="True"/>
     <Author Value="Chronos (robie@centrum.cz)"/>
@@ -16 +17 @@
     <License Value="GNU/GPL"/>
     <Version Minor="7"/>
-    <Files Count="20">
+    <Files Count="21">
       <Item1>
         <Filename Value="StopWatch.pas"/>
@@ -105 +106 @@
         <UnitName Value="UScaleDPI"/>
       </Item20>
+      <Item21>
+        <Filename Value="UGeometry.pas"/>
+        <UnitName Value="UGeometry"/>
+      </Item21>
     </Files>
     <i18n>
@@ -110 +115 @@
       <OutDir Value="Languages"/>
     </i18n>
-    <Type Value="RunAndDesignTime"/>
     <RequiredPkgs Count="2">
       <Item1>

trunk/Packages/Common/Common.pas

@@ -11 +11 @@
   UMemory, UResetableThread, UPool, ULastOpenedList, URegistry, 
   UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort, 
-  UPersistentForm, UFindFile, UScaleDPI, LazarusPackageIntf;
+  UPersistentForm, UFindFile, UScaleDPI, UGeometry, LazarusPackageIntf;
 
 implementation

trunk/UGame.pas

@@ -174 +174 @@
   private
     FSize: TPoint;
+    FUpdateCount: Integer;
     function GetSize: TPoint; virtual;
     procedure PaintCell(Canvas: TCanvas; Pos: TPoint; Text: string; View: TView;
@@ -213 +214 @@
     procedure CreateLinks;
     procedure Clear;
+    procedure BeginUpdate;
+    procedure EndUpdate;
     constructor Create; virtual;
     destructor Destroy; override;
@@ -982 +985 @@
   CellText: string;
   CellLink: TCellLink;
+  NeighCell: TCell;
 begin
   with Canvas, View do
@@ -1028 +1032 @@
         Player.Game.Map.PaintCell(Canvas, Cell.MapCell.PosPx, '', View, Cell.MapCell);
       end;
+
+      {// Draw links to neighbors
+      for NeighCell in Cell.MapCell.Neighbors do begin
+        Pen.Color := clYellow;
+        MoveTo(View.CellToCanvasPos(Cell.MapCell.PosPx));
+        LineTo(View.CellToCanvasPos(NeighCell.PosPx));
+      end;
+      }
     end;
 
@@ -1340 +1352 @@
   if (FSize.X <> AValue.X) or (FSize.Y <> AValue.Y) then begin
     FSize := AValue;
-    Generate;
+    if FUpdateCount = 0 then Generate;
   end;
 end;
@@ -1434 +1446 @@
 //  I: Integer;
 begin
+  FUpdateCount := Source.FUpdateCount;
   MaxPower := Source.MaxPower;
   Game := Source.Game;
@@ -1713 +1726 @@
   Cells.Clear;
   FNewCellId := 1;
+end;
+
+procedure TMap.BeginUpdate;
+begin
+  Inc(FUpdateCount);
+end;
+
+procedure TMap.EndUpdate;
+begin
+  if FUpdateCount > 0 then Dec(FUpdateCount);
+  if FUpdateCount = 0 then Generate;
 end;
 
@@ -3217 +3241 @@
 begin
   with Config do begin
-    MapType := TMapType(GetValue(DOMString(Path + '/GridType'), Integer(mtHexagon)));
+    try
+      Map.BeginUpdate;
+      MapType := TMapType(GetValue(DOMString(Path + '/GridType'), Integer(mtHexagon)));
+      Map.Size := Point(GetValue(DOMString(Path + '/MapSizeX'), 10),
+        GetValue(DOMString(Path + '/MapSizeY'), 10));
+    finally
+      Map.EndUpdate;
+    end;
     MapImageFileName := string(GetValue(DOMString(Path + '/MapImage'), DOMString(MapImageFileName)));
     SymetricMap := GetValue(DOMString(Path + '/SymetricMap'), False);
@@ -3223 +3254 @@
     VoidEnabled := GetValue(DOMString(Path + '/VoidEnabled'), True);
     VoidPercentage := GetValue(DOMString(Path + '/VoidPercentage'), 20);
-    Map.Size := Point(GetValue(DOMString(Path + '/MapSizeX'), 10),
-      GetValue(DOMString(Path + '/MapSizeY'), 10));
     Value := GetValue(DOMString(Path + '/MapShape'), 0);
     if (Value >= Integer(Low(TMapShape))) and (Value <= Integer(High(TMapShape))) then

trunk/UMap.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, UGame, XMLRead, XMLWrite, DOM, Contnrs;
+  Classes, SysUtils, UGame, XMLRead, XMLWrite, DOM, Contnrs, UGeometry;
 
 type
@@ -245 +245 @@
 end;
 
-function Distance(P1, P2: TPoint): Double;
-begin
-  Result := Sqrt(Sqr(P2.X - P1.X) + Sqr(P2.Y - P1.Y));
-end;
-
-function SubPoint(const P1, P2: TPoint): TPoint;
-begin
-  Result.X := P1.X - P2.X;
-  Result.Y := P1.Y - P2.Y;
-end;
-
-function LineIntersect(LineAP1, LineAP2, LineBP1, LineBP2: TPoint): TPoint;
-Var
-  LDetLineA, LDetLineB, LDetDivInv: Double;
-  LDiffLA, LDiffLB: TPoint;
-begin
-  LDetLineA := LineAP1.X * LineAP2.Y - LineAP1.Y * LineAP2.X;
-  LDetLineB := LineBP1.X * LineBP2.Y - LineBP1.Y * LineBP2.X;
-
-  LDiffLA := SubPoint(LineAP1, LineAP2);
-  LDiffLB := SubPoint(LineBP1, LineBP2);
-
-  LDetDivInv := 1 / ((LDiffLA.X * LDiffLB.Y) - (LDiffLA.Y * LDiffLB.X));
-
-  Result.X := Trunc(((LDetLineA * LDiffLB.X) - (LDiffLA.X * LDetLineB)) * LDetDivInv);
-  Result.Y := Trunc(((LDetLineA * LDiffLB.Y) - (LDiffLA.Y * LDetLineB)) * LDetDivInv);
-end;
-
 function CompareDistance(C1, C2: Pointer): Integer;
 begin
@@ -280 +252 @@
 end;
 
-function PointInRect(aPoint: TPoint; aRect: TRect): Boolean;
-begin
-  Result := (aPoint.X >= aRect.Left) and (aPoint.X < aRect.Right) and
-    (aPoint.Y >= aRect.Top) and(aPoint.Y < aRect.Bottom);
+function CompareDistanceReverse(C1, C2: Pointer): Integer;
+begin
+  if TCellsDistance(C1).Distance > TCellsDistance(C2).Distance then Result := -1
+  else if TCellsDistance(C1).Distance < TCellsDistance(C2).Distance then Result := 1
+  else Result := 0;
 end;
 
@@ -293 +266 @@
   CellsDistance: TObjectList; // TObjectList<TCellsDistance>
   NewCellDist: TCellsDistance;
+  SelectedCells: TObjectList; // TObjectList<TCellsDistance>
   I, J: Integer;
   Intersected: Boolean;
   Intersection: TPoint;
+  CellDistance: TCellsDistance;
+  R1, R2: TRect;
+  Cell: TCell;
+  CellsAngle: TObjectList; // TObjecTList<TCellsDistance>
+  CellAngle: TCellsDistance;
+  NextCellAngle: TCellsDistance;
+  L1, L2: TLine;
+  MP: TPoint;
+  LinkLine: TLine;
+  Polygon: TPolygon;
 begin
   Clear;
@@ -313 +297 @@
   end;
 
-{  // Calculate distance between all cells
+  // Calculate distance between all cells
   CellsDistance := TObjectList.Create;
   for I1 := 1 to Cells.Count - 1 do
@@ -323 +307 @@
     CellsDistance.Add(NewCellDist);
   end;
-  CellsDistance.Sort(CompareDistance);
+  CellsDistance.Sort(CompareDistanceReverse);
 
   // Keep shortest non-intersected cell pairs
-  I := 0;
-  while I < CellsDistance.Count do begin
-    Intersected := True;
-    for J := 0 to CellsDistance.Count - 1 do
-      Intersection := LineIntersect(TCellsDistance(CellsDistance[I]).Cell1.PosPx,
-        TCellsDistance(CellsDistance[I]).Cell2.PosPx,
-        TCellsDistance(CellsDistance[J]).Cell1.PosPx,
-        TCellsDistance(CellsDistance[J]).Cell1.PosPx);
-      if PointInRect(Intersection, Rect(TCellsDistance(CellsDistance[I]).Cell1.PosPx.X,
-        TCellsDistance(CellsDistance[I]).Cell1.PosPx.Y,
-      then begin
-          Intersected := False;
-          Break;
+  SelectedCells := TObjectList.Create;
+  SelectedCells.OwnsObjects := False;
+  I := CellsDistance.Count - 1;
+  while I >= 0 do begin
+    Intersected := False;
+    for J := 0 to SelectedCells.Count - 1 do
+    if (TCellsDistance(SelectedCells[J]).Cell1 <> TCellsDistance(CellsDistance[I]).Cell1)
+    and (TCellsDistance(SelectedCells[J]).Cell2 <> TCellsDistance(CellsDistance[I]).Cell2)
+    and (TCellsDistance(SelectedCells[J]).Cell1 <> TCellsDistance(CellsDistance[I]).Cell2)
+    and (TCellsDistance(SelectedCells[J]).Cell2 <> TCellsDistance(CellsDistance[I]).Cell1) then begin
+      L1 := TLine.Create(TCellsDistance(CellsDistance[I]).Cell1.PosPx,
+        TCellsDistance(CellsDistance[I]).Cell2.PosPx);
+      L2 := TLine.Create(TCellsDistance(SelectedCells[J]).Cell1.PosPx,
+        TCellsDistance(SelectedCells[J]).Cell2.PosPx);
+      if LineIntersect(L1, L2, Intersection) then begin
+          R1 := PointsToRect(TCellsDistance(CellsDistance[I]).Cell1.PosPx,
+            TCellsDistance(CellsDistance[I]).Cell2.PosPx);
+          R2 := PointsToRect(TCellsDistance(SelectedCells[J]).Cell1.PosPx,
+            TCellsDistance(SelectedCells[J]).Cell2.PosPx);
+          if PointInRect(Intersection, R1) and PointInRect(Intersection, R2) then begin
+            Intersected := True;
+            Break;
+          end;
         end;
-    if Intersected then begin
-      CellsDistance.Delete(I);
-    end else Inc(I);
-  end;
+    end;
+    if not Intersected then SelectedCells.Add(CellsDistance[I]);
+    Dec(I);
+  end;
+
+  // Add cell neighbors
+  for I := 0 to SelectedCells.Count - 1 do begin
+    CellDistance := TCellsDistance(SelectedCells[I]);
+    CellDistance.Cell1.Neighbors.Add(CellDistance.Cell2);
+    CellDistance.Cell2.Neighbors.Add(CellDistance.Cell1);
+  end;
+
+  FreeAndNil(SelectedCells);
   FreeAndNil(CellsDistance);
- }
+
+  // Compute polygon around cells with sequence sorted by link angle
+  for Cell in Cells do begin
+    CellsAngle := TObjectList.Create;
+    for I := 0 to Cell.Neighbors.Count - 1 do begin
+      CellAngle := TCellsDistance.Create;
+      CellAngle.Cell1 := Cell;
+      CellAngle.Cell2 := TCell(Cell.Neighbors[I]);
+      CellAngle.Distance := ArcTan2Point(Point(
+        CellAngle.Cell2.PosPx.X - CellAngle.Cell1.PosPx.X,
+        CellAngle.Cell2.PosPx.Y - CellAngle.Cell1.PosPx.Y));
+      CellsAngle.Add(CellAngle);
+    end;
+    CellsAngle.Sort(CompareDistance);
+
+    // Use whole map first for cell polygon
+    if CellsAngle.Count > 0 then begin
+      Polygon := TPolygon.Create(Rect(0, 0,
+        Size.X * DefaultCellSize.X, Size.Y * DefaultCellSize.Y));
+      for I := 0 to CellsAngle.Count - 1 do begin
+        CellAngle := TCellsDistance(CellsAngle[I]);
+        LinkLine := TLine.Create(CellAngle.Cell1.PosPx,
+          CellAngle.Cell2.PosPx);
+        MP := LinkLine.GetMiddle;
+        // Create half plane vector
+        L1 := TLine.Create(MP, Point(MP.X + LinkLine.GetSize.X, MP.Y + LinkLine.GetSize.Y));
+
+        Polygon.CutLine(L1, Cell.PosPx);
+      end;
+      Cell.Polygon := Polygon.Points;
+    end else SetLength(Cell.Polygon, 0);
+
+    FreeAndNil(CellsAngle);
+  end;
+
   FPixelRect := CalculatePixelRect;
 end;