Changeset 164 for trunk/UMap.pas


Ignore:
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.
File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/UMap.pas

    r162 r164  
    66
    77uses
    8   Classes, SysUtils, UGame, XMLRead, XMLWrite, DOM, Contnrs;
     8  Classes, SysUtils, UGame, XMLRead, XMLWrite, DOM, Contnrs, UGeometry;
    99
    1010type
     
    245245end;
    246246
    247 function Distance(P1, P2: TPoint): Double;
    248 begin
    249   Result := Sqrt(Sqr(P2.X - P1.X) + Sqr(P2.Y - P1.Y));
    250 end;
    251 
    252 function SubPoint(const P1, P2: TPoint): TPoint;
    253 begin
    254   Result.X := P1.X - P2.X;
    255   Result.Y := P1.Y - P2.Y;
    256 end;
    257 
    258 function LineIntersect(LineAP1, LineAP2, LineBP1, LineBP2: TPoint): TPoint;
    259 Var
    260   LDetLineA, LDetLineB, LDetDivInv: Double;
    261   LDiffLA, LDiffLB: TPoint;
    262 begin
    263   LDetLineA := LineAP1.X * LineAP2.Y - LineAP1.Y * LineAP2.X;
    264   LDetLineB := LineBP1.X * LineBP2.Y - LineBP1.Y * LineBP2.X;
    265 
    266   LDiffLA := SubPoint(LineAP1, LineAP2);
    267   LDiffLB := SubPoint(LineBP1, LineBP2);
    268 
    269   LDetDivInv := 1 / ((LDiffLA.X * LDiffLB.Y) - (LDiffLA.Y * LDiffLB.X));
    270 
    271   Result.X := Trunc(((LDetLineA * LDiffLB.X) - (LDiffLA.X * LDetLineB)) * LDetDivInv);
    272   Result.Y := Trunc(((LDetLineA * LDiffLB.Y) - (LDiffLA.Y * LDetLineB)) * LDetDivInv);
    273 end;
    274 
    275247function CompareDistance(C1, C2: Pointer): Integer;
    276248begin
     
    280252end;
    281253
    282 function PointInRect(aPoint: TPoint; aRect: TRect): Boolean;
    283 begin
    284   Result := (aPoint.X >= aRect.Left) and (aPoint.X < aRect.Right) and
    285     (aPoint.Y >= aRect.Top) and(aPoint.Y < aRect.Bottom);
     254function CompareDistanceReverse(C1, C2: Pointer): Integer;
     255begin
     256  if TCellsDistance(C1).Distance > TCellsDistance(C2).Distance then Result := -1
     257  else if TCellsDistance(C1).Distance < TCellsDistance(C2).Distance then Result := 1
     258  else Result := 0;
    286259end;
    287260
     
    293266  CellsDistance: TObjectList; // TObjectList<TCellsDistance>
    294267  NewCellDist: TCellsDistance;
     268  SelectedCells: TObjectList; // TObjectList<TCellsDistance>
    295269  I, J: Integer;
    296270  Intersected: Boolean;
    297271  Intersection: TPoint;
     272  CellDistance: TCellsDistance;
     273  R1, R2: TRect;
     274  Cell: TCell;
     275  CellsAngle: TObjectList; // TObjecTList<TCellsDistance>
     276  CellAngle: TCellsDistance;
     277  NextCellAngle: TCellsDistance;
     278  L1, L2: TLine;
     279  MP: TPoint;
     280  LinkLine: TLine;
     281  Polygon: TPolygon;
    298282begin
    299283  Clear;
     
    313297  end;
    314298
    315 {  // Calculate distance between all cells
     299  // Calculate distance between all cells
    316300  CellsDistance := TObjectList.Create;
    317301  for I1 := 1 to Cells.Count - 1 do
     
    323307    CellsDistance.Add(NewCellDist);
    324308  end;
    325   CellsDistance.Sort(CompareDistance);
     309  CellsDistance.Sort(CompareDistanceReverse);
    326310
    327311  // Keep shortest non-intersected cell pairs
    328   I := 0;
    329   while I < CellsDistance.Count do begin
    330     Intersected := True;
    331     for J := 0 to CellsDistance.Count - 1 do
    332       Intersection := LineIntersect(TCellsDistance(CellsDistance[I]).Cell1.PosPx,
    333         TCellsDistance(CellsDistance[I]).Cell2.PosPx,
    334         TCellsDistance(CellsDistance[J]).Cell1.PosPx,
    335         TCellsDistance(CellsDistance[J]).Cell1.PosPx);
    336       if PointInRect(Intersection, Rect(TCellsDistance(CellsDistance[I]).Cell1.PosPx.X,
    337         TCellsDistance(CellsDistance[I]).Cell1.PosPx.Y,
    338       then begin
    339           Intersected := False;
    340           Break;
     312  SelectedCells := TObjectList.Create;
     313  SelectedCells.OwnsObjects := False;
     314  I := CellsDistance.Count - 1;
     315  while I >= 0 do begin
     316    Intersected := False;
     317    for J := 0 to SelectedCells.Count - 1 do
     318    if (TCellsDistance(SelectedCells[J]).Cell1 <> TCellsDistance(CellsDistance[I]).Cell1)
     319    and (TCellsDistance(SelectedCells[J]).Cell2 <> TCellsDistance(CellsDistance[I]).Cell2)
     320    and (TCellsDistance(SelectedCells[J]).Cell1 <> TCellsDistance(CellsDistance[I]).Cell2)
     321    and (TCellsDistance(SelectedCells[J]).Cell2 <> TCellsDistance(CellsDistance[I]).Cell1) then begin
     322      L1 := TLine.Create(TCellsDistance(CellsDistance[I]).Cell1.PosPx,
     323        TCellsDistance(CellsDistance[I]).Cell2.PosPx);
     324      L2 := TLine.Create(TCellsDistance(SelectedCells[J]).Cell1.PosPx,
     325        TCellsDistance(SelectedCells[J]).Cell2.PosPx);
     326      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;
    341335        end;
    342     if Intersected then begin
    343       CellsDistance.Delete(I);
    344     end else Inc(I);
    345   end;
     336    end;
     337    if not Intersected then SelectedCells.Add(CellsDistance[I]);
     338    Dec(I);
     339  end;
     340
     341  // Add cell neighbors
     342  for I := 0 to SelectedCells.Count - 1 do begin
     343    CellDistance := TCellsDistance(SelectedCells[I]);
     344    CellDistance.Cell1.Neighbors.Add(CellDistance.Cell2);
     345    CellDistance.Cell2.Neighbors.Add(CellDistance.Cell1);
     346  end;
     347
     348  FreeAndNil(SelectedCells);
    346349  FreeAndNil(CellsDistance);
    347  }
     350
     351  // Compute polygon around cells with sequence sorted by link angle
     352  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
     365    // Use whole map first for cell polygon
     366    if CellsAngle.Count > 0 then begin
     367      Polygon := TPolygon.Create(Rect(0, 0,
     368        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);
     373        MP := LinkLine.GetMiddle;
     374        // Create half plane vector
     375        L1 := TLine.Create(MP, Point(MP.X + LinkLine.GetSize.X, MP.Y + LinkLine.GetSize.Y));
     376
     377        Polygon.CutLine(L1, Cell.PosPx);
     378      end;
     379      Cell.Polygon := Polygon.Points;
     380    end else SetLength(Cell.Polygon, 0);
     381
     382    FreeAndNil(CellsAngle);
     383  end;
     384
    348385  FPixelRect := CalculatePixelRect;
    349386end;
Note: See TracChangeset for help on using the changeset viewer.