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 @@ -59,40 +59,31 @@ (To_String (Arguments.Current_Atom)) is when Commands.Unknown_Align => null; when Commands.Set_Left => - State.Align := Left_Aligned; + State.Set_Align (Left_Aligned); when Commands.Set_Center => - State.Align := Centered; + State.Set_Align (Centered); when Commands.Set_Right => - State.Align := Right_Aligned; + State.Set_Align (Right_Aligned); end case; when others => null; end case; when Commands.Align_Center => - State.Align := Centered; + State.Set_Align (Centered); when Commands.Align_Left => - State.Align := Left_Aligned; + State.Set_Align (Left_Aligned); when Commands.Align_Right => - State.Align := Right_Aligned; + State.Set_Align (Right_Aligned); when Commands.Base => - declare - New_Base : constant Atom_Arrays.Immutable_Reference - := Create (Arguments); - begin - if not New_Base.Is_Empty - and then New_Base.Query.Data.all'Length >= 2 - then - State.Symbols := New_Base; - end if; - end; + State.Set_Symbols (Arguments); when Commands.Padding => case Arguments.Current_Event is when Events.Add_Atom => State.Left_Padding := Create (Arguments.Current_Atom); @@ -102,96 +93,100 @@ end case; Arguments.Next (Event); case Event is when Events.Add_Atom => - State.Right_Padding := Create (Arguments.Current_Atom); + State.Set_Right_Padding (Arguments.Current_Atom); when others => null; end case; when Commands.Padding_Left => case Arguments.Current_Event is when Events.Add_Atom => - State.Left_Padding := Create (Arguments.Current_Atom); + State.Set_Left_Padding (Arguments.Current_Atom); when others => null; end case; when Commands.Padding_Right => case Arguments.Current_Event is when Events.Add_Atom => - State.Right_Padding := Create (Arguments.Current_Atom); + State.Set_Right_Padding (Arguments.Current_Atom); when others => null; end case; when Commands.Sign => case Arguments.Current_Event is when Events.Add_Atom => - State.Positive_Sign := Create (Arguments.Current_Atom); + State.Set_Positive_Sign (Arguments.Current_Atom); when others => return; end case; Arguments.Next (Event); case Event is when Events.Add_Atom => - State.Negative_Sign := Create (Arguments.Current_Atom); + State.Set_Negative_Sign (Arguments.Current_Atom); when others => null; end case; when Commands.Width => case Arguments.Current_Event is when Events.Add_Atom => - State.Maximum_Width - := Width'Value (To_String (Arguments.Current_Atom)); - State.Minimum_Width := State.Maximum_Width; + declare + New_Width : constant Width + := Width'Value (To_String (Arguments.Current_Atom)); + begin + State.Set_Maximum_Width (New_Width); + State.Set_Minimum_Width (New_Width); + end; when others => return; end case; Arguments.Next (Event); case Event is when Events.Add_Atom => - State.Maximum_Width - := Width'Value (To_String (Arguments.Current_Atom)); + State.Set_Maximum_Width + (Width'Value (To_String (Arguments.Current_Atom))); when others => return; end case; Arguments.Next (Event); case Event is when Events.Add_Atom => - State.Overflow_Message := Create (Arguments.Current_Atom); + State.Set_Overflow_Message (Arguments.Current_Atom); when others => return; end case; when Commands.Width_Max => case Arguments.Current_Event is when Events.Add_Atom => - State.Maximum_Width - := Width'Value (To_String (Arguments.Current_Atom)); + State.Set_Maximum_Width + (Width'Value (To_String (Arguments.Current_Atom))); when others => return; end case; Arguments.Next (Event); case Event is when Events.Add_Atom => - State.Overflow_Message := Create (Arguments.Current_Atom); + State.Set_Overflow_Message (Arguments.Current_Atom); when others => return; end case; when Commands.Width_Min => case Arguments.Current_Event is when Events.Add_Atom => - State.Minimum_Width - := Width'Value (To_String (Arguments.Current_Atom)); + State.Set_Minimum_Width + (Width'Value (To_String (Arguments.Current_Atom))); when others => null; end case; end case; end Update_Format; @@ -384,6 +379,135 @@ begin Parse (Parsed_Template, Template); Output.Write (Render (Value, Parsed_Template)); end Render; + + + --------------------- + -- Format Mutators -- + --------------------- + + procedure Set_Align (Object : in out Format; Value : in Alignment) is + begin + Object.Align := Value; + end Set_Align; + + + procedure Set_Left_Padding + (Object : in out Format; + Symbol : in Atom_Refs.Immutable_Reference) is + begin + Object.Left_Padding := Symbol; + end Set_Left_Padding; + + + procedure Set_Left_Padding + (Object : in out Format; + Symbol : in Atom) is + begin + Set_Left_Padding (Object, Create (Symbol)); + end Set_Left_Padding; + + + procedure Set_Maximum_Width (Object : in out Format; Value : in Width) is + begin + Object.Maximum_Width := Value; + + if Object.Minimum_Width > Object.Maximum_Width then + Object.Minimum_Width := Value; + end if; + end Set_Maximum_Width; + + + procedure Set_Minimum_Width (Object : in out Format; Value : in Width) is + begin + Object.Minimum_Width := Value; + + if Object.Minimum_Width > Object.Maximum_Width then + Object.Maximum_Width := Value; + end if; + end Set_Minimum_Width; + + + procedure Set_Negative_Sign + (Object : in out Format; + Sign : in Atom_Refs.Immutable_Reference) is + begin + Object.Negative_Sign := Sign; + end Set_Negative_Sign; + + + procedure Set_Negative_Sign + (Object : in out Format; + Sign : in Atom) is + begin + Set_Negative_Sign (Object, Create (Sign)); + end Set_Negative_Sign; + + + procedure Set_Overflow_Message + (Object : in out Format; + Message : in Atom_Refs.Immutable_Reference) is + begin + Object.Overflow_Message := Message; + end Set_Overflow_Message; + + + procedure Set_Overflow_Message + (Object : in out Format; + Message : in Atom) is + begin + Set_Overflow_Message (Object, Create (Message)); + end Set_Overflow_Message; + + + procedure Set_Positive_Sign + (Object : in out Format; + Sign : in Atom_Refs.Immutable_Reference) is + begin + Object.Positive_Sign := Sign; + end Set_Positive_Sign; + + + procedure Set_Positive_Sign + (Object : in out Format; + Sign : in Atom) is + begin + Set_Positive_Sign (Object, Create (Sign)); + end Set_Positive_Sign; + + + procedure Set_Right_Padding + (Object : in out Format; + Symbol : in Atom_Refs.Immutable_Reference) is + begin + Object.Right_Padding := Symbol; + end Set_Right_Padding; + + + procedure Set_Right_Padding + (Object : in out Format; + Symbol : in Atom) is + begin + Set_Right_Padding (Object, Create (Symbol)); + end Set_Right_Padding; + + + procedure Set_Symbols + (Object : in out Format; + Symbols : in Atom_Arrays.Immutable_Reference) is + begin + if not Symbols.Is_Empty and then Symbols.Query.Data.all'Length >= 2 then + Object.Symbols := Symbols; + end if; + end Set_Symbols; + + + procedure Set_Symbols + (Object : in out Format; + Expression : in out S_Expressions.Descriptor'Class) is + begin + Set_Symbols (Object, Create (Expression)); + end Set_Symbols; + end Natools.S_Expressions.Templates.Generic_Integers; 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 @@ -41,11 +41,15 @@ generic type T is range <>; package Natools.S_Expressions.Templates.Generic_Integers is pragma Preelaborate; - type Format is private; + -------------------------- + -- High-Level Interface -- + -------------------------- + + type Format is tagged private; function Render (Value : T; Template : Format) return Atom; -- Render Value according to Template procedure Parse @@ -57,11 +61,14 @@ (Output : in out Ada.Streams.Root_Stream_Type'Class; Template : in out Lockable.Descriptor'Class; Value : in T); -- Read a rendering format from Template and use it on Value -private + + --------------------- + -- Auxiliary Types -- + --------------------- type Alignment is (Left_Aligned, Centered, Right_Aligned); type Width is range 0 .. 10000; subtype Base_T is T'Base; @@ -73,18 +80,10 @@ function Create (Atom_List : in out S_Expressions.Descriptor'Class) return Atom_Array; -- Build an array consisting of consecutive atoms found in Atom_List - procedure Reverse_Render - (Value : in Natural_T; - Symbols : in Atom_Array; - Output : in out Atom_Buffers.Atom_Buffer; - Length : out Width) - with Pre => Symbols'Length >= 2 and Symbols'First = 0; - -- Create a little-endian image of Value using the given symbol table - package Atom_Arrays is new References (Atom_Array, Storage_Pools.Access_In_Default_Pool'Storage_Pool, Storage_Pools.Access_In_Default_Pool'Storage_Pool); @@ -96,15 +95,78 @@ function Decimal return Atom_Arrays.Immutable_Reference with Post => not Decimal'Result.Is_Empty; -- Return a reference to usual decimal representation + + --------------------- + -- Format Mutators -- + --------------------- + + procedure Set_Align (Object : in out Format; Value : in Alignment); + + 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); + + procedure Set_Maximum_Width (Object : in out Format; Value : in Width); + + procedure Set_Minimum_Width (Object : in out Format; Value : in Width); + + procedure Set_Negative_Sign + (Object : in out Format; + Sign : in Atom_Refs.Immutable_Reference); + procedure Set_Negative_Sign + (Object : in out Format; + Sign : in Atom); + + procedure Set_Overflow_Message + (Object : in out Format; + Message : in Atom_Refs.Immutable_Reference); + procedure Set_Overflow_Message + (Object : in out Format; + Message : in Atom); + + procedure Set_Positive_Sign + (Object : in out Format; + Sign : in Atom_Refs.Immutable_Reference); + procedure Set_Positive_Sign + (Object : in out Format; + Sign : in Atom); + + procedure Set_Right_Padding + (Object : in out Format; + Symbol : in Atom_Refs.Immutable_Reference); + procedure Set_Right_Padding + (Object : in out Format; + Symbol : in Atom); + + procedure Set_Symbols + (Object : in out Format; + Symbols : in Atom_Arrays.Immutable_Reference); + procedure Set_Symbols + (Object : in out Format; + Expression : in out S_Expressions.Descriptor'Class); + + +private + Base_10 : Atom_Arrays.Immutable_Reference; -- Cache for the often-used decimal representation + procedure Reverse_Render + (Value : in Natural_T; + Symbols : in Atom_Array; + Output : in out Atom_Buffers.Atom_Buffer; + Length : out Width) + with Pre => Symbols'Length >= 2 and Symbols'First = 0; + -- Create a little-endian image of Value using the given symbol table - type Format is record + type Format is tagged record Symbols : Atom_Arrays.Immutable_Reference; Positive_Sign : Atom_Refs.Immutable_Reference; Negative_Sign : Atom_Refs.Immutable_Reference; Minimum_Width : Width := 0; @@ -113,8 +175,7 @@ Right_Padding : Atom_Refs.Immutable_Reference; Maximum_Width : Width := Width'Last; Overflow_Message : Atom_Refs.Immutable_Reference; end record; - end Natools.S_Expressions.Templates.Generic_Integers;