Image transferral now works

4 files changed, 85 insertions, 17 deletions

diff --git a/src/datatypes.ads b/src/datatypes.ads
index 164e7c9..7229f2d 100644
--- a/src/datatypes.ads
+++ b/src/datatypes.ads
@@ -72,14 +72,17 @@ package Datatypes is
     subtype Note_Vector is Note_Vectors.Vector;
 
 
-    type Media_ID is new SU.Unbounded_String;
     type Media_Name is new SU.Unbounded_String;
+    type Media_ID is new SU.Unbounded_String;
 
     package Media_Maps is new Ada.Containers.Ordered_Maps
-       (Key_Type     => Media_ID,
-        Element_Type => Media_Name);
+       (Key_Type     => Media_Name,
+        Element_Type => Media_ID);
 
-    subtype Media_Map is Media_Maps.Map;
+    type Media_Collection is record
+        Filename : SU.Unbounded_String;
+        Map      : Media_Maps.Map;
+    end record;
 
 
 end Datatypes;
diff --git a/src/deck_convert.adb b/src/deck_convert.adb
index 75a35d0..7037944 100644
--- a/src/deck_convert.adb
+++ b/src/deck_convert.adb
@@ -105,7 +105,7 @@ procedure Deck_Convert is
     Deck   : Deck_IO.Deck_Handle;
     Models : Model_Map;
     Notes  : Note_Vector;
-    Media  : Media_Map;
+    Media  : Media_Collection;
 
 
 begin
@@ -270,7 +270,7 @@ begin
             if Verbose then
                 Put (Standard_Error, "Reading media...");
             end if;
-            Deck_IO.Read_Media_Map (-Input_Name, Media);
+            Deck_IO.Read_Media_Collection (-Input_Name, Media);
             if Verbose then
                 Put_Line (Standard_Error, " Done");
                 Put (Standard_Error, "Writing output to Fresh Memory Dictionary...");
diff --git a/src/deck_io.adb b/src/deck_io.adb
index 4c87164..2e2d1b4 100644
--- a/src/deck_io.adb
+++ b/src/deck_io.adb
@@ -105,9 +105,9 @@ package body Deck_IO is
 
 
 
-    procedure Read_Media_Map
+    procedure Read_Media_Collection
            (Filename  : in     String;
-            Media     :    out Media_Map)
+            Media     :    out Media_Collection)
     is
         Temp : String := Generate_Temp_Name;
 
@@ -121,7 +121,7 @@ package body Deck_IO is
         is
             Val : SU.Unbounded_String := JS.Get (Value);
         begin
-            Media.Insert (Media_ID (+Name), Media_Name (Val));
+            Media.Map.Insert (Media_Name (Val), Media_ID (+Name));
         end Map_Iteration;
     begin
         UnZip.Extract (Filename, "media", Temp);
@@ -135,7 +135,8 @@ package body Deck_IO is
 
         JSON_Data := JS.Read (-Raw_Data);
         JS.Map_JSON_Object (JSON_Data, Map_Iteration'Access);
-    end Read_Media_Map;
+        Media.Filename := +Filename;
+    end Read_Media_Collection;
 
 
 
@@ -349,6 +350,63 @@ package body Deck_IO is
     end Compose_Name;
 
 
+    function Compose_Dir
+           (Directory : in String;
+            Basename  : in String;
+            Model_Num : in Positive)
+        return SU.Unbounded_String
+    is
+        Result : SU.Unbounded_String := +FD.Compose (Directory, Basename);
+    begin
+        if Model_Num > 1 then
+            SU.Append (Result, "-" & Strfix.Trim (Integer'Image (Model_Num), Ada.Strings.Left));
+        end if;
+        return Result;
+    end Compose_Dir;
+
+
+    procedure Extract_Images
+           (Texts  : in out Datatypes.Field_Vector;
+            Outdir : in     SU.Unbounded_String;
+            Media  : in     Media_Collection)
+    is
+        use type Pat.Match_Location;
+        Matches : Pat.Match_Array (0 .. 2);
+        Regexp : Pat.Pattern_Matcher := Pat.Compile
+            --  Absolutely disgusting regexes
+           ("<img\s+(?:alt=""[^""]*""\s+|alt=\S*\s+)?src=(?:""([^""]*)""|(\S*)\s)\s*/>",
+            Pat.Single_Line);
+        Marker : Positive;
+        Location : Pat.Match_Location;
+        Match_Name : SU.Unbounded_String;
+    begin
+        for Text of Texts loop
+            Marker := 1;
+            loop
+                Pat.Match (Regexp, -(SU.Unbounded_String (Text)), Matches, Marker);
+                exit when Matches (0) = Pat.No_Match;
+                Location := (if Matches (1) = Pat.No_Match then Matches (2) else Matches (1));
+                Match_Name := SU.Unbounded_Slice
+                   (SU.Unbounded_String (Text), Location.First, Location.Last);
+                if Media.Map.Contains (Media_Name (Match_Name)) then
+                    if not FD.Exists (-Outdir) then
+                        FD.Create_Directory (-Outdir);
+                    end if;
+                    if not FD.Exists (FD.Compose (-Outdir, -Match_Name)) then
+                        UnZip.Extract
+                           (-Media.Filename,
+                            SU.To_String (SU.Unbounded_String
+                               (Media.Map.Element (Media_Name (Match_Name)))),
+                            FD.Compose (-Outdir, -Match_Name));
+                    end if;
+                    SU.Insert (SU.Unbounded_String (Text), Location.First, "%%/");
+                end if;
+                Marker := Matches (0).Last + 1;
+            end loop;
+        end loop;
+    end Extract_Images;
+
+
 
 
     procedure Write_CSV
@@ -395,23 +453,28 @@ package body Deck_IO is
             Basename  : in String;
             Models    : in Model_Map;
             Notes     : in Note_Vector;
-            Media     : in Media_Map;
+            Media     : in Media_Collection;
             Overwrite : in Boolean := False)
     is
         Counter : Positive := 1;
-        Outname : SU.Unbounded_String;
+        Outname, Outdir : SU.Unbounded_String;
         File_Handle : TIO.File_Type;
+        Current_Entry : Datatypes.Field_Vector;
         Entry_Size : Positive;
     begin
         for C in Models.Iterate loop
             Outname := Compose_Name (Directory, Basename, "fmd", Counter);
+            Outdir := Compose_Dir (Directory, Basename, Counter);
             if FD.Exists (-Outname) then
                 if not Overwrite then
-                    raise FD.Name_Error;
+                    raise FD.Name_Error with "output file " & (-Outname) & " already exists";
                 else
                     FD.Delete_File (-Outname);
                 end if;
             end if;
+            if FD.Exists (-Outdir) and not Overwrite then
+                raise FD.Name_Error with "output directory " & (-Outdir) & " already exists";
+            end if;
             TIO.Create (File_Handle, TIO.Out_File, -Outname);
             Entry_Size := Positive (Model_Maps.Element (C).Fields.Length);
             FMD.Put_Header (File_Handle);
@@ -424,7 +487,9 @@ package body Deck_IO is
             FMD.Start_Entry_Section (File_Handle);
             for N of Notes loop
                 if N.Model = Model_Maps.Key (C) then
-                    FMD.Put_Entry (File_Handle, N.Fields, Entry_Size);
+                    Current_Entry := N.Fields;
+                    Extract_Images (Current_Entry, Outdir, Media);
+                    FMD.Put_Entry (File_Handle, Current_Entry, Entry_Size);
                 end if;
             end loop;
             FMD.End_Entry_Section (File_Handle);
diff --git a/src/deck_io.ads b/src/deck_io.ads
index 0145c4e..2f00207 100644
--- a/src/deck_io.ads
+++ b/src/deck_io.ads
@@ -29,9 +29,9 @@ package Deck_IO is
         return Boolean;
 
 
-    procedure Read_Media_Map
+    procedure Read_Media_Collection
            (Filename  : in     String;
-            Media     :    out Datatypes.Media_Map);
+            Media     :    out Datatypes.Media_Collection);
 
 
     procedure Open_Database
@@ -71,7 +71,7 @@ package Deck_IO is
             Basename  : in String;
             Models    : in Datatypes.Model_Map;
             Notes     : in Datatypes.Note_Vector;
-            Media     : in Datatypes.Media_Map;
+            Media     : in Datatypes.Media_Collection;
             Overwrite : in Boolean := False)
     with Pre => Matches (Models, Notes);