Multiple fixes in mod processing.

* fixed loading submod when both child and parent are unpacked
* implemented json config merging by same name

Author: alexvins

filesystem.pas

@@ -184,7 +184,6 @@   TModConfig = class (TBaseConfig)
 
     property Disabled:Boolean read FDisabled write FDisabled;
     property ID: TModId read FID write SetID;
-    //realtive (to mod root) mod path
     property Path: String read FPath write SetPath;
     procedure MayBeSetDefaultFSConfig;
 
@@ -294,9 +293,12 @@   TFSManager = class (TComponent, IResourceLoader)
 
     procedure OnFileFound(FileIterator: TFileIterator);
     procedure OnDirectoryFound(FileIterator: TFileIterator);
+    procedure OnTopLevelDirectoryFound(FileIterator: TFileIterator);
+
     procedure OnArchiveFound(FileIterator: TFileIterator);
 
     procedure ScanDir(const RelDir: string; ARootPath: TStrings);
+    procedure ScanContentDir(const RelDir: string; ARootPath: TStrings);
 
     procedure ScanMap(MapPath: string; ARootPath: TStrings);
 
@@ -336,6 +338,7 @@   TFSManager = class (TComponent, IResourceLoader)
     procedure Load(AProgress: IProgressCallback);
 
     procedure LoadResource(AResource: IResource; AResType: TResourceType; AName: string);
+    procedure LoadResourceCombined(AResource: IResource; AResType: TResourceType; AName: string);
 
     function TryLoadResource(AResource: IResource; AResType: TResourceType; AName: string): boolean;
 
@@ -349,6 +352,10 @@   TFSManager = class (TComponent, IResourceLoader)
     property DataPath: TStringListUTF8 read FDataPath;
   end;
 
+  EResourceNotFound = class (Exception)
+
+  end;
+
 
 implementation
 uses
@@ -602,7 +609,7 @@ procedure TModConfig.MayBeSetDefaultFSConfig;
     cur_path := Filesystem.Add;
     cur_path.Identifier := '';
 
-    item :=  cur_path.Items.Add;
+    item := cur_path.Items.Add;
     item.&Type := 'dir';
     item.Path := MOD_ROOT;
   end;
@@ -734,7 +741,7 @@ procedure TFSManager.ProcessModConfig(AParentModID: AnsiString;
   try
     mod_config := TModConfig.Create;
     mod_config.ID := AModID;
-    mod_config.Path := ExtractFileNameOnly(ExcludeTrailingBackslash(ExtractFilePath(mod_path)));
+    mod_config.Path := ExtractFilePath(mod_path);
     destreamer.JSONStreamToObject(stm, mod_config,'');
     mod_config.MayBeSetDefaultFSConfig;
 
@@ -775,7 +782,30 @@ procedure TFSManager.OnDirectoryFound(FileIterator: TFileIterator);
   srch.OnDirectoryFound:=@OnDirectoryFound;
   try
     p := IncludeTrailingPathDelimiter(FileIterator.FileName);
-    srch.Search(p);
+    srch.Search(p, '', False);
+  finally
+    srch.Free;
+  end;
+end;
+
+procedure TFSManager.OnTopLevelDirectoryFound(FileIterator: TFileIterator);
+var
+  srch: TFileSearcher;
+  p, tld_name: string;
+begin
+  srch := TFileSearcher.Create;
+  srch.OnFileFound := @OnFileFound;
+  srch.OnDirectoryFound:=@OnDirectoryFound;
+  try
+    p := IncludeTrailingPathDelimiter(FileIterator.FileName);
+
+    tld_name := ExtractFileNameOnly(ExcludeTrailingPathDelimiter(FileIterator.FileName));
+
+    if UpperCase(tld_name) <> 'MODS' then
+    begin
+      DebugLn('TLD :', p);
+      srch.Search(p, '', False);
+    end;
   finally
     srch.Free;
   end;
@@ -993,10 +1023,62 @@ procedure TFSManager.LoadResource(AResource: IResource; AResType: TResourceType;
 begin
   if not TryLoadResource(AResource, AResType, AName) then
   begin
-    raise Exception.Create('Resource not found: '+AName);
+    raise EResourceNotFound.Create('Resource not found: '+AName);
   end;
 end;
 
+procedure TFSManager.LoadResourceCombined(AResource: IResource;
+  AResType: TResourceType; AName: string);
+var
+  it : TResIDToLocationMap.TIterator;
+
+  last_location: TResLocation;
+  order: Integer;
+begin
+  AName := NormalizeResourceName(AName);
+  it := SelectResource(AResType, AName);
+  if not Assigned(it) then
+  begin
+    raise EResourceNotFound.Create('Resource not found: '+AName);
+  end;
+
+  last_location := it.Value;
+  order := it.Key.ModOrder;
+
+  case last_location.lt of
+    TLocationType.InLod: last_location.lod.LoadResource(AResource,last_location.FileHeader);
+    TLocationType.InFile: LoadFileResource(AResource,last_location.path);
+    TLocationType.InArchive: LoadArchiveResource(AResource, last_location.archive, last_location.entry);
+  end;
+
+  while it.Next do
+  begin
+    if (it.Key.VFSPath = AName) and (it.Key.Typ = AResType) then
+    begin
+      last_location := it.Value;
+
+      if not (order < it.Key.ModOrder) then
+      begin
+        raise Exception.CreateFmt('[Internal error] wrong order %d for %s', [it.Key.ModOrder, AName]);
+      end;
+
+      case last_location.lt of
+        TLocationType.InLod: last_location.lod.LoadResource(AResource,last_location.FileHeader) ;
+        TLocationType.InFile: LoadFileResource(AResource,last_location.path);
+        TLocationType.InArchive: LoadArchiveResource(AResource, last_location.archive, last_location.entry);
+      end;
+
+      order := it.Key.ModOrder;
+    end
+    else
+    begin
+      Break;
+    end;
+  end;
+
+  FreeAndNil(it);
+end;
+
 function TFSManager.TryLoadResource(AResource: IResource; AResType: TResourceType; AName: string): boolean;
 var
   it : TResIDToLocationMap.TIterator;
@@ -1132,15 +1214,9 @@ procedure TFSManager.ScanMods;
         FCurrentLoadOrder:=load_order;
         mod_paths.Clear;
 
-        for APath in mod_roots do
-        begin
-          mod_paths.Append( IncludeTrailingPathDelimiter(APath) + AMod.Path);
-        end;
+        mod_paths.Append(AMod.Path);
 
-        for APath in mod_roots do
-        begin
-          ProcessFSConfig(FModMap.Data[mod_idx].Filesystem,mod_paths);
-        end;
+        ProcessFSConfig(FModMap.Data[mod_idx].Filesystem,mod_paths);
       end;
     end;
 
@@ -1297,12 +1373,14 @@ procedure TFSManager.OnFileFound(FileIterator: TFileIterator);
   file_name := ExtractFileNameOnly(FileIterator.FileName);
 
   res_id.Typ := res_typ;
-  res_id.VFSPath := SetDirSeparators(UpperCase(FCurrentVFSPath+ExtractFilePath(rel_path)+file_name));//
+  res_id.VFSPath := SetDirSeparators(UpperCase(FCurrentVFSPath+ExtractFilePath(rel_path)+file_name));
   res_id.ModOrder:=FCurrentLoadOrder;
 
   res_loc.SetFile(FileIterator.FileName);
 
   FResMap.Insert(res_id,res_loc);
+
+  DebugLn(rel_path, ' => ' , res_id.VFSPath, ' => ', FileIterator.FileName);
 end;
 
 procedure TFSManager.OnLodItemFound(Alod: TLod; constref AItem: TLodItem);
@@ -1327,7 +1405,7 @@ procedure TFSManager.OnLodItemFound(Alod: TLod; constref AItem: TLodItem);
     exit;
 
   res_id.Typ := res_typ;
-  res_id.VFSPath := FCurrentVFSPath+file_name;//
+  res_id.VFSPath := FCurrentVFSPath+file_name;
   res_id.ModOrder:=FCurrentLoadOrder;
 
   res_loc.SetLod(Alod, AItem);
@@ -1395,12 +1473,13 @@ procedure TFSManager.ProcessConfigItem(APath: TFilesystemConfigPath; ARootPath:
         ScanLod(rel_path,ARootPath);
       end;
       'dir':begin
-        if item.Path = MOD_ROOT then
+        if UpperCase(rel_path) = UpperCase(MOD_ROOT) then
         begin
           ScanArchive(item, rel_path, ARootPath);
-          ScanDir(rel_path,ARootPath);
+          ScanContentDir(rel_path,ARootPath);
         end
-        else begin
+        else if UpperCase(item.Path) <> 'MODS' then
+        begin
           ScanDir(rel_path,ARootPath);
         end;
       end;
@@ -1431,12 +1510,35 @@ procedure TFSManager.ScanDir(const RelDir: string; ARootPath: TStrings);
   begin
     srch := TFileSearcher.Create;
     srch.OnFileFound := @OnFileFound;
-    //srch.OnDirectoryFound:=@OnDirectoryFound;
+    srch.OnDirectoryFound:=@OnDirectoryFound;
+    try
+      FCurrentRelPath := RelDir;
+      FCurrentRootPath := root_path;
+      p := IncludeTrailingPathDelimiter(MakeFullPath(root_path,RelDir));
+      srch.Search(p, '', False);
+    finally
+      srch.Free;
+    end;
+  end;
+end;
+
+procedure TFSManager.ScanContentDir(const RelDir: string; ARootPath: TStrings);
+var
+  srch: TFileSearcher;
+  p: string;
+  root_path: String;
+begin
+  for root_path in ARootPath do
+  begin
+    DebugLn('ScanContentDir: ', root_path, ' ', RelDir);
+    srch := TFileSearcher.Create;
+    //srch.OnFileFound := @OnFileFound;
+    srch.OnDirectoryFound:=@OnTopLevelDirectoryFound;
     try
       FCurrentRelPath := RelDir;
       FCurrentRootPath := root_path;
       p := IncludeTrailingPathDelimiter(MakeFullPath(root_path,RelDir));
-      srch.Search(p);
+      srch.Search(p, '', False);
     finally
       srch.Free;
     end;

filesystem_base.pas

@@ -45,6 +45,8 @@ interface
     *)
     procedure LoadResource(AResource: IResource; AResType: TResourceType; AName: string);
 
+    procedure LoadResourceCombined(AResource: IResource; AResType: TResourceType; AName: string);
+
     function ExistsResource(AResType: TResourceType; AName: string): boolean;
 
     function TryLoadResource(AResource: IResource; AResType: TResourceType; AName: string):boolean;
@@ -67,8 +69,8 @@   TBaseResource = class abstract (TObject, IResource)
 
     procedure LoadFromStream(AFileName: AnsiString; AStream: TStream); virtual; abstract;
 
-    procedure Load(ALoader: IResourceLoader);
-    function TryLoad(ALoader: IResourceLoader): Boolean;
+    procedure Load(ALoader: IResourceLoader); virtual;
+    function TryLoad(ALoader: IResourceLoader): Boolean; virtual;
   end;
 
   { TFSConsumer }

lists_manager.pas

@@ -2393,9 +2393,9 @@ procedure TListsManager.LoadResourceTypes;
 
 procedure TListsManager.LoadTextDataConfig;
 var
-  config: TJsonResource;
+  config: TJsonCombinedResource;
 begin
-  config := TJsonResource.Create(TEXT_DATA_CONFIG);
+  config := TJsonCombinedResource.Create(TEXT_DATA_CONFIG);
   try
     config.Load(ResourceLoader);
     config.DestreamTo(FTextDataConfig, 'textData');

vcmi_json.pas

@@ -139,6 +139,16 @@   TJsonResource = class (TBaseResource, IResource)
     procedure DestreamTo(AObject: TObject; AFieldName: string = '');
   end;
 
+
+  { TJsonCombinedResource }
+
+  TJsonCombinedResource = class (TJsonResource)
+  public
+    procedure LoadFromStream(AFileName: AnsiString; AStream: TStream); override;
+    procedure Load(ALoader: IResourceLoader); override;
+    function TryLoad(ALoader: IResourceLoader): Boolean; override;
+  end;
+
   TJsonObjectList = specialize TFPGObjectList<TJSONObject>;
 
 
@@ -357,6 +367,40 @@ function LoadHeroSex(ASrc: TJSONData): THeroSex;
 
 end;
 
+{ TJsonCombinedResource }
+
+procedure TJsonCombinedResource.LoadFromStream(AFileName: AnsiString;  AStream: TStream);
+var
+  current: TJSONObject;
+begin
+  if not Assigned(FRoot) then
+  begin
+    FRoot := CreateJSONObject([]);
+  end;
+
+  current := destreamer.JSONStreamToJSONObject(AStream,'');
+  try
+    MergeJson(current, Root);
+  finally
+    current.Free;
+  end;
+end;
+
+procedure TJsonCombinedResource.Load(ALoader: IResourceLoader);
+begin
+  ALoader.LoadResourceCombined(Self, Typ, Path);
+end;
+
+function TJsonCombinedResource.TryLoad(ALoader: IResourceLoader): Boolean;
+begin
+  Result:= ALoader.ExistsResource(Self.Typ, Self.Path);
+
+  if Result then
+  begin
+    Load(ALoader);
+  end;
+end;
+
 { TVCMIJsonArray }
 
 function TVCMIJsonArray.Clone: TJSONData;

vcmieditor.lpi

@@ -815,7 +815,7 @@
     </Other>
   </CompilerOptions>
   <Debugging>
-    <Exceptions Count="3">
+    <Exceptions Count="4">
       <Item1>
         <Name Value="EAbort"/>
       </Item1>
@@ -825,6 +825,9 @@
       <Item3>
         <Name Value="EFOpenError"/>
       </Item3>
+      <Item4>
+        <Name Value="EResourceNotFound"/>
+      </Item4>
     </Exceptions>
   </Debugging>
 </CONFIG>