Changeset 28 for trunk

Timestamp:

Apr 12, 2015, 2:32:33 PM (10 years ago)

Author:

chronos

Message:

• Added: Now user can place additional trains on line and move trains between lines and different places on line.

Location:

trunk

Files:

• UEngine.pas (modified) (19 diffs)
• UFormMain.lfm (modified) (1 diff)
• UFormMain.pas (modified) (4 diffs)
• UGeometric.pas (modified) (2 diffs)

trunk/UEngine.pas

@@ -143 +143 @@
   TMetroTrain = class
   private
+    FLine: TMetroLine;
     LastPosDelta: Integer;
     LastTrainMoveTime: TDateTime;
     StationStopTime: TDateTime;
+    procedure SetLine(AValue: TMetroLine);
   public
     Passengers: TMetroPassengers;
-    Line: TMetroLine;
+
     BaseTrackPoint: TTrackPoint;
     RelPos: Double;
@@ -159 +161 @@
     constructor Create;
     destructor Destroy; override;
+    property Line: TMetroLine read FLine write SetLine;
   end;
 
@@ -187 +190 @@
   end;
 
+  { TView }
+
   TView = class
-    Size: TPoint;
-    Zoom: Double;
+  private
+    FDestRect: TRect;
+    FZoom: Double;
+    procedure SetDestRect(AValue: TRect);
+    procedure SetZoom(AValue: Double);
+  public
+    SourceRect: TRect;
+    constructor Create;
+    property DestRect: TRect read FDestRect write SetDestRect;
+    property Zoom: Double read FZoom write SetZoom;
   end;
 
@@ -213 +226 @@
     function GetStationOnPos(Pos: TPoint): TMapStation;
     function GetTrackOnPos(Pos: TPoint): TTrack;
+    function GetTrainOnPos(Pos: TPoint): TMetroTrain;
     procedure DrawLine(Canvas: TCanvas; Pos: TPoint);
     procedure DrawShape(Canvas: TCanvas; Position: TPoint; Shape: TStationShape;
@@ -233 +247 @@
     View: TView;
     SelectedLine: TMetroLine;
+    SelectedTrain: TMetroTrain;
     TrackStationDown: TTrackPoint;
     TrackStationUp: TTrackPoint;
@@ -285 +300 @@
   UGeometric;
 
+resourcestring
+  SZeroZoomNotAlowed = 'Zero zoom not allowed';
+
+{ TView }
+
+procedure TView.SetDestRect(AValue: TRect);
+var
+  Diff: TPoint;
+begin
+  if RectEquals(FDestRect, AValue) then Exit;
+  Diff := Point(Trunc((DestRect.Right - DestRect.Left) / Zoom - (AValue.Right - AValue.Left) / Zoom) div 2,
+    Trunc((DestRect.Bottom - DestRect.Top) / Zoom - (AValue.Bottom - AValue.Top) / Zoom) div 2);
+  FDestRect := AValue;
+  SourceRect := Bounds(SourceRect.Left + Diff.X, SourceRect.Top + Diff.Y,
+    Trunc((DestRect.Right - DestRect.Left) / Zoom),
+    Trunc((DestRect.Bottom - DestRect.Top) / Zoom));
+end;
+
+procedure TView.SetZoom(AValue: Double);
+begin
+  if FZoom = AValue then Exit;
+  if AValue = 0 then
+    raise Exception.Create(SZeroZoomNotAlowed);
+  FZoom := AValue;
+  SourceRect := Bounds(Trunc(SourceRect.Left + (SourceRect.Right - SourceRect.Left) div 2 - (DestRect.Right - DestRect.Left) / Zoom / 2),
+    Trunc(SourceRect.Top +  (SourceRect.Bottom - SourceRect.Top) div 2 - (DestRect.Bottom - DestRect.Top) / Zoom / 2),
+    Trunc((DestRect.Right - DestRect.Left) / Zoom),
+    Trunc((DestRect.Bottom - DestRect.Top) / Zoom));
+end;
+
+constructor TView.Create;
+begin
+  Zoom := 1.5;
+end;
+
 { TTracks }
 
@@ -361 +411 @@
   NewIndex: Integer;
 begin
+  Result := nil;
   NewIndex := Line.TrackPoints.IndexOf(Self) - 1;
-  if NewIndex >= 0 then Result := TTrackPoint(Line.TrackPoints[NewIndex])
-    else Result := nil;
+  if NewIndex >= 0 then Result := TTrackPoint(Line.TrackPoints[NewIndex]);
 end;
 
@@ -370 +420 @@
   NewIndex: Integer;
 begin
-  NewIndex := Line.TrackPoints.IndexOf(Self) + 1;
-  if NewIndex < Line.TrackPoints.Count then Result := TTrackPoint(Line.TrackPoints[NewIndex])
-    else Result := nil;
+  Result := nil;
+  if Assigned(Line) then begin
+    NewIndex := Line.TrackPoints.IndexOf(Self) + 1;
+    if NewIndex < Line.TrackPoints.Count then Result := TTrackPoint(Line.TrackPoints[NewIndex]);
+  end;
 end;
 
@@ -731 +783 @@
 
 { TMetroTrain }
+
+procedure TMetroTrain.SetLine(AValue: TMetroLine);
+begin
+  if FLine = AValue then Exit;
+  FLine := AValue;
+  if AValue = nil then begin
+    RelPos := 0;
+    BaseTrackPoint := nil;
+    TargetStation := nil;
+  end;
+end;
 
 function TMetroTrain.GetTargetStationDistance: Integer;
@@ -1013 +1076 @@
     end;
     Inc(I);
+  end;
+end;
+
+function TEngine.GetTrainOnPos(Pos: TPoint): TMetroTrain;
+var
+  I: Integer;
+  MinDistance: Integer;
+  D: Integer;
+begin
+  Result := nil;
+  MinDistance := High(Integer);
+  for I := 0 to Trains.Count - 1 do
+  with TMetroTrain(Trains[I]) do begin
+    D := Distance(GetPosition, Pos);
+    if (D < (TrainSize div 2)) and (D < MinDistance) then begin
+      Result := TMetroTrain(Trains[I]);
+      MinDistance := D;
+    end;
   end;
 end;
@@ -1201 +1282 @@
   for I := 0 to Trains.Count - 1 do
   with TMetroTrain(Trains[I]) do begin
+    if not Assigned(TargetStation) and Assigned(BaseTrackPoint) then begin
+      Direction := 1;
+      TargetStation := BaseTrackPoint.GetUp.LineStation;
+    end;
     if Assigned(Line) then begin
       if InStation then begin
@@ -1426 +1511 @@
   ShapePos: TPoint;
 begin
-    // Draw trains
+  // Draw trains
   for I := 0 to Trains.Count - 1 do
   with TMetroTrain(Trains[I]) do begin
@@ -1576 +1661 @@
 procedure TEngine.MouseUp(Button: TMouseButton; Position: TPoint);
 var
-  Station: TMapStation;
-  Line: TMetroLine;
-  I: Integer;
+  I: Integer;
+  FocusedTrack: TTrack;
 begin
   if Button = mbLeft then begin
+    // Place selected train if focused track
+    if Assigned(SelectedTrain) then begin
+      SelectedTrain.TargetStation := nil;
+      SelectedTrain.BaseTrackPoint := nil;
+      if Assigned(SelectedTrain.Line) then begin
+        SelectedTrain.Line.Trains.Remove(SelectedTrain);
+        SelectedTrain.Line := nil;
+      end;
+      FocusedTrack := GetTrackOnPos(Position);
+      if Assigned(FocusedTrack.PointDown) then begin
+        SelectedTrain.Line := FocusedTrack.PointDown.Line;
+        SelectedTrain.Line.Trains.Add(SelectedTrain);
+        SelectedTrain.BaseTrackPoint := FocusedTrack.PointDown;
+      end else
+      if Assigned(FocusedTrack.PointDown) then begin
+        SelectedTrain.Line := FocusedTrack.PointUp.Line;
+        SelectedTrain.Line.Trains.Add(SelectedTrain);
+        SelectedTrain.BaseTrackPoint := FocusedTrack.PointUp;
+      end;
+    end;
 
     // Line color selection
     for I := 0 to Lines.Count - 1 do
-      if Distance(Point(View.Size.X div 2 - Length(LineColors) div 2 * LineColorsDist + I * LineColorsDist,
-        View.Size.Y - LineColorsDist), Position) < 20 then begin
+      if Distance(Point(View.DestRect.Right div 2 - Length(LineColors) div 2 * LineColorsDist + I * LineColorsDist,
+        View.DestRect.Bottom - LineColorsDist), Position) < 20 then begin
           SelectedLine := TMetroLine(Lines[I]);
           Exit;
@@ -1604 +1708 @@
   TrackStationDown := nil;
   TrackStationUp := nil;
+  SelectedTrain := nil;
 end;
 
@@ -1618 +1723 @@
     MouseHold := True;
     LastFocusedStation := nil;
+
+    // Train selection
+    SelectedTrain := GetTrainOnPos(Position);
+    if Assigned(SelectedTrain) then begin
+      Exit;
+    end;
+
+    // Select unused train
+    if (Distance(Position, Point(View.DestRect.Right div 2 - Length(LineColors) div 2 * LineColorsDist - 100,
+    View.DestRect.Bottom - LineColorsDist)) < 30) and
+    (Trains.GetUnusedCount > 0) then begin
+      SelectedTrain := Trains.GetUnusedTrain;
+      Exit;
+    end;
 
     // Line selection
@@ -1673 +1792 @@
 
   // Start with 3 stations with each different shape
-  InitialStationCount := 3;
+  InitialStationCount := 30;
   for I := 0 to InitialStationCount - 1 do begin
     NewStation := Stations.AddNew;
@@ -1742 +1861 @@
   PassengerPos: TPoint;
   Direction: Integer;
+  Points: array of TPoint;
 const
   GameOverText = 'Game Over';
@@ -1889 +2009 @@
   end;
 
-  // Interface
+  // Draw unused trains
+  Text := IntToStr(Trains.GetUnusedCount);
+  Canvas.Draw(Canvas.Width div 2 - Length(LineColors) div 2 * LineColorsDist - 100,
+    Canvas.Height - LineColorsDist - ImageLocomotive.Picture.Bitmap.Height div 2, ImageLocomotive.Picture.Bitmap);
+  Canvas.Brush.Style := bsClear;
+  Canvas.TextOut(Canvas.Width div 2 - Length(LineColors) div 2 * LineColorsDist - 50 - Canvas.TextWidth(Text),
+    Canvas.Height - LineColorsDist - Canvas.TextHeight(Text) div 2, Text);
+
+
+  // Status interface
   Text := IntToStr(ServedPassengerCount);
   Canvas.Draw(Canvas.Width - 140, 20, ImagePassenger.Picture.Bitmap);
@@ -1895 +2024 @@
   Canvas.TextOut(Canvas.Width - 146 - Canvas.TextWidth(Text), 25, Text);
 
-  Text := IntToStr(Trains.GetUnusedCount);
-  Canvas.Draw(Canvas.Width - 240, 20, ImageLocomotive.Picture.Bitmap);
-  Canvas.Brush.Style := bsClear;
-  Canvas.TextOut(Canvas.Width - 246 - Canvas.TextWidth(Text), 25, Text);
-
   DrawClock(Canvas);
+
+  if Assigned(SelectedTrain) then begin
+    Canvas.Brush.Color := clBlack; //SelectedTrain.Line.Color;
+    Canvas.Brush.Style := bsSolid;
+    Canvas.Pen.Style := psClear;
+    Pos := LastMousePos;
+    Angle := 0;
+
+    SetLength(Points, 4);
+    Points[0] := RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y - TrainSize div 3), Angle);
+    Points[1] := RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y - TrainSize div 3), Angle);
+    Points[2] := RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y + TrainSize div 3), Angle);
+    Points[3] := RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y + TrainSize div 3), Angle);
+    Canvas.Polygon(Points);
+  end;
 
   // Game over

trunk/UFormMain.lfm

@@ -19 +19 @@
     Width = 1139
     Align = alClient
-    OnClick = PaintBox1Click
     OnMouseDown = PaintBox1MouseDown
     OnMouseMove = PaintBox1MouseMove

trunk/UFormMain.pas

@@ -20 +20 @@
     procedure FormKeyPress(Sender: TObject; var Key: char);
     procedure FormShow(Sender: TObject);
-    procedure PaintBox1Click(Sender: TObject);
     procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
       Shift: TShiftState; X, Y: Integer);
@@ -68 +67 @@
 begin
   Randomize;
-  Engine.View.Size := Point(PaintBox1.Width, PaintBox1.Height);
-  Engine.Map.Size := Engine.View.Size;
+  Engine.Map.Size := Point(PaintBox1.Width, PaintBox1.Height);
   Engine.Reset;
-end;
-
-procedure TFormMain.PaintBox1Click(Sender: TObject);
-begin
-
 end;
 
@@ -98 +91 @@
 procedure TFormMain.PaintBox1Paint(Sender: TObject);
 begin
+  Engine.View.DestRect := Rect(0, 0, PaintBox1.Width, PaintBox1.Height);
   Engine.Paint(PaintBox1.Canvas);
 end;
@@ -103 +97 @@
 procedure TFormMain.PaintBox1Resize(Sender: TObject);
 begin
-  //Engine.
 end;
 

trunk/UGeometric.pas

@@ -22 +22 @@
 function ArcTan2Point(Point: TPoint): Float;
 function ArcTanPoint(Point: TPoint): Float;
+function RectEquals(A, B: TRect): Boolean;
 
 implementation
@@ -125 +126 @@
 end;
 
+function RectEquals(A, B: TRect): Boolean;
+begin
+  Result := (A.Left = B.Left) and (A.Top = B.Top) and
+    (A.Right = B.Right) and (A.Bottom = B.Bottom);
+end;
+
+
 end.