Changeset 162


Ignore:
Timestamp:
Nov 20, 2017, 6:11:16 PM (7 years ago)
Author:
chronos
Message:
  • Modified: Partial progress on Voronoi map generator.
Location:
trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/Languages/xtactics.cs.po

    r158 r162  
    8686
    8787#: tcore.ashowcharts.caption
     88#, fuzzy
     89#| msgid "Charts"
    8890msgctxt "tcore.ashowcharts.caption"
    89 msgid "Charts"
     91msgid "Show charts"
    9092msgstr "Grafy vývoje"
    91 
    92 #: tcore.ashowunitmoves.caption
    93 msgctxt "tcore.ashowunitmoves.caption"
    94 msgid "Unit moves"
    95 msgstr "Pohyby jednotek"
    9693
    9794#: tformabout.buttonclose.caption
     
    711708msgid "Zero zoom not allowed"
    712709msgstr "Nulové přiblížení není povoleno"
     710
  • trunk/Languages/xtactics.po

    r158 r162  
    7777#: tcore.ashowcharts.caption
    7878msgctxt "tcore.ashowcharts.caption"
    79 msgid "Charts"
    80 msgstr ""
    81 
    82 #: tcore.ashowunitmoves.caption
    83 msgctxt "tcore.ashowunitmoves.caption"
    84 msgid "Unit moves"
     79msgid "Show charts"
    8580msgstr ""
    8681
  • trunk/UGame.pas

    r158 r162  
    30283028  with TMapArea(Areas[I]) do begin
    30293029    GetBorderCells(BorderList);
     3030    if BorderList.Count > 0 then
    30303031    for J := 0 to 4 do begin
    30313032
     
    30543055    end;
    30553056    end;
    3056 
    30573057  end;
    30583058  FreeAndNil(List);
  • trunk/UMap.pas

    r158 r162  
    66
    77uses
    8   Classes, SysUtils, UGame, XMLRead, XMLWrite, DOM;
     8  Classes, SysUtils, UGame, XMLRead, XMLWrite, DOM, Contnrs;
    99
    1010type
     11  TCellsDistance = class
     12    Cell1: TCell;
     13    Cell2: TCell;
     14    Distance: Double;
     15  end;
     16
    1117  { THexMap }
    1218
     
    5157    procedure Generate; override;
    5258  end;
    53 
    5459
    5560implementation
     
    240245end;
    241246
     247function Distance(P1, P2: TPoint): Double;
     248begin
     249  Result := Sqrt(Sqr(P2.X - P1.X) + Sqr(P2.Y - P1.Y));
     250end;
     251
     252function SubPoint(const P1, P2: TPoint): TPoint;
     253begin
     254  Result.X := P1.X - P2.X;
     255  Result.Y := P1.Y - P2.Y;
     256end;
     257
     258function LineIntersect(LineAP1, LineAP2, LineBP1, LineBP2: TPoint): TPoint;
     259Var
     260  LDetLineA, LDetLineB, LDetDivInv: Double;
     261  LDiffLA, LDiffLB: TPoint;
     262begin
     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);
     273end;
     274
     275function CompareDistance(C1, C2: Pointer): Integer;
     276begin
     277  if TCellsDistance(C1).Distance > TCellsDistance(C2).Distance then Result := 1
     278  else if TCellsDistance(C1).Distance < TCellsDistance(C2).Distance then Result := -1
     279  else Result := 0;
     280end;
     281
     282function PointInRect(aPoint: TPoint; aRect: TRect): Boolean;
     283begin
     284  Result := (aPoint.X >= aRect.Left) and (aPoint.X < aRect.Right) and
     285    (aPoint.Y >= aRect.Top) and(aPoint.Y < aRect.Bottom);
     286end;
     287
    242288procedure TVoronoiMap.Generate;
    243289var
    244290  X, Y: Integer;
     291  I1, I2: Integer;
    245292  NewCell: TCell;
     293  CellsDistance: TObjectList; // TObjectList<TCellsDistance>
     294  NewCellDist: TCellsDistance;
     295  I, J: Integer;
     296  Intersected: Boolean;
     297  Intersection: TPoint;
    246298begin
    247299  Clear;
     
    261313  end;
    262314
     315{  // Calculate distance between all cells
     316  CellsDistance := TObjectList.Create;
     317  for I1 := 1 to Cells.Count - 1 do
     318  for I2 := I1 + 1 to Cells.Count - 1 do begin
     319    NewCellDist := TCellsDistance.Create;
     320    NewCellDist.Cell1 := Cells[I1];
     321    NewCellDist.Cell2 := Cells[I2];
     322    NewCellDist.Distance := Distance(NewCellDist.Cell1.PosPx, NewCellDist.Cell2.PosPx);
     323    CellsDistance.Add(NewCellDist);
     324  end;
     325  CellsDistance.Sort(CompareDistance);
     326
     327  // 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;
     341        end;
     342    if Intersected then begin
     343      CellsDistance.Delete(I);
     344    end else Inc(I);
     345  end;
     346  FreeAndNil(CellsDistance);
     347 }
    263348  FPixelRect := CalculatePixelRect;
    264349end;
Note: See TracChangeset for help on using the changeset viewer.