Changeset 122 for trunk

Timestamp:

Oct 26, 2022, 5:25:25 PM (2 years ago)

Author:

chronos

Message:

• Modified: Partial implementation for load/save of current game.

Location:

trunk

Files:

• Forms/UFormMain.pas (modified) (1 diff)
• Languages/BigMetro.cs.mo (modified) ( previous)
• Languages/BigMetro.cs.po (modified) (1 diff)
• Languages/BigMetro.de.po (modified) (1 diff)
• Languages/BigMetro.fr.po (modified) (1 diff)
• Languages/BigMetro.pot (modified) (1 diff)
• UEngine.pas (modified) (19 diffs)
• UTrack.pas (modified) (11 diffs)

trunk/Forms/UFormMain.pas

@@ -119 +119 @@
 procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
 begin
+  //Engine.SaveToFile('Game.bmg');
   Core.PersistentForm1.Save(Self);
 end;

trunk/Languages/BigMetro.cs.po

@@ -251 +251 @@
 msgstr "týden"
 
+#: uengine.swrongfileformat
+msgid "Wrong file format"
+msgstr "Špatný formát souboru"
+
 #: uformmain.sfridayshort
 msgid "FRI"

trunk/Languages/BigMetro.de.po

@@ -253 +253 @@
 msgstr ""
 
+#: uengine.swrongfileformat
+msgid "Wrong file format"
+msgstr ""
+
 #: uformmain.sfridayshort
 msgid "FRI"

trunk/Languages/BigMetro.fr.po

@@ -253 +253 @@
 msgstr ""
 
+#: uengine.swrongfileformat
+msgid "Wrong file format"
+msgstr ""
+
 #: uformmain.sfridayshort
 msgid "FRI"

trunk/Languages/BigMetro.pot

@@ -241 +241 @@
 msgstr ""
 
+#: uengine.swrongfileformat
+msgid "Wrong file format"
+msgstr ""
+
 #: uformmain.sfridayshort
 msgid "FRI"

trunk/UEngine.pas

@@ -10 +10 @@
   URegistry, UMetaCanvas, Generics.Collections, Generics.Defaults, UMenu,
   UControls, UMetroPassenger, UColors, UView, URiver, UTrack, UCity, UGeometric,
-  UPersistentForm, UTranslator;
+  UTranslator, DOM, XMLRead, XMLWrite, UXMLUtils;
 
 type
@@ -37 +37 @@
     function GetMaxPassengers: Integer;
     function IsBestStationForShape(Shape: TStationShape; Check, Current: TLineStation): Boolean;
+    procedure LoadFromXmlNode(Node: TDOMNode);
+    procedure SaveToXmlNode(Node: TDOMNode);
     constructor Create;
     destructor Destroy; override;
@@ -47 +49 @@
     function GetRect: TRect;
     function AddNew: TMapStation;
+    procedure LoadFromXmlNode(Node: TDOMNode);
+    procedure SaveToXmlNode(Node: TDOMNode);
   end;
 
@@ -71 +75 @@
     procedure UpdateEndingLines;
   public
+    Id: Integer;
     Index: Integer;
     Engine: TEngine;
@@ -82 +87 @@
     destructor Destroy; override;
     function IsCircular: Boolean;
+    procedure LoadFromXmlNode(Node: TDOMNode);
+    procedure SaveToXmlNode(Node: TDOMNode);
   end;
 
@@ -89 +96 @@
     Engine: TEngine;
     function AddNew(Color: TColor): TMetroLine;
+    function FindById(Id: Integer): TMetroLine;
     function SearchByColor(Color: TColor): TMetroLine;
+    procedure LoadFromXmlNode(Node: TDOMNode);
+    procedure SaveToXmlNode(Node: TDOMNode);
   end;
 
@@ -121 +131 @@
     procedure SetLine(AValue: TMetroLine);
   public
+    Engine: TEngine;
     Passengers: TMetroPassengers;
     TrackPosition: TTrackPosition;
@@ -127 +138 @@
     TargetStation: TLineStation;
     Carriages: TMetroCarriages;
+    procedure LoadFromXmlNode(Node: TDOMNode);
+    procedure SaveToXmlNode(Node: TDOMNode);
     procedure FindTargetStation;
     function GetTargetStationDistance: Integer;
@@ -140 +153 @@
     function GetUnusedCount: Integer;
     function AddNew: TMetroTrain;
+    procedure LoadFromXmlNode(Node: TDOMNode);
+    procedure SaveToXmlNode(Node: TDOMNode);
   end;
 
@@ -309 +324 @@
     procedure LoadFromRegistry;
     procedure SaveToRegistry;
+    procedure LoadFromFile(FileName: string);
+    procedure SaveToFile(FileName: string);
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -397 +414 @@
   SSuccessReason = 'Your metro transported enough passengers and you have reached your goal for this city.';
   SUnlockedCity = 'City %s is now unlocked.';
+  SWrongFileFormat = 'Wrong file format';
 
   // Cities
@@ -513 +531 @@
   Result := TMetroTrain.Create;
   Add(Result);
+end;
+
+procedure TMetroTrains.LoadFromXmlNode(Node: TDOMNode);
+var
+  Node2: TDOMNode;
+  NewItem: TMetroTrain;
+begin
+  Node2 := Node.FirstChild;
+  while Assigned(Node2) and (Node2.NodeName = 'Train') do begin
+    NewItem := TMetroTrain.Create;
+    NewItem.LoadFromXmlNode(Node2);
+    Add(NewItem);
+    Node2 := Node2.NextSibling;
+  end;
+end;
+
+procedure TMetroTrains.SaveToXmlNode(Node: TDOMNode);
+var
+  I: Integer;
+  NewNode: TDOMNode;
+begin
+  for I := 0 to Count - 1 do begin;
+    NewNode := Node.OwnerDocument.CreateElement('Train');
+    Node.AppendChild(NewNode);
+    Items[I].SaveToXmlNode(NewNode);
+  end;
 end;
 
@@ -568 +612 @@
 end;
 
+procedure TMapStations.LoadFromXmlNode(Node: TDOMNode);
+var
+  Node2: TDOMNode;
+  NewItem: TMapStation;
+begin
+  Node2 := Node.FirstChild;
+  while Assigned(Node2) and (Node2.NodeName = 'Line') do begin
+    NewItem := TMapStation.Create;
+    NewItem.LoadFromXmlNode(Node2);
+    Add(NewItem);
+    Node2 := Node2.NextSibling;
+  end;
+end;
+
+procedure TMapStations.SaveToXmlNode(Node: TDOMNode);
+var
+  I: Integer;
+  NewNode: TDOMNode;
+begin
+  for I := 0 to Count - 1 do begin;
+    NewNode := Node.OwnerDocument.CreateElement('Station');
+    Node.AppendChild(NewNode);
+    Items[I].SaveToXmlNode(NewNode);
+  end;
+end;
+
 { TMetroLines }
 
@@ -579 +649 @@
 end;
 
+function TMetroLines.FindById(Id: Integer): TMetroLine;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Count) and (Items[I].Id <> Id) do Inc(I);
+  if I < Count then Result := Items[I]
+    else Result := nil;
+end;
+
 function TMetroLines.SearchByColor(Color: TColor): TMetroLine;
 var
@@ -587 +667 @@
   if I < Count then Result := Items[I]
     else Result := nil;
+end;
+
+procedure TMetroLines.LoadFromXmlNode(Node: TDOMNode);
+var
+  Node2: TDOMNode;
+  NewItem: TMetroLine;
+begin
+  Node2 := Node.FirstChild;
+  while Assigned(Node2) and (Node2.NodeName = 'Line') do begin
+    NewItem := TMetroLine.Create;
+    NewItem.LoadFromXmlNode(Node2);
+    Add(NewItem);
+    Node2 := Node2.NextSibling;
+  end;
+end;
+
+procedure TMetroLines.SaveToXmlNode(Node: TDOMNode);
+var
+  I: Integer;
+  NewNode: TDOMNode;
+begin
+  for I := 0 to Count - 1 do begin;
+    NewNode := Node.OwnerDocument.CreateElement('Line');
+    Node.AppendChild(NewNode);
+    Items[I].SaveToXmlNode(NewNode);
+  end;
 end;
 
@@ -786 +892 @@
 end;
 
+procedure TMetroLine.LoadFromXmlNode(Node: TDOMNode);
+var
+  Node2: TDOMNode;
+begin
+  Id := ReadInteger(Node, 'Id', Id);
+  Color := TColor(ReadInteger(Node, 'Color', Color));
+
+  Node2 := Node.FindNode('Track');
+  if Assigned(Node2) then
+    Track.LoadFromXmlNode(Node2);
+end;
+
+procedure TMetroLine.SaveToXmlNode(Node: TDOMNode);
+var
+  Node2: TDOMNode;
+begin
+  WriteInteger(Node, 'Id', Id);
+  WriteInteger(Node, 'Color', Color);
+
+  Node2 := Node.OwnerDocument.CreateElement('Track');
+  Node.AppendChild(Node2);
+  Track.SaveToXmlNode(Node2);
+end;
+
 { TMetroTrain }
 
@@ -797 +927 @@
     TargetStation := nil;
   end;
+end;
+
+procedure TMetroTrain.LoadFromXmlNode(Node: TDOMNode);
+begin
+  Line := Engine.Lines.FindById(ReadInteger(Node, 'Line', 0));
+end;
+
+procedure TMetroTrain.SaveToXmlNode(Node: TDOMNode);
+begin
+  if Assigned(Line) then WriteInteger(Node, 'Line', Line.Id)
+    else WriteInteger(Node, 'Line', 0);
 end;
 
@@ -1031 +1172 @@
   Result := (Check.MapStation.ShapeDistance[Shape] <> -1) and
     (Check.MapStation.ShapeDistance[Shape] <= Distance);
+end;
+
+procedure TMapStation.LoadFromXmlNode(Node: TDOMNode);
+begin
+  Position.X := ReadInteger(Node, 'PositionX', Position.X);
+  Position.Y := ReadInteger(Node, 'PositionY', Position.Y);
+  Shape := TStationShape(ReadInteger(Node, 'Shape', Integer(Shape)));
+  IsTerminal := ReadBoolean(Node, 'IsTerminal', IsTerminal);
+end;
+
+procedure TMapStation.SaveToXmlNode(Node: TDOMNode);
+begin
+  WriteInteger(Node, 'PositionX', Position.X);
+  WriteInteger(Node, 'PositionY', Position.Y);
+  WriteInteger(Node, 'Shape', Integer(Shape));
+  WriteBoolean(Node, 'IsTerminal', IsTerminal);
 end;
 
@@ -3369 +3526 @@
   finally
     Free;
+  end;
+end;
+
+procedure TEngine.LoadFromFile(FileName: string);
+var
+  NewNode: TDOMNode;
+  Doc: TXMLDocument;
+  RootNode: TDOMNode;
+begin
+  ReadXMLFile(Doc, FileName);
+  Clear;
+  with Doc do try
+    if Doc.DocumentElement.NodeName <> 'BigMetroGame' then
+      raise Exception.Create(SWrongFileFormat);
+    RootNode := Doc.DocumentElement;
+    with RootNode do begin
+      ServedPassengerCount := ReadInteger(RootNode, 'ServedPassengerCount', ServedPassengerCount);
+
+      NewNode := FindNode('Stations');
+      Stations.LoadFromXmlNode(NewNode);
+
+      NewNode := FindNode('Lines');
+      Lines.LoadFromXmlNode(NewNode);
+
+      NewNode := FindNode('Trains');
+      Trains.LoadFromXmlNode(NewNode);
+    end;
+  finally
+    FreeAndNil(Doc);
+  end;
+end;
+
+procedure TEngine.SaveToFile(FileName: string);
+var
+  NewNode: TDOMNode;
+  Doc: TXMLDocument;
+  RootNode: TDOMNode;
+  I: Integer;
+begin
+  Doc := TXMLDocument.Create;
+  with Doc do try
+    RootNode := CreateElement('BigMetroGame');
+    AppendChild(RootNode);
+    with RootNode do begin
+      WriteInteger(RootNode, 'ServedPassengerCount', ServedPassengerCount);
+
+      for I := 0 to Lines.Count - 1 do
+        Lines[I].Id := I + 1;
+
+      NewNode := OwnerDocument.CreateElement('Stations');
+      AppendChild(NewNode);
+      Stations.SaveToXmlNode(NewNode);
+
+      NewNode := OwnerDocument.CreateElement('Lines');
+      AppendChild(NewNode);
+      Lines.SaveToXmlNode(NewNode);
+
+      NewNode := OwnerDocument.CreateElement('Trains');
+      AppendChild(NewNode);
+      Trains.SaveToXmlNode(NewNode);
+    end;
+    if ExtractFileDir(FileName) <> '' then
+      ForceDirectories(ExtractFileDir(FileName));
+    WriteXMLFile(Doc, FileName);
+  finally
+    FreeAndNil(Doc);
   end;
 end;

trunk/UTrack.pas

@@ -4 +4 @@
 
 uses
-  Classes, SysUtils, Math, Generics.Collections, UGeometric;
+  Classes, SysUtils, Math, Generics.Collections, UGeometric, DOM, XMLRead,
+  XMLWrite, UXMLUtils;
 
 type
@@ -48 +49 @@
     // Move to TTrackLink later
     function GetDistance: Integer;
+
+    procedure LoadFromXmlNode(Node: TDOMNode);
+    procedure SaveToXmlNode(Node: TDOMNode);
     constructor Create;
     destructor Destroy; override;
@@ -57 +61 @@
     Track: TTrack;
     function AddNew: TTrackPoint;
+    procedure LoadFromXmlNode(Node: TDOMNode);
+    procedure SaveToXmlNode(Node: TDOMNode);
   end;
 
@@ -64 +70 @@
     Points: TTrackPoints;
     Shift: TPoint;
+    procedure LoadFromXmlNode(Node: TDOMNode);
+    procedure SaveToXmlNode(Node: TDOMNode);
     constructor Create;
     destructor Destroy; override;
@@ -73 +81 @@
     function SearchPoints(Point1, Point2: TTrackPoint): TTrackLink;
     function AddNew: TTrackLink;
+    procedure LoadFromXmlNode(Node: TDOMNode);
+    procedure SaveToXmlNode(Node: TDOMNode);
   end;
 
@@ -86 +96 @@
     constructor Create;
     destructor Destroy; override;
+    procedure LoadFromXmlNode(Node: TDOMNode);
+    procedure SaveToXmlNode(Node: TDOMNode);
   end;
 
@@ -200 +212 @@
 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 }
 
@@ -206 +244 @@
   Result := TTrackPoint.Create;
   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;
 
@@ -222 +286 @@
   FreeAndNil(Links);
   inherited;
+end;
+
+procedure TTrack.LoadFromXmlNode(Node: TDOMNode);
+begin
+  Points.LoadFromXmlNode(Node);
+  Links.LoadFromXmlNode(Node);
+end;
+
+procedure TTrack.SaveToXmlNode(Node: TDOMNode);
+begin
+  Points.SaveToXmlNode(Node);
+  Links.SaveToXmlNode(Node);
 end;
 
@@ -281 +357 @@
 { TTrackLink }
 
+procedure TTrackLink.LoadFromXmlNode(Node: TDOMNode);
+begin
+
+end;
+
+procedure TTrackLink.SaveToXmlNode(Node: TDOMNode);
+begin
+
+end;
+
 constructor TTrackLink.Create;
 begin
@@ -444 +530 @@
 end;
 
+procedure TTrackPoint.LoadFromXmlNode(Node: TDOMNode);
+begin
+  Position.X := ReadInteger(Node, 'PositionX', Position.X);
+  Position.Y := ReadInteger(Node, 'PositionY', Position.Y);
+end;
+
+procedure TTrackPoint.SaveToXmlNode(Node: TDOMNode);
+begin
+  WriteInteger(Node, 'PositionX', Position.X);
+  WriteInteger(Node, 'PositionY', Position.Y);
+end;
+
 constructor TTrackPoint.Create;
 begin