- Timestamp:
- Nov 26, 2017, 12:32:16 AM (7 years ago)
- Location:
- trunk
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/BigMetro.lpr
r41 r49 8 8 {$ENDIF} 9 9 Interfaces, // this includes the LCL widgetset 10 Forms, SysUtils, UFormMain, UEngine, UGeometric, UTrack, UMetaCanvas, 11 UFormImages; 10 Forms, SysUtils, UFormMain, UFormImages; 12 11 13 12 {$R *.res} -
trunk/UEngine.pas
r44 r49 6 6 7 7 uses 8 Classes, SysUtils, Contnrs,Graphics, Controls, ExtCtrls, Math, DateUtils,9 UMetaCanvas ;8 Classes, SysUtils, Graphics, Controls, ExtCtrls, Math, DateUtils, 9 UMetaCanvas, fgl; 10 10 11 11 type … … 46 46 { TMapStations } 47 47 48 TMapStations = class(T ObjectList)48 TMapStations = class(TFPGObjectList<TMapStation>) 49 49 Engine: TEngine; 50 50 function GetRect: TRect; … … 60 60 { TLineStations } 61 61 62 TLineStations = class(T ObjectList)62 TLineStations = class(TFPGObjectList<TLineStation>) 63 63 Line: TMetroLine; 64 64 function SearchMapStation(Station: TMapStation): TLineStation; … … 94 94 { TTrackPoints } 95 95 96 TTrackPoints = class(T ObjectList)96 TTrackPoints = class(TFPGObjectList<TTrackPoint>) 97 97 Track: TTrack; 98 98 function AddNew: TTrackPoint; … … 111 111 { TTrackLinks } 112 112 113 TTrackLinks = class(T ObjectList)113 TTrackLinks = class(TFPGObjectList<TTrackLink>) 114 114 Track: TTrack; 115 115 function SearchPoints(Point1, Point2: TTrackPoint): TTrackLink; … … 129 129 { TTracks } 130 130 131 TTracks = class(T ObjectList)131 TTracks = class(TFPGObjectList<TTrackLink>) 132 132 function SearchPointUp(TrackPoint: TTrackPoint; Skip: TTrackLink): TTrackLink; 133 133 function SearchPointDown(TrackPoint: TTrackPoint; Skip: TTrackLink): TTrackLink; … … 145 145 { TTrackPointsAngleGroup } 146 146 147 TTrackPointsAngleGroup = class(T ObjectList)147 TTrackPointsAngleGroup = class(TFPGObjectList<TTrackPointsAngle>) 148 148 function SearchAngle(Angle: Double): TTrackPointsAngle; 149 149 end; … … 171 171 { TMetroLines } 172 172 173 TMetroLines = class(T ObjectList)173 TMetroLines = class(TFPGObjectList<TMetroLine>) 174 174 Engine: TEngine; 175 175 function AddNew: TMetroLine; … … 204 204 { TMetroTrains } 205 205 206 TMetroTrains = class(T ObjectList)206 TMetroTrains = class(TFPGObjectList<TMetroTrain>) 207 207 function GetUnusedTrain: TMetroTrain; 208 208 function GetUnusedCount: Integer; … … 219 219 { TMetroPassengers } 220 220 221 TMetroPassengers = class(T ObjectList)221 TMetroPassengers = class(TFPGObjectList<TMetroPassenger>) 222 222 Engine: TEngine; 223 223 function AddNew: TMetroPassenger; … … 231 231 end; 232 232 233 TRivers = class(T ObjectList)233 TRivers = class(TFPGObjectList<TRiver>) 234 234 end; 235 235 … … 414 414 begin 415 415 Points := TTrackPoints.Create; 416 Points. OwnsObjects := False;416 Points.FreeObjects := False; 417 417 end; 418 418 … … 542 542 begin 543 543 TrackLinks := TTrackLinks.Create; 544 TrackLinks. OwnsObjects := False;544 TrackLinks.FreeObjects := False; 545 545 end; 546 546 … … 667 667 begin 668 668 NeighPoints := TTrackPoints.Create; 669 NeighPoints. OwnsObjects := False;669 NeighPoints.FreeObjects := False; 670 670 NeighLinks := TTrackLinks.Create; 671 NeighLinks. OwnsObjects := False;671 NeighLinks.FreeObjects := False; 672 672 end; 673 673 … … 1016 1016 begin 1017 1017 LineStations := TLineStations.Create; 1018 LineStations. OwnsObjects := True;1018 LineStations.FreeObjects := True; 1019 1019 Trains := TMetroTrains.Create; 1020 Trains. OwnsObjects := False;1020 Trains.FreeObjects := False; 1021 1021 Track := TTrack.Create; 1022 1022 Track.Line := Self; … … 1113 1113 begin 1114 1114 Passengers := TMetroPassengers.Create; 1115 Passengers. OwnsObjects := False;1115 Passengers.FreeObjects := False; 1116 1116 Direction := 1; 1117 1117 Line := nil; … … 1144 1144 begin 1145 1145 TrackLinks := TTrackLinks.Create; 1146 TrackLinks. OwnsObjects := False;1146 TrackLinks.FreeObjects := False; 1147 1147 1148 1148 // Collect all near track points as track links … … 1213 1213 end; 1214 1214 1215 TPAngleGroup.Free;1216 TrackLinks.Free;1217 end; 1218 1219 function MapStationCompareLine( Item1, Item2: Pointer): Integer;1220 begin 1221 if TMetroLine(Item1).Index > TMetroLine(Item2).Index then Result := 11222 else if TMetroLine(Item1).Index < TMetroLine(Item2).Index then Result := -11215 FreeAndNil(TPAngleGroup); 1216 FreeAndNil(TrackLinks); 1217 end; 1218 1219 function MapStationCompareLine(const Item1, Item2: TMetroLine): Integer; 1220 begin 1221 if Item1.Index > Item2.Index then Result := 1 1222 else if Item1.Index < Item2.Index then Result := -1 1223 1223 else Result := 0; 1224 1224 end; … … 1290 1290 begin 1291 1291 Passengers := TMetroPassengers.Create; 1292 Passengers. OwnsObjects := False;1292 Passengers.FreeObjects := False; 1293 1293 Lines := TMetroLines.Create; 1294 Lines. OwnsObjects := False;1294 Lines.FreeObjects := False; 1295 1295 end; 1296 1296 1297 1297 destructor TMapStation.Destroy; 1298 1298 begin 1299 Lines.Free;1300 Passengers.Free;1299 FreeAndNil(Lines); 1300 FreeAndNil(Passengers); 1301 1301 inherited Destroy; 1302 1302 end; … … 1323 1323 var 1324 1324 I: Integer; 1325 Station: TMapStation; 1325 1326 begin 1326 1327 Result := []; 1327 for I := 0 to Stations.Count - 1 do 1328 with TMapStation(Stations[I]) do begin 1329 Result := Result + [Shape]; 1330 end; 1328 for Station in Stations do 1329 Result := Result + [Station.Shape]; 1331 1330 end; 1332 1331 … … 1533 1532 I: Integer; 1534 1533 S: TStationShape; 1534 Station: TMapStation; 1535 1535 begin 1536 1536 // Reset all distances 1537 for I := 0 to Stations.Count - 1do1538 with TMapStation(Stations[I])do begin1537 for Station in Stations do 1538 with Station do begin 1539 1539 for S := Low(ShapeDistance) to High(ShapeDistance) do 1540 1540 ShapeDistance[S] := -1; … … 1543 1543 // Propagate shape distance for all stations 1544 1544 // Distace 0 means that station is final target 1545 for I := 0 to Stations.Count - 1do1546 with TMapStation(Stations[I])do begin1547 ComputeShapeDistanceStation( TMapStation(Stations[I]), Shape, 0);1545 for Station in Stations do 1546 with Station do begin 1547 ComputeShapeDistanceStation(Station, Shape, 0); 1548 1548 end; 1549 1549 end; … … 1773 1773 I: Integer; 1774 1774 J: Integer; 1775 L: Integer;1776 1775 Link1, Link2: TPoint; 1777 1776 NewPoint: TPoint; 1777 MetroLine: TMetroLine; 1778 TrackPoint: TTrackPoint; 1779 MapStation: TMapStation; 1778 1780 begin 1779 1781 // Reset all trackpoints position shift 1780 for I := 0 to Lines.Count - 1 do 1781 with TMetroLine(Lines[I]) do 1782 for MetroLine in Lines do 1783 for TrackPoint in MetroLine.Track.Points do 1784 TrackPoint.Position := TrackPoint.PositionDesigned; 1785 1786 // Calculate new position shifts 1787 for MapStation in Stations do 1788 MapStation.ShiftTrackPoints; 1789 1790 // Compute track points from track shift 1791 for MetroLine in Lines do 1792 with MetroLine do begin 1793 if Track.Points.Count > 1 then begin 1794 Track.Points[0].Position := Track.Points[0].PositionDesigned + 1795 Track.Points[0].LinkUp.Shift; 1796 end; 1797 for I := 1 to Track.Points.Count - 1 do 1798 with Track.Points[I] do 1799 if Assigned(Track.Points[I].LinkDown) and Assigned(Track.Points[I].LinkUp) then begin 1800 Link1 := (Track.Points[I].PositionDesigned + Track.Points[I].LinkDown.Shift) - 1801 (Track.Points[I - 1].PositionDesigned + Track.Points[I].LinkDown.Shift); 1802 if (I + 1) < Track.Points.Count then 1803 Link2 := (Track.Points[I + 1].PositionDesigned + Track.Points[I].LinkUp.Shift) - 1804 (Track.Points[I].PositionDesigned + Track.Points[I].LinkUp.Shift) 1805 else Link2 := Link1; 1806 1807 { if ArcTanPoint(Link1) = ArcTanPoint(Link2) then begin 1808 // Parallel lines 1809 NewPoint := Track.Points[I].PositionDesigned + Track.Points[I].LinkDown.Shift; 1810 Track.Points[I].Position := NewPoint; 1811 end else begin} 1812 // Intersected lines 1813 if LineIntersect(Track.Points[I - 1].PositionDesigned + Track.Points[I].LinkDown.Shift, 1814 Track.Points[I].PositionDesigned + Track.Points[I].LinkDown.Shift, 1815 Track.Points[I].PositionDesigned + Track.Points[I].LinkUp.Shift, 1816 Track.Points[I + 1].PositionDesigned + Track.Points[I].LinkUp.Shift, NewPoint) then 1817 Track.Points[I].Position := NewPoint 1818 else begin 1819 // Parallel lines 1820 NewPoint := Track.Points[I].PositionDesigned + Track.Points[I].LinkDown.Shift; 1821 Track.Points[I].Position := NewPoint; 1822 end; 1823 // end; 1824 end; 1825 end; 1826 1827 // Remove all temporal links 1828 for MetroLine in Lines do 1829 with MetroLine do 1782 1830 for J := 0 to Track.Points.Count - 1 do 1783 TTrackPoint(Track.Points[J]).Position := TTrackPoint(Track.Points[J]).PositionDesigned; 1784 1785 // Calculate new position shifts 1786 for I := 0 to Stations.Count - 1 do 1787 TMapStation(Stations[I]).ShiftTrackPoints; 1788 1789 // Compute track points from track shift 1790 for L := 0 to Lines.Count - 1 do 1791 with TMetroLine(Lines[L]) do begin 1792 if Track.Points.Count > 1 then begin 1793 TTrackPoint(Track.Points[0]).Position := AddPoint(TTrackPoint(Track.Points[0]).PositionDesigned, 1794 TTrackPoint(Track.Points[0]).LinkUp.Shift); 1795 end; 1796 for I := 1 to Track.Points.Count - 1 do 1797 with TTrackPoint(Track.Points[I]) do 1798 if Assigned(TTrackPoint(Track.Points[I]).LinkDown) and Assigned(TTrackPoint(Track.Points[I]).LinkUp) then begin 1799 Link1 := SubPoint(AddPoint(TTrackPoint(Track.Points[I]).PositionDesigned, TTrackPoint(Track.Points[I]).LinkDown.Shift), 1800 AddPoint(TTrackPoint(Track.Points[I - 1]).PositionDesigned, TTrackPoint(Track.Points[I]).LinkDown.Shift)); 1801 if (I + 1) < Track.Points.Count then 1802 Link2 := SubPoint(AddPoint(TTrackPoint(Track.Points[I + 1]).PositionDesigned, TTrackPoint(Track.Points[I]).LinkUp.Shift), 1803 AddPoint(TTrackPoint(Track.Points[I]).PositionDesigned, TTrackPoint(Track.Points[I]).LinkUp.Shift)) 1804 else Link2 := Link1; 1805 1806 if ArcTanPoint(Link1) = ArcTanPoint(Link2) then begin 1807 // Parallel lines 1808 NewPoint := AddPoint(TTrackPoint(Track.Points[I]).PositionDesigned, 1809 TTrackPoint(Track.Points[I]).LinkDown.Shift); 1810 TTrackPoint(Track.Points[I]).Position := NewPoint; 1811 end else begin 1812 // Intersected lines 1813 NewPoint := LineIntersect(AddPoint(TTrackPoint(Track.Points[I - 1]).PositionDesigned, 1814 TTrackPoint(Track.Points[I]).LinkDown.Shift), 1815 AddPoint(TTrackPoint(Track.Points[I]).PositionDesigned, TTrackPoint(Track.Points[I]).LinkDown.Shift), 1816 AddPoint(TTrackPoint(Track.Points[I]).PositionDesigned, TTrackPoint(Track.Points[I]).LinkUp.Shift), 1817 AddPoint(TTrackPoint(Track.Points[I + 1]).PositionDesigned, TTrackPoint(Track.Points[I]).LinkUp.Shift)); 1818 TTrackPoint(Track.Points[I]).Position := NewPoint; 1819 end; 1820 end; 1821 end; 1822 1823 // Remove all temporal links 1824 for I := 0 to Lines.Count - 1 do 1825 with TMetroLine(Lines[I]) do 1826 for J := 0 to Track.Points.Count - 1 do 1827 if Assigned(TTrackPoint(Track.Points[J]).LinkUp) then begin 1828 TTrackPoint(Track.Points[J]).LinkUp.Free; 1829 TTrackPoint(Track.Points[J]).LinkUp := nil; 1830 TTrackPoint(Track.Points[J + 1]).LinkDown := nil; 1831 if Assigned(Track.Points[J].LinkUp) then begin 1832 Track.Points[J].LinkUp.Free; 1833 Track.Points[J].LinkUp := nil; 1834 Track.Points[J + 1].LinkDown := nil; 1831 1835 end; 1832 1836 end; … … 1863 1867 procedure TEngine.DrawTrains(Canvas: TCanvas); 1864 1868 var 1865 I: Integer;1866 1869 P: Integer; 1867 1870 Pos: TPoint; … … 1869 1872 Angle: Double; 1870 1873 ShapePos: TPoint; 1874 Train: TMetroTrain; 1875 Passenger: TMetroPassenger; 1871 1876 begin 1872 1877 // Draw trains 1873 for I := 0 to Trains.Count - 1do1874 with T MetroTrain(Trains[I])do begin1878 for Train in Trains do 1879 with Train do begin 1875 1880 if Assigned(Line) then begin 1876 1881 Canvas.Brush.Color := Line.Color; … … 1887 1892 Canvas.Polygon(Points); 1888 1893 Canvas.Brush.Color := clWhite; 1889 for P := 0 to Passengers.Count - 1 do 1890 with TMetroPassenger(Passengers[P]) do begin 1894 P := 0; 1895 for Passenger in Passengers do 1896 with Passenger do begin 1891 1897 ShapePos := Point(Pos.X - Trunc(TrainSize div 3 * 1) + (P mod 3) * TrainSize div 3, 1892 1898 Pos.Y - Trunc(TrainSize div 6 * 1) + (P div 3) * TrainSize div 3); 1893 1899 ShapePos := RotatePoint(Pos, ShapePos, Angle); 1894 1900 DrawShape(Canvas, ShapePos, Shape, TrainSize div 3, Angle + Pi / 2); 1901 Inc(P); 1895 1902 end; 1896 1903 end; … … 1901 1908 var 1902 1909 Passenger: TMetroPassenger; 1903 I: Integer;1910 MapStation: TMapStation; 1904 1911 begin 1905 1912 if State = gsRunning then begin … … 1933 1940 if (Time - LastNewPassengerTime) > NewPassengerPeriod then begin 1934 1941 LastNewPassengerTime := Time; 1935 for I := 0 to Stations.Count - 1do1936 with TMapStation(Stations[I])do1942 for MapStation in Stations do 1943 with MapStation do 1937 1944 if Random < NewPassengerProbability then begin 1938 1945 Passenger := Self.Passengers.AddNew; 1939 Passenger.Station := TMapStation(Stations[I]);1946 Passenger.Station := MapStation; 1940 1947 Passengers.Add(Passenger); 1941 1948 1942 1949 // Passenger is not allowed to have same shape 1943 while (Passenger.Shape = Passenger.Station.Shape) or not (Passenger.Shape in GetExistStationShapes) do 1950 while (Passenger.Shape = Passenger.Station.Shape) or 1951 not (Passenger.Shape in GetExistStationShapes) do 1944 1952 Passenger.Shape := TStationShape((Integer(Passenger.Shape) + 1) mod Integer(ShapeCount)); 1945 1953 Redraw; … … 1948 1956 1949 1957 // Check station passenger overload state 1950 for I := 0 to Stations.Count - 1do1951 with TMapStation(Stations[I])do begin1958 for MapStation in Stations do 1959 with MapStation do begin 1952 1960 if Passengers.Count > MaxWaitingPassengers then begin 1953 1961 OverloadDuration := OverloadDuration + (FTime - FLastTime); … … 1968 1976 1969 1977 // Game over 1970 for I := 0 to Stations.Count - 1do1971 with TMapStation(Stations[I])do begin1978 for MapStation in Stations do 1979 with MapStation do begin 1972 1980 if OverloadDuration >= MaxPassengersOveloadTime then begin 1973 1981 State := gsGameOver; … … 2223 2231 destructor TEngine.Destroy; 2224 2232 begin 2225 MetaCanvas.Free;2226 Trains.Free;2227 ImageLocomotive.Free;2228 ImagePassenger.Free;2229 View.Free;2230 Map.Free;2231 Passengers.Free;2232 Stations.Free;2233 Lines.Free;2233 FreeAndNil(MetaCanvas); 2234 FreeAndNil(Trains); 2235 FreeAndNil(ImageLocomotive); 2236 FreeAndNil(ImagePassenger); 2237 FreeAndNil(View); 2238 FreeAndNil(Map); 2239 FreeAndNil(Passengers); 2240 FreeAndNil(Stations); 2241 FreeAndNil(Lines); 2234 2242 inherited Destroy; 2235 2243 end; … … 2240 2248 S: Integer; 2241 2249 Size: Integer; 2242 P: Integer;2243 2250 Pos: TPoint; 2244 2251 Text: string; … … 2248 2255 Points: array of TPoint; 2249 2256 Canvas: TMetaCanvas; 2257 MetroLine: TMetroLine; 2258 MapStation: TMapStation; 2259 Passenger: TMetroPassenger; 2250 2260 const 2251 2261 GameOverText = 'Game Over'; … … 2258 2268 2259 2269 // Draw station passenger overload 2260 for I := 0 to Stations.Count - 1do2261 with TMapStation(Stations[I])do begin2270 for MapStation in Stations do 2271 with MapStation do begin 2262 2272 if OverloadDuration > 0 then begin 2263 2273 Canvas.Brush.Color := clSilver; … … 2274 2284 2275 2285 // Draw lines 2276 for I := 0 to Lines.Count - 1do2277 with TMetroLine(Lines[I])do begin2286 for MetroLine in Lines do 2287 with MetroLine do begin 2278 2288 Canvas.Pen.Color := Color; 2279 2289 Canvas.Pen.Style := psSolid; 2280 2290 Canvas.Pen.Width := MetroLineThickness; 2281 if Track.Points.Count > 0 then Canvas.MoveTo(T TrackPoint(Track.Points[0]).Position);2291 if Track.Points.Count > 0 then Canvas.MoveTo(Track.Points[0].Position); 2282 2292 for S := 1 to Track.Points.Count - 1 do begin 2283 Canvas.LineTo(T TrackPoint(Track.Points[S]).Position);2293 Canvas.LineTo(Track.Points[S].Position); 2284 2294 { if (S = TrackPoints.Count - 1) then begin 2285 2295 Canvas.Pen.EndCap := pecSquare; … … 2349 2359 // Draw stations 2350 2360 Canvas.Pen.Width := 5; 2351 for I := 0 to Stations.Count - 1do2352 with TMapStation(Stations[I])do begin2361 for MapStation in Stations do 2362 with MapStation do begin 2353 2363 Canvas.Pen.Style := psSolid; 2354 2364 if Assigned(SelectedLine) and (Lines.IndexOf(SelectedLine) <> -1) then begin … … 2368 2378 PassengerPos := Point(0, 0); 2369 2379 Direction := 1; 2370 for P := 0 to Passengers.Count - 1do2371 with TMetroPassenger(Passengers[P])do begin2380 for Passenger in Passengers do 2381 with Passenger do begin 2372 2382 DrawShape(Canvas, Point(Position.X + StationSize + PassengerPos.X, 2373 2383 Position.Y - StationSize div 2 + PassengerPos.Y), -
trunk/UGeometric.pas
r44 r49 19 19 function RotatePoint(Center, P: TPoint; Angle: Double): TPoint; 20 20 function RotatePoints(Center: TPoint; P: TPointArray; Angle: Double): TPointArray; 21 function LineIntersect(LineAP1, LineAP2, LineBP1, LineBP2: TPoint): TPoint; 21 function LineIntersect(LineAP1, LineAP2, LineBP1, LineBP2: TPoint; 22 out Intersection: TPoint): Boolean; 22 23 function ArcTan2Point(Point: TPoint): Float; 23 24 function ArcTanPoint(Point: TPoint): Float; … … 100 101 end; 101 102 102 function LineIntersect(LineAP1, LineAP2, LineBP1, LineBP2: TPoint): TPoint; 103 function LineIntersect(LineAP1, LineAP2, LineBP1, LineBP2: TPoint; 104 out Intersection: TPoint): Boolean; 103 105 Var 104 106 LDetLineA, LDetLineB, LDetDivInv: Double; 105 107 LDiffLA, LDiffLB: TPoint; 108 D: Double; 106 109 begin 110 if (LineAP1 = LineAP2) or (LineBP1 = LineBP2) then begin 111 Result := False; 112 Exit; 113 end; 107 114 LDetLineA := LineAP1.X * LineAP2.Y - LineAP1.Y * LineAP2.X; 108 115 LDetLineB := LineBP1.X * LineBP2.Y - LineBP1.Y * LineBP2.X; … … 111 118 LDiffLB := SubPoint(LineBP1, LineBP2); 112 119 113 LDetDivInv := 1 / ((LDiffLA.X * LDiffLB.Y) - (LDiffLA.Y * LDiffLB.X)); 120 D := ((LDiffLA.X * LDiffLB.Y) - (LDiffLA.Y * LDiffLB.X)); 121 if D = 0 then begin 122 // Parallel lines without intersection 123 Result := False; 124 Exit; 125 end; 126 LDetDivInv := 1 / D; 114 127 115 Result.X := Trunc(((LDetLineA * LDiffLB.X) - (LDiffLA.X * LDetLineB)) * LDetDivInv); 116 Result.Y := Trunc(((LDetLineA * LDiffLB.Y) - (LDiffLA.Y * LDetLineB)) * LDetDivInv); 128 Intersection.X := Trunc(((LDetLineA * LDiffLB.X) - (LDiffLA.X * LDetLineB)) * LDetDivInv); 129 Intersection.Y := Trunc(((LDetLineA * LDiffLB.Y) - (LDiffLA.Y * LDetLineB)) * LDetDivInv); 130 Result := True; 117 131 end; 118 132
Note:
See TracChangeset
for help on using the changeset viewer.