source: trunk/Engine.pas

Last change on this file was 145, checked in by chronos, 21 months ago
  • Modified: Updated Common package.
File size: 141.8 KB
Line 
1unit Engine;
2
3{$IFDEF DARWIN}{$modeswitch Objectivec1}{$ENDIF}
4
5interface
6
7uses
8 {$IFDEF DARWIN}MacOSAll, CocoaAll, CocoaUtils,{$ENDIF}
9 Classes, SysUtils, Graphics, Controls, ExtCtrls, Math, DateUtils, Types,
10 RegistryEx, MetaCanvas, Generics.Collections, Generics.Defaults, Menu,
11 BasicControls, MetroPassenger, Colors, View, River, Track, City, Geometric,
12 Translator, DOM, XMLRead, XMLWrite, XML, Items, FileUtil;
13
14type
15 TEngine = class;
16 TMetroLines = class;
17 TMetroLine = class;
18 TMetroTrains = class;
19 TLineStation = class;
20 TMetroTrain = class;
21
22 TStationStyle = (ssShapes, ssLinear, ssAlpha);
23
24 { TMapStation }
25
26 TMapStation = class(TItem)
27 private
28 procedure ShiftTrackPoints;
29 procedure SortLines;
30 public
31 Engine: TEngine;
32 DestinationIndex: TDestinationIndex;
33 Position: TPoint;
34 Passengers: TMetroPassengers;
35 Lines: TMetroLines;
36 DestinationDistance: array of Integer;
37 OverloadDuration: TDateTime;
38 IsTerminal: Boolean;
39 function GetMaxPassengers: Integer;
40 function IsBestStationForShape(DestinationIndex: TDestinationIndex; Check, Current: TLineStation): Boolean;
41 class function GetClassSysName: string; override;
42 procedure LoadFromXmlNode(Node: TDOMNode); override;
43 procedure SaveToXmlNode(Node: TDOMNode); override;
44 constructor Create;
45 destructor Destroy; override;
46 end;
47
48 { TMapStations }
49
50 TMapStations = class(TItems<TMapStation>)
51 Engine: TEngine;
52 function CreateItem: TMapStation; override;
53 function GetRect: TRect;
54 function AddNew: TMapStation;
55 class function GetClassSysName: string; override;
56 end;
57
58 { TLineStation }
59
60 TLineStation = class(TItem)
61 Line: TMetroLine;
62 MapStation: TMapStation;
63 TrackPoint: TTrackPoint;
64 class function GetClassSysName: string; override;
65 procedure LoadFromXmlNode(Node: TDOMNode); override;
66 procedure SaveToXmlNode(Node: TDOMNode); override;
67 end;
68
69 { TLineStations }
70
71 TLineStations = class(TItems<TLineStation>)
72 Line: TMetroLine;
73 function CreateItem: TLineStation; override;
74 function SearchMapStation(Station: TMapStation): TLineStation;
75 class function GetClassSysName: string; override;
76 end;
77
78 { TMetroLine }
79
80 TMetroLine = class(TItem)
81 private
82 procedure UpdateEndingLine(EndIndex, Direction: Integer);
83 procedure UpdateEndingLines;
84 public
85 Index: Integer;
86 Engine: TEngine;
87 Color: TColor;
88 LineStations: TLineStations;
89 Trains: TMetroTrains;
90 Track: TTrack;
91 procedure ConnectStation(Station: TMapStation; LineStationDown, LineStationUp: TLineStation);
92 procedure DisconnectStation(ALineStation: TLineStation);
93 constructor Create;
94 destructor Destroy; override;
95 function IsCircular: Boolean;
96 class function GetClassSysName: string; override;
97 procedure LoadFromXmlNode(Node: TDOMNode); override;
98 procedure SaveToXmlNode(Node: TDOMNode); override;
99 end;
100
101 { TMetroLines }
102
103 TMetroLines = class(TItems<TMetroLine>)
104 Engine: TEngine;
105 function CreateItem: TMetroLine; override;
106 function AddNew(Color: TColor): TMetroLine;
107 function SearchByColor(Color: TColor): TMetroLine;
108 class function GetClassSysName: string; override;
109 end;
110
111 { TMetroCarriage }
112
113 TMetroCarriage = class(TItem)
114 Engine: TEngine;
115 Train: TMetroTrain;
116 Passengers: TMetroPassengers;
117 function GetTrackPosition: TTrackPosition;
118 function GetVector: TVector;
119 constructor Create;
120 destructor Destroy; override;
121 class function GetClassSysName: string; override;
122 procedure LoadFromXmlNode(Node: TDOMNode); override;
123 procedure SaveToXmlNode(Node: TDOMNode); override;
124 end;
125
126 { TMetroCarriages }
127
128 TMetroCarriages = class(TItems<TMetroCarriage>)
129 Engine: TEngine;
130 function CreateItem: TMetroCarriage; override;
131 function GetUnused: TMetroCarriage;
132 function GetUnusedCount: Integer;
133 class function GetClassSysName: string; override;
134 end;
135
136 { TMetroTrain }
137
138 TMetroTrain = class(TItem)
139 private
140 FLine: TMetroLine;
141 LastPosDelta: Integer;
142 LastTrainMoveTime: TDateTime;
143 StationStopTime: TDateTime;
144 procedure SetLine(AValue: TMetroLine);
145 public
146 Engine: TEngine;
147 Passengers: TMetroPassengers;
148 TrackPosition: TTrackPosition;
149 Direction: Integer;
150 InStation: Boolean;
151 TargetStation: TLineStation;
152 Carriages: TMetroCarriages;
153 class function GetClassSysName: string; override;
154 procedure LoadFromXmlNode(Node: TDOMNode); override;
155 procedure SaveToXmlNode(Node: TDOMNode); override;
156 procedure FindTargetStation;
157 function GetTargetStationDistance: Integer;
158 constructor Create;
159 destructor Destroy; override;
160 property Line: TMetroLine read FLine write SetLine;
161 end;
162
163 { TMetroTrains }
164
165 TMetroTrains = class(TItems<TMetroTrain>)
166 Engine: TEngine;
167 function GetUnused: TMetroTrain;
168 function GetUnusedCount: Integer;
169 function CreateItem: TMetroTrain; override;
170 class function GetClassSysName: string; override;
171 end;
172
173 { TMap }
174
175 TMap = class
176 Size: TPoint;
177 Rivers: TRivers;
178 constructor Create;
179 destructor Destroy; override;
180 end;
181
182 TGameState = (gsNotStarted, gsRunning, gsPaused, gsGameOver, gsMenu, gsNewWeek,
183 gsNewImprovement, gsSuccess);
184
185 TMetroImprovement = (miNone, miTunnel, miTerminal, miLine, miCarriage,
186 miFastTrain);
187 TMetroImprovementSet = set of TMetroImprovement;
188 TFullScrenChangeEvent = procedure (Sender: TObject; Active: Boolean) of object;
189
190 { TClock }
191
192 TClock = class(TControl)
193 Time: TDateTime;
194 TextColor: TColor;
195 BackgroundColor: TColor;
196 procedure Paint; override;
197 end;
198
199 TVisualStyle = (vsLondon, vsPrague);
200
201 { TEngine }
202
203 TEngine = class(TComponent)
204 private
205 FDarkMode: Boolean;
206 FFullScreen: Boolean;
207 FMovableTracks: Boolean;
208 FOnDarkModeChange: TNotifyEvent;
209 FOnExit: TNotifyEvent;
210 FOnFullScreenChange: TFullScrenChangeEvent;
211 FState: TGameState;
212 FStationStyle: TStationStyle;
213 FTranslator: TTranslator;
214 FVisualStyle: TVisualStyle;
215 LastMousePos: TPoint;
216 LastFocusedStation: TMapStation;
217 MouseHold: Boolean;
218 LastNewStationTime: TDateTime;
219 LastNewPassengerTime: TDateTime;
220 LastNewWeekTime: TDateTime;
221 LastNewShapeTime: TDateTime;
222 LastTickTime: TDateTime;
223 FTime: TDateTime;
224 FLastTime: TDateTime;
225 MetaCanvas: TMetaCanvas;
226 Menu: TMenu;
227 MenuMain: TMenu;
228 MenuOptions: TMenu;
229 MenuCareer: TMenu;
230 MenuGame: TMenu;
231 MenuCustomGame: TMenu;
232 MenuGameSlots: TMenu;
233 LastState: TGameState;
234 TimePerSecond: TDateTime;
235 ImprovementImageSize: Integer;
236 IconSize: Integer;
237 LineColors: array of TColor;
238 CarriageCountVisible: Boolean;
239 TerminalCountVisible: Boolean;
240 LastGrabbedTrainTrackPosition: TTrackPosition;
241 GrabbedTrainDirection: Integer;
242 LastGrabbedTrain: TMetroTrain;
243 function GetMetroLineThickness: Integer;
244 function GetServedDaysCount: Integer;
245 function DestinationIndexToText(DestinationIndex: TDestinationIndex): string;
246 function DestinationIndexToShape(DestinationIndex: TDestinationIndex): TDestinationShape;
247 procedure ResizeView(Force: Boolean);
248 function GetExistStationDestinationIndex(DestinationIndex: TDestinationIndex): Boolean;
249 function GetStationOnPos(Pos: TPoint): TMapStation;
250 function GetTrackOnPos(Pos: TPoint; out Intersect: TPoint): TTrackLink;
251 function GetTrainOnPos(Pos: TPoint): TMetroTrain;
252 function GetCarriageOnPos(Pos: TPoint): TMetroCarriage;
253 procedure DrawFrame(Canvas: TCanvas; Rect: TRect);
254 procedure DrawLine(Canvas: TCanvas; Pos: TPoint);
255 procedure DrawShape(Canvas: TCanvas; Position: TPoint; Shape: TDestinationShape;
256 Size: Integer; Angle: Double);
257 procedure DrawClock(Canvas: TCanvas; CanvasSize: TPoint);
258 procedure DrawTrains(Canvas: TCanvas);
259 procedure DrawGameOver(Canvas: TCanvas; CanvasSize: TPoint);
260 procedure DrawHighScore(Canvas: TCanvas; CanvasSize: TPoint; Y: Integer);
261 procedure DrawSuccess(Canvas: TCanvas; CanvasSize: TPoint);
262 procedure DrawNewWeek(Canvas: TCanvas; CanvasSize: TPoint);
263 procedure DrawNewImprovement(Canvas: TCanvas; CanvasSize: TPoint);
264 procedure DrawStationPassengerOverload(Canvas: TCanvas);
265 procedure DrawLines(Canvas: TCanvas);
266 procedure DrawStations(Canvas: TCanvas);
267 procedure DrawGameControls(Canvas: TCanvas; CanvasSize: TPoint);
268 procedure DrawGrabbed(Canvas: TCanvas; CanvasSize: TPoint);
269 procedure ComputeShapeDistance;
270 procedure ComputeDestinationIndexDistanceStation(Station: TMapStation;
271 UpdatedDestinationIndex: TDestinationIndex; Distance: Integer);
272 procedure SetDarkMode(AValue: Boolean);
273 procedure SetFullScreen(AValue: Boolean);
274 procedure SetState(AValue: TGameState);
275 procedure TrainsMovement;
276 procedure TrainMovement(Train: TMetroTrain);
277 function GetUnusedLine: TMetroLine;
278 procedure ShiftTrackPoints;
279 procedure MenuItemExit(Sender: TObject);
280 procedure MenuItemCity(Sender: TObject);
281 procedure MenuItemPlay(Sender: TObject);
282 procedure MenuItemCareer(Sender: TObject);
283 procedure MenuItemOptions(Sender: TObject);
284 procedure MenuItemCustomGame(Sender: TObject);
285 procedure MenuItemCustomPlay(Sender: TObject);
286 procedure MenuItemGameContinue(Sender: TObject);
287 procedure MenuItemGameExit(Sender: TObject);
288 procedure MenuItemGameRestart(Sender: TObject);
289 procedure MenuItemGameLoad(Sender: TObject);
290 procedure MenuItemGameSave(Sender: TObject);
291 procedure MenuItemGameSlotLoad(Sender: TObject);
292 procedure MenuItemGameSlotSave(Sender: TObject);
293 procedure MenuItemBack(Sender: TObject);
294 procedure ButtonPlay(Sender: TObject);
295 procedure ButtonPause(Sender: TObject);
296 procedure ButtonFastForward(Sender: TObject);
297 procedure ButtonNewTrain(Sender: TObject);
298 procedure ButtonNewImprovement1(Sender: TObject);
299 procedure ButtonNewImprovement2(Sender: TObject);
300 procedure ButtonBackClick(Sender: TObject);
301 procedure DarkModeChanged(Sender: TObject);
302 procedure LanguageChanged(Sender: TObject);
303 procedure FullScreenChanged(Sender: TObject);
304 procedure MovableTrackChanged(Sender: TObject);
305 procedure StationStyleChanged(Sender: TObject);
306 procedure VisualStyleChanged(Sender: TObject);
307 procedure UpdateInterface;
308 function GetImprovementText(Improvement: TMetroImprovement): string;
309 function GetImprovementBitmap(Improvement: TMetroImprovement): TBitmap;
310 procedure EvaluateImprovement(Improvement: TMetroImprovement);
311 procedure ReloadGameSlots(Save: Boolean);
312 function GetGameSlotFileName(Index: Integer): string;
313 procedure AutoSave;
314 procedure CheckScore;
315 public
316 // Test
317 function GetSelectedOrUnusedMetroLine: TMetroLine;
318 public
319 AvailableTerminals: Integer;
320 Week: Integer;
321 Colors: TColors;
322 Passengers: TMetroPassengers;
323 Stations: TMapStations;
324 Lines: TMetroLines;
325 Trains: TMetroTrains;
326 Carriages: TMetroCarriages;
327 DestinationCount: Integer;
328 Map: TMap;
329 View: TView;
330 Cities: TCities;
331 City: TCity;
332 SelectedLine: TMetroLine;
333 SelectedTrain: TMetroTrain;
334 SelectedCarriage: TMetroCarriage;
335 SelectedTerminal: Boolean;
336 TrackStationDown: TTrackPoint;
337 TrackStationUp: TTrackPoint;
338 ServedPassengerCount: Integer;
339 RedrawPending: Boolean;
340 ButtonBack: TImage;
341 ImagePassenger: TImage;
342 ImageLocomotive: TImage;
343 ImagePlay: TImage;
344 ImagePause: TImage;
345 ImageFastForward: TImage;
346 ImageAchievement: TImage;
347 ImageCarriage: TImage;
348 ImageTerminal: TImage;
349 ImageTunnel: TImage;
350 ImageLine: TImage;
351 ImageNewTrain: TImage;
352 ImageNewImprovement1: TImage;
353 ImageNewImprovement2: TImage;
354 Clock: TClock;
355 AvailableImprovements: TMetroImprovementSet;
356 Improvement1: TMetroImprovement;
357 Improvement2: TMetroImprovement;
358 HighestServedPassengerCount: Integer;
359 HighestServedDaysCount: Integer;
360 OldHighestServedPassengerCount: Integer;
361 OldHighestServedDaysCount: Integer;
362 RegistryContext: TRegistryContext;
363 CurvedLines: Boolean;
364 procedure InitMenus;
365 procedure InitCities;
366 procedure MouseMove(Position: TPoint);
367 procedure MouseUp(Button: TMouseButton; Position: TPoint);
368 procedure MouseDown(Button: TMouseButton; Position: TPoint);
369 procedure KeyUp(Key: Word);
370 procedure MainMenu;
371 procedure Clear;
372 procedure NewGame;
373 procedure Redraw;
374 procedure LoadFromRegistry;
375 procedure SaveToRegistry;
376 procedure LoadFromXmlNode(Node: TDOMNode);
377 procedure SaveToXmlNode(Node: TDOMNode);
378 procedure LoadFromFile(FileName: string);
379 procedure SaveToFile(FileName: string);
380 constructor Create(AOwner: TComponent); override;
381 destructor Destroy; override;
382 procedure Tick;
383 procedure Paint(Canvas: TCanvas; CanvasSize: TPoint);
384 property Time: TDateTime read FTime;
385 property State: TGameState read FState write SetState;
386 property ServedDaysCount: Integer read GetServedDaysCount;
387 published
388 property MovableTracks: Boolean read FMovableTracks write FMovableTracks;
389 property VisualStyle: TVisualStyle read FVisualStyle write FVisualStyle;
390 property StationStyle: TStationStyle read FStationStyle write FStationStyle;
391 property DarkMode: Boolean read FDarkMode write SetDarkMode;
392 property FullScreen: Boolean read FFullScreen write SetFullScreen;
393 property Translator: TTranslator read FTranslator write FTranslator;
394 property OnDarkModeChange: TNotifyEvent read FOnDarkModeChange
395 write FOnDarkModeChange;
396 property OnFullScreenChange: TFullScrenChangeEvent read FOnFullScreenChange
397 write FOnFullScreenChange;
398 property OnExit: TNotifyEvent read FOnExit write FOnExit;
399 end;
400
401const
402 StationSize = 30;
403 StationOverloadSize = 60;
404 PassengerSize = 15;
405 TrainSize = 40;
406 TrainGap = 5;
407 LineColorsDist = 50;
408 TrainSpeed = 2000;
409 TrainPassengerCount = 6;
410 StationMinDistance = 100;
411 StationMaxDistance = 300;
412 MaxWaitingPassengers = 10;
413 MaxWaitingPassengersTerminal = 16;
414 MaxPassengersOveloadTime = 2;
415 MetroLineThickness = 13;
416 TrackClickDistance = 15;
417 EndStationLength = 50;
418 EndStationWidth = 20;
419 ShowDistances = False;
420 TimePerSecondNormal = 60 * OneMinute;
421 TimePerSecondFast = 2 * TimePerSecondNormal;
422 NewStationPeriod = 1;
423 NewShapePeriod = 10;
424 NewTrainPeriod = 7; // Each week
425 NewPassengerPeriod = 0.3 * OneSecond;
426 NewPassengerProbability = 0.003;
427 VisiblePassengersPerLine = 6;
428 TransLinesExt = '.tlg';
429
430
431implementation
432
433uses
434 Languages;
435
436resourcestring
437 SGameOver = 'Game Over';
438 SGameOverReason = 'Overcrowding at one of your stations has forced you to resign as metro manager.';
439 SGameOverStatistic = '%d passengers travelled on your metro over %d days.';
440 SDay = 'Day';
441 SNewHighScore = 'New high score!';
442 SOldHighScore = 'Old high score was %d passengers in %d days.';
443 SStationNotDefined = 'Station have to be defined';
444 SNoOldStationToConnectNew = 'No old line station to connect new station';
445 SStationWithoutMapStation = 'Station have to have MapStation';
446 SNewTrain = 'You get a new train for your metro';
447 SNewImprovement = 'Select a new improvement for your metro';
448 SWeek = 'week';
449 STrain = 'Train';
450 SPlay = 'Play';
451 SLoad = 'Load';
452 SSave = 'Save';
453 SCustomGame = 'Custom game';
454 SOptions = 'Options';
455 SExit = 'Exit';
456 STransLines = 'TransLines';
457 SDarkMode = 'Dark mode';
458 SLanguage = 'Language';
459 SMovableTrack = 'Movable track';
460 SCzech = 'Czech';
461 SEnglish = 'English';
462 SFrench = 'French';
463 SGerman = 'German';
464 SAutomatic = 'Automatic';
465 SBack = 'Back';
466 SFullScreen = 'Full screen';
467 SContinue = 'Continue';
468 SRestart = 'Try again';
469 STerminal = 'Terminal';
470 SLine = 'Line';
471 SCarriage = 'Carriage';
472 STunnel = 'Tunnel';
473 SCareer = 'Career';
474 SSuccess = 'Success';
475 SSuccessReason = 'Your metro transported enough passengers and you have reached your goal for this city.';
476 SUnlockedCity = 'City %s is now unlocked.';
477 SWrongFileFormat = 'Wrong file format';
478 SVisualStyle = 'Visual style';
479 SStationStyle = 'Station style';
480 SSlot = 'Slot';
481 SAutoSave = 'Auto save';
482
483 // Cities
484 SPrague = 'Prague';
485 SLondon = 'London';
486 SParis = 'Paris';
487 SNewYork = 'New York';
488 STokyo = 'Tokyo';
489 SRome = 'Rome';
490 SSeoul = 'Seoul';
491 SBeijing = 'Beijing';
492
493 // Station styles
494 SShapes = 'Shapes';
495 SLinear = 'Linear';
496 SAlpha = 'Alpha';
497
498var
499 StationStyleText: array[TStationStyle] of string = (SShapes, SLinear, SAlpha);
500 VisualStyleText: array[TVisualStyle] of string = (SLondon, SPrague);
501
502const
503 GameXmlName = 'TransLinesGame';
504
505{ TLineStation }
506
507class function TLineStation.GetClassSysName: string;
508begin
509 Result := 'LineStation';
510end;
511
512procedure TLineStation.LoadFromXmlNode(Node: TDOMNode);
513begin
514 inherited;
515 MapStation := Line.Engine.Stations.FindById(ReadInteger(Node, 'MapStation', 0));
516 TrackPoint := Line.Track.Points.FindById(ReadInteger(Node, 'TrackPoint', 0));
517 TrackPoint.OwnerPoint := Self;
518end;
519
520procedure TLineStation.SaveToXmlNode(Node: TDOMNode);
521begin
522 inherited;
523 WriteInteger(Node, 'MapStation', MapStation.Id);
524 WriteInteger(Node, 'TrackPoint', TrackPoint.Id);
525end;
526
527{ TClock }
528
529procedure TClock.Paint;
530var
531 ClockCenter: TPoint;
532 Angle: Double;
533 I: Integer;
534 IsDay: Boolean;
535begin
536 IsDay := (((Time / OneHour) mod 24) > 6) and (((Time / OneHour) mod 24) < 18);
537 if IsDay then begin
538 Canvas.Brush.Style := bsSolid;
539 Canvas.Brush.Color := BackgroundColor;
540 end else begin
541 Canvas.Brush.Style := bsSolid;
542 Canvas.Brush.Color := TextColor;
543 end;
544 Canvas.Pen.Style := psSolid;
545 Canvas.Pen.Color := TextColor;
546 Canvas.Pen.Width := 2;
547 ClockCenter := Point(Bounds.Left + Bounds.Width div 2,
548 Bounds.Top + Bounds.Height div 2);
549 Angle := Time / (12 * OneHour) * 2 * Pi - Pi / 2;
550 Canvas.EllipseC(ClockCenter.X, ClockCenter.Y, Bounds.Width div 2, Bounds.Height div 2);
551 Canvas.Brush.Style := bsClear;
552
553 if IsDay then begin
554 Canvas.Pen.Color := TextColor;
555 end else begin
556 Canvas.Pen.Color := BackgroundColor;
557 end;
558 Canvas.Line(ClockCenter, Point(ClockCenter.X + Round(Cos(Angle) * (Bounds.Width / 2) * 0.8),
559 ClockCenter.Y + Round(Sin(Angle) * (Bounds.Height / 2) * 0.8)));
560 for I := 0 to 12 do begin
561 Angle := I / 12 * 2 * Pi;
562 Canvas.Line(ClockCenter.X + Round(Cos(Angle) * (Bounds.Width / 2) * 0.7),
563 ClockCenter.Y + Round(Sin(Angle) * (Bounds.Height / 2) * 0.7),
564 ClockCenter.X + Round(Cos(Angle) * (Bounds.Width / 2) * 0.9),
565 ClockCenter.Y + Round(Sin(Angle) * (Bounds.Height / 2) * 0.9));
566 end;
567end;
568
569{ TMetroCarriage }
570
571function TMetroCarriage.GetTrackPosition: TTrackPosition;
572begin
573 if Assigned(Train) then begin
574 Result := Train.TrackPosition;
575 Result.Move(-Train.Direction * (TrainSize + TrainGap) * (Train.Carriages.IndexOf(Self) + 1));
576 end;
577end;
578
579function TMetroCarriage.GetVector: TVector;
580begin
581 Result := Train.TrackPosition.GetVector;
582 Result.Position := AddPoint(Result.Position, Point(TrainSize, TrainSize));
583end;
584
585constructor TMetroCarriage.Create;
586begin
587 Passengers := TMetroPassengers.Create;
588 Passengers.OwnsObjects := False;
589end;
590
591destructor TMetroCarriage.Destroy;
592begin
593 FreeAndNil(Passengers);
594 inherited;
595end;
596
597class function TMetroCarriage.GetClassSysName: string;
598begin
599 Result := 'Carriage';
600end;
601
602procedure TMetroCarriage.LoadFromXmlNode(Node: TDOMNode);
603var
604 Node2: TDOMNode;
605begin
606 inherited;
607
608 Node2 := Node.FindNode(DOMString(TMetroPassengers.GetClassSysName));
609 if Assigned(Node2) then
610 Passengers.LoadFromXmlNodeRef(Node2, Engine.Passengers);
611end;
612
613procedure TMetroCarriage.SaveToXmlNode(Node: TDOMNode);
614var
615 NewNode: TDOMNode;
616begin
617 inherited;
618
619 NewNode := Node.OwnerDocument.CreateElement(DOMString(TMetroPassengers.GetClassSysName));
620 Node.AppendChild(NewNode);
621 Passengers.SaveToXmlNodeRef(NewNode);
622end;
623
624{ TMetroCarriages }
625
626function TMetroCarriages.CreateItem: TMetroCarriage;
627begin
628 Result := inherited;
629 Result.Engine := Engine;
630end;
631
632function TMetroCarriages.GetUnused: TMetroCarriage;
633var
634 I: Integer;
635begin
636 I := 0;
637 while (I < Count) and (Assigned(Items[I].Train)) do Inc(I);
638 if I < Count then Result := Items[I]
639 else Result := nil;
640end;
641
642function TMetroCarriages.GetUnusedCount: Integer;
643var
644 I: Integer;
645begin
646 Result := 0;
647 for I := 0 to Count - 1 do
648 if not Assigned(Items[I].Train) then Inc(Result);
649end;
650
651class function TMetroCarriages.GetClassSysName: string;
652begin
653 Result := 'Carriages';
654end;
655
656{ TMap }
657
658constructor TMap.Create;
659begin
660 Rivers := TRivers.Create;
661end;
662
663destructor TMap.Destroy;
664begin
665 FreeAndNil(Rivers);
666 inherited;
667end;
668
669{ TLineStations }
670
671function TLineStations.CreateItem: TLineStation;
672begin
673 Result := inherited;
674 Result.Line := Line;
675end;
676
677function TLineStations.SearchMapStation(Station: TMapStation): TLineStation;
678var
679 I: Integer;
680begin
681 I := 0;
682 while (I < Count) and (Items[I].MapStation <> Station) do Inc(I);
683 if I < Count then Result := Items[I]
684 else Result := nil;
685end;
686
687class function TLineStations.GetClassSysName: string;
688begin
689 Result := 'LineStations';
690end;
691
692{ TMetroTrains }
693
694function TMetroTrains.GetUnused: TMetroTrain;
695var
696 I: Integer;
697begin
698 I := 0;
699 while (I < Count) and (Assigned(Items[I].Line)) do Inc(I);
700 if I < Count then Result := Items[I]
701 else Result := nil;
702end;
703
704function TMetroTrains.GetUnusedCount: Integer;
705var
706 I: Integer;
707begin
708 Result := 0;
709 for I := 0 to Count - 1 do
710 if not Assigned(Items[I].Line) then Inc(Result);
711end;
712
713function TMetroTrains.CreateItem: TMetroTrain;
714begin
715 Result := inherited;
716 Result.Engine := Engine;
717end;
718
719class function TMetroTrains.GetClassSysName: string;
720begin
721 Result := 'Trains';
722end;
723
724{ TMapStations }
725
726function TMapStations.CreateItem: TMapStation;
727begin
728 Result := inherited;
729 Result.Engine := Engine;
730end;
731
732function TMapStations.GetRect: TRect;
733var
734 I: Integer;
735begin
736 if Count > 0 then begin
737 with Items[0] do
738 Result := Rect(Position.X, Position.Y, Position.X, Position.Y);
739 for I := 1 to Count - 1 do
740 with Items[I] do begin
741 if Position.X < Result.Left then Result.Left := Position.X;
742 if Position.X > Result.Right then Result.Right := Position.X;
743 if Position.Y < Result.Top then Result.Top := Position.Y;
744 if Position.Y > Result.Bottom then Result.Bottom := Position.Y;
745 end;
746 end else Result := Rect(0, 0, 0, 0);
747end;
748
749function TMapStations.AddNew: TMapStation;
750var
751 D: Integer;
752 MinD: Integer;
753 I: Integer;
754 Pass: Integer;
755 Angle: Double;
756 L: Integer;
757const
758 Step = 20;
759begin
760 Result := CreateItem;
761 Angle := Random * 2 * Pi;
762 // Ensure minimum distance between stations
763 Pass := 0;
764 L := Step;
765 repeat
766 Result.Position := Point(Trunc(Engine.Map.Size.X / 2 + Cos(Angle) * L * 1.5),
767 Trunc(Engine.Map.Size.Y / 2 + Sin(Angle) * L));
768 MinD := High(Integer);
769 for I := 0 to Engine.Stations.Count - 1 do begin
770 D := Distance(Engine.Stations[I].Position, Result.Position);
771 if D < MinD then MinD := D;
772 end;
773 Inc(Pass);
774 L := L + StationMinDistance div 2;
775 until (MinD > StationMinDistance) or
776 (Pass > 1000) or (Engine.Stations.Count = 0);
777 Result.DestinationIndex := Random(Engine.DestinationCount);
778 Add(Result);
779 Engine.ComputeShapeDistance;
780end;
781
782class function TMapStations.GetClassSysName: string;
783begin
784 Result := 'MapStations';
785end;
786
787{ TMetroLines }
788
789function TMetroLines.CreateItem: TMetroLine;
790begin
791 Result := inherited;
792 Result.Engine := Engine;
793end;
794
795function TMetroLines.AddNew(Color: TColor): TMetroLine;
796begin
797 Result := AddItem;
798 Result.Index := Count;
799 Result.Color := Color;
800end;
801
802function TMetroLines.SearchByColor(Color: TColor): TMetroLine;
803var
804 I: Integer;
805begin
806 I := 0;
807 while (I < Count) and (Items[I].Color <> Color) do Inc(I);
808 if I < Count then Result := Items[I]
809 else Result := nil;
810end;
811
812class function TMetroLines.GetClassSysName: string;
813begin
814 Result := 'Lines';
815end;
816
817{ TMetroLine }
818
819procedure TMetroLine.UpdateEndingLine(EndIndex, Direction: Integer);
820var
821 //Index: Integer;
822 //NewTrackPoint: TTrackPoint;
823 Angle: Double;
824 EndPoint: TPoint;
825begin
826{ if Direction = 1 then Index := Track.Points.IndexOf(LineStations.Last.TrackPoint)
827 else if Direction = -1 then Index := Track.Points.IndexOf(LineStations.Last.TrackPoint);
828 if Index = EndIndex then begin
829 NewTrackPoint := Track.Points.AddNew;
830 if Direction = 1 then Track.Points.Insert(EndIndex, NewTrackPoint)
831 else if Direction = -1 then begin
832 Inc(EndIndex);
833 Track.Points.Insert(EndIndex, NewTrackPoint);
834 end;
835 end;
836 }
837 Angle := ArcTan2((Track.Points[EndIndex + 2 * Direction].PositionDesigned.Y -
838 Track.Points[EndIndex + Direction].PositionDesigned.Y),
839 (Track.Points[EndIndex + 2 * Direction].PositionDesigned.X -
840 Track.Points[EndIndex + Direction].PositionDesigned.X));
841 EndPoint := Point(Round(Track.Points[EndIndex + Direction].PositionDesigned.X - EndStationLength * Cos(Angle)),
842 Round(Track.Points[EndIndex + Direction].PositionDesigned.Y - EndStationLength * Sin(Angle)));
843 Track.Points[EndIndex].PositionDesigned := EndPoint;
844 Track.Points[EndIndex].Position := EndPoint;
845end;
846
847procedure TMetroLine.UpdateEndingLines;
848var
849 Index: Integer;
850 NewTrackPoint: TTrackPoint;
851begin
852 if LineStations.Count >= 2 then begin
853 Index := Track.Points.IndexOf(LineStations.First.TrackPoint);
854 if Index = 0 then begin
855 NewTrackPoint := Track.Points.CreateItem;
856 Track.Points.Insert(0, NewTrackPoint);
857 end;
858 Index := Track.Points.IndexOf(LineStations.Last.TrackPoint);
859 if Index = Track.Points.Count - 1 then begin
860 NewTrackPoint := Track.Points.CreateItem;
861 Track.Points.Insert(Track.Points.Count, NewTrackPoint);
862 end;
863 UpdateEndingLine(0, 1);
864 UpdateEndingLine(Track.Points.Count - 1, -1);
865 end;
866end;
867
868procedure TMetroLine.ConnectStation(Station: TMapStation; LineStationDown, LineStationUp: TLineStation);
869var
870 Train: TMetroTrain;
871 NewTrackPoint: TTrackPoint;
872 NewLineStation: TLineStation;
873 Index: Integer;
874begin
875 if not Assigned(Station) then
876 raise Exception.Create(SStationNotDefined);
877 if not Assigned(LineStationDown) and not Assigned(LineStationUp) and (LineStations.Count > 0) then
878 raise Exception.Create(SNoOldStationToConnectNew);
879 NewLineStation := TLineStation.Create;
880 NewLineStation.Line := Self;
881 NewLineStation.MapStation := Station;
882 Index := 0;
883 if Assigned(LineStationDown) then Index := LineStations.IndexOf(LineStationDown) + 1
884 else if Assigned(LineStationDown) then Index := LineStations.IndexOf(LineStationUp);
885 LineStations.Insert(Index, NewLineStation);
886 Station.Lines.Add(Self);
887
888 NewTrackPoint := Track.Points.CreateItem;
889 NewTrackPoint.OwnerPoint := NewLineStation;
890 NewTrackPoint.Position := Station.Position;
891 NewTrackPoint.PositionDesigned := NewTrackPoint.Position;
892 Index := 0;
893 if Assigned(LineStationDown) then Index := Track.Points.IndexOf(LineStationDown.TrackPoint) + 1
894 else if Assigned(LineStationUp) then Index := Track.Points.IndexOf(LineStationUp.TrackPoint);
895 Track.Points.Insert(Index, NewTrackPoint);
896 NewLineStation.TrackPoint := NewTrackPoint;
897
898 if Assigned(LineStationDown) then
899 Track.RouteTrack(NewLineStation.TrackPoint.GetDown, NewLineStation.TrackPoint);
900 if Assigned(LineStationUp) then
901 Track.RouteTrack(NewLineStation.TrackPoint, NewLineStation.TrackPoint.GetUp);
902
903 // Place one train if at least two stations present
904 if (LineStations.Count = 2) then begin
905 Train := Engine.Trains.GetUnused;
906 if Assigned(Train) then begin
907 Train.Line := Self;
908 Train.TargetStation := LineStations[0];
909 Train.TrackPosition.BaseTrackPoint := Track.Points.First;
910 Trains.Add(Train);
911 end;
912 end;
913 UpdateEndingLines;
914 Engine.ComputeShapeDistance;
915 Engine.ShiftTrackPoints;
916end;
917
918procedure TMetroLine.DisconnectStation(ALineStation: TLineStation);
919var
920 I: Integer;
921 J: Integer;
922 Index: Integer;
923 TP1, TP2: TTrackPoint;
924 IsOnTrack: Boolean;
925begin
926 // Determine track point range to be removed
927 TP1 := ALineStation.TrackPoint.GetDown;
928 if not Assigned(TP1) then TP1 := Track.Points.First;
929 TP2 := ALineStation.TrackPoint.GetUp;
930 if not Assigned(TP2) then TP2 := Track.Points.Last;
931
932 // Remove track points from trains
933 for I := 0 to Trains.Count - 1 do
934 with TMetroTrain(Trains[I]) do begin
935 IsOnTrack := False;
936 for J := Track.Points.IndexOf(TP1) to Track.Points.IndexOf(TP2) do
937 if Track.Points[J] = TrackPosition.BaseTrackPoint then begin
938 IsOnTrack := True;
939 Break;
940 end;
941 if IsOnTrack then begin
942 if Assigned(TrackPosition.BaseTrackPoint) and Assigned(TrackPosition.BaseTrackPoint.GetUp) and
943 (TrackPosition.BaseTrackPoint.GetUp <> ALineStation.TrackPoint) then
944 TrackPosition.BaseTrackPoint := TrackPosition.BaseTrackPoint.GetUp
945 else
946 if Assigned(TrackPosition.BaseTrackPoint) and Assigned(TrackPosition.BaseTrackPoint.GetDown) and
947 (TrackPosition.BaseTrackPoint.GetDown <> ALineStation.TrackPoint) then
948 TrackPosition.BaseTrackPoint := TrackPosition.BaseTrackPoint.GetDown
949 else TrackPosition.BaseTrackPoint := nil;
950 end;
951 end;
952
953 // Delete old trackpoints
954 Index := Track.Points.IndexOf(ALineStation.TrackPoint) - 1;
955 while (Index >= 0) and (not Assigned(Track.Points[Index].OwnerPoint)) do begin
956 Track.Points.Delete(Index);
957 Dec(Index);
958 end;
959 Index := Index + 1;
960 Track.Points.Delete(Index);
961 while (Index < Track.Points.Count) and (not Assigned(Track.Points[Index].OwnerPoint)) do
962 Track.Points.Delete(Index);
963
964 if ((Index - 1) >= 0) and (Index < Track.Points.Count) then
965 Track.RouteTrack(Track.Points[Index - 1], Track.Points[Index]);
966
967 ALineStation.MapStation.Lines.Remove(Self);
968 Index := LineStations.IndexOf(ALineStation);
969
970 for I := 0 to Trains.Count - 1 do
971 with Trains[I] do begin
972 if TargetStation = ALineStation then
973 TargetStation := LineStations[(Index + 1) mod LineStations.Count];
974 end;
975
976 LineStations.Delete(Index);
977
978 // Remove all trains if less then two stations
979 if LineStations.Count < 2 then
980 for I := Trains.Count - 1 downto 0 do begin
981 Trains[I].Line := nil;
982 Trains.Delete(I);
983 end;
984 UpdateEndingLines;
985 Engine.ComputeShapeDistance;
986 Engine.ShiftTrackPoints;
987end;
988
989constructor TMetroLine.Create;
990begin
991 LineStations := TLineStations.Create;
992 LineStations.OwnsObjects := True;
993 LineStations.Line := Self;
994 Trains := TMetroTrains.Create;
995 Trains.OwnsObjects := False;
996 Track := TTrack.Create;
997 Track.Owner := Self;
998end;
999
1000destructor TMetroLine.Destroy;
1001begin
1002 FreeAndNil(Trains);
1003 FreeAndNil(LineStations);
1004 FreeAndNil(Track);
1005 inherited;
1006end;
1007
1008function TMetroLine.IsCircular: Boolean;
1009begin
1010 Result := False;
1011 if LineStations.Count >= 2 then
1012 Result := (LineStations.Last.MapStation = LineStations.First.MapStation);
1013end;
1014
1015class function TMetroLine.GetClassSysName: string;
1016begin
1017 Result := 'Line';
1018end;
1019
1020procedure TMetroLine.LoadFromXmlNode(Node: TDOMNode);
1021var
1022 Node2: TDOMNode;
1023 I: Integer;
1024begin
1025 inherited;
1026 Color := TColor(ReadInteger(Node, 'Color', Color));
1027 Index := TColor(ReadInteger(Node, 'Index', Index));
1028
1029 Node2 := Node.FindNode(DOMString(TTrack.GetClassSysName));
1030 if Assigned(Node2) then
1031 Track.LoadFromXmlNode(Node2);
1032
1033 Node2 := Node.FindNode(DOMString(TLineStations.GetClassSysName));
1034 if Assigned(Node2) then
1035 LineStations.LoadFromXmlNode(Node2);
1036 for I := 0 to LineStations.Count - 1 do
1037 LineStations[I].MapStation.Lines.Add(Self);
1038end;
1039
1040procedure TMetroLine.SaveToXmlNode(Node: TDOMNode);
1041var
1042 Node2: TDOMNode;
1043begin
1044 inherited;
1045 WriteInteger(Node, 'Color', Color);
1046 WriteInteger(Node, 'Index', Index);
1047
1048 LineStations.RebuildItemsId;
1049
1050 Node2 := Node.OwnerDocument.CreateElement(DOMString(TTrack.GetClassSysName));
1051 Node.AppendChild(Node2);
1052 Track.SaveToXmlNode(Node2);
1053
1054 Node2 := Node.OwnerDocument.CreateElement(DOMString(TLineStations.GetClassSysName));
1055 Node.AppendChild(Node2);
1056 LineStations.SaveToXmlNode(Node2);
1057end;
1058
1059{ TMetroTrain }
1060
1061procedure TMetroTrain.SetLine(AValue: TMetroLine);
1062begin
1063 if FLine = AValue then Exit;
1064 FLine := AValue;
1065 if AValue = nil then begin
1066 TrackPosition.RelPos := 0;
1067 TrackPosition.BaseTrackPoint := nil;
1068 TargetStation := nil;
1069 end;
1070end;
1071
1072class function TMetroTrain.GetClassSysName: string;
1073begin
1074 Result := 'Train';
1075end;
1076
1077procedure TMetroTrain.LoadFromXmlNode(Node: TDOMNode);
1078var
1079 Node2: TDOMNode;
1080 I: Integer;
1081begin
1082 inherited;
1083 Line := Engine.Lines.FindById(ReadInteger(Node, 'Line', 0));
1084 Direction := ReadInteger(Node, 'Direction', Direction);
1085 if Assigned(Line) then begin
1086 Line.Trains.Add(Self);
1087 TargetStation := Line.LineStations.FindById(ReadInteger(Node, 'TargetStation', 0));
1088 TrackPosition.LoadFromXmlNode(Node, Line.Track.Points);
1089 end;
1090
1091 Node2 := Node.FindNode(DOMString(TMetroPassengers.GetClassSysName));
1092 if Assigned(Node2) then
1093 Passengers.LoadFromXmlNodeRef(Node2, Engine.Passengers);
1094
1095 Node2 := Node.FindNode(DOMString(TMetroCarriages.GetClassSysName));
1096 if Assigned(Node2) then
1097 Carriages.LoadFromXmlNodeRef(Node2, Engine.Carriages);
1098 for I := 0 to Carriages.Count - 1 do
1099 Carriages[I].Train := Self;
1100end;
1101
1102procedure TMetroTrain.SaveToXmlNode(Node: TDOMNode);
1103var
1104 NewNode: TDOMNode;
1105begin
1106 inherited;
1107 if Assigned(Line) then WriteInteger(Node, 'Line', Line.Id)
1108 else WriteInteger(Node, 'Line', 0);
1109 WriteInteger(Node, 'Direction', Direction);
1110 if Assigned(TargetStation) then WriteInteger(Node, 'TargetStation', TargetStation.Id)
1111 else WriteInteger(Node, 'TargetStation', 0);
1112 TrackPosition.SaveToXmlNode(Node);
1113
1114 NewNode := Node.OwnerDocument.CreateElement(DOMString(TMetroPassengers.GetClassSysName));
1115 Node.AppendChild(NewNode);
1116 Passengers.SaveToXmlNodeRef(NewNode);
1117
1118 NewNode := Node.OwnerDocument.CreateElement(DOMString(TMetroCarriages.GetClassSysName));
1119 Node.AppendChild(NewNode);
1120 Carriages.SaveToXmlNodeRef(NewNode);
1121end;
1122
1123procedure TMetroTrain.FindTargetStation;
1124var
1125 TP: TTrackPoint;
1126begin
1127 if Direction > 0 then begin
1128 TP := TrackPosition.BaseTrackPoint.GetUp;
1129 if Assigned(TP) then begin
1130 TargetStation := TLineStation(TP.OwnerPoint);
1131 end else begin
1132 TP := TrackPosition.BaseTrackPoint.GetDown;
1133 if Assigned(TP) then
1134 TargetStation := TLineStation(TP.OwnerPoint);
1135 end;
1136 end else
1137 if Direction < 0 then begin
1138 if Assigned(TrackPosition.BaseTrackPoint.OwnerPoint) then
1139 TargetStation := TLineStation(TrackPosition.BaseTrackPoint.OwnerPoint)
1140 else begin
1141 TP := TrackPosition.BaseTrackPoint.GetUp;
1142 if Assigned(TP) then
1143 TargetStation := TLineStation(TP.OwnerPoint);
1144 end;
1145 end;
1146 LastPosDelta := Abs(GetTargetStationDistance);
1147end;
1148
1149function TMetroTrain.GetTargetStationDistance: Integer;
1150var
1151 Current: Integer;
1152 Target: Integer;
1153 I: Integer;
1154begin
1155 Result := 0;
1156 if Assigned(TrackPosition.BaseTrackPoint) and Assigned(TargetStation) then begin
1157 Current := Line.Track.Points.IndexOf(TrackPosition.BaseTrackPoint);
1158 Target := Line.Track.Points.IndexOf(TargetStation.TrackPoint);
1159 if Current < Target then begin
1160 for I := Current to Target - 1 do
1161 Result := Result + Line.Track.Points[I].GetDistance;
1162 Result := Result - Trunc(TrackPosition.RelPos);
1163 end else
1164 if Current > Target then begin
1165 for I := Current - 1 downto Target do
1166 Result := Result + Line.Track.Points[I].GetDistance;
1167 Result := Result + Trunc(TrackPosition.RelPos);
1168 end else Result := Trunc(TrackPosition.RelPos);
1169 end;
1170end;
1171
1172constructor TMetroTrain.Create;
1173begin
1174 Passengers := TMetroPassengers.Create;
1175 Passengers.OwnsObjects := False;
1176 Carriages := TMetroCarriages.Create;
1177 Carriages.OwnsObjects := False;
1178 Direction := 1;
1179 Line := nil;
1180end;
1181
1182destructor TMetroTrain.Destroy;
1183begin
1184 FreeAndNil(Passengers);
1185 FreeAndNil(Carriages);
1186 inherited;
1187end;
1188
1189{ TMapStation }
1190
1191procedure TMapStation.ShiftTrackPoints;
1192var
1193 TrackLinks: TTrackLinks;
1194 I: Integer;
1195 J: Integer;
1196 Index: Integer;
1197 TP: TTrackPoint;
1198 LS: TLineStation;
1199 Line: TMetroLine;
1200 Angle: Float;
1201 TPAngleGroup: TTrackPointsAngleGroup;
1202 GroupItem: TTrackPointsAngle;
1203 NewTrackLink: TTrackLink;
1204 HAngle: Double;
1205 P1, P2: TPoint;
1206 NewShift: TPoint;
1207begin
1208 TrackLinks := TTrackLinks.Create;
1209 TrackLinks.OwnsObjects := False;
1210
1211 // Collect all near track points as track links
1212 SortLines;
1213 for I := 0 to Lines.Count - 1 do begin
1214 Line := Lines[I];
1215 LS := Line.LineStations.SearchMapStation(Self);
1216 TP := LS.TrackPoint;
1217 Index := Line.Track.Points.IndexOf(TP);
1218 if Index > 0 then begin
1219 NewTrackLink := Line.Track.Points[Index].GetLinkDown;
1220 TrackLinks.Add(NewTrackLink);
1221 end;
1222 if Index < (Line.Track.Points.Count - 1) then begin
1223 NewTrackLink := Line.Track.Points[Index].GetLinkUp;
1224 TrackLinks.Add(NewTrackLink);
1225 end;
1226 if Line.IsCircular and (Self = Line.LineStations.First.MapStation) and
1227 (Self = Line.LineStations.Last.MapStation) then begin
1228 LS := Line.LineStations.Last;
1229 TP := LS.TrackPoint;
1230 Index := Line.Track.Points.IndexOf(TP);
1231 if Index > 0 then begin
1232 NewTrackLink := Line.Track.Points[Index].GetLinkDown;
1233 TrackLinks.Add(NewTrackLink);
1234 end;
1235 if Index < (Line.Track.Points.Count - 1) then begin
1236 NewTrackLink := Line.Track.Points[Index].GetLinkUp;
1237 TrackLinks.Add(NewTrackLink);
1238 end;
1239 end;
1240 end;
1241
1242 // Make groups of TrackLinks with same angle
1243 TPAngleGroup := TTrackPointsAngleGroup.Create;
1244 for I := 0 to TrackLinks.Count - 1 do begin
1245 P1 := TrackLinks[I].Points[0].PositionDesigned;
1246 P2 := TrackLinks[I].Points[1].PositionDesigned;
1247 if ComparePoint(P1, Position) and not ComparePoint(P2, Position) then begin
1248 Angle := ArcTan2(P2.Y - Position.Y, P2.X - Position.X);
1249 end else
1250 if ComparePoint(P2, Position) and not ComparePoint(P1, Position) then begin
1251 Angle := ArcTan2(P1.Y - Position.Y, P1.X - Position.X);
1252 end else Angle := 0;// else raise Exception.Create('TrackLink angle error');
1253
1254 GroupItem := TPAngleGroup.SearchAngle(Angle);
1255 if not Assigned(GroupItem) then begin
1256 GroupItem := TTrackPointsAngle.Create;
1257 GroupItem.Angle := Angle;
1258 TPAngleGroup.Add(GroupItem);
1259 end;
1260 GroupItem.TrackLinks.Add(TrackLinks[I]);
1261 end;
1262
1263 // Shift TrackLinks according number of lines in group
1264 for I := 0 to TPAngleGroup.Count - 1 do
1265 with TPAngleGroup[I] do begin
1266 for J := 0 to TrackLinks.Count - 1 do
1267 with TrackLinks[J] do begin
1268 // Get orthogonal angle
1269 HAngle := (Angle + Pi / 2) mod Pi;
1270 NewShift.X := Trunc(Engine.GetMetroLineThickness * Cos(HAngle) * (J - (TrackLinks.Count - 1) / 2));
1271 NewShift.Y := Trunc(Engine.GetMetroLineThickness * Sin(HAngle) * (J - (TrackLinks.Count - 1) / 2));
1272 Shift := NewShift;
1273 end;
1274 end;
1275
1276 FreeAndNil(TPAngleGroup);
1277 FreeAndNil(TrackLinks);
1278end;
1279
1280function MapStationCompareLine(constref Item1, Item2: TMetroLine): Integer;
1281begin
1282 if Item1.Index > Item2.Index then Result := 1
1283 else if Item1.Index < Item2.Index then Result := -1
1284 else Result := 0;
1285end;
1286
1287procedure TMapStation.SortLines;
1288begin
1289 Lines.Sort(TComparer<TMetroLine>.Construct(MapStationCompareLine));
1290end;
1291
1292function TMapStation.GetMaxPassengers: Integer;
1293begin
1294 if IsTerminal then Result := MaxWaitingPassengersTerminal
1295 else Result := MaxWaitingPassengers;
1296end;
1297
1298function TMapStation.IsBestStationForShape(DestinationIndex: TDestinationIndex;
1299 Check, Current: TLineStation): Boolean;
1300var
1301 I: Integer;
1302 T: Integer;
1303 Distance: Integer;
1304 StationIndex: Integer;
1305 DirectionUp: Boolean;
1306 DirectionDown: Boolean;
1307 NextStationUp: TLineStation;
1308 NextStationDown: TLineStation;
1309 CurrentLineStation: TLineStation;
1310begin
1311 Distance := High(Integer);
1312 for I := 0 to Lines.Count - 1 do
1313 with Lines[I] do begin
1314 CurrentLineStation := LineStations.SearchMapStation(Current.MapStation);
1315 StationIndex := LineStations.IndexOf(CurrentLineStation);
1316 if IsCircular then begin
1317 DirectionUp := False;
1318 DirectionDown := False;
1319 for T := 0 to Trains.Count - 1 do begin
1320 if Trains[T].Direction = 1 then DirectionUp := True;
1321 if Trains[T].Direction = -1 then DirectionDown := True;
1322 end;
1323 if StationIndex = 0 then
1324 NextStationDown := LineStations[LineStations.Count - 2]
1325 else
1326 if StationIndex > 0 then
1327 NextStationDown := LineStations[StationIndex - 1];
1328
1329 if (StationIndex >= 0) and (StationIndex = LineStations.Count - 1) then
1330 NextStationUp := LineStations[1]
1331 else
1332 if (StationIndex >= 0) and (StationIndex < LineStations.Count - 1) then
1333 NextStationUp := LineStations[StationIndex + 1];
1334 end else begin
1335 if StationIndex > 0 then begin
1336 DirectionDown := True;
1337 NextStationDown := LineStations[StationIndex - 1]
1338 end else DirectionDown := False;
1339 if (StationIndex >= 0) and (StationIndex < LineStations.Count - 1) then begin
1340 DirectionUp := True;
1341 NextStationUp := LineStations[StationIndex + 1];
1342 end else DirectionUp := False;
1343 end;
1344 if DirectionDown and (NextStationDown.MapStation.DestinationDistance[DestinationIndex] <> -1) and
1345 (NextStationDown.MapStation.DestinationDistance[DestinationIndex] < Distance) then begin
1346 Distance := NextStationDown.MapStation.DestinationDistance[DestinationIndex];
1347 end;
1348 if DirectionUp and (NextStationUp.MapStation.DestinationDistance[DestinationIndex] <> -1) and
1349 (NextStationUp.MapStation.DestinationDistance[DestinationIndex] < Distance) then begin
1350 Distance := NextStationUp.MapStation.DestinationDistance[DestinationIndex];
1351 end;
1352 end;
1353 Result := (Check.MapStation.DestinationDistance[DestinationIndex] <> -1) and
1354 (Check.MapStation.DestinationDistance[DestinationIndex] <= Distance);
1355end;
1356
1357class function TMapStation.GetClassSysName: string;
1358begin
1359 Result := 'MapStation';
1360end;
1361
1362procedure TMapStation.LoadFromXmlNode(Node: TDOMNode);
1363var
1364 Node2: TDOMNode;
1365begin
1366 inherited;
1367 Position.X := ReadInteger(Node, 'PositionX', Position.X);
1368 Position.Y := ReadInteger(Node, 'PositionY', Position.Y);
1369 DestinationIndex := ReadInteger(Node, 'DestinationIndex', Integer(DestinationIndex));
1370 IsTerminal := ReadBoolean(Node, 'IsTerminal', IsTerminal);
1371 OverloadDuration := ReadDateTime(Node, 'OverloadDuration', OverloadDuration);
1372
1373 Node2 := Node.FindNode(DOMString(TMetroPassengers.GetClassSysName));
1374 if Assigned(Node2) then
1375 Passengers.LoadFromXmlNodeRef(Node2, Engine.Passengers);
1376end;
1377
1378procedure TMapStation.SaveToXmlNode(Node: TDOMNode);
1379var
1380 NewNode: TDOMNode;
1381begin
1382 inherited;
1383 WriteInteger(Node, 'PositionX', Position.X);
1384 WriteInteger(Node, 'PositionY', Position.Y);
1385 WriteInteger(Node, 'DestinationIndex', DestinationIndex);
1386 WriteBoolean(Node, 'IsTerminal', IsTerminal);
1387 WriteDateTime(Node, 'OverloadDuration', OverloadDuration);
1388
1389 NewNode := Node.OwnerDocument.CreateElement(DOMString(TMetroPassengers.GetClassSysName));
1390 Node.AppendChild(NewNode);
1391 Passengers.SaveToXmlNodeRef(NewNode);
1392end;
1393
1394constructor TMapStation.Create;
1395begin
1396 Passengers := TMetroPassengers.Create;
1397 Passengers.OwnsObjects := False;
1398 Lines := TMetroLines.Create;
1399 Lines.OwnsObjects := False;
1400 SetLength(DestinationDistance, Integer(High(TDestinationShape)) + 1);
1401end;
1402
1403destructor TMapStation.Destroy;
1404begin
1405 FreeAndNil(Lines);
1406 FreeAndNil(Passengers);
1407 inherited;
1408end;
1409
1410{ TEngine }
1411
1412// Need to see all stations on screen
1413procedure TEngine.ResizeView(Force: Boolean);
1414var
1415 NewPoint: TPoint;
1416 Intersected: TRect;
1417 NewView: TView;
1418begin
1419 NewView := TView.Create;
1420 NewView.Assign(View);
1421
1422 NewView.SourceRect := RectEnlarge(Stations.GetRect, 100);
1423 NewPoint := Point(
1424 Trunc((NewView.SourceRect.Left + (NewView.SourceRect.Right - NewView.SourceRect.Left) / 2) -
1425 (NewView.DestRect.Left + (NewView.DestRect.Right - NewView.DestRect.Left) / 2 / NewView.Zoom)),
1426 Trunc((NewView.SourceRect.Top + (NewView.SourceRect.Bottom - NewView.SourceRect.Top) / 2) -
1427 (NewView.DestRect.Top + (NewView.DestRect.Bottom - NewView.DestRect.Top) / 2 / NewView.Zoom)));
1428 NewView.SourceRect := Bounds(NewPoint.X, NewPoint.Y, Trunc((NewView.DestRect.Right - NewView.DestRect.Left) / NewView.Zoom),
1429 Trunc((NewView.DestRect.Bottom - NewView.DestRect.Top) / NewView.Zoom));
1430
1431 Intersected := NewView.SourceRect;
1432 Intersected.Union(View.SourceRect);
1433 if not Force and (Intersected = View.SourceRect) then Exit;
1434
1435 View.Assign(NewView);
1436
1437 NewView.Free;
1438end;
1439
1440function TEngine.GetMetroLineThickness: Integer;
1441begin
1442 case VisualStyle of
1443 vsLondon: Result := MetroLineThickness;
1444 vsPrague: Result := Round(3 * MetroLineThickness);
1445 end;
1446end;
1447
1448function TEngine.GetServedDaysCount: Integer;
1449begin
1450 Result := Trunc(Time);
1451end;
1452
1453function TEngine.GetExistStationDestinationIndex(
1454 DestinationIndex: TDestinationIndex): Boolean;
1455var
1456 Station: TMapStation;
1457begin
1458 Result := False;
1459 for Station in Stations do
1460 if Station.DestinationIndex = DestinationIndex then
1461 Result := True;
1462end;
1463
1464function TEngine.GetStationOnPos(Pos: TPoint): TMapStation;
1465var
1466 I: Integer;
1467const
1468 ClickDistance = 30;
1469begin
1470 I := 0;
1471 while (I < Stations.Count) and (Distance(Stations[I].Position, Pos) > ClickDistance) do Inc(I);
1472 if I < Stations.Count then Result := Stations[I]
1473 else Result := nil;
1474end;
1475
1476function TEngine.GetTrackOnPos(Pos: TPoint; out Intersect: TPoint): TTrackLink;
1477var
1478 I: Integer;
1479 T: Integer;
1480 D: Integer;
1481 MinD: Integer;
1482 TempIntersect: TPoint;
1483begin
1484 Result := nil;
1485 I := 0;
1486 MinD := High(Integer);
1487 while (I < Lines.Count) do
1488 with TMetroLine(Lines[I]) do begin
1489 for T := 1 to Track.Points.Count - 1 do begin
1490 D := PointToLineDistance(Pos, Track.Points[T - 1].Position, Track.Points[T].Position,
1491 TempIntersect);
1492 if (D < MinD) and (D < TrackClickDistance) then begin
1493 MinD := D;
1494 if not Assigned(Result) then
1495 Result := TTrackLink.Create;
1496 Result.Points.Add(Track.Points[T - 1]);
1497 Result.Points.Add(Track.Points[T]);
1498 Intersect := TempIntersect;
1499 end;
1500 end;
1501 Inc(I);
1502 end;
1503end;
1504
1505function TEngine.GetTrainOnPos(Pos: TPoint): TMetroTrain;
1506var
1507 I: Integer;
1508 MinDistance: Integer;
1509 D: Integer;
1510begin
1511 Result := nil;
1512 MinDistance := High(Integer);
1513 for I := 0 to Trains.Count - 1 do
1514 with TMetroTrain(Trains[I]) do begin
1515 D := Distance(TrackPosition.GetVector.Position, Pos);
1516 if (D < (TrainSize div 2)) and (D < MinDistance) then begin
1517 Result := Trains[I];
1518 MinDistance := D;
1519 end;
1520 end;
1521end;
1522
1523function TEngine.GetCarriageOnPos(Pos: TPoint): TMetroCarriage;
1524var
1525 I: Integer;
1526 J: Integer;
1527 MinDistance: Integer;
1528 D: Integer;
1529begin
1530 Result := nil;
1531 MinDistance := High(Integer);
1532 for I := 0 to Trains.Count - 1 do
1533 with TMetroTrain(Trains[I]) do begin
1534 for J := 0 to Carriages.Count - 1 do
1535 with TMetroCarriage(Carriages[J]) do begin
1536 D := Distance(GetTrackPosition.GetVector.Position, Pos);
1537 if (D < (TrainSize div 2)) and (D < MinDistance) then begin
1538 Result := Carriages[J];
1539 MinDistance := D;
1540 end;
1541 end;
1542 end;
1543end;
1544
1545procedure TEngine.DrawFrame(Canvas: TCanvas; Rect: TRect);
1546begin
1547 with Canvas do begin
1548 Pen.Color := Self.Colors.Text;
1549 Pen.Style := psSolid;
1550 Pen.Width := ScaleX(2, 96);
1551 Brush.Color := Self.Colors.Background2;
1552 Brush.Style := bsSolid;
1553 Rectangle(Rect);
1554 Pen.Style := psClear;
1555 end;
1556end;
1557
1558procedure TEngine.DrawLine(Canvas: TCanvas; Pos: TPoint);
1559var
1560 Delta: TPoint;
1561begin
1562 Delta := Point(Pos.X - Canvas.PenPos.X, Pos.Y - Canvas.PenPos.Y);
1563 if Abs(Delta.X) > Abs(Delta.Y) then begin
1564 Canvas.LineTo(Pos.X - Sign(Delta.X) * Abs(Delta.Y), Canvas.PenPos.Y);
1565 end else begin
1566 Canvas.LineTo(Canvas.PenPos.X, Pos.Y - Sign(Delta.Y) * Abs(Delta.X));
1567 end;
1568 Canvas.LineTo(Pos.X, Pos.Y);
1569end;
1570
1571procedure TEngine.DrawShape(Canvas: TCanvas; Position: TPoint; Shape: TDestinationShape;
1572 Size: Integer; Angle: Double);
1573var
1574 Points: array of TPoint;
1575 I: Integer;
1576 Angle2: Double;
1577begin
1578 case Shape of
1579 ssSquare: begin
1580 Points := nil;
1581 SetLength(Points, 4);
1582 Points[0] := Point(Position.X - Size div 2, Position.Y - Size div 2);
1583 Points[1] := Point(Position.X + Size div 2, Position.Y - Size div 2);
1584 Points[2] := Point(Position.X + Size div 2, Position.Y + Size div 2);
1585 Points[3] := Point(Position.X - Size div 2, Position.Y + Size div 2);
1586 Points := RotatePoints(Position, Points, Angle);
1587 Canvas.Polygon(Points);
1588 end;
1589 ssCircle: Canvas.Ellipse(
1590 Position.X - Size div 2, Position.Y - Size div 2,
1591 Position.X + Size div 2, Position.Y + Size div 2);
1592 ssTriangle: begin
1593 SetLength(Points, 3);
1594 Points[0] := Point(Position.X, Position.Y - Size div 2);
1595 Points[1] := Point(Position.X + Size div 2, Position.Y + Size div 2);
1596 Points[2] := Point(Position.X - Size div 2, Position.Y + Size div 2);
1597 Points := RotatePoints(Position, Points, Angle);
1598 Canvas.Polygon(Points);
1599 end;
1600 ssStar: begin
1601 SetLength(Points, 10);
1602 for I := 0 to 9 do begin
1603 Angle2 := I / 10 * 2 * Pi - Pi / 2;
1604 if (I mod 2) = 0 then
1605 Points[I] := Point(Round(Position.X + Cos(Angle2) * Size / 2),
1606 Round(Position.Y + Sin(Angle2) * Size / 2))
1607 else
1608 Points[I] := Point(Round(Position.X + Cos(Angle2) * Size / 5),
1609 Round(Position.Y + Sin(Angle2) * Size / 5));
1610 end;
1611 Points := RotatePoints(Position, Points, Angle);
1612 Canvas.Polygon(Points);
1613 end;
1614 ssPlus: begin
1615 SetLength(Points, 12);
1616 Points[0] := Point(Position.X + Size div 6, Position.Y - Size div 6);
1617 Points[1] := Point(Position.X + Size div 2, Position.Y - Size div 6);
1618 Points[2] := Point(Position.X + Size div 2, Position.Y + Size div 6);
1619 Points[3] := Point(Position.X + Size div 6, Position.Y + Size div 6);
1620 Points[4] := Point(Position.X + Size div 6, Position.Y + Size div 2);
1621 Points[5] := Point(Position.X - Size div 6, Position.Y + Size div 2);
1622 Points[6] := Point(Position.X - Size div 6, Position.Y + Size div 6);
1623 Points[7] := Point(Position.X - Size div 2, Position.Y + Size div 6);
1624 Points[8] := Point(Position.X - Size div 2, Position.Y - Size div 6);
1625 Points[9] := Point(Position.X - Size div 6, Position.Y - Size div 6);
1626 Points[10] := Point(Position.X - Size div 6, Position.Y - Size div 2);
1627 Points[11] := Point(Position.X + Size div 6, Position.Y - Size div 2);
1628 Points := RotatePoints(Position, Points, Angle);
1629 Canvas.Polygon(Points);
1630 end;
1631 ssPentagon: begin
1632 SetLength(Points, 5);
1633 for I := 0 to 4 do begin
1634 Angle2 := I / 5 * 2 * Pi - Pi / 2;
1635 Points[I] := Point(Round(Position.X + Cos(Angle2) * Size / 2),
1636 Round(Position.Y + Sin(Angle2) * Size / 2));
1637 end;
1638 Points := RotatePoints(Position, Points, Angle);
1639 Canvas.Polygon(Points);
1640 end;
1641 ssHexagon: begin
1642 SetLength(Points, 6);
1643 for I := 0 to 5 do begin
1644 Angle2 := I / 6 * 2 * Pi - Pi / 2;
1645 Points[I] := Point(Round(Position.X + Cos(Angle2) * Size / 2),
1646 Round(Position.Y + Sin(Angle2) * Size / 2));
1647 end;
1648 Points := RotatePoints(Position, Points, Angle);
1649 Canvas.Polygon(Points);
1650 end;
1651 ssDiamond: begin
1652 SetLength(Points, 4);
1653 Points[0] := Point(Position.X, Position.Y - Size div 2);
1654 Points[1] := Point(Position.X + Size div 2, Position.Y);
1655 Points[2] := Point(Position.X, Position.Y + Size div 2);
1656 Points[3] := Point(Position.X - Size div 2, Position.Y);
1657 Points := RotatePoints(Position, Points, Angle);
1658 Canvas.Polygon(Points);
1659 end;
1660 ssCross: begin
1661 SetLength(Points, 12);
1662 Points[0] := Point(Position.X + Size div 6, Position.Y - Size div 6);
1663 Points[1] := Point(Position.X + Size div 2, Position.Y - Size div 6);
1664 Points[2] := Point(Position.X + Size div 2, Position.Y + Size div 6);
1665 Points[3] := Point(Position.X + Size div 6, Position.Y + Size div 6);
1666 Points[4] := Point(Position.X + Size div 6, Position.Y + Size div 2);
1667 Points[5] := Point(Position.X - Size div 6, Position.Y + Size div 2);
1668 Points[6] := Point(Position.X - Size div 6, Position.Y + Size div 6);
1669 Points[7] := Point(Position.X - Size div 2, Position.Y + Size div 6);
1670 Points[8] := Point(Position.X - Size div 2, Position.Y - Size div 6);
1671 Points[9] := Point(Position.X - Size div 6, Position.Y - Size div 6);
1672 Points[10] := Point(Position.X - Size div 6, Position.Y - Size div 2);
1673 Points[11] := Point(Position.X + Size div 6, Position.Y - Size div 2);
1674 Points := RotatePoints(Position, Points, Angle + Pi / 4);
1675 Canvas.Polygon(Points);
1676 end;
1677 ssHalfCircle: Canvas.Pie(
1678 Position.X - Size div 2, Position.Y - Size div 2,
1679 Position.X + Size div 2, Position.Y + Size div 2,
1680 Position.X - Size div 2, Position.Y,
1681 Position.X + Size div 2, Position.Y);
1682 ssQuarterCircle: Canvas.Pie(
1683 Position.X - Size div 2 - Size, Position.Y - Size div 2,
1684 Position.X + Size div 2, Position.Y + Size div 2 + Size,
1685 Position.X + Size div 2, Position.Y + Size div 2,
1686 Position.X - Size div 2, Position.Y - Size div 2);
1687 ssHeptagon: begin
1688 SetLength(Points, 8);
1689 for I := 0 to High(Points) do begin
1690 Angle2 := I / Length(Points) * 2 * Pi - Pi / 2;
1691 Points[I] := Point(Round(Position.X + Cos(Angle2) * Size / 2),
1692 Round(Position.Y + Sin(Angle2) * Size / 2));
1693 end;
1694 Points := RotatePoints(Position, Points, Angle);
1695 Canvas.Polygon(Points);
1696 end;
1697 end;
1698end;
1699
1700procedure TEngine.ComputeShapeDistance;
1701var
1702 S: TDestinationIndex;
1703 Station: TMapStation;
1704begin
1705 // Reset all distances
1706 for Station in Stations do
1707 with Station do begin
1708 for S := Low(DestinationDistance) to High(DestinationDistance) do
1709 DestinationDistance[S] := -1;
1710 end;
1711
1712 // Propagate shape distance for all stations
1713 // Distace 0 means that station is final target
1714 for Station in Stations do
1715 with Station do begin
1716 ComputeDestinationIndexDistanceStation(Station, DestinationIndex, 0);
1717 end;
1718end;
1719
1720procedure TEngine.ComputeDestinationIndexDistanceStation(Station: TMapStation;
1721 UpdatedDestinationIndex: TDestinationIndex; Distance: Integer);
1722var
1723 I: Integer;
1724 T: Integer;
1725 StationIndex: Integer;
1726 DirectionDown: Boolean;
1727 DirectionUp: Boolean;
1728begin
1729 with Station do begin
1730 if (Distance < DestinationDistance[UpdatedDestinationIndex]) or (DestinationDistance[UpdatedDestinationIndex] = -1) then begin
1731 DestinationDistance[UpdatedDestinationIndex] := Distance;
1732 // Do for all lines connected to station
1733 for I := 0 to Lines.Count - 1 do
1734 with Lines[I] do
1735 for StationIndex := 0 to LineStations.Count - 1 do
1736 if LineStations[StationIndex].MapStation = Station then begin
1737 if not IsCircular then begin
1738 // Update for all adjecent stations
1739 if StationIndex > 0 then
1740 ComputeDestinationIndexDistanceStation(LineStations[StationIndex - 1].MapStation,
1741 UpdatedDestinationIndex, Station.DestinationDistance[UpdatedDestinationIndex] + 1);
1742 if (StationIndex >= 0) and (StationIndex < LineStations.Count - 1) then
1743 ComputeDestinationIndexDistanceStation(LineStations[StationIndex + 1].MapStation,
1744 UpdatedDestinationIndex, Station.DestinationDistance[UpdatedDestinationIndex] + 1);
1745 end else begin
1746 // If circular then trains might go in single direction so passengers
1747 // waiting for opposite directions are wrong
1748 DirectionUp := False;
1749 DirectionDown := False;
1750 for T := 0 to Trains.Count - 1 do begin
1751 if Trains[T].Direction = 1 then DirectionUp := True;
1752 if Trains[T].Direction = -1 then DirectionDown := True;
1753 end;
1754
1755 // Update for all adjecent stations
1756 if DirectionUp then begin
1757 if StationIndex = 0 then
1758 ComputeDestinationIndexDistanceStation(LineStations[LineStations.Count - 2].MapStation,
1759 UpdatedDestinationIndex, Station.DestinationDistance[UpdatedDestinationIndex] + 1);
1760 if StationIndex > 0 then
1761 ComputeDestinationIndexDistanceStation(LineStations[StationIndex - 1].MapStation,
1762 UpdatedDestinationIndex, Station.DestinationDistance[UpdatedDestinationIndex] + 1);
1763 end;
1764 if DirectionDown then begin
1765 if (StationIndex >= 0) and (StationIndex = LineStations.Count - 1) then
1766 ComputeDestinationIndexDistanceStation(LineStations[1].MapStation,
1767 UpdatedDestinationIndex, Station.DestinationDistance[UpdatedDestinationIndex] + 1);
1768 if (StationIndex >= 0) and (StationIndex < LineStations.Count - 1) then
1769 ComputeDestinationIndexDistanceStation(LineStations[StationIndex + 1].MapStation,
1770 UpdatedDestinationIndex, Station.DestinationDistance[UpdatedDestinationIndex] + 1);
1771 end;
1772 end;
1773 end;
1774 end;
1775 end;
1776end;
1777
1778procedure TEngine.SetDarkMode(AValue: Boolean);
1779begin
1780 if FDarkMode = AValue then Exit;
1781 FDarkMode := AValue;
1782 Colors.Init(FDarkMode);
1783 if Assigned(FOnDarkModeChange) then FOnDarkModeChange(Self);
1784end;
1785
1786procedure TEngine.SetFullScreen(AValue: Boolean);
1787begin
1788 if FFullScreen = AValue then Exit;
1789 FFullScreen := AValue;
1790 if Assigned(FOnFullScreenChange) then
1791 FOnFullScreenChange(Self, FFullScreen);
1792end;
1793
1794procedure TEngine.SetState(AValue: TGameState);
1795begin
1796 if FState = AValue then Exit;
1797 FState := AValue;
1798 UpdateInterface;
1799end;
1800
1801procedure TEngine.TrainsMovement;
1802var
1803 I: Integer;
1804begin
1805 for I := 0 to Trains.Count - 1 do
1806 TrainMovement(Trains[I]);
1807end;
1808
1809procedure TEngine.TrainMovement(Train: TMetroTrain);
1810var
1811 J: Integer;
1812 CurrentStation: TLineStation;
1813 P: Integer;
1814 Passenger: TMetroPassenger;
1815 PosDelta: Integer;
1816 TargetStationIndex: Integer;
1817 PosChange: Double;
1818 Done: Boolean;
1819begin
1820 with Train do begin
1821 if Assigned(Line) then begin
1822 if InStation then begin
1823 if (Time - StationStopTime) > OneHour then begin
1824 CurrentStation := TargetStation;
1825
1826 // Choose next target station
1827 TargetStationIndex := Line.LineStations.IndexOf(TargetStation) + Direction;
1828 if TargetStationIndex < 0 then begin
1829 if Line.IsCircular then begin
1830 TargetStationIndex := Line.LineStations.Count - 2;
1831 TrackPosition.BaseTrackPoint := Line.LineStations.Last.TrackPoint;
1832 TrackPosition.RelPos := 0;
1833 end else begin
1834 TargetStationIndex := 1;
1835 Direction := -Direction;
1836 end;
1837 end else
1838 if TargetStationIndex >= Line.LineStations.Count then begin
1839 if Line.IsCircular then begin
1840 TargetStationIndex := 1;
1841 TrackPosition.BaseTrackPoint := Line.LineStations.First.TrackPoint;
1842 TrackPosition.RelPos := 0;
1843 end else begin
1844 TargetStationIndex := Line.LineStations.Count - 2;
1845 Direction := -Direction;
1846 end;
1847 end;
1848 TargetStation := Line.LineStations[TargetStationIndex];
1849
1850 // Unload passengers in target station
1851 if Assigned(CurrentStation) then begin
1852 for P := Passengers.Count - 1 downto 0 do begin
1853 if Passengers[P].DestinationIndex = CurrentStation.MapStation.DestinationIndex then begin
1854 Passenger := Passengers[P];
1855 Passengers.Delete(P);
1856 Self.Passengers.Remove(Passenger);
1857 Inc(ServedPassengerCount);
1858 end;
1859 end;
1860 for J := 0 to Carriages.Count - 1 do
1861 with Carriages[J] do begin
1862 for P := Passengers.Count - 1 downto 0 do begin
1863 if Passengers[P].DestinationIndex = CurrentStation.MapStation.DestinationIndex then begin
1864 Passenger := Passengers[P];
1865 Passengers.Delete(P);
1866 Self.Passengers.Remove(Passenger);
1867 Inc(ServedPassengerCount);
1868 end;
1869 end;
1870 end;
1871 end;
1872
1873 // Unload passengers to change line
1874 if Assigned(CurrentStation) then begin
1875 for P := Passengers.Count - 1 downto 0 do begin
1876 if not CurrentStation.MapStation.IsBestStationForShape(Passengers[P].DestinationIndex,
1877 TargetStation, CurrentStation) then begin
1878 Passenger := Passengers[P];
1879 Passengers.Delete(P);
1880 CurrentStation.MapStation.Passengers.Add(Passenger);
1881 end;
1882 end;
1883 for J := 0 to Carriages.Count - 1 do
1884 with Carriages[J] do begin
1885 for P := Passengers.Count - 1 downto 0 do begin
1886 if not CurrentStation.MapStation.IsBestStationForShape(Passengers[P].DestinationIndex,
1887 TargetStation, CurrentStation) then begin
1888 Passenger := Passengers[P];
1889 Passengers.Delete(P);
1890 CurrentStation.MapStation.Passengers.Add(Passenger);
1891 end;
1892 end;
1893 end;
1894 end;
1895
1896 // Load new passengers
1897 if Assigned(CurrentStation) and not Assigned(CurrentStation.MapStation) then
1898 raise Exception.Create(SStationWithoutMapStation);
1899 if Assigned(CurrentStation) then
1900 for P := CurrentStation.MapStation.Passengers.Count - 1 downto 0 do begin
1901 if (Passengers.Count < TrainPassengerCount) then begin
1902 Passenger := CurrentStation.MapStation.Passengers[P];
1903 if CurrentStation.MapStation.IsBestStationForShape(Passenger.DestinationIndex,
1904 TargetStation, CurrentStation) then begin
1905 CurrentStation.MapStation.Passengers.Delete(P);
1906 Passengers.Add(Passenger);
1907 end;
1908 end else begin
1909 Done := False;
1910 for J := 0 to Carriages.Count - 1 do
1911 with Carriages[J] do begin
1912 if (Passengers.Count < TrainPassengerCount) then begin
1913 Passenger := CurrentStation.MapStation.Passengers[P];
1914 if CurrentStation.MapStation.IsBestStationForShape(Passenger.DestinationIndex,
1915 TargetStation, CurrentStation) then begin
1916 CurrentStation.MapStation.Passengers.Delete(P);
1917 Passengers.Add(Passenger);
1918 Done := True;
1919 Break;
1920 end;
1921 end;
1922 end;
1923 if not Done then Break;
1924 end;
1925 end;
1926
1927 LastPosDelta := Abs(GetTargetStationDistance);
1928 InStation := False;
1929 LastTrainMoveTime := Time;
1930 end;
1931 end else begin
1932 PosChange := Direction + Trunc(Direction * TrainSpeed * (Time - LastTrainMoveTime));
1933 LastTrainMoveTime := Time;
1934 Redraw;
1935 if Assigned(TrackPosition.BaseTrackPoint) then
1936 TrackPosition.Move(PosChange);
1937
1938 if Assigned(TargetStation) then begin
1939 PosDelta := Abs(GetTargetStationDistance);
1940 if PosDelta >= LastPosDelta then begin
1941 // We are getting far from station, stop at station
1942 TrackPosition.BaseTrackPoint := TargetStation.TrackPoint;
1943 TrackPosition.RelPos := 0;
1944 InStation := True;
1945 StationStopTime := Time;
1946 Redraw;
1947 end;
1948 end;
1949 LastPosDelta := PosDelta;
1950 end;
1951 end;
1952 end;
1953end;
1954
1955function TEngine.GetUnusedLine: TMetroLine;
1956var
1957 I: Integer;
1958begin
1959 I := 0;
1960 while (I < Lines.Count) and (Lines[I].Track.Points.Count > 0) do Inc(I);
1961 if I < Lines.Count then Result := Lines[I]
1962 else Result := nil;
1963end;
1964
1965procedure TEngine.ShiftTrackPoints;
1966var
1967 I: Integer;
1968 J: Integer;
1969 //Link1, Link2: TPoint;
1970 NewPoint: TPoint;
1971 MetroLine: TMetroLine;
1972 TrackPoint: TTrackPoint;
1973 MapStation: TMapStation;
1974begin
1975 // Reset all trackpoints position shift
1976 for MetroLine in Lines do
1977 MetroLine.Track.Points.ResetToDesignatedPosition;
1978
1979 // Calculate new position shifts
1980 for MapStation in Stations do
1981 MapStation.ShiftTrackPoints;
1982
1983 // Compute track points from track shift
1984 for MetroLine in Lines do
1985 with MetroLine, Track do begin
1986 // Update start
1987 if Points.Count > 1 then begin
1988 if not Assigned(Points[0].LinkUp) then Points[0].GetLinkUp;
1989 Points[0].Position := Points[0].PositionDesigned + Points[0].LinkUp.Shift;
1990 end;
1991
1992 for I := 1 to Points.Count - 1 do
1993 with TTrackPoint(Points[I]) do
1994 if Assigned(Points[I].LinkDown) and Assigned(Points[I].LinkUp) then begin
1995 {
1996 Link1 := (Track.Points[I].PositionDesigned + Track.Points[I].LinkDown.Shift) -
1997 (Track.Points[I - 1].PositionDesigned + Track.Points[I].LinkDown.Shift);
1998 if (I + 1) < Track.Points.Count then
1999 Link2 := (Track.Points[I + 1].PositionDesigned + Track.Points[I].LinkUp.Shift) -
2000 (Track.Points[I].PositionDesigned + Track.Points[I].LinkUp.Shift)
2001 else Link2 := Link1;
2002
2003 if ArcTanPoint(Link1) = ArcTanPoint(Link2) then begin
2004 // Parallel lines
2005 NewPoint := Track.Points[I].PositionDesigned + Track.Points[I].LinkDown.Shift;
2006 Track.Points[I].Position := NewPoint;
2007 end else begin}
2008 // Intersected lines
2009 if LineIntersect(Points[I - 1].PositionDesigned + Points[I].LinkDown.Shift,
2010 Points[I].PositionDesigned + Points[I].LinkDown.Shift,
2011 Points[I].PositionDesigned + Points[I].LinkUp.Shift,
2012 Points[I + 1].PositionDesigned + Points[I].LinkUp.Shift, NewPoint) then
2013 begin
2014 Points[I].Position := NewPoint;
2015 end else begin
2016 // Parallel lines
2017 NewPoint := Points[I].PositionDesigned + Points[I].LinkDown.Shift;
2018 Points[I].Position := NewPoint;
2019 end;
2020// end;
2021
2022 // Update ending
2023 if Points.Count > 1 then begin
2024 if not Assigned(Points[Points.Count - 1].LinkDown) then
2025 Points[Points.Count - 1].GetLinkDown;
2026 Points[Points.Count - 1].Position := Points[Points.Count - 1].PositionDesigned -
2027 Points[Points.Count - 1].LinkDown.Shift;
2028 end;
2029 end;
2030
2031 // Update ending
2032 if Points.Count > 1 then begin
2033 if not Assigned(Points[Points.Count - 1].LinkDown) then
2034 Points[Points.Count - 1].GetLinkDown;
2035 Points[Points.Count - 1].Position := Points[Points.Count - 1].PositionDesigned -
2036 Points[Points.Count - 1].LinkDown.Shift;
2037 end;
2038 end;
2039
2040 // Remove all temporal links
2041 for MetroLine in Lines do
2042 with MetroLine, Track do begin
2043 for J := 0 to Points.Count - 1 do
2044 if Assigned(Points[J].LinkUp) then begin
2045 Points[J].LinkUp.Free;
2046 Points[J].LinkUp := nil;
2047 Points[J + 1].LinkDown := nil;
2048 end;
2049 end;
2050end;
2051
2052procedure TEngine.MenuItemExit(Sender: TObject);
2053begin
2054 if Assigned(FOnExit) then FOnExit(Self);
2055end;
2056
2057procedure TEngine.MenuItemCity(Sender: TObject);
2058begin
2059 if Sender is TMenuItemButton then begin;
2060 City := TCity(TMenuItemButton(Sender).Ref);
2061 NewGame;
2062 end;
2063end;
2064
2065procedure TEngine.MenuItemPlay(Sender: TObject);
2066begin
2067 City := nil;
2068 NewGame;
2069end;
2070
2071procedure TEngine.MenuItemCareer(Sender: TObject);
2072var
2073 City: TCity;
2074begin
2075 MenuCareer.Parent := MenuMain;
2076 with MenuCareer, Items do begin
2077 Clear;
2078 for City in Cities do
2079 with AddButton(City.Name, MenuItemCity) do begin
2080 Ref := City;
2081 Enabled := not City.Locked;
2082 TextSize := 40;
2083 TextColor := Colors.MenuItemText;
2084 TextDisabledColor := Colors.MenuItemDisabledText;
2085 BackgroundColor := Colors.MenuItemBackground;
2086 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2087 end;
2088 with AddButton(SBack, MenuItemBack) do begin
2089 TextSize := 40;
2090 TextColor := Colors.MenuItemText;
2091 TextDisabledColor := Colors.MenuItemDisabledText;
2092 BackgroundColor := Colors.MenuItemBackground;
2093 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2094 end;
2095 OnExit := MenuItemBack;
2096 end;
2097
2098 Menu := MenuCareer;
2099 Redraw;
2100end;
2101
2102procedure TEngine.MenuItemOptions(Sender: TObject);
2103var
2104 VisualStyleIndex: TVisualStyle;
2105 StationStyleIndex: TStationStyle;
2106begin
2107 MenuOptions.Parent := MenuMain;
2108 with MenuOptions, Items do begin
2109 Clear;
2110 with AddComboBox(SLanguage, [], LanguageChanged) do begin
2111 TextSize := 40;
2112 TextColor := Colors.MenuItemText;
2113 TextDisabledColor := Colors.MenuItemDisabledText;
2114 BackgroundColor := Colors.MenuItemBackground;
2115 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2116 if Assigned(Translator) then begin
2117 Translator.LanguageListToStrings(States);
2118 Index := States.IndexOfObject(Translator.Language);
2119 end;
2120 if Index = -1 then Index := 0;
2121 end;
2122 with AddCheckBox(SDarkMode, DarkModeChanged) do begin
2123 TextSize := 40;
2124 TextColor := Colors.MenuItemText;
2125 TextDisabledColor := Colors.MenuItemDisabledText;
2126 BackgroundColor := Colors.MenuItemBackground;
2127 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2128 Checked := DarkMode;
2129 end;
2130 with AddCheckBox(SFullScreen, FullScreenChanged) do begin
2131 TextSize := 40;
2132 TextColor := Colors.MenuItemText;
2133 TextDisabledColor := Colors.MenuItemDisabledText;
2134 BackgroundColor := Colors.MenuItemBackground;
2135 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2136 Checked := FullScreen;
2137 end;
2138 with AddComboBox(SVisualStyle, [], VisualStyleChanged) do begin
2139 TextSize := 40;
2140 TextColor := Colors.MenuItemText;
2141 TextDisabledColor := Colors.MenuItemDisabledText;
2142 BackgroundColor := Colors.MenuItemBackground;
2143 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2144 for VisualStyleIndex := Low(TVisualStyle) to High(TVisualStyle) do
2145 States.AddObject(VisualStyleText[VisualStyleIndex], TObject(VisualStyleIndex));
2146 Index := States.IndexOfObject(TObject(VisualStyle));
2147 if Index = -1 then Index := 0;
2148 end;
2149 with AddComboBox(SStationStyle, [], StationStyleChanged) do begin
2150 TextSize := 40;
2151 TextColor := Colors.MenuItemText;
2152 TextDisabledColor := Colors.MenuItemDisabledText;
2153 BackgroundColor := Colors.MenuItemBackground;
2154 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2155 for StationStyleIndex := Low(TStationStyle) to High(TStationStyle) do
2156 States.AddObject(StationStyleText[StationStyleIndex], TObject(StationStyleIndex));
2157 Index := States.IndexOfObject(TObject(StationStyle));
2158 if Index = -1 then Index := 0;
2159 end;
2160 with AddCheckBox(SMovableTrack, MovableTrackChanged) do begin
2161 TextSize := 40;
2162 TextColor := Colors.MenuItemText;
2163 TextDisabledColor := Colors.MenuItemDisabledText;
2164 BackgroundColor := Colors.MenuItemBackground;
2165 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2166 Checked := MovableTracks;
2167 end;
2168 with AddButton(SBack, MenuItemBack) do begin
2169 TextSize := 40;
2170 TextColor := Colors.MenuItemText;
2171 TextDisabledColor := Colors.MenuItemDisabledText;
2172 BackgroundColor := Colors.MenuItemBackground;
2173 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2174 end;
2175 OnExit := MenuItemBack;
2176 end;
2177
2178 Menu := MenuOptions;
2179 Redraw;
2180end;
2181
2182procedure TEngine.MenuItemCustomGame(Sender: TObject);
2183begin
2184 MenuCustomGame.Parent := MenuMain;
2185 with MenuCustomGame, Items do begin
2186 Clear;
2187 with AddButton(SPlay, MenuItemCustomPlay) do begin
2188 TextSize := 40;
2189 TextColor := Colors.MenuItemText;
2190 TextDisabledColor := Colors.MenuItemDisabledText;
2191 BackgroundColor := Colors.MenuItemBackground;
2192 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2193 end;
2194 with AddButton(SBack, MenuItemBack) do begin
2195 TextSize := 40;
2196 TextColor := Colors.MenuItemText;
2197 TextDisabledColor := Colors.MenuItemDisabledText;
2198 BackgroundColor := Colors.MenuItemBackground;
2199 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2200 end;
2201 OnExit := MenuItemBack;
2202 end;
2203
2204 Menu := MenuCustomGame;
2205 Redraw;
2206end;
2207
2208procedure TEngine.MenuItemCustomPlay(Sender: TObject);
2209begin
2210 City := nil;
2211 NewGame;
2212end;
2213
2214procedure TEngine.MenuItemBack(Sender: TObject);
2215begin
2216 if Assigned(Menu.Parent) then begin
2217 Menu := Menu.Parent;
2218 Redraw;
2219 end else MenuItemExit(nil);
2220end;
2221
2222procedure TEngine.ButtonPlay(Sender: TObject);
2223begin
2224 TimePerSecond := TimePerSecondNormal;
2225 if State = gsPaused then State := gsRunning;
2226 UpdateInterface;
2227end;
2228
2229procedure TEngine.ButtonPause(Sender: TObject);
2230begin
2231 if State = gsRunning then State := gsPaused;
2232 UpdateInterface;
2233end;
2234
2235procedure TEngine.ButtonFastForward(Sender: TObject);
2236begin
2237 TimePerSecond := TimePerSecondFast;
2238 if State = gsPaused then State := gsRunning;
2239 UpdateInterface;
2240end;
2241
2242procedure TEngine.ButtonNewTrain(Sender: TObject);
2243var
2244 Improvements: TList<TMetroImprovement>;
2245 Improvement: TMetroImprovement;
2246 Index: Integer;
2247begin
2248 Trains.AddItem;
2249 State := gsNewImprovement;
2250 if Lines.Count <= (High(LineColors) - Low(LineColors)) then
2251 AvailableImprovements := AvailableImprovements + [miLine]
2252 else AvailableImprovements := AvailableImprovements - [miLine];
2253
2254 // Select offered improvements
2255 Improvements := TList<TMetroImprovement>.Create;
2256 try
2257 for Improvement := Low(TMetroImprovement) to High(TMetroImprovement) do
2258 if Improvement in AvailableImprovements then begin
2259 Improvements.Add(Improvement);
2260 end;
2261
2262 Index := Random(Integer(Improvements.Count));
2263 Improvement1 := Improvements[Index];
2264 Improvements.Delete(Index);
2265
2266 if Improvements.Count > 0 then begin
2267 Index := Random(Integer(Improvements.Count));
2268 Improvement2 := Improvements[Index];
2269 end else Improvement2 := miNone;
2270
2271 if Improvement1 <> miNone then
2272 ImageNewImprovement1.Bitmap.Assign(GetImprovementBitmap(Improvement1));
2273 ImageNewImprovement1.Enabled := Improvement1 <> miNone;
2274
2275 if Improvement2 <> miNone then
2276 ImageNewImprovement2.Bitmap.Assign(GetImprovementBitmap(Improvement2));
2277 ImageNewImprovement2.Enabled := Improvement2 <> miNone;
2278 finally
2279 Improvements.Free;
2280 end;
2281 Redraw;
2282end;
2283
2284procedure TEngine.ButtonNewImprovement1(Sender: TObject);
2285begin
2286 EvaluateImprovement(Improvement1);
2287 State := gsRunning;
2288 Redraw;
2289end;
2290
2291procedure TEngine.ButtonNewImprovement2(Sender: TObject);
2292begin
2293 EvaluateImprovement(Improvement2);
2294 State := gsRunning;
2295 Redraw;
2296end;
2297
2298procedure TEngine.MenuItemGameContinue(Sender: TObject);
2299begin
2300 State := LastState;
2301 Redraw;
2302end;
2303
2304procedure TEngine.MenuItemGameExit(Sender: TObject);
2305begin
2306 AutoSave;
2307 State := gsMenu;
2308 LastState := gsNotStarted;
2309 Clear;
2310 Menu := MenuMain;
2311 Redraw;
2312end;
2313
2314procedure TEngine.MenuItemGameRestart(Sender: TObject);
2315begin
2316 NewGame;
2317end;
2318
2319procedure TEngine.MenuItemGameLoad(Sender: TObject);
2320begin
2321 ReloadGameSlots(False);
2322 Menu := MenuGameSlots;
2323end;
2324
2325procedure TEngine.MenuItemGameSave(Sender: TObject);
2326begin
2327 ReloadGameSlots(True);
2328 Menu := MenuGameSlots;
2329end;
2330
2331procedure TEngine.MenuItemGameSlotLoad(Sender: TObject);
2332begin
2333 LoadFromFile(GetGameSlotFileName(Integer(TMenuItemButton(Sender).Ref)));
2334 if State in [gsMenu] then State := gsRunning;
2335 Redraw;
2336end;
2337
2338procedure TEngine.MenuItemGameSlotSave(Sender: TObject);
2339begin
2340 SaveToFile(GetGameSlotFileName(Integer(TMenuItemButton(Sender).Ref)));
2341 State := LastState;
2342end;
2343
2344procedure TEngine.DarkModeChanged(Sender: TObject);
2345begin
2346 DarkMode := TMenuItemCheckBox(Sender).Checked;
2347 InitMenus;
2348end;
2349
2350procedure TEngine.LanguageChanged(Sender: TObject);
2351var
2352 NewLanguage: TLanguage;
2353begin
2354 NewLanguage := TLanguage(TMenuItemComboBox(Sender).States.Objects[TMenuItemComboBox(Sender).Index]);
2355 if Assigned(Translator) and (Translator.Language <> NewLanguage) then begin
2356 Translator.Language := NewLanguage;
2357 Translator.Translate;
2358 InitMenus;
2359
2360 // Recreate cities with translated names
2361 SaveToRegistry;
2362 InitCities;
2363 LoadFromRegistry;
2364 end;
2365end;
2366
2367procedure TEngine.FullScreenChanged(Sender: TObject);
2368begin
2369 FullScreen := TMenuItemCheckBox(Sender).Checked;
2370end;
2371
2372procedure TEngine.MovableTrackChanged(Sender: TObject);
2373begin
2374 MovableTracks := TMenuItemCheckBox(Sender).Checked;
2375end;
2376
2377procedure TEngine.StationStyleChanged(Sender: TObject);
2378begin
2379 StationStyle := TStationStyle(TMenuItemComboBox(Sender).States.Objects[TMenuItemComboBox(Sender).Index]);
2380end;
2381
2382procedure TEngine.VisualStyleChanged(Sender: TObject);
2383begin
2384 VisualStyle := TVisualStyle(TMenuItemComboBox(Sender).States.Objects[TMenuItemComboBox(Sender).Index]);
2385end;
2386
2387procedure TEngine.UpdateInterface;
2388begin
2389 ImagePlay.Enabled := not ((State = gsRunning) and (TimePerSecond = TimePerSecondNormal));
2390 ImageFastForward.Enabled := not ((State = gsRunning) and (TimePerSecond = TimePerSecondFast));
2391 ImagePause.Enabled := FState = gsRunning; //not (State = gsPaused);
2392end;
2393
2394procedure TEngine.InitCities;
2395var
2396 I: Integer;
2397begin
2398 with Cities do begin
2399 Clear;
2400 with AddNew('Prague', SPrague, 1275406) do begin
2401 LineColors := [clRed, clGreen, clYellow];
2402 InitialLineCount := 1;
2403 PassengersCountToUnlock := 300;
2404 end;
2405 with AddNew('Paris', SParis, 2138551) do begin
2406 LineColors := [clRed, clGreen, clYellow, clBlue, clBrown, clOrange,
2407 clPurple, clOlive, clAqua, clDarkYellow, clPink];
2408 InitialLineCount := 1;
2409 PassengersCountToUnlock := 500;
2410 end;
2411 with AddNew('Rome', SRome, 2872800) do begin
2412 LineColors := [clRed, clGreen, clYellow];
2413 InitialLineCount := 1;
2414 PassengersCountToUnlock := 700;
2415 end;
2416 with AddNew('NewYork', SNewYork, 8804190) do begin
2417 InitialLineCount := 1;
2418 PassengersCountToUnlock := 1000;
2419 end;
2420 with AddNew('London', SLondon, 9002488) do begin
2421 InitialLineCount := 3;
2422 PassengersCountToUnlock := 1500;
2423 end;
2424 with AddNew('Seoul', SSeoul, 10197604) do begin
2425 InitialLineCount := 3;
2426 LineColors := [clRed, clGreen, clYellow, clOrange, clGray,
2427 clPink, clCyan, clMoneyGreen, clPurple, clSkyBlue];
2428 PassengersCountToUnlock := 2000;
2429 end;
2430 with AddNew('Tokyo', STokyo, 13960236) do begin
2431 InitialLineCount := 3;
2432 PassengersCountToUnlock := 2500;
2433 end;
2434 with AddNew('Beijing', SBeijing, 21893095) do begin
2435 InitialLineCount := 3;
2436 LineColors := [clRed, clGreen, clYellow, clOrange, clOlive, clGray,
2437 clPink, clCyan, clMoneyGreen, clPurple, clSkyBlue, clBrown];
2438 PassengersCountToUnlock := 3000;
2439 end;
2440 end;
2441 for I := 1 to Cities.Count - 1 do
2442 Cities[I].Locked := True;
2443end;
2444
2445function TEngine.GetImprovementText(Improvement: TMetroImprovement): string;
2446begin
2447 case Improvement of
2448 miCarriage: Result := SCarriage;
2449 miTerminal: Result := STerminal;
2450 miTunnel: Result := STunnel;
2451 miLine: Result := SLine;
2452 end;
2453end;
2454
2455function TEngine.GetImprovementBitmap(Improvement: TMetroImprovement): TBitmap;
2456begin
2457 case Improvement of
2458 miCarriage: Result := ImageCarriage.Bitmap;
2459 miTerminal: Result := ImageTerminal.Bitmap;
2460 miTunnel: Result := ImageTunnel.Bitmap;
2461 miLine: Result := ImageLine.Bitmap;
2462 end;
2463end;
2464
2465procedure TEngine.EvaluateImprovement(Improvement: TMetroImprovement);
2466begin
2467 case Improvement of
2468 miLine: Lines.AddNew(LineColors[Lines.Count]);
2469 miCarriage: Carriages.AddItem;
2470 //miTunnel: Tunnels.AddNew;
2471 miTerminal: Inc(AvailableTerminals);
2472 end;
2473end;
2474
2475procedure TEngine.ReloadGameSlots(Save: Boolean);
2476var
2477 I: Integer;
2478 Action: TNotifyEvent;
2479 FileName: string;
2480 FileDateTime: TDateTime;
2481 ControlName: string;
2482const
2483 GameSlotCount = 5;
2484begin
2485 with MenuGameSlots, Items do begin
2486 Clear;
2487 Parent := Menu;
2488 if Save then Action := MenuItemGameSlotSave
2489 else Action := MenuItemGameSlotLoad;
2490 for I := 0 to GameSlotCount do begin
2491 FileName := GetGameSlotFileName(Integer(I));
2492 if I = 0 then ControlName := SAutoSave
2493 else ControlName := SSlot + ' ' + IntToStr(I);
2494 if FileExists(FileName) then begin
2495 FileAge(FileName, FileDateTime);
2496 ControlName := ControlName + ' (' + DateTimeToStr(FileDateTime) + ')';
2497 end;
2498 with AddButton(ControlName, Action) do begin
2499 Ref := TObject(I);
2500 Enabled := FileExists(FileName) or (Save and (I > 0));
2501 TextSize := 40;
2502 TextColor := Colors.MenuItemText;
2503 TextDisabledColor := Colors.MenuItemDisabledText;
2504 BackgroundColor := Colors.MenuItemBackground;
2505 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2506 end;
2507 end;
2508 with AddButton(SExit, MenuItemBack) do begin
2509 TextSize := 40;
2510 TextColor := Colors.MenuItemText;
2511 TextDisabledColor := Colors.MenuItemDisabledText;
2512 BackgroundColor := Colors.MenuItemBackground;
2513 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2514 end;
2515 OnExit := MenuItemBack;
2516 end;
2517end;
2518
2519function TEngine.GetGameSlotFileName(Index: Integer): string;
2520begin
2521 Result := GetAppConfigDir(False) + 'Saved game ' + IntToStr(Index) + TransLinesExt;
2522end;
2523
2524procedure TEngine.AutoSave;
2525begin
2526 if (State = gsNotStarted) or ((State = gsMenu) and (LastState = gsNotStarted)) then Exit;
2527 SaveToFile(GetGameSlotFileName(0));
2528end;
2529
2530procedure TEngine.CheckScore;
2531begin
2532 OldHighestServedDaysCount := HighestServedDaysCount;
2533 OldHighestServedPassengerCount := HighestServedPassengerCount;
2534
2535 if (ServedPassengerCount > HighestServedPassengerCount) then begin
2536 HighestServedPassengerCount := ServedPassengerCount;
2537 HighestServedDaysCount := ServedDaysCount;
2538 end;
2539
2540 if Assigned(City) then begin
2541 if (ServedPassengerCount > City.HighestServedPassengerCount) then begin
2542 City.HighestServedPassengerCount := ServedPassengerCount;
2543 City.HighestServedDaysCount := ServedDaysCount;
2544 end;
2545 end;
2546end;
2547
2548function TEngine.DestinationIndexToText(DestinationIndex: TDestinationIndex): string;
2549begin
2550 case StationStyle of
2551 ssShapes: Result := '';
2552 ssAlpha: Result := Chr(Ord('A') + Integer(DestinationIndex));
2553 ssLinear: Result := IntToStr(1 + Integer(DestinationIndex));
2554 end;
2555end;
2556
2557function TEngine.DestinationIndexToShape(DestinationIndex: TDestinationIndex): TDestinationShape;
2558begin
2559 if StationStyle = ssShapes then Result := TDestinationShape(DestinationIndex)
2560 else Result := ssCircle;
2561end;
2562
2563function TEngine.GetSelectedOrUnusedMetroLine: TMetroLine;
2564begin
2565 if Assigned(SelectedLine) and (SelectedLine.LineStations.Count = 0) then
2566 Result := SelectedLine
2567 else Result := GetUnusedLine;
2568end;
2569
2570procedure TEngine.InitMenus;
2571begin
2572 with MenuMain, Items do begin
2573 Clear;
2574 with AddButton(STransLines, nil) do begin
2575 Enabled := False;
2576 TextSize := 60;
2577 TextColor := Colors.Text;
2578 TextDisabledColor := Colors.Text;
2579 BackgroundColor := clNone;
2580 BackgroundSelectedColor := clNone;
2581 end;
2582 with AddButton(SPlay, MenuItemPlay) do begin
2583 TextSize := 40;
2584 TextColor := Colors.MenuItemText;
2585 TextDisabledColor := Colors.MenuItemDisabledText;
2586 BackgroundColor := Colors.MenuItemBackground;
2587 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2588 end;
2589 with AddButton(SLoad, MenuItemGameLoad) do begin
2590 TextSize := 40;
2591 TextColor := Colors.MenuItemText;
2592 TextDisabledColor := Colors.MenuItemDisabledText;
2593 BackgroundColor := Colors.MenuItemBackground;
2594 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2595 end;
2596 {
2597 with AddButton(SCustomGame, MenuItemCustomGame) do begin
2598 TextSize := 40;
2599 TextColor := Colors.MenuItemText;
2600 TextDisabledColor := Colors.MenuItemDisabledText;
2601 BackgroundColor := Colors.MenuItemBackground;
2602 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2603 end;
2604 }
2605 with AddButton(SCareer, MenuItemCareer) do begin
2606 TextSize := 40;
2607 TextColor := Colors.MenuItemText;
2608 TextDisabledColor := Colors.MenuItemDisabledText;
2609 BackgroundColor := Colors.MenuItemBackground;
2610 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2611 end;
2612 with AddButton(SOptions, MenuItemOptions) do begin
2613 TextSize := 40;
2614 TextColor := Colors.MenuItemText;
2615 TextDisabledColor := Colors.MenuItemDisabledText;
2616 BackgroundColor := Colors.MenuItemBackground;
2617 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2618 end;
2619 with AddButton(SExit, MenuItemExit) do begin
2620 TextSize := 40;
2621 TextColor := Colors.MenuItemText;
2622 TextDisabledColor := Colors.MenuItemDisabledText;
2623 BackgroundColor := Colors.MenuItemBackground;
2624 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2625 end;
2626 OnExit := MenuItemExit;
2627 end;
2628
2629 with MenuGame, Items do begin
2630 Clear;
2631 with AddButton(SContinue, MenuItemGameContinue) do begin
2632 TextSize := 40;
2633 TextColor := Colors.MenuItemText;
2634 TextDisabledColor := Colors.MenuItemDisabledText;
2635 BackgroundColor := Colors.MenuItemBackground;
2636 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2637 end;
2638 with AddButton(SRestart, MenuItemGameRestart) do begin
2639 TextSize := 40;
2640 TextColor := Colors.MenuItemText;
2641 TextDisabledColor := Colors.MenuItemDisabledText;
2642 BackgroundColor := Colors.MenuItemBackground;
2643 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2644 end;
2645 with AddButton(SLoad, MenuItemGameLoad) do begin
2646 TextSize := 40;
2647 TextColor := Colors.MenuItemText;
2648 TextDisabledColor := Colors.MenuItemDisabledText;
2649 BackgroundColor := Colors.MenuItemBackground;
2650 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2651 end;
2652 with AddButton(SSave, MenuItemGameSave) do begin
2653 TextSize := 40;
2654 TextColor := Colors.MenuItemText;
2655 TextDisabledColor := Colors.MenuItemDisabledText;
2656 BackgroundColor := Colors.MenuItemBackground;
2657 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2658 end;
2659 with AddButton(SExit, MenuItemGameExit) do begin
2660 TextSize := 40;
2661 TextColor := Colors.MenuItemText;
2662 TextDisabledColor := Colors.MenuItemDisabledText;
2663 BackgroundColor := Colors.MenuItemBackground;
2664 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2665 end;
2666 OnExit := MenuItemGameContinue;
2667 end;
2668end;
2669
2670procedure TEngine.ButtonBackClick(Sender: TObject);
2671begin
2672 if State = gsSuccess then begin
2673 State := gsMenu;
2674 MenuItemCareer(Self);
2675 end else begin
2676 Menu := MenuGame;
2677 LastState := State;
2678 State := gsMenu;
2679 Redraw;
2680 end;
2681end;
2682
2683procedure TEngine.DrawClock(Canvas: TCanvas; CanvasSize: TPoint);
2684var
2685 X: Integer;
2686 Y: Integer;
2687 Text: string;
2688begin
2689 Clock.Time := Time;
2690 Clock.Canvas := Canvas;
2691 Clock.TextColor := Colors.Text;
2692 Clock.BackgroundColor := Colors.Background;
2693 Clock.Bounds := Bounds(ScaleX(15, 96), ScaleY(15, 96),
2694 ScaleX(40, 96), ScaleY(40, 96));
2695 Clock.Paint;
2696
2697 X := Clock.Bounds.Left + Clock.Bounds.Width + ScaleY(10, 96);
2698 Y := Clock.Bounds.Top;
2699
2700 Canvas.Pen.Color := Colors.Text;
2701 Canvas.Font.Color := Colors.Text;
2702 Canvas.Brush.Style := bsClear;
2703 Text := FormatDateTime('ddd', Time + 2);
2704 Canvas.TextOut(X, Y + (Clock.Bounds.Height - Canvas.TextHeight(Text)) div 2, Text);
2705 X := X + ScaleX(40, 96) + ScaleY(5, 96);
2706 Y := Clock.Bounds.Top + (Clock.Bounds.Height - ImagePause.Bounds.Height) div 2;
2707
2708 ImagePause.Canvas := Canvas;
2709 ImagePause.Bounds := Bounds(X, Y, ScaleX(20, 96), ScaleY(20, 96));
2710 ImagePause.Paint;
2711 X := X + ImagePause.Bounds.Width + ScaleX(5, 96);
2712
2713 ImagePlay.Canvas := Canvas;
2714 ImagePlay.Bounds := Bounds(X, Y, ScaleX(20, 96), ScaleY(20, 96));
2715 ImagePlay.Paint;
2716 X := X + ImagePlay.Bounds.Width + ScaleX(5, 96);
2717
2718 ImageFastForward.Canvas := Canvas;
2719 ImageFastForward.Bounds := Bounds(X, Y, ScaleX(20, 96), ScaleY(20, 96));
2720 ImageFastForward.Paint;
2721
2722 X := Clock.Bounds.Left;
2723 Y := Clock.Bounds.Top + Clock.Bounds.Height + ScaleY(5, 96);
2724
2725 Canvas.Pen.Color := Colors.Text;
2726 Canvas.Font.Color := Colors.Text;
2727 Canvas.Brush.Style := bsClear;
2728 Text := SDay + ' ' + IntToStr(Trunc(Time));
2729 Canvas.TextOut(X, Y, Text);
2730 Y := Y + Canvas.TextHeight(Text) + ScaleY(5, 96);
2731end;
2732
2733procedure TEngine.DrawTrains(Canvas: TCanvas);
2734var
2735 P: Integer;
2736 Pos: TPoint;
2737 Points: array of TPoint;
2738 Angle: Double;
2739 ShapePos: TPoint;
2740 Train: TMetroTrain;
2741 Passenger: TMetroPassenger;
2742 Carriage: TMetroCarriage;
2743 Vector: TVector;
2744 Text: string;
2745begin
2746 for Train in Trains do
2747 with Train do begin
2748 if Assigned(Line) then begin
2749 Canvas.Brush.Color := Line.Color;
2750 Canvas.Brush.Style := bsSolid;
2751 Canvas.Pen.Width := 1;
2752 case VisualStyle of
2753 vsLondon: Canvas.Pen.Style := psClear;
2754 vsPrague: begin
2755 Canvas.Pen.Style := psSolid;
2756 Canvas.Pen.Color := Colors.Text;
2757 end;
2758 end;
2759 Vector := TrackPosition.GetVector;
2760 Pos := Vector.Position;
2761 Angle := Vector.GetAngle;
2762
2763 Points := nil;
2764 SetLength(Points, 4);
2765 Points[0] := RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y - TrainSize div 3), Angle);
2766 Points[1] := RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y - TrainSize div 3), Angle);
2767 Points[2] := RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y + TrainSize div 3), Angle);
2768 Points[3] := RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y + TrainSize div 3), Angle);
2769 Canvas.Polygon(Points);
2770
2771 Canvas.Pen.Style := psClear;
2772 Canvas.Brush.Color := clWhite;
2773 P := 0;
2774 for Passenger in Passengers do
2775 with Passenger do begin
2776 ShapePos := Point(Pos.X - Trunc(TrainSize div 3 * 1) + (P mod 3) * TrainSize div 3,
2777 Pos.Y - Trunc(TrainSize div 6 * 1) + (P div 3) * TrainSize div 3);
2778 ShapePos := RotatePoint(Pos, ShapePos, Angle);
2779 if StationStyle = ssShapes then begin
2780 DrawShape(Canvas, ShapePos, DestinationIndexToShape(DestinationIndex), TrainSize div 3, Angle + Pi / 2);
2781 end else begin
2782 Text := DestinationIndexToText(DestinationIndex);
2783 if Text <> '' then begin
2784 Canvas.Brush.Style := bsClear;
2785 Canvas.Font.Color := clWhite;
2786 Canvas.Font.Size := Round(TrainSize * 0.15);
2787 Canvas.Font.Orientation := Round((-Angle / Pi * 180) * 10);
2788 Canvas.TextOut(ShapePos.X - Round(TrainSize * 0.15),
2789 ShapePos.Y - Round(TrainSize * 0.15), Text);
2790 Canvas.Font.Orientation := 0;
2791 end;
2792 end;
2793 Inc(P);
2794 end;
2795
2796 // Draw carriages
2797 for Carriage in Train.Carriages do
2798 with Carriage do begin
2799 Canvas.Brush.Color := Line.Color;
2800 Canvas.Brush.Style := bsSolid;
2801 case VisualStyle of
2802 vsLondon: Canvas.Pen.Style := psClear;
2803 vsPrague: begin
2804 Canvas.Pen.Style := psSolid;
2805 Canvas.Pen.Color := Colors.Text;
2806 end;
2807 end;
2808 Vector := GetTrackPosition.GetVector;
2809 Pos := Vector.Position;
2810 Angle := Vector.GetAngle;
2811
2812 SetLength(Points, 4);
2813 Points[0] := RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y - TrainSize div 3), Angle);
2814 Points[1] := RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y - TrainSize div 3), Angle);
2815 Points[2] := RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y + TrainSize div 3), Angle);
2816 Points[3] := RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y + TrainSize div 3), Angle);
2817 Canvas.Polygon(Points);
2818
2819 Canvas.Pen.Style := psClear;
2820 Canvas.Brush.Color := clWhite;
2821 P := 0;
2822 for Passenger in Passengers do
2823 with Passenger do begin
2824 ShapePos := Point(Pos.X - Trunc(TrainSize div 3 * 1) + (P mod 3) * TrainSize div 3,
2825 Pos.Y - Trunc(TrainSize div 6 * 1) + (P div 3) * TrainSize div 3);
2826 ShapePos := RotatePoint(Pos, ShapePos, Angle);
2827 if StationStyle = ssShapes then begin
2828 DrawShape(Canvas, ShapePos, DestinationIndexToShape(DestinationIndex), TrainSize div 3, Angle + Pi / 2);
2829 end else begin
2830 Text := DestinationIndexToText(DestinationIndex);
2831 if Text <> '' then begin
2832 Canvas.Brush.Style := bsClear;
2833 Canvas.Font.Color := clWhite;
2834 Canvas.Font.Size := Round(TrainSize * 0.15);
2835 Canvas.Font.Orientation := Round((-Angle / Pi * 180) * 10);
2836 Canvas.TextOut(ShapePos.X - Round(TrainSize * 0.15),
2837 ShapePos.Y - Round(TrainSize * 0.15), Text);
2838 Canvas.Font.Orientation := 0;
2839 end;
2840 end;
2841 Inc(P);
2842 end;
2843 end;
2844
2845{ // Target station links
2846 if Assigned(TargetStation) then begin
2847 Canvas.Pen.Width := 1;
2848 Canvas.Pen.Style := psSolid;
2849 Canvas.Pen.Color := Colors.MenuItemText;
2850 Canvas.MoveTo(Pos);
2851 Canvas.LineTo(TargetStation.TrackPoint.Position);
2852 end;
2853}
2854 end;
2855 end;
2856end;
2857
2858procedure TEngine.DrawGameOver(Canvas: TCanvas; CanvasSize: TPoint);
2859var
2860 Y: Integer;
2861 Text: string;
2862begin
2863 with Canvas do begin
2864 DrawFrame(Canvas, Bounds(CanvasSize.X div 8, ScaleY(90, 96),
2865 Round(CanvasSize.X / 4 * 3), ScaleY(210, 96)));
2866
2867 Canvas.Font.Color := Self.Colors.Text;
2868 Brush.Style := bsClear;
2869 Pen.Style := psClear;
2870
2871 Y := ScaleY(100, 96);
2872
2873 Font.Size := 40;
2874 Text := SGameOver;
2875 TextOut((CanvasSize.X - TextWidth(Text)) div 2, Y, Text);
2876 Y := Y + Round(TextHeight(Text) * 1.1);
2877
2878 Font.Size := 14;
2879 Text := SGameOverReason;
2880 TextOut((CanvasSize.X - TextWidth(Text)) div 2, Y, Text);
2881 Y := Y + Round(TextHeight(Text) * 1.1);
2882
2883 Text := Format(SGameOverStatistic, [ServedPassengerCount, ServedDaysCount]);
2884 TextOut((CanvasSize.X - TextWidth(Text)) div 2, Y, Text);
2885 Y := Y + Round(TextHeight(SGameOverStatistic) * 1.1);
2886
2887 Y := Y + ScaleY(16, 96);
2888
2889 DrawHighScore(Canvas, CanvasSize, Y);
2890 end;
2891end;
2892
2893procedure TEngine.DrawHighScore(Canvas: TCanvas; CanvasSize: TPoint; Y: Integer);
2894var
2895 Text: string;
2896begin
2897 with Canvas do begin
2898 Text := '';
2899 if (ServedPassengerCount >= HighestServedPassengerCount) or
2900 (ServedDaysCount >= HighestServedDaysCount) then begin
2901 Text := SNewHighScore + ' ';
2902 end;
2903 Text := Text + Format(SOldHighScore, [OldHighestServedPassengerCount,
2904 OldHighestServedDaysCount]);
2905 Canvas.TextOut((CanvasSize.X - TextWidth(Text)) div 2, Y, Text);
2906 Y := Y + Round(TextHeight(Text) * 1.1);
2907 end;
2908end;
2909
2910procedure TEngine.DrawSuccess(Canvas: TCanvas; CanvasSize: TPoint);
2911var
2912 Y: Integer;
2913 Text: string;
2914 Index: Integer;
2915begin
2916 with Canvas do begin
2917 DrawFrame(Canvas, Bounds(CanvasSize.X div 8, ScaleY(90, 96),
2918 Round(CanvasSize.X / 4 * 3), ScaleY(230, 96)));
2919
2920 Canvas.Font.Color := Self.Colors.Text;
2921 Brush.Style := bsClear;
2922 Pen.Style := psClear;
2923
2924 Y := ScaleY(100, 96);
2925
2926 Font.Size := 40;
2927 Text := SSuccess;
2928 TextOut((CanvasSize.X - TextWidth(Text)) div 2, Y, Text);
2929 Y := Y + Round(TextHeight(Text) * 1.1);
2930
2931 Font.Size := 14;
2932 Text := SSuccessReason;
2933 TextOut((CanvasSize.X - TextWidth(Text)) div 2, Y, Text);
2934 Y := Y + Round(TextHeight(Text) * 1.1);
2935
2936 // Unlock next city
2937 if Assigned(City) then begin
2938 Index := Cities.IndexOf(City);
2939 if (Index >= 0) and ((Index + 1) < Cities.Count) then begin
2940 Cities[Index + 1].Locked := False;
2941 Font.Size := 14;
2942 Text := Format(SUnlockedCity, [Cities[Index + 1].Name]);
2943 TextOut((CanvasSize.X - TextWidth(Text)) div 2, Y, Text);
2944 Y := Y + Round(TextHeight(Text) * 1.1);
2945 end;
2946 end;
2947
2948 Text := Format(SGameOverStatistic, [ServedPassengerCount, ServedDaysCount]);
2949 TextOut((CanvasSize.X - TextWidth(Text)) div 2, Y, Text);
2950 Y := Y + Round(TextHeight(SGameOverStatistic) * 1.1);
2951
2952 Y := Y + ScaleY(16, 96);
2953
2954 DrawHighScore(Canvas, CanvasSize, Y);
2955 end;
2956end;
2957
2958procedure TEngine.DrawNewWeek(Canvas: TCanvas; CanvasSize: TPoint);
2959var
2960 Text: string;
2961 TextSize: TSize;
2962 Y: Integer;
2963 X: Integer;
2964begin
2965 with Canvas do begin
2966
2967 DrawFrame(Canvas, Bounds(CanvasSize.X div 4, CanvasSize.Y div 4, CanvasSize.X div 2, CanvasSize.Y div 2));
2968 X := CanvasSize.X div 4 + ScaleX(10, 96);
2969 Y := CanvasSize.Y div 4 + ScaleX(10, 96);
2970
2971 Text := IntToStr(Week) + '. ' + SWeek;
2972 Font.Size := 30;
2973 Font.Color := Self.Colors.Text;
2974 TextSize := TextExtent(Text);
2975 TextOut(X, Y, Text);
2976 Y := Y + Round(1.1 * TextSize.Height);
2977
2978 Text := SNewTrain;
2979 Font.Size := 14;
2980 Font.Color := Self.Colors.Text;
2981 TextSize := TextExtent(Text);
2982 TextOut(X, Y, Text);
2983 Y := Y + Round(1.1 * TextSize.Height);
2984
2985 ImageNewTrain.Canvas := Canvas;
2986 ImageNewTrain.Bounds := Bounds(CanvasSize.X div 2 - ImprovementImageSize div 2,
2987 CanvasSize.Y div 2 - ImprovementImageSize div 2,
2988 ImprovementImageSize, ImprovementImageSize);
2989 ImageNewTrain.Paint;
2990
2991 Y := (CanvasSize.Y - ImprovementImageSize) div 2 +
2992 Round(ImprovementImageSize * 1.1);
2993
2994 Text := STrain;
2995 Font.Size := 20;
2996 Font.Color := Self.Colors.Text;
2997 TextSize := TextExtent(Text);
2998 TextOut((CanvasSize.X - TextSize.Width) div 2, Y, Text);
2999 end;
3000end;
3001
3002procedure TEngine.DrawNewImprovement(Canvas: TCanvas; CanvasSize: TPoint);
3003var
3004 Text: string;
3005 TextSize: TSize;
3006 Y: Integer;
3007 X: Integer;
3008 Center: TPoint;
3009begin
3010 with Canvas do begin
3011 Center := Point(CanvasSize.X div 2, CanvasSize.Y div 2);
3012
3013 DrawFrame(Canvas, Bounds(CanvasSize.X div 4, CanvasSize.Y div 4, CanvasSize.X div 2, CanvasSize.Y div 2));
3014 X := CanvasSize.X div 4 + ScaleX(10, 96);
3015 Y := CanvasSize.Y div 4 + ScaleX(10, 96);
3016
3017 Text := IntToStr(Week) + '. ' + SWeek;
3018 Font.Size := 30;
3019 Font.Color := Self.Colors.Text;
3020 TextSize := TextExtent(Text);
3021 TextOut(X, Y, Text);
3022 Y := Y + Round(1.1 * TextSize.Height);
3023
3024 Text := SNewImprovement;
3025 Font.Size := 14;
3026 Font.Color := Self.Colors.Text;
3027 TextSize := TextExtent(Text);
3028 TextOut(X, Y, Text);
3029 Y := Y + Round(1.1 * TextSize.Height);
3030
3031 if Improvement1 <> miNone then begin
3032 ImageNewImprovement1.Canvas := Canvas;
3033 ImageNewImprovement1.Bounds := Bounds(Center.X - CanvasSize.X div 8 -
3034 ImprovementImageSize div 2, Center.Y - ImprovementImageSize div 2,
3035 ImprovementImageSize, ImprovementImageSize);
3036 ImageNewImprovement1.Paint;
3037 end;
3038
3039 if Improvement2 <> miNone then begin
3040 ImageNewImprovement2.Canvas := Canvas;
3041 ImageNewImprovement2.Bounds := Bounds(Center.X + CanvasSize.X div 8 -
3042 ImprovementImageSize div 2, Center.Y - ImprovementImageSize div 2,
3043 ImprovementImageSize, ImprovementImageSize);
3044 ImageNewImprovement2.Paint;
3045 end;
3046
3047 Y := Center.Y - ImprovementImageSize div 2 +
3048 Round(ImprovementImageSize * 1.1);
3049
3050 if Improvement1 <> miNone then begin
3051 Text := GetImprovementText(Improvement1);
3052 Font.Size := 20;
3053 Font.Color := Self.Colors.Text;
3054 TextSize := TextExtent(Text);
3055 TextOut(Center.X - CanvasSize.X div 8 - TextSize.Width div 2, Y, Text);
3056 end;
3057
3058 if Improvement2 <> miNone then begin
3059 Text := GetImprovementText(Improvement2);
3060 Font.Size := 20;
3061 Font.Color := Self.Colors.Text;
3062 TextSize := TextExtent(Text);
3063 TextOut(Center.X + CanvasSize.X div 8 - TextSize.Width div 2, Y, Text);
3064 end;
3065 end;
3066end;
3067
3068procedure TEngine.DrawStationPassengerOverload(Canvas: TCanvas);
3069var
3070 MapStation: TMapStation;
3071 Angle: Real;
3072begin
3073 for MapStation in Stations do
3074 with MapStation do begin
3075 if OverloadDuration > 0 then begin
3076 Canvas.Brush.Color := clSilver;
3077 Canvas.Brush.Style := bsSolid;
3078 Canvas.Pen.Color := clSilver;
3079 Canvas.Pen.Style := psSolid;
3080 Angle := OverloadDuration / MaxPassengersOveloadTime * 2 * Pi;
3081 Canvas.Pie(Position.X - StationOverloadSize, Position.Y - StationOverloadSize,
3082 Position.X + StationOverloadSize, Position.Y + StationOverloadSize,
3083 Trunc(Position.X + StationOverloadSize * Cos(Angle)),
3084 Trunc(Position.Y + StationOverloadSize * Sin(Angle)), Position.X + StationOverloadSize, Position.Y);
3085 end;
3086 end;
3087end;
3088
3089procedure TEngine.DrawLines(Canvas: TCanvas);
3090var
3091 MetroLine: TMetroLine;
3092 I: Integer;
3093 Points: array of TPoint;
3094 Vector: TVector;
3095 HalfDownPoint: TPoint;
3096 HalfUpPoint: TPoint;
3097 Angle: Double;
3098 EndPoint: TPoint;
3099const
3100 CurveRadius: Double = 0;
3101begin
3102 for MetroLine in Lines do
3103 with MetroLine do begin
3104 Canvas.Pen.Color := Color;
3105 Canvas.Pen.Style := psSolid;
3106 Canvas.Pen.Width := GetMetroLineThickness;
3107
3108 if CurvedLines then begin
3109 Points := nil;
3110 if Track.Points.Count >= 2 then begin
3111 SetLength(Points, (Track.Points.Count - 1) * 3 - 2);
3112 for I := 1 to Track.Points.Count - 2 do begin
3113 if I = 1 then begin
3114 HalfDownPoint := Track.Points[I - 1].Position;
3115 end else
3116 if I > 0 then begin
3117 HalfDownPoint := Point((Track.Points[I].Position.X + Track.Points[I - 1].Position.X) div 2,
3118 (Track.Points[I].Position.Y + Track.Points[I - 1].Position.Y) div 2)
3119 end else begin
3120 HalfDownPoint := Track.Points[0].Position;
3121 end;
3122
3123 if I = Track.Points.Count - 2 then begin
3124 HalfUpPoint := Track.Points[I + 1].Position
3125 end else
3126 if I < Track.Points.Count - 1 then begin
3127 HalfUpPoint := Point((Track.Points[I].Position.X + Track.Points[I + 1].Position.X) div 2,
3128 (Track.Points[I].Position.Y + Track.Points[I + 1].Position.Y) div 2)
3129 end else begin
3130 HalfUpPoint := Track.Points[Track.Points.Count - 1].Position;
3131 end;
3132
3133 Points[(I - 1) * 3] := HalfDownPoint;
3134 Points[I * 3] := HalfUpPoint;
3135
3136 if (I > 0) and (I < Track.Points.Count - 1) then begin
3137 Vector := TVector.Create(HalfDownPoint, Track.Points[I].Position);
3138 Vector.SetLength(Vector.GetLength - CurveRadius);
3139 Points[(I - 1) * 3 + 1] := AddPoint(Vector.Position, Vector.Direction);
3140 end;
3141 if I < Track.Points.Count - 1 then begin
3142 Vector := TVector.Create(HalfUpPoint, Track.Points[I].Position);
3143 Vector.SetLength(Vector.GetLength - CurveRadius);
3144 Points[(I - 1) * 3 + 2] := AddPoint(Vector.Position, Vector.Direction);
3145 end;
3146 end;
3147 if Length(Points) > 1 then
3148 Canvas.PolyBezier(@Points[0], Length(Points));
3149 end;
3150 end else begin
3151 if Track.Points.Count > 0 then Canvas.MoveTo(Track.Points[0].Position);
3152 for I := 1 to Track.Points.Count - 1 do begin
3153 Canvas.LineTo(Track.Points[I].Position);
3154 end;
3155 end;
3156
3157 if VisualStyle = vsLondon then begin
3158 // Starting orthogonal line
3159 if (Track.Points.Count > 1) then begin
3160 Canvas.Pen.EndCap := pecSquare;
3161 Angle := Arctan2((Track.Points[1].Position.Y - Track.Points[0].Position.Y),
3162 (Track.Points[1].Position.X - Track.Points[0].Position.X));
3163 Canvas.MoveTo(Track.Points[1].Position);
3164 EndPoint := Point(Round(Track.Points[1].Position.X - EndStationLength * Cos(Angle)),
3165 Round(Track.Points[1].Position.Y - EndStationLength * Sin(Angle)));
3166 Canvas.LineTo(EndPoint);
3167 Canvas.MoveTo(Point(Round(EndPoint.X - Cos(Angle + Pi / 2) * EndStationWidth / 2),
3168 Round(EndPoint.Y - Sin(Angle + Pi / 2) * EndStationWidth / 2)));
3169 Canvas.LineTo(Point(Round(EndPoint.X - Cos(Angle - Pi / 2) * EndStationWidth / 2),
3170 Round(EndPoint.Y - Sin(Angle - Pi / 2) * EndStationWidth / 2)));
3171 Canvas.Pen.EndCap := pecRound;
3172 end;
3173
3174 // Ending orthogonal line
3175 if (Track.Points.Count > 1) then begin
3176 Canvas.Pen.EndCap := pecSquare;
3177 Angle := Arctan2((Track.Points[Track.Points.Count - 1].Position.Y - Track.Points[Track.Points.Count - 2].Position.Y),
3178 (Track.Points[Track.Points.Count - 1].Position.X - Track.Points[Track.Points.Count - 2].Position.X));
3179 Canvas.MoveTo(Track.Points[Track.Points.Count - 2].Position);
3180 EndPoint := Point(Round(Track.Points[Track.Points.Count - 2].Position.X + EndStationLength * Cos(Angle)),
3181 Round(Track.Points[Track.Points.Count - 2].Position.Y + EndStationLength * Sin(Angle)));
3182 Canvas.LineTo(EndPoint);
3183 Canvas.MoveTo(Point(Round(EndPoint.X + Cos(Angle + Pi / 2) * EndStationWidth / 2),
3184 Round(EndPoint.Y + Sin(Angle + Pi / 2) * EndStationWidth / 2)));
3185 Canvas.LineTo(Point(Round(EndPoint.X + Cos(Angle - Pi / 2) * EndStationWidth / 2),
3186 Round(EndPoint.Y + Sin(Angle - Pi / 2) * EndStationWidth / 2)));
3187 Canvas.Pen.EndCap := pecRound;
3188 end;
3189 end;
3190 end;
3191
3192 // Draw design time lines
3193 if Assigned(TrackStationDown) and Assigned(TrackStationDown.OwnerPoint) then begin
3194 Canvas.Pen.Color := TMetroLine(TrackStationDown.Track.Owner).Color;
3195 Canvas.MoveTo(TLineStation(TrackStationDown.OwnerPoint).TrackPoint.Position);
3196 DrawLine(Canvas, View.PointDestToSrc(LastMousePos));
3197 end;
3198 if Assigned(TrackStationUp) and Assigned(TrackStationUp.OwnerPoint) then begin
3199 Canvas.Pen.Color := TMetroLine(TrackStationUp.Track.Owner).Color;
3200 Canvas.MoveTo(TLineStation(TrackStationUp.OwnerPoint).TrackPoint.Position);
3201 DrawLine(Canvas, View.PointDestToSrc(LastMousePos));
3202 end;
3203end;
3204
3205procedure TEngine.DrawStations(Canvas: TCanvas);
3206var
3207 MapStation: TMapStation;
3208 Passenger: TMetroPassenger;
3209 PassengerPos: TPoint;
3210 Direction: Integer;
3211 UsedStationSize: Integer;
3212 Text: string;
3213begin
3214 Canvas.Pen.Width := 5;
3215 for MapStation in Stations do
3216 with MapStation do begin
3217 Canvas.Pen.Style := psSolid;
3218 if IsTerminal then UsedStationSize := Round(StationSize * 1.5)
3219 else UsedStationSize := StationSize;
3220
3221 if Assigned(SelectedLine) and (Lines.IndexOf(SelectedLine) <> -1) then begin
3222 case VisualStyle of
3223 vsLondon: begin
3224 Canvas.Brush.Style := bsClear;
3225 Canvas.Pen.Style := psSolid;
3226 Canvas.Pen.Color := SelectedLine.Color;
3227 end;
3228 vsPrague: begin
3229 Canvas.Brush.Style := bsSolid;
3230 Canvas.Brush.Color := SelectedLine.Color;
3231 Canvas.Pen.Style := psClear;
3232 Canvas.Pen.Color := Colors.Background;
3233 end;
3234 end;
3235 DrawShape(Canvas, Position, DestinationIndexToShape(Integer(DestinationIndex)),
3236 UsedStationSize + Canvas.Pen.Width + 4, 0);
3237 end;
3238
3239 case VisualStyle of
3240 vsLondon: begin
3241 Canvas.Brush.Style := bsSolid;
3242 Canvas.Brush.Color := Colors.ShapeBackground;
3243 Canvas.Pen.Color := Colors.Text;
3244 end;
3245 vsPrague: begin
3246 if Lines.Count = 0 then begin
3247 Canvas.Brush.Style := bsSolid;
3248 Canvas.Brush.Color := Colors.Background2;
3249 end else Canvas.Brush.Style := bsClear;
3250 Canvas.Pen.Style := psClear;
3251 end;
3252 end;
3253 DrawShape(Canvas, Position, DestinationIndexToShape(Integer(DestinationIndex)),
3254 UsedStationSize, 0);
3255 Text := DestinationIndexToText(Integer(DestinationIndex));
3256 if Text <> '' then begin
3257 Canvas.Brush.Style := bsClear;
3258 Canvas.Font.Size := Round(UsedStationSize * 0.4);
3259 Canvas.Font.Color := Colors.Text;
3260 Canvas.Font.Style := [fsBold];
3261 Canvas.TextOut(Position.X - Canvas.TextWidth(Text) div 2,
3262 Position.Y - Canvas.TextHeight(Text) div 2, Text);
3263 end;
3264
3265 // Draw station border
3266 if (VisualStyle = vsPrague) and (Lines.Count > 0) then begin
3267 Canvas.Brush.Style := bsClear;
3268 Canvas.Pen.Style := psSolid;
3269 Canvas.Pen.Color := Colors.Background;
3270 DrawShape(Canvas, Position, DestinationIndexToShape(Integer(DestinationIndex)),
3271 UsedStationSize + Canvas.Pen.Width + 4, 0);
3272 end;
3273
3274 // Draw passengers
3275 Canvas.Pen.Style := psClear;
3276 Canvas.Brush.Color := Colors.Text;
3277 PassengerPos := Point(0, 0);
3278 Direction := 1;
3279 for Passenger in Passengers do
3280 with Passenger do begin
3281 if StationStyle = ssShapes then begin
3282 DrawShape(Canvas, Point(Position.X + StationSize + PassengerPos.X,
3283 Position.Y - StationSize div 2 + PassengerPos.Y),
3284 DestinationIndexToShape(DestinationIndex), PassengerSize, 0);
3285 end else begin
3286 Text := DestinationIndexToText(Integer(DestinationIndex));
3287 if Text <> '' then begin
3288 Canvas.Brush.Style := bsClear;
3289 Canvas.Font.Size := Round(StationSize * 0.3);
3290 Canvas.Font.Color := Colors.Text;
3291 Canvas.Font.Style := [fsBold];
3292 Canvas.TextOut(Position.X + StationSize + PassengerPos.X - Canvas.TextWidth(Text) div 2,
3293 Position.Y - StationSize div 2 + PassengerPos.Y - Canvas.TextHeight(Text) div 2, Text);
3294 end;
3295 end;
3296 PassengerPos := Point(PassengerPos.X + Direction * (PassengerSize + 2), PassengerPos.Y);
3297 if PassengerPos.X >= (PassengerSize + 2) * VisiblePassengersPerLine then begin
3298 Direction := -Direction;
3299 PassengerPos.X := PassengerPos.X - (PassengerSize + 2);
3300 PassengerPos.Y := PassengerPos.Y + (PassengerSize + 2);
3301 end;
3302 if PassengerPos.X < 0 then begin
3303 Direction := -Direction;
3304 PassengerPos.X := 0;
3305 PassengerPos.Y := PassengerPos.Y + (PassengerSize + 2);
3306 end;
3307 end;
3308
3309{ if ShowDistances then begin
3310 Canvas.Brush.Style := bsClear;
3311 Text := '';
3312 for P := 0 to 5 do
3313 Text := Text + IntToStr(DestinationDistance[TDestinationIndex(P)]) + ',';
3314 Canvas.TextOut(Position.X + StationSize div 2, Position.Y + StationSize div 2, Text);
3315 end;
3316 }
3317 end;
3318end;
3319
3320procedure TEngine.DrawGameControls(Canvas: TCanvas; CanvasSize: TPoint);
3321var
3322 I: Integer;
3323 Text: string;
3324 Radius: Integer;
3325 X: Integer;
3326 Y: Integer;
3327 SeparatorSize: Integer;
3328begin
3329 SeparatorSize := ScaleX(20, 96);
3330 X := CanvasSize.X div 2;
3331 Y := CanvasSize.Y - LineColorsDist;
3332
3333 // Line selection
3334 Canvas.Pen.Width := 4;
3335 for I := 0 to High(LineColors) do begin
3336 if Assigned(Lines.SearchByColor(LineColors[I])) then begin
3337 Canvas.Brush.Color := LineColors[I];
3338 Radius := 15;
3339 end else begin
3340 Canvas.Brush.Color := clSilver;
3341 Radius := 5;
3342 end;
3343 Canvas.Pen.Color := Colors.Text;
3344 if Assigned(SelectedLine) and (SelectedLine.Color = LineColors[I]) then begin
3345 Canvas.Pen.Style := psSolid;
3346 end else begin
3347 Canvas.Pen.Style := psClear;
3348 end;
3349
3350 Canvas.EllipseC(X - Length(LineColors) div 2 * LineColorsDist + I * LineColorsDist,
3351 Y, Radius, Radius);
3352 end;
3353 X := X - Length(LineColors) div 2 * LineColorsDist - 2 * SeparatorSize;
3354
3355 // Draw unused trains
3356 ImageLocomotive.Bounds := Bounds(X - IconSize, Y - IconSize div 2,
3357 IconSize, IconSize);
3358 ImageLocomotive.Canvas := Canvas;
3359 ImageLocomotive.Paint;
3360 X := X - IconSize - SeparatorSize div 3;
3361
3362 Text := IntToStr(Trains.GetUnusedCount);
3363 Canvas.Brush.Style := bsClear;
3364 Canvas.Font.Size := 14;
3365 Canvas.Font.Color := Colors.Text;
3366 Canvas.TextOut(X - Canvas.TextWidth(Text),
3367 Y - Canvas.TextHeight(Text) div 2, Text);
3368 X := X - Canvas.TextWidth(Text) - SeparatorSize;
3369
3370 // Draw unused carriages
3371 if Carriages.GetUnusedCount > 0 then CarriageCountVisible := True;
3372 if CarriageCountVisible then begin
3373 Text := IntToStr(Carriages.GetUnusedCount);
3374 ImageCarriage.Bounds := Bounds(X - IconSize, Y - IconSize div 2,
3375 IconSize, IconSize);
3376 ImageCarriage.Canvas := Canvas;
3377 ImageCarriage.Paint;
3378 X := X - IconSize - SeparatorSize div 3;
3379
3380 Canvas.Brush.Style := bsClear;
3381 Canvas.Font.Size := 14;
3382 Canvas.Font.Color := Colors.Text;
3383 Canvas.TextOut(X - Canvas.TextWidth(Text),
3384 Y - Canvas.TextHeight(Text) div 2, Text);
3385 X := X - Canvas.TextWidth(Text) - SeparatorSize;
3386 end;
3387
3388 // Draw unused terminals
3389 if AvailableTerminals > 0 then TerminalCountVisible := True;
3390 if TerminalCountVisible then begin
3391 Text := IntToStr(AvailableTerminals);
3392 ImageTerminal.Bounds := Bounds(X - IconSize, Y - IconSize div 2,
3393 IconSize, IconSize);
3394 ImageTerminal.Canvas := Canvas;
3395 ImageTerminal.Paint;
3396 X := X - IconSize - SeparatorSize div 3;
3397
3398 Canvas.Brush.Style := bsClear;
3399 Canvas.Font.Size := 14;
3400 Canvas.Font.Color := Colors.Text;
3401 Canvas.TextOut(X - Canvas.TextWidth(Text),
3402 Y - Canvas.TextHeight(Text) div 2, Text);
3403 end;
3404
3405 // Passenger count
3406 X := CanvasSize.X - ScaleX(10, 96);
3407 ImagePassenger.Bounds := Bounds(X - IconSize, Y - IconSize div 2,
3408 IconSize, IconSize);
3409 ImagePassenger.Canvas := Canvas;
3410 ImagePassenger.Paint;
3411 X := X - IconSize - SeparatorSize div 3;
3412
3413 Canvas.Brush.Style := bsClear;
3414 Canvas.Font.Size := 14;
3415 Canvas.Font.Color := Colors.Text;
3416 Text := IntToStr(ServedPassengerCount);
3417 Canvas.TextOut(X - Canvas.TextWidth(Text),
3418 Y - Canvas.TextHeight(Text) div 2, Text);
3419
3420 DrawClock(Canvas, CanvasSize);
3421
3422 // Back button
3423 Canvas.Font.Size := 40;
3424 Canvas.Font.Color := Colors.Text;
3425 ButtonBack.Canvas := Canvas;
3426 ButtonBack.Bounds := Bounds(CanvasSize.X - ButtonBack.Bounds.Width - 10, 10,
3427 ButtonBack.Bounds.Width, ButtonBack.Bounds.Height);
3428 ButtonBack.Paint;
3429
3430 // City name
3431 if Assigned(City) then begin
3432 Canvas.Brush.Style := bsClear;
3433 Canvas.Font.Color := Colors.Text;
3434 Canvas.Font.Size := 20;
3435 Text := City.Name;
3436 Canvas.TextOut(20, CanvasSize.Y -
3437 Canvas.TextHeight(Text) - 20, Text);
3438
3439 X := CanvasSize.X - ScaleX(10, 96);
3440 ImageAchievement.Bounds := Bounds(X - IconSize, Y - 2 * IconSize,
3441 IconSize, IconSize);
3442 ImageAchievement.Canvas := Canvas;
3443 ImageAchievement.Paint;
3444
3445 X := X - IconSize - SeparatorSize div 3;
3446
3447 Canvas.Brush.Style := bsClear;
3448 Canvas.Font.Size := 14;
3449 Canvas.Font.Color := Colors.Text;
3450 Text := IntToStr(City.PassengersCountToUnlock);
3451 Canvas.TextOut(X - Canvas.TextWidth(Text),
3452 Y - Round(1.5 * IconSize) - Canvas.TextHeight(Text) div 2, Text);
3453 end;
3454end;
3455
3456procedure TEngine.DrawGrabbed(Canvas: TCanvas; CanvasSize: TPoint);
3457var
3458 Pos: TPoint;
3459 Angle: Double;
3460 FocusedTrack: TTrackLink;
3461 Vector: TVector;
3462 Intersect: TPoint;
3463 TrackPosition: TTrackPosition;
3464begin
3465 // Show train grabbed by mouse
3466 Angle := 0;
3467 Pos := LastMousePos;
3468
3469 if Assigned(SelectedTrain) then begin
3470 FocusedTrack := GetTrackOnPos(View.PointDestToSrc(Pos), Intersect);
3471 if Assigned(FocusedTrack) then begin
3472 if Assigned(FocusedTrack.Points[0]) then begin
3473 TrackPosition.BaseTrackPoint := FocusedTrack.Points[0];
3474 TrackPosition.RelPos := Distance(FocusedTrack.Points[0].Position,
3475 Intersect);
3476 Vector := TrackPosition.GetVector;
3477 Angle := Vector.GetAngle;
3478
3479 if Assigned(LastGrabbedTrain) then begin
3480 if TrackPosition.GetTrackPosition >
3481 LastGrabbedTrainTrackPosition.GetTrackPosition then
3482 GrabbedTrainDirection := 1
3483 else
3484 if TrackPosition.GetTrackPosition <
3485 LastGrabbedTrainTrackPosition.GetTrackPosition then
3486 GrabbedTrainDirection := -1;
3487 end else GrabbedTrainDirection := 1;
3488
3489 LastGrabbedTrain := SelectedTrain;
3490 LastGrabbedTrainTrackPosition := TrackPosition;
3491 end;
3492 FreeAndNil(FocusedTrack);
3493 end;
3494
3495 if GrabbedTrainDirection = -1 then Angle := Angle + Pi;
3496 Canvas.Brush.Color := Colors.Text; //SelectedTrain.Line.Color;
3497 Canvas.Brush.Style := bsSolid;
3498 Canvas.Pen.Style := psClear;
3499 Canvas.Polygon([
3500 RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y - TrainSize div 3), Angle),
3501 RotatePoint(Pos, Point(Pos.X + TrainSize div 2 - 10, Pos.Y - TrainSize div 3), Angle),
3502 RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y), Angle),
3503 RotatePoint(Pos, Point(Pos.X + TrainSize div 2 - 10, Pos.Y + TrainSize div 3), Angle),
3504 RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y + TrainSize div 3), Angle)
3505 ]);
3506 end;
3507
3508 // Show carriage grabbed by mouse
3509 if Assigned(SelectedCarriage) then begin
3510 Canvas.Brush.Color := Colors.Text; //SelectedTrain.Line.Color;
3511 Canvas.Brush.Style := bsSolid;
3512 Canvas.Pen.Style := psClear;
3513 Pos := LastMousePos;
3514 Angle := 0;
3515
3516 Canvas.Polygon([
3517 RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y - TrainSize div 3), Angle),
3518 RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y - TrainSize div 3), Angle),
3519 RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y + TrainSize div 3), Angle),
3520 RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y + TrainSize div 3), Angle)
3521 ]);
3522 end;
3523
3524 // Show grabbed terminal by mouse
3525 if SelectedTerminal then begin
3526 Canvas.Brush.Color := Colors.Text; //SelectedTrain.Line.Color;
3527 Canvas.Brush.Style := bsSolid;
3528 Canvas.Pen.Style := psClear;
3529 Pos := LastMousePos;
3530 Angle := 0;
3531
3532 Canvas.Ellipse(Pos.X - TrainSize div 2, Pos.Y - TrainSize div 2,
3533 Pos.X + TrainSize div 2, Pos.Y + TrainSize div 2);
3534 end;
3535end;
3536
3537procedure TEngine.Tick;
3538var
3539 Passenger: TMetroPassenger;
3540 MapStation: TMapStation;
3541begin
3542 if State = gsRunning then begin
3543 FTime := FTime + (Now - LastTickTime) / OneSecond * TimePerSecond;
3544 Redraw; // Redraw on every tick because engine time is changed so clock should be redrawn
3545
3546 // Add new trains
3547 if (Time - LastNewWeekTime) > NewTrainPeriod then begin
3548 LastNewWeekTime := Time;
3549 Inc(Week);
3550 State := gsNewWeek;
3551 Redraw;
3552 end;
3553
3554 // Add new shape
3555 if (Time - LastNewShapeTime) > NewShapePeriod then begin
3556 LastNewShapeTime := Time;
3557 if DestinationCount < Integer(High(TDestinationShape)) then Inc(DestinationCount);
3558 Redraw;
3559 end;
3560
3561 // Add new station
3562 if (Time - LastNewStationTime) > NewStationPeriod then begin
3563 LastNewStationTime := Time;
3564 Stations.AddNew;
3565 ResizeView(False);
3566 Redraw;
3567 end;
3568
3569 // Add new passengers
3570 if (Time - LastNewPassengerTime) > NewPassengerPeriod then begin
3571 LastNewPassengerTime := Time;
3572 for MapStation in Stations do
3573 with MapStation do
3574 if Random < NewPassengerProbability then begin
3575 Passenger := Self.Passengers.AddItem;
3576 Passenger.DestinationIndex := Random(DestinationCount);
3577 Passengers.Add(Passenger);
3578
3579 // Passenger is not allowed to have same DestinationIndex
3580 while (Passenger.DestinationIndex = DestinationIndex) or
3581 not GetExistStationDestinationIndex(Passenger.DestinationIndex) do
3582 Passenger.DestinationIndex := (Passenger.DestinationIndex + 1) mod DestinationCount;
3583 Redraw;
3584 end;
3585 end;
3586
3587 // Check station passenger overload state
3588 for MapStation in Stations do
3589 with MapStation do begin
3590 if Passengers.Count > GetMaxPassengers then begin
3591 OverloadDuration := OverloadDuration + (FTime - FLastTime);
3592 if OverloadDuration > MaxPassengersOveloadTime then
3593 OverloadDuration := MaxPassengersOveloadTime;
3594 if OverloadDuration < MaxPassengersOveloadTime then Redraw;
3595 end;
3596 if Passengers.Count <= GetMaxPassengers then begin
3597 if OverloadDuration > 0 then Redraw;
3598 OverloadDuration := OverloadDuration - (FTime - FLastTime);
3599 if OverloadDuration < 0 then begin
3600 OverloadDuration := 0;
3601 end;
3602 end;
3603 end;
3604
3605 TrainsMovement;
3606
3607 // Game over
3608 for MapStation in Stations do
3609 with MapStation do begin
3610 if OverloadDuration >= MaxPassengersOveloadTime then begin
3611 State := gsGameOver;
3612 CheckScore;
3613 Redraw;
3614 end;
3615 end;
3616
3617 if Assigned(City) and (ServedPassengerCount >= City.PassengersCountToUnlock) then begin
3618 State := gsSuccess;
3619 CheckScore;
3620 Redraw;
3621 end;
3622 end;
3623 LastTickTime := Now;
3624 FLastTime := FTime;
3625end;
3626
3627procedure TEngine.MouseMove(Position: TPoint);
3628var
3629 FocusedStation: TMapStation;
3630 Line: TMetroLine;
3631 LineStationDown: TLineStation;
3632 LineStationUp: TLineStation;
3633 CurrentTrackPoint: TTrackPoint;
3634begin
3635 if State = gsMenu then begin
3636 Menu.MouseMove(Position);
3637 Redraw;
3638 end;
3639
3640 if Assigned(SelectedTrain) or Assigned(SelectedCarriage) or
3641 SelectedTerminal then Redraw;
3642
3643 LastMousePos := Position;
3644 if MouseHold then begin
3645 FocusedStation := GetStationOnPos(View.PointDestToSrc(Position));
3646 Line := nil;
3647 if Assigned(TrackStationDown) then begin
3648 Line := TMetroLine(TrackStationDown.Track.Owner);
3649 Redraw;
3650 end;
3651 if Assigned(TrackStationUp) then begin
3652 Line := TMetroLine(TrackStationUp.Track.Owner);
3653 Redraw;
3654 end;
3655 if Assigned(Line) and not Assigned(LastFocusedStation) and Assigned(FocusedStation) then begin
3656 if Assigned(TrackStationDown) and (TLineStation(TrackStationDown.OwnerPoint).MapStation = FocusedStation) then begin
3657 if MovableTracks then begin
3658 // Disconnect down
3659 CurrentTrackPoint := TrackStationDown;
3660 TrackStationDown := TrackStationDown.GetDown;
3661 Line.DisconnectStation(TLineStation(CurrentTrackPoint.OwnerPoint));
3662 end;
3663 end else
3664 if Assigned(TrackStationUp) and (TLineStation(TrackStationUp.OwnerPoint).MapStation = FocusedStation) then begin
3665 if MovableTracks then begin
3666 // Disconnect up
3667 CurrentTrackPoint := TrackStationUp;
3668 if Assigned(TrackStationUp) then
3669 TrackStationUp := TrackStationUp.GetUp;
3670 Line.DisconnectStation(TLineStation(CurrentTrackPoint.OwnerPoint));
3671 end;
3672 end else
3673 if Assigned(Line) and ((not Line.IsCircular) or ((TrackStationDown <> nil) and (TrackStationUp <> nil))) and
3674 ((Line.LineStations.SearchMapStation(FocusedStation) = nil) or
3675 ((Line.LineStations.Count > 0) and
3676 ((Line.LineStations.First.MapStation = FocusedStation) or
3677 (Line.LineStations.Last.MapStation = FocusedStation)) and
3678 ((TrackStationDown = nil) or (TrackStationUp = nil)) and
3679 (not Line.IsCircular))) then begin
3680 if Assigned(TrackStationDown) then LineStationDown := TLineStation(TrackStationDown.OwnerPoint)
3681 else LineStationDown := nil;
3682 if Assigned(TrackStationUp) then LineStationUp := TLineStation(TrackStationUp.OwnerPoint)
3683 else LineStationUp := nil;
3684 Line.ConnectStation(FocusedStation, LineStationDown, LineStationUp);
3685 if Assigned(TrackStationDown) then TrackStationDown := TrackStationDown.GetUp
3686 else if Assigned(TrackStationUp) then TrackStationUp := TrackStationUp.GetDown;
3687 end;
3688 end;
3689 LastFocusedStation := FocusedStation;
3690 end;
3691end;
3692
3693procedure TEngine.MouseUp(Button: TMouseButton; Position: TPoint);
3694var
3695 I: Integer;
3696 FocusedTrack: TTrackLink;
3697 FocusedTrain: TMetroTrain;
3698 FocusedStation: TMapStation;
3699 Intersect: TPoint;
3700begin
3701 if Button = mbLeft then begin
3702 if State = gsMenu then begin
3703 Menu.MouseUp(Button, Position);
3704 Redraw;
3705 end else
3706 if State in [gsGameOver, gsSuccess] then begin
3707 ButtonBack.MouseUp(Position);
3708 end else
3709 if State = gsNewWeek then begin
3710 ImageNewTrain.MouseUp(Position);
3711 end else
3712 if State = gsNewImprovement then begin
3713 ImageNewImprovement1.MouseUp(Position);
3714 ImageNewImprovement2.MouseUp(Position);
3715 end
3716 else
3717 if State in [gsRunning, gsPaused] then begin
3718 ButtonBack.MouseUp(Position);
3719 ImagePause.MouseUp(Position);
3720 ImagePlay.MouseUp(Position);
3721 ImageFastForward.MouseUp(Position);
3722 Redraw;
3723
3724 // Place selected train if focused track
3725 if Assigned(SelectedTrain) then begin
3726 SelectedTrain.TargetStation := nil;
3727 SelectedTrain.TrackPosition.BaseTrackPoint := nil;
3728 if Assigned(SelectedTrain.Line) then begin
3729 SelectedTrain.Line.Trains.Remove(SelectedTrain);
3730 SelectedTrain.Line := nil;
3731
3732 // Remove train carriages
3733 for I := SelectedTrain.Carriages.Count - 1 downto 0 do begin
3734 SelectedTrain.Carriages[I].Train := nil;
3735 SelectedTrain.Carriages.Delete(I);
3736 end;
3737 end;
3738 FocusedTrack := GetTrackOnPos(View.PointDestToSrc(Position), Intersect);
3739 if Assigned(FocusedTrack) then begin
3740 if Assigned(FocusedTrack.Points[0]) then begin
3741 SelectedTrain.Line := TMetroLine(FocusedTrack.Points[0].Track.Owner);
3742 SelectedTrain.Line.Trains.Add(SelectedTrain);
3743 SelectedTrain.TrackPosition.BaseTrackPoint := FocusedTrack.Points[0];
3744 SelectedTrain.TrackPosition.RelPos := Distance(FocusedTrack.Points[0].Position,
3745 Intersect);
3746 SelectedTrain.Direction := GrabbedTrainDirection;
3747 SelectedTrain.FindTargetStation;
3748 SelectedTrain.LastTrainMoveTime := Time;
3749 end;
3750 FreeAndNil(FocusedTrack);
3751 end;
3752
3753 LastGrabbedTrain := nil;
3754 end;
3755
3756 // Place selected carriage if focused train
3757 if Assigned(SelectedCarriage) then begin
3758 if Assigned(SelectedCarriage.Train) then begin
3759 SelectedCarriage.Train.Carriages.Remove(SelectedCarriage);
3760 SelectedCarriage.Train := nil;
3761 end;
3762 FocusedTrain := GetTrainOnPos(View.PointDestToSrc(Position));
3763 if Assigned(FocusedTrain) then begin
3764 SelectedCarriage.Train := FocusedTrain;
3765 FocusedTrain.Carriages.Add(SelectedCarriage);
3766 end;
3767 end;
3768
3769 if SelectedTerminal then begin
3770 FocusedStation := GetStationOnPos(View.PointDestToSrc(Position));
3771 if Assigned(FocusedStation) and not FocusedStation.IsTerminal then begin
3772 FocusedStation.IsTerminal := True;
3773 Dec(AvailableTerminals);
3774 Redraw;
3775 end;
3776 SelectedTerminal := False;
3777 end;
3778
3779 // Line color selection
3780 for I := 0 to Lines.Count - 1 do
3781 if Distance(Point(View.DestRect.Right div 2 - Length(LineColors) div 2 * LineColorsDist + I * LineColorsDist,
3782 View.DestRect.Bottom - LineColorsDist), Position) < 20 then begin
3783 SelectedLine := Lines[I];
3784 Exit;
3785 end;
3786
3787 // Remove single line station on line
3788 if Assigned(TrackStationDown) and (TMetroLine(TrackStationDown.Track.Owner).LineStations.Count = 1) then begin
3789 TMetroLine(TrackStationDown.Track.Owner).DisconnectStation(
3790 TMetroLine(TrackStationDown.Track.Owner).LineStations.First);
3791 end;
3792 if Assigned(TrackStationUp) and (TMetroLine(TrackStationUp.Track.Owner).LineStations.Count = 1) then begin
3793 TMetroLine(TrackStationUp.Track.Owner).DisconnectStation(
3794 TMetroLine(TrackStationUp.Track.Owner).LineStations.First);
3795 end;
3796 end;
3797 end else
3798 if Button = mbRight then begin
3799 SelectedLine := nil;
3800 end;
3801 MouseHold := False;
3802 TrackStationDown := nil;
3803 TrackStationUp := nil;
3804 SelectedTrain := nil;
3805 SelectedCarriage := nil;
3806 Redraw;
3807end;
3808
3809procedure TEngine.MouseDown(Button: TMouseButton; Position: TPoint);
3810var
3811 Station: TMapStation;
3812 NewLine: TMetroLine;
3813 TrackLink: TTrackLink;
3814 NewIndex: Integer;
3815 Intersection: TPoint;
3816begin
3817 if (Button = mbLeft) then begin
3818 if State in [gsRunning, gsPaused] then begin
3819 MouseHold := True;
3820 LastFocusedStation := nil;
3821 Redraw;
3822
3823 // Train selection
3824 SelectedTrain := GetTrainOnPos(View.PointDestToSrc(Position));
3825 if Assigned(SelectedTrain) then begin
3826 Exit;
3827 end;
3828
3829 // Carriage selection
3830 SelectedCarriage := GetCarriageOnPos(View.PointDestToSrc(Position));
3831 if Assigned(SelectedCarriage) then begin
3832 Exit;
3833 end;
3834
3835 // Select unused train
3836 if (Distance(Position, ImageLocomotive.Bounds.CenterPoint) < 30) and
3837 (Trains.GetUnusedCount > 0) then begin
3838 SelectedTrain := Trains.GetUnused;
3839 Exit;
3840 end;
3841
3842 // Select unused carriage
3843 if CarriageCountVisible and (Distance(Position, ImageCarriage.Bounds.CenterPoint) < 30) and
3844 (Carriages.GetUnusedCount > 0) then begin
3845 SelectedCarriage := Carriages.GetUnused;
3846 Exit;
3847 end;
3848
3849 // Select unused carriage
3850 if TerminalCountVisible and (Distance(Position, ImageTerminal.Bounds.CenterPoint) < 30) and
3851 (AvailableTerminals > 0) then begin
3852 SelectedTerminal := True;
3853 Exit;
3854 end;
3855
3856 // New track creation from selected station as start
3857 Station := GetStationOnPos(View.PointDestToSrc(Position));
3858 if Assigned(Station) then begin
3859 NewLine := GetSelectedOrUnusedMetroLine;
3860 if Assigned(NewLine) then begin
3861 NewLine.ConnectStation(Station, nil, nil);
3862 TrackStationDown := NewLine.Track.Points.Last;
3863 TrackStationUp := nil;
3864 LastFocusedStation := Station;
3865 SelectedLine := NewLine;
3866 Exit;
3867 end;
3868 end;
3869
3870 // Line selection
3871 TrackLink := GetTrackOnPos(View.PointDestToSrc(Position), Intersection);
3872 if Assigned(TrackLink) and Assigned(TrackLink.Points[0]) and Assigned(TrackLink.Points[1]) then begin
3873 SelectedLine := TMetroLine(TrackLink.Points[0].Track.Owner);
3874
3875 TrackStationDown := TrackLink.Points[0];
3876 NewIndex := TrackStationDown.Track.Points.IndexOf(TrackStationDown);
3877 while Assigned(TrackStationDown) and (not Assigned(TrackStationDown.OwnerPoint)) do begin
3878 NewIndex := NewIndex - 1;
3879 if NewIndex >= 0 then TrackStationDown := TrackStationDown.Track.Points[NewIndex]
3880 else TrackStationDown := nil;
3881 end;
3882 TrackStationUp := TrackLink.Points[1];
3883 NewIndex := TrackStationUp.Track.Points.IndexOf(TrackStationDown);
3884 while Assigned(TrackStationUp) and (not Assigned(TrackStationUp.OwnerPoint)) do begin
3885 NewIndex := NewIndex + 1;
3886 if NewIndex < TrackStationUp.Track.Points.Count then
3887 TrackStationUp := TrackStationUp.Track.Points[NewIndex]
3888 else TrackStationUp := nil;
3889 end;
3890
3891 if not MovableTracks and (Assigned(TrackStationDown) and Assigned(TrackStationUp)) then begin
3892 TrackStationDown := nil;
3893 TrackStationUp := nil;
3894 SelectedLine := nil;
3895 end;
3896
3897 TrackLink.Free;
3898 Exit;
3899 end;
3900 if Assigned(TrackLink) then TrackLink.Free;
3901 end;
3902 end;
3903end;
3904
3905procedure TEngine.KeyUp(Key: Word);
3906const
3907 KeyEsc = 27;
3908{$IFDEF DEBUG}
3909 KeyF2 = 113;
3910 KeyF3 = 114;
3911 KeyF4 = 115;
3912 KeyF5 = 116;
3913 KeyF6 = 117;
3914 KeyF7 = 118;
3915 KeyF8 = 119;
3916 KeyF9 = 120;
3917{$ENDIF}
3918 KeyT = 84;
3919 KeyC = 67;
3920 KeyF = 70;
3921 KeyP = 80;
3922begin
3923 if Key = KeyEsc then begin
3924 if State = gsMenu then begin
3925 if Assigned(Menu.OnExit) then
3926 Menu.OnExit(nil);
3927 end else begin
3928 ButtonBackClick(nil);
3929 end;
3930 end;
3931 if State in [gsRunning, gsPaused] then begin
3932 if Key = KeyT then begin
3933 if Trains.GetUnusedCount > 0 then begin
3934 SelectedTrain := Trains.GetUnused;
3935 Redraw;
3936 end;
3937 end else
3938 if Key = KeyC then begin
3939 if Carriages.GetUnusedCount > 0 then begin
3940 SelectedCarriage := Carriages.GetUnused;
3941 Redraw;
3942 end;
3943 end else
3944 if Key = KeyF then begin
3945 ButtonFastForward(Self);
3946 end else
3947 if Key = KeyP then begin
3948 ButtonPlay(Self);
3949 end;
3950 end;
3951 {$IFDEF DEBUG}
3952 if State in [gsRunning, gsPaused] then begin
3953 if Key = KeyF2 then begin
3954 State := gsGameOver;
3955 CheckScore;
3956 Redraw;
3957 end;
3958 if Key = KeyF3 then begin
3959 Trains.AddItem;
3960 Redraw;
3961 end;
3962 if Key = KeyF4 then begin
3963 Carriages.AddItem;
3964 Redraw;
3965 end;
3966 if Key = KeyF5 then begin
3967 State := gsNewWeek;
3968 Redraw;
3969 end;
3970 if Key = KeyF6 then begin
3971 Stations.AddNew;
3972 ResizeView(False);
3973 Redraw;
3974 end else
3975 if Key = KeyF7 then begin
3976 State := gsSuccess;
3977 CheckScore;
3978 Redraw;
3979 end else
3980 if Key = KeyF8 then begin
3981 Inc(AvailableTerminals);
3982 Redraw;
3983 end else
3984 if Key = KeyF9 then begin
3985 Inc(ServedPassengerCount, 100);
3986 Redraw;
3987 end;
3988 end;
3989 {$ENDIF}
3990end;
3991
3992procedure TEngine.MainMenu;
3993begin
3994 State := gsMenu;
3995 Redraw;
3996end;
3997
3998procedure TEngine.Clear;
3999begin
4000 CarriageCountVisible := False;
4001 TerminalCountVisible := False;
4002 AvailableTerminals := 0;
4003 ServedPassengerCount := 0;
4004 Week := 1;
4005 Trains.Clear;
4006 Passengers.Clear;
4007 Carriages.Clear;
4008 Lines.Clear;
4009 Stations.Clear;
4010 View.SourceRect := Bounds(0, 0, 0, 0);
4011 SelectedLine := nil;
4012 SelectedTrain := nil;
4013 SelectedCarriage := nil;
4014end;
4015
4016procedure TEngine.NewGame;
4017var
4018 NewTrain: TMetroTrain;
4019 I: Integer;
4020 NewStation: TMapStation;
4021 InitialStationCount: Integer;
4022 InitialLineCount: Integer;
4023begin
4024 Clear;
4025 if Assigned(City) then begin
4026 LineColors := City.LineColors;
4027 InitialLineCount := City.InitialLineCount;
4028 end else begin
4029 LineColors := [clBlue, clRed, clDarkYellow, clGreen, clPurple, clGray,
4030 clOrange, clBrown, clCyan];
4031 InitialLineCount := 3;
4032 end;
4033 AvailableImprovements := [miCarriage, miLine, miTerminal];
4034 DestinationCount := 3;
4035
4036 // Start with 3 stations with each different shape
4037 InitialStationCount := 3;
4038 for I := 0 to InitialStationCount - 1 do begin
4039 NewStation := Stations.AddNew;
4040 if I = 0 then NewStation.DestinationIndex := Integer(ssSquare)
4041 else if I = 1 then NewStation.DestinationIndex := Integer(ssCircle)
4042 else if I = 2 then NewStation.DestinationIndex := Integer(ssTriangle);
4043 end;
4044
4045 for I := 0 to InitialLineCount - 1 do begin
4046 Lines.AddNew(LineColors[Lines.Count]);
4047 NewTrain := TMetroTrain.Create;
4048 Trains.Add(NewTrain);
4049 end;
4050
4051 ResizeView(True);
4052
4053 FTime := 0;
4054 FLastTime := 0;
4055 LastNewStationTime := Time;
4056 LastNewPassengerTime := Time;
4057 LastNewWeekTime := Time;
4058 LastNewShapeTime := Time;
4059 LastTickTime := Now;
4060 State := gsRunning;
4061 Redraw;
4062end;
4063
4064procedure TEngine.Redraw;
4065begin
4066 RedrawPending := True;
4067end;
4068
4069procedure TEngine.LoadFromRegistry;
4070begin
4071 with TRegistryEx.Create do
4072 try
4073 CurrentContext := RegistryContext;
4074 DarkMode := ReadBoolWithDefault('DarkMode', False);
4075 HighestServedPassengerCount := ReadIntegerWithDefault('HighestPassengers', 0);
4076 HighestServedDaysCount := ReadIntegerWithDefault('HighestDays', 0);
4077 StationStyle := TStationStyle(ReadIntegerWithDefault('StationStyle', Integer(ssShapes)));
4078 VisualStyle := TVisualStyle(ReadIntegerWithDefault('VisualStyle', Integer(vsLondon)));
4079 MovableTracks := ReadBoolWithDefault('MovableTracks', MovableTracks);
4080 Cities.LoadFromRegistry(TRegistryContext.Create(RegistryContext.RootKey, RegistryContext.Key + '\Cities'));
4081 finally
4082 Free;
4083 end;
4084end;
4085
4086procedure TEngine.SaveToRegistry;
4087begin
4088 with TRegistryEx.Create do
4089 try
4090 CurrentContext := RegistryContext;
4091
4092 WriteBool('DarkMode', DarkMode);
4093 WriteInteger('HighestPassengers', HighestServedPassengerCount);
4094 WriteInteger('HighestDays', HighestServedDaysCount);
4095 WriteInteger('StationStyle', Integer(StationStyle));
4096 WriteInteger('VisualStyle', Integer(VisualStyle));
4097 WriteBool('MovableTracks', MovableTracks);
4098 Cities.SaveToRegistry(TRegistryContext.Create(RegistryContext.RootKey, RegistryContext.Key + '\Cities'));
4099 finally
4100 Free;
4101 end;
4102end;
4103
4104procedure TEngine.LoadFromXmlNode(Node: TDOMNode);
4105var
4106 NewNode: TDOMNode;
4107 Node2: TDOMNode;
4108 Improvement: TMetroImprovement;
4109begin
4110 Clear;
4111 ServedPassengerCount := ReadInteger(Node, 'ServedPassengerCount', ServedPassengerCount);
4112 DestinationCount := ReadInteger(Node, 'DestinationCount', DestinationCount);
4113 State := TGameState(ReadInteger(Node, 'State', Integer(gsNotStarted)));
4114 FTime := ReadDateTime(Node, 'Time', 0);
4115 FLastTime := FTime;
4116 City := Cities.SearchBySysName(ReadString(Node, 'CityName', ''));
4117 AvailableTerminals := ReadInteger(Node, 'AvailableTerminals', AvailableTerminals);
4118 LastNewShapeTime := ReadDateTime(Node, 'LastNewShapeTime', LastNewShapeTime);
4119 LastNewWeekTime := ReadDateTime(Node, 'LastNewWeekTime', LastNewWeekTime);
4120 LastNewPassengerTime := ReadDateTime(Node, 'LastNewPassengerTime', LastNewPassengerTime);
4121 LastNewStationTime := ReadDateTime(Node, 'LastNewStationTime', LastNewStationTime);
4122 TerminalCountVisible := ReadBoolean(Node, 'TerminalCountVisible', TerminalCountVisible);
4123 CarriageCountVisible := ReadBoolean(Node, 'CarriageCountVisible', CarriageCountVisible);
4124
4125 NewNode := Node.FindNode(DOMString(TView.GetClassSysName));
4126 if Assigned(NewNode) then
4127 View.LoadFromXmlNode(NewNode);
4128
4129 SetLength(LineColors, 0);
4130 NewNode := Node.FindNode('LineColors');
4131 if Assigned(NewNode) then begin
4132 Node2 := NewNode.FirstChild;
4133 while Assigned(Node2) and (Node2.NodeName = 'LineColor') do begin
4134 SetLength(LineColors, Length(LineColors) + 1);
4135 LineColors[Length(LineColors) - 1] := TColor(StrToInt(string(Node2.TextContent)));
4136 Node2 := Node2.NextSibling;
4137 end;
4138 end;
4139
4140 AvailableImprovements := [];
4141 NewNode := Node.FindNode('Improvements');
4142 if Assigned(NewNode) then begin
4143 Node2 := NewNode.FirstChild;
4144 while Assigned(Node2) and (Node2.NodeName = 'Improvement') do begin
4145 Improvement := TMetroImprovement(StrToInt(string(Node2.TextContent)));
4146 AvailableImprovements := AvailableImprovements + [Improvement];
4147 Node2 := Node2.NextSibling;
4148 end;
4149 end;
4150
4151 NewNode := Node.FindNode(DOMString(TMetroPassengers.GetClassSysName));
4152 if Assigned(NewNode) then
4153 Passengers.LoadFromXmlNode(NewNode);
4154
4155 NewNode := Node.FindNode(DOMString(TMapStations.GetClassSysName));
4156 if Assigned(NewNode) then
4157 Stations.LoadFromXmlNode(NewNode);
4158
4159 NewNode := Node.FindNode(DOMString(TMetroLines.GetClassSysName));
4160 if Assigned(NewNode) then
4161 Lines.LoadFromXmlNode(NewNode);
4162
4163 NewNode := Node.FindNode(DOMString(TMetroCarriages.GetClassSysName));
4164 if Assigned(NewNode) then
4165 Carriages.LoadFromXmlNode(NewNode);
4166
4167 NewNode := Node.FindNode(DOMString(TMetroTrains.GetClassSysName));
4168 if Assigned(NewNode) then
4169 Trains.LoadFromXmlNode(NewNode);
4170
4171 ComputeShapeDistance;
4172end;
4173
4174procedure TEngine.SaveToXmlNode(Node: TDOMNode);
4175var
4176 I: Integer;
4177 NewNode: TDOMNode;
4178 Improvement: TMetroImprovement;
4179begin
4180 Lines.RebuildItemsId;
4181 Stations.RebuildItemsId;
4182 Passengers.RebuildItemsId;
4183 Trains.RebuildItemsId;
4184 Carriages.RebuildItemsId;
4185
4186 WriteInteger(Node, 'ServedPassengerCount', ServedPassengerCount);
4187 WriteInteger(Node, 'DestinationCount', DestinationCount);
4188 if State = gsMenu then WriteInteger(Node, 'State', Integer(LastState))
4189 else WriteInteger(Node, 'State', Integer(State));
4190 WriteDateTime(Node, 'Time', FTime);
4191 if Assigned(City) then WriteString(Node, 'CityName', City.SysName);
4192 WriteInteger(Node, 'AvailableTerminals', AvailableTerminals);
4193 WriteDateTime(Node, 'LastNewShapeTime', LastNewShapeTime);
4194 WriteDateTime(Node, 'LastNewWeekTime', LastNewWeekTime);
4195 WriteDateTime(Node, 'LastNewPassengerTime', LastNewPassengerTime);
4196 WriteDateTime(Node, 'LastNewStationTime', LastNewStationTime);
4197 WriteBoolean(Node, 'TerminalCountVisible', TerminalCountVisible);
4198 WriteBoolean(Node, 'CarriageCountVisible', CarriageCountVisible);
4199
4200 NewNode := Node.OwnerDocument.CreateElement(DOMString(TView.GetClassSysName));
4201 Node.AppendChild(NewNode);
4202 View.SaveToXmlNode(NewNode);
4203
4204 NewNode := Node.OwnerDocument.CreateElement('LineColors');
4205 Node.AppendChild(NewNode);
4206 for I := 0 to Length(LineColors) - 1 do begin
4207 WriteInteger(NewNode, 'LineColor', Integer(LineColors[I]));
4208 end;
4209
4210 NewNode := Node.OwnerDocument.CreateElement('Improvements');
4211 Node.AppendChild(NewNode);
4212 for Improvement := Low(TMetroImprovement) to High(TMetroImprovement) do begin
4213 if Improvement in AvailableImprovements then
4214 WriteInteger(NewNode, 'Improvement', Integer(Improvement));
4215 end;
4216
4217 NewNode := Node.OwnerDocument.CreateElement(DOMString(TMetroPassengers.GetClassSysName));
4218 Node.AppendChild(NewNode);
4219 Passengers.SaveToXmlNode(NewNode);
4220
4221 NewNode := Node.OwnerDocument.CreateElement(DOMString(TMapStations.GetClassSysName));
4222 Node.AppendChild(NewNode);
4223 Stations.SaveToXmlNode(NewNode);
4224
4225 NewNode := Node.OwnerDocument.CreateElement(DOMString(TMetroLines.GetClassSysName));
4226 Node.AppendChild(NewNode);
4227 Lines.SaveToXmlNode(NewNode);
4228
4229 NewNode := Node.OwnerDocument.CreateElement(DOMString(TMetroCarriages.GetClassSysName));
4230 Node.AppendChild(NewNode);
4231 Carriages.SaveToXmlNode(NewNode);
4232
4233 NewNode := Node.OwnerDocument.CreateElement(DOMString(TMetroTrains.GetClassSysName));
4234 Node.AppendChild(NewNode);
4235 Trains.SaveToXmlNode(NewNode);
4236end;
4237
4238procedure TEngine.LoadFromFile(FileName: string);
4239var
4240 Doc: TXMLDocument;
4241 RootNode: TDOMNode;
4242begin
4243 ReadXMLFile(Doc, FileName);
4244 Clear;
4245 with Doc do try
4246 if Doc.DocumentElement.NodeName <> GameXmlName then
4247 raise Exception.Create(SWrongFileFormat);
4248 RootNode := Doc.DocumentElement;
4249 LoadFromXmlNode(RootNode);
4250 finally
4251 FreeAndNil(Doc);
4252 end;
4253 LastTickTime := Now;
4254end;
4255
4256procedure TEngine.SaveToFile(FileName: string);
4257var
4258 Doc: TXMLDocument;
4259 RootNode: TDOMNode;
4260begin
4261 Doc := TXMLDocument.Create;
4262 with Doc do try
4263 RootNode := CreateElement(GameXmlName);
4264 AppendChild(RootNode);
4265 SaveToXmlNode(RootNode);
4266 if ExtractFileDir(FileName) <> '' then
4267 ForceDirectories(ExtractFileDir(FileName));
4268 WriteXMLFile(Doc, FileName);
4269 finally
4270 FreeAndNil(Doc);
4271 end;
4272end;
4273
4274constructor TEngine.Create(AOwner: TComponent);
4275begin
4276 inherited;
4277 CurvedLines := True;
4278 MovableTracks := True;
4279 Colors := TColors.Create;
4280 Colors.Init(FDarkMode);
4281 ImprovementImageSize := ScaleX(64, 96);
4282 IconSize := ScaleX(32, 96);
4283 TimePerSecond := TimePerSecondNormal;
4284 ButtonBack := TImage.Create;
4285 ButtonBack.OnClick := ButtonBackClick;
4286 ButtonBack.Bounds := Bounds(0, 0, ScaleX(50, 96), ScaleY(50, 96));
4287 Cities := TCities.Create;
4288 InitCities;
4289 MenuMain := TMenu.Create;
4290 MenuOptions := TMenu.Create;
4291 MenuCareer := TMenu.Create;
4292 MenuGame := TMenu.Create;
4293 MenuCustomGame := TMenu.Create;
4294 MenuGameSlots := TMenu.Create;
4295 Menu := MenuMain;
4296 InitMenus;
4297 Stations := TMapStations.Create;
4298 Stations.Engine := Self;
4299 Lines := TMetroLines.Create;
4300 Lines.Engine := Self;
4301 Passengers := TMetroPassengers.Create;
4302 Map := TMap.Create;
4303 View := TView.Create;
4304 Trains := TMetroTrains.Create;
4305 Trains.Engine := Self;
4306 Carriages := TMetroCarriages.Create;
4307 Carriages.Engine := Self;
4308 ImageTunnel := TImage.Create;
4309 ImageLine := TImage.Create;
4310 ImageTerminal := TImage.Create;
4311 ImagePassenger := TImage.Create;
4312 ImageLocomotive := TImage.Create;
4313 ImageCarriage := TImage.Create;
4314 ImagePlay := TImage.Create;
4315 ImagePlay.OnClick := ButtonPlay;
4316 ImagePause := TImage.Create;
4317 ImagePause.OnClick := ButtonPause;
4318 ImageFastForward := TImage.Create;
4319 ImageFastForward.OnClick := ButtonFastForward;
4320 ImageAchievement := TImage.Create;
4321 ImageNewTrain := TImage.Create;
4322 ImageNewTrain.OnClick := ButtonNewTrain;
4323 ImageNewImprovement1 := TImage.Create;
4324 ImageNewImprovement1.OnClick := ButtonNewImprovement1;
4325 ImageNewImprovement2 := TImage.Create;
4326 ImageNewImprovement2.OnClick := ButtonNewImprovement2;
4327 Clock := TClock.Create;
4328 MetaCanvas := TMetaCanvas.Create;
4329end;
4330
4331destructor TEngine.Destroy;
4332begin
4333 AutoSave;
4334 FreeAndNil(MetaCanvas);
4335 FreeAndNil(Trains);
4336 FreeAndNil(Carriages);
4337 FreeAndNil(Clock);
4338 FreeAndNil(ImageTunnel);
4339 FreeAndNil(ImageTerminal);
4340 FreeAndNil(ImageLine);
4341 FreeAndNil(ImageNewImprovement1);
4342 FreeAndNil(ImageNewImprovement2);
4343 FreeAndNil(ImageNewTrain);
4344 FreeAndNil(ImagePlay);
4345 FreeAndNil(ImageFastForward);
4346 FreeAndNil(ImageAchievement);
4347 FreeAndNil(ImagePause);
4348 FreeAndNil(ImageCarriage);
4349 FreeAndNil(ImageLocomotive);
4350 FreeAndNil(ImagePassenger);
4351 FreeAndNil(View);
4352 FreeAndNil(Map);
4353 FreeAndNil(Passengers);
4354 FreeAndNil(Stations);
4355 FreeAndNil(Lines);
4356 FreeAndNil(MenuMain);
4357 FreeAndNil(MenuOptions);
4358 FreeAndNil(MenuCustomGame);
4359 FreeAndNil(MenuCareer);
4360 FreeAndNil(MenuGame);
4361 FreeAndNil(MenuGameSlots);
4362 FreeAndNil(Cities);
4363 FreeAndNil(ButtonBack);
4364 FreeAndNil(Colors);
4365 inherited;
4366end;
4367
4368procedure TEngine.Paint(Canvas: TCanvas; CanvasSize: TPoint);
4369begin
4370 MetaCanvas.Size := Point(Canvas.Width, Canvas.Height);
4371 MetaCanvas.Reset;
4372
4373 DrawStationPassengerOverload(MetaCanvas);
4374 DrawLines(MetaCanvas);
4375 DrawTrains(MetaCanvas);
4376 DrawStations(MetaCanvas);
4377
4378 // MainMenu background
4379 Canvas.Brush.Color := Colors.Background;
4380 Canvas.Brush.Style := bsSolid;
4381 Canvas.Clear;
4382
4383 MetaCanvas.Move(Point(-View.SourceRect.Left, -View.SourceRect.Top));
4384 MetaCanvas.Zoom(View.Zoom);
4385
4386 // Draw meta canvas to real target canvas
4387 MetaCanvas.DrawTo(Canvas);
4388
4389 if State = gsGameOver then
4390 begin
4391 DrawGameOver(Canvas, CanvasSize);
4392 DrawGameControls(Canvas, CanvasSize);
4393 end else
4394 if State = gsSuccess then
4395 begin
4396 DrawSuccess(Canvas, CanvasSize);
4397 DrawGameControls(Canvas, CanvasSize);
4398 end else
4399 if State = gsMenu then begin
4400 Menu.Paint(Canvas, CanvasSize);
4401 end else
4402 if State = gsNewWeek then begin
4403 DrawNewWeek(Canvas, CanvasSize);
4404 end else
4405 if State = gsNewImprovement then begin
4406 DrawNewImprovement(Canvas, CanvasSize);
4407 end else
4408 if State in [gsRunning, gsPaused] then begin
4409 DrawGameControls(Canvas, CanvasSize);
4410 DrawGrabbed(Canvas, CanvasSize);
4411 end;
4412
4413 RedrawPending := False;
4414end;
4415
4416end.
4417
Note: See TracBrowser for help on using the repository browser.