with

    Ada.Characters.Latin_1,
    Ada.Strings.Fixed,
    Ada.Strings.Maps,
    Ada.Text_IO;

use

    Ada.Text_IO;


package body FMD is


    package Latin renames Ada.Characters.Latin_1;
    package Strfix renames Ada.Strings.Fixed;
    package Strmap renames Ada.Strings.Maps;

    function "*"
           (Left  : in Natural;
            Right : in Character)
        return String
        renames Ada.Strings.Fixed."*";




    procedure Put_Header
           (File_Handle : in Ada.Text_IO.File_Type;
            Version     : in String := "1.4") is
    begin
        Put_Line (File_Handle, "<?xml version=""1.0"" encoding=""UTF-8""?>");
        Put_Line (File_Handle, "<!DOCTYPE freshmemory-dict>");
        Put_Line (File_Handle, "<dict version=""" & Version & """>");
    end Put_Header;




    procedure Put_Fields
           (File_Handle : in Ada.Text_IO.File_Type;
            Field_IDs   : in Data_Vectors.Vector)
    is
        Text : SU.Unbounded_String;
    begin
        Put_Line (File_Handle, (4 * ' ') & "<fields>");
        for FID of Field_IDs loop
            Text := To_Unbounded_String (FID);
            Standard_Escapes (Text);
            Put_Line (File_Handle, (8 * ' ') & "<field>" & (-Text) & "</field>");
        end loop;
        Put_Line (File_Handle, (4 * ' ') & "</fields>");
    end Put_Fields;




    procedure Start_Pack_Section
           (File_Handle : in Ada.Text_IO.File_Type) is
    begin
        Put_Line (File_Handle, (4 * ' ') & "<packs>");
    end Start_Pack_Section;


    procedure Put_Pack
           (File_Handle : in Ada.Text_IO.File_Type;
            Q_Data      : in Data_Vectors.Vector;
            A_Data      : in Data_Vectors.Vector)
    is
        Text : SU.Unbounded_String;
    begin
        Put_Line (File_Handle, (8 * ' ') & "<pack>");
        Text := To_Unbounded_String (Q_Data.First_Element);
        Standard_Escapes (Text);
        Put_Line (File_Handle, (12 * ' ') & "<qst>" & (-Text) & "</qst>");
        for I in Vector_Index range Vector_Index'Succ (Q_Data.First_Index) .. Q_Data.Last_Index loop
            Text := To_Unbounded_String (Q_Data.Element (I));
            Standard_Escapes (Text);
            --  Fresh Memory unfortunately cannot cope with multiple question fields
            Put_Line (File_Handle, (12 * ' ') & "<!--" & "<qst>" & (-Text) & "</qst>" & "-->");
        end loop;
        for FID of A_Data loop
            Text := To_Unbounded_String (FID);
            Standard_Escapes (Text);
            Put_Line (File_Handle, (12 * ' ') & "<ans>" & (-Text) & "</ans>");
        end loop;
        Put_Line (File_Handle, (8 * ' ') & "</pack>");
    end Put_Pack;


    procedure End_Pack_Section
           (File_Handle : in Ada.Text_IO.File_Type) is
    begin
        Put_Line (File_Handle, (4 * ' ') & "</packs>");
    end End_Pack_Section;




    procedure Start_Entry_Section
           (File_Handle : in Ada.Text_IO.File_Type) is
    begin
        Put_Line (File_Handle, (4 * ' ') & "<entries>");
    end Start_Entry_Section;


    procedure Put_Entry
           (File_Handle : in Ada.Text_IO.File_Type;
            Data        : in Data_Vectors.Vector;
            Quantity    : in Positive)
    is
        Counter : Positive := 1;
        Position : Vector_Index := Data.First_Index;
        Text : SU.Unbounded_String;
    begin
        Put_Line (File_Handle, (8 * ' ') & "<e>");
        while Counter <= Quantity loop
            if Position <= Data.Last_Index then
                Text := To_Unbounded_String (Data.Element (Position));
                Standard_Escapes (Text);
                Put_Line (File_Handle, (12 * ' ') & "<f>" & (-Text) & "</f>");
            else
                Put_Line (File_Handle, (12 * ' ') & "<f></f>");
            end if;
            Position := Vector_Index'Succ (Position);
            Counter := Counter + 1;
        end loop;
        Put_Line (File_Handle, (8 * ' ') & "</e>");
    end Put_Entry;


    procedure End_Entry_Section
           (File_Handle : in Ada.Text_IO.File_Type) is
    begin
        Put_Line (File_Handle, (4 * ' ') & "</entries>");
    end End_Entry_Section;




    procedure Put_Footer
           (File_Handle : in Ada.Text_IO.File_Type) is
    begin
        Put_Line (File_Handle, "</dict>");
    end Put_Footer;




    procedure Escape
           (Text : in out SU.Unbounded_String;
            Char : in     Character;
            Sub  : in     String)
    is
        Position : Natural;
    begin
        loop
            Position := SU.Index (Text, Strmap.To_Set (Char));
            exit when Position = 0;
            SU.Replace_Slice (Text, Position, Position, Sub);
        end loop;
    end Escape;


    procedure Standard_Escapes
           (Text : in out SU.Unbounded_String) is
    begin
        Escape (Text, '<', "&lt;");
        Escape (Text, '>', "&gt;");
        Escape (Text, '"', "&quot;");
    end Standard_Escapes;


end FMD;