summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/datatypes.ads11
-rw-r--r--src/deck_convert.adb4
-rw-r--r--src/deck_io.adb81
-rw-r--r--src/deck_io.ads6
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);