Index: generated/natools-static_maps-s_expressions-templates-integers-mc.adb ================================================================== --- generated/natools-static_maps-s_expressions-templates-integers-mc.adb +++ generated/natools-static_maps-s_expressions-templates-integers-mc.adb @@ -1,21 +1,22 @@ with Interfaces; use Interfaces; package body Natools.Static_Maps.S_Expressions.Templates.Integers.MC is - P : constant array (0 .. 3) of Natural := - (1, 2, 5, 9); - - T1 : constant array (0 .. 3) of Unsigned_8 := - (31, 27, 5, 36); - - T2 : constant array (0 .. 3) of Unsigned_8 := - (3, 33, 25, 27); - - G : constant array (0 .. 40) of Unsigned_8 := - (0, 0, 17, 16, 0, 17, 0, 0, 0, 0, 0, 12, 1, 12, 0, 7, 2, 9, 11, 4, 6, - 0, 17, 0, 0, 0, 0, 16, 5, 0, 1, 0, 0, 15, 0, 0, 0, 0, 13, 0, 7); + 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; @@ -22,12 +23,12 @@ 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 41; - F2 := (F2 + Natural (T2 (K)) * J) mod 41; + 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 20; + return (Natural (G (F1)) + Natural (G (F2))) mod 22; end Hash; end Natools.Static_Maps.S_Expressions.Templates.Integers.MC; Index: generated/natools-static_maps-s_expressions-templates-integers-t.adb ================================================================== --- generated/natools-static_maps-s_expressions-templates-integers-t.adb +++ generated/natools-static_maps-s_expressions-templates-integers-t.adb @@ -1,6 +1,6 @@ --- Generated at 2014-09-14 21:29:47 +0000 by Natools.Static_Hash_Maps +-- 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 Index: generated/natools-static_maps-s_expressions-templates-integers-t.ads ================================================================== --- generated/natools-static_maps-s_expressions-templates-integers-t.ads +++ generated/natools-static_maps-s_expressions-templates-integers-t.ads @@ -1,6 +1,6 @@ --- Generated at 2014-09-14 21:29:47 +0000 by Natools.Static_Hash_Maps +-- 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); Index: src/natools-s_expressions-templates-generic_integers-maps.sx ================================================================== --- src/natools-s_expressions-templates-generic_integers-maps.sx +++ src/natools-s_expressions-templates-generic_integers-maps.sx @@ -7,10 +7,11 @@ Align, Align_Center, Align_Left, Align_Right, Base, + Images, Padding, Padding_Left, Padding_Right, Sign, Width, @@ -27,10 +28,11 @@ (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) Index: src/natools-s_expressions-templates-generic_integers.adb ================================================================== --- src/natools-s_expressions-templates-generic_integers.adb +++ src/natools-s_expressions-templates-generic_integers.adb @@ -25,10 +25,21 @@ 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); @@ -35,10 +46,50 @@ ------------------------------ -- 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; @@ -81,10 +132,13 @@ 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; @@ -191,11 +245,11 @@ end case; end Update_Format; procedure Interpreter is new Interpreter_Loop - (Format, Meaningless_Type, Update_Format); + (Format, Meaningless_Type, Update_Format, Insert_Image); ------------------------- -- Dynamic Atom Arrays -- @@ -312,10 +366,19 @@ 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); @@ -397,16 +460,56 @@ --------------------- -- 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 Index: src/natools-s_expressions-templates-generic_integers.ads ================================================================== --- src/natools-s_expressions-templates-generic_integers.ads +++ src/natools-s_expressions-templates-generic_integers.ads @@ -19,29 +19,33 @@ -- 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 -- @@ -103,16 +107,40 @@ 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 @@ -182,8 +210,10 @@ 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;