source: tags/1.4.0/UEngine.pas

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