source: tags/1.3.0/UEngine.pas

Last change on this file was 119, checked in by chronos, 3 years ago
  • Fixed: Error if track removed while train in station.
  • Fixed: Fullscreen was not working at the application first start.
File size: 110.2 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
13type
14 TEngine = class;
15 TMetroLines = class;
16 TMetroLine = class;
17 TMetroTrains = class;
18 TLineStation = class;
19 TMetroTrain = class;
20
21 { TMapStation }
22
23 TMapStation = class
24 private
25 procedure ShiftTrackPoints;
26 procedure SortLines;
27 public
28 Engine: TEngine;
29 Shape: TStationShape;
30 Position: TPoint;
31 Passengers: TMetroPassengers;
32 Lines: TMetroLines;
33 ShapeDistance: array[TStationShape] of Integer;
34 OverloadDuration: TDateTime;
35 IsTerminal: Boolean;
36 function GetMaxPassengers: Integer;
37 function IsBestStationForShape(Shape: TStationShape; Check, Current: TLineStation): Boolean;
38 constructor Create;
39 destructor Destroy; override;
40 end;
41
42 { TMapStations }
43
44 TMapStations = class(TObjectList<TMapStation>)
45 Engine: TEngine;
46 function GetRect: TRect;
47 function AddNew: TMapStation;
48 end;
49
50 { TLineStation }
51
52 TLineStation = class
53 Line: TMetroLine;
54 MapStation: TMapStation;
55 TrackPoint: TTrackPoint;
56 end;
57
58 { TLineStations }
59
60 TLineStations = class(TObjectList<TLineStation>)
61 Line: TMetroLine;
62 function SearchMapStation(Station: TMapStation): TLineStation;
63 end;
64
65 { TMetroLine }
66
67 TMetroLine = class
68 private
69 procedure UpdateEndingLine(EndIndex, Direction: Integer);
70 procedure UpdateEndingLines;
71 public
72 Index: Integer;
73 Engine: TEngine;
74 Color: TColor;
75 LineStations: TLineStations;
76 Trains: TMetroTrains;
77 Track: TTrack;
78 procedure ConnectStation(Station: TMapStation; LineStationDown, LineStationUp: TLineStation);
79 procedure DisconnectStation(ALineStation: TLineStation);
80 constructor Create;
81 destructor Destroy; override;
82 function IsCircular: Boolean;
83 end;
84
85 { TMetroLines }
86
87 TMetroLines = class(TObjectList<TMetroLine>)
88 Engine: TEngine;
89 function AddNew(Color: TColor): TMetroLine;
90 function SearchByColor(Color: TColor): TMetroLine;
91 end;
92
93 { TMetroCarriage }
94
95 TMetroCarriage = class
96 Train: TMetroTrain;
97 Passengers: TMetroPassengers;
98 function GetTrackPosition: TTrackPosition;
99 function GetVector: TVector;
100 constructor Create;
101 destructor Destroy; override;
102 end;
103
104 { TMetroCarriages }
105
106 TMetroCarriages = class(TObjectList<TMetroCarriage>)
107 function GetUnused: TMetroCarriage;
108 function GetUnusedCount: Integer;
109 function AddNew: TMetroCarriage;
110 end;
111
112 { TMetroTrain }
113
114 TMetroTrain = class
115 private
116 FLine: TMetroLine;
117 LastPosDelta: Integer;
118 LastTrainMoveTime: TDateTime;
119 StationStopTime: TDateTime;
120 procedure SetLine(AValue: TMetroLine);
121 public
122 Passengers: TMetroPassengers;
123 TrackPosition: TTrackPosition;
124 Direction: Integer;
125 InStation: Boolean;
126 TargetStation: TLineStation;
127 Carriages: TMetroCarriages;
128 procedure FindTargetStation;
129 function GetTargetStationDistance: Integer;
130 constructor Create;
131 destructor Destroy; override;
132 property Line: TMetroLine read FLine write SetLine;
133 end;
134
135 { TMetroTrains }
136
137 TMetroTrains = class(TObjectList<TMetroTrain>)
138 function GetUnused: TMetroTrain;
139 function GetUnusedCount: Integer;
140 function AddNew: TMetroTrain;
141 end;
142
143 { TMap }
144
145 TMap = class
146 Size: TPoint;
147 Rivers: TRivers;
148 constructor Create;
149 destructor Destroy; override;
150 end;
151
152 TGameState = (gsNotStarted, gsRunning, gsPaused, gsGameOver, gsMenu, gsNewWeek,
153 gsNewImprovement, gsSuccess);
154
155 TMetroImprovement = (miNone, miTunnel, miTerminal, miLine, miCarriage,
156 miFastTrain);
157 TMetroImprovementSet = set of TMetroImprovement;
158
159 { TEngine }
160
161 TEngine = class
162 private
163 FDarkMode: Boolean;
164 FOnDarkModeChange: TNotifyEvent;
165 FState: TGameState;
166 LastMousePos: TPoint;
167 LastFocusedStation: TMapStation;
168 MouseHold: Boolean;
169 LastNewStationTime: TDateTime;
170 LastNewPassengerTime: TDateTime;
171 LastNewWeekTime: TDateTime;
172 LastNewShapeTime: TDateTime;
173 LastTickTime: TDateTime;
174 FTime: TDateTime;
175 FLastTime: TDateTime;
176 MetaCanvas: TMetaCanvas;
177 Menu: TMenu;
178 MenuMain: TMenu;
179 MenuOptions: TMenu;
180 MenuCareer: TMenu;
181 MenuGame: TMenu;
182 LastState: TGameState;
183 TimePerSecond: TDateTime;
184 ImprovementImageSize: Integer;
185 IconSize: Integer;
186 LineColors: array of TColor;
187 CarriageCountVisible: Boolean;
188 TerminalCountVisible: Boolean;
189 LastGrabbedTrainTrackPosition: TTrackPosition;
190 GrabbedTrainDirection: Integer;
191 LastGrabbedTrain: TMetroTrain;
192 function GetServedDaysCount: Integer;
193 procedure ResizeView(Force: Boolean);
194 function GetExistStationShapes: TStationShapeSet;
195 function GetStationOnPos(Pos: TPoint): TMapStation;
196 function GetTrackOnPos(Pos: TPoint; out Intersect: TPoint): TTrackLink;
197 function GetTrainOnPos(Pos: TPoint): TMetroTrain;
198 function GetCarriageOnPos(Pos: TPoint): TMetroCarriage;
199 procedure DrawFrame(Canvas: TCanvas; Rect: TRect);
200 procedure DrawLine(Canvas: TCanvas; Pos: TPoint);
201 procedure DrawShape(Canvas: TCanvas; Position: TPoint; Shape: TStationShape;
202 Size: Integer; Angle: Double);
203 procedure DrawClock(Canvas: TCanvas; CanvasSize: TPoint);
204 procedure DrawTrains(Canvas: TCanvas);
205 procedure DrawGameOver(Canvas: TCanvas; CanvasSize: TPoint);
206 procedure DrawHighScore(Canvas: TCanvas; CanvasSize: TPoint; Y: Integer);
207 procedure DrawSuccess(Canvas: TCanvas; CanvasSize: TPoint);
208 procedure DrawNewWeek(Canvas: TCanvas; CanvasSize: TPoint);
209 procedure DrawNewImprovement(Canvas: TCanvas; CanvasSize: TPoint);
210 procedure DrawStationPassengerOverload(Canvas: TCanvas);
211 procedure DrawLines(Canvas: TCanvas);
212 procedure DrawStations(Canvas: TCanvas);
213 procedure DrawGameControls(Canvas: TCanvas; CanvasSize: TPoint);
214 procedure DrawGrabbed(Canvas: TCanvas; CanvasSize: TPoint);
215 procedure ComputeShapeDistance;
216 procedure ComputeShapeDistanceStation(Station: TMapStation;
217 UpdatedShape: TStationShape; Distance: Integer);
218 procedure SetDarkMode(AValue: Boolean);
219 procedure SetState(AValue: TGameState);
220 procedure TrainsMovement;
221 procedure TrainMovement(Train: TMetroTrain);
222 function GetUnusedLine: TMetroLine;
223 procedure ShiftTrackPoints;
224 procedure MenuItemExit(Sender: TObject);
225 procedure MenuItemCity(Sender: TObject);
226 procedure MenuItemPlay(Sender: TObject);
227 procedure MenuItemCareer(Sender: TObject);
228 procedure MenuItemOptions(Sender: TObject);
229 procedure MenuItemGameContinue(Sender: TObject);
230 procedure MenuItemGameExit(Sender: TObject);
231 procedure MenuItemGameRestart(Sender: TObject);
232 procedure MenuItemBack(Sender: TObject);
233 procedure ButtonPlay(Sender: TObject);
234 procedure ButtonPause(Sender: TObject);
235 procedure ButtonFastForward(Sender: TObject);
236 procedure ButtonNewTrain(Sender: TObject);
237 procedure ButtonNewImprovement1(Sender: TObject);
238 procedure ButtonNewImprovement2(Sender: TObject);
239 procedure ButtonBackClick(Sender: TObject);
240 procedure DarkModeChanged(Sender: TObject);
241 procedure LanguageChanged(Sender: TObject);
242 procedure FullScreenChanged(Sender: TObject);
243 procedure UpdateInterface;
244 function GetImprovementText(Improvement: TMetroImprovement): string;
245 function GetImprovementBitmap(Improvement: TMetroImprovement): TBitmap;
246 procedure EvaluateImprovement(Improvement: TMetroImprovement);
247 public
248 AvailableTerminals: Integer;
249 Week: Integer;
250 Colors: TColors;
251 Passengers: TMetroPassengers;
252 Stations: TMapStations;
253 Lines: TMetroLines;
254 Trains: TMetroTrains;
255 Carriages: TMetroCarriages;
256 ShapeCount: Integer;
257 Map: TMap;
258 View: TView;
259 Cities: TCities;
260 City: TCity;
261 SelectedLine: TMetroLine;
262 SelectedTrain: TMetroTrain;
263 SelectedCarriage: TMetroCarriage;
264 SelectedTerminal: Boolean;
265 TrackStationDown: TTrackPoint;
266 TrackStationUp: TTrackPoint;
267 ServedPassengerCount: Integer;
268 RedrawPending: Boolean;
269 ButtonBack: TImage;
270 ImagePassenger: TImage;
271 ImageLocomotive: TImage;
272 ImagePlay: TImage;
273 ImagePause: TImage;
274 ImageFastForward: TImage;
275 ImageAchievement: TImage;
276 ImageCarriage: TImage;
277 ImageTerminal: TImage;
278 ImageTunnel: TImage;
279 ImageLine: TImage;
280 ImageNewTrain: TImage;
281 ImageNewImprovement1: TImage;
282 ImageNewImprovement2: TImage;
283 AvailableImprovements: TMetroImprovementSet;
284 Improvement1: TMetroImprovement;
285 Improvement2: TMetroImprovement;
286 HighestServedPassengerCount: Integer;
287 HighestServedDaysCount: Integer;
288 RegistryContext: TRegistryContext;
289 procedure InitMenus;
290 procedure InitCities;
291 procedure MouseMove(Position: TPoint);
292 procedure MouseUp(Button: TMouseButton; Position: TPoint);
293 procedure MouseDown(Button: TMouseButton; Position: TPoint);
294 procedure KeyUp(Key: Word);
295 procedure MainMenu;
296 procedure Clear;
297 procedure NewGame;
298 procedure Redraw;
299 procedure LoadFromRegistry;
300 procedure SaveToRegistry;
301 constructor Create;
302 destructor Destroy; override;
303 procedure Tick;
304 procedure Paint(Canvas: TCanvas; CanvasSize: TPoint);
305 property Time: TDateTime read FTime;
306 property DarkMode: Boolean read FDarkMode write SetDarkMode;
307 property State: TGameState read FState write SetState;
308 property ServedDaysCount: Integer read GetServedDaysCount;
309 property OnDarkModeChange: TNotifyEvent read FOnDarkModeChange
310 write FOnDarkModeChange;
311 end;
312
313const
314 StationSize = 30;
315 StationOverloadSize = 60;
316 PassengerSize = 15;
317 TrainSize = 40;
318 TrainGap = 5;
319 LineColorsDist = 50;
320 TrainSpeed = 2000;
321 TrainPassengerCount = 6;
322 StationMinDistance = 100;
323 StationMaxDistance = 300;
324 MaxWaitingPassengers = 10;
325 MaxWaitingPassengersTerminal = 16;
326 MaxPassengersOveloadTime = 2;
327 MetroLineThickness = 13;
328 TrackClickDistance = 15;
329 EndStationLength = 50;
330 ShowDistances = False;
331 TimePerSecondNormal = 60 * OneMinute;
332 TimePerSecondFast = 2 * TimePerSecondNormal;
333 NewStationPeriod = 1;
334 NewShapePeriod = 10;
335 NewTrainPeriod = 7; // Each week
336 NewPassengerPeriod = 0.3 * OneSecond;
337 NewPassengerProbability = 0.003;
338 VisiblePassengersPerLine = 6;
339
340
341implementation
342
343uses
344 UFormMain, ULanguages;
345
346resourcestring
347 SGameOver = 'Game Over';
348 SGameOverReason = 'Overcrowding at one of your stations has forced you to resign as metro manager.';
349 SGameOverStatistic = '%d passengers travelled on your metro over %d days.';
350 SDay = 'Day';
351 SNewHighScore = 'New high score!';
352 SOldHighScore = 'Old high score was %d passengers in %d days.';
353 SStationNotDefined = 'Station have to be defined';
354 SNoOldStationToConnectNew = 'No old line station to connect new station';
355 SStationWithoutMapStation = 'Station have to have MapStation';
356 SNewTrain = 'You get a new train for your metro';
357 SNewImprovement = 'Select a new improvement for your metro';
358 SWeek = 'week';
359 STrain = 'Train';
360 SPlay = 'Play';
361 SOptions = 'Options';
362 SExit = 'Exit';
363 SBigMetro = 'Big Metro';
364 SDarkMode = 'Dark mode';
365 SLanguage = 'Language';
366 SCzech = 'Czech';
367 SEnglish = 'English';
368 SFrench = 'French';
369 SGerman = 'German';
370 SAutomatic = 'Automatic';
371 SBack = 'Back';
372 SFullScreen = 'Full screen';
373 SContinue = 'Continue';
374 SRestart = 'Try again';
375 STerminal = 'Terminal';
376 SLine = 'Line';
377 SCarriage = 'Carriage';
378 STunnel = 'Tunnel';
379 SCareer = 'Career';
380 SSuccess = 'Success';
381 SSuccessReason = 'Your metro transported enough passengers and you have reached your goal for this city.';
382 SUnlockedCity = 'City %s is now unlocked.';
383
384 // Cities
385 SPrague = 'Prague';
386 SLondon = 'London';
387 SParis = 'Paris';
388 SNewYork = 'New York';
389 STokyo = 'Tokyo';
390 SRome = 'Rome';
391 SSeoul = 'Seoul';
392 SBeijing = 'Beijing';
393
394{ TMetroCarriage }
395
396function TMetroCarriage.GetTrackPosition: TTrackPosition;
397begin
398 if Assigned(Train) then begin
399 Result := Train.TrackPosition;
400 Result.Move(-Train.Direction * (TrainSize + TrainGap) * (Train.Carriages.IndexOf(Self) + 1));
401 end;
402end;
403
404function TMetroCarriage.GetVector: TVector;
405begin
406 Result := Train.TrackPosition.GetVector;
407 Result.Position := AddPoint(Result.Position, Point(TrainSize, TrainSize));
408end;
409
410constructor TMetroCarriage.Create;
411begin
412 Passengers := TMetroPassengers.Create;
413 Passengers.OwnsObjects := False;
414end;
415
416destructor TMetroCarriage.Destroy;
417begin
418 FreeAndNil(Passengers);
419 inherited;
420end;
421
422{ TMetroCarriages }
423
424function TMetroCarriages.GetUnused: TMetroCarriage;
425var
426 I: Integer;
427begin
428 I := 0;
429 while (I < Count) and (Assigned(Items[I].Train)) do Inc(I);
430 if I < Count then Result := Items[I]
431 else Result := nil;
432end;
433
434function TMetroCarriages.GetUnusedCount: Integer;
435var
436 I: Integer;
437begin
438 Result := 0;
439 for I := 0 to Count - 1 do
440 if not Assigned(Items[I].Train) then Inc(Result);
441end;
442
443function TMetroCarriages.AddNew: TMetroCarriage;
444begin
445 Result := TMetroCarriage.Create;
446 Add(Result);
447end;
448
449{ TMap }
450
451constructor TMap.Create;
452begin
453 Rivers := TRivers.Create;
454end;
455
456destructor TMap.Destroy;
457begin
458 FreeAndNil(Rivers);
459 inherited;
460end;
461
462{ TLineStations }
463
464function TLineStations.SearchMapStation(Station: TMapStation): TLineStation;
465var
466 I: Integer;
467begin
468 I := 0;
469 while (I < Count) and (Items[I].MapStation <> Station) do Inc(I);
470 if I < Count then Result := Items[I]
471 else Result := nil;
472end;
473
474{ TMetroTrains }
475
476function TMetroTrains.GetUnused: TMetroTrain;
477var
478 I: Integer;
479begin
480 I := 0;
481 while (I < Count) and (Assigned(Items[I].Line)) do Inc(I);
482 if I < Count then Result := Items[I]
483 else Result := nil;
484end;
485
486function TMetroTrains.GetUnusedCount: Integer;
487var
488 I: Integer;
489begin
490 Result := 0;
491 for I := 0 to Count - 1 do
492 if not Assigned(Items[I].Line) then Inc(Result);
493end;
494
495function TMetroTrains.AddNew: TMetroTrain;
496begin
497 Result := TMetroTrain.Create;
498 Add(Result);
499end;
500
501{ TMapStations }
502
503function TMapStations.GetRect: TRect;
504var
505 I: Integer;
506begin
507 if Count > 0 then begin
508 with Items[0] do
509 Result := Rect(Position.X, Position.Y, Position.X, Position.Y);
510 for I := 1 to Count - 1 do
511 with Items[I] do begin
512 if Position.X < Result.Left then Result.Left := Position.X;
513 if Position.X > Result.Right then Result.Right := Position.X;
514 if Position.Y < Result.Top then Result.Top := Position.Y;
515 if Position.Y > Result.Bottom then Result.Bottom := Position.Y;
516 end;
517 end else Result := Rect(0, 0, 0, 0);
518end;
519
520function TMapStations.AddNew: TMapStation;
521var
522 D: Integer;
523 MinD: Integer;
524 I: Integer;
525 Pass: Integer;
526 Angle: Double;
527 L: Integer;
528const
529 Step = 20;
530begin
531 Result := TMapStation.Create;
532 Result.Engine := Engine;
533 Angle := Random * 2 * Pi;
534 // Ensure minimum distance between stations
535 Pass := 0;
536 L := Step;
537 repeat
538 Result.Position := Point(Trunc(Engine.Map.Size.X / 2 + Cos(Angle) * L * 1.5),
539 Trunc(Engine.Map.Size.Y / 2 + Sin(Angle) * L));
540 MinD := High(Integer);
541 for I := 0 to Engine.Stations.Count - 1 do begin
542 D := Distance(Engine.Stations[I].Position, Result.Position);
543 if D < MinD then MinD := D;
544 end;
545 Inc(Pass);
546 L := L + StationMinDistance div 2;
547 until (MinD > StationMinDistance) or
548 (Pass > 1000) or (Engine.Stations.Count = 0);
549 Result.Shape := TStationShape(Random(Integer(Engine.ShapeCount)));
550 Add(Result);
551 Engine.ComputeShapeDistance;
552end;
553
554{ TMetroLines }
555
556function TMetroLines.AddNew(Color: TColor): TMetroLine;
557begin
558 Result := TMetroLine.Create;
559 Result.Engine := Engine;
560 Result.Index := Count;
561 Result.Color := Color;
562 Add(Result);
563end;
564
565function TMetroLines.SearchByColor(Color: TColor): TMetroLine;
566var
567 I: Integer;
568begin
569 I := 0;
570 while (I < Count) and (Items[I].Color <> Color) do Inc(I);
571 if I < Count then Result := Items[I]
572 else Result := nil;
573end;
574
575{ TMetroLine }
576
577procedure TMetroLine.UpdateEndingLine(EndIndex, Direction: Integer);
578var
579 //Index: Integer;
580 //NewTrackPoint: TTrackPoint;
581 Angle: Double;
582 EndPoint: TPoint;
583begin
584{ if Direction = 1 then Index := Track.Points.IndexOf(LineStations.Last.TrackPoint)
585 else if Direction = -1 then Index := Track.Points.IndexOf(LineStations.Last.TrackPoint);
586 if Index = EndIndex then begin
587 NewTrackPoint := Track.Points.AddNew;
588 if Direction = 1 then Track.Points.Insert(EndIndex, NewTrackPoint)
589 else if Direction = -1 then begin
590 Inc(EndIndex);
591 Track.Points.Insert(EndIndex, NewTrackPoint);
592 end;
593 end;
594 }
595 Angle := ArcTan2((Track.Points[EndIndex + 2 * Direction].PositionDesigned.Y -
596 Track.Points[EndIndex + Direction].PositionDesigned.Y),
597 (Track.Points[EndIndex + 2 * Direction].PositionDesigned.X -
598 Track.Points[EndIndex + Direction].PositionDesigned.X));
599 EndPoint := Point(Round(Track.Points[EndIndex + Direction].PositionDesigned.X - EndStationLength * Cos(Angle)),
600 Round(Track.Points[EndIndex + Direction].PositionDesigned.Y - EndStationLength * Sin(Angle)));
601 Track.Points[EndIndex].PositionDesigned := EndPoint;
602 Track.Points[EndIndex].Position := EndPoint;
603end;
604
605procedure TMetroLine.UpdateEndingLines;
606var
607 Index: Integer;
608 NewTrackPoint: TTrackPoint;
609begin
610 if LineStations.Count >= 2 then begin
611 Index := Track.Points.IndexOf(LineStations.First.TrackPoint);
612 if Index = 0 then begin
613 NewTrackPoint := Track.Points.AddNew;
614 Track.Points.Insert(0, NewTrackPoint);
615 end;
616 Index := Track.Points.IndexOf(LineStations.Last.TrackPoint);
617 if Index = Track.Points.Count - 1 then begin
618 NewTrackPoint := Track.Points.AddNew;
619 Track.Points.Insert(Track.Points.Count, NewTrackPoint);
620 end;
621 UpdateEndingLine(0, 1);
622 UpdateEndingLine(Track.Points.Count - 1, -1);
623 end;
624end;
625
626procedure TMetroLine.ConnectStation(Station: TMapStation; LineStationDown, LineStationUp: TLineStation);
627var
628 Train: TMetroTrain;
629 NewTrackPoint: TTrackPoint;
630 NewLineStation: TLineStation;
631 Index: Integer;
632begin
633 if not Assigned(Station) then
634 raise Exception.Create(SStationNotDefined);
635 if not Assigned(LineStationDown) and not Assigned(LineStationUp) and (LineStations.Count > 0) then
636 raise Exception.Create(SNoOldStationToConnectNew);
637 NewLineStation := TLineStation.Create;
638 NewLineStation.Line := Self;
639 NewLineStation.MapStation := Station;
640 Index := 0;
641 if Assigned(LineStationDown) then Index := LineStations.IndexOf(LineStationDown) + 1
642 else if Assigned(LineStationDown) then Index := LineStations.IndexOf(LineStationUp);
643 LineStations.Insert(Index, NewLineStation);
644 Station.Lines.Add(Self);
645
646 NewTrackPoint := Track.Points.AddNew;
647 NewTrackPoint.OwnerPoint := NewLineStation;
648 NewTrackPoint.Position := Station.Position;
649 NewTrackPoint.PositionDesigned := NewTrackPoint.Position;
650 Index := 0;
651 if Assigned(LineStationDown) then Index := Track.Points.IndexOf(LineStationDown.TrackPoint) + 1
652 else if Assigned(LineStationUp) then Index := Track.Points.IndexOf(LineStationUp.TrackPoint);
653 Track.Points.Insert(Index, NewTrackPoint);
654 NewLineStation.TrackPoint := NewTrackPoint;
655
656 if Assigned(LineStationDown) then
657 Track.RouteTrack(NewLineStation.TrackPoint.GetDown, NewLineStation.TrackPoint);
658 if Assigned(LineStationUp) then
659 Track.RouteTrack(NewLineStation.TrackPoint, NewLineStation.TrackPoint.GetUp);
660
661 // Place one train if at least two stations present
662 if (LineStations.Count = 2) then begin
663 Train := Engine.Trains.GetUnused;
664 if Assigned(Train) then begin
665 Train.Line := Self;
666 Train.TargetStation := LineStations[0];
667 Train.TrackPosition.BaseTrackPoint := Track.Points.First;
668 Trains.Add(Train);
669 end;
670 end;
671 UpdateEndingLines;
672 Engine.ComputeShapeDistance;
673 Engine.ShiftTrackPoints;
674end;
675
676procedure TMetroLine.DisconnectStation(ALineStation: TLineStation);
677var
678 I: Integer;
679 J: Integer;
680 Index: Integer;
681 TP1, TP2: TTrackPoint;
682 IsOnTrack: Boolean;
683begin
684 // Determine track point range to be removed
685 TP1 := ALineStation.TrackPoint.GetDown;
686 if not Assigned(TP1) then TP1 := Track.Points.First;
687 TP2 := ALineStation.TrackPoint.GetUp;
688 if not Assigned(TP2) then TP2 := Track.Points.Last;
689
690 // Remove track points from trains
691 for I := 0 to Trains.Count - 1 do
692 with Trains[I] do begin
693 IsOnTrack := False;
694 for J := Track.Points.IndexOf(TP1) to Track.Points.IndexOf(TP2) do
695 if Track.Points[J] = TrackPosition.BaseTrackPoint then begin
696 IsOnTrack := True;
697 Break;
698 end;
699 if IsOnTrack then begin
700 if Assigned(TrackPosition.BaseTrackPoint) and Assigned(TrackPosition.BaseTrackPoint.GetUp) and
701 (TrackPosition.BaseTrackPoint.GetUp <> ALineStation.TrackPoint) then
702 TrackPosition.BaseTrackPoint := TrackPosition.BaseTrackPoint.GetUp
703 else
704 if Assigned(TrackPosition.BaseTrackPoint) and Assigned(TrackPosition.BaseTrackPoint.GetDown) and
705 (TrackPosition.BaseTrackPoint.GetDown <> ALineStation.TrackPoint) then
706 TrackPosition.BaseTrackPoint := TrackPosition.BaseTrackPoint.GetDown
707 else TrackPosition.BaseTrackPoint := nil;
708 end;
709 end;
710
711 // Delete old trackpoints
712 Index := Track.Points.IndexOf(ALineStation.TrackPoint) - 1;
713 while (Index >= 0) and (not Assigned(Track.Points[Index].OwnerPoint)) do begin
714 Track.Points.Delete(Index);
715 Dec(Index);
716 end;
717 Index := Index + 1;
718 Track.Points.Delete(Index);
719 while (Index < Track.Points.Count) and (not Assigned(Track.Points[Index].OwnerPoint)) do
720 Track.Points.Delete(Index);
721
722 if ((Index - 1) >= 0) and (Index < Track.Points.Count) then
723 Track.RouteTrack(Track.Points[Index - 1], Track.Points[Index]);
724
725 ALineStation.MapStation.Lines.Remove(Self);
726 Index := LineStations.IndexOf(ALineStation);
727
728 for I := 0 to Trains.Count - 1 do
729 with Trains[I] do begin
730 if TargetStation = ALineStation then
731 TargetStation := LineStations[(Index + 1) mod LineStations.Count];
732 end;
733
734 LineStations.Delete(Index);
735
736 // Remove all trains if less then two stations
737 if LineStations.Count < 2 then
738 for I := Trains.Count - 1 downto 0 do begin
739 Trains[I].Line := nil;
740 Trains.Delete(I);
741 end;
742 UpdateEndingLines;
743 Engine.ComputeShapeDistance;
744 Engine.ShiftTrackPoints;
745end;
746
747constructor TMetroLine.Create;
748begin
749 LineStations := TLineStations.Create;
750 LineStations.OwnsObjects := True;
751 Trains := TMetroTrains.Create;
752 Trains.OwnsObjects := False;
753 Track := TTrack.Create;
754 Track.Owner := Self;
755end;
756
757destructor TMetroLine.Destroy;
758begin
759 FreeAndNil(Trains);
760 FreeAndNil(LineStations);
761 FreeAndNil(Track);
762 inherited;
763end;
764
765function TMetroLine.IsCircular: Boolean;
766begin
767 Result := False;
768 if LineStations.Count >= 2 then
769 Result := (LineStations.Last.MapStation = LineStations.First.MapStation);
770end;
771
772{ TMetroTrain }
773
774procedure TMetroTrain.SetLine(AValue: TMetroLine);
775begin
776 if FLine = AValue then Exit;
777 FLine := AValue;
778 if AValue = nil then begin
779 TrackPosition.RelPos := 0;
780 TrackPosition.BaseTrackPoint := nil;
781 TargetStation := nil;
782 end;
783end;
784
785procedure TMetroTrain.FindTargetStation;
786var
787 TP: TTrackPoint;
788begin
789 if Direction > 0 then begin
790 TP := TrackPosition.BaseTrackPoint.GetUp;
791 if Assigned(TP) then begin
792 TargetStation := TLineStation(TP.OwnerPoint);
793 end else begin
794 TP := TrackPosition.BaseTrackPoint.GetDown;
795 if Assigned(TP) then
796 TargetStation := TLineStation(TP.OwnerPoint);
797 end;
798 end else
799 if Direction < 0 then begin
800 if Assigned(TrackPosition.BaseTrackPoint.OwnerPoint) then
801 TargetStation := TLineStation(TrackPosition.BaseTrackPoint.OwnerPoint)
802 else begin
803 TP := TrackPosition.BaseTrackPoint.GetUp;
804 if Assigned(TP) then
805 TargetStation := TLineStation(TP.OwnerPoint);
806 end;
807 end;
808 LastPosDelta := Abs(GetTargetStationDistance);
809end;
810
811function TMetroTrain.GetTargetStationDistance: Integer;
812var
813 Current: Integer;
814 Target: Integer;
815 I: Integer;
816begin
817 Result := 0;
818 if Assigned(TrackPosition.BaseTrackPoint) and Assigned(TargetStation) then begin
819 Current := Line.Track.Points.IndexOf(TrackPosition.BaseTrackPoint);
820 Target := Line.Track.Points.IndexOf(TargetStation.TrackPoint);
821 if Current < Target then begin
822 for I := Current to Target - 1 do
823 Result := Result + Line.Track.Points[I].GetDistance;
824 Result := Result - Trunc(TrackPosition.RelPos);
825 end else
826 if Current > Target then begin
827 for I := Current - 1 downto Target do
828 Result := Result + Line.Track.Points[I].GetDistance;
829 Result := Result + Trunc(TrackPosition.RelPos);
830 end else Result := Trunc(TrackPosition.RelPos);
831 end;
832end;
833
834constructor TMetroTrain.Create;
835begin
836 Passengers := TMetroPassengers.Create;
837 Passengers.OwnsObjects := False;
838 Carriages := TMetroCarriages.Create;
839 Carriages.OwnsObjects := False;
840 Direction := 1;
841 Line := nil;
842end;
843
844destructor TMetroTrain.Destroy;
845begin
846 FreeAndNil(Passengers);
847 FreeAndNil(Carriages);
848 inherited;
849end;
850
851{ TMapStation }
852
853procedure TMapStation.ShiftTrackPoints;
854var
855 TrackLinks: TTrackLinks;
856 I: Integer;
857 J: Integer;
858 Index: Integer;
859 TP: TTrackPoint;
860 LS: TLineStation;
861 Line: TMetroLine;
862 Angle: Float;
863 TPAngleGroup: TTrackPointsAngleGroup;
864 GroupItem: TTrackPointsAngle;
865 NewTrackLink: TTrackLink;
866 HAngle: Double;
867 P1, P2: TPoint;
868 NewShift: TPoint;
869begin
870 TrackLinks := TTrackLinks.Create;
871 TrackLinks.OwnsObjects := False;
872
873 // Collect all near track points as track links
874 SortLines;
875 for I := 0 to Lines.Count - 1 do begin
876 Line := Lines[I];
877 LS := Line.LineStations.SearchMapStation(Self);
878 TP := LS.TrackPoint;
879 Index := Line.Track.Points.IndexOf(TP);
880 if Index > 0 then begin
881 NewTrackLink := Line.Track.Points[Index].GetLinkDown;
882 TrackLinks.Add(NewTrackLink);
883 end;
884 if Index < (Line.Track.Points.Count - 1) then begin
885 NewTrackLink := Line.Track.Points[Index].GetLinkUp;
886 TrackLinks.Add(NewTrackLink);
887 end;
888 if Line.IsCircular and (Self = Line.LineStations.First.MapStation) and
889 (Self = Line.LineStations.Last.MapStation) then begin
890 LS := Line.LineStations.Last;
891 TP := LS.TrackPoint;
892 Index := Line.Track.Points.IndexOf(TP);
893 if Index > 0 then begin
894 NewTrackLink := Line.Track.Points[Index].GetLinkDown;
895 TrackLinks.Add(NewTrackLink);
896 end;
897 if Index < (Line.Track.Points.Count - 1) then begin
898 NewTrackLink := Line.Track.Points[Index].GetLinkUp;
899 TrackLinks.Add(NewTrackLink);
900 end;
901 end;
902 end;
903
904 // Make groups of TrackLinks with same angle
905 TPAngleGroup := TTrackPointsAngleGroup.Create;
906 for I := 0 to TrackLinks.Count - 1 do begin
907 P1 := TrackLinks[I].Points[0].PositionDesigned;
908 P2 := TrackLinks[I].Points[1].PositionDesigned;
909 if ComparePoint(P1, Position) and not ComparePoint(P2, Position) then begin
910 Angle := ArcTan2(P2.Y - Position.Y, P2.X - Position.X);
911 end else
912 if ComparePoint(P2, Position) and not ComparePoint(P1, Position) then begin
913 Angle := ArcTan2(P1.Y - Position.Y, P1.X - Position.X);
914 end else Angle := 0;// else raise Exception.Create('TrackLink angle error');
915
916 GroupItem := TPAngleGroup.SearchAngle(Angle);
917 if not Assigned(GroupItem) then begin
918 GroupItem := TTrackPointsAngle.Create;
919 GroupItem.Angle := Angle;
920 TPAngleGroup.Add(GroupItem);
921 end;
922 GroupItem.TrackLinks.Add(TrackLinks[I]);
923 end;
924
925 // Shift TrackLinks according number of lines in group
926 for I := 0 to TPAngleGroup.Count - 1 do
927 with TPAngleGroup[I] do begin
928 for J := 0 to TrackLinks.Count - 1 do
929 with TrackLinks[J] do begin
930 // Get orthogonal angle
931 HAngle := (Angle + Pi / 2) mod Pi;
932 NewShift.X := Trunc(MetroLineThickness * Cos(HAngle) * (J - (TrackLinks.Count - 1) / 2));
933 NewShift.Y := Trunc(MetroLineThickness * Sin(HAngle) * (J - (TrackLinks.Count - 1) / 2));
934 Shift := NewShift;
935 end;
936 end;
937
938 FreeAndNil(TPAngleGroup);
939 FreeAndNil(TrackLinks);
940end;
941
942function MapStationCompareLine(constref Item1, Item2: TMetroLine): Integer;
943begin
944 if Item1.Index > Item2.Index then Result := 1
945 else if Item1.Index < Item2.Index then Result := -1
946 else Result := 0;
947end;
948
949procedure TMapStation.SortLines;
950begin
951 Lines.Sort(TComparer<TMetroLine>.Construct(MapStationCompareLine));
952end;
953
954function TMapStation.GetMaxPassengers: Integer;
955begin
956 if IsTerminal then Result := MaxWaitingPassengersTerminal
957 else Result := MaxWaitingPassengers;
958end;
959
960function TMapStation.IsBestStationForShape(Shape: TStationShape;
961 Check, Current: TLineStation): Boolean;
962var
963 I: Integer;
964 T: Integer;
965 Distance: Integer;
966 StationIndex: Integer;
967 DirectionUp: Boolean;
968 DirectionDown: Boolean;
969 NextStationUp: TLineStation;
970 NextStationDown: TLineStation;
971 CurrentLineStation: TLineStation;
972begin
973 Distance := High(Integer);
974 for I := 0 to Lines.Count - 1 do
975 with Lines[I] do begin
976 CurrentLineStation := LineStations.SearchMapStation(Current.MapStation);
977 StationIndex := LineStations.IndexOf(CurrentLineStation);
978 if IsCircular then begin
979 DirectionUp := False;
980 DirectionDown := False;
981 for T := 0 to Trains.Count - 1 do begin
982 if Trains[T].Direction = 1 then DirectionUp := True;
983 if Trains[T].Direction = -1 then DirectionDown := True;
984 end;
985 if StationIndex = 0 then
986 NextStationDown := LineStations[LineStations.Count - 2]
987 else
988 if StationIndex > 0 then
989 NextStationDown := LineStations[StationIndex - 1];
990
991 if (StationIndex >= 0) and (StationIndex = LineStations.Count - 1) then
992 NextStationUp := LineStations[1]
993 else
994 if (StationIndex >= 0) and (StationIndex < LineStations.Count - 1) then
995 NextStationUp := LineStations[StationIndex + 1];
996 end else begin
997 if StationIndex > 0 then begin
998 DirectionDown := True;
999 NextStationDown := LineStations[StationIndex - 1]
1000 end else DirectionDown := False;
1001 if (StationIndex >= 0) and (StationIndex < LineStations.Count - 1) then begin
1002 DirectionUp := True;
1003 NextStationUp := LineStations[StationIndex + 1];
1004 end else DirectionUp := False;
1005 end;
1006 if DirectionDown and (NextStationDown.MapStation.ShapeDistance[Shape] <> -1) and
1007 (NextStationDown.MapStation.ShapeDistance[Shape] < Distance) then begin
1008 Distance := NextStationDown.MapStation.ShapeDistance[Shape];
1009 end;
1010 if DirectionUp and (NextStationUp.MapStation.ShapeDistance[Shape] <> -1) and
1011 (NextStationUp.MapStation.ShapeDistance[Shape] < Distance) then begin
1012 Distance := NextStationUp.MapStation.ShapeDistance[Shape];
1013 end;
1014 end;
1015 Result := (Check.MapStation.ShapeDistance[Shape] <> -1) and
1016 (Check.MapStation.ShapeDistance[Shape] <= Distance);
1017end;
1018
1019constructor TMapStation.Create;
1020begin
1021 Passengers := TMetroPassengers.Create;
1022 Passengers.OwnsObjects := False;
1023 Lines := TMetroLines.Create;
1024 Lines.OwnsObjects := False;
1025end;
1026
1027destructor TMapStation.Destroy;
1028begin
1029 FreeAndNil(Lines);
1030 FreeAndNil(Passengers);
1031 inherited;
1032end;
1033
1034{ TEngine }
1035
1036// Need to see all stations on screen
1037procedure TEngine.ResizeView(Force: Boolean);
1038var
1039 NewPoint: TPoint;
1040 Intersected: TRect;
1041 NewView: TView;
1042begin
1043 NewView := TView.Create;
1044 NewView.Assign(View);
1045
1046 NewView.SourceRect := RectEnlarge(Stations.GetRect, 100);
1047 NewPoint := Point(
1048 Trunc((NewView.SourceRect.Left + (NewView.SourceRect.Right - NewView.SourceRect.Left) / 2) -
1049 (NewView.DestRect.Left + (NewView.DestRect.Right - NewView.DestRect.Left) / 2 / NewView.Zoom)),
1050 Trunc((NewView.SourceRect.Top + (NewView.SourceRect.Bottom - NewView.SourceRect.Top) / 2) -
1051 (NewView.DestRect.Top + (NewView.DestRect.Bottom - NewView.DestRect.Top) / 2 / NewView.Zoom)));
1052 NewView.SourceRect := Bounds(NewPoint.X, NewPoint.Y, Trunc((NewView.DestRect.Right - NewView.DestRect.Left) / NewView.Zoom),
1053 Trunc((NewView.DestRect.Bottom - NewView.DestRect.Top) / NewView.Zoom));
1054
1055 Intersected := NewView.SourceRect;
1056 Intersected.Union(View.SourceRect);
1057 if not Force and (Intersected = View.SourceRect) then Exit;
1058
1059 View.Assign(NewView);
1060
1061 NewView.Free;
1062end;
1063
1064function TEngine.GetServedDaysCount: Integer;
1065begin
1066 Result := Trunc(Time);
1067end;
1068
1069function TEngine.GetExistStationShapes: TStationShapeSet;
1070var
1071 Station: TMapStation;
1072begin
1073 Result := [];
1074 for Station in Stations do
1075 Result := Result + [Station.Shape];
1076end;
1077
1078function TEngine.GetStationOnPos(Pos: TPoint): TMapStation;
1079var
1080 I: Integer;
1081const
1082 ClickDistance = 30;
1083begin
1084 I := 0;
1085 while (I < Stations.Count) and (Distance(Stations[I].Position, Pos) > ClickDistance) do Inc(I);
1086 if I < Stations.Count then Result := Stations[I]
1087 else Result := nil;
1088end;
1089
1090function TEngine.GetTrackOnPos(Pos: TPoint; out Intersect: TPoint): TTrackLink;
1091var
1092 I: Integer;
1093 T: Integer;
1094 D: Integer;
1095 MinD: Integer;
1096 TempIntersect: TPoint;
1097begin
1098 Result := TTrackLink.Create;
1099 Result.Points.Count := 2;
1100 Result.Points[0] := nil;
1101 Result.Points[1] := nil;
1102 I := 0;
1103 MinD := High(Integer);
1104 while (I < Lines.Count) do
1105 with TMetroLine(Lines[I]) do begin
1106 for T := 1 to Track.Points.Count - 1 do begin
1107 D := PointToLineDistance(Pos, Track.Points[T - 1].Position, Track.Points[T].Position,
1108 TempIntersect);
1109 if (D < MinD) and (D < TrackClickDistance) then begin
1110 MinD := D;
1111 Result.Points[0] := Track.Points[T - 1];
1112 Result.Points[1] := Track.Points[T];
1113 Intersect := TempIntersect;
1114 end;
1115 end;
1116 Inc(I);
1117 end;
1118end;
1119
1120function TEngine.GetTrainOnPos(Pos: TPoint): TMetroTrain;
1121var
1122 I: Integer;
1123 MinDistance: Integer;
1124 D: Integer;
1125begin
1126 Result := nil;
1127 MinDistance := High(Integer);
1128 for I := 0 to Trains.Count - 1 do
1129 with TMetroTrain(Trains[I]) do begin
1130 D := Distance(TrackPosition.GetVector.Position, Pos);
1131 if (D < (TrainSize div 2)) and (D < MinDistance) then begin
1132 Result := Trains[I];
1133 MinDistance := D;
1134 end;
1135 end;
1136end;
1137
1138function TEngine.GetCarriageOnPos(Pos: TPoint): TMetroCarriage;
1139var
1140 I: Integer;
1141 J: Integer;
1142 MinDistance: Integer;
1143 D: Integer;
1144begin
1145 Result := nil;
1146 MinDistance := High(Integer);
1147 for I := 0 to Trains.Count - 1 do
1148 with TMetroTrain(Trains[I]) do begin
1149 for J := 0 to Carriages.Count - 1 do
1150 with TMetroCarriage(Carriages[J]) do begin
1151 D := Distance(GetTrackPosition.GetVector.Position, Pos);
1152 if (D < (TrainSize div 2)) and (D < MinDistance) then begin
1153 Result := Carriages[J];
1154 MinDistance := D;
1155 end;
1156 end;
1157 end;
1158end;
1159
1160procedure TEngine.DrawFrame(Canvas: TCanvas; Rect: TRect);
1161begin
1162 with Canvas do begin
1163 Pen.Color := Self.Colors.Text;
1164 Pen.Style := psSolid;
1165 Pen.Width := ScaleX(2, 96);
1166 Brush.Color := Self.Colors.Background2;
1167 Brush.Style := bsSolid;
1168 Rectangle(Rect);
1169 Pen.Style := psClear;
1170 end;
1171end;
1172
1173procedure TEngine.DrawLine(Canvas: TCanvas; Pos: TPoint);
1174var
1175 Delta: TPoint;
1176begin
1177 Delta := Point(Pos.X - Canvas.PenPos.X, Pos.Y - Canvas.PenPos.Y);
1178 if Abs(Delta.X) > Abs(Delta.Y) then begin
1179 Canvas.LineTo(Pos.X - Sign(Delta.X) * Abs(Delta.Y), Canvas.PenPos.Y);
1180 end else begin
1181 Canvas.LineTo(Canvas.PenPos.X, Pos.Y - Sign(Delta.Y) * Abs(Delta.X));
1182 end;
1183 Canvas.LineTo(Pos.X, Pos.Y);
1184end;
1185
1186procedure TEngine.DrawShape(Canvas: TCanvas; Position: TPoint; Shape: TStationShape;
1187 Size: Integer; Angle: Double);
1188var
1189 Points: array of TPoint;
1190 I: Integer;
1191 Angle2: Double;
1192begin
1193 case Shape of
1194 ssSquare: begin
1195 SetLength(Points, 4);
1196 Points[0] := Point(Position.X - Size div 2, Position.Y - Size div 2);
1197 Points[1] := Point(Position.X + Size div 2, Position.Y - Size div 2);
1198 Points[2] := Point(Position.X + Size div 2, Position.Y + Size div 2);
1199 Points[3] := Point(Position.X - Size div 2, Position.Y + Size div 2);
1200 Points := RotatePoints(Position, Points, Angle);
1201 Canvas.Polygon(Points);
1202 end;
1203 ssCircle: Canvas.Ellipse(
1204 Position.X - Size div 2, Position.Y - Size div 2,
1205 Position.X + Size div 2, Position.Y + Size div 2);
1206 ssTriangle: begin
1207 SetLength(Points, 3);
1208 Points[0] := Point(Position.X, Position.Y - Size div 2);
1209 Points[1] := Point(Position.X + Size div 2, Position.Y + Size div 2);
1210 Points[2] := Point(Position.X - Size div 2, Position.Y + Size div 2);
1211 Points := RotatePoints(Position, Points, Angle);
1212 Canvas.Polygon(Points);
1213 end;
1214 ssStar: begin
1215 SetLength(Points, 10);
1216 for I := 0 to 9 do begin
1217 Angle2 := I / 10 * 2 * Pi - Pi / 2;
1218 if (I mod 2) = 0 then
1219 Points[I] := Point(Round(Position.X + Cos(Angle2) * Size / 2),
1220 Round(Position.Y + Sin(Angle2) * Size / 2))
1221 else
1222 Points[I] := Point(Round(Position.X + Cos(Angle2) * Size / 5),
1223 Round(Position.Y + Sin(Angle2) * Size / 5));
1224 end;
1225 Points := RotatePoints(Position, Points, Angle);
1226 Canvas.Polygon(Points);
1227 end;
1228 ssPlus: begin
1229 SetLength(Points, 12);
1230 Points[0] := Point(Position.X + Size div 6, Position.Y - Size div 6);
1231 Points[1] := Point(Position.X + Size div 2, Position.Y - Size div 6);
1232 Points[2] := Point(Position.X + Size div 2, Position.Y + Size div 6);
1233 Points[3] := Point(Position.X + Size div 6, Position.Y + Size div 6);
1234 Points[4] := Point(Position.X + Size div 6, Position.Y + Size div 2);
1235 Points[5] := Point(Position.X - Size div 6, Position.Y + Size div 2);
1236 Points[6] := Point(Position.X - Size div 6, Position.Y + Size div 6);
1237 Points[7] := Point(Position.X - Size div 2, Position.Y + Size div 6);
1238 Points[8] := Point(Position.X - Size div 2, Position.Y - Size div 6);
1239 Points[9] := Point(Position.X - Size div 6, Position.Y - Size div 6);
1240 Points[10] := Point(Position.X - Size div 6, Position.Y - Size div 2);
1241 Points[11] := Point(Position.X + Size div 6, Position.Y - Size div 2);
1242 Points := RotatePoints(Position, Points, Angle);
1243 Canvas.Polygon(Points);
1244 end;
1245 ssPentagon: begin
1246 SetLength(Points, 5);
1247 for I := 0 to 4 do begin
1248 Angle2 := I / 5 * 2 * Pi - Pi / 2;
1249 Points[I] := Point(Round(Position.X + Cos(Angle2) * Size / 2),
1250 Round(Position.Y + Sin(Angle2) * Size / 2));
1251 end;
1252 Points := RotatePoints(Position, Points, Angle);
1253 Canvas.Polygon(Points);
1254 end;
1255 ssHexagon: begin
1256 SetLength(Points, 6);
1257 for I := 0 to 5 do begin
1258 Angle2 := I / 6 * 2 * Pi - Pi / 2;
1259 Points[I] := Point(Round(Position.X + Cos(Angle2) * Size / 2),
1260 Round(Position.Y + Sin(Angle2) * Size / 2));
1261 end;
1262 Points := RotatePoints(Position, Points, Angle);
1263 Canvas.Polygon(Points);
1264 end;
1265 ssDiamond: begin
1266 SetLength(Points, 4);
1267 Points[0] := Point(Position.X, Position.Y - Size div 2);
1268 Points[1] := Point(Position.X + Size div 2, Position.Y);
1269 Points[2] := Point(Position.X, Position.Y + Size div 2);
1270 Points[3] := Point(Position.X - Size div 2, Position.Y);
1271 Points := RotatePoints(Position, Points, Angle);
1272 Canvas.Polygon(Points);
1273 end;
1274 ssCross: begin
1275 SetLength(Points, 12);
1276 Points[0] := Point(Position.X + Size div 6, Position.Y - Size div 6);
1277 Points[1] := Point(Position.X + Size div 2, Position.Y - Size div 6);
1278 Points[2] := Point(Position.X + Size div 2, Position.Y + Size div 6);
1279 Points[3] := Point(Position.X + Size div 6, Position.Y + Size div 6);
1280 Points[4] := Point(Position.X + Size div 6, Position.Y + Size div 2);
1281 Points[5] := Point(Position.X - Size div 6, Position.Y + Size div 2);
1282 Points[6] := Point(Position.X - Size div 6, Position.Y + Size div 6);
1283 Points[7] := Point(Position.X - Size div 2, Position.Y + Size div 6);
1284 Points[8] := Point(Position.X - Size div 2, Position.Y - Size div 6);
1285 Points[9] := Point(Position.X - Size div 6, Position.Y - Size div 6);
1286 Points[10] := Point(Position.X - Size div 6, Position.Y - Size div 2);
1287 Points[11] := Point(Position.X + Size div 6, Position.Y - Size div 2);
1288 Points := RotatePoints(Position, Points, Angle + Pi / 4);
1289 Canvas.Polygon(Points);
1290 end;
1291 ssHalfCircle: Canvas.Pie(
1292 Position.X - Size div 2, Position.Y - Size div 2,
1293 Position.X + Size div 2, Position.Y + Size div 2,
1294 Position.X - Size div 2, Position.Y,
1295 Position.X + Size div 2, Position.Y);
1296 ssQuarterCircle: Canvas.Pie(
1297 Position.X - Size div 2 - Size, Position.Y - Size div 2,
1298 Position.X + Size div 2, Position.Y + Size div 2 + Size,
1299 Position.X + Size div 2, Position.Y + Size div 2,
1300 Position.X - Size div 2, Position.Y - Size div 2);
1301 ssHeptagon: begin
1302 SetLength(Points, 8);
1303 for I := 0 to High(Points) do begin
1304 Angle2 := I / Length(Points) * 2 * Pi - Pi / 2;
1305 Points[I] := Point(Round(Position.X + Cos(Angle2) * Size / 2),
1306 Round(Position.Y + Sin(Angle2) * Size / 2));
1307 end;
1308 Points := RotatePoints(Position, Points, Angle);
1309 Canvas.Polygon(Points);
1310 end;
1311 end;
1312end;
1313
1314procedure TEngine.ComputeShapeDistance;
1315var
1316 S: TStationShape;
1317 Station: TMapStation;
1318begin
1319 // NewGame all distances
1320 for Station in Stations do
1321 with Station do begin
1322 for S := Low(ShapeDistance) to High(ShapeDistance) do
1323 ShapeDistance[S] := -1;
1324 end;
1325
1326 // Propagate shape distance for all stations
1327 // Distace 0 means that station is final target
1328 for Station in Stations do
1329 with Station do begin
1330 ComputeShapeDistanceStation(Station, Shape, 0);
1331 end;
1332end;
1333
1334procedure TEngine.ComputeShapeDistanceStation(Station: TMapStation;
1335 UpdatedShape: TStationShape; Distance: Integer);
1336var
1337 I: Integer;
1338 T: Integer;
1339 StationIndex: Integer;
1340 DirectionDown: Boolean;
1341 DirectionUp: Boolean;
1342begin
1343 with Station do begin
1344 if (Distance < ShapeDistance[UpdatedShape]) or (ShapeDistance[UpdatedShape] = -1) then begin
1345 ShapeDistance[UpdatedShape] := Distance;
1346 // Do for all lines connected to station
1347 for I := 0 to Lines.Count - 1 do
1348 with Lines[I] do
1349 for StationIndex := 0 to LineStations.Count - 1 do
1350 if LineStations[StationIndex].MapStation = Station then begin
1351 if not IsCircular then begin
1352 // Update for all adjecent stations
1353 if StationIndex > 0 then
1354 ComputeShapeDistanceStation(LineStations[StationIndex - 1].MapStation,
1355 UpdatedShape, Station.ShapeDistance[UpdatedShape] + 1);
1356 if (StationIndex >= 0) and (StationIndex < LineStations.Count - 1) then
1357 ComputeShapeDistanceStation(LineStations[StationIndex + 1].MapStation,
1358 UpdatedShape, Station.ShapeDistance[UpdatedShape] + 1);
1359 end else begin
1360 // If circular then trains might go in single direction so passengers
1361 // waiting for opposite directions are wrong
1362 DirectionUp := False;
1363 DirectionDown := False;
1364 for T := 0 to Trains.Count - 1 do begin
1365 if Trains[T].Direction = 1 then DirectionUp := True;
1366 if Trains[T].Direction = -1 then DirectionDown := True;
1367 end;
1368 // Update for all adjecent stations
1369 if DirectionUp then begin
1370 if StationIndex = 0 then
1371 ComputeShapeDistanceStation(LineStations[LineStations.Count - 2].MapStation,
1372 UpdatedShape, Station.ShapeDistance[UpdatedShape] + 1);
1373 if StationIndex > 0 then
1374 ComputeShapeDistanceStation(LineStations[StationIndex - 1].MapStation,
1375 UpdatedShape, Station.ShapeDistance[UpdatedShape] + 1);
1376 end;
1377 if DirectionDown then begin
1378 if (StationIndex >= 0) and (StationIndex = LineStations.Count - 1) then
1379 ComputeShapeDistanceStation(LineStations[1].MapStation,
1380 UpdatedShape, Station.ShapeDistance[UpdatedShape] + 1);
1381 if (StationIndex >= 0) and (StationIndex < LineStations.Count - 1) then
1382 ComputeShapeDistanceStation(LineStations[StationIndex + 1].MapStation,
1383 UpdatedShape, Station.ShapeDistance[UpdatedShape] + 1);
1384 end;
1385 end;
1386 end;
1387 end;
1388 end;
1389end;
1390
1391procedure TEngine.SetDarkMode(AValue: Boolean);
1392begin
1393 if FDarkMode = AValue then Exit;
1394 FDarkMode := AValue;
1395 Colors.Init(FDarkMode);
1396 if Assigned(FOnDarkModeChange) then FOnDarkModeChange(Self);
1397end;
1398
1399procedure TEngine.SetState(AValue: TGameState);
1400begin
1401 if FState = AValue then Exit;
1402 FState := AValue;
1403 UpdateInterface;
1404end;
1405
1406procedure TEngine.TrainsMovement;
1407var
1408 I: Integer;
1409begin
1410 for I := 0 to Trains.Count - 1 do
1411 TrainMovement(Trains[I]);
1412end;
1413
1414procedure TEngine.TrainMovement(Train: TMetroTrain);
1415var
1416 J: Integer;
1417 CurrentStation: TLineStation;
1418 P: Integer;
1419 Passenger: TMetroPassenger;
1420 PosDelta: Integer;
1421 TargetStationIndex: Integer;
1422 PosChange: Double;
1423 Done: Boolean;
1424begin
1425 with Train do begin
1426 if Assigned(Line) then begin
1427 if InStation then begin
1428 if (Time - StationStopTime) > OneHour then begin
1429 CurrentStation := TargetStation;
1430
1431 // Choose next target station
1432 TargetStationIndex := Line.LineStations.IndexOf(TargetStation) + Direction;
1433 if TargetStationIndex < 0 then begin
1434 if Line.IsCircular then begin
1435 TargetStationIndex := Line.LineStations.Count - 2;
1436 TrackPosition.BaseTrackPoint := Line.LineStations.Last.TrackPoint;
1437 TrackPosition.RelPos := 0;
1438 end else begin
1439 TargetStationIndex := 1;
1440 Direction := -Direction;
1441 end;
1442 end else
1443 if TargetStationIndex >= Line.LineStations.Count then begin
1444 if Line.IsCircular then begin
1445 TargetStationIndex := 1;
1446 TrackPosition.BaseTrackPoint := Line.LineStations.First.TrackPoint;
1447 TrackPosition.RelPos := 0;
1448 end else begin
1449 TargetStationIndex := Line.LineStations.Count - 2;
1450 Direction := -Direction;
1451 end;
1452 end;
1453 TargetStation := Line.LineStations[TargetStationIndex];
1454
1455 // Unload passengers in target station
1456 if Assigned(CurrentStation) then begin
1457 for P := Passengers.Count - 1 downto 0 do begin
1458 if Passengers[P].Shape = CurrentStation.MapStation.Shape then begin
1459 Passenger := Passengers[P];
1460 Passengers.Delete(P);
1461 Self.Passengers.Remove(Passenger);
1462 Inc(ServedPassengerCount);
1463 end;
1464 end;
1465 for J := 0 to Carriages.Count - 1 do
1466 with Carriages[J] do begin
1467 for P := Passengers.Count - 1 downto 0 do begin
1468 if Passengers[P].Shape = CurrentStation.MapStation.Shape then begin
1469 Passenger := Passengers[P];
1470 Passengers.Delete(P);
1471 Self.Passengers.Remove(Passenger);
1472 Inc(ServedPassengerCount);
1473 end;
1474 end;
1475 end;
1476 end;
1477
1478 // Unload passengers to change line
1479 if Assigned(CurrentStation) then begin
1480 for P := Passengers.Count - 1 downto 0 do begin
1481 if not CurrentStation.MapStation.IsBestStationForShape(Passengers[P].Shape,
1482 TargetStation, CurrentStation) then begin
1483 Passenger := Passengers[P];
1484 Passengers.Delete(P);
1485 CurrentStation.MapStation.Passengers.Add(Passenger);
1486 end;
1487 end;
1488 for J := 0 to Carriages.Count - 1 do
1489 with Carriages[J] do begin
1490 for P := Passengers.Count - 1 downto 0 do begin
1491 if not CurrentStation.MapStation.IsBestStationForShape(Passengers[P].Shape,
1492 TargetStation, CurrentStation) then begin
1493 Passenger := Passengers[P];
1494 Passengers.Delete(P);
1495 CurrentStation.MapStation.Passengers.Add(Passenger);
1496 end;
1497 end;
1498 end;
1499 end;
1500
1501 // Load new passengers
1502 if Assigned(CurrentStation) and not Assigned(CurrentStation.MapStation) then
1503 raise Exception.Create(SStationWithoutMapStation);
1504 if Assigned(CurrentStation) then
1505 for P := CurrentStation.MapStation.Passengers.Count - 1 downto 0 do begin
1506 if (Passengers.Count < TrainPassengerCount) then begin
1507 Passenger := CurrentStation.MapStation.Passengers[P];
1508 if CurrentStation.MapStation.IsBestStationForShape(Passenger.Shape,
1509 TargetStation, CurrentStation) then begin
1510 CurrentStation.MapStation.Passengers.Delete(P);
1511 Passengers.Add(Passenger);
1512 end;
1513 end else begin
1514 Done := False;
1515 for J := 0 to Carriages.Count - 1 do
1516 with Carriages[J] do begin
1517 if (Passengers.Count < TrainPassengerCount) then begin
1518 Passenger := CurrentStation.MapStation.Passengers[P];
1519 if CurrentStation.MapStation.IsBestStationForShape(Passenger.Shape,
1520 TargetStation, CurrentStation) then begin
1521 CurrentStation.MapStation.Passengers.Delete(P);
1522 Passengers.Add(Passenger);
1523 Done := True;
1524 Break;
1525 end;
1526 end;
1527 end;
1528 if not Done then Break;
1529 end;
1530 end;
1531
1532 LastPosDelta := Abs(GetTargetStationDistance);
1533 InStation := False;
1534 LastTrainMoveTime := Time;
1535 end;
1536 end else begin
1537 PosChange := Direction + Trunc(Direction * TrainSpeed * (Time - LastTrainMoveTime));
1538 LastTrainMoveTime := Time;
1539 Redraw;
1540 if Assigned(TrackPosition.BaseTrackPoint) then
1541 TrackPosition.Move(PosChange);
1542
1543 if Assigned(TargetStation) then begin
1544 PosDelta := Abs(GetTargetStationDistance);
1545 if PosDelta >= LastPosDelta then begin
1546 // We are getting far from station, stop at station
1547 TrackPosition.BaseTrackPoint := TargetStation.TrackPoint;
1548 TrackPosition.RelPos := 0;
1549 InStation := True;
1550 StationStopTime := Time;
1551 Redraw;
1552 end;
1553 end;
1554 LastPosDelta := PosDelta;
1555 end;
1556 end;
1557 end;
1558end;
1559
1560function TEngine.GetUnusedLine: TMetroLine;
1561var
1562 I: Integer;
1563begin
1564 I := 0;
1565 while (I < Lines.Count) and (Lines[I].Track.Points.Count > 0) do Inc(I);
1566 if I < Lines.Count then Result := Lines[I]
1567 else Result := nil;
1568end;
1569
1570procedure TEngine.ShiftTrackPoints;
1571var
1572 I: Integer;
1573 J: Integer;
1574 //Link1, Link2: TPoint;
1575 NewPoint: TPoint;
1576 MetroLine: TMetroLine;
1577 TrackPoint: TTrackPoint;
1578 MapStation: TMapStation;
1579begin
1580 // NewGame all trackpoints position shift
1581 for MetroLine in Lines do
1582 for TrackPoint in MetroLine.Track.Points do
1583 TrackPoint.Position := TrackPoint.PositionDesigned;
1584
1585 // Calculate new position shifts
1586 for MapStation in Stations do
1587 MapStation.ShiftTrackPoints;
1588
1589 // Compute track points from track shift
1590 for MetroLine in Lines do
1591 with MetroLine do begin
1592 // Update start
1593 if Track.Points.Count > 1 then begin
1594 Track.Points[0].Position := Track.Points[0].PositionDesigned +
1595 Track.Points[0].LinkUp.Shift;
1596 end;
1597
1598 for I := 1 to Track.Points.Count - 1 do
1599 with Track.Points[I] do
1600 if Assigned(Track.Points[I].LinkDown) and Assigned(Track.Points[I].LinkUp) then begin
1601 {
1602 Link1 := (Track.Points[I].PositionDesigned + Track.Points[I].LinkDown.Shift) -
1603 (Track.Points[I - 1].PositionDesigned + Track.Points[I].LinkDown.Shift);
1604 if (I + 1) < Track.Points.Count then
1605 Link2 := (Track.Points[I + 1].PositionDesigned + Track.Points[I].LinkUp.Shift) -
1606 (Track.Points[I].PositionDesigned + Track.Points[I].LinkUp.Shift)
1607 else Link2 := Link1;
1608
1609 if ArcTanPoint(Link1) = ArcTanPoint(Link2) then begin
1610 // Parallel lines
1611 NewPoint := Track.Points[I].PositionDesigned + Track.Points[I].LinkDown.Shift;
1612 Track.Points[I].Position := NewPoint;
1613 end else begin}
1614 // Intersected lines
1615 if LineIntersect(Track.Points[I - 1].PositionDesigned + Track.Points[I].LinkDown.Shift,
1616 Track.Points[I].PositionDesigned + Track.Points[I].LinkDown.Shift,
1617 Track.Points[I].PositionDesigned + Track.Points[I].LinkUp.Shift,
1618 Track.Points[I + 1].PositionDesigned + Track.Points[I].LinkUp.Shift, NewPoint) then begin
1619 Track.Points[I].Position := NewPoint;
1620 end else begin
1621 // Parallel lines
1622 NewPoint := Track.Points[I].PositionDesigned + Track.Points[I].LinkDown.Shift;
1623 Track.Points[I].Position := NewPoint;
1624 end;
1625// end;
1626
1627 // Update ending
1628 if Track.Points.Count > 1 then begin
1629 Track.Points[Track.Points.Count - 1].Position := Track.Points[Track.Points.Count - 1].PositionDesigned -
1630 Track.Points[Track.Points.Count - 1].LinkDown.Shift;
1631 end;
1632 end;
1633
1634 // Update ending
1635 if Track.Points.Count > 1 then begin
1636 Track.Points[Track.Points.Count - 1].Position := Track.Points[Track.Points.Count - 1].PositionDesigned -
1637 Track.Points[Track.Points.Count - 1].LinkDown.Shift;
1638 end;
1639 end;
1640
1641 // Remove all temporal links
1642 for MetroLine in Lines do
1643 with MetroLine do begin
1644 for J := 0 to Track.Points.Count - 1 do
1645 if Assigned(Track.Points[J].LinkUp) then begin
1646 Track.Points[J].LinkUp.Free;
1647 Track.Points[J].LinkUp := nil;
1648 Track.Points[J + 1].LinkDown := nil;
1649 end;
1650 end;
1651end;
1652
1653procedure TEngine.MenuItemExit(Sender: TObject);
1654begin
1655 FormMain.Close;
1656end;
1657
1658procedure TEngine.MenuItemCity(Sender: TObject);
1659begin
1660 if Sender is TMenuItemButton then begin;
1661 City := TCity(TMenuItemButton(Sender).Ref);
1662 NewGame;
1663 end;
1664end;
1665
1666procedure TEngine.MenuItemPlay(Sender: TObject);
1667begin
1668 City := nil;
1669 NewGame;
1670end;
1671
1672procedure TEngine.MenuItemCareer(Sender: TObject);
1673var
1674 City: TCity;
1675begin
1676 MenuCareer.Parent := MenuMain;
1677 with MenuCareer, Items do begin
1678 Clear;
1679 for City in Cities do
1680 with AddButton(City.Name, MenuItemCity) do begin
1681 Ref := City;
1682 Enabled := not City.Locked;
1683 TextSize := 40;
1684 TextColor := Colors.MenuItemText;
1685 TextDisabledColor := Colors.MenuItemDisabledText;
1686 BackgroundColor := Colors.MenuItemBackground;
1687 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
1688 end;
1689 with AddButton(SBack, MenuItemBack) do begin
1690 TextSize := 40;
1691 TextColor := Colors.MenuItemText;
1692 TextDisabledColor := Colors.MenuItemDisabledText;
1693 BackgroundColor := Colors.MenuItemBackground;
1694 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
1695 end;
1696 OnExit := MenuItemBack;
1697 end;
1698
1699 Menu := MenuCareer;
1700 Redraw;
1701end;
1702
1703procedure TEngine.MenuItemOptions(Sender: TObject);
1704begin
1705 MenuOptions.Parent := MenuMain;
1706 with MenuOptions, Items do begin
1707 Clear;
1708 with AddComboBox(SLanguage, [], LanguageChanged) do begin
1709 TextSize := 40;
1710 TextColor := Colors.MenuItemText;
1711 TextDisabledColor := Colors.MenuItemDisabledText;
1712 BackgroundColor := Colors.MenuItemBackground;
1713 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
1714 FormMain.Translator1.LanguageListToStrings(States);
1715 Index := States.IndexOfObject(FormMain.Translator1.Language);
1716 if Index = -1 then Index := 0;
1717 end;
1718 with AddCheckBox(SDarkMode, DarkModeChanged) do begin
1719 TextSize := 40;
1720 TextColor := Colors.MenuItemText;
1721 TextDisabledColor := Colors.MenuItemDisabledText;
1722 BackgroundColor := Colors.MenuItemBackground;
1723 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
1724 Checked := DarkMode;
1725 end;
1726 with AddCheckBox(SFullScreen, FullScreenChanged) do begin
1727 TextSize := 40;
1728 TextColor := Colors.MenuItemText;
1729 TextDisabledColor := Colors.MenuItemDisabledText;
1730 BackgroundColor := Colors.MenuItemBackground;
1731 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
1732 Checked := FormMain.FullScreen;
1733 end;
1734 with AddButton(SBack, MenuItemBack) do begin
1735 TextSize := 40;
1736 TextColor := Colors.MenuItemText;
1737 TextDisabledColor := Colors.MenuItemDisabledText;
1738 BackgroundColor := Colors.MenuItemBackground;
1739 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
1740 end;
1741 OnExit := MenuItemBack;
1742 end;
1743
1744 Menu := MenuOptions;
1745 Redraw;
1746end;
1747
1748procedure TEngine.MenuItemBack(Sender: TObject);
1749begin
1750 if Assigned(Menu.Parent) then begin
1751 Menu := Menu.Parent;
1752 Redraw;
1753 end else MenuItemExit(nil);
1754end;
1755
1756procedure TEngine.ButtonPlay(Sender: TObject);
1757begin
1758 TimePerSecond := TimePerSecondNormal;
1759 if State = gsPaused then State := gsRunning;
1760 UpdateInterface;
1761end;
1762
1763procedure TEngine.ButtonPause(Sender: TObject);
1764begin
1765 if State = gsRunning then State := gsPaused;
1766 UpdateInterface;
1767end;
1768
1769procedure TEngine.ButtonFastForward(Sender: TObject);
1770begin
1771 TimePerSecond := TimePerSecondFast;
1772 if State = gsPaused then State := gsRunning;
1773 UpdateInterface;
1774end;
1775
1776procedure TEngine.ButtonNewTrain(Sender: TObject);
1777var
1778 Improvements: TList<TMetroImprovement>;
1779 Improvement: TMetroImprovement;
1780 Index: Integer;
1781begin
1782 Trains.AddNew;
1783 State := gsNewImprovement;
1784 if Lines.Count <= (High(LineColors) - Low(LineColors)) then
1785 AvailableImprovements := AvailableImprovements + [miLine]
1786 else AvailableImprovements := AvailableImprovements - [miLine];
1787
1788 // Select offered improvements
1789 Improvements := TList<TMetroImprovement>.Create;
1790 try
1791 for Improvement := Low(TMetroImprovement) to High(TMetroImprovement) do
1792 if Improvement in AvailableImprovements then begin
1793 Improvements.Add(Improvement);
1794 end;
1795
1796 Index := Random(Integer(Improvements.Count));
1797 Improvement1 := Improvements[Index];
1798 Improvements.Delete(Index);
1799
1800 if Improvements.Count > 0 then begin
1801 Index := Random(Integer(Improvements.Count));
1802 Improvement2 := Improvements[Index];
1803 end else Improvement2 := miNone;
1804
1805 if Improvement1 <> miNone then
1806 ImageNewImprovement1.Bitmap.Assign(GetImprovementBitmap(Improvement1));
1807 ImageNewImprovement1.Enabled := Improvement1 <> miNone;
1808
1809 if Improvement2 <> miNone then
1810 ImageNewImprovement2.Bitmap.Assign(GetImprovementBitmap(Improvement2));
1811 ImageNewImprovement2.Enabled := Improvement2 <> miNone;
1812 finally
1813 Improvements.Free;
1814 end;
1815 Redraw;
1816end;
1817
1818procedure TEngine.ButtonNewImprovement1(Sender: TObject);
1819begin
1820 EvaluateImprovement(Improvement1);
1821 State := gsRunning;
1822 Redraw;
1823end;
1824
1825procedure TEngine.ButtonNewImprovement2(Sender: TObject);
1826begin
1827 EvaluateImprovement(Improvement2);
1828 State := gsRunning;
1829 Redraw;
1830end;
1831
1832procedure TEngine.MenuItemGameContinue(Sender: TObject);
1833begin
1834 State := LastState;
1835 Redraw;
1836end;
1837
1838procedure TEngine.MenuItemGameExit(Sender: TObject);
1839begin
1840 State := gsMenu;
1841 Clear;
1842 Menu := MenuMain;
1843 Redraw;
1844end;
1845
1846procedure TEngine.MenuItemGameRestart(Sender: TObject);
1847begin
1848 NewGame;
1849end;
1850
1851procedure TEngine.DarkModeChanged(Sender: TObject);
1852begin
1853 DarkMode := TMenuItemCheckBox(Sender).Checked;
1854 InitMenus;
1855end;
1856
1857procedure TEngine.LanguageChanged(Sender: TObject);
1858var
1859 NewLanguage: TLanguage;
1860begin
1861 NewLanguage := TLanguage(TMenuItemComboBox(Sender).States.Objects[TMenuItemComboBox(Sender).Index]);
1862 if FormMain.Translator1.Language <> NewLanguage then begin
1863 FormMain.Translator1.Language := NewLanguage;
1864 FormMain.Translator1.Translate;
1865 InitMenus;
1866
1867 // Recreate cities with translated names
1868 SaveToRegistry;
1869 InitCities;
1870 LoadFromRegistry;
1871 end;
1872end;
1873
1874procedure TEngine.FullScreenChanged(Sender: TObject);
1875begin
1876 FormMain.FullScreen := TMenuItemCheckBox(Sender).Checked;
1877 FormMain.PersistentForm1.SetFullScreen(FormMain.FullScreen);
1878end;
1879
1880procedure TEngine.UpdateInterface;
1881begin
1882 ImagePlay.Enabled := not ((State = gsRunning) and (TimePerSecond = TimePerSecondNormal));
1883 ImageFastForward.Enabled := not ((State = gsRunning) and (TimePerSecond = TimePerSecondFast));
1884 ImagePause.Enabled := FState = gsRunning; //not (State = gsPaused);
1885end;
1886
1887procedure TEngine.InitCities;
1888var
1889 I: Integer;
1890begin
1891 with Cities do begin
1892 Clear;
1893 with AddNew('Prague', SPrague, 1275406) do begin
1894 LineColors := [clRed, clGreen, clYellow];
1895 InitialLineCount := 1;
1896 PassengersCountToUnlock := 300;
1897 end;
1898 with AddNew('Paris', SParis, 2138551) do begin
1899 LineColors := [clRed, clGreen, clYellow, clBlue, clBrown, clOrange,
1900 clPurple, clOlive, clAqua, clDarkYellow, clPink];
1901 InitialLineCount := 1;
1902 PassengersCountToUnlock := 500;
1903 end;
1904 with AddNew('Rome', SRome, 2872800) do begin
1905 LineColors := [clRed, clGreen, clYellow];
1906 InitialLineCount := 1;
1907 PassengersCountToUnlock := 700;
1908 end;
1909 with AddNew('NewYork', SNewYork, 8804190) do begin
1910 InitialLineCount := 1;
1911 PassengersCountToUnlock := 1000;
1912 end;
1913 with AddNew('London', SLondon, 9002488) do begin
1914 InitialLineCount := 3;
1915 PassengersCountToUnlock := 1500;
1916 end;
1917 with AddNew('Seoul', SSeoul, 10197604) do begin
1918 InitialLineCount := 3;
1919 LineColors := [clRed, clGreen, clYellow, clOrange, clGray,
1920 clPink, clCyan, clMoneyGreen, clPurple, clSkyBlue];
1921 PassengersCountToUnlock := 2000;
1922 end;
1923 with AddNew('Tokyo', STokyo, 13960236) do begin
1924 InitialLineCount := 3;
1925 PassengersCountToUnlock := 2500;
1926 end;
1927 with AddNew('Beijing', SBeijing, 21893095) do begin
1928 InitialLineCount := 3;
1929 LineColors := [clRed, clGreen, clYellow, clOrange, clOlive, clGray,
1930 clPink, clCyan, clMoneyGreen, clPurple, clSkyBlue, clBrown];
1931 PassengersCountToUnlock := 3000;
1932 end;
1933 end;
1934 for I := 1 to Cities.Count - 1 do
1935 Cities[I].Locked := True;
1936end;
1937
1938function TEngine.GetImprovementText(Improvement: TMetroImprovement): string;
1939begin
1940 case Improvement of
1941 miCarriage: Result := SCarriage;
1942 miTerminal: Result := STerminal;
1943 miTunnel: Result := STunnel;
1944 miLine: Result := SLine;
1945 end;
1946end;
1947
1948function TEngine.GetImprovementBitmap(Improvement: TMetroImprovement): TBitmap;
1949begin
1950 case Improvement of
1951 miCarriage: Result := ImageCarriage.Bitmap;
1952 miTerminal: Result := ImageTerminal.Bitmap;
1953 miTunnel: Result := ImageTunnel.Bitmap;
1954 miLine: Result := ImageLine.Bitmap;
1955 end;
1956end;
1957
1958procedure TEngine.EvaluateImprovement(Improvement: TMetroImprovement);
1959begin
1960 case Improvement of
1961 miLine: Lines.AddNew(LineColors[Lines.Count]);
1962 miCarriage: Carriages.AddNew;
1963 //miTunnel: Tunnels.AddNew;
1964 miTerminal: Inc(AvailableTerminals);
1965 end;
1966end;
1967
1968procedure TEngine.InitMenus;
1969begin
1970 with MenuMain, Items do begin
1971 Clear;
1972 with AddButton(SBigMetro, nil) do begin
1973 Enabled := False;
1974 TextSize := 60;
1975 TextColor := Colors.Text;
1976 TextDisabledColor := Colors.Text;
1977 BackgroundColor := clNone;
1978 BackgroundSelectedColor := clNone;
1979 end;
1980 with AddButton(SPlay, MenuItemPlay) do begin
1981 TextSize := 40;
1982 TextColor := Colors.MenuItemText;
1983 TextDisabledColor := Colors.MenuItemDisabledText;
1984 BackgroundColor := Colors.MenuItemBackground;
1985 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
1986 end;
1987 with AddButton(SCareer, MenuItemCareer) do begin
1988 TextSize := 40;
1989 TextColor := Colors.MenuItemText;
1990 TextDisabledColor := Colors.MenuItemDisabledText;
1991 BackgroundColor := Colors.MenuItemBackground;
1992 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
1993 end;
1994 with AddButton(SOptions, MenuItemOptions) do begin
1995 TextSize := 40;
1996 TextColor := Colors.MenuItemText;
1997 TextDisabledColor := Colors.MenuItemDisabledText;
1998 BackgroundColor := Colors.MenuItemBackground;
1999 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2000 end;
2001 with AddButton(SExit, MenuItemExit) do begin
2002 TextSize := 40;
2003 TextColor := Colors.MenuItemText;
2004 TextDisabledColor := Colors.MenuItemDisabledText;
2005 BackgroundColor := Colors.MenuItemBackground;
2006 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2007 end;
2008 OnExit := MenuItemExit;
2009 end;
2010
2011 with MenuGame, Items do begin
2012 Clear;
2013 with AddButton(SContinue, MenuItemGameContinue) do begin
2014 TextSize := 40;
2015 TextColor := Colors.MenuItemText;
2016 TextDisabledColor := Colors.MenuItemDisabledText;
2017 BackgroundColor := Colors.MenuItemBackground;
2018 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2019 end;
2020 with AddButton(SRestart, MenuItemGameRestart) do begin
2021 TextSize := 40;
2022 TextColor := Colors.MenuItemText;
2023 TextDisabledColor := Colors.MenuItemDisabledText;
2024 BackgroundColor := Colors.MenuItemBackground;
2025 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2026 end;
2027 with AddButton(SExit, MenuItemGameExit) do begin
2028 TextSize := 40;
2029 TextColor := Colors.MenuItemText;
2030 TextDisabledColor := Colors.MenuItemDisabledText;
2031 BackgroundColor := Colors.MenuItemBackground;
2032 BackgroundSelectedColor := Colors.MenuItemBackgroundSelected;
2033 end;
2034 OnExit := MenuItemGameContinue;
2035 end;
2036end;
2037
2038procedure TEngine.ButtonBackClick(Sender: TObject);
2039begin
2040 if State = gsSuccess then begin
2041 State := gsMenu;
2042 MenuItemCareer(Self);
2043 end else begin
2044 Menu := MenuGame;
2045 LastState := State;
2046 State := gsMenu;
2047 Redraw;
2048 end;
2049end;
2050
2051procedure TEngine.DrawClock(Canvas: TCanvas; CanvasSize: TPoint);
2052var
2053 ClockCenter: TPoint;
2054 Angle: Double;
2055 Text: string;
2056 I: Integer;
2057 Y: Integer;
2058 IsDay: Boolean;
2059const
2060 ClockSize = 20;
2061begin
2062 IsDay := (((Time / OneHour) mod 24) > 6) and (((Time / OneHour) mod 24) < 18);
2063 if IsDay then begin
2064 Canvas.Brush.Style := bsSolid;
2065 Canvas.Brush.Color := Colors.Background;
2066 end else begin
2067 Canvas.Brush.Style := bsSolid;
2068 Canvas.Brush.Color := Colors.Text;
2069 end;
2070 Canvas.Pen.Style := psSolid;
2071 Canvas.Pen.Color := Colors.Text;
2072 Canvas.Pen.Width := 2;
2073 ClockCenter := Point(CanvasSize.X - 30, 40);
2074 Angle := Time / (12 * OneHour) * 2 * Pi - Pi / 2;
2075 Canvas.EllipseC(ClockCenter.X, ClockCenter.Y, ClockSize, ClockSize);
2076 Canvas.Brush.Style := bsClear;
2077
2078 if IsDay then begin
2079 Canvas.Pen.Color := Colors.Text;
2080 end else begin
2081 Canvas.Pen.Color := Colors.Background;
2082 end;
2083 Canvas.Line(ClockCenter, Point(ClockCenter.X + Round(Cos(Angle) * ClockSize * 0.8),
2084 ClockCenter.Y + Round(Sin(Angle) * ClockSize * 0.8)));
2085 for I := 0 to 12 do begin
2086 Angle := I / 12 * 2 * Pi;
2087 Canvas.Line(ClockCenter.X + Round(Cos(Angle) * ClockSize * 0.7),
2088 ClockCenter.Y + Round(Sin(Angle) * ClockSize * 0.7),
2089 ClockCenter.X + Round(Cos(Angle) * ClockSize * 0.9),
2090 ClockCenter.Y + Round(Sin(Angle) * ClockSize * 0.9));
2091 end;
2092 Y := ClockCenter.Y;
2093
2094 Canvas.Pen.Color := Colors.Text;
2095 Canvas.Font.Color := Colors.Text;
2096 Text := FormatDateTime('ddd', Time + 2);
2097 Canvas.TextOut(ClockCenter.X - ClockSize - Canvas.TextWidth(Text) - ScaleX(10, 96),
2098 Y - Canvas.TextHeight(Text) div 2, Text);
2099 Y := Y + Canvas.TextHeight(Text) + ScaleY(5, 96);
2100
2101 Text := SDay + ' ' + IntToStr(Trunc(Time));
2102 Canvas.TextOut(ClockCenter.X - ClockSize - Canvas.TextWidth(Text) - ScaleX(10, 96),
2103 Y - Canvas.TextHeight(Text) div 2, Text);
2104 Y := Y + Canvas.TextHeight(Text) + ScaleY(5, 96);
2105
2106 ImagePause.Canvas := Canvas;
2107 ImagePause.Bounds := Bounds(CanvasSize.X - ScaleX(20 + 10, 96), Y,
2108 ScaleX(20, 96), ScaleY(20, 96));
2109 ImagePause.Paint;
2110 Y := Y + ImagePause.Bounds.Height + ScaleY(5, 96);
2111
2112 ImagePlay.Canvas := Canvas;
2113 ImagePlay.Bounds := Bounds(CanvasSize.X - ScaleX(20 + 10, 96) , Y,
2114 ScaleX(20, 96), ScaleY(20, 96));
2115 ImagePlay.Paint;
2116 Y := Y + ImagePlay.Bounds.Height + ScaleY(5, 96);
2117
2118 ImageFastForward.Canvas := Canvas;
2119 ImageFastForward.Bounds := Bounds(CanvasSize.X - ScaleX(20 + 10, 96) , Y,
2120 ScaleX(20, 96), ScaleY(20, 96));
2121 ImageFastForward.Paint;
2122 Y := Y + ImageFastForward.Bounds.Height + ScaleY(5, 96);
2123end;
2124
2125procedure TEngine.DrawTrains(Canvas: TCanvas);
2126var
2127 P: Integer;
2128 Pos: TPoint;
2129 Points: array of TPoint;
2130 Angle: Double;
2131 ShapePos: TPoint;
2132 Train: TMetroTrain;
2133 Passenger: TMetroPassenger;
2134 Carriage: TMetroCarriage;
2135 Vector: TVector;
2136begin
2137 for Train in Trains do
2138 with Train do begin
2139 if Assigned(Line) then begin
2140 Canvas.Brush.Color := Line.Color;
2141 Canvas.Brush.Style := bsSolid;
2142 Canvas.Pen.Style := psClear;
2143 Vector := TrackPosition.GetVector;
2144 Pos := Vector.Position;
2145 Angle := Vector.GetAngle;
2146
2147 SetLength(Points, 4);
2148 Points[0] := RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y - TrainSize div 3), Angle);
2149 Points[1] := RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y - TrainSize div 3), Angle);
2150 Points[2] := RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y + TrainSize div 3), Angle);
2151 Points[3] := RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y + TrainSize div 3), Angle);
2152 Canvas.Polygon(Points);
2153 Canvas.Brush.Color := clWhite;
2154 P := 0;
2155 for Passenger in Passengers do
2156 with Passenger do begin
2157 ShapePos := Point(Pos.X - Trunc(TrainSize div 3 * 1) + (P mod 3) * TrainSize div 3,
2158 Pos.Y - Trunc(TrainSize div 6 * 1) + (P div 3) * TrainSize div 3);
2159 ShapePos := RotatePoint(Pos, ShapePos, Angle);
2160 DrawShape(Canvas, ShapePos, Shape, TrainSize div 3, Angle + Pi / 2);
2161 Inc(P);
2162 end;
2163
2164 // Draw carriages
2165 for Carriage in Train.Carriages do
2166 with Carriage do begin
2167 Canvas.Brush.Color := Line.Color;
2168 Canvas.Brush.Style := bsSolid;
2169 Canvas.Pen.Style := psClear;
2170 Vector := GetTrackPosition.GetVector;
2171 Pos := Vector.Position;
2172 Angle := Vector.GetAngle;
2173
2174 SetLength(Points, 4);
2175 Points[0] := RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y - TrainSize div 3), Angle);
2176 Points[1] := RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y - TrainSize div 3), Angle);
2177 Points[2] := RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y + TrainSize div 3), Angle);
2178 Points[3] := RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y + TrainSize div 3), Angle);
2179 Canvas.Polygon(Points);
2180 Canvas.Brush.Color := clWhite;
2181 P := 0;
2182 for Passenger in Passengers do
2183 with Passenger do begin
2184 ShapePos := Point(Pos.X - Trunc(TrainSize div 3 * 1) + (P mod 3) * TrainSize div 3,
2185 Pos.Y - Trunc(TrainSize div 6 * 1) + (P div 3) * TrainSize div 3);
2186 ShapePos := RotatePoint(Pos, ShapePos, Angle);
2187 DrawShape(Canvas, ShapePos, Shape, TrainSize div 3, Angle + Pi / 2);
2188 Inc(P);
2189 end;
2190 end;
2191
2192{ // Target station links
2193 if Assigned(TargetStation) then begin
2194 Canvas.Pen.Width := 1;
2195 Canvas.Pen.Style := psSolid;
2196 Canvas.Pen.Color := Colors.MenuItemText;
2197 Canvas.MoveTo(Pos);
2198 Canvas.LineTo(TargetStation.TrackPoint.Position);
2199 end;
2200}
2201 end;
2202 end;
2203end;
2204
2205procedure TEngine.DrawGameOver(Canvas: TCanvas; CanvasSize: TPoint);
2206var
2207 Y: Integer;
2208 Text: string;
2209begin
2210 with Canvas do begin
2211 DrawFrame(Canvas, Bounds(CanvasSize.X div 8, ScaleY(90, 96),
2212 Round(CanvasSize.X / 4 * 3), ScaleY(210, 96)));
2213
2214 Canvas.Font.Color := Self.Colors.Text;
2215 Brush.Style := bsClear;
2216 Pen.Style := psClear;
2217
2218 Y := ScaleY(100, 96);
2219
2220 Font.Size := 40;
2221 Text := SGameOver;
2222 TextOut((CanvasSize.X - TextWidth(Text)) div 2, Y, Text);
2223 Y := Y + Round(TextHeight(Text) * 1.1);
2224
2225 Font.Size := 14;
2226 Text := SGameOverReason;
2227 TextOut((CanvasSize.X - TextWidth(Text)) div 2, Y, Text);
2228 Y := Y + Round(TextHeight(Text) * 1.1);
2229
2230 Text := Format(SGameOverStatistic, [ServedPassengerCount, ServedDaysCount]);
2231 TextOut((CanvasSize.X - TextWidth(Text)) div 2, Y, Text);
2232 Y := Y + Round(TextHeight(SGameOverStatistic) * 1.1);
2233
2234 Y := Y + ScaleY(16, 96);
2235
2236 DrawHighScore(Canvas, CanvasSize, Y);
2237 end;
2238end;
2239
2240procedure TEngine.DrawHighScore(Canvas: TCanvas; CanvasSize: TPoint; Y: Integer);
2241var
2242 Text: string;
2243begin
2244 with Canvas do begin
2245 // Calculate new highest score
2246 Text := '';
2247 if (ServedPassengerCount > HighestServedPassengerCount) or
2248 (ServedDaysCount > HighestServedDaysCount) then begin
2249 Text := SNewHighScore + ' ';
2250 end;
2251 Text := Text + Format(SOldHighScore, [HighestServedPassengerCount,
2252 HighestServedDaysCount]);
2253 Canvas.TextOut((CanvasSize.X - TextWidth(Text)) div 2, Y, Text);
2254 Y := Y + Round(TextHeight(Text) * 1.1);
2255 if (ServedPassengerCount > HighestServedPassengerCount) then
2256 HighestServedPassengerCount := ServedPassengerCount;
2257 if (ServedDaysCount > HighestServedDaysCount) then
2258 HighestServedDaysCount := ServedDaysCount;
2259
2260 if Assigned(City) then begin
2261 if (ServedPassengerCount > City.HighestServedPassengerCount) then
2262 City.HighestServedPassengerCount := ServedPassengerCount;
2263 if (ServedDaysCount > City.HighestServedDaysCount) then
2264 City.HighestServedDaysCount := ServedDaysCount;
2265 end;
2266 end;
2267end;
2268
2269procedure TEngine.DrawSuccess(Canvas: TCanvas; CanvasSize: TPoint);
2270var
2271 Y: Integer;
2272 Text: string;
2273 Index: Integer;
2274begin
2275 with Canvas do begin
2276 DrawFrame(Canvas, Bounds(CanvasSize.X div 8, ScaleY(90, 96),
2277 Round(CanvasSize.X / 4 * 3), ScaleY(230, 96)));
2278
2279 Canvas.Font.Color := Self.Colors.Text;
2280 Brush.Style := bsClear;
2281 Pen.Style := psClear;
2282
2283 Y := ScaleY(100, 96);
2284
2285 Font.Size := 40;
2286 Text := SSuccess;
2287 TextOut((CanvasSize.X - TextWidth(Text)) div 2, Y, Text);
2288 Y := Y + Round(TextHeight(Text) * 1.1);
2289
2290 Font.Size := 14;
2291 Text := SSuccessReason;
2292 TextOut((CanvasSize.X - TextWidth(Text)) div 2, Y, Text);
2293 Y := Y + Round(TextHeight(Text) * 1.1);
2294
2295 // Unlock next city
2296 if Assigned(City) then begin
2297 Index := Cities.IndexOf(City);
2298 if (Index >= 0) and ((Index + 1) < Cities.Count) then begin
2299 Cities[Index + 1].Locked := False;
2300 Font.Size := 14;
2301 Text := Format(SUnlockedCity, [Cities[Index + 1].Name]);
2302 TextOut((CanvasSize.X - TextWidth(Text)) div 2, Y, Text);
2303 Y := Y + Round(TextHeight(Text) * 1.1);
2304 end;
2305 end;
2306
2307 Text := Format(SGameOverStatistic, [ServedPassengerCount, ServedDaysCount]);
2308 TextOut((CanvasSize.X - TextWidth(Text)) div 2, Y, Text);
2309 Y := Y + Round(TextHeight(SGameOverStatistic) * 1.1);
2310
2311 Y := Y + ScaleY(16, 96);
2312
2313 DrawHighScore(Canvas, CanvasSize, Y);
2314 end;
2315end;
2316
2317procedure TEngine.DrawNewWeek(Canvas: TCanvas; CanvasSize: TPoint);
2318var
2319 Text: string;
2320 TextSize: TSize;
2321 Y: Integer;
2322 X: Integer;
2323begin
2324 with Canvas do begin
2325
2326 DrawFrame(Canvas, Bounds(CanvasSize.X div 4, CanvasSize.Y div 4, CanvasSize.X div 2, CanvasSize.Y div 2));
2327 X := CanvasSize.X div 4 + ScaleX(10, 96);
2328 Y := CanvasSize.Y div 4 + ScaleX(10, 96);
2329
2330 Text := IntToStr(Week) + '. ' + SWeek;
2331 Font.Size := 30;
2332 Font.Color := Self.Colors.Text;
2333 TextSize := TextExtent(Text);
2334 TextOut(X, Y, Text);
2335 Y := Y + Round(1.1 * TextSize.Height);
2336
2337 Text := SNewTrain;
2338 Font.Size := 14;
2339 Font.Color := Self.Colors.Text;
2340 TextSize := TextExtent(Text);
2341 TextOut(X, Y, Text);
2342 Y := Y + Round(1.1 * TextSize.Height);
2343
2344 ImageNewTrain.Canvas := Canvas;
2345 ImageNewTrain.Bounds := Bounds(CanvasSize.X div 2 - ImprovementImageSize div 2,
2346 CanvasSize.Y div 2 - ImprovementImageSize div 2,
2347 ImprovementImageSize, ImprovementImageSize);
2348 ImageNewTrain.Paint;
2349
2350 Y := (CanvasSize.Y - ImprovementImageSize) div 2 +
2351 Round(ImprovementImageSize * 1.1);
2352
2353 Text := STrain;
2354 Font.Size := 20;
2355 Font.Color := Self.Colors.Text;
2356 TextSize := TextExtent(Text);
2357 TextOut((CanvasSize.X - TextSize.Width) div 2, Y, Text);
2358 end;
2359end;
2360
2361procedure TEngine.DrawNewImprovement(Canvas: TCanvas; CanvasSize: TPoint);
2362var
2363 Text: string;
2364 TextSize: TSize;
2365 Y: Integer;
2366 X: Integer;
2367 Center: TPoint;
2368begin
2369 with Canvas do begin
2370 Center := Point(CanvasSize.X div 2, CanvasSize.Y div 2);
2371
2372 DrawFrame(Canvas, Bounds(CanvasSize.X div 4, CanvasSize.Y div 4, CanvasSize.X div 2, CanvasSize.Y div 2));
2373 X := CanvasSize.X div 4 + ScaleX(10, 96);
2374 Y := CanvasSize.Y div 4 + ScaleX(10, 96);
2375
2376 Text := IntToStr(Week) + '. ' + SWeek;
2377 Font.Size := 30;
2378 Font.Color := Self.Colors.Text;
2379 TextSize := TextExtent(Text);
2380 TextOut(X, Y, Text);
2381 Y := Y + Round(1.1 * TextSize.Height);
2382
2383 Text := SNewImprovement;
2384 Font.Size := 14;
2385 Font.Color := Self.Colors.Text;
2386 TextSize := TextExtent(Text);
2387 TextOut(X, Y, Text);
2388 Y := Y + Round(1.1 * TextSize.Height);
2389
2390 if Improvement1 <> miNone then begin
2391 ImageNewImprovement1.Canvas := Canvas;
2392 ImageNewImprovement1.Bounds := Bounds(Center.X - CanvasSize.X div 8 -
2393 ImprovementImageSize div 2, Center.Y - ImprovementImageSize div 2,
2394 ImprovementImageSize, ImprovementImageSize);
2395 ImageNewImprovement1.Paint;
2396 end;
2397
2398 if Improvement2 <> miNone then begin
2399 ImageNewImprovement2.Canvas := Canvas;
2400 ImageNewImprovement2.Bounds := Bounds(Center.X + CanvasSize.X div 8 -
2401 ImprovementImageSize div 2, Center.Y - ImprovementImageSize div 2,
2402 ImprovementImageSize, ImprovementImageSize);
2403 ImageNewImprovement2.Paint;
2404 end;
2405
2406 Y := Center.Y - ImprovementImageSize div 2 +
2407 Round(ImprovementImageSize * 1.1);
2408
2409 if Improvement1 <> miNone then begin
2410 Text := GetImprovementText(Improvement1);
2411 Font.Size := 20;
2412 Font.Color := Self.Colors.Text;
2413 TextSize := TextExtent(Text);
2414 TextOut(Center.X - CanvasSize.X div 8 - TextSize.Width div 2, Y, Text);
2415 end;
2416
2417 if Improvement2 <> miNone then begin
2418 Text := GetImprovementText(Improvement2);
2419 Font.Size := 20;
2420 Font.Color := Self.Colors.Text;
2421 TextSize := TextExtent(Text);
2422 TextOut(Center.X + CanvasSize.X div 8 - TextSize.Width div 2, Y, Text);
2423 end;
2424 end;
2425end;
2426
2427procedure TEngine.DrawStationPassengerOverload(Canvas: TCanvas);
2428var
2429 MapStation: TMapStation;
2430 Angle: Real;
2431begin
2432 for MapStation in Stations do
2433 with MapStation do begin
2434 if OverloadDuration > 0 then begin
2435 Canvas.Brush.Color := clSilver;
2436 Canvas.Brush.Style := bsSolid;
2437 Canvas.Pen.Color := clSilver;
2438 Canvas.Pen.Style := psSolid;
2439 Angle := OverloadDuration / MaxPassengersOveloadTime * 2 * Pi;
2440 Canvas.Pie(Position.X - StationOverloadSize, Position.Y - StationOverloadSize,
2441 Position.X + StationOverloadSize, Position.Y + StationOverloadSize,
2442 Trunc(Position.X + StationOverloadSize * Cos(Angle)),
2443 Trunc(Position.Y + StationOverloadSize * Sin(Angle)), Position.X + StationOverloadSize, Position.Y);
2444 end;
2445 end;
2446end;
2447
2448procedure TEngine.DrawLines(Canvas: TCanvas);
2449var
2450 MetroLine: TMetroLine;
2451 S: Integer;
2452begin
2453 for MetroLine in Lines do
2454 with MetroLine do begin
2455 Canvas.Pen.Color := Color;
2456 Canvas.Pen.Style := psSolid;
2457 Canvas.Pen.Width := MetroLineThickness;
2458 if Track.Points.Count > 0 then Canvas.MoveTo(Track.Points[0].Position);
2459 for S := 1 to Track.Points.Count - 1 do begin
2460 Canvas.LineTo(Track.Points[S].Position);
2461{ if (S = TrackPoints.Count - 1) then begin
2462 Canvas.Pen.EndCap := pecSquare;
2463 Angle := arctan2D(((TrackPoints[S].Position.Y - TrackPoints[S - 1].Position.Y),
2464 (TrackPoints[S].Position.X - TrackPoints[S - 1].Position.X));
2465 EndPoint := Point(Round(TrackPoints[S].Position.X + EndStationLength * Cos(Angle)),
2466 Round(TrackPoints[S].Position.Y + EndStationLength * Sin(Angle)));
2467 Canvas.LineTo(EndPoint);
2468 Canvas.MoveTo(Point(Round(EndPoint.X + Cos(Angle + Pi / 2) * EndStationLength / 3),
2469 Round(EndPoint.Y + Sin(Angle + Pi / 2) * EndStationLength / 3)));
2470 Canvas.LineTo(Point(Round(EndPoint.X + Cos(Angle - Pi / 2) * EndStationLength / 3),
2471 Round(EndPoint.Y + Sin(Angle - Pi / 2) * EndStationLength / 3)));
2472 Canvas.Pen.EndCap := pecRound;
2473 end;}
2474 end;
2475(* Canvas.Pen.Color := Color;
2476 Canvas.Pen.Style := psSolid;
2477 Canvas.Pen.Width := MetroLineThickness div 2;
2478 if Track.Points.Count > 0 then Canvas.MoveTo(Track.Points[0].PositionDesigned);
2479 for S := 1 to Track.Points.Count - 1 do begin
2480 Canvas.LineTo(Track.Points[S].PositionDesigned);
2481{ if (S = TrackPoints.Count - 1) then begin
2482 Canvas.Pen.EndCap := pecSquare;
2483 Angle := arctan2((TrackPoints[S].Position.Y - TrackPoints[S - 1].Position.Y),
2484 (TrackPoints[S].Position.X - TrackPoints[S - 1].Position.X));
2485 EndPoint := Point(Round(TrackPoints[S].Position.X + EndStationLength * Cos(Angle)),
2486 Round(TrackPoints[S].Position.Y + EndStationLength * Sin(Angle)));
2487 Canvas.LineTo(EndPoint);
2488 Canvas.MoveTo(Point(Round(EndPoint.X + Cos(Angle + Pi / 2) * EndStationLength / 3),
2489 Round(EndPoint.Y + Sin(Angle + Pi / 2) * EndStationLength / 3)));
2490 Canvas.LineTo(Point(Round(EndPoint.X + Cos(Angle - Pi / 2) * EndStationLength / 3),
2491 Round(EndPoint.Y + Sin(Angle - Pi / 2) * EndStationLength / 3)));
2492 Canvas.Pen.EndCap := pecRound;
2493 end;}
2494 end;
2495 {
2496 if (TrackPoints.Count > 1) then begin
2497 Canvas.Pen.EndCap := pecSquare;
2498 Angle := arctan2((TrackPoints[1].Position.Y - TrackPoints[0].Position.Y),
2499 (TrackPoints[1].Position.X - TrackPoints[0].Position.X));
2500 Canvas.MoveTo(TrackPoints[0].Position);
2501 EndPoint := Point(Round(TrackPoints[0].Position.X - EndStationLength * Cos(Angle)),
2502 Round(TrackPoints[0].Position.Y - EndStationLength * Sin(Angle)));
2503 Canvas.LineTo(EndPoint);
2504 Canvas.MoveTo(Point(Round(EndPoint.X - Cos(Angle + Pi / 2) * EndStationLength / 3),
2505 Round(EndPoint.Y - Sin(Angle + Pi / 2) * EndStationLength / 3)));
2506 Canvas.LineTo(Point(Round(EndPoint.X - Cos(Angle - Pi / 2) * EndStationLength / 3),
2507 Round(EndPoint.Y - Sin(Angle - Pi / 2) * EndStationLength / 3)));
2508 Canvas.Pen.EndCap := pecRound;
2509 end; }
2510 *)
2511 end;
2512
2513 // Draw design time lines
2514 if Assigned(TrackStationDown) and Assigned(TrackStationDown.OwnerPoint) then begin
2515 Canvas.Pen.Color := TMetroLine(TrackStationDown.Track.Owner).Color;
2516 Canvas.MoveTo(TLineStation(TrackStationDown.OwnerPoint).TrackPoint.Position);
2517 DrawLine(Canvas, View.PointDestToSrc(LastMousePos));
2518 end;
2519 if Assigned(TrackStationUp) and Assigned(TrackStationUp.OwnerPoint) then begin
2520 Canvas.Pen.Color := TMetroLine(TrackStationUp.Track.Owner).Color;
2521 Canvas.MoveTo(TLineStation(TrackStationUp.OwnerPoint).TrackPoint.Position);
2522 DrawLine(Canvas, View.PointDestToSrc(LastMousePos));
2523 end;
2524end;
2525
2526procedure TEngine.DrawStations(Canvas: TCanvas);
2527var
2528 MapStation: TMapStation;
2529 Passenger: TMetroPassenger;
2530 PassengerPos: TPoint;
2531 Direction: Integer;
2532 UsedStationSize: Integer;
2533begin
2534 Canvas.Pen.Width := 5;
2535 for MapStation in Stations do
2536 with MapStation do begin
2537 Canvas.Pen.Style := psSolid;
2538 if IsTerminal then UsedStationSize := Round(StationSize * 1.5)
2539 else UsedStationSize := StationSize;
2540
2541 if Assigned(SelectedLine) and (Lines.IndexOf(SelectedLine) <> -1) then begin
2542 Canvas.Brush.Style := bsClear;
2543 Canvas.Pen.Color := SelectedLine.Color;
2544 DrawShape(Canvas, Position, Shape, UsedStationSize + Canvas.Pen.Width + 4, 0);
2545 end;
2546
2547 Canvas.Brush.Color := Colors.ShapeBackground;
2548 Canvas.Brush.Style := bsSolid;
2549 Canvas.Pen.Color := Colors.Text;
2550 DrawShape(Canvas, Position, Shape, UsedStationSize, 0);
2551
2552 // Draw passengers
2553 Canvas.Pen.Style := psClear;
2554 Canvas.Brush.Color := Colors.Text;
2555 PassengerPos := Point(0, 0);
2556 Direction := 1;
2557 for Passenger in Passengers do
2558 with Passenger do begin
2559 DrawShape(Canvas, Point(Position.X + StationSize + PassengerPos.X,
2560 Position.Y - StationSize div 2 + PassengerPos.Y),
2561 Shape, PassengerSize, 0);
2562 PassengerPos := Point(PassengerPos.X + Direction * (PassengerSize + 2), PassengerPos.Y);
2563 if PassengerPos.X >= (PassengerSize + 2) * VisiblePassengersPerLine then begin
2564 Direction := -Direction;
2565 PassengerPos.X := PassengerPos.X - (PassengerSize + 2);
2566 PassengerPos.Y := PassengerPos.Y + (PassengerSize + 2);
2567 end;
2568 if PassengerPos.X < 0 then begin
2569 Direction := -Direction;
2570 PassengerPos.X := 0;
2571 PassengerPos.Y := PassengerPos.Y + (PassengerSize + 2);
2572 end;
2573 end;
2574
2575{ if ShowDistances then begin
2576 Canvas.Brush.Style := bsClear;
2577 Text := '';
2578 for P := 0 to 5 do
2579 Text := Text + IntToStr(ShapeDistance[TStationShape(P)]) + ',';
2580 Canvas.TextOut(Position.X + StationSize div 2, Position.Y + StationSize div 2, Text);
2581 end;
2582 }
2583 end;
2584end;
2585
2586procedure TEngine.DrawGameControls(Canvas: TCanvas; CanvasSize: TPoint);
2587var
2588 I: Integer;
2589 Text: string;
2590 Radius: Integer;
2591 Angle: Real;
2592 Pos: TPoint;
2593 X: Integer;
2594 Y: Integer;
2595 SeparatorSize: Integer;
2596begin
2597 SeparatorSize := ScaleX(20, 96);
2598 X := CanvasSize.X div 2;
2599 Y := CanvasSize.Y - LineColorsDist;
2600
2601 // Line selection
2602 Canvas.Pen.Width := 4;
2603 for I := 0 to High(LineColors) do begin
2604 if Assigned(Lines.SearchByColor(LineColors[I])) then begin
2605 Canvas.Brush.Color := LineColors[I];
2606 Radius := 15;
2607 end else begin
2608 Canvas.Brush.Color := clSilver;
2609 Radius := 5;
2610 end;
2611 Canvas.Pen.Color := Colors.Text;
2612 if Assigned(SelectedLine) and (SelectedLine.Color = LineColors[I]) then begin
2613 Canvas.Pen.Style := psSolid;
2614 end else begin
2615 Canvas.Pen.Style := psClear;
2616 end;
2617
2618 Canvas.EllipseC(X - Length(LineColors) div 2 * LineColorsDist + I * LineColorsDist,
2619 Y, Radius, Radius);
2620 end;
2621 X := X - Length(LineColors) div 2 * LineColorsDist - 2 * SeparatorSize;
2622
2623 // Draw unused trains
2624 ImageLocomotive.Bounds := Bounds(X - IconSize, Y - IconSize div 2,
2625 IconSize, IconSize);
2626 ImageLocomotive.Canvas := Canvas;
2627 ImageLocomotive.Paint;
2628 X := X - IconSize - SeparatorSize div 3;
2629
2630 Text := IntToStr(Trains.GetUnusedCount);
2631 Canvas.Brush.Style := bsClear;
2632 Canvas.Font.Size := 14;
2633 Canvas.Font.Color := Colors.Text;
2634 Canvas.TextOut(X - Canvas.TextWidth(Text),
2635 Y - Canvas.TextHeight(Text) div 2, Text);
2636 X := X - Canvas.TextWidth(Text) - SeparatorSize;
2637
2638 // Draw unused carriages
2639 if Carriages.GetUnusedCount > 0 then CarriageCountVisible := True;
2640 if CarriageCountVisible then begin
2641 Text := IntToStr(Carriages.GetUnusedCount);
2642 ImageCarriage.Bounds := Bounds(X - IconSize, Y - IconSize div 2,
2643 IconSize, IconSize);
2644 ImageCarriage.Canvas := Canvas;
2645 ImageCarriage.Paint;
2646 X := X - IconSize - SeparatorSize div 3;
2647
2648 Canvas.Brush.Style := bsClear;
2649 Canvas.Font.Size := 14;
2650 Canvas.Font.Color := Colors.Text;
2651 Canvas.TextOut(X - Canvas.TextWidth(Text),
2652 Y - Canvas.TextHeight(Text) div 2, Text);
2653 X := X - Canvas.TextWidth(Text) - SeparatorSize;
2654 end;
2655
2656 // Draw unused terminals
2657 if AvailableTerminals > 0 then TerminalCountVisible := True;
2658 if TerminalCountVisible then begin
2659 Text := IntToStr(AvailableTerminals);
2660 ImageTerminal.Bounds := Bounds(X - IconSize, Y - IconSize div 2,
2661 IconSize, IconSize);
2662 ImageTerminal.Canvas := Canvas;
2663 ImageTerminal.Paint;
2664 X := X - IconSize - SeparatorSize div 3;
2665
2666 Canvas.Brush.Style := bsClear;
2667 Canvas.Font.Size := 14;
2668 Canvas.Font.Color := Colors.Text;
2669 Canvas.TextOut(X - Canvas.TextWidth(Text),
2670 Y - Canvas.TextHeight(Text) div 2, Text);
2671 end;
2672
2673 // Passenger count
2674 X := CanvasSize.X - ScaleX(10, 96);
2675 ImagePassenger.Bounds := Bounds(X - IconSize, Y - IconSize div 2,
2676 IconSize, IconSize);
2677 ImagePassenger.Canvas := Canvas;
2678 ImagePassenger.Paint;
2679 X := X - IconSize - SeparatorSize div 3;
2680
2681 Canvas.Brush.Style := bsClear;
2682 Canvas.Font.Size := 14;
2683 Canvas.Font.Color := Colors.Text;
2684 Text := IntToStr(ServedPassengerCount);
2685 Canvas.TextOut(X - Canvas.TextWidth(Text),
2686 Y - Canvas.TextHeight(Text) div 2, Text);
2687
2688 DrawClock(Canvas, CanvasSize);
2689
2690 // Back button
2691 Canvas.Font.Size := 40;
2692 Canvas.Font.Color := Colors.Text;
2693 ButtonBack.Canvas := Canvas;
2694 ButtonBack.Bounds.Left := 10;
2695 ButtonBack.Bounds.Top := 10;
2696 ButtonBack.Paint;
2697
2698 // City name
2699 if Assigned(City) then begin
2700 Canvas.Brush.Style := bsClear;
2701 Canvas.Font.Color := Colors.Text;
2702 Canvas.Font.Size := 20;
2703 Text := City.Name;
2704 Canvas.TextOut(20, CanvasSize.Y -
2705 Canvas.TextHeight(Text) - 20, Text);
2706
2707 X := CanvasSize.X - ScaleX(10, 96);
2708 ImageAchievement.Bounds := Bounds(X - IconSize, Y - 2 * IconSize,
2709 IconSize, IconSize);
2710 ImageAchievement.Canvas := Canvas;
2711 ImageAchievement.Paint;
2712
2713 X := X - IconSize - SeparatorSize div 3;
2714
2715 Canvas.Brush.Style := bsClear;
2716 Canvas.Font.Size := 14;
2717 Canvas.Font.Color := Colors.Text;
2718 Text := IntToStr(City.PassengersCountToUnlock);
2719 Canvas.TextOut(X - Canvas.TextWidth(Text),
2720 Y - Round(1.5 * IconSize) - Canvas.TextHeight(Text) div 2, Text);
2721 end;
2722end;
2723
2724procedure TEngine.DrawGrabbed(Canvas: TCanvas; CanvasSize: TPoint);
2725var
2726 Pos: TPoint;
2727 Angle: Double;
2728 FocusedTrack: TTrackLink;
2729 Vector: TVector;
2730 Intersect: TPoint;
2731 TrackPosition: TTrackPosition;
2732begin
2733 // Show train grabbed by mouse
2734 Angle := 0;
2735 Pos := LastMousePos;
2736
2737 if Assigned(SelectedTrain) then begin
2738 FocusedTrack := GetTrackOnPos(View.PointDestToSrc(Pos), Intersect);
2739 if Assigned(FocusedTrack.Points[0]) then begin
2740 TrackPosition.BaseTrackPoint := FocusedTrack.Points[0];
2741 TrackPosition.RelPos := Distance(FocusedTrack.Points[0].Position,
2742 Intersect);
2743 Vector := TrackPosition.GetVector;
2744 Angle := Vector.GetAngle;
2745
2746 if Assigned(LastGrabbedTrain) then begin
2747 if TrackPosition.GetTrackPosition >
2748 LastGrabbedTrainTrackPosition.GetTrackPosition then
2749 GrabbedTrainDirection := 1
2750 else
2751 if TrackPosition.GetTrackPosition <
2752 LastGrabbedTrainTrackPosition.GetTrackPosition then
2753 GrabbedTrainDirection := -1;
2754 end else GrabbedTrainDirection := 1;
2755
2756 LastGrabbedTrain := SelectedTrain;
2757 LastGrabbedTrainTrackPosition := TrackPosition;
2758 end;
2759 FocusedTrack.Free;
2760
2761 if GrabbedTrainDirection = -1 then Angle := Angle + Pi;
2762 Canvas.Brush.Color := Colors.Text; //SelectedTrain.Line.Color;
2763 Canvas.Brush.Style := bsSolid;
2764 Canvas.Pen.Style := psClear;
2765 Canvas.Polygon([
2766 RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y - TrainSize div 3), Angle),
2767 RotatePoint(Pos, Point(Pos.X + TrainSize div 2 - 10, Pos.Y - TrainSize div 3), Angle),
2768 RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y), Angle),
2769 RotatePoint(Pos, Point(Pos.X + TrainSize div 2 - 10, Pos.Y + TrainSize div 3), Angle),
2770 RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y + TrainSize div 3), Angle)
2771 ]);
2772 end;
2773
2774 // Show carriage grabbed by mouse
2775 if Assigned(SelectedCarriage) then begin
2776 Canvas.Brush.Color := Colors.Text; //SelectedTrain.Line.Color;
2777 Canvas.Brush.Style := bsSolid;
2778 Canvas.Pen.Style := psClear;
2779 Pos := LastMousePos;
2780 Angle := 0;
2781
2782 Canvas.Polygon([
2783 RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y - TrainSize div 3), Angle),
2784 RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y - TrainSize div 3), Angle),
2785 RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y + TrainSize div 3), Angle),
2786 RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y + TrainSize div 3), Angle)
2787 ]);
2788 end;
2789
2790 // Show grabbed terminal by mouse
2791 if SelectedTerminal then begin
2792 Canvas.Brush.Color := Colors.Text; //SelectedTrain.Line.Color;
2793 Canvas.Brush.Style := bsSolid;
2794 Canvas.Pen.Style := psClear;
2795 Pos := LastMousePos;
2796 Angle := 0;
2797
2798 Canvas.Ellipse(Pos.X - TrainSize div 2, Pos.Y - TrainSize div 2,
2799 Pos.X + TrainSize div 2, Pos.Y + TrainSize div 2);
2800 end;
2801end;
2802
2803procedure TEngine.Tick;
2804var
2805 Passenger: TMetroPassenger;
2806 MapStation: TMapStation;
2807begin
2808 if State = gsRunning then begin
2809 FTime := FTime + (Now - LastTickTime) / OneSecond * TimePerSecond;
2810 Redraw; // Redraw on every tick because engine time is changed so clock should be redrawn
2811
2812 // Add new trains
2813 if (Time - LastNewWeekTime) > NewTrainPeriod then begin
2814 LastNewWeekTime := Time;
2815 Inc(Week);
2816 State := gsNewWeek;
2817 Redraw;
2818 end;
2819
2820 // Add new shape
2821 if (Time - LastNewShapeTime) > NewShapePeriod then begin
2822 LastNewShapeTime := Time;
2823 if ShapeCount <= Integer(High(TStationShape)) then Inc(ShapeCount);
2824 Redraw;
2825 end;
2826
2827 // Add new station
2828 if (Time - LastNewStationTime) > NewStationPeriod then begin
2829 LastNewStationTime := Time;
2830 Stations.AddNew;
2831 ResizeView(False);
2832 Redraw;
2833 end;
2834
2835 // Add new passengers
2836 if (Time - LastNewPassengerTime) > NewPassengerPeriod then begin
2837 LastNewPassengerTime := Time;
2838 for MapStation in Stations do
2839 with MapStation do
2840 if Random < NewPassengerProbability then begin
2841 Passenger := Self.Passengers.AddNew;
2842 Passenger.Shape := TStationShape(Random(Integer(ShapeCount)));
2843 Passengers.Add(Passenger);
2844
2845 // Passenger is not allowed to have same shape
2846 while (Passenger.Shape = Shape) or
2847 not (Passenger.Shape in GetExistStationShapes) do
2848 Passenger.Shape := TStationShape((Integer(Passenger.Shape) + 1) mod Integer(ShapeCount));
2849 Redraw;
2850 end;
2851 end;
2852
2853 // Check station passenger overload state
2854 for MapStation in Stations do
2855 with MapStation do begin
2856 if Passengers.Count > GetMaxPassengers then begin
2857 OverloadDuration := OverloadDuration + (FTime - FLastTime);
2858 if OverloadDuration > MaxPassengersOveloadTime then
2859 OverloadDuration := MaxPassengersOveloadTime;
2860 if OverloadDuration < MaxPassengersOveloadTime then Redraw;
2861 end;
2862 if Passengers.Count <= GetMaxPassengers then begin
2863 if OverloadDuration > 0 then Redraw;
2864 OverloadDuration := OverloadDuration - (FTime - FLastTime);
2865 if OverloadDuration < 0 then begin
2866 OverloadDuration := 0;
2867 end;
2868 end;
2869 end;
2870
2871 TrainsMovement;
2872
2873 // Game over
2874 for MapStation in Stations do
2875 with MapStation do begin
2876 if OverloadDuration >= MaxPassengersOveloadTime then begin
2877 State := gsGameOver;
2878 Redraw;
2879 end;
2880 end;
2881
2882 if Assigned(City) and (ServedPassengerCount >= City.PassengersCountToUnlock) then begin
2883 State := gsSuccess;
2884 Redraw;
2885 end;
2886 end;
2887 LastTickTime := Now;
2888 FLastTime := FTime;
2889end;
2890
2891procedure TEngine.MouseMove(Position: TPoint);
2892var
2893 FocusedStation: TMapStation;
2894 Line: TMetroLine;
2895 LineStationDown: TLineStation;
2896 LineStationUp: TLineStation;
2897 CurrentTrackPoint: TTrackPoint;
2898begin
2899 if State = gsMenu then begin
2900 Menu.MouseMove(Position);
2901 Redraw;
2902 end;
2903
2904 if Assigned(SelectedTrain) or Assigned(SelectedCarriage) or
2905 SelectedTerminal then Redraw;
2906
2907 LastMousePos := Position;
2908 if MouseHold then begin
2909 FocusedStation := GetStationOnPos(View.PointDestToSrc(Position));
2910 Line := nil;
2911 if Assigned(TrackStationDown) then begin
2912 Line := TMetroLine(TrackStationDown.Track.Owner);
2913 Redraw;
2914 end;
2915 if Assigned(TrackStationUp) then begin
2916 Line := TMetroLine(TrackStationUp.Track.Owner);
2917 Redraw;
2918 end;
2919 if Assigned(Line) and not Assigned(LastFocusedStation) and Assigned(FocusedStation) then begin
2920 if Assigned(TrackStationDown) and (TLineStation(TrackStationDown.OwnerPoint).MapStation = FocusedStation) then begin
2921 // Disconnect down
2922 CurrentTrackPoint := TrackStationDown;
2923 TrackStationDown := TrackStationDown.GetDown;
2924 Line.DisconnectStation(TLineStation(CurrentTrackPoint.OwnerPoint));
2925 end else
2926 if Assigned(TrackStationUp) and (TLineStation(TrackStationUp.OwnerPoint).MapStation = FocusedStation) then begin
2927 // Disconnect up
2928 CurrentTrackPoint := TrackStationUp;
2929 if Assigned(TrackStationUp) then
2930 TrackStationUp := TrackStationUp.GetUp;
2931 Line.DisconnectStation(TLineStation(CurrentTrackPoint.OwnerPoint));
2932 end else
2933 if Assigned(Line) and ((not Line.IsCircular) or ((TrackStationDown <> nil) and (TrackStationUp <> nil))) and
2934 ((Line.LineStations.SearchMapStation(FocusedStation) = nil) or
2935 ((Line.LineStations.Count > 0) and
2936 ((Line.LineStations.First.MapStation = FocusedStation) or
2937 (Line.LineStations.Last.MapStation = FocusedStation)) and
2938 ((TrackStationDown = nil) or (TrackStationUp = nil)) and
2939 (not Line.IsCircular))) then begin
2940 if Assigned(TrackStationDown) then LineStationDown := TLineStation(TrackStationDown.OwnerPoint)
2941 else LineStationDown := nil;
2942 if Assigned(TrackStationUp) then LineStationUp := TLineStation(TrackStationUp.OwnerPoint)
2943 else LineStationUp := nil;
2944 Line.ConnectStation(FocusedStation, LineStationDown, LineStationUp);
2945 if Assigned(TrackStationDown) then TrackStationDown := TrackStationDown.GetUp
2946 else if Assigned(TrackStationUp) then TrackStationUp := TrackStationUp.GetDown;
2947 end;
2948 end;
2949 LastFocusedStation := FocusedStation;
2950 end;
2951end;
2952
2953procedure TEngine.MouseUp(Button: TMouseButton; Position: TPoint);
2954var
2955 I: Integer;
2956 FocusedTrack: TTrackLink;
2957 FocusedTrain: TMetroTrain;
2958 FocusedStation: TMapStation;
2959 Intersect: TPoint;
2960begin
2961 if Button = mbLeft then begin
2962 if State = gsMenu then begin
2963 Menu.MouseUp(Button, Position);
2964 Redraw;
2965 end else
2966 if State in [gsGameOver, gsSuccess] then begin
2967 ButtonBack.MouseUp(Position);
2968 end else
2969 if State = gsNewWeek then begin
2970 ImageNewTrain.MouseUp(Position);
2971 end else
2972 if State = gsNewImprovement then begin
2973 ImageNewImprovement1.MouseUp(Position);
2974 ImageNewImprovement2.MouseUp(Position);
2975 end
2976 else
2977 if State in [gsRunning, gsPaused] then begin
2978 ButtonBack.MouseUp(Position);
2979 ImagePause.MouseUp(Position);
2980 ImagePlay.MouseUp(Position);
2981 ImageFastForward.MouseUp(Position);
2982 Redraw;
2983
2984 // Place selected train if focused track
2985 if Assigned(SelectedTrain) then begin
2986 SelectedTrain.TargetStation := nil;
2987 SelectedTrain.TrackPosition.BaseTrackPoint := nil;
2988 if Assigned(SelectedTrain.Line) then begin
2989 SelectedTrain.Line.Trains.Remove(SelectedTrain);
2990 SelectedTrain.Line := nil;
2991
2992 // Remove train carriages
2993 for I := SelectedTrain.Carriages.Count - 1 downto 0 do begin
2994 SelectedTrain.Carriages[I].Train := nil;
2995 SelectedTrain.Carriages.Delete(I);
2996 end;
2997 end;
2998 FocusedTrack := GetTrackOnPos(View.PointDestToSrc(Position), Intersect);
2999 if Assigned(FocusedTrack.Points[0]) then begin
3000 SelectedTrain.Line := TMetroLine(FocusedTrack.Points[0].Track.Owner);
3001 SelectedTrain.Line.Trains.Add(SelectedTrain);
3002 SelectedTrain.TrackPosition.BaseTrackPoint := FocusedTrack.Points[0];
3003 SelectedTrain.TrackPosition.RelPos := Distance(FocusedTrack.Points[0].Position,
3004 Intersect);
3005 SelectedTrain.Direction := GrabbedTrainDirection;
3006 SelectedTrain.FindTargetStation;
3007 SelectedTrain.LastTrainMoveTime := Time;
3008 end;
3009 FocusedTrack.Free;
3010
3011 LastGrabbedTrain := nil;
3012 end;
3013
3014 // Place selected carriage if focused train
3015 if Assigned(SelectedCarriage) then begin
3016 if Assigned(SelectedCarriage.Train) then begin
3017 SelectedCarriage.Train.Carriages.Remove(SelectedCarriage);
3018 SelectedCarriage.Train := nil;
3019 end;
3020 FocusedTrain := GetTrainOnPos(View.PointDestToSrc(Position));
3021 if Assigned(FocusedTrain) then begin
3022 SelectedCarriage.Train := FocusedTrain;
3023 FocusedTrain.Carriages.Add(SelectedCarriage);
3024 end;
3025 end;
3026
3027 if SelectedTerminal then begin
3028 FocusedStation := GetStationOnPos(View.PointDestToSrc(Position));
3029 if Assigned(FocusedStation) and not FocusedStation.IsTerminal then begin
3030 FocusedStation.IsTerminal := True;
3031 Dec(AvailableTerminals);
3032 Redraw;
3033 end;
3034 SelectedTerminal := False;
3035 end;
3036
3037 // Line color selection
3038 for I := 0 to Lines.Count - 1 do
3039 if Distance(Point(View.DestRect.Right div 2 - Length(LineColors) div 2 * LineColorsDist + I * LineColorsDist,
3040 View.DestRect.Bottom - LineColorsDist), Position) < 20 then begin
3041 SelectedLine := Lines[I];
3042 Exit;
3043 end;
3044
3045 // Remove single line station on line
3046 if Assigned(TrackStationDown) and (TMetroLine(TrackStationDown.Track.Owner).LineStations.Count = 1) then begin
3047 TMetroLine(TrackStationDown.Track.Owner).DisconnectStation(
3048 TMetroLine(TrackStationDown.Track.Owner).LineStations.First);
3049 end;
3050 if Assigned(TrackStationUp) and (TMetroLine(TrackStationUp.Track.Owner).LineStations.Count = 1) then begin
3051 TMetroLine(TrackStationUp.Track.Owner).DisconnectStation(
3052 TMetroLine(TrackStationUp.Track.Owner).LineStations.First);
3053 end;
3054 end;
3055 end else
3056 if Button = mbRight then begin
3057 SelectedLine := nil;
3058 end;
3059 MouseHold := False;
3060 TrackStationDown := nil;
3061 TrackStationUp := nil;
3062 SelectedTrain := nil;
3063 SelectedCarriage := nil;
3064 Redraw;
3065end;
3066
3067procedure TEngine.MouseDown(Button: TMouseButton; Position: TPoint);
3068var
3069 Station: TMapStation;
3070 NewLine: TMetroLine;
3071 Track: TTrackLink;
3072 NewIndex: Integer;
3073 Intersection: TPoint;
3074begin
3075 if (Button = mbLeft) then begin
3076 if State in [gsRunning, gsPaused] then begin
3077 MouseHold := True;
3078 LastFocusedStation := nil;
3079 Redraw;
3080
3081 // Train selection
3082 SelectedTrain := GetTrainOnPos(View.PointDestToSrc(Position));
3083 if Assigned(SelectedTrain) then begin
3084 Exit;
3085 end;
3086
3087 // Carriage selection
3088 SelectedCarriage := GetCarriageOnPos(View.PointDestToSrc(Position));
3089 if Assigned(SelectedCarriage) then begin
3090 Exit;
3091 end;
3092
3093 // Select unused train
3094 if (Distance(Position, ImageLocomotive.Bounds.CenterPoint) < 30) and
3095 (Trains.GetUnusedCount > 0) then begin
3096 SelectedTrain := Trains.GetUnused;
3097 Exit;
3098 end;
3099
3100 // Select unused carriage
3101 if CarriageCountVisible and (Distance(Position, ImageCarriage.Bounds.CenterPoint) < 30) and
3102 (Carriages.GetUnusedCount > 0) then begin
3103 SelectedCarriage := Carriages.GetUnused;
3104 Exit;
3105 end;
3106
3107 // Select unused carriage
3108 if TerminalCountVisible and (Distance(Position, ImageTerminal.Bounds.CenterPoint) < 30) and
3109 (AvailableTerminals > 0) then begin
3110 SelectedTerminal := True;
3111 Exit;
3112 end;
3113
3114 // New track creation from selected station as start
3115 Station := GetStationOnPos(View.PointDestToSrc(Position));
3116 if Assigned(Station) then begin
3117 if Assigned(SelectedLine) and (SelectedLine.LineStations.Count = 0) then NewLine := SelectedLine
3118 else NewLine := GetUnusedLine;
3119 if Assigned(NewLine) then begin
3120 NewLine.ConnectStation(Station, nil, nil);
3121 TrackStationDown := NewLine.Track.Points.Last;
3122 TrackStationUp := nil;
3123 LastFocusedStation := Station;
3124 SelectedLine := NewLine;
3125 Exit;
3126 end;
3127 end;
3128
3129 // Line selection
3130 Track := GetTrackOnPos(View.PointDestToSrc(Position), Intersection);
3131 if Assigned(Track) and Assigned(Track.Points[0]) and Assigned(Track.Points[1]) then begin
3132 SelectedLine := TMetroLine(Track.Points[0].Track.Owner);
3133
3134 TrackStationDown := Track.Points[0];
3135 NewIndex := TrackStationDown.Track.Points.IndexOf(TrackStationDown);
3136 while Assigned(TrackStationDown) and (not Assigned(TrackStationDown.OwnerPoint)) do begin
3137 NewIndex := NewIndex - 1;
3138 if NewIndex >= 0 then TrackStationDown := TrackStationDown.Track.Points[NewIndex]
3139 else TrackStationDown := nil;
3140 end;
3141 TrackStationUp := Track.Points[1];
3142 NewIndex := TrackStationUp.Track.Points.IndexOf(TrackStationDown);
3143 while Assigned(TrackStationUp) and (not Assigned(TrackStationUp.OwnerPoint)) do begin
3144 NewIndex := NewIndex + 1;
3145 if NewIndex < TrackStationUp.Track.Points.Count then
3146 TrackStationUp := TrackStationUp.Track.Points[NewIndex]
3147 else TrackStationUp := nil;
3148 end;
3149 Track.Free;
3150 Exit;
3151 end;
3152 if Assigned(Track) then Track.Free;
3153 end;
3154 end;
3155end;
3156
3157procedure TEngine.KeyUp(Key: Word);
3158const
3159 KeyEsc = 27;
3160{$IFDEF DEBUG}
3161 KeyF2 = 113;
3162 KeyF3 = 114;
3163 KeyF4 = 115;
3164 KeyF5 = 116;
3165 KeyF6 = 117;
3166 KeyF7 = 118;
3167 KeyF8 = 119;
3168{$ENDIF}
3169 KeyT = 84;
3170 KeyC = 67;
3171 KeyF = 70;
3172 KeyP = 80;
3173begin
3174 if Key = KeyEsc then begin
3175 if State = gsMenu then begin
3176 if Assigned(Menu.OnExit) then
3177 Menu.OnExit(nil);
3178 end else begin
3179 ButtonBackClick(nil);
3180 end;
3181 end;
3182 if State in [gsRunning, gsPaused] then begin
3183 if Key = KeyT then begin
3184 if Trains.GetUnusedCount > 0 then begin
3185 SelectedTrain := Trains.GetUnused;
3186 Redraw;
3187 end;
3188 end else
3189 if Key = KeyC then begin
3190 if Carriages.GetUnusedCount > 0 then begin
3191 SelectedCarriage := Carriages.GetUnused;
3192 Redraw;
3193 end;
3194 end else
3195 if Key = KeyF then begin
3196 ButtonFastForward(Self);
3197 end else
3198 if Key = KeyP then begin
3199 ButtonPlay(Self);
3200 end;
3201 end;
3202 {$IFDEF DEBUG}
3203 if State in [gsRunning, gsPaused] then begin
3204 if Key = KeyF2 then begin
3205 State := gsGameOver;
3206 Redraw;
3207 end;
3208 if Key = KeyF3 then begin
3209 Trains.AddNew;
3210 Redraw;
3211 end;
3212 if Key = KeyF4 then begin
3213 Carriages.AddNew;
3214 Redraw;
3215 end;
3216 if Key = KeyF5 then begin
3217 State := gsNewWeek;
3218 Redraw;
3219 end;
3220 if Key = KeyF6 then begin
3221 Stations.AddNew;
3222 ResizeView(False);
3223 Redraw;
3224 end else
3225 if Key = KeyF7 then begin
3226 State := gsSuccess;
3227 Redraw;
3228 end else
3229 if Key = KeyF8 then begin
3230 Inc(AvailableTerminals);
3231 Redraw;
3232 end;
3233 end;
3234 {$ENDIF}
3235end;
3236
3237procedure TEngine.MainMenu;
3238begin
3239 State := gsMenu;
3240 Redraw;
3241end;
3242
3243procedure TEngine.Clear;
3244begin
3245 CarriageCountVisible := False;
3246 TerminalCountVisible := False;
3247 AvailableTerminals := 0;
3248 ServedPassengerCount := 0;
3249 Week := 1;
3250 Trains.Clear;
3251 Passengers.Clear;
3252 Carriages.Clear;
3253 Lines.Clear;
3254 Stations.Clear;
3255 View.SourceRect := Bounds(0, 0, 0, 0);
3256 SelectedLine := nil;
3257 SelectedTrain := nil;
3258 SelectedCarriage := nil;
3259end;
3260
3261procedure TEngine.NewGame;
3262var
3263 NewTrain: TMetroTrain;
3264 I: Integer;
3265 NewStation: TMapStation;
3266 InitialStationCount: Integer;
3267 InitialLineCount: Integer;
3268begin
3269 Clear;
3270 if Assigned(City) then begin
3271 LineColors := City.LineColors;
3272 InitialLineCount := City.InitialLineCount;
3273 end else begin
3274 LineColors := [clBlue, clRed, clDarkYellow, clGreen, clPurple, clGray,
3275 clOrange, clBrown, clCyan];
3276 InitialLineCount := 3;
3277 end;
3278 AvailableImprovements := [miCarriage, miLine, miTerminal];
3279 ShapeCount := 3;
3280
3281 // Start with 3 stations with each different shape
3282 InitialStationCount := 3;
3283 for I := 0 to InitialStationCount - 1 do begin
3284 NewStation := Stations.AddNew;
3285 if I = 0 then NewStation.Shape := ssSquare
3286 else if I = 1 then NewStation.Shape := ssCircle
3287 else if I = 2 then NewStation.Shape := ssTriangle;
3288 end;
3289
3290 for I := 0 to InitialLineCount - 1 do begin
3291 Lines.AddNew(LineColors[Lines.Count]);
3292 NewTrain := TMetroTrain.Create;
3293 Trains.Add(NewTrain);
3294 end;
3295
3296 ResizeView(True);
3297
3298 FTime := 0;
3299 FLastTime := 0;
3300 LastNewStationTime := Time;
3301 LastNewPassengerTime := Time;
3302 LastNewWeekTime := Time;
3303 LastNewShapeTime := Time;
3304 LastTickTime := Now;
3305 State := gsRunning;
3306 Redraw;
3307end;
3308
3309procedure TEngine.Redraw;
3310begin
3311 RedrawPending := True;
3312end;
3313
3314procedure TEngine.LoadFromRegistry;
3315begin
3316 with TRegistryEx.Create do
3317 try
3318 CurrentContext := RegistryContext;
3319 DarkMode := ReadBoolWithDefault('DarkMode', False);
3320 HighestServedPassengerCount := ReadIntegerWithDefault('HighestPassengers', 0);
3321 HighestServedDaysCount := ReadIntegerWithDefault('HighestDays', 0);
3322 Cities.LoadFromRegistry(TRegistryContext.Create(RegistryContext.RootKey, RegistryContext.Key + '\Cities'));
3323 finally
3324 Free;
3325 end;
3326end;
3327
3328procedure TEngine.SaveToRegistry;
3329begin
3330 with TRegistryEx.Create do
3331 try
3332 CurrentContext := RegistryContext;
3333
3334 WriteBool('DarkMode', DarkMode);
3335 WriteInteger('HighestPassengers', HighestServedPassengerCount);
3336 WriteInteger('HighestDays', HighestServedDaysCount);
3337 Cities.SaveToRegistry(TRegistryContext.Create(RegistryContext.RootKey, RegistryContext.Key + '\Cities'));
3338 finally
3339 Free;
3340 end;
3341end;
3342
3343constructor TEngine.Create;
3344begin
3345 ImprovementImageSize := ScaleX(64, 96);
3346 IconSize := ScaleX(32, 96);
3347 TimePerSecond := TimePerSecondNormal;
3348 ButtonBack := TImage.Create;
3349 ButtonBack.OnClick := ButtonBackClick;
3350 ButtonBack.Bounds := Bounds(0, 0, ScaleX(80, 96), ScaleY(80, 96));
3351 Cities := TCities.Create;
3352 InitCities;
3353 MenuMain := TMenu.Create;
3354 MenuOptions := TMenu.Create;
3355 MenuCareer := TMenu.Create;
3356 MenuGame := TMenu.Create;
3357 Menu := MenuMain;
3358 InitMenus;
3359 Stations := TMapStations.Create;
3360 Stations.Engine := Self;
3361 Lines := TMetroLines.Create;
3362 Lines.Engine := Self;
3363 Passengers := TMetroPassengers.Create;
3364 Map := TMap.Create;
3365 View := TView.Create;
3366 Trains := TMetroTrains.Create;
3367 Carriages := TMetroCarriages.Create;
3368 ImageTunnel := TImage.Create;
3369 ImageLine := TImage.Create;
3370 ImageTerminal := TImage.Create;
3371 ImagePassenger := TImage.Create;
3372 ImageLocomotive := TImage.Create;
3373 ImageCarriage := TImage.Create;
3374 ImagePlay := TImage.Create;
3375 ImagePlay.OnClick := ButtonPlay;
3376 ImagePause := TImage.Create;
3377 ImagePause.OnClick := ButtonPause;
3378 ImageFastForward := TImage.Create;
3379 ImageFastForward.OnClick := ButtonFastForward;
3380 ImageAchievement := TImage.Create;
3381 ImageNewTrain := TImage.Create;
3382 ImageNewTrain.OnClick := ButtonNewTrain;
3383 ImageNewImprovement1 := TImage.Create;
3384 ImageNewImprovement1.OnClick := ButtonNewImprovement1;
3385 ImageNewImprovement2 := TImage.Create;
3386 ImageNewImprovement2.OnClick := ButtonNewImprovement2;
3387 MetaCanvas := TMetaCanvas.Create;
3388 Colors.Init(FDarkMode);
3389end;
3390
3391destructor TEngine.Destroy;
3392begin
3393 FreeAndNil(MetaCanvas);
3394 FreeAndNil(Trains);
3395 FreeAndNil(Carriages);
3396 FreeAndNil(ImageTunnel);
3397 FreeAndNil(ImageTerminal);
3398 FreeAndNil(ImageLine);
3399 FreeAndNil(ImageNewImprovement1);
3400 FreeAndNil(ImageNewImprovement2);
3401 FreeAndNil(ImageNewTrain);
3402 FreeAndNil(ImagePlay);
3403 FreeAndNil(ImageFastForward);
3404 FreeAndNil(ImageAchievement);
3405 FreeAndNil(ImagePause);
3406 FreeAndNil(ImageCarriage);
3407 FreeAndNil(ImageLocomotive);
3408 FreeAndNil(ImagePassenger);
3409 FreeAndNil(View);
3410 FreeAndNil(Map);
3411 FreeAndNil(Passengers);
3412 FreeAndNil(Stations);
3413 FreeAndNil(Lines);
3414 FreeAndNil(MenuMain);
3415 FreeAndNil(MenuOptions);
3416 FreeAndNil(MenuCareer);
3417 FreeAndNil(MenuGame);
3418 FreeAndNil(Cities);
3419 FreeAndNil(ButtonBack);
3420 inherited;
3421end;
3422
3423procedure TEngine.Paint(Canvas: TCanvas; CanvasSize: TPoint);
3424begin
3425 MetaCanvas.Size := Point(Canvas.Width, Canvas.Height);
3426 MetaCanvas.Reset;
3427
3428 DrawStationPassengerOverload(MetaCanvas);
3429 DrawLines(MetaCanvas);
3430 DrawTrains(MetaCanvas);
3431 DrawStations(MetaCanvas);
3432
3433 // MainMenu background
3434 Canvas.Brush.Color := Colors.Background;
3435 Canvas.Brush.Style := bsSolid;
3436 Canvas.Clear;
3437
3438 MetaCanvas.Move(Point(-View.SourceRect.Left, -View.SourceRect.Top));
3439 MetaCanvas.Zoom(View.Zoom);
3440
3441 // Draw meta canvas to real target canvas
3442 MetaCanvas.DrawTo(Canvas);
3443
3444 if State = gsGameOver then
3445 begin
3446 DrawGameOver(Canvas, CanvasSize);
3447 DrawGameControls(Canvas, CanvasSize);
3448 end else
3449 if State = gsSuccess then
3450 begin
3451 DrawSuccess(Canvas, CanvasSize);
3452 DrawGameControls(Canvas, CanvasSize);
3453 end else
3454 if State = gsMenu then begin
3455 Menu.Paint(Canvas, CanvasSize);
3456 end else
3457 if State = gsNewWeek then begin
3458 DrawNewWeek(Canvas, CanvasSize);
3459 end else
3460 if State = gsNewImprovement then begin
3461 DrawNewImprovement(Canvas, CanvasSize);
3462 end else
3463 if State in [gsRunning, gsPaused] then begin
3464 DrawGameControls(Canvas, CanvasSize);
3465 DrawGrabbed(Canvas, CanvasSize);
3466 end;
3467
3468 RedrawPending := False;
3469end;
3470
3471end.
3472
Note: See TracBrowser for help on using the repository browser.