Natools

with Interfaces; use Interfaces;

package body Natools.Static_Maps.S_Expressions.Templates.Integers.MC is

   P : constant array (0 .. 4) of Natural :=
     (1, 2, 5, 6, 9);

   T1 : constant array (0 .. 4) of Unsigned_8 :=
     (15, 31, 41, 38, 11);

   T2 : constant array (0 .. 4) of Unsigned_8 :=
     (10, 33, 15, 23, 26);

   G : constant array (0 .. 44) of Unsigned_8 :=
     (0, 0, 0, 0, 5, 17, 14, 0, 5, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 13, 21,
      0, 0, 0, 11, 18, 7, 0, 16, 4, 2, 9, 0, 0, 15, 0, 0, 0, 2, 3, 7, 13, 0,
      1);

   function Hash (S : String) return Natural is
      F : constant Natural := S'First - 1;
      L : constant Natural := S'Length;
      F1, F2 : Natural := 0;
      J : Natural;
   begin
      for K in P'Range loop
         exit when L < P (K);
         J  := Character'Pos (S (P (K) + F));
         F1 := (F1 + Natural (T1 (K)) * J) mod 45;
         F2 := (F2 + Natural (T2 (K)) * J) mod 45;
      end loop;
      return (Natural (G (F1)) + Natural (G (F2))) mod 22;
   end Hash;

end Natools.Static_Maps.S_Expressions.Templates.Integers.MC;

--  Generated at 2014-09-23 18:25:16 +0000 by Natools.Static_Hash_Maps
--  from src/natools-s_expressions-templates-generic_integers-maps.sx

with Natools.Static_Maps.S_Expressions.Templates.Integers.MC;
with Natools.Static_Maps.S_Expressions.Templates.Integers.AC;
function Natools.Static_Maps.S_Expressions.Templates.Integers.T
  return Boolean is
begin

--  Generated at 2014-09-23 18:25:16 +0000 by Natools.Static_Hash_Maps
--  from src/natools-s_expressions-templates-generic_integers-maps.sx

function Natools.Static_Maps.S_Expressions.Templates.Integers.T
  return Boolean;
pragma Pure (Natools.Static_Maps.S_Expressions.Templates.Integers.T);

(Natools.Static_Maps.S_Expressions.Templates.Integers
   pure
   (test-function T)
   (extra-decl "\
   type Main_Command is
     (Error,
      Align,
      Align_Center,
      Align_Left,
      Align_Right,
      Base,
      Images,
      Padding,
      Padding_Left,
      Padding_Right,
      Sign,
      Width,
      Width_Max,
      Width_Min);

   type Align_Command is (Unknown_Align, Set_Left, Set_Center, Set_Right);")

   (Main_Command
      (hash-package Natools.Static_Maps.S_Expressions.Templates.Integers.MC)
      (function Main)
      (not-found Error)
      (nodes
         (Align          align)
         (Align_Center   align-center centered)
         (Align_Left     align-left left-align)
         (Align_Right    align-right right-align)
         (Base           base)
         (Images         image images)
         (Padding        padding)
         (Padding_Left   padding-left left-padding)
         (Padding_Right  padding-right right-padding)
         (Sign           sign signs)
         (Width          width)
         (Width_Max      width-max max-width)
         (Width_Min      width-min min-width)))

   package Commands
     renames Natools.Static_Maps.S_Expressions.Templates.Integers;

   function Create (Data : Atom) return Atom_Refs.Immutable_Reference
     renames Atom_Ref_Constructors.Create;


   procedure Insert_Image
     (State : in out Format;
      Context : in Meaningless_Type;
      Image : in Atom);

   procedure Update_Image
     (State : in out Format;
      Context : in Meaningless_Type;
      Name : in Atom;
      Arguments : in out Lockable.Descriptor'Class);

   procedure Update_Format
     (State : in out Format;
      Context : in Meaningless_Type;
      Name : in Atom;
      Arguments : in out Lockable.Descriptor'Class);


   ------------------------------
   -- Local Helper Subprograms --
   ------------------------------

   procedure Insert_Image
     (State : in out Format;
      Context : in Meaningless_Type;
      Image : in Atom)
   is
      pragma Unreferenced (Context);
   begin
      State.Append_Image (Image);
   end Insert_Image;


   procedure Update_Image
     (State : in out Format;
      Context : in Meaningless_Type;
      Name : in Atom;
      Arguments : in out Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
      Value : T;
   begin
      begin
         Value := T'Value (To_String (Name));
      exception
         when Constraint_Error =>
            return;
      end;

      case Arguments.Current_Event is
         when Events.Add_Atom =>
            State.Set_Image (Value, Arguments.Current_Atom);
         when others =>
            State.Remove_Image (Value);
      end case;
   end Update_Image;


   procedure Image_Interpreter is new Interpreter_Loop
     (Format, Meaningless_Type, Update_Image, Insert_Image);


   procedure Update_Format
     (State : in out Format;
      Context : in Meaningless_Type;
      Name : in Atom;
      Arguments : in out Lockable.Descriptor'Class)
   is

         when Commands.Align_Right =>
            State.Set_Align (Right_Aligned);

         when Commands.Base =>
            State.Set_Symbols (Arguments);

         when Commands.Images =>
            Image_Interpreter (Arguments, State, Meaningless_Value);

         when Commands.Padding =>
            case Arguments.Current_Event is
               when Events.Add_Atom =>
                  State.Left_Padding := Create (Arguments.Current_Atom);
                  State.Right_Padding := State.Left_Padding;
               when others =>
                  return;

                  null;
            end case;
      end case;
   end Update_Format;


   procedure Interpreter is new Interpreter_Loop
     (Format, Meaningless_Type, Update_Format, Insert_Image);



   -------------------------
   -- Dynamic Atom Arrays --
   -------------------------

      Output : Atom_Buffers.Atom_Buffer;
      Has_Sign : Boolean := True;
      Length : Width;
      Symbols : constant Atom_Arrays.Immutable_Reference
        := (if Template.Symbols.Is_Empty then Decimal else Template.Symbols);
   begin
      Check_Explicit_Image :
      declare
         Cursor : constant Atom_Maps.Cursor := Template.Images.Find (Value);
      begin
         if Atom_Maps.Has_Element (Cursor) then
            return Atom_Maps.Element (Cursor).Query.Data.all;
         end if;
      end Check_Explicit_Image;

      if Value < 0 then
         Reverse_Render (-Value, Symbols.Query.Data.all, Output, Length);
         Output.Append (Safe_Atom (Template.Negative_Sign, "-"));
      else
         Reverse_Render (Value, Symbols.Query.Data.all, Output, Length);

         if not Template.Positive_Sign.Is_Empty then

   end Render;



   ---------------------
   -- Format Mutators --
   ---------------------

   procedure Append_Image
     (Object : in out Format;
      Image : in Atom_Refs.Immutable_Reference) is
   begin
      Set_Image (Object, Next_Index (Object.Images), Image);
   end Append_Image;


   procedure Append_Image
     (Object : in out Format;
      Image : in Atom) is
   begin
      Append_Image (Object, Create (Image));
   end Append_Image;


   procedure Remove_Image (Object : in out Format; Value : in T) is
   begin
      Object.Images.Exclude (Value);
   end Remove_Image;


   procedure Set_Align (Object : in out Format; Value : in Alignment) is
   begin
      Object.Align := Value;
   end Set_Align;


   procedure Set_Image
     (Object : in out Format;
      Value : in T;
      Image : in Atom_Refs.Immutable_Reference) is
   begin
      Object.Images.Include (Value, Image);
   end Set_Image;


   procedure Set_Image
     (Object : in out Format;
      Value : in T;
      Image : in Atom) is
   begin
      Set_Image (Object, Value, Create (Image));
   end Set_Image;


   procedure Set_Left_Padding
     (Object : in out Format;
      Symbol : in Atom_Refs.Immutable_Reference) is
   begin
      Object.Left_Padding := Symbol;
   end Set_Left_Padding;

------------------------------------------------------------------------------
-- Natools.S_Expressions.Templates.Generic_Integers provides a template     --
-- interpreter for integer rendering.                                       --
-- The following commands are recognized:                                   --
--   (align "left|right|center")                                            --
--   (base "symbol 0" "symbol 1" "symbol 2" ...)                            --
--   (left-padding "symbol")                                                --
--   (image (0 "symbol 0") (2 "symbol 2") ...)                              --
--   (max-width "max width" ["overflow text"])                              --
--   (min-width "min width")                                                --
--   (padding "left-symbol" "right-symbol")                                 --
--   (padding "symbol")                                                     --
--   (right-padding "symbol")                                               --
--   (sign "plus sign" ["minus sign"])                                      --
--   (width "fixed width")                                                  --
--   (width "min width" "max width" ["overflow text"])                      --
-- Top-level atoms are taken as the image for the next number.              --
------------------------------------------------------------------------------

with Ada.Containers.Ordered_Maps;
with Ada.Streams;
with Natools.References;
with Natools.S_Expressions.Atom_Buffers;
with Natools.S_Expressions.Atom_Refs;
with Natools.S_Expressions.Lockable;
with Natools.Storage_Pools;

generic
   type T is range <>;
   with function "<" (Left, Right : T) return Boolean is <>;
package Natools.S_Expressions.Templates.Generic_Integers is
   pragma Preelaborate;

   --------------------------
   -- High-Level Interface --
   --------------------------

      --  Build an array reference consisting of
      --  consecutive atoms found in Atom_List.

   function Decimal return Atom_Arrays.Immutable_Reference
     with Post => not Decimal'Result.Is_Empty;
      --  Return a reference to usual decimal representation


   package Atom_Maps is new Ada.Containers.Ordered_Maps
     (T, Atom_Refs.Immutable_Reference, "<", Atom_Refs."=");

   function Next_Index (Map : Atom_Maps.Map) return T
     is (if Map.Is_Empty then T'First else Map.Last_Key + 1);
      --  Index of the next element to insert in sequential lists


   ---------------------
   -- Format Mutators --
   ---------------------

   procedure Set_Align (Object : in out Format; Value : in Alignment);

   procedure Append_Image
     (Object : in out Format;
      Image : in Atom_Refs.Immutable_Reference);
   procedure Append_Image
     (Object : in out Format;
      Image : in Atom);
   procedure Remove_Image (Object : in out Format; Value : in T);
   procedure Set_Image
     (Object : in out Format;
      Value : in T;
      Image : in Atom_Refs.Immutable_Reference);
   procedure Set_Image
     (Object : in out Format;
      Value : in T;
      Image : in Atom);

   procedure Set_Left_Padding
     (Object : in out Format;
      Symbol : in Atom_Refs.Immutable_Reference);
   procedure Set_Left_Padding
     (Object : in out Format;
      Symbol : in Atom);

      Minimum_Width : Width := 0;
      Align : Alignment := Right_Aligned;
      Left_Padding : Atom_Refs.Immutable_Reference;
      Right_Padding : Atom_Refs.Immutable_Reference;

      Maximum_Width : Width := Width'Last;
      Overflow_Message : Atom_Refs.Immutable_Reference;

      Images : Atom_Maps.Map;
   end record;

end Natools.S_Expressions.Templates.Generic_Integers;