----------------------------------------------------------------------- -- pt-drivers-svg -- Printer driver -- Copyright (C) 2024 Stephane Carrez -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) -- SPDX-License-Identifier: Apache-2.0 ----------------------------------------------------------------------- with Ada.Strings.UTF_Encoding.Wide_Wide_Strings; with Ada.Strings.Unbounded; with Util.Serialize.IO.XML; with Util.Streams.Texts; private with PT.Colors; package PT.Drivers.SVG is type Printer_Type is limited new PT.Printer_Type with private; procedure Create (Printer : in out Printer_Type; Area : in Rect_Type; Output : in Util.Streams.Texts.Print_Stream_Access); -- Set the CSS style to be used within the SVG generated images. procedure CSS_Style (Printer : in out Printer_Type; Style : in String); -- Release the style when it is no longer used. procedure Delete_Style (Printer : in out Printer_Type; Style : in out Style_Type); -- Set the character fill style. procedure Set_Fill (Printer : in out Printer_Type; Style : in Style_Type; Fill : in Wide_Wide_Character); -- Set to use the given background color when drawing with this style. procedure Set_Background (Printer : in out Printer_Type; Style : in Style_Type; Color : in Color_Type); overriding procedure Initialize (Driver : in out Printer_Type); overriding procedure Finalize (Driver : in out Printer_Type); function To_String (S : in WString; Output_BOM : in Boolean := False) return String renames Ada.Strings.UTF_Encoding.Wide_Wide_Strings.Encode; private type Style_Info_Type is record Color : Color_Type := PT.Colors.White; Background : Color_Type := PT.Colors.Black; Fill : Wide_Wide_Character := ' '; Justify : PT.Justify_Type := J_LEFT; Font : PT.Font_Type := F_NORMAL; Allocated : Boolean := False; end record; type Style_Info_Array is array (Style_Index_Type'Range) of Style_Info_Type; type Printer_Access is access all Printer_Type'Class; type Driver_Type is limited new PT.Driver_Type with record Area : Rect_Type; Clip : Rect_Type; Styles : Style_Info_Array; Current : Style_Info_Type; Printer : Printer_Access; Stream : Util.Serialize.IO.XML.Output_Stream; Y_Offset : Y_Type := 0; Line_Size : H_Type := 20; Char_Size : W_Type := 20; CSS : Ada.Strings.Unbounded.Unbounded_String; end record; function To_String (Driver : in Driver_Type; X : in X_Type) return String; function To_String (Driver : in Driver_Type; Y : in Y_Type) return String; function Width_To_String (Driver : in Driver_Type; W : in W_Type) return String; function Height_To_String (Driver : in Driver_Type; H : in H_Type) return String; function To_String (Driver : in Driver_Type; Style : in Style_Type) return String; -- Get the drawing area coordinates. overriding function Get_Area (Driver : in Driver_Type) return Rect_Type; -- Get the current cliping area coordinates. overriding function Get_Clip (Driver : in Driver_Type) return Rect_Type; -- Get the dimension of the text when it is written with the given style. overriding function Get_Dimension (Driver : in Driver_Type; Text : in String; Style : in Style_Type) return Dimension_Type; overriding function Get_Wide_Dimension (Driver : in Driver_Type; Text : in Wide_Wide_String; Style : in Style_Type) return Dimension_Type; overriding function Get_Dimension (Driver : in Driver_Type; Percent : in Percent_Type; On_Width : in W_Type := 0) return Dimension_Type; -- Create a new style that can be configured, referenced and used. overriding procedure Create_Style (Driver : in out Driver_Type; Style : out Style_Type); -- Copy the style definition from one style to another. overriding procedure Copy_Style (Driver : in out Driver_Type; From : in Style_Type; To : in Style_Type); -- Set to use the given color when drawing with this style. overriding procedure Set_Color (Driver : in out Driver_Type; Style : in Style_Type; Color : in Color_Type); -- Set the style justification. overriding procedure Set_Justify (Driver : in out Driver_Type; Style : in Style_Type; Justify : in Justify_Type); -- Set the font style. overriding procedure Set_Font (Driver : in out Driver_Type; Style : in Style_Type; Font : in Font_Type); -- Set the current cliping area. overriding procedure Clip (Driver : in out Driver_Type; Rect : in Rect_Type); -- Fill the rectangle by using the given type. -- The rectangle is clipped if it intersects the cliping area. overriding procedure Fill (Driver : in out Driver_Type; Rect : in Rect_Type; Style : in Style_Type); -- Draw a line starting from (X1, Y1) to (X2, Y2) using the given style. -- The line is clipped if it intersects the cliping area. overriding procedure Draw (Driver : in out Driver_Type; X1 : in X_Type; Y1 : in Y_Type; X2 : in X_Type; Y2 : in Y_Type; Rect : in Rect_Type; Style : in Style_Type); -- Write the text starting at the top left X, Y corner and using the -- given style. The text is clipped if it intersects the cliping area. -- An UTF-8 sequence must be converted to a Wide_Wide_String and -- the Put_Wide method must be used. overriding procedure Put (Driver : in out Driver_Type; X : in X_Type; Y : in Y_Type; Text : in String; Style : in Style_Type; Justify : in Justify_Type := J_DEFAULT); overriding procedure Put_Wide (Driver : in out Driver_Type; X : in X_Type; Y : in Y_Type; Text : in Wide_Wide_String; Style : in Style_Type; Justify : in Justify_Type := J_DEFAULT); overriding procedure Put_Wide (Driver : in out Driver_Type; Box : in Rect_Type; Text : in Wide_Wide_String; Style : in Style_Type; Justify : in Justify_Type := J_DEFAULT); overriding procedure New_Line (Driver : in out Driver_Type); overriding procedure New_Page (Driver : in out Driver_Type); procedure Clear (Driver : in out Driver_Type); type Driver_Access is access all Driver_Type'Class; type Printer_Type is limited new PT.Printer_Type with record SVG_Driver : Driver_Access; Area : Rect_Type; Clip : Rect_Type; Styles : Style_Info_Array; end record; end PT.Drivers.SVG;