Changeset 165
- Timestamp:
- Nov 22, 2017, 4:48:33 PM (7 years ago)
- Location:
- trunk
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/Common/UGeometry.pas
r164 r165 14 14 15 15 TLine = record 16 private 17 function GetDistance: Double; 18 procedure SetDistance(AValue: Double); 19 public 16 20 P1: TPoint; 17 21 P2: TPoint; 18 22 function Create(P1, P2: TPoint): TLine; 19 function Distance: Double;20 23 function GetMiddle: TPoint; 21 24 function GetAngle: Double; … … 25 28 procedure Rotate(Angle: Double); 26 29 class operator Equal(A, B: TLine): Boolean; 30 property Distance: Double read GetDistance write SetDistance; 27 31 end; 28 32 … … 56 60 function PointInRect(P: TPoint; aRect: TRect): Boolean; 57 61 function HalfDistancePoint(P1, P2: TPoint): TPoint; 62 function NormalizeAngle(Angle: Double): Double; 63 function SubAngle(A1, A2: Double): Double; 58 64 59 65 implementation … … 208 214 begin 209 215 Result := Point(P1.X + (P2.X - P1.X) div 2, P1.Y + (P2.Y - P1.Y) div 2) 216 end; 217 218 function NormalizeAngle(Angle: Double): Double; 219 begin 220 if Angle < 0 then Result := Angle + (Trunc(Angle / (2 * Pi)) + 1) * (2 * Pi) 221 else if Angle > 2 * Pi then Result := Angle - Trunc(Angle / (2 * Pi)) * (2 * Pi) 222 else Result := Angle; 223 end; 224 225 function SubAngle(A1, A2: Double): Double; 226 begin 227 A1 := NormalizeAngle(A1); 228 A2 := NormalizeAngle(A2); 229 if A1 < A2 then Result := A1 + 2 * Pi - A2 230 else Result := A1 - A2; 210 231 end; 211 232 … … 310 331 end else begin 311 332 // Crossing line, end polygon. If point NewPolygonStarted, the use polygon as result 333 NewPoly.AddPoint(Points[I]); 312 334 NewPoly.AddPoint(Intersection); 313 335 if NewPoly.IsPointInside(PointInside) then begin … … 326 348 if PointsChecked > 2 * Length(Points) then Break; 327 349 end; 328 if Success then Points := NewPoly.Points 329 else Clear; 350 if Success then Points := NewPoly.Points; 330 351 end; 331 352 332 353 { TLine } 354 355 function TLine.GetDistance: Double; 356 begin 357 Result := Sqrt(Sqr(P2.X - P1.X) + Sqr(P2.Y - P1.Y)); 358 end; 359 360 procedure TLine.SetDistance(AValue: Double); 361 var 362 Angle: Double; 363 begin 364 Angle := GetAngle; 365 P2 := Point(Round(P1.X + Cos(Angle) * AValue), 366 Round(P1.Y + Sin(Angle) * AValue)); 367 end; 333 368 334 369 function TLine.Create(P1, P2: TPoint): TLine; … … 336 371 Result.P1 := P1; 337 372 Result.P2 := P2; 338 end;339 340 function TLine.Distance: Double;341 begin342 Result := Sqrt(Sqr(P2.X - P1.X) + Sqr(P2.Y - P1.Y));343 373 end; 344 374 -
trunk/UGame.pas
r164 r165 7 7 uses 8 8 Classes, SysUtils, ExtCtrls, Graphics, XMLConf, XMLRead, XMLWrite, 9 DOM, Math, LazFileUtils, UXMLUtils, Dialogs, Types, LCLType, LCLIntf, fgl; 9 DOM, Math, LazFileUtils, UXMLUtils, Dialogs, Types, LCLType, LCLIntf, fgl, 10 UGeometry; 10 11 11 12 const … … 60 61 Mark: Boolean; // Temporary value 61 62 Weight: Integer; // Temporary value 63 Angle: Double; // Temporary value 62 64 Links: TCellLinks; 65 procedure ConnectTo(Cell: TCell); 66 procedure DisconnectFrom(Cell: TCell); 63 67 procedure Check; 64 68 function NeighboringToVoid: Boolean; … … 93 97 procedure ClearMark; 94 98 procedure ClearWeight; 99 function ToString: ansistring; override; 95 100 end; 96 101 … … 115 120 procedure LoadFromNode(Node: TDOMNode); 116 121 procedure SaveToNode(Node: TDOMNode); 122 end; 123 124 { TCellLinkParams } 125 126 TCellLinkParams = class 127 Cell1: TCell; 128 Cell2: TCell; 129 Distance: Double; 130 Angle: Double; 117 131 end; 118 132 … … 187 201 FNewCellId: Integer; 188 202 function GetNewCellId: Integer; virtual; 203 procedure SortNeighborsByAngle; 189 204 public 190 205 Game: TGame; … … 1032 1047 Player.Game.Map.PaintCell(Canvas, Cell.MapCell.PosPx, '', View, Cell.MapCell); 1033 1048 end; 1034 1035 {// Draw links to neighbors 1049 end; 1050 1051 { // Draw links to neighbors 1052 for Cell in Cells do begin 1036 1053 for NeighCell in Cell.MapCell.Neighbors do begin 1037 1054 Pen.Color := clYellow; … … 1039 1056 LineTo(View.CellToCanvasPos(NeighCell.PosPx)); 1040 1057 end; 1041 } 1042 end; 1043 1058 1059 Font.Color := clRed; 1060 Brush.Style := bsClear; 1061 TextOut(View.CellToCanvasPos(Cell.MapCell.PosPx).X, 1062 View.CellToCanvasPos(Cell.MapCell.PosPx).Y, IntToStr(Cell.MapCell.Id)); 1063 end; 1064 } 1044 1065 // Draw arrows 1045 1066 Pen.Color := clCream; … … 1166 1187 end; 1167 1188 1189 function TCells.ToString: ansistring; 1190 var 1191 C: TCell; 1192 begin 1193 Result := ''; 1194 for C in Self do 1195 Result := Result + IntToStr(C.Id) + ', '; 1196 end; 1197 1168 1198 { TPlayers } 1169 1199 … … 1353 1383 FSize := AValue; 1354 1384 if FUpdateCount = 0 then Generate; 1385 end; 1386 end; 1387 1388 function CompareCellAngle(const C1, C2: TCell): Integer; 1389 begin 1390 if C1.Angle < C2.Angle then Result := -1 1391 else if C1.Angle > C2.Angle then Result := 1 1392 else Result := 0; 1393 end; 1394 1395 procedure TMap.SortNeighborsByAngle; 1396 var 1397 Cell: TCell; 1398 NeighborCell: TCell; 1399 begin 1400 for Cell in Cells do begin 1401 for NeighborCell in Cell.Neighbors do 1402 NeighborCell.Angle := ArcTan2Point(Point( 1403 NeighborCell.PosPx.X - Cell.PosPx.X, 1404 NeighborCell.PosPx.Y - Cell.PosPx.Y)); 1405 1406 Cell.Neighbors.Sort(CompareCellAngle); 1355 1407 end; 1356 1408 end; … … 1896 1948 FPower := AValue; 1897 1949 //Check; 1950 end; 1951 1952 procedure TCell.ConnectTo(Cell: TCell); 1953 begin 1954 Cell.Neighbors.Add(Self); 1955 Neighbors.Add(Cell); 1956 end; 1957 1958 procedure TCell.DisconnectFrom(Cell: TCell); 1959 var 1960 I: Integer; 1961 begin 1962 I := Cell.Neighbors.IndexOf(Self); 1963 if I >= 0 then Cell.Neighbors.Delete(I) else 1964 raise Exception.Create('Can''t disconnect neigboring cells.'); 1965 I := Neighbors.IndexOf(Cell); 1966 if I >= 0 then Neighbors.Delete(I) 1967 else Exception.Create('Can''t disconnect neigboring cells.'); 1898 1968 end; 1899 1969 -
trunk/UMap.pas
r164 r165 271 271 Intersection: TPoint; 272 272 CellDistance: TCellsDistance; 273 R1, R2: TRect;274 273 Cell: TCell; 275 CellsAngle: TObjectList; // TObjecTList<TCellsDistance>276 CellAngle: TCellsDistance;277 NextCellAngle: TCellsDistance;278 274 L1, L2: TLine; 279 275 MP: TPoint; 280 276 LinkLine: TLine; 281 277 Polygon: TPolygon; 278 //LeftLink: TCellsDistance; 279 //CenterLink: TCellsDistance; 280 //RightLink: TCellsDistance; 281 LeftClosingLine1: TLine; 282 LeftClosingLine2: TLine; 283 RightClosingLine1: TLine; 284 RightClosingLine2: TLine; 285 CurrentAngle: Double; 286 LeftAngle: Double; 287 RightAngle: Double; 288 CenterCell: TCell; 289 LeftCell: TCell; 290 RightCell: TCell; 291 LeftIndex: Integer; 292 RightIndex: Integer; 293 LeftCenterCell: TCell; 294 RightCenterCell: TCell; 295 ChangesCount: Integer; 296 LeftCellCommon: TCell; 297 RightCellCommon: TCell; 298 LeftText: string; 299 RightText: string; 282 300 begin 283 301 Clear; 284 285 // Allocate and init new 302 RandSeed := 1234; 303 304 // Allocate and init new cells 286 305 Cells.Count := Size.Y * Size.X; 287 306 for Y := 0 to Size.Y - 1 do … … 325 344 TCellsDistance(SelectedCells[J]).Cell2.PosPx); 326 345 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; 346 if PointInRect(Intersection, L1.ToRect) and 347 PointInRect(Intersection, L2.ToRect) then begin 348 Intersected := True; 349 Break; 335 350 end; 351 end; 336 352 end; 337 353 if not Intersected then SelectedCells.Add(CellsDistance[I]); … … 348 364 FreeAndNil(SelectedCells); 349 365 FreeAndNil(CellsDistance); 366 SortNeighborsByAngle; 367 368 while True do begin 369 ChangesCount := 0; 370 // Optimize link lines for lower angle 371 for Cell in Cells do begin 372 // Change link if lower angle can be achieved 373 for I := 0 to Cell.Neighbors.Count - 1 do begin 374 LeftCell := Cell.Neighbors[I]; 375 RightCell := Cell.Neighbors[(I + 1) mod Cell.Neighbors.Count]; 376 LeftText := LeftCell.Neighbors.ToString; 377 RightText := RightCell.Neighbors.ToString; 378 LeftIndex := LeftCell.Neighbors.IndexOf(Cell); 379 RightIndex := RightCell.Neighbors.IndexOf(Cell); 380 LeftCellCommon := LeftCell.Neighbors[(LeftIndex + LeftCell.Neighbors.Count - 1) mod LeftCell.Neighbors.Count]; 381 RightCellCommon := RightCell.Neighbors[(RightIndex + 1) mod RightCell.Neighbors.Count]; 382 if (LeftCellCommon = RightCell) and 383 (RightCellCommon = LeftCell) then begin 384 LeftCenterCell := LeftCell.Neighbors[(LeftIndex + LeftCell.Neighbors.Count - 2) mod LeftCell.Neighbors.Count]; 385 RightCenterCell := RightCell.Neighbors[(RightIndex + 2) mod RightCell.Neighbors.Count]; 386 387 if LeftCenterCell = RightCenterCell then begin 388 CenterCell := LeftCenterCell; 389 390 LeftClosingLine1 := TLine.Create(LeftCell.PosPx, Cell.PosPx); 391 LeftClosingLine2 := TLine.Create(LeftCell.PosPx, 392 CenterCell.PosPx); 393 LeftAngle := SubAngle(LeftClosingLine1.GetAngle, 394 LeftClosingLine2.GetAngle); 395 396 RightClosingLine1 := TLine.Create(RightCell.PosPx, Cell.PosPx); 397 RightClosingLine2 := TLine.Create(RightCell.PosPx, 398 CenterCell.PosPx); 399 RightAngle := SubAngle(RightClosingLine2.GetAngle, 400 RightClosingLine1.GetAngle); 401 402 LeftClosingLine1 := TLine.Create(Cell.PosPx, LeftCell.PosPx); 403 RightClosingLine1 := TLine.Create(Cell.PosPx, RightCell.PosPx); 404 CurrentAngle := SubAngle(RightClosingLine1.GetAngle, 405 LeftClosingLine1.GetAngle); 406 if (CurrentAngle > LeftAngle) and (CurrentAngle > RightAngle) then begin 407 LeftCell.DisconnectFrom(RightCell); 408 Cell.ConnectTo(CenterCell); 409 SortNeighborsByAngle; 410 Inc(ChangesCount); 411 end; 412 end; 413 //end; 414 end; 415 end; 416 end; 417 if ChangesCount = 0 then Break; 418 end; 350 419 351 420 // Compute polygon around cells with sequence sorted by link angle 352 421 for Cell in Cells do begin 353 CellsAngle := TObjectList.Create;354 for I := 0 to Cell.Neighbors.Count - 1 do begin355 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 422 // Use whole map first for cell polygon 366 if Cell sAngle.Count > 0 then begin423 if Cell.Neighbors.Count > 0 then begin 367 424 Polygon := TPolygon.Create(Rect(0, 0, 368 425 Size.X * DefaultCellSize.X, Size.Y * DefaultCellSize.Y)); 369 for I := 0 to Cell sAngle.Count - 1 do begin370 CellAngle := TCellsDistance(CellsAngle[I]);371 LinkLine := TLine.Create(CellAngle.Cell1.PosPx,372 CellAngle.Cell2.PosPx);426 for I := 0 to Cell.Neighbors.Count - 1 do begin 427 LinkLine := TLine.Create(Cell.PosPx, 428 Cell.Neighbors[I].PosPx); 429 LinkLine.Distance := LinkLine.Distance - 4; 373 430 MP := LinkLine.GetMiddle; 374 431 // Create half plane vector 375 L1 := TLine.Create(MP, Point(MP.X + LinkLine.GetSize.X, MP.Y + LinkLine.GetSize.Y)); 432 L1 := TLine.Create(MP, Point(MP.X + LinkLine.GetSize.X, 433 MP.Y + LinkLine.GetSize.Y)); 376 434 377 435 Polygon.CutLine(L1, Cell.PosPx); … … 379 437 Cell.Polygon := Polygon.Points; 380 438 end else SetLength(Cell.Polygon, 0); 381 382 FreeAndNil(CellsAngle);383 439 end; 384 440 -
trunk/xtactics.lpr
r148 r165 8 8 {$ENDIF} 9 9 Interfaces, // this includes the LCL widgetset 10 Forms, tachartlazaruspkg, UGame, UCore, Common, CoolTranslator,11 TemplateGenerics, UFormPlayer10 Forms, tachartlazaruspkg, UGame, UCore, Common, 11 CoolTranslator, TemplateGenerics, UFormPlayer 12 12 { you can add units after this }, 13 13 SysUtils, UFormMain, UFormMove, UFormNew, UFormCharts, UFormUnitMoves;
Note:
See TracChangeset
for help on using the changeset viewer.