source: tags/1.1.0/UTrack.pas

unit UTrack;

{$mode delphi}

interface

uses
  Classes, SysUtils, fgl;

type
  TTrack = class;
  TTrackPoints = class;
  TTrackLinks = class;

  { TTrackPoint }

  TTrackPoint = class
    Track: TTrack;
    Position: TPoint;
    NeighPoints: TTrackPoints;
    NeighLinks: TTrackLinks;
    procedure Connect(TrackPoint: TTrackPoint);
    procedure Disconnect(TrackPoint: TTrackPoint);
    constructor Create;
    destructor Destroy; override;
  end;

  { TTrackPoints }

  TTrackPoints = class(TFPGObjectList<TTrackPoint>)
  end;

  { TTrackLink }

  TTrackLink = class
    Track: TTrack;
    Points: TTrackPoints;
    constructor Create;
    destructor Destroy; override;
  end;

  { TTrackLinks }

  TTrackLinks = class(TFPGObjectList<TTrackLink>)
    function SearchPoints(Point1, Point2: TTrackPoint): TTrackLink;
  end;

  { TTrack }

  TTrack = class
  public
    Points: TTrackPoints;
    Links: TTrackLinks;
    function AddNew: TTrackPoint;
    constructor Create;
    destructor Destroy; override;
    procedure RemoveTrackBetween(TP1, TP2: TTrackPoint);
  end;


implementation

{ TTrackLinks }

function TTrackLinks.SearchPoints(Point1, Point2: TTrackPoint): TTrackLink;
var
  I: Integer;
begin
  I := 0;
  while (I < 0) and
  ((Items[I].Points.First <> Point1) or (Items[I].Points.Last <> Point2))
  and ((Items[I].Points.First <> Point2) or (Items[I].Points.Last <> Point1)) do
  Inc(I);
  if I < 0 then Result := Items[I]
    else Result := nil;
end;

{ TTrackLink }

constructor TTrackLink.Create;
begin
  Points := TTrackPoints.Create;
  Points.OwnsObjects := False;
end;

destructor TTrackLink.Destroy;
begin
  Points.Free;
  inherited;
end;

{ TTrackPoints }

function TTrack.AddNew: TTrackPoint;
begin
  Result := TTrackPoint.Create;
  Result.Track := Self;
  Points.Add(Result);
end;

{ TTrackPoint }

procedure TTrackPoint.Connect(TrackPoint: TTrackPoint);
var
  NewLink: TTrackLink;
begin
  if NeighPoints.IndexOf(TrackPoint) = -1 then begin
    NeighPoints.Add(TrackPoint);
    TrackPoint.NeighPoints.Add(Self);
    // Add new link
    NewLink := TTrackLink.Create;
    NewLink.Points.Add(TrackPoint);
    NewLink.Points.Add(Self);
    NeighLinks.Add(NewLink);
    TrackPoint.NeighLinks.Add(NewLink);
    Track.Links.Add(NewLink);
  end;
end;

procedure TTrackPoint.Disconnect(TrackPoint: TTrackPoint);
var
  Index: Integer;
  Link: TTrackLink;
begin
  Index := NeighPoints.IndexOf(TrackPoint);
  if NeighPoints.IndexOf(TrackPoint) <> -1 then begin
    NeighPoints.Delete(Index);
    TrackPoint.NeighPoints.Remove(Self);
    // Remove link
    Link := NeighLinks.SearchPoints(Self, TrackPoint);
    NeighLinks.Remove(Link);
    TrackPoint.NeighLinks.Remove(Link);
    Track.Links.Remove(Link);
  end;
end;

constructor TTrackPoint.Create;
begin
  NeighPoints := TTrackPoints.Create;
  NeighPoints.OwnsObjects := False;
end;

destructor TTrackPoint.Destroy;
var
  I: Integer;
begin
  // Disconnect from all before destruction
  for I := NeighPoints.Count - 1 downto 0 do
    NeighPoints[I].Disconnect(Self);
  if Assigned(Track) then Track.Points.Remove(Self);
  NeighPoints.Free;
  inherited;
end;

{ TTrack }

constructor TTrack.Create;
begin
  Points := TTrackPoints.Create;
end;

destructor TTrack.Destroy;
begin
  Points.Free;
  inherited;
end;

procedure TTrack.RemoveTrackBetween(TP1, TP2: TTrackPoint);
var
  Index1, Index2: Integer;
  Temp: Integer;
  I: Integer;
begin
  Index1 := Points.IndexOf(TP1);
  Index2 := Points.IndexOf(TP2);
  if (Index1 = -1) then
    raise Exception.Create('TrackPoint1 not found');
  if (Index2 = -1) then
    raise Exception.Create('TrackPoint2 not found');
  if Index1 > Index2 then begin
    Temp := Index1;
    Index1 := Index2;
    Index2 := Temp;
  end;
  for I := 1 to Index2 - Index1 - 1 do
    Points.Delete(Index1 + 1);
end;


end.