1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209 | -----------------------------------------------------------------------
-- 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;
|