source: tags/1.1.0/UEngine.pas

Last change on this file was 73, checked in by chronos, 5 years ago
  • Fixed: Build with Lazarus 2.0.6.
File size: 88.6 KB
Line 
1unit UEngine;
2
3{$mode delphi}
4{$IFDEF DARWIN}{$modeswitch Objectivec1}{$ENDIF}
5
6interface
7
8uses
9 {$IFDEF Darwin}MacOSAll, CocoaAll, CocoaUtils,{$ENDIF}
10 Classes, SysUtils, Graphics, Controls, ExtCtrls, Math, DateUtils,
11 UMetaCanvas, fgl, UMenu;
12
13type
14 TStationShape = (ssCircle, ssSquare, ssTriangle, ssStar, ssPlus, ssPentagon,
15 ssDiamond, ssQuarterCircle, ssHexagon, ssCross, ssHalfCircle, ssHeptagon);
16 TStationShapeSet = set of TStationShape;
17 TEngine = class;
18 TMetroPassengers = class;
19 TMetroLines = class;
20 TMetroLine = class;
21 TMetroTrains = class;
22 TTrackPoint = class;
23 TLineStation = class;
24 TTrackPoints = class;
25 TTrack = class;
26 TTrackLink = class;
27 TTrackLinks = class;
28
29 TColors = record
30 Background: TColor;
31 Text: TColor;
32 ShapeBackground: TColor;
33 MenuItemText: TColor;
34 MenuItemBackground: TColor;
35 MenuItemBackgroundSelected: TColor;
36 end;
37
38 { TMapStation }
39
40 TMapStation = class
41 private
42 procedure ShiftTrackPoints;
43 procedure SortLines;
44 public
45 Engine: TEngine;
46 Shape: TStationShape;
47 Position: TPoint;
48 Passengers: TMetroPassengers;
49 Lines: TMetroLines;
50 ShapeDistance: array[TStationShape] of Integer;
51 OverloadDuration: TDateTime;
52 function IsBestStationForShape(Shape: TStationShape; Check, Current: TLineStation): Boolean;
53 constructor Create;
54 destructor Destroy; override;
55 end;
56
57 { TMapStations }
58
59 TMapStations = class(TFPGObjectList<TMapStation>)
60 Engine: TEngine;
61 function GetRect: TRect;
62 function AddNew: TMapStation;
63 end;
64
65 TLineStation = class
66 Line: TMetroLine;
67 MapStation: TMapStation;
68 TrackPoint: TTrackPoint;
69 end;
70
71 { TLineStations }
72
73 TLineStations = class(TFPGObjectList<TLineStation>)
74 Line: TMetroLine;
75 function SearchMapStation(Station: TMapStation): TLineStation;
76 end;
77
78 { TTrackPoint }
79
80 TTrackPoint = class
81 LineStation: TLineStation;
82 Position: TPoint;
83 //PositionShift: TPoint;
84 PositionDesigned: TPoint;
85 Pending: Boolean;
86 Track: TTrack;
87 NeighPoints: TTrackPoints;
88 NeighLinks: TTrackLinks;
89 LinkUp: TTrackLink;
90 LinkDown: TTrackLink;
91 procedure Connect(TrackPoint: TTrackPoint);
92 procedure Disconnect(TrackPoint: TTrackPoint);
93 function GetDown: TTrackPoint;
94 function GetUp: TTrackPoint;
95 function GetNeighDown: TTrackPoint;
96 function GetNeighUp: TTrackPoint;
97 function GetLinkDown: TTrackLink;
98 function GetLinkUp: TTrackLink;
99 // Move to TTrackLink later
100 function GetDistance: Integer;
101 constructor Create;
102 destructor Destroy; override;
103 end;
104
105 { TTrackPoints }
106
107 TTrackPoints = class(TFPGObjectList<TTrackPoint>)
108 Track: TTrack;
109 function AddNew: TTrackPoint;
110 end;
111
112 { TTrackLink }
113
114 TTrackLink = class
115 Points: TTrackPoints;
116 Shift: TPoint;
117 Track: TTrack;
118 constructor Create;
119 destructor Destroy; override;
120 end;
121
122 { TTrackLinks }
123
124 TTrackLinks = class(TFPGObjectList<TTrackLink>)
125 Track: TTrack;
126 function SearchPoints(Point1, Point2: TTrackPoint): TTrackLink;
127 function AddNew: TTrackLink;
128 end;
129
130 TTrack = class
131 Points: TTrackPoints;
132 Links: TTrackLinks;
133 Line: TMetroLine;
134 procedure RouteTrack(TP1, TP2: TTrackPoint);
135 procedure RemoveTrackBetween(TP1, TP2: TTrackPoint);
136 constructor Create;
137 destructor Destroy; override;
138 end;
139
140 { TTracks }
141
142 TTracks = class(TFPGObjectList<TTrackLink>)
143 function SearchPointUp(TrackPoint: TTrackPoint; Skip: TTrackLink): TTrackLink;
144 function SearchPointDown(TrackPoint: TTrackPoint; Skip: TTrackLink): TTrackLink;
145 end;
146
147 { TTrackPointsAngle }
148
149 TTrackPointsAngle = class
150 Angle: Double;
151 TrackLinks: TTrackLinks;
152 constructor Create;
153 destructor Destroy; override;
154 end;
155
156 { TTrackPointsAngleGroup }
157
158 TTrackPointsAngleGroup = class(TFPGObjectList<TTrackPointsAngle>)
159 function SearchAngle(Angle: Double): TTrackPointsAngle;
160 end;
161
162 { TMetroLine }
163
164 TMetroLine = class
165 private
166 procedure UpdateEndingLines;
167 public
168 Index: Integer;
169 Engine: TEngine;
170 Color: TColor;
171 LineStations: TLineStations;
172 Trains: TMetroTrains;
173 Track: TTrack;
174 procedure ConnectStation(Station: TMapStation; LineStationDown, LineStationUp: TLineStation);
175 procedure DisconnectStation(ALineStation: TLineStation);
176 function GetTrackLength: Integer;
177 constructor Create;
178 destructor Destroy; override;
179 function IsCircular: Boolean;
180 end;
181
182 { TMetroLines }
183
184 TMetroLines = class(TFPGObjectList<TMetroLine>)
185 Engine: TEngine;
186 function AddNew: TMetroLine;
187 function SearchByColor(Color: TColor): TMetroLine;
188 end;
189
190 { TMetroTrain }
191
192 TMetroTrain = class
193 private
194 FLine: TMetroLine;
195 LastPosDelta: Integer;
196 LastTrainMoveTime: TDateTime;
197 StationStopTime: TDateTime;
198 procedure SetLine(AValue: TMetroLine);
199 public
200 Passengers: TMetroPassengers;
201 BaseTrackPoint: TTrackPoint;
202 RelPos: Double;
203 Direction: Integer;
204 InStation: Boolean;
205 TargetStation: TLineStation;
206 function GetTargetStationDistance: Integer;
207 function GetPosition: TPoint;
208 function GetAngle: Double;
209 constructor Create;
210 destructor Destroy; override;
211 property Line: TMetroLine read FLine write SetLine;
212 end;
213
214 { TMetroTrains }
215
216 TMetroTrains = class(TFPGObjectList<TMetroTrain>)
217 function GetUnusedTrain: TMetroTrain;
218 function GetUnusedCount: Integer;
219 function AddNew: TMetroTrain;
220 end;
221
222 TMetroPassenger = class
223 Engine: TEngine;
224 Shape: TStationShape;
225 Station: TMapStation;
226 Train: TMetroTrain;
227 end;
228
229 { TMetroPassengers }
230
231 TMetroPassengers = class(TFPGObjectList<TMetroPassenger>)
232 Engine: TEngine;
233 function AddNew: TMetroPassenger;
234 end;
235
236 { TRiver }
237
238 TRiver = class
239 Points: array of TPoint;
240 procedure Paint(Canvas: TCanvas);
241 end;
242
243 TRivers = class(TFPGObjectList<TRiver>)
244 end;
245
246 TMap = class
247 Size: TPoint;
248 Rivers: TRivers;
249 constructor Create;
250 destructor Destroy; override;
251 end;
252
253 { TView }
254
255 TView = class
256 private
257 FDestRect: TRect;
258 FSourceRect: TRect;
259 FZoom: Double;
260 procedure SetDestRect(AValue: TRect);
261 procedure SetSourceRect(AValue: TRect);
262 procedure SetZoom(AValue: Double);
263 public
264 function PointDestToSrc(Pos: TPoint): TPoint;
265 function PointSrcToDest(Pos: TPoint): TPoint;
266 constructor Create;
267 property SourceRect: TRect read FSourceRect write SetSourceRect;
268 property DestRect: TRect read FDestRect write SetDestRect;
269 property Zoom: Double read FZoom write SetZoom;
270 end;
271
272 TGameState = (gsNotStarted, gsRunning, gsPaused, gsGameOver, gsMenu);
273
274 { TEngine }
275
276 TEngine = class
277 private
278 FDarkMode: Boolean;
279 LastMousePos: TPoint;
280 LastFocusedStation: TMapStation;
281 MouseHold: Boolean;
282 LastNewStationTime: TDateTime;
283 LastNewPassengerTime: TDateTime;
284 LastNewWeekTime: TDateTime;
285 LastNewShapeTime: TDateTime;
286 LastTickTime: TDateTime;
287 FTime: TDateTime;
288 FLastTime: TDateTime;
289 MetaCanvas: TMetaCanvas;
290 Menu: TMenu;
291 MenuMain: TMenu;
292 MenuOptions: TMenu;
293 MenuGame: TMenu;
294 ButtonBack: TMenuItemButton;
295 LastState: TGameState;
296 function GetServedDaysCount: Integer;
297 procedure ResizeView;
298 function GetExistStationShapes: TStationShapeSet;
299 function GetStationOnPos(Pos: TPoint): TMapStation;
300 function GetTrackOnPos(Pos: TPoint): TTrackLink;
301 function GetTrainOnPos(Pos: TPoint): TMetroTrain;
302 procedure DrawLine(Canvas: TCanvas; Pos: TPoint);
303 procedure DrawShape(Canvas: TCanvas; Position: TPoint; Shape: TStationShape;
304 Size: Integer; Angle: Double);
305 procedure DrawClock(Canvas: TCanvas; CanvasSize: TPoint);
306 procedure DrawTrains(Canvas: TCanvas);
307 procedure DrawGameOver(Canvas: TCanvas; CanvasSize: TPoint);
308 procedure DrawStationPassengerOverload(Canvas: TCanvas);
309 procedure DrawLines(Canvas: TCanvas);
310 procedure DrawStations(Canvas: TCanvas);
311 procedure DrawGameControls(Canvas: TCanvas; CanvasSize: TPoint);
312 procedure ComputeShapeDistance;
313 procedure ComputeShapeDistanceStation(Station: TMapStation;
314 UpdatedShape: TStationShape; Distance: Integer);
315 procedure SetDarkMode(AValue: Boolean);
316 procedure InitColors;
317 procedure TrainMovement;
318 function GetUnusedLine: TMetroLine;
319 procedure ShiftTrackPoints;
320 procedure MenuItemExit(Sender: TObject);
321 procedure MenuItemPlay(Sender: TObject);
322 procedure MenuItemOptions(Sender: TObject);
323 procedure MenuItemGameContinue(Sender: TObject);
324 procedure MenuItemGameExit(Sender: TObject);
325 procedure MenuItemGameRestart(Sender: TObject);
326 procedure MenuItemBack(Sender: TObject);
327 procedure ButtonBackClick(Sender: TObject);
328 procedure DarkModeChanged(Sender: TObject);
329 procedure LanguageChanged(Sender: TObject);
330 procedure FullScreenChanged(Sender: TObject);
331 public
332 Colors: TColors;
333 Passengers: TMetroPassengers;
334 Stations: TMapStations;
335 Lines: TMetroLines;
336 Trains: TMetroTrains;
337 ShapeCount: Integer;
338 Map: TMap;
339 View: TView;
340 SelectedLine: TMetroLine;
341 SelectedTrain: TMetroTrain;
342 TrackStationDown: TTrackPoint;
343 TrackStationUp: TTrackPoint;
344 ServedPassengerCount: Integer;
345 State: TGameState;
346 RedrawPending: Boolean;
347 ImagePassenger: TImage;
348 ImageLocomotive: TImage;
349 HighestServedPassengerCount: Integer;
350 HighestServedDaysCount: Integer;
351 procedure InitMenus;
352 procedure MouseMove(Position: TPoint);
353 procedure MouseUp(Button: TMouseButton; Position: TPoint);
354 procedure MouseDown(Button: TMouseButton; Position: TPoint);
355 procedure KeyUp(Key: Word);
356 procedure MainMenu;
357 procedure Clear;
358 procedure NewGame;
359 procedure Redraw;
360 constructor Create;
361 destructor Destroy; override;
362 procedure Tick;
363 procedure Paint(Canvas: TCanvas; CanvasSize: TPoint);
364 property Time: TDateTime read FTime;
365 property DarkMode: Boolean read FDarkMode write SetDarkMode;
366 property ServedDaysCount: Integer read GetServedDaysCount;
367 end;
368
369const
370 clDarkYellow = TColor($00dede);
371 clOrange = TColor($0080ff);
372 clBrown = TColor($003090);
373 clCyan = TColor($FFFF00);
374 LineColors: array[0..8] of TColor = (clBlue, clRed, clDarkYellow, clGreen,
375 clPurple, clGray, clOrange, clBrown, clCyan);
376 StationSize = 30;
377 StationOverloadSize = 60;
378 PassengerSize = 15;
379 TrainSize = 40;
380 LineColorsDist = 50;
381 TrainSpeed = 2000;
382 ImagePassengerName = 'Images/Passenger.png';
383 ImageLocomotiveName = 'Images/Locomotive.png';
384 TrainPassengerCount = 6;
385 StationMinDistance = 100;
386 StationMaxDistance = 300;
387 MaxWaitingPassengers = 10;
388 MaxPassengersOveloadTime = 2;
389 MetroLineThickness = 13;
390 TrackClickDistance = 20;
391 EndStationLength = 50;
392 ShowDistances = False;
393 TimePerSecond = 60 * OneMinute;
394 NewStationPeriod = 1;
395 NewShapePeriod = 10;
396 NewTrainPeriod = 7; // Each week
397 NewPassengerPeriod = 0.3 * OneSecond;
398 NewPassengerProbability = 0.003;
399 VisiblePassengersPerLine = 6;
400
401
402implementation
403
404uses
405 UGeometric, UFormMain, ULanguages;
406
407resourcestring
408 SZeroZoomNotAlowed = 'Zero zoom not allowed';
409 SAlreadyConnectedTrackPoint = 'Trying to connect already connected track point';
410 SAlreadyDisconnectedTrackPoint = 'Trying to disconnect not connected track point';
411 SGameOver = 'Game Over';
412 SGameOverReason = 'Overcrowding at this station has forced you to resign as metro manager.';
413 SGameOverStatistic = '%d passengers travelled on your metro over %d days.';
414 SDay = 'Day';
415 SNewHighScore = 'New high score!';
416 SOldHighScore = 'Old high score was %d passengers in %d days.';
417
418{ TTrackLinks }
419
420function TTrackLinks.SearchPoints(Point1, Point2: TTrackPoint): TTrackLink;
421var
422 I: Integer;
423begin
424 I := 0;
425 while (I < 0) and
426 ((Items[I].Points.First <> Point1) or (Items[I].Points.Last <> Point2)) and
427 ((Items[I].Points.First <> Point2) or (Items[I].Points.Last <> Point1)) do
428 Inc(I);
429 if I < 0 then Result := Items[I]
430 else Result := nil;
431end;
432
433function TTrackLinks.AddNew: TTrackLink;
434begin
435 Result := TTrackLink.Create;
436 Result.Track := Track;
437end;
438
439{ TTrackPoints }
440
441function TTrackPoints.AddNew: TTrackPoint;
442begin
443 Result := TTrackPoint.Create;
444 Result.Track := Track;
445end;
446
447{ TTrack }
448
449constructor TTrack.Create;
450begin
451 Points := TTrackPoints.Create;
452 Points.Track := Self;
453 Links := TTrackLinks.Create;
454 Links.Track := Self;
455end;
456
457destructor TTrack.Destroy;
458begin
459 Points.Free;
460 Links.Free;
461 inherited;
462end;
463
464{ TTrackLink }
465
466constructor TTrackLink.Create;
467begin
468 Points := TTrackPoints.Create;
469 Points.FreeObjects := False;
470end;
471
472destructor TTrackLink.Destroy;
473begin
474 Points.Free;
475 inherited;
476end;
477
478{ TRiver }
479
480procedure TRiver.Paint(Canvas: TCanvas);
481begin
482 Canvas.Brush.Color := $ffffe0;
483 Canvas.Brush.Style := bsSolid;
484 Canvas.Polygon(Points);
485end;
486
487{ TMap }
488
489constructor TMap.Create;
490begin
491 Rivers := TRivers.Create;
492end;
493
494destructor TMap.Destroy;
495begin
496 Rivers.Free;
497 inherited;
498end;
499
500{ TView }
501
502procedure TView.SetDestRect(AValue: TRect);
503var
504 Diff: TPoint;
505begin
506 if RectEquals(FDestRect, AValue) then Exit;
507 Diff := Point(Trunc((DestRect.Right - DestRect.Left) / Zoom - (AValue.Right - AValue.Left) / Zoom) div 2,
508 Trunc((DestRect.Bottom - DestRect.Top) / Zoom - (AValue.Bottom - AValue.Top) / Zoom) div 2);
509 FDestRect := AValue;
510 FSourceRect := Bounds(FSourceRect.Left + Diff.X, FSourceRect.Top + Diff.Y,
511 Trunc((DestRect.Right - DestRect.Left) / Zoom),
512 Trunc((DestRect.Bottom - DestRect.Top) / Zoom));
513end;
514
515procedure TView.SetSourceRect(AValue: TRect);
516var
517 ZX: Double;
518 ZY: Double;
519begin
520 if RectEquals(FSourceRect, AValue) then Exit;
521 FSourceRect := AValue;
522 ZX := (FDestRect.Right - FDestRect.Left) / (FSourceRect.Right - FSourceRect.Left);
523 ZY := (FDestRect.Bottom - FDestRect.Top) / (FSourceRect.Bottom - FSourceRect.Top);
524 if ZX > ZY then
525 Zoom := ZY
526 else Zoom := ZX;
527end;
528
529procedure TView.SetZoom(AValue: Double);
530begin
531 if FZoom = AValue then Exit;
532 if AValue = 0 then
533 raise Exception.Create(SZeroZoomNotAlowed);
534 FZoom := AValue;
535 FSourceRect := Bounds(Trunc(FSourceRect.Left + (FSourceRect.Right - FSourceRect.Left) div 2 - (DestRect.Right - DestRect.Left) / Zoom / 2),
536 Trunc(FSourceRect.Top + (FSourceRect.Bottom - FSourceRect.Top) div 2 - (FDestRect.Bottom - DestRect.Top) / Zoom / 2),
537 Trunc((DestRect.Right - DestRect.Left) / Zoom),
538 Trunc((DestRect.Bottom - DestRect.Top) / Zoom));
539end;
540
541function TView.PointDestToSrc(Pos: TPoint): TPoint;
542begin
543 Result := Point(Trunc(Pos.X / FZoom + FSourceRect.Left),
544 Trunc(Pos.Y / FZoom + FSourceRect.Top));
545end;
546
547function TView.PointSrcToDest(Pos: TPoint): TPoint;
548begin
549 Result := Point(Trunc((Pos.X - FSourceRect.Left) * FZoom),
550 Trunc((Pos.Y - FSourceRect.Top) * FZoom));
551end;
552
553constructor TView.Create;
554begin
555 Zoom := 1;
556end;
557
558{ TTracks }
559
560function TTracks.SearchPointUp(TrackPoint: TTrackPoint; Skip: TTrackLink): TTrackLink;
561var
562 I: Integer;
563begin
564 I := 0;
565 while (I < Count) and (Items[I].Points[1] <> TrackPoint) and (Items[I] <> Skip) do Inc(I);
566 if I < Count then Result := Items[I]
567 else Result := nil;
568end;
569
570function TTracks.SearchPointDown(TrackPoint: TTrackPoint; Skip: TTrackLink): TTrackLink;
571var
572 I: Integer;
573begin
574 I := 0;
575 while (I < Count) and (Items[I].Points[0] <> TrackPoint) and (Items[I] <> Skip) do Inc(I);
576 if I < Count then Result := Items[I]
577 else Result := nil;
578end;
579
580{ TTrackPointsAngleGroup }
581
582function TTrackPointsAngleGroup.SearchAngle(Angle: Double): TTrackPointsAngle;
583var
584 I: Integer;
585begin
586 I := 0;
587 while (I < Count) and (Items[I].Angle <> Angle) do Inc(I);
588 if I < Count then Result := Items[I]
589 else Result := nil;
590end;
591
592{ TTrackPointsAngle }
593
594constructor TTrackPointsAngle.Create;
595begin
596 TrackLinks := TTrackLinks.Create;
597 TrackLinks.FreeObjects := False;
598end;
599
600destructor TTrackPointsAngle.Destroy;
601begin
602 TrackLinks.Free;
603 inherited;
604end;
605
606{ TTrackPoint }
607
608procedure TTrackPoint.Connect(TrackPoint: TTrackPoint);
609var
610 NewLink: TTrackLink;
611begin
612 if NeighPoints.IndexOf(TrackPoint) = -1 then begin
613 NeighPoints.Add(TrackPoint);
614 TrackPoint.NeighPoints.Add(Self);
615
616 // Add new link to both self and connected track point
617 NewLink := Track.Links.AddNew;
618 NewLink.Points.Add(TrackPoint);
619 NewLink.Points.Add(Self);
620 NeighLinks.Add(NewLink);
621 TrackPoint.NeighLinks.Add(NewLink);
622 Track.Links.Add(NewLink);
623 end else raise Exception.Create(SAlreadyConnectedTrackPoint);
624end;
625
626procedure TTrackPoint.Disconnect(TrackPoint: TTrackPoint);
627var
628 Index: Integer;
629 Link: TTrackLink;
630begin
631 Index := NeighPoints.IndexOf(TrackPoint);
632 if NeighPoints.IndexOf(TrackPoint) <> -1 then begin
633 NeighPoints.Delete(Index);
634 TrackPoint.NeighPoints.Remove(Self);
635
636 // Remove link from both track points
637 Link := NeighLinks.SearchPoints(Self, TrackPoint);
638 NeighLinks.Remove(Link);
639 TrackPoint.NeighLinks.Remove(Link);
640 Track.Links.Remove(Link);
641 end else raise Exception.Create(SAlreadyDisconnectedTrackPoint);
642end;
643
644function TTrackPoint.GetDown: TTrackPoint;
645var
646 I: Integer;
647begin
648 I := Track.Points.IndexOf(Self) - 1;
649 while (I >= 0) and not Assigned(Track.Points[I].LineStation) do
650 Dec(I);
651 if I >= 0 then Result := Track.Points[I]
652 else Result := nil;
653end;
654
655function TTrackPoint.GetUp: TTrackPoint;
656var
657 I: Integer;
658begin
659 I := Track.Points.IndexOf(Self) + 1;
660 while (I < Track.Points.Count) and not Assigned(Track.Points[I].LineStation) do
661 Inc(I);
662 if I < Track.Points.Count then Result := Track.Points[I]
663 else Result := nil;
664end;
665
666function TTrackPoint.GetNeighDown: TTrackPoint;
667var
668 NewIndex: Integer;
669begin
670 Result := nil;
671 NewIndex := Track.Points.IndexOf(Self) - 1;
672 if NewIndex >= 0 then Result := Track.Points[NewIndex];
673end;
674
675function TTrackPoint.GetNeighUp: TTrackPoint;
676var
677 NewIndex: Integer;
678begin
679 Result := nil;
680 if Assigned(Track) then begin
681 NewIndex := Track.Points.IndexOf(Self) + 1;
682 if NewIndex < Track.Points.Count then Result := Track.Points[NewIndex];
683 end;
684end;
685
686function TTrackPoint.GetLinkDown: TTrackLink;
687begin
688 if Assigned(LinkDown) then Result := LinkDown
689 else begin
690 LinkDown := TTrackLink.Create;
691 LinkDown.Points.Add(GetNeighDown);
692 LinkDown.Points.Add(Self);
693 Result := LinkDown;
694 GetNeighDown.LinkUp := LinkDown;
695 end;
696end;
697
698function TTrackPoint.GetLinkUp: TTrackLink;
699begin
700 if Assigned(LinkUp) then Result := LinkUp
701 else begin
702 LinkUp := TTrackLink.Create;
703 LinkUp.Points.Add(Self);
704 LinkUp.Points.Add(GetNeighUp);
705 Result := LinkUp;
706 GetNeighUp.LinkDown := LinkUp;
707 end;
708end;
709
710function TTrackPoint.GetDistance: Integer;
711var
712 Index: Integer;
713begin
714 Index := Track.Points.IndexOf(Self);
715 Result := Distance(Track.Points[Index + 1].Position, Track.Points[Index].Position);
716end;
717
718constructor TTrackPoint.Create;
719begin
720 NeighPoints := TTrackPoints.Create;
721 NeighPoints.FreeObjects := False;
722 NeighLinks := TTrackLinks.Create;
723 NeighLinks.FreeObjects := False;
724end;
725
726destructor TTrackPoint.Destroy;
727begin
728 NeighLinks.Free;
729 NeighPoints.Free;
730 inherited;
731end;
732
733{ TLineStations }
734
735function TLineStations.SearchMapStation(Station: TMapStation): TLineStation;
736var
737 I: Integer;
738begin
739 I := 0;
740 while (I < Count) and (Items[I].MapStation <> Station) do Inc(I);
741 if I < Count then Result := Items[I]
742 else Result := nil;
743end;
744
745{ TMetroPassengers }
746
747function TMetroPassengers.AddNew: TMetroPassenger;
748begin
749 Result := TMetroPassenger.Create;
750 Result.Engine := Engine;
751 Result.Shape := TStationShape(Random(Integer(Engine.ShapeCount)));
752 Add(Result);
753end;
754
755{ TMetroTrains }
756
757function TMetroTrains.GetUnusedTrain: TMetroTrain;
758var
759 I: Integer;
760begin
761 I := 0;
762 while (I < Count) and (Assigned(Items[I].Line)) do Inc(I);
763 if I < Count then Result := Items[I]
764 else Result := nil;
765end;
766
767function TMetroTrains.GetUnusedCount: Integer;
768var
769 I: Integer;
770begin
771 Result := 0;
772 for I := 0 to Count - 1 do
773 if not Assigned(Items[I].Line) then Inc(Result);
774end;
775
776function TMetroTrains.AddNew: TMetroTrain;
777begin
778 Result := TMetroTrain.Create;
779 Add(Result);
780end;
781
782{ TMapStations }
783
784function TMapStations.GetRect: TRect;
785var
786 I: Integer;
787begin
788 if Count > 0 then begin
789 with Items[0] do
790 Result := Rect(Position.X, Position.Y, Position.X, Position.Y);
791 for I := 1 to Count - 1 do
792 with Items[I] do begin
793 if Position.X < Result.Left then Result.Left := Position.X;
794 if Position.X > Result.Right then Result.Right := Position.X;
795 if Position.Y < Result.Top then Result.Top := Position.Y;
796 if Position.Y > Result.Bottom then Result.Bottom := Position.Y;
797 end;
798 end else Result := Rect(0, 0, 0, 0);
799end;
800
801function TMapStations.AddNew: TMapStation;
802var
803 D: Integer;
804 MinD: Integer;
805 I: Integer;
806 Pass: Integer;
807 Angle: Double;
808 L: Integer;
809const
810 Step = 20;
811begin
812 Result := TMapStation.Create;
813 Result.Engine := Engine;
814 Angle := Random * 2 * Pi;
815 // Ensure minimum distance between stations
816 Pass := 0;
817 L := Step;
818 repeat
819 Result.Position := Point(Trunc(Engine.Map.Size.X / 2 + Cos(Angle) * L * 1.5),
820 Trunc(Engine.Map.Size.Y / 2 + Sin(Angle) * L));
821 MinD := High(Integer);
822 for I := 0 to Engine.Stations.Count - 1 do begin
823 D := Distance(Engine.Stations[I].Position, Result.Position);
824 if D < MinD then MinD := D;
825 end;
826 Inc(Pass);
827 L := L + StationMinDistance div 2;
828 until (MinD > StationMinDistance) or
829 (Pass > 1000) or (Engine.Stations.Count = 0);
830 Result.Shape := TStationShape(Random(Integer(Engine.ShapeCount)));
831 Add(Result);
832 Engine.ComputeShapeDistance;
833end;
834
835{ TMetroLines }
836
837function TMetroLines.AddNew: TMetroLine;
838begin
839 Result := TMetroLine.Create;
840 Result.Color := LineColors[Count];
841 Result.Engine := Engine;
842 Result.Index := Count;
843 Add(Result);
844end;
845
846function TMetroLines.SearchByColor(Color: TColor): TMetroLine;
847var
848 I: Integer;
849begin
850 I := 0;
851 while (I < Count) and (Items[I].Color <> Color) do Inc(I);
852 if I < Count then Result := Items[I]
853 else Result := nil;
854end;
855
856{ TMetroLine }
857
858procedure TMetroLine.UpdateEndingLines;
859var
860 Index: Integer;
861 NewTrackPoint: TTrackPoint;
862 Angle: Double;
863 EndPoint: TPoint;
864begin
865 if LineStations.Count >= 2 then begin
866 Index := Track.Points.IndexOf(LineStations.First.TrackPoint);
867 if Index = 0 then begin
868 NewTrackPoint := Track.Points.AddNew;
869 Track.Points.Insert(0, NewTrackPoint);
870 end;
871 Index := Track.Points.IndexOf(LineStations.Last.TrackPoint);
872 if Index = Track.Points.Count - 1 then begin
873 NewTrackPoint := Track.Points.AddNew;
874 Track.Points.Insert(Track.Points.Count, NewTrackPoint);
875 end;
876
877 Angle := ArcTan2((Track.Points[2].PositionDesigned.Y - Track.Points[1].PositionDesigned.Y),
878 (Track.Points[2].PositionDesigned.X - Track.Points[1].PositionDesigned.X));
879 EndPoint := Point(Round(Track.Points[1].PositionDesigned.X - EndStationLength * Cos(Angle)),
880 Round(Track.Points[1].PositionDesigned.Y - EndStationLength * Sin(Angle)));
881 Track.Points.First.PositionDesigned := EndPoint;
882 Track.Points.First.Position := EndPoint;
883
884 Angle := ArcTan2((Track.Points[Track.Points.Count - 2].PositionDesigned.Y - Track.Points[Track.Points.Count - 3].PositionDesigned.Y),
885 (Track.Points[Track.Points.Count - 2].PositionDesigned.X - Track.Points[Track.Points.Count - 3].PositionDesigned.X));
886 EndPoint := Point(Round(Track.Points[Track.Points.Count - 2].PositionDesigned.X + EndStationLength * Cos(Angle)),
887 Round(Track.Points[Track.Points.Count - 2].PositionDesigned.Y + EndStationLength * Sin(Angle)));
888 Track.Points.Last.PositionDesigned := EndPoint;
889 Track.Points.Last.Position := EndPoint;
890 end;
891end;
892
893procedure TMetroLine.ConnectStation(Station: TMapStation; LineStationDown, LineStationUp: TLineStation);
894var
895 Train: TMetroTrain;
896 NewTrackPoint: TTrackPoint;
897 NewLineStation: TLineStation;
898 Index: Integer;
899begin
900 if not Assigned(Station) then
901 raise Exception.Create('Station have to be defined');
902 if not Assigned(LineStationDown) and not Assigned(LineStationUp) and (LineStations.Count > 0) then
903 raise Exception.Create('No old line station to connect new station');
904 NewLineStation := TLineStation.Create;
905 NewLineStation.Line := Self;
906 NewLineStation.MapStation := Station;
907 Index := 0;
908 if Assigned(LineStationDown) then Index := LineStations.IndexOf(LineStationDown) + 1
909 else if Assigned(LineStationDown) then Index := LineStations.IndexOf(LineStationUp);
910 LineStations.Insert(Index, NewLineStation);
911 Station.Lines.Add(Self);
912
913 NewTrackPoint := Track.Points.AddNew;
914 NewTrackPoint.LineStation := NewLineStation;
915 NewTrackPoint.Position := Station.Position;
916 NewTrackPoint.PositionDesigned := NewTrackPoint.Position;
917 Index := 0;
918 if Assigned(LineStationDown) then Index := Track.Points.IndexOf(LineStationDown.TrackPoint) + 1
919 else if Assigned(LineStationUp) then Index := Track.Points.IndexOf(LineStationUp.TrackPoint);
920 Track.Points.Insert(Index, NewTrackPoint);
921 NewLineStation.TrackPoint := NewTrackPoint;
922
923 if Assigned(LineStationDown) then
924 Track.RouteTrack(NewLineStation.TrackPoint.GetDown, NewLineStation.TrackPoint);
925 if Assigned(LineStationUp) then
926 Track.RouteTrack(NewLineStation.TrackPoint, NewLineStation.TrackPoint.GetUp);
927
928 // Place one train if at least two stations present
929 if (LineStations.Count = 2) then begin
930 Train := Engine.Trains.GetUnusedTrain;
931 if Assigned(Train) then begin
932 Train.Line := Self;
933 Train.TargetStation := LineStations[0];
934 Train.BaseTrackPoint := Track.Points.First;
935 Trains.Add(Train);
936 end;
937 end;
938 UpdateEndingLines;
939 Engine.ComputeShapeDistance;
940 Engine.ShiftTrackPoints;
941end;
942
943procedure TMetroLine.DisconnectStation(ALineStation: TLineStation);
944var
945 I: Integer;
946 J: Integer;
947 Index: Integer;
948 TP1, TP2: TTrackPoint;
949 IsOnTrack: Boolean;
950begin
951 // Determine track point range to be removed
952 TP1 := ALineStation.TrackPoint.GetDown;
953 if not Assigned(TP1) then TP1 := Track.Points.First;
954 TP2 := ALineStation.TrackPoint.GetUp;
955 if not Assigned(TP2) then TP2 := Track.Points.Last;
956
957 // Remove track points from trains
958 for I := 0 to Trains.Count - 1 do
959 with Trains[I] do begin
960 IsOnTrack := False;
961 for J := Track.Points.IndexOf(TP1) to Track.Points.IndexOf(TP2) do
962 if Track.Points[J] = BaseTrackPoint then begin
963 IsOnTrack := True;
964 Break;
965 end;
966 if IsOnTrack then begin
967 if Assigned(BaseTrackPoint) and Assigned(BaseTrackPoint.GetUp) and (BaseTrackPoint.GetUp <> ALineStation.TrackPoint) then
968 BaseTrackPoint := BaseTrackPoint.GetUp
969 else
970 if Assigned(BaseTrackPoint) and Assigned(BaseTrackPoint.GetDown) and (BaseTrackPoint.GetDown <> ALineStation.TrackPoint) then
971 BaseTrackPoint := BaseTrackPoint.GetDown
972 else BaseTrackPoint := nil;
973 end;
974 end;
975
976 // Delete old trackpoints
977 Index := Track.Points.IndexOf(ALineStation.TrackPoint) - 1;
978 while (Index >= 0) and (not Assigned(Track.Points[Index].LineStation)) do begin
979 Track.Points.Delete(Index);
980 Dec(Index);
981 end;
982 Index := Index + 1;
983 Track.Points.Delete(Index);
984 while (Index < Track.Points.Count) and (not Assigned(Track.Points[Index].LineStation)) do
985 Track.Points.Delete(Index);
986
987 if ((Index - 1) >= 0) and (Index < Track.Points.Count) then
988 Track.RouteTrack(Track.Points[Index - 1], Track.Points[Index]);
989
990 ALineStation.MapStation.Lines.Remove(Self);
991 Index := LineStations.IndexOf(ALineStation);
992
993 for I := 0 to Trains.Count - 1 do
994 with Trains[I] do begin
995 if TargetStation = ALineStation then
996 TargetStation := LineStations[(Index + 1) mod LineStations.Count];
997 end;
998
999 LineStations.Delete(Index);
1000
1001 // Remove all trains if less then two stations
1002 if LineStations.Count < 2 then
1003 for I := Trains.Count - 1 downto 0 do begin
1004 Trains[I].Line := nil;
1005 Trains.Delete(I);
1006 end;
1007 UpdateEndingLines;
1008 Engine.ComputeShapeDistance;
1009 Engine.ShiftTrackPoints;
1010end;
1011
1012procedure TTrack.RouteTrack(TP1, TP2: TTrackPoint);
1013var
1014 NewTrackPoint: TTrackPoint;
1015 Delta: TPoint;
1016 P1, P2: TPoint;
1017 Index1, Index2: Integer;
1018begin
1019 RemoveTrackBetween(TP1, TP2);
1020 Index1 := Points.IndexOf(TP1);
1021 Index2 := Points.IndexOf(TP2);
1022 P1 := Points[Index1].PositionDesigned;
1023 P2 := Points[Index2].PositionDesigned;
1024 NewTrackPoint := Points.AddNew;
1025 Delta := Point(P2.X - P1.X, P2.Y - P1.Y);
1026 if Abs(Delta.X) > Abs(Delta.Y) then begin
1027 NewTrackPoint.PositionDesigned := Point(P2.X - Sign(Delta.X) * Abs(Delta.Y), P1.Y);
1028 NewTrackPoint.Position := NewTrackPoint.PositionDesigned;
1029 end else begin
1030 NewTrackPoint.PositionDesigned := Point(P1.X, P2.Y - Sign(Delta.Y) * Abs(Delta.X));
1031 NewTrackPoint.Position := NewTrackPoint.PositionDesigned;
1032 end;
1033 Points.Insert(Index1 + 1, NewTrackPoint);
1034end;
1035
1036procedure TTrack.RemoveTrackBetween(TP1, TP2: TTrackPoint);
1037var
1038 Index1, Index2: Integer;
1039 Temp: Integer;
1040 I: Integer;
1041begin
1042 Index1 := Points.IndexOf(TP1);
1043 Index2 := Points.IndexOf(TP2);
1044 if (Index1 = -1) then
1045 raise Exception.Create('TrackPoint1 not found');
1046 if (Index2 = -1) then
1047 raise Exception.Create('TrackPoint2 not found');
1048 if Index1 > Index2 then begin
1049 Temp := Index1;
1050 Index1 := Index2;
1051 Index2 := Temp;
1052 end;
1053 for I := 1 to Index2 - Index1 - 1 do
1054 Points.Delete(Index1 + 1);
1055end;
1056
1057function TMetroLine.GetTrackLength: Integer;
1058var
1059 I: Integer;
1060begin
1061 Result := 0;
1062 for I := 0 to Track.Points.Count - 1 do
1063 if I > 0 then
1064 Result := Result + Distance(Track.Points[I].Position, Track.Points[I - 1].Position);
1065end;
1066
1067constructor TMetroLine.Create;
1068begin
1069 LineStations := TLineStations.Create;
1070 LineStations.FreeObjects := True;
1071 Trains := TMetroTrains.Create;
1072 Trains.FreeObjects := False;
1073 Track := TTrack.Create;
1074 Track.Line := Self;
1075end;
1076
1077destructor TMetroLine.Destroy;
1078begin
1079 Trains.Free;
1080 LineStations.Free;
1081 Track.Free;
1082 inherited;
1083end;
1084
1085function TMetroLine.IsCircular: Boolean;
1086begin
1087 Result := False;
1088 if LineStations.Count >= 2 then
1089 Result := (LineStations.Last.MapStation = LineStations.First.MapStation);
1090end;
1091
1092{ TMetroTrain }
1093
1094procedure TMetroTrain.SetLine(AValue: TMetroLine);
1095begin
1096 if FLine = AValue then Exit;
1097 FLine := AValue;
1098 if AValue = nil then begin
1099 RelPos := 0;
1100 BaseTrackPoint := nil;
1101 TargetStation := nil;
1102 end;
1103end;
1104
1105function TMetroTrain.GetTargetStationDistance: Integer;
1106var
1107 Current: Integer;
1108 Target: Integer;
1109 I: Integer;
1110begin
1111 Result := 0;
1112 if Assigned(BaseTrackPoint) and Assigned(TargetStation) then begin
1113 Current := Line.Track.Points.IndexOf(BaseTrackPoint);
1114 Target := Line.Track.Points.IndexOf(TargetStation.TrackPoint);
1115 if Current < Target then begin
1116 for I := Current to Target - 1 do
1117 Result := Result + Line.Track.Points[I].GetDistance;
1118 Result := Result - Trunc(RelPos);
1119 end else
1120 if Current > Target then begin
1121 for I := Current - 1 downto Target do
1122 Result := Result + Line.Track.Points[I].GetDistance;
1123 Result := Result + Trunc(RelPos);
1124 end else Result := Trunc(RelPos);
1125 end;
1126end;
1127
1128function TMetroTrain.GetPosition: TPoint;
1129var
1130 D: Integer;
1131 Delta: TPoint;
1132 UpPoint: TTrackPoint;
1133begin
1134 Result := Point(0, 0);
1135 if Assigned(BaseTrackPoint) then
1136 with BaseTrackPoint do begin
1137 UpPoint := BaseTrackPoint.GetNeighUp;
1138 if Assigned(UpPoint) then begin
1139 D := Distance(UpPoint.Position, Position);
1140 if D > 0 then begin
1141 Delta := SubPoint(UpPoint.Position, Position);
1142 Result := Point(Trunc(Position.X + Delta.X * RelPos / D),
1143 Trunc(Position.Y + Delta.Y * RelPos / D));
1144 end;
1145 end;
1146 end;
1147end;
1148
1149function TMetroTrain.GetAngle: Double;
1150var
1151 UpPoint: TTrackPoint;
1152begin
1153 Result := 0;
1154 if Assigned(BaseTrackPoint) then
1155 with BaseTrackPoint do begin
1156 UpPoint := BaseTrackPoint.GetNeighUp;
1157 if Assigned(UpPoint) then begin
1158 Result := ArcTan2(UpPoint.Position.Y - Position.Y,
1159 UpPoint.Position.X - Position.X);
1160 end;
1161 end;
1162end;
1163
1164constructor TMetroTrain.Create;
1165begin
1166 Passengers := TMetroPassengers.Create;
1167 Passengers.FreeObjects := False;
1168 Direction := 1;
1169 Line := nil;
1170end;
1171
1172destructor TMetroTrain.Destroy;
1173begin
1174 Passengers.Free;
1175 inherited;
1176end;
1177
1178{ TMapStation }
1179
1180procedure TMapStation.ShiftTrackPoints;
1181var
1182 TrackLinks: TTrackLinks;
1183 I: Integer;
1184 J: Integer;
1185 Index: Integer;
1186 TP: TTrackPoint;
1187 LS: TLineStation;
1188 Line: TMetroLine;
1189 Angle: Float;
1190 TPAngleGroup: TTrackPointsAngleGroup;
1191 GroupItem: TTrackPointsAngle;
1192 NewTrackLink: TTrackLink;
1193 HAngle: Double;
1194 P1, P2: TPoint;
1195 NewShift: TPoint;
1196begin
1197 TrackLinks := TTrackLinks.Create;
1198 TrackLinks.FreeObjects := False;
1199
1200 // Collect all near track points as track links
1201 SortLines;
1202 for I := 0 to Lines.Count - 1 do begin
1203 Line := Lines[I];
1204 LS := Line.LineStations.SearchMapStation(Self);
1205 TP := LS.TrackPoint;
1206 Index := Line.Track.Points.IndexOf(TP);
1207 if Index > 0 then begin
1208 NewTrackLink := Line.Track.Points[Index].GetLinkDown;
1209 TrackLinks.Add(NewTrackLink);
1210 end;
1211 if Index < (Line.Track.Points.Count - 1) then begin
1212 NewTrackLink := Line.Track.Points[Index].GetLinkUp;
1213 TrackLinks.Add(NewTrackLink);
1214 end;
1215 if Line.IsCircular and (Self = Line.LineStations.First.MapStation) and
1216 (Self = Line.LineStations.Last.MapStation) then begin
1217 LS := Line.LineStations.Last;
1218 TP := LS.TrackPoint;
1219 Index := Line.Track.Points.IndexOf(TP);
1220 if Index > 0 then begin
1221 NewTrackLink := Line.Track.Points[Index].GetLinkDown;
1222 TrackLinks.Add(NewTrackLink);
1223 end;
1224 if Index < (Line.Track.Points.Count - 1) then begin
1225 NewTrackLink := Line.Track.Points[Index].GetLinkUp;
1226 TrackLinks.Add(NewTrackLink);
1227 end;
1228 end;
1229 end;
1230
1231 // Make groups of TrackLinks with same angle
1232 TPAngleGroup := TTrackPointsAngleGroup.Create;
1233 for I := 0 to TrackLinks.Count - 1 do begin
1234 P1 := TrackLinks[I].Points[0].PositionDesigned;
1235 P2 := TrackLinks[I].Points[1].PositionDesigned;
1236 if ComparePoint(P1, Position) and not ComparePoint(P2, Position) then begin
1237 Angle := ArcTan2(P2.Y - Position.Y, P2.X - Position.X);
1238 end else
1239 if ComparePoint(P2, Position) and not ComparePoint(P1, Position) then begin
1240 Angle := ArcTan2(P1.Y - Position.Y, P1.X - Position.X);
1241 end else Angle := 0;// else raise Exception.Create('TrackLink angle rrror');
1242
1243 GroupItem := TPAngleGroup.SearchAngle(Angle);
1244 if not Assigned(GroupItem) then begin
1245 GroupItem := TTrackPointsAngle.Create;
1246 GroupItem.Angle := Angle;
1247 TPAngleGroup.Add(GroupItem);
1248 end;
1249 GroupItem.TrackLinks.Add(TrackLinks[I])
1250 end;
1251
1252 // Shift TrackLinks according number of lines in group
1253 for I := 0 to TPAngleGroup.Count - 1 do
1254 with TPAngleGroup[I] do begin
1255 for J := 0 to TrackLinks.Count - 1 do
1256 with TrackLinks[J] do begin
1257 // Get orthogonal angle
1258 HAngle := Angle + Pi / 2;
1259 if HAngle > Pi then HAngle := HAngle - Pi;
1260 NewShift.X := Trunc(MetroLineThickness * Cos(HAngle) * (J - (TrackLinks.Count - 1) / 2));
1261 NewShift.Y := Trunc(MetroLineThickness * Sin(HAngle) * (J - (TrackLinks.Count - 1) / 2));
1262 //NewShift.X := TrackLinks.Count;
1263 Shift := NewShift;
1264 end;
1265 end;
1266
1267 FreeAndNil(TPAngleGroup);
1268 FreeAndNil(TrackLinks);
1269end;
1270
1271function MapStationCompareLine(const Item1, Item2: TMetroLine): Integer;
1272begin
1273 if Item1.Index > Item2.Index then Result := 1
1274 else if Item1.Index < Item2.Index then Result := -1
1275 else Result := 0;
1276end;
1277
1278procedure TMapStation.SortLines;
1279begin
1280 Lines.Sort(MapStationCompareLine);
1281end;
1282
1283function TMapStation.IsBestStationForShape(Shape: TStationShape;
1284 Check, Current: TLineStation): Boolean;
1285var
1286 I: Integer;
1287 T: Integer;
1288 Distance: Integer;
1289 StationIndex: Integer;
1290 DirectionUp: Boolean;
1291 DirectionDown: Boolean;
1292 NextStationUp: TLineStation;
1293 NextStationDown: TLineStation;
1294 CurrentLineStation: TLineStation;
1295begin
1296 Distance := High(Integer);
1297 for I := 0 to Lines.Count - 1 do
1298 with Lines[I] do begin
1299 CurrentLineStation := LineStations.SearchMapStation(Current.MapStation);
1300 StationIndex := LineStations.IndexOf(CurrentLineStation);
1301 if IsCircular then begin
1302 DirectionUp := False;
1303 DirectionDown := False;
1304 for T := 0 to Trains.Count - 1 do begin
1305 if Trains[T].Direction = 1 then DirectionUp := True;
1306 if Trains[T].Direction = -1 then DirectionDown := True;
1307 end;
1308 if StationIndex = 0 then
1309 NextStationDown := LineStations[LineStations.Count - 2]
1310 else
1311 if StationIndex > 0 then
1312 NextStationDown := LineStations[StationIndex - 1];
1313
1314 if (StationIndex >= 0) and (StationIndex = LineStations.Count - 1) then
1315 NextStationUp := LineStations[1]
1316 else
1317 if (StationIndex >= 0) and (StationIndex < LineStations.Count - 1) then
1318 NextStationUp := LineStations[StationIndex + 1];
1319 end else begin
1320 if StationIndex > 0 then begin
1321 DirectionDown := True;
1322 NextStationDown := LineStations[StationIndex - 1]
1323 end else DirectionDown := False;
1324 if (StationIndex >= 0) and (StationIndex < LineStations.Count - 1) then begin
1325 DirectionUp := True;
1326 NextStationUp := LineStations[StationIndex + 1];
1327 end else DirectionUp := False;
1328 end;
1329 if DirectionDown and (NextStationDown.MapStation.ShapeDistance[Shape] <> -1) and
1330 (NextStationDown.MapStation.ShapeDistance[Shape] < Distance) then begin
1331 Distance := NextStationDown.MapStation.ShapeDistance[Shape];
1332 end;
1333 if DirectionUp and (NextStationUp.MapStation.ShapeDistance[Shape] <> -1) and
1334 (NextStationUp.MapStation.ShapeDistance[Shape] < Distance) then begin
1335 Distance := NextStationUp.MapStation.ShapeDistance[Shape];
1336 end;
1337 end;
1338 Result := (Check.MapStation.ShapeDistance[Shape] <> -1) and
1339 (Check.MapStation.ShapeDistance[Shape] <= Distance);
1340end;
1341
1342constructor TMapStation.Create;
1343begin
1344 Passengers := TMetroPassengers.Create;
1345 Passengers.FreeObjects := False;
1346 Lines := TMetroLines.Create;
1347 Lines.FreeObjects := False;
1348end;
1349
1350destructor TMapStation.Destroy;
1351begin
1352 FreeAndNil(Lines);
1353 FreeAndNil(Passengers);
1354 inherited;
1355end;
1356
1357{ TEngine }
1358
1359procedure TEngine.ResizeView;
1360var
1361 NewPoint: TPoint;
1362begin
1363 // Need to see all stations on screen
1364 View.SourceRect := RectEnlarge(Stations.GetRect, 100);
1365
1366 NewPoint := Point(
1367 Trunc((View.SourceRect.Left + (View.SourceRect.Right - View.SourceRect.Left) / 2) -
1368 (View.DestRect.Left + (View.DestRect.Right - View.DestRect.Left) / 2 / View.Zoom)),
1369 Trunc((View.SourceRect.Top + (View.SourceRect.Bottom - View.SourceRect.Top) / 2) -
1370 (View.DestRect.Top + (View.DestRect.Bottom - View.DestRect.Top) / 2 / View.Zoom)));
1371 View.SourceRect := Bounds(NewPoint.X, NewPoint.Y, Trunc((View.DestRect.Right - View.DestRect.Left) / View.Zoom),
1372 Trunc((View.DestRect.Bottom - View.DestRect.Top) / View.Zoom));
1373end;
1374
1375function TEngine.GetServedDaysCount: Integer;
1376begin
1377 Result := Trunc(Time);
1378end;
1379
1380function TEngine.GetExistStationShapes: TStationShapeSet;
1381var
1382 Station: TMapStation;
1383begin
1384 Result := [];
1385 for Station in Stations do
1386 Result := Result + [Station.Shape];
1387end;
1388
1389function TEngine.GetStationOnPos(Pos: TPoint): TMapStation;
1390var
1391 I: Integer;
1392const
1393 ClickDistance = 30;
1394begin
1395 I := 0;
1396 while (I < Stations.Count) and (Distance(Stations[I].Position, Pos) > ClickDistance) do Inc(I);
1397 if I < Stations.Count then Result := Stations[I]
1398 else Result := nil;
1399end;
1400
1401function TEngine.GetTrackOnPos(Pos: TPoint): TTrackLink;
1402var
1403 I: Integer;
1404 T: Integer;
1405 D: Integer;
1406 MinD: Integer;
1407begin
1408 Result := TTrackLink.Create;
1409 Result.Points.Count := 2;
1410 Result.Points[0] := nil;
1411 Result.Points[1] := nil;
1412 I := 0;
1413 MinD := High(Integer);
1414 while (I < Lines.Count) do
1415 with Lines[I] do begin
1416 for T := 1 to Track.Points.Count - 1 do begin
1417 D := PointToLineDistance(Pos, Track.Points[T - 1].Position, Track.Points[T].Position);
1418 if (D < MinD) and (D < TrackClickDistance) then begin
1419 MinD := D;
1420 Result.Points[0] := Track.Points[T - 1];
1421 Result.Points[1] := Track.Points[T];
1422 end;
1423 end;
1424 Inc(I);
1425 end;
1426end;
1427
1428function TEngine.GetTrainOnPos(Pos: TPoint): TMetroTrain;
1429var
1430 I: Integer;
1431 MinDistance: Integer;
1432 D: Integer;
1433begin
1434 Result := nil;
1435 MinDistance := High(Integer);
1436 for I := 0 to Trains.Count - 1 do
1437 with Trains[I] do begin
1438 D := Distance(GetPosition, Pos);
1439 if (D < (TrainSize div 2)) and (D < MinDistance) then begin
1440 Result := Trains[I];
1441 MinDistance := D;
1442 end;
1443 end;
1444end;
1445
1446procedure TEngine.DrawLine(Canvas: TCanvas; Pos: TPoint);
1447var
1448 Delta: TPoint;
1449begin
1450 Delta := Point(Pos.X - Canvas.PenPos.X, Pos.Y - Canvas.PenPos.Y);
1451 if Abs(Delta.X) > Abs(Delta.Y) then begin
1452 Canvas.LineTo(Pos.X - Sign(Delta.X) * Abs(Delta.Y), Canvas.PenPos.Y);
1453 end else begin
1454 Canvas.LineTo(Canvas.PenPos.X, Pos.Y - Sign(Delta.Y) * Abs(Delta.X));
1455 end;
1456 Canvas.LineTo(Pos.X, Pos.Y);
1457end;
1458
1459procedure TEngine.DrawShape(Canvas: TCanvas; Position: TPoint; Shape: TStationShape;
1460 Size: Integer; Angle: Double);
1461var
1462 Points: array of TPoint;
1463 I: Integer;
1464 Angle2: Double;
1465begin
1466 case Shape of
1467 ssSquare: begin
1468 SetLength(Points, 4);
1469 Points[0] := Point(Position.X - Size div 2, Position.Y - Size div 2);
1470 Points[1] := Point(Position.X + Size div 2, Position.Y - Size div 2);
1471 Points[2] := Point(Position.X + Size div 2, Position.Y + Size div 2);
1472 Points[3] := Point(Position.X - Size div 2, Position.Y + Size div 2);
1473 Points := RotatePoints(Position, Points, Angle);
1474 Canvas.Polygon(Points);
1475 end;
1476 ssCircle: Canvas.Ellipse(
1477 Position.X - Size div 2, Position.Y - Size div 2,
1478 Position.X + Size div 2, Position.Y + Size div 2);
1479 ssTriangle: begin
1480 SetLength(Points, 3);
1481 Points[0] := Point(Position.X, Position.Y - Size div 2);
1482 Points[1] := Point(Position.X + Size div 2, Position.Y + Size div 2);
1483 Points[2] := Point(Position.X - Size div 2, Position.Y + Size div 2);
1484 Points := RotatePoints(Position, Points, Angle);
1485 Canvas.Polygon(Points);
1486 end;
1487 ssStar: begin
1488 SetLength(Points, 10);
1489 for I := 0 to 9 do begin
1490 Angle2 := I / 10 * 2 * Pi - Pi / 2;
1491 if (I mod 2) = 0 then
1492 Points[I] := Point(Round(Position.X + Cos(Angle2) * Size / 2),
1493 Round(Position.Y + Sin(Angle2) * Size / 2))
1494 else
1495 Points[I] := Point(Round(Position.X + Cos(Angle2) * Size / 5),
1496 Round(Position.Y + Sin(Angle2) * Size / 5));
1497 end;
1498 Points := RotatePoints(Position, Points, Angle);
1499 Canvas.Polygon(Points);
1500 end;
1501 ssPlus: begin
1502 SetLength(Points, 12);
1503 Points[0] := Point(Position.X + Size div 6, Position.Y - Size div 6);
1504 Points[1] := Point(Position.X + Size div 2, Position.Y - Size div 6);
1505 Points[2] := Point(Position.X + Size div 2, Position.Y + Size div 6);
1506 Points[3] := Point(Position.X + Size div 6, Position.Y + Size div 6);
1507 Points[4] := Point(Position.X + Size div 6, Position.Y + Size div 2);
1508 Points[5] := Point(Position.X - Size div 6, Position.Y + Size div 2);
1509 Points[6] := Point(Position.X - Size div 6, Position.Y + Size div 6);
1510 Points[7] := Point(Position.X - Size div 2, Position.Y + Size div 6);
1511 Points[8] := Point(Position.X - Size div 2, Position.Y - Size div 6);
1512 Points[9] := Point(Position.X - Size div 6, Position.Y - Size div 6);
1513 Points[10] := Point(Position.X - Size div 6, Position.Y - Size div 2);
1514 Points[11] := Point(Position.X + Size div 6, Position.Y - Size div 2);
1515 Points := RotatePoints(Position, Points, Angle);
1516 Canvas.Polygon(Points);
1517 end;
1518 ssPentagon: begin
1519 SetLength(Points, 5);
1520 for I := 0 to 4 do begin
1521 Angle2 := I / 5 * 2 * Pi - Pi / 2;
1522 Points[I] := Point(Round(Position.X + Cos(Angle2) * Size / 2),
1523 Round(Position.Y + Sin(Angle2) * Size / 2));
1524 end;
1525 Points := RotatePoints(Position, Points, Angle);
1526 Canvas.Polygon(Points);
1527 end;
1528 ssHexagon: begin
1529 SetLength(Points, 6);
1530 for I := 0 to 5 do begin
1531 Angle2 := I / 6 * 2 * Pi - Pi / 2;
1532 Points[I] := Point(Round(Position.X + Cos(Angle2) * Size / 2),
1533 Round(Position.Y + Sin(Angle2) * Size / 2));
1534 end;
1535 Points := RotatePoints(Position, Points, Angle);
1536 Canvas.Polygon(Points);
1537 end;
1538 ssDiamond: begin
1539 SetLength(Points, 4);
1540 Points[0] := Point(Position.X, Position.Y - Size div 2);
1541 Points[1] := Point(Position.X + Size div 2, Position.Y);
1542 Points[2] := Point(Position.X, Position.Y + Size div 2);
1543 Points[3] := Point(Position.X - Size div 2, Position.Y);
1544 Points := RotatePoints(Position, Points, Angle);
1545 Canvas.Polygon(Points);
1546 end;
1547 ssCross: begin
1548 SetLength(Points, 12);
1549 Points[0] := Point(Position.X + Size div 6, Position.Y - Size div 6);
1550 Points[1] := Point(Position.X + Size div 2, Position.Y - Size div 6);
1551 Points[2] := Point(Position.X + Size div 2, Position.Y + Size div 6);
1552 Points[3] := Point(Position.X + Size div 6, Position.Y + Size div 6);
1553 Points[4] := Point(Position.X + Size div 6, Position.Y + Size div 2);
1554 Points[5] := Point(Position.X - Size div 6, Position.Y + Size div 2);
1555 Points[6] := Point(Position.X - Size div 6, Position.Y + Size div 6);
1556 Points[7] := Point(Position.X - Size div 2, Position.Y + Size div 6);
1557 Points[8] := Point(Position.X - Size div 2, Position.Y - Size div 6);
1558 Points[9] := Point(Position.X - Size div 6, Position.Y - Size div 6);
1559 Points[10] := Point(Position.X - Size div 6, Position.Y - Size div 2);
1560 Points[11] := Point(Position.X + Size div 6, Position.Y - Size div 2);
1561 Points := RotatePoints(Position, Points, Angle + Pi / 4);
1562 Canvas.Polygon(Points);
1563 end;
1564 ssHalfCircle: Canvas.Pie(
1565 Position.X - Size div 2, Position.Y - Size div 2,
1566 Position.X + Size div 2, Position.Y + Size div 2,
1567 Position.X - Size div 2, Position.Y,
1568 Position.X + Size div 2, Position.Y);
1569 ssQuarterCircle: Canvas.Pie(
1570 Position.X - Size div 2 - Size, Position.Y - Size div 2,
1571 Position.X + Size div 2, Position.Y + Size div 2 + Size,
1572 Position.X + Size div 2, Position.Y + Size div 2,
1573 Position.X - Size div 2, Position.Y - Size div 2);
1574 ssHeptagon: begin
1575 SetLength(Points, 8);
1576 for I := 0 to High(Points) do begin
1577 Angle2 := I / Length(Points) * 2 * Pi - Pi / 2;
1578 Points[I] := Point(Round(Position.X + Cos(Angle2) * Size / 2),
1579 Round(Position.Y + Sin(Angle2) * Size / 2));
1580 end;
1581 Points := RotatePoints(Position, Points, Angle);
1582 Canvas.Polygon(Points);
1583 end;
1584 end;
1585end;
1586
1587procedure TEngine.ComputeShapeDistance;
1588var
1589 S: TStationShape;
1590 Station: TMapStation;
1591begin
1592 // NewGame all distances
1593 for Station in Stations do
1594 with Station do begin
1595 for S := Low(ShapeDistance) to High(ShapeDistance) do
1596 ShapeDistance[S] := -1;
1597 end;
1598
1599 // Propagate shape distance for all stations
1600 // Distace 0 means that station is final target
1601 for Station in Stations do
1602 with Station do begin
1603 ComputeShapeDistanceStation(Station, Shape, 0);
1604 end;
1605end;
1606
1607procedure TEngine.ComputeShapeDistanceStation(Station: TMapStation;
1608 UpdatedShape: TStationShape; Distance: Integer);
1609var
1610 I: Integer;
1611 T: Integer;
1612 StationIndex: Integer;
1613 DirectionDown: Boolean;
1614 DirectionUp: Boolean;
1615begin
1616 with Station do begin
1617 if (Distance < ShapeDistance[UpdatedShape]) or (ShapeDistance[UpdatedShape] = -1) then begin
1618 ShapeDistance[UpdatedShape] := Distance;
1619 // Do for all lines connected to station
1620 for I := 0 to Lines.Count - 1 do
1621 with Lines[I] do
1622 for StationIndex := 0 to LineStations.Count - 1 do
1623 if LineStations[StationIndex].MapStation = Station then begin
1624 if not IsCircular then begin
1625 // Update for all adjecent stations
1626 if StationIndex > 0 then
1627 ComputeShapeDistanceStation(LineStations[StationIndex - 1].MapStation,
1628 UpdatedShape, Station.ShapeDistance[UpdatedShape] + 1);
1629 if (StationIndex >= 0) and (StationIndex < LineStations.Count - 1) then
1630 ComputeShapeDistanceStation(LineStations[StationIndex + 1].MapStation,
1631 UpdatedShape, Station.ShapeDistance[UpdatedShape] + 1);
1632 end else begin
1633 // If circular then trains might go in single direction so passengers
1634 // waiting for opposite directions are wrong
1635 DirectionUp := False;
1636 DirectionDown := False;
1637 for T := 0 to Trains.Count - 1 do begin
1638 if Trains[T].Direction = 1 then DirectionUp := True;
1639 if Trains[T].Direction = -1 then DirectionDown := True;
1640 end;
1641 // Update for all adjecent stations
1642 if DirectionUp then begin
1643 if StationIndex = 0 then
1644 ComputeShapeDistanceStation(LineStations[LineStations.Count - 2].MapStation,
1645 UpdatedShape, Station.ShapeDistance[UpdatedShape] + 1);
1646 if StationIndex > 0 then
1647 ComputeShapeDistanceStation(LineStations[StationIndex - 1].MapStation,
1648 UpdatedShape, Station.ShapeDistance[UpdatedShape] + 1);
1649 end;
1650 if DirectionDown then begin
1651 if (StationIndex >= 0) and (StationIndex = LineStations.Count - 1) then
1652 ComputeShapeDistanceStation(LineStations[1].MapStation,
1653 UpdatedShape, Station.ShapeDistance[UpdatedShape] + 1);
1654 if (StationIndex >= 0) and (StationIndex < LineStations.Count - 1) then
1655 ComputeShapeDistanceStation(LineStations[StationIndex + 1].MapStation,
1656 UpdatedShape, Station.ShapeDistance[UpdatedShape] + 1);
1657 end;
1658 end;
1659 end;
1660 end;
1661 end;
1662end;
1663
1664procedure TEngine.SetDarkMode(AValue: Boolean);
1665begin
1666 if FDarkMode = AValue then Exit;
1667 FDarkMode := AValue;
1668 InitColors;
1669end;
1670
1671procedure TEngine.InitColors;
1672begin
1673 with Colors do
1674 if FDarkMode then begin
1675 Background := $2f3020;
1676 Text := clWhite;
1677 ShapeBackground := clBlack;
1678 MenuItemText := $cccccc;
1679 MenuItemBackground := $b75C01;
1680 MenuItemBackgroundSelected := $070C81;
1681 end else begin
1682 Background := $eff0e0;
1683 Text := clBlack;
1684 ShapeBackground := clWhite;
1685 MenuItemText := clWhite;
1686 MenuItemBackground := $e78C31;
1687 MenuItemBackgroundSelected := $f7bC61;
1688 end;
1689end;
1690
1691procedure TEngine.TrainMovement;
1692var
1693 I: Integer;
1694 CurrentStation: TLineStation;
1695 P: Integer;
1696 Passenger: TMetroPassenger;
1697 PosDelta: Integer;
1698 TargetStationIndex: Integer;
1699 PosChange: Double;
1700 TP: TTrackPoint;
1701begin
1702 // Move trains
1703 for I := 0 to Trains.Count - 1 do
1704 with Trains[I] do begin
1705 if not Assigned(TargetStation) and Assigned(BaseTrackPoint) then begin
1706 if (Direction <> 1) and (Direction <> -1) then Direction := 1
1707 else Direction := -Direction;
1708 TP := BaseTrackPoint.GetUp;
1709 if Assigned(TP) then TargetStation := TP.LineStation
1710 else begin
1711 TP := BaseTrackPoint.GetDown;
1712 if Assigned(TP) then TargetStation := TP.LineStation;
1713 end;
1714 end;
1715 if Assigned(Line) then begin
1716 if InStation then begin
1717 if (Time - StationStopTime) > OneHour then begin
1718 CurrentStation := TargetStation;
1719
1720 // Choose next target station
1721 TargetStationIndex := Line.LineStations.IndexOf(TargetStation) + Direction;
1722 if TargetStationIndex < 0 then begin
1723 if Line.IsCircular then begin
1724 TargetStationIndex := Line.LineStations.Count - 2;
1725 BaseTrackPoint := Line.LineStations.Last.TrackPoint;
1726 RelPos := 0;
1727 end else begin
1728 TargetStationIndex := 1;
1729 Direction := -Direction;
1730 end;
1731 end else
1732 if TargetStationIndex >= Line.LineStations.Count then begin
1733 if Line.IsCircular then begin
1734 TargetStationIndex := 1;
1735 BaseTrackPoint := Line.LineStations.First.TrackPoint;
1736 RelPos := 0;
1737 end else begin
1738 TargetStationIndex := Line.LineStations.Count - 2;
1739 Direction := -Direction;
1740 end;
1741 end;
1742 TargetStation := Line.LineStations[TargetStationIndex];
1743
1744 // Unload passengers in target station
1745 if Assigned(CurrentStation) then
1746 for P := Passengers.Count - 1 downto 0 do begin
1747 if Passengers[P].Shape = CurrentStation.MapStation.Shape then begin
1748 Passenger := Passengers[P];
1749 Passengers.Delete(P);
1750 Self.Passengers.Remove(Passenger);
1751 Inc(ServedPassengerCount);
1752 end;
1753 end;
1754 // Unload passengers to change line
1755 if Assigned(CurrentStation) then
1756 for P := Passengers.Count - 1 downto 0 do begin
1757 if not CurrentStation.MapStation.IsBestStationForShape(Passengers[P].Shape,
1758 TargetStation, CurrentStation) then begin
1759 Passenger := Passengers[P];
1760 Passengers.Delete(P);
1761 CurrentStation.MapStation.Passengers.Add(Passenger);
1762 Passenger.Station := CurrentStation.MapStation;
1763 end;
1764 end;
1765
1766 // Load new passengers
1767 if Assigned(CurrentStation) and not Assigned(CurrentStation.MapStation) then
1768 raise Exception.Create('Station have to have MapStation');
1769 if Assigned(CurrentStation) then
1770 for P := CurrentStation.MapStation.Passengers.Count - 1 downto 0 do begin
1771 if (Passengers.Count < TrainPassengerCount) then begin
1772 Passenger := CurrentStation.MapStation.Passengers[P];
1773 if CurrentStation.MapStation.IsBestStationForShape(Passenger.Shape,
1774 TargetStation, CurrentStation) then begin
1775 Passenger.Station := nil;
1776 CurrentStation.MapStation.Passengers.Delete(P);
1777 Passengers.Add(Passenger);
1778 Passenger.Train := Trains[I];
1779 end;
1780 end else Break; // No more space
1781 end;
1782
1783 LastPosDelta := Abs(GetTargetStationDistance);
1784 InStation := False;
1785 LastTrainMoveTime := Time;
1786 end;
1787 end else begin
1788 PosChange := Direction + Trunc(Direction * TrainSpeed * (Time - LastTrainMoveTime));
1789 RelPos := RelPos + PosChange;
1790 LastTrainMoveTime := Time;
1791 Redraw;
1792 if Assigned(BaseTrackPoint) then
1793 while (Direction = -1) and (RelPos < 0) do begin
1794 if BaseTrackPoint <> Line.LineStations.First.TrackPoint then begin
1795 BaseTrackPoint := BaseTrackPoint.GetNeighDown;
1796 if Assigned(BaseTrackPoint) then
1797 RelPos := RelPos + BaseTrackPoint.GetDistance
1798 else begin
1799 BaseTrackPoint := Line.LineStations.First.TrackPoint;
1800 RelPos := 0;
1801 end;
1802 end else
1803 if Line.IsCircular then begin
1804 BaseTrackPoint := Line.LineStations.Last.TrackPoint;
1805 RelPos := RelPos + BaseTrackPoint.GetDistance;
1806 end else begin
1807 RelPos := 0;
1808 Break;
1809 end;
1810 end;
1811 if Assigned(BaseTrackPoint) then
1812 while (Direction = 1) and (RelPos > BaseTrackPoint.GetDistance) do begin
1813 if BaseTrackPoint <> Line.LineStations.Last.TrackPoint then begin
1814 RelPos := RelPos - BaseTrackPoint.GetDistance;
1815 BaseTrackPoint := BaseTrackPoint.GetNeighUp;
1816 if not Assigned(BaseTrackPoint) then begin
1817 BaseTrackPoint := Line.LineStations.Last.TrackPoint;
1818 RelPos := 0;
1819 end;
1820 end else
1821 if Line.IsCircular then begin
1822 RelPos := RelPos - BaseTrackPoint.GetDistance;
1823 BaseTrackPoint := Line.LineStations.First.TrackPoint;
1824 end else begin
1825 RelPos := BaseTrackPoint.GetDistance;
1826 Break;
1827 end;
1828 end;
1829 PosDelta := Abs(GetTargetStationDistance);
1830 if PosDelta >= LastPosDelta then begin
1831 // We are getting far from station, stop at station
1832 BaseTrackPoint := TargetStation.TrackPoint;
1833 RelPos := 0;
1834 InStation := True;
1835 StationStopTime := Time;
1836 Redraw;
1837 end;
1838 LastPosDelta := PosDelta;
1839 end;
1840 end;
1841 end;
1842end;
1843
1844function TEngine.GetUnusedLine: TMetroLine;
1845var
1846 I: Integer;
1847begin
1848 I := 0;
1849 while (I < Lines.Count) and (Lines[I].Track.Points.Count > 0) do Inc(I);
1850 if I < Lines.Count then Result := Lines[I]
1851 else Result := nil;
1852end;
1853
1854procedure TEngine.ShiftTrackPoints;
1855var
1856 I: Integer;
1857 J: Integer;
1858 //Link1, Link2: TPoint;
1859 NewPoint: TPoint;
1860 MetroLine: TMetroLine;
1861 TrackPoint: TTrackPoint;
1862 MapStation: TMapStation;
1863begin
1864 // NewGame all trackpoints position shift
1865 for MetroLine in Lines do
1866 for TrackPoint in MetroLine.Track.Points do
1867 TrackPoint.Position := TrackPoint.PositionDesigned;
1868
1869 // Calculate new position shifts
1870 for MapStation in Stations do
1871 MapStation.ShiftTrackPoints;
1872
1873 // Compute track points from track shift
1874 for MetroLine in Lines do
1875 with MetroLine do begin
1876 if Track.Points.Count > 1 then begin
1877 Track.Points[0].Position := Track.Points[0].PositionDesigned +
1878 Track.Points[0].LinkUp.Shift;
1879 end;
1880 for I := 1 to Track.Points.Count - 1 do
1881 with Track.Points[I] do
1882 if Assigned(Track.Points[I].LinkDown) and Assigned(Track.Points[I].LinkUp) then begin
1883 {
1884 Link1 := (Track.Points[I].PositionDesigned + Track.Points[I].LinkDown.Shift) -
1885 (Track.Points[I - 1].PositionDesigned + Track.Points[I].LinkDown.Shift);
1886 if (I + 1) < Track.Points.Count then
1887 Link2 := (Track.Points[I + 1].PositionDesigned + Track.Points[I].LinkUp.Shift) -
1888 (Track.Points[I].PositionDesigned + Track.Points[I].LinkUp.Shift)
1889 else Link2 := Link1;
1890
1891 if ArcTanPoint(Link1) = ArcTanPoint(Link2) then begin
1892 // Parallel lines
1893 NewPoint := Track.Points[I].PositionDesigned + Track.Points[I].LinkDown.Shift;
1894 Track.Points[I].Position := NewPoint;
1895 end else begin}
1896 // Intersected lines
1897 if LineIntersect(Track.Points[I - 1].PositionDesigned + Track.Points[I].LinkDown.Shift,
1898 Track.Points[I].PositionDesigned + Track.Points[I].LinkDown.Shift,
1899 Track.Points[I].PositionDesigned + Track.Points[I].LinkUp.Shift,
1900 Track.Points[I + 1].PositionDesigned + Track.Points[I].LinkUp.Shift, NewPoint) then
1901 Track.Points[I].Position := NewPoint
1902 else begin
1903 // Parallel lines
1904 NewPoint := Track.Points[I].PositionDesigned + Track.Points[I].LinkDown.Shift;
1905 Track.Points[I].Position := NewPoint;
1906 end;
1907// end;
1908 end;
1909 end;
1910
1911 // Remove all temporal links
1912 for MetroLine in Lines do
1913 with MetroLine do
1914 for J := 0 to Track.Points.Count - 1 do
1915 if Assigned(Track.Points[J].LinkUp) then begin
1916 Track.Points[J].LinkUp.Free;
1917 Track.Points[J].LinkUp := nil;
1918 Track.Points[J + 1].LinkDown := nil;
1919 end;
1920end;
1921
1922procedure TEngine.MenuItemExit(Sender: TObject);
1923begin
1924 FormMain.Close;
1925end;
1926
1927procedure TEngine.MenuItemPlay(Sender: TObject);
1928begin
1929 NewGame;
1930end;
1931
1932procedure TEngine.MenuItemOptions(Sender: TObject);
1933begin
1934 Menu := MenuOptions;
1935 Redraw;
1936end;
1937
1938procedure TEngine.MenuItemBack(Sender: TObject);
1939begin
1940 if Assigned(Menu.Parent) then begin
1941 Menu := Menu.Parent;
1942 Redraw;
1943 end else MenuItemExit(nil);
1944end;
1945
1946procedure TEngine.MenuItemGameContinue(Sender: TObject);
1947begin
1948 State := LastState;
1949end;
1950
1951procedure TEngine.MenuItemGameExit(Sender: TObject);
1952begin
1953 State := gsMenu;
1954 Clear;
1955 Menu := MenuMain;
1956 Redraw;
1957end;
1958
1959procedure TEngine.MenuItemGameRestart(Sender: TObject);
1960begin
1961 NewGame;
1962end;
1963
1964procedure TEngine.DarkModeChanged(Sender: TObject);
1965begin
1966 DarkMode := TMenuItemCheckBox(Sender).Checked;
1967 InitMenus;
1968end;
1969
1970procedure TEngine.LanguageChanged(Sender: TObject);
1971var
1972 NewLanguage: TLanguage;
1973begin
1974 NewLanguage := TLanguage(TMenuItemComboBox(Sender).States.Objects[TMenuItemComboBox(Sender).Index]);
1975 if FormMain.Translator1.Language <> NewLanguage then begin
1976 FormMain.Translator1.Language := NewLanguage;
1977 FormMain.Translator1.Translate;
1978 InitMenus;
1979 end;
1980end;
1981
1982procedure TEngine.FullScreenChanged(Sender: TObject);
1983begin
1984 FormMain.FullScreen := TMenuItemCheckBox(Sender).Checked;
1985 FormMain.PersistentForm1.SetFullScreen(FormMain.FullScreen);
1986end;
1987
1988procedure TEngine.InitMenus;
1989begin
1990 with MenuMain, Items do begin
1991 Clear;
1992 with AddButton(SBigMetro, nil) do begin
1993 Enabled := False;
1994 FontSize := 60;
1995 FontColor := Colors.Text;
1996 BackgroundColor := clNone;
1997 BackgroundSelectedColor := clNone;
1998 end;
1999 with AddButton(SPlay, MenuItemPlay) do begin
2000 FontSize := 40;
2001 FontColor := Colors.MenuItemText;
2002 BackgroundColor := Colors.MenuItemBackground;
2003 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2004 end;
2005 with AddButton(SOptions, MenuItemOptions) do begin
2006 FontSize := 40;
2007 FontColor := Colors.MenuItemText;
2008 BackgroundColor := Colors.MenuItemBackground;
2009 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2010 end;
2011 with AddButton(SExit, MenuItemExit) do begin
2012 FontSize := 40;
2013 FontColor := Colors.MenuItemText;
2014 BackgroundColor := Colors.MenuItemBackground;
2015 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2016 end;
2017 OnExit := MenuItemExit;
2018 end;
2019
2020 MenuOptions.Parent := MenuMain;
2021 with MenuOptions, Items do begin
2022 Clear;
2023 with AddComboBox(SLanguage, [], LanguageChanged) do begin
2024 FontSize := 40;
2025 FontColor := Colors.MenuItemText;
2026 BackgroundColor := Colors.MenuItemBackground;
2027 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2028 FormMain.Translator1.LanguageListToStrings(States);
2029 Index := States.IndexOfObject(FormMain.Translator1.Language);
2030 if Index = -1 then Index := 0;
2031 end;
2032 with AddCheckBox(SDarkMode, DarkModeChanged) do begin
2033 FontSize := 40;
2034 FontColor := Colors.MenuItemText;
2035 BackgroundColor := Colors.MenuItemBackground;
2036 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2037 Checked := DarkMode;
2038 end;
2039 with AddCheckBox(SFullScreen, FullScreenChanged) do begin
2040 FontSize := 40;
2041 FontColor := Colors.MenuItemText;
2042 BackgroundColor := Colors.MenuItemBackground;
2043 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2044 Checked := FormMain.FullScreen;
2045 end;
2046 with AddButton(SBack, MenuItemBack) do begin
2047 FontSize := 40;
2048 FontColor := Colors.MenuItemText;
2049 BackgroundColor := Colors.MenuItemBackground;
2050 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2051 end;
2052 OnExit := MenuItemBack;
2053 end;
2054
2055 with MenuGame, Items do begin
2056 Clear;
2057 with AddButton(SContinue, MenuItemGameContinue) do begin
2058 FontSize := 40;
2059 FontColor := Colors.MenuItemText;
2060 BackgroundColor := Colors.MenuItemBackground;
2061 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2062 end;
2063 with AddButton(SRestart, MenuItemGameRestart) do begin
2064 FontSize := 40;
2065 FontColor := Colors.MenuItemText;
2066 BackgroundColor := Colors.MenuItemBackground;
2067 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2068 end;
2069 with AddButton(SExit, MenuItemGameExit) do begin
2070 FontSize := 40;
2071 FontColor := Colors.MenuItemText;
2072 BackgroundColor := Colors.MenuItemBackground;
2073 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2074 end;
2075 OnExit := MenuItemGameContinue;
2076 end;
2077end;
2078
2079procedure TEngine.ButtonBackClick(Sender: TObject);
2080begin
2081 Menu := MenuGame;
2082 LastState := State;
2083 State := gsMenu;
2084 Redraw;
2085end;
2086
2087procedure TEngine.DrawClock(Canvas: TCanvas; CanvasSize: TPoint);
2088var
2089 ClockCenter: TPoint;
2090 Angle: Double;
2091 Text: string;
2092 Text2: string;
2093 I: Integer;
2094const
2095 ClockSize = 20;
2096begin
2097 Canvas.Pen.Style := psSolid;
2098 Canvas.Pen.Color := Colors.Text;
2099 Canvas.Pen.Width := 2;
2100 ClockCenter := Point(CanvasSize.X - 30, 40);
2101 Angle := Time / (12 * OneHour) * 2 * Pi - Pi / 2;
2102 Canvas.EllipseC(ClockCenter.X, ClockCenter.Y, ClockSize, ClockSize);
2103 Canvas.Line(ClockCenter, Point(ClockCenter.X + Round(Cos(Angle) * ClockSize * 0.8),
2104 ClockCenter.Y + Round(Sin(Angle) * ClockSize * 0.8)));
2105 for I := 0 to 12 do begin
2106 Angle := I / 12 * 2 * Pi;
2107 Canvas.Line(ClockCenter.X + Round(Cos(Angle) * ClockSize * 0.8),
2108 ClockCenter.Y + Round(Sin(Angle) * ClockSize * 0.8),
2109 ClockCenter.X + Round(Cos(Angle) * ClockSize * 0.9),
2110 ClockCenter.Y + Round(Sin(Angle) * ClockSize * 0.9));
2111 end;
2112
2113 Canvas.Font.Color := Colors.Text;
2114 Text := FormatDateTime('ddd', Time + 2);
2115 Canvas.TextOut(ClockCenter.X - ClockSize - Canvas.TextWidth(Text) - 10, ClockCenter.Y -
2116 Canvas.TextHeight(Text) div 2, Text);
2117
2118 Text2 := SDay + ' ' + IntToStr(Trunc(Time));
2119 Canvas.TextOut(ClockCenter.X - ClockSize - Canvas.TextWidth(Text) - 10, ClockCenter.Y -
2120 Canvas.TextHeight(Text2) div 2 + Trunc(Canvas.TextHeight(Text) * 1.1), Text2);
2121end;
2122
2123procedure TEngine.DrawTrains(Canvas: TCanvas);
2124var
2125 P: Integer;
2126 Pos: TPoint;
2127 Points: array of TPoint;
2128 Angle: Double;
2129 ShapePos: TPoint;
2130 Train: TMetroTrain;
2131 Passenger: TMetroPassenger;
2132begin
2133 for Train in Trains do
2134 with Train do begin
2135 if Assigned(Line) then begin
2136 Canvas.Brush.Color := Line.Color;
2137 Canvas.Brush.Style := bsSolid;
2138 Canvas.Pen.Style := psClear;
2139 Pos := GetPosition;
2140 Angle := GetAngle;
2141
2142 SetLength(Points, 4);
2143 Points[0] := RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y - TrainSize div 3), Angle);
2144 Points[1] := RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y - TrainSize div 3), Angle);
2145 Points[2] := RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y + TrainSize div 3), Angle);
2146 Points[3] := RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y + TrainSize div 3), Angle);
2147 Canvas.Polygon(Points);
2148 Canvas.Brush.Color := clWhite;
2149 P := 0;
2150 for Passenger in Passengers do
2151 with Passenger do begin
2152 ShapePos := Point(Pos.X - Trunc(TrainSize div 3 * 1) + (P mod 3) * TrainSize div 3,
2153 Pos.Y - Trunc(TrainSize div 6 * 1) + (P div 3) * TrainSize div 3);
2154 ShapePos := RotatePoint(Pos, ShapePos, Angle);
2155 DrawShape(Canvas, ShapePos, Shape, TrainSize div 3, Angle + Pi / 2);
2156 Inc(P);
2157 end;
2158 end;
2159 end;
2160end;
2161
2162procedure TEngine.DrawGameOver(Canvas: TCanvas; CanvasSize: TPoint);
2163var
2164 Y: Integer;
2165 Text: string;
2166begin
2167 with Canvas do begin
2168 Canvas.Font.Color := Self.Colors.Text;
2169 Brush.Style := bsSolid;
2170 Brush.Color := Self.Colors.Background;
2171
2172 Y := 100;
2173 Font.Size := 40;
2174 TextOut((CanvasSize.X - TextWidth(SGameOver)) div 2, Y, SGameOver);
2175 Y := Y + Round(TextHeight(SGameOver) * 1.1);
2176
2177 Font.Size := 14;
2178 TextOut((CanvasSize.X - TextWidth(SGameOverReason)) div 2, Y, SGameOverReason);
2179 Y := Y + Round(TextHeight(SGameOverReason) * 1.1);
2180
2181 Text := Format(SGameOverStatistic, [ServedPassengerCount, ServedDaysCount]);
2182 TextOut((CanvasSize.X - TextWidth(Text)) div 2, Y, Text);
2183 Y := Y + Round(TextHeight(SGameOverStatistic) * 1.1);
2184
2185 Y := Y + 16;
2186
2187 // Calculate new highest score
2188 Text := '';
2189 if (ServedPassengerCount > HighestServedPassengerCount) or
2190 (ServedDaysCount > HighestServedDaysCount) then begin
2191 Text := SNewHighScore + ' ';
2192 end;
2193 Text := Text + Format(SOldHighScore, [HighestServedPassengerCount,
2194 HighestServedDaysCount]);
2195 Canvas.TextOut((CanvasSize.X - TextWidth(Text)) div 2, Y, Text);
2196 Y := Y + Round(TextHeight(Text) * 1.1);
2197 if (ServedPassengerCount > HighestServedPassengerCount) then
2198 HighestServedPassengerCount := ServedPassengerCount;
2199 if (ServedDaysCount > HighestServedDaysCount) then
2200 HighestServedDaysCount := ServedDaysCount;
2201 end;
2202end;
2203
2204procedure TEngine.DrawStationPassengerOverload(Canvas: TCanvas);
2205var
2206 MapStation: TMapStation;
2207 Angle: Real;
2208begin
2209 for MapStation in Stations do
2210 with MapStation do begin
2211 if OverloadDuration > 0 then begin
2212 Canvas.Brush.Color := clSilver;
2213 Canvas.Brush.Style := bsSolid;
2214 Canvas.Pen.Color := clSilver;
2215 Canvas.Pen.Style := psSolid;
2216 Angle := OverloadDuration / MaxPassengersOveloadTime * 2 * Pi;
2217 Canvas.Pie(Position.X - StationOverloadSize, Position.Y - StationOverloadSize,
2218 Position.X + StationOverloadSize, Position.Y + StationOverloadSize,
2219 Trunc(Position.X + StationOverloadSize * Cos(Angle)),
2220 Trunc(Position.Y + StationOverloadSize * Sin(Angle)), Position.X + StationOverloadSize, Position.Y);
2221 end;
2222 end;
2223end;
2224
2225procedure TEngine.DrawLines(Canvas: TCanvas);
2226var
2227 MetroLine: TMetroLine;
2228 S: Integer;
2229begin
2230 for MetroLine in Lines do
2231 with MetroLine do begin
2232 Canvas.Pen.Color := Color;
2233 Canvas.Pen.Style := psSolid;
2234 Canvas.Pen.Width := MetroLineThickness;
2235 if Track.Points.Count > 0 then Canvas.MoveTo(Track.Points[0].Position);
2236 for S := 1 to Track.Points.Count - 1 do begin
2237 Canvas.LineTo(Track.Points[S].Position);
2238{ if (S = TrackPoints.Count - 1) then begin
2239 Canvas.Pen.EndCap := pecSquare;
2240 Angle := arctan2(((TrackPoints[S].Position.Y - TrackPoints[S - 1].Position.Y),
2241 (TrackPoints[S].Position.X - TrackPoints[S - 1].Position.X));
2242 EndPoint := Point(Round(TrackPoints[S].Position.X + EndStationLength * Cos(Angle)),
2243 Round(TrackPoints[S].Position.Y + EndStationLength * Sin(Angle)));
2244 Canvas.LineTo(EndPoint);
2245 Canvas.MoveTo(Point(Round(EndPoint.X + Cos(Angle + Pi / 2) * EndStationLength / 3),
2246 Round(EndPoint.Y + Sin(Angle + Pi / 2) * EndStationLength / 3)));
2247 Canvas.LineTo(Point(Round(EndPoint.X + Cos(Angle - Pi / 2) * EndStationLength / 3),
2248 Round(EndPoint.Y + Sin(Angle - Pi / 2) * EndStationLength / 3)));
2249 Canvas.Pen.EndCap := pecRound;
2250 end;}
2251 end;
2252(* Canvas.Pen.Color := Color;
2253 Canvas.Pen.Style := psSolid;
2254 Canvas.Pen.Width := MetroLineThickness div 2;
2255 if Track.Points.Count > 0 then Canvas.MoveTo(Track.Points[0].PositionDesigned);
2256 for S := 1 to Track.Points.Count - 1 do begin
2257 Canvas.LineTo(Track.Points[S].PositionDesigned);
2258{ if (S = TrackPoints.Count - 1) then begin
2259 Canvas.Pen.EndCap := pecSquare;
2260 Angle := arctan2((TrackPoints[S].Position.Y - TrackPoints[S - 1].Position.Y),
2261 (TrackPoints[S].Position.X - TrackPoints[S - 1].Position.X));
2262 EndPoint := Point(Round(TrackPoints[S].Position.X + EndStationLength * Cos(Angle)),
2263 Round(TrackPoints[S].Position.Y + EndStationLength * Sin(Angle)));
2264 Canvas.LineTo(EndPoint);
2265 Canvas.MoveTo(Point(Round(EndPoint.X + Cos(Angle + Pi / 2) * EndStationLength / 3),
2266 Round(EndPoint.Y + Sin(Angle + Pi / 2) * EndStationLength / 3)));
2267 Canvas.LineTo(Point(Round(EndPoint.X + Cos(Angle - Pi / 2) * EndStationLength / 3),
2268 Round(EndPoint.Y + Sin(Angle - Pi / 2) * EndStationLength / 3)));
2269 Canvas.Pen.EndCap := pecRound;
2270 end;}
2271 end;
2272 {
2273 if (TrackPoints.Count > 1) then begin
2274 Canvas.Pen.EndCap := pecSquare;
2275 Angle := arctan2((TrackPoints[1].Position.Y - TrackPoints[0].Position.Y),
2276 (TrackPoints[1].Position.X - TrackPoints[0].Position.X));
2277 Canvas.MoveTo(TrackPoints[0].Position);
2278 EndPoint := Point(Round(TrackPoints[0].Position.X - EndStationLength * Cos(Angle)),
2279 Round(TrackPoints[0].Position.Y - EndStationLength * Sin(Angle)));
2280 Canvas.LineTo(EndPoint);
2281 Canvas.MoveTo(Point(Round(EndPoint.X - Cos(Angle + Pi / 2) * EndStationLength / 3),
2282 Round(EndPoint.Y - Sin(Angle + Pi / 2) * EndStationLength / 3)));
2283 Canvas.LineTo(Point(Round(EndPoint.X - Cos(Angle - Pi / 2) * EndStationLength / 3),
2284 Round(EndPoint.Y - Sin(Angle - Pi / 2) * EndStationLength / 3)));
2285 Canvas.Pen.EndCap := pecRound;
2286 end; }
2287 *)
2288 end;
2289
2290 // Draw design time lines
2291 if Assigned(TrackStationDown) and Assigned(TrackStationDown.LineStation) then begin
2292 Canvas.Pen.Color := TrackStationDown.Track.Line.Color;
2293 Canvas.MoveTo(TrackStationDown.LineStation.TrackPoint.Position);
2294 DrawLine(Canvas, View.PointDestToSrc(LastMousePos));
2295 end;
2296 if Assigned(TrackStationUp) and Assigned(TrackStationUp.LineStation) then begin
2297 Canvas.Pen.Color := TrackStationUp.Track.Line.Color;
2298 Canvas.MoveTo(TrackStationUp.LineStation.TrackPoint.Position);
2299 DrawLine(Canvas, View.PointDestToSrc(LastMousePos));
2300 end;
2301end;
2302
2303procedure TEngine.DrawStations(Canvas: TCanvas);
2304var
2305 MapStation: TMapStation;
2306 Passenger: TMetroPassenger;
2307 PassengerPos: TPoint;
2308 Direction: Integer;
2309begin
2310 Canvas.Pen.Width := 5;
2311 for MapStation in Stations do
2312 with MapStation do begin
2313 Canvas.Pen.Style := psSolid;
2314 if Assigned(SelectedLine) and (Lines.IndexOf(SelectedLine) <> -1) then begin
2315 Canvas.Brush.Style := bsClear;
2316 Canvas.Pen.Color := SelectedLine.Color;
2317 DrawShape(Canvas, Position, Shape, StationSize + Canvas.Pen.Width + 4, 0);
2318 end;
2319
2320 Canvas.Brush.Color := Colors.ShapeBackground;
2321 Canvas.Brush.Style := bsSolid;
2322 Canvas.Pen.Color := Colors.Text;
2323 DrawShape(Canvas, Position, Shape, StationSize, 0);
2324
2325 // Draw passengers
2326 Canvas.Pen.Style := psClear;
2327 Canvas.Brush.Color := Colors.Text;
2328 PassengerPos := Point(0, 0);
2329 Direction := 1;
2330 for Passenger in Passengers do
2331 with Passenger do begin
2332 DrawShape(Canvas, Point(Position.X + StationSize + PassengerPos.X,
2333 Position.Y - StationSize div 2 + PassengerPos.Y),
2334 Shape, PassengerSize, 0);
2335 PassengerPos := Point(PassengerPos.X + Direction * (PassengerSize + 2), PassengerPos.Y);
2336 if PassengerPos.X >= (PassengerSize + 2) * VisiblePassengersPerLine then begin
2337 Direction := -Direction;
2338 PassengerPos.X := PassengerPos.X - (PassengerSize + 2);
2339 PassengerPos.Y := PassengerPos.Y + (PassengerSize + 2);
2340 end;
2341 if PassengerPos.X < 0 then begin
2342 Direction := -Direction;
2343 PassengerPos.X := 0;
2344 PassengerPos.Y := PassengerPos.Y + (PassengerSize + 2);
2345 end;
2346 end;
2347
2348{ if ShowDistances then begin
2349 Canvas.Brush.Style := bsClear;
2350 Text := '';
2351 for P := 0 to 5 do
2352 Text := Text + IntToStr(ShapeDistance[TStationShape(P)]) + ',';
2353 Canvas.TextOut(Position.X + StationSize div 2, Position.Y + StationSize div 2, Text);
2354 end;
2355 }
2356 end;
2357end;
2358
2359procedure TEngine.DrawGameControls(Canvas: TCanvas; CanvasSize: TPoint);
2360var
2361 I: Integer;
2362 Text: string;
2363 Radius: Integer;
2364 Angle: Real;
2365 Pos: TPoint;
2366begin
2367 // Line selection
2368 Canvas.Pen.Width := 4;
2369 for I := 0 to High(LineColors) do begin
2370 if Assigned(Lines.SearchByColor(LineColors[I])) then begin
2371 Canvas.Brush.Color := LineColors[I];
2372 Radius := 15;
2373 end else begin
2374 Canvas.Brush.Color := clSilver;
2375 Radius := 5;
2376 end;
2377 Canvas.Pen.Color := Colors.Text;
2378 if Assigned(SelectedLine) and (SelectedLine.Color = LineColors[I]) then begin
2379 Canvas.Pen.Style := psSolid;
2380 end else begin
2381 Canvas.Pen.Style := psClear;
2382 end;
2383
2384 Canvas.EllipseC(CanvasSize.X div 2 - Length(LineColors) div 2 * LineColorsDist + I * LineColorsDist,
2385 CanvasSize.Y - LineColorsDist, Radius, Radius);
2386 end;
2387
2388 // Draw unused trains
2389 Text := IntToStr(Trains.GetUnusedCount);
2390 Canvas.Draw(CanvasSize.X div 2 - Length(LineColors) div 2 * LineColorsDist - 100,
2391 CanvasSize.Y - LineColorsDist - ImageLocomotive.Picture.Bitmap.Height div 2, ImageLocomotive.Picture.Bitmap);
2392 Canvas.Brush.Style := bsClear;
2393 Canvas.Font.Size := 14;
2394 Canvas.Font.Color := Colors.Text;
2395 Canvas.TextOut(CanvasSize.X div 2 - Length(LineColors) div 2 * LineColorsDist - 50 - Canvas.TextWidth(Text),
2396 CanvasSize.Y - LineColorsDist - Canvas.TextHeight(Text) div 2, Text);
2397
2398 // Status interface
2399 Text := IntToStr(ServedPassengerCount);
2400 Canvas.Draw(CanvasSize.X - 50, CanvasSize.Y - 60, ImagePassenger.Picture.Bitmap);
2401 Canvas.Brush.Style := bsClear;
2402 Canvas.Font.Size := 14;
2403 Canvas.Font.Color := Colors.Text;
2404 Canvas.TextOut(CanvasSize.X - 70 - Canvas.TextWidth(Text),
2405 CanvasSize.Y - 55, Text);
2406
2407 DrawClock(Canvas, CanvasSize);
2408
2409 // Back button
2410 Canvas.Font.Size := 40;
2411 Canvas.Font.Color := Colors.Text;
2412 ButtonBack.Paint(Canvas, Point(10, 10));
2413
2414 // Show train grabbed by mouse
2415 if Assigned(SelectedTrain) then begin
2416 Canvas.Brush.Color := Colors.Text; //SelectedTrain.Line.Color;
2417 Canvas.Brush.Style := bsSolid;
2418 Canvas.Pen.Style := psClear;
2419 Pos := LastMousePos;
2420 Angle := 0;
2421
2422 Canvas.Polygon([
2423 RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y - TrainSize div 3), Angle),
2424 RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y - TrainSize div 3), Angle),
2425 RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y + TrainSize div 3), Angle),
2426 RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y + TrainSize div 3), Angle)
2427 ]);
2428 end;
2429end;
2430
2431procedure TEngine.Tick;
2432var
2433 Passenger: TMetroPassenger;
2434 MapStation: TMapStation;
2435begin
2436 if State = gsRunning then begin
2437 FTime := FTime + (Now - LastTickTime) / OneSecond * TimePerSecond;
2438 Redraw; // Redraw on every because engine time is changed so clock should be redrawn
2439
2440 // Add new trains
2441 if (Time - LastNewWeekTime) > NewTrainPeriod then begin
2442 LastNewWeekTime := Time;
2443 Trains.AddNew;
2444 // TODO: Show notification screen with confirmation
2445 Redraw;
2446 end;
2447
2448 // Add new shape
2449 if (Time - LastNewShapeTime) > NewShapePeriod then begin
2450 LastNewShapeTime := Time;
2451 if ShapeCount <= Integer(High(TStationShape)) then Inc(ShapeCount);
2452 Redraw;
2453 end;
2454
2455 // Add new stations
2456 if (Time - LastNewStationTime) > NewStationPeriod then begin
2457 LastNewStationTime := Time;
2458 Stations.AddNew;
2459 ResizeView;
2460 Redraw;
2461 end;
2462
2463 // Add new passengers
2464 if (Time - LastNewPassengerTime) > NewPassengerPeriod then begin
2465 LastNewPassengerTime := Time;
2466 for MapStation in Stations do
2467 with MapStation do
2468 if Random < NewPassengerProbability then begin
2469 Passenger := Self.Passengers.AddNew;
2470 Passenger.Station := MapStation;
2471 Passengers.Add(Passenger);
2472
2473 // Passenger is not allowed to have same shape
2474 while (Passenger.Shape = Passenger.Station.Shape) or
2475 not (Passenger.Shape in GetExistStationShapes) do
2476 Passenger.Shape := TStationShape((Integer(Passenger.Shape) + 1) mod Integer(ShapeCount));
2477 Redraw;
2478 end;
2479 end;
2480
2481 // Check station passenger overload state
2482 for MapStation in Stations do
2483 with MapStation do begin
2484 if Passengers.Count > MaxWaitingPassengers then begin
2485 OverloadDuration := OverloadDuration + (FTime - FLastTime);
2486 if OverloadDuration > MaxPassengersOveloadTime then
2487 OverloadDuration := MaxPassengersOveloadTime;
2488 if OverloadDuration < MaxPassengersOveloadTime then Redraw;
2489 end;
2490 if Passengers.Count <= MaxWaitingPassengers then begin
2491 if OverloadDuration > 0 then Redraw;
2492 OverloadDuration := OverloadDuration - (FTime - FLastTime);
2493 if OverloadDuration < 0 then begin
2494 OverloadDuration := 0;
2495 end;
2496 end;
2497 end;
2498
2499 TrainMovement;
2500
2501 // Game over
2502 for MapStation in Stations do
2503 with MapStation do begin
2504 if OverloadDuration >= MaxPassengersOveloadTime then begin
2505 State := gsGameOver;
2506 Redraw;
2507 end;
2508 end;
2509
2510 end;
2511 LastTickTime := Now;
2512 FLastTime := FTime;
2513end;
2514
2515procedure TEngine.MouseMove(Position: TPoint);
2516var
2517 FocusedStation: TMapStation;
2518 Line: TMetroLine;
2519 LineStationDown: TLineStation;
2520 LineStationUp: TLineStation;
2521 CurrentTrackPoint: TTrackPoint;
2522begin
2523 if State = gsMenu then begin
2524 Menu.MouseMove(Position);
2525 Redraw;
2526 end;
2527
2528 LastMousePos := Position;
2529 if MouseHold then begin
2530 FocusedStation := GetStationOnPos(View.PointDestToSrc(Position));
2531 Line := nil;
2532 if Assigned(TrackStationDown) then begin
2533 Line := TrackStationDown.Track.Line;
2534 Redraw;
2535 end;
2536 if Assigned(TrackStationUp) then begin
2537 Line := TrackStationUp.Track.Line;
2538 Redraw;
2539 end;
2540 if Assigned(Line) and not Assigned(LastFocusedStation) and Assigned(FocusedStation) then begin
2541 if Assigned(TrackStationDown) and (TrackStationDown.LineStation.MapStation = FocusedStation) then begin
2542 // Disconnect down
2543 CurrentTrackPoint := TrackStationDown;
2544 TrackStationDown := TrackStationDown.GetDown;
2545 Line.DisconnectStation(CurrentTrackPoint.LineStation);
2546 end else
2547 if Assigned(TrackStationUp) and (TrackStationUp.LineStation.MapStation = FocusedStation) then begin
2548 // Disconnect up
2549 CurrentTrackPoint := TrackStationUp;
2550 if Assigned(TrackStationUp) then
2551 TrackStationUp := TrackStationUp.GetUp;
2552 Line.DisconnectStation(CurrentTrackPoint.LineStation);
2553 end else
2554 if Assigned(Line) and ((not Line.IsCircular) or ((TrackStationDown <> nil) and (TrackStationUp <> nil))) and
2555 ((Line.LineStations.SearchMapStation(FocusedStation) = nil) or
2556 ((Line.LineStations.Count > 0) and
2557 ((Line.LineStations.First.MapStation = FocusedStation) or
2558 (Line.LineStations.Last.MapStation = FocusedStation)) and
2559 ((TrackStationDown = nil) or (TrackStationUp = nil)) and
2560 (not Line.IsCircular))) then begin
2561 if Assigned(TrackStationDown) then LineStationDown := TrackStationDown.LineStation
2562 else LineStationDown := nil;
2563 if Assigned(TrackStationUp) then LineStationUp := TrackStationUp.LineStation
2564 else LineStationUp := nil;
2565 Line.ConnectStation(FocusedStation, LineStationDown, LineStationUp);
2566 if Assigned(TrackStationDown) then TrackStationDown := TrackStationDown.GetUp
2567 else if Assigned(TrackStationUp) then TrackStationUp := TrackStationUp.GetDown;
2568 end;
2569 end;
2570 LastFocusedStation := FocusedStation;
2571 end;
2572end;
2573
2574procedure TEngine.MouseUp(Button: TMouseButton; Position: TPoint);
2575var
2576 I: Integer;
2577 FocusedTrack: TTrackLink;
2578begin
2579 if Button = mbLeft then begin
2580 if State = gsMenu then begin
2581 Menu.MouseUp(Button, Position);
2582 Redraw;
2583 end else begin
2584 // Back button
2585 if ButtonBack.Bounds.Contains(Position) then begin
2586 if Assigned(ButtonBack.OnClick) then
2587 ButtonBack.OnClick(ButtonBack);
2588 end;
2589
2590 // Place selected train if focused track
2591 if Assigned(SelectedTrain) then begin
2592 SelectedTrain.TargetStation := nil;
2593 SelectedTrain.BaseTrackPoint := nil;
2594 if Assigned(SelectedTrain.Line) then begin
2595 SelectedTrain.Line.Trains.Remove(SelectedTrain);
2596 SelectedTrain.Line := nil;
2597 end;
2598 FocusedTrack := GetTrackOnPos(View.PointDestToSrc(Position));
2599 if Assigned(FocusedTrack.Points[0]) then begin
2600 SelectedTrain.Line := FocusedTrack.Points[0].Track.Line;
2601 SelectedTrain.Line.Trains.Add(SelectedTrain);
2602 SelectedTrain.BaseTrackPoint := FocusedTrack.Points[0];
2603 end else
2604 if Assigned(FocusedTrack.Points[1]) then begin
2605 SelectedTrain.Line := FocusedTrack.Points[1].Track.Line;
2606 SelectedTrain.Line.Trains.Add(SelectedTrain);
2607 SelectedTrain.BaseTrackPoint := FocusedTrack.Points[1];
2608 end;
2609 FocusedTrack.Free;
2610 end;
2611
2612 // Line color selection
2613 for I := 0 to Lines.Count - 1 do
2614 if Distance(Point(View.DestRect.Right div 2 - Length(LineColors) div 2 * LineColorsDist + I * LineColorsDist,
2615 View.DestRect.Bottom - LineColorsDist), Position) < 20 then begin
2616 SelectedLine := Lines[I];
2617 Exit;
2618 end;
2619
2620 // Remove single line station on line
2621 if Assigned(TrackStationDown) and (TrackStationDown.Track.Line.LineStations.Count = 1) then begin
2622 TrackStationDown.Track.Line.DisconnectStation(TrackStationDown.Track.Line.LineStations.First);
2623 end;
2624 if Assigned(TrackStationUp) and (TrackStationUp.Track.Line.LineStations.Count = 1) then begin
2625 TrackStationUp.Track.Line.DisconnectStation(TrackStationUp.Track.Line.LineStations.First);
2626 end;
2627 end;
2628 end else
2629 if Button = mbRight then begin
2630 SelectedLine := nil;
2631 end;
2632 MouseHold := False;
2633 TrackStationDown := nil;
2634 TrackStationUp := nil;
2635 SelectedTrain := nil;
2636end;
2637
2638procedure TEngine.MouseDown(Button: TMouseButton; Position: TPoint);
2639var
2640 Station: TMapStation;
2641 NewLine: TMetroLine;
2642 Track: TTrackLink;
2643 NewIndex: Integer;
2644begin
2645 if Button = mbLeft then begin
2646 if State <> gsMenu then begin
2647 MouseHold := True;
2648 LastFocusedStation := nil;
2649
2650 // Train selection
2651 SelectedTrain := GetTrainOnPos(View.PointDestToSrc(Position));
2652 if Assigned(SelectedTrain) then begin
2653 Exit;
2654 end;
2655
2656 // Select unused train
2657 if (Distance(Position, Point(View.DestRect.Right div 2 - Length(LineColors) div 2 * LineColorsDist - 100,
2658 View.DestRect.Bottom - LineColorsDist)) < 30) and
2659 (Trains.GetUnusedCount > 0) then begin
2660 SelectedTrain := Trains.GetUnusedTrain;
2661 Exit;
2662 end;
2663
2664 // Line selection
2665 Track := GetTrackOnPos(View.PointDestToSrc(Position));
2666 if Assigned(Track) and Assigned(Track.Points[0]) and Assigned(Track.Points[1]) then begin
2667 SelectedLine := Track.Points[0].Track.Line;
2668
2669 TrackStationDown := Track.Points[0];
2670 NewIndex := TrackStationDown.Track.Points.IndexOf(TrackStationDown);
2671 while Assigned(TrackStationDown) and (not Assigned(TrackStationDown.LineStation)) do begin
2672 NewIndex := NewIndex - 1;
2673 if NewIndex >= 0 then TrackStationDown := TrackStationDown.Track.Points[NewIndex]
2674 else TrackStationDown := nil;
2675 end;
2676 TrackStationUp := Track.Points[1];
2677 NewIndex := TrackStationUp.Track.Points.IndexOf(TrackStationDown);
2678 while Assigned(TrackStationUp) and (not Assigned(TrackStationUp.LineStation)) do begin
2679 NewIndex := NewIndex + 1;
2680 if NewIndex < TrackStationUp.Track.Points.Count then
2681 TrackStationUp := TrackStationUp.Track.Points[NewIndex]
2682 else TrackStationUp := nil;
2683 end;
2684 Track.Free;
2685 Exit;
2686 end;
2687 if Assigned(Track) then Track.Free;
2688
2689 // New track creation from selected station as start
2690 Station := GetStationOnPos(View.PointDestToSrc(Position));
2691 if Assigned(Station) then begin
2692 if Assigned(SelectedLine) and (SelectedLine.LineStations.Count = 0) then NewLine := SelectedLine
2693 else NewLine := GetUnusedLine;
2694 if Assigned(NewLine) then begin
2695 NewLine.ConnectStation(Station, nil, nil);
2696 TrackStationDown := NewLine.Track.Points.Last;
2697 TrackStationUp := nil;
2698 LastFocusedStation := Station;
2699 end;
2700 end;
2701 end;
2702 end;
2703end;
2704
2705procedure TEngine.KeyUp(Key: Word);
2706const
2707 KeyEsc = 27;
2708 KeyF2 = 113;
2709begin
2710 if Key = KeyEsc then begin
2711 if State = gsMenu then begin
2712 if Assigned(Menu.OnExit) then
2713 Menu.OnExit(nil);
2714 end else begin
2715 ButtonBackClick(nil);
2716 end;
2717 end;
2718 {$IFDEF DEBUG}
2719 if Key = KeyF2 then begin
2720 if State = gsRunning then begin
2721 State := gsGameOver;
2722 Redraw;
2723 end;
2724 end;
2725 {$ENDIF}
2726end;
2727
2728procedure TEngine.MainMenu;
2729begin
2730 State := gsMenu;
2731 Redraw;
2732end;
2733
2734procedure TEngine.Clear;
2735begin
2736 Trains.Clear;
2737 Passengers.Clear;
2738 Lines.Clear;
2739 Stations.Clear;
2740end;
2741
2742procedure TEngine.NewGame;
2743var
2744 NewTrain: TMetroTrain;
2745 I: Integer;
2746 NewStation: TMapStation;
2747 InitialStationCount: Integer;
2748begin
2749 Clear;
2750 ShapeCount := 3;
2751 ServedPassengerCount := 0;
2752
2753 // Start with 3 stations with each different shape
2754 InitialStationCount := 3;
2755 for I := 0 to InitialStationCount - 1 do begin
2756 NewStation := Stations.AddNew;
2757 if I = 0 then NewStation.Shape := ssSquare
2758 else if I = 1 then NewStation.Shape := ssCircle
2759 else if I = 2 then NewStation.Shape := ssTriangle;
2760 end;
2761
2762 for I := 0 to 8 do begin
2763 Lines.AddNew;
2764 NewTrain := TMetroTrain.Create;
2765 Trains.Add(NewTrain);
2766 end;
2767
2768 ResizeView;
2769
2770 SelectedLine := nil;
2771 FTime := 0;
2772 FLastTime := 0;
2773 LastNewStationTime := Time;
2774 LastNewPassengerTime := Time;
2775 LastNewWeekTime := Time;
2776 LastNewShapeTime := Time;
2777 LastTickTime := Now;
2778 State := gsRunning;
2779 Redraw;
2780end;
2781
2782procedure TEngine.Redraw;
2783begin
2784 RedrawPending := True;
2785end;
2786
2787constructor TEngine.Create;
2788begin
2789 ButtonBack := TMenuItemButton.Create;
2790 ButtonBack.Text := '🡸';
2791 ButtonBack.OnClick := ButtonBackClick;
2792 ButtonBack.BackgroundColor := clNone;
2793 MenuMain := TMenu.Create;
2794 MenuOptions := TMenu.Create;
2795 MenuGame := TMenu.Create;
2796 Menu := MenuMain;
2797 InitMenus;
2798 Stations := TMapStations.Create;
2799 Stations.Engine := Self;
2800 Lines := TMetroLines.Create;
2801 Lines.Engine := Self;
2802 Passengers := TMetroPassengers.Create;
2803 Passengers.Engine := Self;
2804 Map := TMap.Create;
2805 View := TView.Create;
2806 Trains := TMetroTrains.Create;
2807 ImagePassenger := TImage.Create(nil);
2808 ImageLocomotive := TImage.Create(nil);
2809 //if FileExists(ImagePassengerName) then
2810 // ImagePassenger.Picture.LoadFromFile(ImagePassengerName);
2811 //if FileExists(ImageLocomotiveName) then
2812 // ImageLocomotive.Picture.LoadFromFile(ImageLocomotiveName);
2813 MetaCanvas := TMetaCanvas.Create;
2814 InitColors;
2815end;
2816
2817destructor TEngine.Destroy;
2818begin
2819 FreeAndNil(MetaCanvas);
2820 FreeAndNil(Trains);
2821 FreeAndNil(ImageLocomotive);
2822 FreeAndNil(ImagePassenger);
2823 FreeAndNil(View);
2824 FreeAndNil(Map);
2825 FreeAndNil(Passengers);
2826 FreeAndNil(Stations);
2827 FreeAndNil(Lines);
2828 FreeAndNil(MenuMain);
2829 FreeAndNil(MenuOptions);
2830 FreeAndNil(MenuGame);
2831 FreeAndNil(ButtonBack);
2832 inherited;
2833end;
2834
2835procedure TEngine.Paint(Canvas: TCanvas; CanvasSize: TPoint);
2836begin
2837 MetaCanvas.Size := Point(Canvas.Width, Canvas.Height);
2838 MetaCanvas.Reset;
2839
2840 DrawStationPassengerOverload(MetaCanvas);
2841 DrawLines(MetaCanvas);
2842 DrawTrains(MetaCanvas);
2843 DrawStations(MetaCanvas);
2844
2845 // MainMenu background
2846 Canvas.Brush.Color := Colors.Background;
2847 Canvas.Brush.Style := bsSolid;
2848 Canvas.Clear;
2849
2850 MetaCanvas.Move(Point(-View.SourceRect.Left, -View.SourceRect.Top));
2851 MetaCanvas.Zoom(View.Zoom);
2852
2853 // Draw meta canvas to real target canvas
2854 MetaCanvas.DrawTo(Canvas);
2855
2856 if State <> gsMenu then begin
2857 DrawGameControls(Canvas, CanvasSize);
2858 end;
2859
2860 // Game over
2861 if State = gsGameOver then
2862 begin
2863 DrawGameOver(Canvas, CanvasSize);
2864 end else
2865 if State = gsMenu then begin
2866 Menu.Paint(Canvas, CanvasSize);
2867 end;
2868
2869 RedrawPending := False;
2870end;
2871
2872end.
2873
Note: See TracBrowser for help on using the repository browser.