Changeset 25


Ignore:
Timestamp:
Apr 12, 2015, 12:08:05 AM (9 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:
4 edited

Legend:

Unmodified
Added
Removed

  • trunk/BigMetro.lpi

    r24 r25  
    6969      </Item1>
    7070    </RequiredPackages>
    71     <Units Count="4">
     71    <Units Count="5">
    7272      <Unit0>
    7373        <Filename Value="BigMetro.lpr"/>
    … …  
    9292        <UnitName Value="UGeometric"/>
    9393      </Unit3>
     94      <Unit4>
     95        <Filename Value="UTrack.pas"/>
     96        <IsPartOfProject Value="True"/>
     97        <UnitName Value="UTrack"/>
     98      </Unit4>
    9499    </Units>
    95100  </ProjectOptions>
    … …  
    119124        <StackChecks Value="True"/>
    120125      </Checks>
    121       <VerifyObjMethodCallValidity Value="True"/>
    122126    </CodeGeneration>
    123127    <Linking>

  • trunk/BigMetro.lpr

    r20 r25  
    88  {$ENDIF}{$ENDIF}
    99  Interfaces, // this includes the LCL widgetset
    10   Forms, SysUtils, UFormMain, UEngine, UGeometric
     10  Forms, SysUtils, UFormMain, UEngine, UGeometric, UTrack
    1111  { you can add units after this };
    1212

  • trunk/UEngine.pas

    r24 r25  
    2424  TMapStation = class
    2525  private
     26    procedure ShiftTrackPoints;
     27    procedure SortLines;
    2628  public
    2729    Engine: TEngine;
    … …  
    6365    LineStation: TLineStation;
    6466    Point: TPoint;
     67    PointShift: TPoint;
     68    DesignedPoint: TPoint;
    6569    Pending: Boolean;
    6670    function GetDown: TTrackPoint;
    … …  
    7276  end;
    7377
    74   TTrack = record
     78  TTrack = class
    7579    PointDown: TTrackPoint;
    7680    PointUp: TTrackPoint;
     81    Line: TMetroLine;
     82    Shift: TPoint;
     83  end;
     84
     85  { TTracks }
     86
     87  TTracks = class(TObjectList)
     88    function SearchPointUp(TrackPoint: TTrackPoint; Skip: TTrack): TTrack;
     89    function SearchPointDown(TrackPoint: TTrackPoint; Skip: TTrack): TTrack;
     90  end;
     91
     92  { TTrackPointsAngle }
     93
     94  TTrackPointsAngle = class
     95    Angle: Double;
     96    Tracks: TTracks;
     97    constructor Create;
     98    destructor Destroy; override;
     99  end;
     100
     101  { TTrackPointsAngleGroup }
     102
     103  TTrackPointsAngleGroup = class(TObjectList)
     104    function SearchAngle(Angle: Double): TTrackPointsAngle;
    77105  end;
    78106
    … …  
    83111    procedure UpdateEndingLines;
    84112  public
     113    Index: Integer;
    85114    Engine: TEngine;
    86115    Color: TColor;
    … …  
    189218    procedure TrainMovement;
    190219    function GetUnusedLine: TMetroLine;
     220    procedure ShiftTrackPoints;
    191221  public
    192222    Passengers: TMetroPassengers;
    … …  
    231261  StationMaxDistance = 300;
    232262  MaxWaitingPassengers = 10;
    233   MaxPassengersOveloadTime = 1;
     263  MaxPassengersOveloadTime = 2;
    234264  MetroLineThickness = 13;
    235265  TrackClickDistance = 20;
    … …  
    238268  //TimePerSecond = (60 * OneMinute);
    239269  TimePerSecond = (60 * OneMinute);
     270  NewStationPeriod = 1;
     271  NewShapePeriod = 10;
     272  NewTrainPeriod = 7; // Each week
     273  NewPassengerPeriod = 0.3 * OneSecond;
     274  NewPassengerProbability = 0.002;
    240275
    241276implementation
    … …  
    243278uses
    244279  UGeometric;
     280
     281{ TTracks }
     282
     283function TTracks.SearchPointUp(TrackPoint: TTrackPoint; Skip: TTrack): TTrack;
     284var
     285  I: Integer;
     286begin
     287  I := 0;
     288  while (I < Count) and (TTrack(Items[I]).PointUp <> TrackPoint) and (TTrack(Items[I]) <> Skip) do Inc(I);
     289  if I < Count then Result := TTrack(Items[I])
     290    else Result := nil;
     291end;
     292
     293function TTracks.SearchPointDown(TrackPoint: TTrackPoint; Skip: TTrack): TTrack;
     294var
     295  I: Integer;
     296begin
     297  I := 0;
     298  while (I < Count) and (TTrack(Items[I]).PointDown <> TrackPoint) and (TTrack(Items[I]) <> Skip) do Inc(I);
     299  if I < Count then Result := TTrack(Items[I])
     300    else Result := nil;
     301end;
     302
     303{ TTrackPointsAngleGroup }
     304
     305function TTrackPointsAngleGroup.SearchAngle(Angle: Double): TTrackPointsAngle;
     306var
     307  I: Integer;
     308begin
     309  I := 0;
     310  while (I < Count) and (TTrackPointsAngle(Items[I]).Angle <> Angle) do Inc(I);
     311  if I < Count then Result := TTrackPointsAngle(Items[I])
     312    else Result := nil;
     313end;
     314
     315{ TTrackPointsAngle }
     316
     317constructor TTrackPointsAngle.Create;
     318begin
     319  Tracks := TTracks.Create;
     320  Tracks.OwnsObjects := False;
     321end;
     322
     323destructor TTrackPointsAngle.Destroy;
     324begin
     325  Tracks.Free;
     326  inherited Destroy;
     327end;
    245328
    246329{ TTrackPoint }
    … …  
    357440  Result.Color := LineColors[Count];
    358441  Result.Engine := Engine;
     442  Result.Index := Count;
    359443  Add(Result);
    360444end;
    … …  
    398482      Round(TTrackPoint(TrackPoints[1]).Point.Y - EndStationLength * Sin(Angle)));
    399483    TTrackPoint(TrackPoints.First).Point := EndPoint;
     484    TTrackPoint(TrackPoints.First).DesignedPoint := EndPoint;
    400485
    401486    Angle := arctan2((TTrackPoint(TrackPoints[TrackPoints.Count - 2]).Point.Y - TTrackPoint(TrackPoints[TrackPoints.Count - 3]).Point.Y),
    … …  
    404489      Round(TTrackPoint(TrackPoints[TrackPoints.Count - 2]).Point.Y + EndStationLength * Sin(Angle)));
    405490    TTrackPoint(TrackPoints.Last).Point := EndPoint;
     491    TTrackPoint(TrackPoints.Last).DesignedPoint := EndPoint;
    406492  end;
    407493end;
    … …  
    430516  NewTrackPoint.LineStation := NewLineStation;
    431517  NewTrackPoint.Point := Station.Position;
     518  NewTrackPoint.DesignedPoint := NewTrackPoint.Point;
    432519  NewTrackPoint.Line := TrackPoints.Line;
    433520  Index := 0;
    … …  
    453540  UpdateEndingLines;
    454541  Engine.ComputeShapeDistance;
     542  Engine.ShiftTrackPoints;
    455543end;
    456544
    … …  
    491579  UpdateEndingLines;
    492580  Engine.ComputeShapeDistance;
     581  Engine.ShiftTrackPoints;
    493582end;
    494583
    … …  
    510599  if Abs(Delta.X) > Abs(Delta.Y) then begin
    511600    NewTrackPoint.Point := Point(P2.X - Sign(Delta.X) * Abs(Delta.Y), P1.Y);
     601    NewTrackPoint.DesignedPoint := NewTrackPoint.Point;
    512602  end else begin
    513603    NewTrackPoint.Point := Point(P1.X, P2.Y - Sign(Delta.Y) * Abs(Delta.X));
     604    NewTrackPoint.DesignedPoint := NewTrackPoint.Point;
    514605  end;
    515606  TrackPoints.Insert(Index1 + 1, NewTrackPoint);
    … …  
    650741
    651742{ TMapStation }
     743
     744procedure TMapStation.ShiftTrackPoints;
     745var
     746  Tracks: TTracks;
     747  I: Integer;
     748  J: Integer;
     749  Index: Integer;
     750  TP: TTrackPoint;
     751  LS: TLineStation;
     752  Line: TMetroLine;
     753  Angle: Double;
     754  TPAngleGroup: TTrackPointsAngleGroup;
     755  GroupItem: TTrackPointsAngle;
     756  NewTrack: TTrack;
     757  HAngle: Double;
     758  PairTrack: TTrack;
     759  NewPoint: TPoint;
     760begin
     761  Tracks := TTracks.Create;
     762
     763  // Collect all near track points as track
     764  SortLines;
     765  for I := 0 to Lines.Count - 1 do begin
     766    Line := TMetroLine(Lines[I]);
     767    LS := Line.LineStations.SearchMapStation(Self);
     768    TP := LS.TrackPoint;
     769    Index := Line.TrackPoints.IndexOf(TP);
     770    if Index > 0 then begin
     771      NewTrack := TTrack.Create;
     772      NewTrack.PointDown := TTrackPoint(Line.TrackPoints[Index - 1]);
     773      NewTrack.PointUp := TTrackPoint(Line.TrackPoints[Index]);
     774      Tracks.Add(NewTrack);
     775    end;
     776    if Index < (Line.TrackPoints.Count - 1) then begin
     777      NewTrack := TTrack.Create;
     778      NewTrack.PointDown := TTrackPoint(Line.TrackPoints[Index + 1]);
     779      NewTrack.PointUp := TTrackPoint(Line.TrackPoints[Index]);
     780      Tracks.Add(NewTrack);
     781    end;
     782  end;
     783
     784  // Make groups of tracks with same angle
     785  TPAngleGroup := TTrackPointsAngleGroup.Create;
     786  for I := 0 to Tracks.Count - 1 do begin
     787    Angle := ArcTan2(TTrack(Tracks[I]).PointDown.DesignedPoint.Y - Position.Y,
     788      TTrack(Tracks[I]).PointDown.DesignedPoint.X - Position.X);
     789    GroupItem := TPAngleGroup.SearchAngle(Angle);
     790    if not Assigned(GroupItem) then begin
     791      GroupItem := TTrackPointsAngle.Create;
     792      GroupItem.Angle := Angle;
     793      TPAngleGroup.Add(GroupItem);
     794    end;
     795    GroupItem.Tracks.Add(TTrack(Tracks[I]))
     796  end;
     797
     798  // Shift tracks according number of lines in group
     799  for I := 0 to TPAngleGroup.Count - 1 do
     800  with TTrackPointsAngle(TPAngleGroup[I]) do begin
     801    for J := 0 to Tracks.Count - 1 do
     802      with TTrack(Tracks[J]) do begin
     803        // Get orthogonal angle
     804        HAngle := Angle + Pi / 2;
     805        if HAngle > Pi then HAngle := Hangle - Pi;
     806        Shift.X := Trunc(MetroLineThickness * Cos(HAngle) * (J - (Tracks.Count - 1) / 2));
     807        Shift.Y := Trunc(MetroLineThickness * Sin(HAngle) * (J - (Tracks.Count - 1) / 2));
     808        PointDown.PointShift := Shift;
     809        PointUp.PointShift := Shift;
     810      end;
     811  end;
     812
     813  TPAngleGroup.Free;
     814  Tracks.Free;
     815end;
     816
     817function MapStationCompareLine(Item1, Item2: Pointer): Integer;
     818begin
     819  if TMetroLine(Item1).Index > TMetroLine(Item2).Index then Result := 1
     820  else if TMetroLine(Item1).Index < TMetroLine(Item2).Index then Result := -1
     821  else Result := 0;
     822end;
     823
     824procedure TMapStation.SortLines;
     825begin
     826  Lines.Sort(MapStationCompareLine);
     827end;
    652828
    653829function TMapStation.IsBestStationForShape(Shape: TStationShape;
    … …  
    756932  MinD: Integer;
    757933begin
     934  Result := TTrack.Create;
    758935  Result.PointDown := nil;
    759936  Result.PointUp := nil;
    … …  
    9261103          if DirectionUp then begin
    9271104            if StationIndex = 0 then
    928               ComputeShapeDistanceStation(TLineStation(LineStations[Stations.Count - 2]).MapStation,
     1105              ComputeShapeDistanceStation(TLineStation(LineStations[LineStations.Count - 2]).MapStation,
    9291106              UpdatedShape, Station.ShapeDistance[UpdatedShape] + 1);
    9301107            if StationIndex > 0 then
    … …  
    10631240end;
    10641241
     1242procedure TEngine.ShiftTrackPoints;
     1243var
     1244  I: Integer;
     1245  J: Integer;
     1246  L: Integer;
     1247  Link1, Link2: TPoint;
     1248  NewPoint: TPoint;
     1249begin
     1250  // Reset all trackpoints position shift
     1251  for I := 0 to Lines.Count - 1 do
     1252  with TMetroLine(Lines[I]) do
     1253    for J := 0 to TrackPoints.Count - 1 do
     1254    TTrackPoint(TrackPoints[J]).Point := TTrackPoint(TrackPoints[J]).DesignedPoint;
     1255
     1256  // Calculate new position shifts
     1257  for I := 0 to Stations.Count - 1 do
     1258    TMapStation(Stations[I]).ShiftTrackPoints;
     1259
     1260  // Compute track points from track shift
     1261  for L := 0 to Lines.Count - 1 do
     1262  with TMetroLine(Lines[L]) do begin
     1263    if TrackPoints.Count > 0 then
     1264      TTrackPoint(TrackPoints[0]).Point := AddPoint(TTrackPoint(TrackPoints[0]).DesignedPoint,
     1265        TTrackPoint(TrackPoints[0]).PointShift);
     1266    for I := 1 to TrackPoints.Count - 1 do
     1267    with TTrackPoint(TrackPoints[I]) do begin
     1268      Link1 := SubPoint(AddPoint(TTrackPoint(TrackPoints[I]).DesignedPoint, TTrackPoint(TrackPoints[I]).PointShift),
     1269        AddPoint(TTrackPoint(TrackPoints[I - 1]).DesignedPoint, TTrackPoint(TrackPoints[I - 1]).PointShift));
     1270      if (I + 1) < TrackPoints.Count then
     1271        Link2 := SubPoint(AddPoint(TTrackPoint(TrackPoints[I + 1]).DesignedPoint, TTrackPoint(TrackPoints[I + 1]).PointShift),
     1272          AddPoint(TTrackPoint(TrackPoints[I]).DesignedPoint, TTrackPoint(TrackPoints[I]).PointShift))
     1273        else Link2 := Link1;
     1274
     1275      if ArcTanPoint(Link1) = ArcTanPoint(Link2) then begin
     1276        // Parallel lines
     1277        TTrackPoint(TrackPoints[I]).Point := AddPoint(TTrackPoint(TrackPoints[I]).DesignedPoint,
     1278          TTrackPoint(TrackPoints[I]).PointShift);
     1279      end else begin
     1280        // Intersected lines
     1281        NewPoint := LineIntersect(AddPoint(TTrackPoint(TrackPoints[I - 1]).DesignedPoint, TTrackPoint(TrackPoints[I - 1]).PointShift),
     1282          AddPoint(TTrackPoint(TrackPoints[I]).DesignedPoint, TTrackPoint(TrackPoints[I]).PointShift),
     1283          AddPoint(TTrackPoint(TrackPoints[I]).DesignedPoint, TTrackPoint(TrackPoints[I]).PointShift),
     1284          AddPoint(TTrackPoint(TrackPoints[I + 1]).DesignedPoint, TTrackPoint(TrackPoints[I + 1]).PointShift));
     1285        TTrackPoint(TrackPoints[I]).Point := NewPoint;
     1286      end;
     1287    end;
     1288  end;
     1289
     1290end;
     1291
    10651292procedure TEngine.DrawClock(Canvas: TCanvas);
    10661293var
    … …  
    11301357
    11311358procedure TEngine.Tick;
    1132 const
    1133   NewStationPeriod = 1;
    1134   NewShapePeriod = 10;
    1135   NewTrainPeriod = 7; // Each week
    1136   NewPassengerPeriod = 0.3 * OneSecond;
    1137   NewPassengerProbability = 0.005;
    11381359var
    11391360  Passenger: TMetroPassenger;
    … …  
    12351456          Line.DisconnectStation(CurrentTrackPoint.LineStation);
    12361457        end else
    1237         if Assigned(Line) and ((Line.LineStations.SearchMapStation(FocusedStation) = nil) or
     1458        if Assigned(Line) and ((not Line.IsCircular) or ((TrackStationDown <> nil) and (TrackStationUp <> nil))) and
     1459        ((Line.LineStations.SearchMapStation(FocusedStation) = nil) or
    12381460        ((Line.LineStations.Count > 0) and
    12391461        ((TLineStation(Line.LineStations.First).MapStation = FocusedStation) or
    1240         (TLineStation(Line.LineStations.Last).MapStation = FocusedStation)))) then begin
     1462        (TLineStation(Line.LineStations.Last).MapStation = FocusedStation)) and
     1463        ((TrackStationDown = nil) or (TrackStationUp = nil)) and
     1464        (not Line.IsCircular))) then begin
    12411465          if Assigned(TrackStationDown) then LineStationDown := TrackStationDown.LineStation
    12421466            else LineStationDown := nil;
    … …  
    12991523    // Line selection
    13001524    Track := GetTrackOnPos(Position);
    1301     if Assigned(Track.PointDown) and Assigned(Track.PointUp) then begin
     1525    if Assigned(Track) and Assigned(Track.PointDown) and Assigned(Track.PointUp) then begin
    13021526      SelectedLine := Track.PointDown.Line;
    13031527
    … …  
    13171541          else TrackStationUp := nil;
    13181542      end;
    1319 
     1543      Track.Free;
    13201544      Exit;
    13211545    end;

  • trunk/UGeometric.pas

    r13 r25  
    1313function Distance(P1, P2: TPoint): Integer;
    1414function Dot(const P1, P2: TPoint): Double;
     15function AddPoint(const P1, P2: TPoint): TPoint;
    1516function SubPoint(const P1, P2: TPoint): TPoint;
    1617function PointToLineDistance(const P, V, W: TPoint): Integer;
    … …  
    1819function RotatePoint(Center, P: TPoint; Angle: Double): TPoint;
    1920function RotatePoints(Center: TPoint; P: TPointArray; Angle: Double): TPointArray;
     21function LineIntersect(LineAP1, LineAP2, LineBP1, LineBP2: TPoint): TPoint;
     22function ArcTan2Point(Point: TPoint): Float;
     23function ArcTanPoint(Point: TPoint): Float;
    2024
    2125implementation
    … …  
    2933begin
    3034  Result := P1.X * P2.X + P1.Y * P2.Y;
     35end;
     36
     37function AddPoint(const P1, P2: TPoint): TPoint;
     38begin
     39  Result.X := P1.X + P2.X;
     40  Result.Y := P1.Y + P2.Y;
    3141end;
    3242
    … …  
    8898end;
    8999
     100function LineIntersect(LineAP1, LineAP2, LineBP1, LineBP2: TPoint): TPoint;
     101Var
     102  LDetLineA, LDetLineB, LDetDivInv: Double;
     103  LDiffLA, LDiffLB: TPoint;
     104begin
     105  LDetLineA := LineAP1.X * LineAP2.Y - LineAP1.Y * LineAP2.X;
     106  LDetLineB := LineBP1.X * LineBP2.Y - LineBP1.Y * LineBP2.X;
     107
     108  LDiffLA := SubPoint(LineAP1, LineAP2);
     109  LDiffLB := SubPoint(LineBP1, LineBP2);
     110
     111  LDetDivInv := 1 / ((LDiffLA.X * LDiffLB.Y) - (LDiffLA.Y * LDiffLB.X));
     112
     113  Result.X := Trunc(((LDetLineA * LDiffLB.X) - (LDiffLA.X * LDetLineB)) * LDetDivInv);
     114  Result.Y := Trunc(((LDetLineA * LDiffLB.Y) - (LDiffLA.Y * LDetLineB)) * LDetDivInv);
     115end;
     116
     117function ArcTan2Point(Point: TPoint): Float;
     118begin
     119  Result := ArcTan2(Point.Y, Point.X);
     120end;
     121
     122function ArcTanPoint(Point: TPoint): Float;
     123begin
     124  Result := ArcTan(Point.Y / Point.X);
     125end;
    90126
    91127end.
Note: See TracChangeset for help on using the changeset viewer.