1 files changed, 109 insertions, 0 deletions
diff --git a/src/deckdata-csv.adb b/src/deckdata-csv.adb
new file mode 100644
index 0000000..4789469
--- /dev/null
+++ b/src/deckdata-csv.adb
@@ -0,0 +1,109 @@
+
+
+--  This source is licensed under the Sunset License v1.0
+
+
+with
+
+    Ada.Characters.Latin_1,
+    Ada.Strings.Fixed,
+    Ada.Strings.Maps,
+    Ada.Text_IO;
+
+use
+
+    Ada.Text_IO;
+
+
+package body Deckdata.CSV is
+
+
+    package Latin renames Ada.Characters.Latin_1;
+    package Strfix renames Ada.Strings.Fixed;
+    package Strmap renames Ada.Strings.Maps;
+
+
+
+
+    procedure Put_Cell
+           (File_Handle : in Ada.Text_IO.File_Type;
+            Data        : in String) is
+    begin
+        Put_Cell (File_Handle, +Data);
+    end Put_Cell;
+
+
+    procedure Put_Cell
+           (File_Handle : in Ada.Text_IO.File_Type;
+            Data        : in Ada.Strings.Unbounded.Unbounded_String)
+    is
+        Processed : SU.Unbounded_String := Data;
+        Position  : Natural;
+    begin
+        --  Deal with any lurking linefeed characters
+        loop
+            Position := SU.Index (Processed, Strmap.To_Set (Latin.LF));
+            exit when Position = 0;
+            SU.Replace_Element (Processed, Position, ' ');
+        end loop;
+
+        --  Escape any quizzical quotation characters
+        Position := SU.Index (Processed, Strmap.To_Set (Quote_Char));
+        while Position /= 0 loop
+            SU.Insert (Processed, Position, Strfix."*" (1, Escape_Char));
+            Position := Position + 2;  --  skip over the \" we already know about
+            exit when Position > SU.Length (Processed);
+            Position := SU.Index (Processed, Strmap.To_Set (Quote_Char), Position);
+        end loop;
+
+        --  Surround any suspicious separator characters
+        if SU.Index (Processed, Strmap.To_Set (Separator_Char)) /= 0 then
+            SU.Insert (Processed, 1, Strfix."*" (1, Quote_Char));
+            SU.Append (Processed, Quote_Char);
+        end if;
+
+        Put (File_Handle, -Processed);
+    end Put_Cell;
+
+
+    procedure Put_Header
+           (File_Handle : in Ada.Text_IO.File_Type;
+            Titles      : in Field_ID_Vector) is
+    begin
+        for Position in Field_Ordinal range
+            Titles.First_Index .. Field_Ordinal'Pred (Titles.Last_Index)
+        loop
+            Put_Cell (File_Handle, SU.Unbounded_String (Titles.Element (Position)));
+            Put (File_Handle, Separator_Char);
+        end loop;
+        Put_Cell (File_Handle, SU.Unbounded_String (Titles.Last_Element));
+        New_Line (File_Handle);
+    end Put_Header;
+
+
+    procedure Put_Row
+           (File_Handle : in Ada.Text_IO.File_Type;
+            Cells       : in Field_Vector;
+            Quantity    : in Positive)
+    is
+        Counter  : Positive := 1;
+        Position : Field_Ordinal := Cells.First_Index;
+    begin
+        while Counter < Quantity loop
+            if Position <= Cells.Last_Index then
+                Put_Cell (File_Handle, SU.Unbounded_String (Cells.Element (Position)));
+            end if;
+            Put (File_Handle, Separator_Char);
+            Position := Field_Ordinal'Succ (Position);
+            Counter := Counter + 1;
+        end loop;
+        if Position <= Cells.Last_Index then
+            Put_Cell (File_Handle, SU.Unbounded_String (Cells.Element (Position)));
+        end if;
+        New_Line (File_Handle);
+    end Put_Row;
+
+
+end Deckdata.CSV;
+
+