From 36b0cbf19bd44c94bbe5aa67730347290f20628c Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Tue, 9 Nov 2021 17:05:44 +1300 Subject: Refactored packages --- src/fmd.adb | 214 ------------------------------------------------------------ 1 file changed, 214 deletions(-) delete mode 100644 src/fmd.adb (limited to 'src/fmd.adb') diff --git a/src/fmd.adb b/src/fmd.adb deleted file mode 100644 index ae037f4..0000000 --- a/src/fmd.adb +++ /dev/null @@ -1,214 +0,0 @@ - - --- This source is licensed under the Sunset License v1.0 - - -with - - Ada.Characters.Latin_1, - Ada.Strings.Fixed, - Ada.Strings.Maps, - Ada.Text_IO, - Datatypes; - -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, ""); - Put_Line (File_Handle, ""); - Put_Line (File_Handle, ""); - end Put_Header; - - - - - procedure Put_Fields - (File_Handle : in Ada.Text_IO.File_Type; - Field_IDs : in Datatypes.Field_ID_Vector) - is - Text : SU.Unbounded_String; - begin - Put_Line (File_Handle, (4 * ' ') & ""); - for FID of Field_IDs loop - Text := Prep (SU.Unbounded_String (FID)); - Put_Line (File_Handle, (8 * ' ') & "" & (-Text) & ""); - end loop; - Put_Line (File_Handle, (4 * ' ') & ""); - end Put_Fields; - - - - - procedure Start_Pack_Section - (File_Handle : in Ada.Text_IO.File_Type) is - begin - Put_Line (File_Handle, (4 * ' ') & ""); - end Start_Pack_Section; - - - procedure Put_Pack - (File_Handle : in Ada.Text_IO.File_Type; - Q_Data : in Datatypes.Field_ID_Vector; - A_Data : in Datatypes.Field_ID_Vector) - is - Text : SU.Unbounded_String; - begin - Put_Line (File_Handle, (8 * ' ') & ""); - Text := Prep (SU.Unbounded_String (Q_Data.First_Element)); - Put_Line (File_Handle, (12 * ' ') & "" & (-Text) & ""); - for I in Datatypes.Field_Ordinal range - Datatypes.Field_Ordinal'Succ (Q_Data.First_Index) .. Q_Data.Last_Index - loop - Text := Prep (SU.Unbounded_String (Q_Data.Element (I))); - -- Fresh Memory unfortunately cannot cope with multiple question fields - Put_Line (File_Handle, (12 * ' ') & ""); - end loop; - for FID of A_Data loop - Text := Prep (SU.Unbounded_String (FID)); - Put_Line (File_Handle, (12 * ' ') & "" & (-Text) & ""); - end loop; - Put_Line (File_Handle, (8 * ' ') & ""); - end Put_Pack; - - - procedure End_Pack_Section - (File_Handle : in Ada.Text_IO.File_Type) is - begin - Put_Line (File_Handle, (4 * ' ') & ""); - end End_Pack_Section; - - - - - procedure Start_Entry_Section - (File_Handle : in Ada.Text_IO.File_Type) is - begin - Put_Line (File_Handle, (4 * ' ') & ""); - end Start_Entry_Section; - - - procedure Put_Entry - (File_Handle : in Ada.Text_IO.File_Type; - Data : in Datatypes.Field_Vector; - Quantity : in Positive) - is - use type Datatypes.Field_Ordinal; - Counter : Positive := 1; - Position : Datatypes.Field_Ordinal := Data.First_Index; - Text : SU.Unbounded_String; - begin - Put_Line (File_Handle, (8 * ' ') & ""); - while Counter <= Quantity loop - if Position <= Data.Last_Index then - Text := Prep (SU.Unbounded_String (Data.Element (Position))); - Put_Line (File_Handle, (12 * ' ') & "" & (-Text) & ""); - else - Put_Line (File_Handle, (12 * ' ') & ""); - end if; - Position := Datatypes.Field_Ordinal'Succ (Position); - Counter := Counter + 1; - end loop; - Put_Line (File_Handle, (8 * ' ') & ""); - end Put_Entry; - - - procedure End_Entry_Section - (File_Handle : in Ada.Text_IO.File_Type) is - begin - Put_Line (File_Handle, (4 * ' ') & ""); - end End_Entry_Section; - - - - - procedure Put_Footer - (File_Handle : in Ada.Text_IO.File_Type) is - begin - Put_Line (File_Handle, ""); - end Put_Footer; - - - - - procedure Replace_All - (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 Replace_All; - - - procedure Replace_All - (Text : in out SU.Unbounded_String; - Item : in String; - Sub : in String) - is - Position : Natural; - begin - loop - Position := SU.Index (Text, Item); - exit when Position = 0; - SU.Replace_Slice (Text, Position, Position + Item'Length - 1, Sub); - end loop; - end Replace_All; - - - function Prep - (Text : in SU.Unbounded_String) - return SU.Unbounded_String - is - Result : SU.Unbounded_String := Text; - begin - -- Fresh Memory needs these character codes - Replace_All (Result, '<', "<"); - Replace_All (Result, '>', ">"); - Replace_All (Result, '"', """); - - -- Not sure why these cause Fresh Memory to not load the dict - -- Replace_All (Result, Latin.CR & Latin.LF, "
"); - -- Replace_All (Result, Latin.LF, "
"); - - -- Fresh memory doesn't recognise these character codes so get rid of them - -- Note that this list may not be complete - Replace_All (Result, "–", "–"); - Replace_All (Result, "’", "’"); - Replace_All (Result, "‘", "‘"); - Replace_All (Result, "”", "”"); - Replace_All (Result, "“", "“"); - - return Result; - end Prep; - - -end FMD; - - -- cgit