Changeset 25 for trunk

Timestamp:

Apr 12, 2015, 12:08:05 AM (10 years ago)

Author:

chronos

Message:

• Added: Draw track lines which go in same position side by side to see them all and be able to grab one of them. This is not yet perfectly implemented as this require to implement track points link properties first.
• Fixed: Do not allow connect end station to grabbed track between two stations.
• Fixed: Index on wrong list in shape distance calculation function.

Location:

trunk

Files:

• BigMetro.lpi (modified) (3 diffs)
• BigMetro.lpr (modified) (1 diff)
• UEngine.pas (modified) (23 diffs)
• UGeometric.pas (modified) (4 diffs)

trunk/BigMetro.lpi

@@ -69 +69 @@
       </Item1>
     </RequiredPackages>
-    <Units Count="4">
+    <Units Count="5">
       <Unit0>
         <Filename Value="BigMetro.lpr"/>
@@ -92 +92 @@
         <UnitName Value="UGeometric"/>
       </Unit3>
+      <Unit4>
+        <Filename Value="UTrack.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="UTrack"/>
+      </Unit4>
     </Units>
   </ProjectOptions>
@@ -119 +124 @@
         <StackChecks Value="True"/>
       </Checks>
-      <VerifyObjMethodCallValidity Value="True"/>
     </CodeGeneration>
     <Linking>

trunk/BigMetro.lpr

@@ -8 +8 @@
   {$ENDIF}{$ENDIF}
   Interfaces, // this includes the LCL widgetset
-  Forms, SysUtils, UFormMain, UEngine, UGeometric
+  Forms, SysUtils, UFormMain, UEngine, UGeometric, UTrack
   { you can add units after this };
 

trunk/UEngine.pas

@@ -24 +24 @@
   TMapStation = class
   private
+    procedure ShiftTrackPoints;
+    procedure SortLines;
   public
     Engine: TEngine;
@@ -63 +65 @@
     LineStation: TLineStation;
     Point: TPoint;
+    PointShift: TPoint;
+    DesignedPoint: TPoint;
     Pending: Boolean;
     function GetDown: TTrackPoint;
@@ -72 +76 @@
   end;
 
-  TTrack = record
+  TTrack = class
     PointDown: TTrackPoint;
     PointUp: TTrackPoint;
+    Line: TMetroLine;
+    Shift: TPoint;
+  end;
+
+  { TTracks }
+
+  TTracks = class(TObjectList)
+    function SearchPointUp(TrackPoint: TTrackPoint; Skip: TTrack): TTrack;
+    function SearchPointDown(TrackPoint: TTrackPoint; Skip: TTrack): TTrack;
+  end;
+
+  { TTrackPointsAngle }
+
+  TTrackPointsAngle = class
+    Angle: Double;
+    Tracks: TTracks;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  { TTrackPointsAngleGroup }
+
+  TTrackPointsAngleGroup = class(TObjectList)
+    function SearchAngle(Angle: Double): TTrackPointsAngle;
   end;
 
@@ -83 +111 @@
     procedure UpdateEndingLines;
   public
+    Index: Integer;
     Engine: TEngine;
     Color: TColor;
@@ -189 +218 @@
     procedure TrainMovement;
     function GetUnusedLine: TMetroLine;
+    procedure ShiftTrackPoints;
   public
     Passengers: TMetroPassengers;
@@ -231 +261 @@
   StationMaxDistance = 300;
   MaxWaitingPassengers = 10;
-  MaxPassengersOveloadTime = 1;
+  MaxPassengersOveloadTime = 2;
   MetroLineThickness = 13;
   TrackClickDistance = 20;
@@ -238 +268 @@
   //TimePerSecond = (60 * OneMinute);
   TimePerSecond = (60 * OneMinute);
+  NewStationPeriod = 1;
+  NewShapePeriod = 10;
+  NewTrainPeriod = 7; // Each week
+  NewPassengerPeriod = 0.3 * OneSecond;
+  NewPassengerProbability = 0.002;
 
 implementation
@@ -243 +278 @@
 uses
   UGeometric;
+
+{ TTracks }
+
+function TTracks.SearchPointUp(TrackPoint: TTrackPoint; Skip: TTrack): TTrack;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Count) and (TTrack(Items[I]).PointUp <> TrackPoint) and (TTrack(Items[I]) <> Skip) do Inc(I);
+  if I < Count then Result := TTrack(Items[I])
+    else Result := nil;
+end;
+
+function TTracks.SearchPointDown(TrackPoint: TTrackPoint; Skip: TTrack): TTrack;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Count) and (TTrack(Items[I]).PointDown <> TrackPoint) and (TTrack(Items[I]) <> Skip) do Inc(I);
+  if I < Count then Result := TTrack(Items[I])
+    else Result := nil;
+end;
+
+{ TTrackPointsAngleGroup }
+
+function TTrackPointsAngleGroup.SearchAngle(Angle: Double): TTrackPointsAngle;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Count) and (TTrackPointsAngle(Items[I]).Angle <> Angle) do Inc(I);
+  if I < Count then Result := TTrackPointsAngle(Items[I])
+    else Result := nil;
+end;
+
+{ TTrackPointsAngle }
+
+constructor TTrackPointsAngle.Create;
+begin
+  Tracks := TTracks.Create;
+  Tracks.OwnsObjects := False;
+end;
+
+destructor TTrackPointsAngle.Destroy;
+begin
+  Tracks.Free;
+  inherited Destroy;
+end;
 
 { TTrackPoint }
@@ -357 +440 @@
   Result.Color := LineColors[Count];
   Result.Engine := Engine;
+  Result.Index := Count;
   Add(Result);
 end;
@@ -398 +482 @@
       Round(TTrackPoint(TrackPoints[1]).Point.Y - EndStationLength * Sin(Angle)));
     TTrackPoint(TrackPoints.First).Point := EndPoint;
+    TTrackPoint(TrackPoints.First).DesignedPoint := EndPoint;
 
     Angle := arctan2((TTrackPoint(TrackPoints[TrackPoints.Count - 2]).Point.Y - TTrackPoint(TrackPoints[TrackPoints.Count - 3]).Point.Y),
@@ -404 +489 @@
       Round(TTrackPoint(TrackPoints[TrackPoints.Count - 2]).Point.Y + EndStationLength * Sin(Angle)));
     TTrackPoint(TrackPoints.Last).Point := EndPoint;
+    TTrackPoint(TrackPoints.Last).DesignedPoint := EndPoint;
   end;
 end;
@@ -430 +516 @@
   NewTrackPoint.LineStation := NewLineStation;
   NewTrackPoint.Point := Station.Position;
+  NewTrackPoint.DesignedPoint := NewTrackPoint.Point;
   NewTrackPoint.Line := TrackPoints.Line;
   Index := 0;
@@ -453 +540 @@
   UpdateEndingLines;
   Engine.ComputeShapeDistance;
+  Engine.ShiftTrackPoints;
 end;
 
@@ -491 +579 @@
   UpdateEndingLines;
   Engine.ComputeShapeDistance;
+  Engine.ShiftTrackPoints;
 end;
 
@@ -510 +599 @@
   if Abs(Delta.X) > Abs(Delta.Y) then begin
     NewTrackPoint.Point := Point(P2.X - Sign(Delta.X) * Abs(Delta.Y), P1.Y);
+    NewTrackPoint.DesignedPoint := NewTrackPoint.Point;
   end else begin
     NewTrackPoint.Point := Point(P1.X, P2.Y - Sign(Delta.Y) * Abs(Delta.X));
+    NewTrackPoint.DesignedPoint := NewTrackPoint.Point;
   end;
   TrackPoints.Insert(Index1 + 1, NewTrackPoint);
@@ -650 +741 @@
 
 { TMapStation }
+
+procedure TMapStation.ShiftTrackPoints;
+var
+  Tracks: TTracks;
+  I: Integer;
+  J: Integer;
+  Index: Integer;
+  TP: TTrackPoint;
+  LS: TLineStation;
+  Line: TMetroLine;
+  Angle: Double;
+  TPAngleGroup: TTrackPointsAngleGroup;
+  GroupItem: TTrackPointsAngle;
+  NewTrack: TTrack;
+  HAngle: Double;
+  PairTrack: TTrack;
+  NewPoint: TPoint;
+begin
+  Tracks := TTracks.Create;
+
+  // Collect all near track points as track
+  SortLines;
+  for I := 0 to Lines.Count - 1 do begin
+    Line := TMetroLine(Lines[I]);
+    LS := Line.LineStations.SearchMapStation(Self);
+    TP := LS.TrackPoint;
+    Index := Line.TrackPoints.IndexOf(TP);
+    if Index > 0 then begin
+      NewTrack := TTrack.Create;
+      NewTrack.PointDown := TTrackPoint(Line.TrackPoints[Index - 1]);
+      NewTrack.PointUp := TTrackPoint(Line.TrackPoints[Index]);
+      Tracks.Add(NewTrack);
+    end;
+    if Index < (Line.TrackPoints.Count - 1) then begin
+      NewTrack := TTrack.Create;
+      NewTrack.PointDown := TTrackPoint(Line.TrackPoints[Index + 1]);
+      NewTrack.PointUp := TTrackPoint(Line.TrackPoints[Index]);
+      Tracks.Add(NewTrack);
+    end;
+  end;
+
+  // Make groups of tracks with same angle
+  TPAngleGroup := TTrackPointsAngleGroup.Create;
+  for I := 0 to Tracks.Count - 1 do begin
+    Angle := ArcTan2(TTrack(Tracks[I]).PointDown.DesignedPoint.Y - Position.Y,
+      TTrack(Tracks[I]).PointDown.DesignedPoint.X - Position.X);
+    GroupItem := TPAngleGroup.SearchAngle(Angle);
+    if not Assigned(GroupItem) then begin
+      GroupItem := TTrackPointsAngle.Create;
+      GroupItem.Angle := Angle;
+      TPAngleGroup.Add(GroupItem);
+    end;
+    GroupItem.Tracks.Add(TTrack(Tracks[I]))
+  end;
+
+  // Shift tracks according number of lines in group
+  for I := 0 to TPAngleGroup.Count - 1 do
+  with TTrackPointsAngle(TPAngleGroup[I]) do begin
+    for J := 0 to Tracks.Count - 1 do
+      with TTrack(Tracks[J]) do begin
+        // Get orthogonal angle
+        HAngle := Angle + Pi / 2;
+        if HAngle > Pi then HAngle := Hangle - Pi;
+        Shift.X := Trunc(MetroLineThickness * Cos(HAngle) * (J - (Tracks.Count - 1) / 2));
+        Shift.Y := Trunc(MetroLineThickness * Sin(HAngle) * (J - (Tracks.Count - 1) / 2));
+        PointDown.PointShift := Shift;
+        PointUp.PointShift := Shift;
+      end;
+  end;
+
+  TPAngleGroup.Free;
+  Tracks.Free;
+end;
+
+function MapStationCompareLine(Item1, Item2: Pointer): Integer;
+begin
+  if TMetroLine(Item1).Index > TMetroLine(Item2).Index then Result := 1
+  else if TMetroLine(Item1).Index < TMetroLine(Item2).Index then Result := -1
+  else Result := 0;
+end;
+
+procedure TMapStation.SortLines;
+begin
+  Lines.Sort(MapStationCompareLine);
+end;
 
 function TMapStation.IsBestStationForShape(Shape: TStationShape;
@@ -756 +932 @@
   MinD: Integer;
 begin
+  Result := TTrack.Create;
   Result.PointDown := nil;
   Result.PointUp := nil;
@@ -926 +1103 @@
           if DirectionUp then begin
             if StationIndex = 0 then
-              ComputeShapeDistanceStation(TLineStation(LineStations[Stations.Count - 2]).MapStation,
+              ComputeShapeDistanceStation(TLineStation(LineStations[LineStations.Count - 2]).MapStation,
               UpdatedShape, Station.ShapeDistance[UpdatedShape] + 1);
             if StationIndex > 0 then
@@ -1063 +1240 @@
 end;
 
+procedure TEngine.ShiftTrackPoints;
+var
+  I: Integer;
+  J: Integer;
+  L: Integer;
+  Link1, Link2: TPoint;
+  NewPoint: TPoint;
+begin
+  // Reset all trackpoints position shift
+  for I := 0 to Lines.Count - 1 do
+  with TMetroLine(Lines[I]) do
+    for J := 0 to TrackPoints.Count - 1 do
+    TTrackPoint(TrackPoints[J]).Point := TTrackPoint(TrackPoints[J]).DesignedPoint;
+
+  // Calculate new position shifts
+  for I := 0 to Stations.Count - 1 do
+    TMapStation(Stations[I]).ShiftTrackPoints;
+
+  // Compute track points from track shift
+  for L := 0 to Lines.Count - 1 do
+  with TMetroLine(Lines[L]) do begin
+    if TrackPoints.Count > 0 then
+      TTrackPoint(TrackPoints[0]).Point := AddPoint(TTrackPoint(TrackPoints[0]).DesignedPoint,
+        TTrackPoint(TrackPoints[0]).PointShift);
+    for I := 1 to TrackPoints.Count - 1 do
+    with TTrackPoint(TrackPoints[I]) do begin
+      Link1 := SubPoint(AddPoint(TTrackPoint(TrackPoints[I]).DesignedPoint, TTrackPoint(TrackPoints[I]).PointShift),
+        AddPoint(TTrackPoint(TrackPoints[I - 1]).DesignedPoint, TTrackPoint(TrackPoints[I - 1]).PointShift));
+      if (I + 1) < TrackPoints.Count then
+        Link2 := SubPoint(AddPoint(TTrackPoint(TrackPoints[I + 1]).DesignedPoint, TTrackPoint(TrackPoints[I + 1]).PointShift),
+          AddPoint(TTrackPoint(TrackPoints[I]).DesignedPoint, TTrackPoint(TrackPoints[I]).PointShift))
+        else Link2 := Link1;
+
+      if ArcTanPoint(Link1) = ArcTanPoint(Link2) then begin
+        // Parallel lines
+        TTrackPoint(TrackPoints[I]).Point := AddPoint(TTrackPoint(TrackPoints[I]).DesignedPoint,
+          TTrackPoint(TrackPoints[I]).PointShift);
+      end else begin
+        // Intersected lines
+        NewPoint := LineIntersect(AddPoint(TTrackPoint(TrackPoints[I - 1]).DesignedPoint, TTrackPoint(TrackPoints[I - 1]).PointShift),
+          AddPoint(TTrackPoint(TrackPoints[I]).DesignedPoint, TTrackPoint(TrackPoints[I]).PointShift),
+          AddPoint(TTrackPoint(TrackPoints[I]).DesignedPoint, TTrackPoint(TrackPoints[I]).PointShift),
+          AddPoint(TTrackPoint(TrackPoints[I + 1]).DesignedPoint, TTrackPoint(TrackPoints[I + 1]).PointShift));
+        TTrackPoint(TrackPoints[I]).Point := NewPoint;
+      end;
+    end;
+  end;
+
+end;
+
 procedure TEngine.DrawClock(Canvas: TCanvas);
 var
@@ -1130 +1357 @@
 
 procedure TEngine.Tick;
-const
-  NewStationPeriod = 1;
-  NewShapePeriod = 10;
-  NewTrainPeriod = 7; // Each week
-  NewPassengerPeriod = 0.3 * OneSecond;
-  NewPassengerProbability = 0.005;
 var
   Passenger: TMetroPassenger;
@@ -1235 +1456 @@
           Line.DisconnectStation(CurrentTrackPoint.LineStation);
         end else
-        if Assigned(Line) and ((Line.LineStations.SearchMapStation(FocusedStation) = nil) or
+        if Assigned(Line) and ((not Line.IsCircular) or ((TrackStationDown <> nil) and (TrackStationUp <> nil))) and
+        ((Line.LineStations.SearchMapStation(FocusedStation) = nil) or
         ((Line.LineStations.Count > 0) and
         ((TLineStation(Line.LineStations.First).MapStation = FocusedStation) or
-        (TLineStation(Line.LineStations.Last).MapStation = FocusedStation)))) then begin
+        (TLineStation(Line.LineStations.Last).MapStation = FocusedStation)) and
+        ((TrackStationDown = nil) or (TrackStationUp = nil)) and
+        (not Line.IsCircular))) then begin
           if Assigned(TrackStationDown) then LineStationDown := TrackStationDown.LineStation
             else LineStationDown := nil;
@@ -1299 +1523 @@
     // Line selection
     Track := GetTrackOnPos(Position);
-    if Assigned(Track.PointDown) and Assigned(Track.PointUp) then begin
+    if Assigned(Track) and Assigned(Track.PointDown) and Assigned(Track.PointUp) then begin
       SelectedLine := Track.PointDown.Line;
 
@@ -1317 +1541 @@
           else TrackStationUp := nil;
       end;
-
+      Track.Free;
       Exit;
     end;

trunk/UGeometric.pas

@@ -13 +13 @@
 function Distance(P1, P2: TPoint): Integer;
 function Dot(const P1, P2: TPoint): Double;
+function AddPoint(const P1, P2: TPoint): TPoint;
 function SubPoint(const P1, P2: TPoint): TPoint;
 function PointToLineDistance(const P, V, W: TPoint): Integer;
@@ -18 +19 @@
 function RotatePoint(Center, P: TPoint; Angle: Double): TPoint;
 function RotatePoints(Center: TPoint; P: TPointArray; Angle: Double): TPointArray;
+function LineIntersect(LineAP1, LineAP2, LineBP1, LineBP2: TPoint): TPoint;
+function ArcTan2Point(Point: TPoint): Float;
+function ArcTanPoint(Point: TPoint): Float;
 
 implementation
@@ -29 +33 @@
 begin
   Result := P1.X * P2.X + P1.Y * P2.Y;
+end;
+
+function AddPoint(const P1, P2: TPoint): TPoint;
+begin
+  Result.X := P1.X + P2.X;
+  Result.Y := P1.Y + P2.Y;
 end;
 
@@ -88 +98 @@
 end;
 
+function LineIntersect(LineAP1, LineAP2, LineBP1, LineBP2: TPoint): TPoint;
+Var
+  LDetLineA, LDetLineB, LDetDivInv: Double;
+  LDiffLA, LDiffLB: TPoint;
+begin
+  LDetLineA := LineAP1.X * LineAP2.Y - LineAP1.Y * LineAP2.X;
+  LDetLineB := LineBP1.X * LineBP2.Y - LineBP1.Y * LineBP2.X;
+
+  LDiffLA := SubPoint(LineAP1, LineAP2);
+  LDiffLB := SubPoint(LineBP1, LineBP2);
+
+  LDetDivInv := 1 / ((LDiffLA.X * LDiffLB.Y) - (LDiffLA.Y * LDiffLB.X));
+
+  Result.X := Trunc(((LDetLineA * LDiffLB.X) - (LDiffLA.X * LDetLineB)) * LDetDivInv);
+  Result.Y := Trunc(((LDetLineA * LDiffLB.Y) - (LDiffLA.Y * LDetLineB)) * LDetDivInv);
+end;
+
+function ArcTan2Point(Point: TPoint): Float;
+begin
+  Result := ArcTan2(Point.Y, Point.X);
+end;
+
+function ArcTanPoint(Point: TPoint): Float;
+begin
+  Result := ArcTan(Point.Y / Point.X);
+end;
 
 end.