Changeset 102
- Timestamp:
- Dec 26, 2014, 8:30:25 PM (10 years ago)
- Location:
- trunk
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormNew.pas
r100 r102 326 326 var 327 327 I: Integer; 328 NewItem: TListItem;329 328 begin 330 329 CheckBoxSymetricMap.Checked := Game.SymetricMap; -
trunk/UGame.pas
r100 r102 87 87 end; 88 88 89 { TCellLink } 90 89 91 TCellLink = class 90 92 Points: array of TPoint; 91 93 Cell1: TCell; 92 94 Cell2: TCell; 93 end; 95 procedure LoadFromNode(Node: TDOMNode); 96 procedure SaveToNode(Node: TDOMNode); 97 end; 98 99 { TCellLinks } 94 100 95 101 TCellLinks = class(TObjectList) 96 102 Map: TMap; 103 procedure LoadFromNode(Node: TDOMNode); 104 procedure SaveToNode(Node: TDOMNode); 97 105 end; 98 106 … … 154 162 private 155 163 FSize: TPoint; 156 FNewCellId: Integer;157 164 function GetSize: TPoint; virtual; 158 165 procedure PaintCell(Canvas: TCanvas; Pos: TPoint; Text: string; View: TView; … … 161 168 Text: string); 162 169 procedure SetSize(AValue: TPoint); virtual; 170 protected 171 FNewCellId: Integer; 163 172 function GetNewCellId: Integer; virtual; 164 173 public … … 190 199 procedure ForEachCells(Method: TMethod); virtual; 191 200 property Size: TPoint read GetSize write SetSize; 192 end;193 194 { THexMap }195 196 THexMap = class(TMap)197 private198 function IsCellsPosNeighbor(CellPos1, CellPos2: TPoint): Boolean;199 procedure GetCellPosNeighbors(CellPos: TPoint; Neighbours: TCells);200 function GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPointArray;201 public202 procedure LoadFromFile(FileName: string); override;203 procedure SaveToFile(FileName: string); override;204 function IsValidIndex(Index: TPoint): Boolean; override;205 procedure Generate; override;206 end;207 208 { TSquareMap }209 210 TSquareMap = class(TMap)211 private212 function GetSquarePolygon(Pos: TPoint; Size: TPoint): TPointArray;213 public214 function IsValidIndex(Index: TPoint): Boolean; override;215 procedure Generate; override;216 end;217 218 { TTriangleMap }219 220 TTriangleMap = class(TMap)221 private222 function GetTrianglePolygon(Pos: TPoint; Size: TPoint; Reverse: Boolean): TPointArray;223 public224 function IsValidIndex(Index: TPoint): Boolean; override;225 procedure Generate; override;226 end;227 228 { TVoronoiMap }229 230 TVoronoiMap = class(TMap)231 private232 function GetTrianglePolygon(Pos: TPoint; Size: TPoint; Reverse: Boolean): TPointArray;233 public234 procedure Generate; override;235 201 end; 236 202 … … 457 423 implementation 458 424 425 uses 426 UMap; 427 459 428 resourcestring 460 429 SMinimumPlayers = 'You need at least two players'; … … 537 506 ((((Color shr 16) and $ff) shr 1) shl 16) or 538 507 ((((Color shr 24) and $ff) shr 0) shl 24); 508 end; 509 510 { TCellLink } 511 512 procedure TCellLink.LoadFromNode(Node: TDOMNode); 513 var 514 Node2: TDOMNode; 515 Node3: TDOMNode; 516 begin 517 Node3 := Node.FindNode('Points'); 518 if Assigned(Node3) then begin 519 SetLength(Points, 0); 520 Node2 := Node3.FirstChild; 521 while Assigned(Node2) and (Node2.NodeName = 'Point') do begin 522 SetLength(Points, Length(Points) + 1); 523 Points[High(Points)].X := ReadInteger(Node2, 'X', 0); 524 Points[High(Points)].Y := ReadInteger(Node2, 'Y', 0); 525 Node2 := Node2.NextSibling; 526 end; 527 end; 528 end; 529 530 procedure TCellLink.SaveToNode(Node: TDOMNode); 531 var 532 NewNode: TDOMNode; 533 NewNode2: TDOMNode; 534 I: Integer; 535 begin 536 NewNode := Node.OwnerDocument.CreateElement('Points'); 537 Node.AppendChild(NewNode); 538 for I := 0 to Length(Points) - 1 do begin 539 NewNode2 := NewNode.OwnerDocument.CreateElement('Point'); 540 NewNode.AppendChild(NewNode2); 541 WriteInteger(NewNode2, 'X', Points[I].X); 542 WriteInteger(NewNode2, 'Y', Points[I].Y); 543 end; 544 end; 545 546 { TCellLinks } 547 548 procedure TCellLinks.LoadFromNode(Node: TDOMNode); 549 var 550 Node2: TDOMNode; 551 NewCell: TCellLink; 552 begin 553 Count := 0; 554 Node2 := Node.FirstChild; 555 while Assigned(Node2) and (Node2.NodeName = 'CellLink') do begin 556 NewCell := TCellLink.Create; 557 //NewCell.Map := Map; 558 NewCell.LoadFromNode(Node2); 559 Add(NewCell); 560 Node2 := Node2.NextSibling; 561 end; 562 end; 563 564 procedure TCellLinks.SaveToNode(Node: TDOMNode); 565 var 566 I: Integer; 567 NewNode2: TDOMNode; 568 begin 569 for I := 0 to Count - 1 do 570 with TCellLink(Items[I]) do begin 571 NewNode2 := Node.OwnerDocument.CreateElement('CellLink'); 572 Node.AppendChild(NewNode2); 573 SaveToNode(NewNode2); 574 end; 539 575 end; 540 576 … … 976 1012 TUnitMove(Items[I]).SaveToNode(NewNode); 977 1013 end; 978 end;979 980 { TVoronoiMap }981 982 function TVoronoiMap.GetTrianglePolygon(Pos: TPoint; Size: TPoint;983 Reverse: Boolean): TPointArray;984 begin985 986 end;987 988 procedure TVoronoiMap.Generate;989 var990 X, Y: Integer;991 I, J, PI: Integer;992 V, VN: Integer;993 NewCell: TCell;994 Pos: TPoint;995 begin996 // Free previous997 Cells.Count := 0;998 FNewCellId := 1;999 // Allocate and init new1000 Cells.Count := FSize.Y * FSize.X;1001 for Y := 0 to FSize.Y - 1 do1002 for X := 0 to FSize.X - 1 do begin1003 NewCell := TCell.Create;1004 NewCell.Map := Self;1005 NewCell.PosPx := Point(Trunc(Random * FSize.X * DefaultCellSize.X), Trunc(Random * FSize.Y * DefaultCellSize.Y));1006 SetLength(NewCell.Polygon, 1);1007 NewCell.Polygon[0] := NewCell.PosPx;1008 NewCell.Id := GetNewCellId;1009 Cells[Y * FSize.X + X] := NewCell;1010 end;1011 end;1012 1013 { TTriangleMap }1014 1015 function TTriangleMap.GetTrianglePolygon(Pos: TPoint; Size: TPoint;1016 Reverse: Boolean): TPointArray;1017 var1018 Rev: Integer;1019 begin1020 if Reverse then Rev := -11021 else Rev := 1;1022 SetLength(Result, 3);1023 Result[0] := Point(Trunc(Pos.X - Size.X / 2), Trunc(Pos.Y - (Size.Y * 0.8) / 2 * Rev));1024 Result[1] := Point(Trunc(Pos.X + Size.X / 2), Trunc(Pos.Y - (Size.Y * 0.8) / 2 * Rev));1025 Result[2] := Point(Trunc(Pos.X), Trunc(Pos.Y + (Size.Y * 1.2) / 2 * Rev));1026 end;1027 1028 function TTriangleMap.IsValidIndex(Index: TPoint): Boolean;1029 begin1030 Result := (Index.X >= 0) and (Index.X < Size.X) and1031 (Index.Y >= 0) and (Index.Y < Size.Y);1032 end;1033 1034 procedure TTriangleMap.Generate;1035 var1036 X, Y: Integer;1037 Rev: Integer;1038 Reverse: Boolean;1039 NewCell: TCell;1040 begin1041 // Free previous1042 Cells.Count := 0;1043 FNewCellId := 1;1044 // Allocate and init new1045 Cells.Count := FSize.Y * FSize.X;1046 for Y := 0 to FSize.Y - 1 do1047 for X := 0 to FSize.X - 1 do begin1048 NewCell := TCell.Create;1049 NewCell.Map := Self;1050 Reverse := Boolean(X mod 2) xor Boolean(Y mod 2);1051 if Reverse then Rev := -11052 else Rev := 1;1053 NewCell.PosPx := Point(Trunc(X * DefaultCellSize.X * TriangleCellMulX),1054 Trunc((Y * DefaultCellSize.Y * TriangleCellMulY) - (0.1 * Rev * DefaultCellSize.Y)));1055 NewCell.Polygon := GetTrianglePolygon(NewCell.PosPx, DefaultCellSize, Reverse);1056 NewCell.Id := GetNewCellId;1057 Cells[Y * FSize.X + X] := NewCell;1058 end;1059 1060 // Generate neighbours1061 for Y := 0 to Self.FSize.Y - 1 do1062 for X := 0 to FSize.X - 1 do1063 with TCell(Cells[Y * FSize.X + X]) do begin1064 if Boolean(X mod 2) xor Boolean(Y mod 2) then Rev := -11065 else Rev := 1;1066 if IsValidIndex(Point(X + 1, Y + 0)) then1067 Neighbors.Add(TCell(Cells[(Y + 0) * FSize.X + (X + 1)]));1068 if IsValidIndex(Point(X + 0, Y - 1 * Rev)) then1069 Neighbors.Add(TCell(Cells[(Y - 1 * Rev) * FSize.X + (X + 0)]));1070 if IsValidIndex(Point(X - 1, Y + 0)) then1071 Neighbors.Add(TCell(Cells[(Y + 0) * FSize.X + (X - 1)]));1072 end;1073 end;1074 1075 { TSquareMap }1076 1077 procedure TSquareMap.Generate;1078 var1079 X, Y: Integer;1080 NewCell: TCell;1081 begin1082 // Free previous1083 Cells.Count := 0;1084 FNewCellId := 1;1085 // Allocate and init new1086 Cells.Count := FSize.Y * FSize.X;1087 for Y := 0 to FSize.Y - 1 do1088 for X := 0 to FSize.X - 1 do begin1089 NewCell := TCell.Create;1090 NewCell.Map := Self;1091 NewCell.PosPx := Point(Trunc(X * DefaultCellSize.X * SquareCellMulX),1092 Trunc(Y * DefaultCellSize.Y * SquareCellMulY));1093 NewCell.Polygon := GetSquarePolygon(NewCell.PosPx, DefaultCellSize);1094 NewCell.Id := GetNewCellId;1095 Cells[Y * FSize.X + X] := NewCell;1096 end;1097 1098 // Generate neighbours1099 for Y := 0 to FSize.Y - 1 do1100 for X := 0 to FSize.X - 1 do1101 with TCell(Cells[Y * FSize.X + X]) do begin1102 if IsValidIndex(Point(X + 1, Y + 0)) then1103 Neighbors.Add(TCell(Cells[(Y + 0) * FSize.X + (X + 1)]));1104 if IsValidIndex(Point(X + 0, Y + 1)) then1105 Neighbors.Add(TCell(Cells[(Y + 1) * FSize.X + (X + 0)]));1106 if IsValidIndex(Point(X - 1, Y + 0)) then1107 Neighbors.Add(TCell(Cells[(Y + 0) * FSize.X + (X - 1)]));1108 if IsValidIndex(Point(X + 0, Y - 1)) then1109 Neighbors.Add(TCell(Cells[(Y - 1) * FSize.X + (X + 0)]));1110 end;1111 end;1112 1113 function TSquareMap.IsValidIndex(Index: TPoint): Boolean;1114 begin1115 Result := (Index.X >= 0) and (Index.X < Size.X) and1116 (Index.Y >= 0) and (Index.Y < Size.Y);1117 end;1118 1119 function TSquareMap.GetSquarePolygon(Pos: TPoint; Size: TPoint): TPointArray;1120 begin1121 SetLength(Result, 4);1122 Result[0] := Point(Trunc(Pos.X - Size.X / 2), Trunc(Pos.Y - Size.Y / 2));1123 Result[1] := Point(Trunc(Pos.X + Size.X / 2), Trunc(Pos.Y - Size.Y / 2));1124 Result[2] := Point(Trunc(Pos.X + Size.X / 2), Trunc(Pos.Y + Size.Y / 2));1125 Result[3] := Point(Trunc(Pos.X - Size.X / 2), Trunc(Pos.Y + Size.Y / 2));1126 1014 end; 1127 1015 … … 1263 1151 if Assigned(Node2) then 1264 1152 Cells.LoadFromNode(Node2); 1153 Node2 := Node.FindNode('CellLinks'); 1154 if Assigned(Node2) then 1155 CellLinks.LoadFromNode(Node2); 1265 1156 end; 1266 1157 … … 1280 1171 Node.AppendChild(NewNode); 1281 1172 Cells.SaveToNode(NewNode); 1173 NewNode := Node.OwnerDocument.CreateElement('CellLinks'); 1174 Node.AppendChild(NewNode); 1175 CellLinks.SaveToNode(NewNode); 1282 1176 end; 1283 1177 … … 1415 1309 Image := TImage.Create(nil); 1416 1310 CellLinks := TCellLinks.Create; 1311 CellLinks.Map := Self; 1417 1312 Areas := TMapAreas.Create; 1418 1313 end; … … 2987 2882 end; 2988 2883 2989 { THexMap }2990 2991 function THexMap.GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPointArray;2992 var2993 Shift: TFloatPoint;2994 begin2995 Shift := FloatPoint(0.5 * cos(30 / 180 * Pi), 0.5 * sin(30 / 180 * Pi));2996 SetLength(Result, 6);2997 Result[0] := Point(Trunc(Pos.X + 0 * Size.X), Trunc(Pos.Y - 0.5 * Size.Y));2998 Result[1] := Point(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y));2999 Result[2] := Point(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y));3000 Result[3] := Point(Trunc(Pos.X + 0 * Size.X), Trunc(Pos.Y + 0.5 * Size.Y));3001 Result[4] := Point(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y));3002 Result[5] := Point(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y));3003 end;3004 3005 function THexMap.IsCellsPosNeighbor(CellPos1, CellPos2: TPoint): Boolean;3006 var3007 DX: Integer;3008 DY: Integer;3009 MinY: Integer;3010 begin3011 if CellPos1.Y < CellPos2.Y then MinY:= CellPos1.Y3012 else MinY := CellPos2.Y;3013 DX := CellPos2.X - CellPos1.X;3014 DY := CellPos2.Y - CellPos1.Y;3015 Result := (Abs(DX) <= 1) and (Abs(DY) <= 1) and3016 ((((MinY mod 2) = 1) and3017 not ((DX = 1) and (DY = -1)) and3018 not ((DX = -1) and (DY = 1))) or3019 (((MinY mod 2) = 0) and3020 not ((DX = -1) and (DY = -1)) and3021 not ((DX = 1) and (DY = 1))));3022 Result := Result and not ((CellPos1.X = CellPos2.X) and (CellPos1.Y = CellPos2.Y));3023 end;3024 3025 procedure THexMap.LoadFromFile(FileName: string);3026 var3027 Doc: TXMLDocument;3028 begin3029 try3030 ReadXMLFile(Doc, FileName);3031 if Doc.DocumentElement.TagName <> 'Map' then3032 raise Exception.Create('Invalid map format');3033 finally3034 Doc.Free;3035 end;3036 inherited LoadFromFile(FileName);3037 end;3038 3039 procedure THexMap.SaveToFile(FileName: string);3040 var3041 Doc: TXMLDocument;3042 RootNode: TDOMNode;3043 begin3044 try3045 Doc := TXMLDocument.Create;3046 RootNode := Doc.CreateElement('Map');3047 Doc.Appendchild(RootNode);3048 WriteXMLFile(Doc, FileName);3049 finally3050 Doc.Free;3051 end;3052 inherited SaveToFile(FileName);3053 end;3054 3055 function THexMap.IsValidIndex(Index: TPoint): Boolean;3056 begin3057 Result := (Index.X >= 0) and (Index.X < Size.X) and3058 (Index.Y >= 0) and (Index.Y < Size.Y);3059 end;3060 3061 procedure THexMap.GetCellPosNeighbors(CellPos: TPoint; Neighbours: TCells);3062 var3063 X, Y: Integer;3064 begin3065 Neighbours.Count := 0;3066 for Y := -1 to 1 do3067 for X := -1 to 1 do3068 if IsValidIndex(Point(CellPos.X + X, CellPos.Y + Y)) and3069 IsCellsPosNeighbor(CellPos, Point((CellPos.X + X), (CellPos.Y + Y))) then begin3070 Neighbours.Add(TCell(Cells[(CellPos.Y + Y) * FSize.X + (CellPos.X + X)]));3071 end;3072 end;3073 3074 2884 procedure TMap.Paint(Canvas: TCanvas; View: TView); 3075 2885 var … … 3134 2944 end; 3135 2945 3136 procedure THexMap.Generate;3137 var3138 X, Y: Integer;3139 I: Integer;3140 NewCell: TCell;3141 PX, PY: Double;3142 begin3143 // Free previous3144 Cells.Count := 0;3145 FNewCellId := 1;3146 // Allocate and init new3147 Cells.Count := FSize.Y * FSize.X;3148 for Y := 0 to FSize.Y - 1 do3149 for X := 0 to FSize.X - 1 do begin3150 NewCell := TCell.Create;3151 NewCell.Map := Self;3152 PX := X;3153 PY := Y;3154 if (Y and 1) = 1 then begin3155 PX := PX + 0.5;3156 //Y := Y + 0.5;3157 end;3158 NewCell.PosPx := Point(Trunc(PX * DefaultCellSize.X / HexCellMulX),3159 Trunc(PY * DefaultCellSize.Y / HexCellMulY));3160 NewCell.Polygon := GetHexagonPolygon(NewCell.PosPx, DefaultCellSize);3161 NewCell.Id := GetNewCellId;3162 Cells[Y * FSize.X + X] := NewCell;3163 end;3164 3165 // Generate neightbours3166 for Y := 0 to FSize.Y - 1 do3167 for X := 0 to FSize.X - 1 do3168 with TCell(Cells[Y * FSize.X + X]) do begin3169 GetCellPosNeighbors(Point(X, Y), Neighbors);3170 end;3171 end;3172 3173 2946 end. -
trunk/xtactics.lpi
r98 r102 87 87 </Item5> 88 88 </RequiredPackages> 89 <Units Count="1 0">89 <Units Count="11"> 90 90 <Unit0> 91 91 <Filename Value="xtactics.lpr"/> … … 161 161 <UnitName Value="UFormHelp"/> 162 162 </Unit9> 163 <Unit10> 164 <Filename Value="UMap.pas"/> 165 <IsPartOfProject Value="True"/> 166 <UnitName Value="UMap"/> 167 </Unit10> 163 168 </Units> 164 169 </ProjectOptions> -
trunk/xtactics.lpr
r97 r102 12 12 { you can add units after this }, 13 13 SysUtils, UFormSettings, UFormMain, UFormMove, UFormNew, UFormAbout, 14 UFormHelp ;14 UFormHelp, UMap; 15 15 16 16 {$R *.res}
Note:
See TracChangeset
for help on using the changeset viewer.