Changeset 162 for trunk/UMap.pas

Timestamp:

Nov 20, 2017, 6:11:16 PM (6 years ago)

Author:

chronos

Message:

• Modified: Partial progress on Voronoi map generator.

File:

• trunk/UMap.pas (modified) (4 diffs)

trunk/UMap.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, UGame, XMLRead, XMLWrite, DOM;
+  Classes, SysUtils, UGame, XMLRead, XMLWrite, DOM, Contnrs;
 
 type
+  TCellsDistance = class
+    Cell1: TCell;
+    Cell2: TCell;
+    Distance: Double;
+  end;
+
   { THexMap }
 
@@ -51 +57 @@
     procedure Generate; override;
   end;
-
 
 implementation
@@ -240 +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
+  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;
+
+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);
+end;
+
 procedure TVoronoiMap.Generate;
 var
   X, Y: Integer;
+  I1, I2: Integer;
   NewCell: TCell;
+  CellsDistance: TObjectList; // TObjectList<TCellsDistance>
+  NewCellDist: TCellsDistance;
+  I, J: Integer;
+  Intersected: Boolean;
+  Intersection: TPoint;
 begin
   Clear;
@@ -261 +313 @@
   end;
 
+{  // Calculate distance between all cells
+  CellsDistance := TObjectList.Create;
+  for I1 := 1 to Cells.Count - 1 do
+  for I2 := I1 + 1 to Cells.Count - 1 do begin
+    NewCellDist := TCellsDistance.Create;
+    NewCellDist.Cell1 := Cells[I1];
+    NewCellDist.Cell2 := Cells[I2];
+    NewCellDist.Distance := Distance(NewCellDist.Cell1.PosPx, NewCellDist.Cell2.PosPx);
+    CellsDistance.Add(NewCellDist);
+  end;
+  CellsDistance.Sort(CompareDistance);
+
+  // 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;
+        end;
+    if Intersected then begin
+      CellsDistance.Delete(I);
+    end else Inc(I);
+  end;
+  FreeAndNil(CellsDistance);
+ }
   FPixelRect := CalculatePixelRect;
 end;