Changeset 128 for trunk/UTrack.pas

Timestamp:

May 1, 2023, 11:21:30 AM (12 months ago)

Author:

chronos

Message:

• Added: Ability to save and load a game.

File:

• trunk/UTrack.pas (modified) (14 diffs)

trunk/UTrack.pas

@@ -5 +5 @@
 uses
   Classes, SysUtils, Math, Generics.Collections, UGeometric, DOM, XMLRead,
-  XMLWrite, UXMLUtils;
+  XMLWrite, UXMLUtils, UItems;
 
 type
@@ -22 +22 @@
     function GetVector: TVector;
     procedure Move(Distance: Double);
+    procedure LoadFromXmlNode(Node: TDOMNode; Points: TTrackPoints);
+    procedure SaveToXmlNode(Node: TDOMNode);
   end;
 
   { TTrackPoint }
 
-  TTrackPoint = class
+  TTrackPoint = class(TItem)
     OwnerPoint: TObject;
     Position: TPoint;
-    //PositionShift: TPoint;
     PositionDesigned: TPoint;
     Pending: Boolean;
@@ -50 +51 @@
     function GetDistance: Integer;
 
-    procedure LoadFromXmlNode(Node: TDOMNode);
-    procedure SaveToXmlNode(Node: TDOMNode);
+    class function GetClassSysName: string; override;
+    procedure LoadFromXmlNode(Node: TDOMNode); override;
+    procedure SaveToXmlNode(Node: TDOMNode); override;
     constructor Create;
     destructor Destroy; override;
@@ -58 +60 @@
   { TTrackPoints }
 
-  TTrackPoints = class(TObjectList<TTrackPoint>)
+  TTrackPoints = class(TItems<TTrackPoint>)
     Track: TTrack;
-    function AddNew: TTrackPoint;
-    procedure LoadFromXmlNode(Node: TDOMNode);
-    procedure SaveToXmlNode(Node: TDOMNode);
+    class function GetClassSysName: string; override;
+    function CreateItem: TTrackPoint; override;
   end;
 
   { TTrackLink }
 
-  TTrackLink = class
+  TTrackLink = class(TItem)
     Points: TTrackPoints;
     Shift: TPoint;
-    procedure LoadFromXmlNode(Node: TDOMNode);
-    procedure SaveToXmlNode(Node: TDOMNode);
+    class function GetClassSysName: string; override;
+    procedure LoadFromXmlNode(Node: TDOMNode); override;
+    procedure SaveToXmlNode(Node: TDOMNode); override;
     constructor Create;
     destructor Destroy; override;
@@ -78 +80 @@
   { TTrackLinks }
 
-  TTrackLinks = class(TObjectList<TTrackLink>)
+  TTrackLinks = class(TItems<TTrackLink>)
+    class function GetClassSysName: string; override;
     function SearchPoints(Point1, Point2: TTrackPoint): TTrackLink;
-    function AddNew: TTrackLink;
-    procedure LoadFromXmlNode(Node: TDOMNode);
-    procedure SaveToXmlNode(Node: TDOMNode);
   end;
 
   { TTrack }
 
-  TTrack = class
+  TTrack = class(TItem)
     Points: TTrackPoints;
     Links: TTrackLinks;
@@ -96 +96 @@
     constructor Create;
     destructor Destroy; override;
-    procedure LoadFromXmlNode(Node: TDOMNode);
-    procedure SaveToXmlNode(Node: TDOMNode);
+    class function GetClassSysName: string; override;
+    procedure LoadFromXmlNode(Node: TDOMNode); override;
+    procedure SaveToXmlNode(Node: TDOMNode); override;
   end;
 
@@ -192 +193 @@
 end;
 
+procedure TTrackPosition.LoadFromXmlNode(Node: TDOMNode; Points: TTrackPoints);
+begin
+  RelPos := ReadDouble(Node, 'RelPos', RelPos);
+  BaseTrackPoint := Points.FindById(ReadInteger(Node, 'BaseTrackPoint', 0));
+end;
+
+procedure TTrackPosition.SaveToXmlNode(Node: TDOMNode);
+begin
+  WriteDouble(Node, 'RelPos', RelPos);
+  if Assigned(BaseTrackPoint) then
+    WriteInteger(Node, 'BaseTrackPoint', BaseTrackPoint.Id)
+    else WriteInteger(Node, 'BaseTrackPoint', 0)
+end;
+
 { TTrackLinks }
+
+class function TTrackLinks.GetClassSysName: string;
+begin
+  Result := 'Links';
+end;
 
 function TTrackLinks.SearchPoints(Point1, Point2: TTrackPoint): TTrackLink;
@@ -207 +227 @@
 end;
 
-function TTrackLinks.AddNew: TTrackLink;
-begin
-  Result := TTrackLink.Create;
-end;
-
-procedure TTrackLinks.LoadFromXmlNode(Node: TDOMNode);
-var
-  Node2: TDOMNode;
-  NewItem: TTrackLink;
-begin
-  Node2 := Node.FirstChild;
-  while Assigned(Node2) and (Node2.NodeName = 'Link') do begin
-    NewItem := TTrackLink.Create;
-    NewItem.LoadFromXmlNode(Node2);
-    Add(NewItem);
-    Node2 := Node2.NextSibling;
-  end;
-end;
-
-procedure TTrackLinks.SaveToXmlNode(Node: TDOMNode);
-var
-  I: Integer;
-  Node2: TDOMNode;
-begin
-  for I := 0 to Count - 1 do begin;
-    Node2 := Node.OwnerDocument.CreateElement('Link');
-    Node.AppendChild(Node2);
-    Items[I].SaveToXmlNode(Node2);
-  end;
-end;
-
 { TTrackPoints }
 
-function TTrackPoints.AddNew: TTrackPoint;
-begin
-  Result := TTrackPoint.Create;
+class function TTrackPoints.GetClassSysName: string;
+begin
+  Result := 'Points';
+end;
+
+function TTrackPoints.CreateItem: TTrackPoint;
+begin
+  Result := inherited;
   Result.Track := Track;
-end;
-
-procedure TTrackPoints.LoadFromXmlNode(Node: TDOMNode);
-var
-  Node2: TDOMNode;
-  NewItem: TTrackPoint;
-begin
-  Node2 := Node.FirstChild;
-  while Assigned(Node2) and (Node2.NodeName = 'Point') do begin
-    NewItem := TTrackPoint.Create;
-    NewItem.LoadFromXmlNode(Node2);
-    Add(NewItem);
-    Node2 := Node2.NextSibling;
-  end;
-end;
-
-procedure TTrackPoints.SaveToXmlNode(Node: TDOMNode);
-var
-  I: Integer;
-  Node2: TDOMNode;
-begin
-  for I := 0 to Count - 1 do begin;
-    Node2 := Node.OwnerDocument.CreateElement('Point');
-    Node.AppendChild(Node2);
-    Items[I].SaveToXmlNode(Node2);
-  end;
 end;
 
@@ -288 +256 @@
 end;
 
+class function TTrack.GetClassSysName: string;
+begin
+  Result := 'Track';
+end;
+
 procedure TTrack.LoadFromXmlNode(Node: TDOMNode);
-begin
-  Points.LoadFromXmlNode(Node);
-  Links.LoadFromXmlNode(Node);
+var
+  NewNode: TDOMNode;
+begin
+  NewNode := Node.FindNode(DOMString(TTrackPoints.GetClassSysName));
+  if Assigned(NewNode) then
+    Points.LoadFromXmlNode(NewNode);
+
+  NewNode := Node.FindNode(DOMString(TTrackLinks.GetClassSysName));
+  if Assigned(NewNode) then
+    Links.LoadFromXmlNode(NewNode);
 end;
 
 procedure TTrack.SaveToXmlNode(Node: TDOMNode);
-begin
-  Points.SaveToXmlNode(Node);
-  Links.SaveToXmlNode(Node);
+var
+  NewNode: TDOMNode;
+begin
+  Points.RebuildItemsId;
+  Links.RebuildItemsId;
+
+  NewNode := Node.OwnerDocument.CreateElement(DOMString(TTrackPoints.GetClassSysName));
+  Node.AppendChild(NewNode);
+  Points.SaveToXmlNode(NewNode);
+
+  NewNode := Node.OwnerDocument.CreateElement(DOMString(TTrackLinks.GetClassSysName));
+  Node.AppendChild(NewNode);
+  Links.SaveToXmlNode(NewNode);
 end;
 
@@ -322 +312 @@
   P1 := Points[Index1].PositionDesigned;
   P2 := Points[Index2].PositionDesigned;
-  NewTrackPoint := Points.AddNew;
+  NewTrackPoint := Points.CreateItem;
   Delta := Point(P2.X - P1.X, P2.Y - P1.Y);
   if Abs(Delta.X) > Abs(Delta.Y) then begin
@@ -357 +347 @@
 { TTrackLink }
 
+class function TTrackLink.GetClassSysName: string;
+begin
+  Result := 'Link';
+end;
+
 procedure TTrackLink.LoadFromXmlNode(Node: TDOMNode);
 begin
-
+  inherited;
 end;
 
 procedure TTrackLink.SaveToXmlNode(Node: TDOMNode);
 begin
-
+  inherited;
 end;
 
@@ -416 +411 @@
 
     // Add new link to both self and connected track point
-    NewLink := Track.Links.AddNew;
+    NewLink := Track.Links.CreateItem;
     NewLink.Points.Add(TrackPoint);
     NewLink.Points.Add(Self);
@@ -530 +525 @@
 end;
 
+class function TTrackPoint.GetClassSysName: string;
+begin
+  Result := 'Point';
+end;
+
 procedure TTrackPoint.LoadFromXmlNode(Node: TDOMNode);
 begin
+  inherited;
   Position.X := ReadInteger(Node, 'PositionX', Position.X);
   Position.Y := ReadInteger(Node, 'PositionY', Position.Y);
+  PositionDesigned.X := ReadInteger(Node, 'PositionDesignedX', PositionDesigned.X);
+  PositionDesigned.Y := ReadInteger(Node, 'PositionDesignedY', PositionDesigned.Y);
 end;
 
 procedure TTrackPoint.SaveToXmlNode(Node: TDOMNode);
 begin
+  inherited;
   WriteInteger(Node, 'PositionX', Position.X);
   WriteInteger(Node, 'PositionY', Position.Y);
+  WriteInteger(Node, 'PositionDesignedX', PositionDesigned.X);
+  WriteInteger(Node, 'PositionDesignedY', PositionDesigned.Y);
 end;
 
@@ -554 +560 @@
   FreeAndNil(NeighLinks);
   FreeAndNil(NeighPoints);
+  Track := nil;
+  OwnerPoint := nil;
   inherited;
 end;