1 | % (c) 2020-2024 Lehrstuhl fuer Softwaretechnik und Programmiersprachen, | |
2 | % Heinrich Heine Universitaet Duesseldorf | |
3 | % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html) | |
4 | ||
5 | :- module(external_functions_svg,[svg_points/4, | |
6 | svg_train/8, svg_car/8, | |
7 | svg_axis/7, | |
8 | svg_set_polygon/7, svg_set_polygon_auto/6, | |
9 | svg_set_dasharray/4, | |
10 | svg_dasharray_for_intervals/4]). | |
11 | ||
12 | ||
13 | ||
14 | :- use_module(probsrc(tools_strings),[ajoin/2]). | |
15 | ||
16 | ||
17 | % external functions which aid in producing attributes for SVG/HTML VisB objects | |
18 | ||
19 | % generate a SVG "points" attribute string (e.g. for polygons or polylines) from a sequence of pairs of reals: | |
20 | % svg_points2str(points) == conc(%i.(i:dom(points)| | |
21 | % FORMAT_TO_STRING("~w,~w ",[prj1(REAL,REAL)(points(i)), | |
22 | % prj2(REAL,REAL)(points(i))]))); | |
23 | % example: svg_points([(1.0,2.0),(2.0,2.0)]) = "1.0,2.0 2.0,2.0 " | |
24 | ||
25 | :- use_module(probsrc(kernel_tools),[ground_value_check/2]). | |
26 | % external_fun_type('svg_points',[T1,T2],[seq(couple(T1,T2)),string]). % T1, T2 should be numbers | |
27 | :- block 'svg_points'(-,?,?,?). | |
28 | svg_points(Seq,StrResult,Span,WF) :- !, | |
29 | custom_explicit_sets:expand_custom_set_to_list_wf(Seq,ESeq,_Done,'svg_points',WF), | |
30 | ground_value_check(ESeq,Ground), | |
31 | svg_points2str_aux(Ground,ESeq,StrResult,Span,WF). | |
32 | ||
33 | :- block svg_points2str_aux(-,?,?,?,?). | |
34 | svg_points2str_aux(_Done,ESeq,StrResult,Span,_WF) :- | |
35 | translate_b_pairs_list_for_svg(ESeq,ResStr,Span), | |
36 | StrResult = string(ResStr). | |
37 | ||
38 | ||
39 | % translate pairs of numbers to SVG format "x1,y1 x2,y2 ..." | |
40 | translate_b_pairs_list_for_svg(ESeq,ResStr,Span) :- | |
41 | sort(ESeq,Sorted), | |
42 | translate_pairs(Sorted,Span,List,[]), | |
43 | ajoin(List,ResStr). | |
44 | ||
45 | translate_pairs([],_) --> []. | |
46 | translate_pairs([(_,(V1,V2))|T],Span) --> | |
47 | {get_number(V1,V1A,Span)}, | |
48 | [V1A], | |
49 | [','], | |
50 | {get_number(V2,V2A,Span)}, | |
51 | [V2A], | |
52 | [' '], | |
53 | translate_pairs(T,Span). | |
54 | ||
55 | % to do: use pp_value(V,LimitReached,Codes,[]) | |
56 | % to do: check that we have numbers | |
57 | % external_functions:svg_points([(int(1),(int(1),int(3)))],Res,unknown,WF), Res == string('1,3 ') | |
58 | % external_functions:svg_points([(int(1),(int(1),int(3))), (int(2),(int(2),int(4)))],Res,unknown,WF), Res == Res = string('1,3 2,4 ') | |
59 | ||
60 | % ----------- | |
61 | ||
62 | % render a simple train as a polygon | |
63 | % XScale is applied to start and length | |
64 | % B Example: svg_train(10,5,1.0,2.0,3.0) = "10.0,3.0 15.0,3.0 13.0,0 10.0,0 10.0,3.0 " | |
65 | ||
66 | svg_train(Start,Length,XScale,Slant,Height,StrResult,Span,_WF) :- | |
67 | svg_vehicle(Start,Length,XScale,Slant,Height,StrResult,Span,svg_train). | |
68 | svg_car(Start,Length,XScale,Slant,Height,StrResult,Span,_WF) :- | |
69 | svg_vehicle(Start,Length,XScale,Slant,Height,StrResult,Span,svg_car). | |
70 | ||
71 | % external_fun_type('svg_train',[T1,T2],[T1,T1,T2,T2,T2,string]). % T1, T2 should be numbers | |
72 | :- block 'svg_vehicle'(-,?,?,?,?, ?,?,?), | |
73 | 'svg_vehicle'(?,-,?,?,?, ?,?,?), | |
74 | 'svg_vehicle'(?,?,-,?,?, ?,?,?), | |
75 | 'svg_vehicle'(?,?,?,-,?, ?,?,?), | |
76 | 'svg_vehicle'(?,?,?,?,-, ?,?,?). | |
77 | svg_vehicle(Start,Length,XScale,Slant,Height,StrResult,Span,Vehicle) :- | |
78 | get_number(Start,St,Span), get_number(Length,Len,Span), | |
79 | get_number(XScale,XMultiplier,Span), | |
80 | get_number(Slant,S,Span), get_number(Height,H,Span), | |
81 | svg_vehicle_aux(Vehicle,St,Len,XMultiplier,S,H,StrResult,Span). | |
82 | ||
83 | :- block 'svg_vehicle_aux'(?,-,?,?,?,?, ?,?), | |
84 | 'svg_vehicle_aux'(?,?,-,?,?,?, ?,?), | |
85 | 'svg_vehicle_aux'(?,?,?,-,?,?, ?,?), | |
86 | 'svg_vehicle_aux'(?,?,?,?,-,?, ?,?), | |
87 | 'svg_vehicle_aux'(?,?,?,?,?,-, ?,?). | |
88 | svg_vehicle_aux(svg_train,St,Len,XMultiplier,Slant,Height,StrResult,Span) :- | |
89 | X1 is St*XMultiplier, | |
90 | X2 is (St+Len)*XMultiplier, X2S is X2-Slant, | |
91 | translate_pairs([(1,(X1,Height)), (2,(X2,Height)), (3,(X2S,0)), (4,(X1,0)), (5,(X1,Height))],Span,List,[]), | |
92 | ajoin(List,ResStr), | |
93 | StrResult = string(ResStr). | |
94 | svg_vehicle_aux(svg_car,St,Len,XMultiplier,Slant,Height,StrResult,Span) :- | |
95 | X1 is St*XMultiplier, | |
96 | X2 is (St+Len)*XMultiplier, X2S is X2-Slant, X2SS is X2S-Slant, H2 is Height/2, | |
97 | translate_pairs([(1,(X1,Height)), (2,(X2,Height)), (3, (X2,H2)), (4,(X2S,H2)), (5,(X2SS,0)), | |
98 | (6,(X1,0)), (7,(X1,Height))],Span,List,[]), | |
99 | ajoin(List,ResStr), | |
100 | StrResult = string(ResStr). | |
101 | ||
102 | % -------------------------- | |
103 | ||
104 | % draw an axis from 0 to MaxX with TickMarks of height Height at the TickMarks positions | |
105 | % the TickMarks set values are multiplied by XScale (for convenience, e.g., for B models without reals) | |
106 | % StrResult is a string to be used for a SVG polyline or polygon points attribute | |
107 | % Note: polylines start at 0,0 | |
108 | % B example: svg_axis({50},1,100,1) = "0,0 50,0 50,0.5 50,-0.5 50,0 100,0 " | |
109 | % svg_axis({50},1.5,100.0,2.0) = "0.0,0 75.0,0 75.0,1.0 75.0,-1.0 75.0,0 100.0,0 " | |
110 | ||
111 | % external_fun_type('svg_axis',[T1,T2],[set(T1),T2,T2,T2,string]). % T1, T2 should be numbers | |
112 | :- block 'svg_axis'(-,?,?,?,?,?,?), | |
113 | 'svg_axis'(?,-,?,?,?,?,?), | |
114 | 'svg_axis'(?,?,-,?,?,?,?), | |
115 | 'svg_axis'(?,?,?,-,?,?,?). | |
116 | svg_axis(TickMarks,XScale,MaxX,Height,StrResult,Span,WF) :- | |
117 | get_number(MaxX,Max,Span), | |
118 | get_number(XScale,XMultiplier,Span), | |
119 | get_number(Height,H,Span), | |
120 | custom_explicit_sets:expand_custom_set_to_list_wf(TickMarks,ESet,Done,'svg_axis',WF), | |
121 | svg_axis_aux(Done,ESet,XMultiplier,Max,H,StrResult,Span). | |
122 | ||
123 | :- block svg_axis_aux(-,?,?,?, ?,?,?), | |
124 | svg_axis_aux(?,-,?,?, ?,?,?), | |
125 | svg_axis_aux(?,?,-,?, ?,?,?), | |
126 | svg_axis_aux(?,?,?,-, ?,?,?), | |
127 | svg_axis_aux(?,?,?,?, -,?,?). | |
128 | svg_axis_aux(_Done,ESet,XMultiplier,Max,H,StrResult,Span) :- | |
129 | sort(ESet,Sorted), | |
130 | H2 is H / 2, | |
131 | Tail = [Max, ',0 '], | |
132 | gen_ticks(Sorted,XMultiplier,H2,Span,List,Tail), | |
133 | ajoin(List,ResStr), | |
134 | StrResult = string(ResStr). | |
135 | ||
136 | ||
137 | gen_ticks([],_,_,_) --> []. | |
138 | gen_ticks([TickMark|T],XMultiplier,H2,Span) --> | |
139 | {get_number(TickMark,TM,Span), XTick is TM*XMultiplier}, | |
140 | [XTick], [',0 '], | |
141 | [XTick], [','], [H2], [' '], | |
142 | [XTick], [',-'], [H2], [' '], | |
143 | [XTick], [',0 '], | |
144 | gen_ticks(T,XMultiplier,H2,Span). | |
145 | ||
146 | ||
147 | % -------------------------- | |
148 | ||
149 | % shows an integer set as a step-function/polygon of given height | |
150 | % StrResult is a string to be used for a SVG polyline or polygon points attribute | |
151 | % B example: svg_set_polygon({50,51,52,55},1.0,100.0,2.0) = | |
152 | % "50.0,0 50.0,2.0 53.0,2.0 53.0,0 55.0,0 55.0,2.0 56.0,2.0 56.0,0 100.0,0 " | |
153 | % TODO: probably svg_set_polygon should also receive a MinX value to be useful | |
154 | % B example: svg_set_polygon_auto({50,51,52,55},1.0,2.0) = | |
155 | % "50.0,0 50.0,2.0 53.0,2.0 53.0,0 55.0,0 55.0,2.0 56.0,2.0 56.0,0 " | |
156 | ||
157 | svg_set_polygon_auto(TickMarks,XScale,Height,StrResult,Span,WF) :- | |
158 | svg_set_polygon(TickMarks,XScale,auto,Height,StrResult,Span,WF). % do not finish the polygon line to end | |
159 | ||
160 | % external_fun_type('svg_set_polygon',[T2],[set(integer),T2,T2,T2,string]). % T2 should be number type | |
161 | :- block 'svg_set_polygon'(-,?,?,?,?,?,?), | |
162 | 'svg_set_polygon'(?,-,?,?,?,?,?), | |
163 | 'svg_set_polygon'(?,?,-,?,?,?,?), | |
164 | 'svg_set_polygon'(?,?,?,-,?,?,?). | |
165 | svg_set_polygon(TickMarks,XScale,MaxX,Height,StrResult,Span,WF) :- | |
166 | (MaxX=auto | |
167 | -> Max=auto % do not add trailing line to maximum end point at right | |
168 | ; get_number(MaxX,Max,Span)), | |
169 | get_number(XScale,XMultiplier,Span), | |
170 | get_number(Height,H,Span), | |
171 | custom_explicit_sets:expand_custom_set_to_list_wf(TickMarks,ESet,Done,'svg_set_polygon',WF), | |
172 | svg_set_polygon_aux(Done,ESet,XMultiplier,Max,H,StrResult,Span). | |
173 | ||
174 | :- block svg_set_polygon_aux(-,?,?,?, ?,?,?), | |
175 | svg_set_polygon_aux(?,-,?,?, ?,?,?), | |
176 | svg_set_polygon_aux(?,?,-,?, ?,?,?), | |
177 | svg_set_polygon_aux(?,?,?,-, ?,?,?). | |
178 | svg_set_polygon_aux(_Done,ESet,XMultiplier,Max,H,StrResult,Span) :- | |
179 | sort(ESet,Sorted), | |
180 | (Max=auto -> Tail=[] ; Tail = [Max, ',0 ']), | |
181 | gen_polygon(Sorted,XMultiplier,H,Span,List,Tail), | |
182 | ajoin(List,ResStr), | |
183 | StrResult = string(ResStr). | |
184 | ||
185 | ||
186 | gen_polygon([],_,_,_) --> []. | |
187 | gen_polygon([TickMark|T],XMultiplier,H,Span) --> | |
188 | {get_number(TickMark,TM,Span), XTick is TM*XMultiplier}, | |
189 | [XTick], [',0 '], | |
190 | [XTick], [','], [H], [' '], | |
191 | {scan_for_next(T,TM,Span,TR,TM1), XTickNxt is TM1*XMultiplier}, | |
192 | [XTickNxt], [','], [H], [' '], | |
193 | [XTickNxt], [',0 '], | |
194 | gen_polygon(TR,XMultiplier,H,Span). | |
195 | ||
196 | % skip as long as X+1 is also in the set | |
197 | scan_for_next([Nxt|T],XTick,Span,Res,XTickNxt) :- get_number(Nxt,XTick1,Span), XTick1 is XTick+1,!, | |
198 | scan_for_next(T,XTick1,Span,Res,XTickNxt). | |
199 | scan_for_next(List,XTick,_,List,XTickNxt) :- XTickNxt is XTick+1. | |
200 | ||
201 | % ------------------------- | |
202 | ||
203 | % generate a SVG dasharray string from a set of integer points, merging contiguous points into a single dash | |
204 | % Dash arrays contain space or comma separated numbers specifying lengths of dashes and gaps | |
205 | % B example: svg_set_dasharray({50,51,52,55}) = | |
206 | % "0 49 3 2 1 100000" | |
207 | svg_set_dasharray(SetOfIntegers,StrResult,Span,WF) :- | |
208 | svg_set_dasharray(SetOfIntegers,int(1),StrResult,Span,WF). | |
209 | ||
210 | :- block 'svg_set_dasharray'(-,?,?,?,?), 'svg_set_dasharray'(?,-,?,?,?). | |
211 | svg_set_dasharray(SetOfIntegers,int(StartIndex),StrResult,Span,WF) :- | |
212 | custom_explicit_sets:expand_custom_set_to_list_wf(SetOfIntegers,ESet,Done,'svg_set_dasharray',WF), | |
213 | svg_set_dasharray_aux(Done,ESet,StartIndex,StrResult,Span). | |
214 | ||
215 | :- block svg_set_dasharray_aux(-,?,?,?,?), svg_set_dasharray_aux(?,-,?,?,?). | |
216 | svg_set_dasharray_aux(_,ESet,StartIndex,StrResult,Span) :- | |
217 | sort(ESet,Sorted), | |
218 | gen_dash_array(Sorted,StartIndex,Span,List,[]), | |
219 | ajoin(['0 '|List],ResStr), % the first number in List is the length of a gap, dasharray starts with a dash | |
220 | StrResult = string(ResStr). | |
221 | ||
222 | gen_dash_array([],_,_) --> ['100000']. % add a large gap at end, so that we have an even number of numbers | |
223 | gen_dash_array([H|T],PrevDash,Span) --> | |
224 | {get_number(H,Next,Span), Delta is Next - PrevDash}, | |
225 | [Delta], % there is a delta empty dash stroke since the last solid dash | |
226 | [' '], | |
227 | {scan_for_next(T,Next,Span,NewT,NH1), Delta2 is NH1-Next}, | |
228 | [Delta2], % there is a dash of length delta2 in the set | |
229 | [' '], | |
230 | gen_dash_array(NewT,NH1,Span). | |
231 | ||
232 | ||
233 | % ------------------------- | |
234 | ||
235 | % generate a SVG dasharray string from (sorted!) sequence of percentage interval pairs for paths | |
236 | % assumes attribute pathLength="100" | |
237 | % example: svg_dasharray_for_intervals([(30.0,50.0),(75.0,100.0)]) = "0.0 30.0 20.0 25.0 25.0 " | |
238 | % example: svg_dasharray_for_intervals([(30.0,50.0),(75.0,99.0)]) = "0.0 30.0 20.0 25.0 24.0 1.0" | |
239 | % example: svg_dasharray_for_intervals([(0.0,5.0),(30.0,50.0),(75.0,99.0)]) = "0.0 5.0 25.0 20.0 25.0 24.0 1.0" | |
240 | ||
241 | % external_fun_type('svg_dasharray_for_intervals',[T1,T2],[set(couple(T1,T2)),string]). % T1, T2 should be numbers | |
242 | :- block 'svg_dasharray_for_intervals'(-,?,?,?). | |
243 | svg_dasharray_for_intervals(Seq,StrResult,Span,WF) :- !, | |
244 | custom_explicit_sets:expand_custom_set_to_list_wf(Seq,ESeq,_Done,'svg_dasharray_for_intervals',WF), | |
245 | ground_value_check(ESeq,Ground), | |
246 | svg_intervals2str_aux(Ground,ESeq,StrResult,Span,WF). | |
247 | ||
248 | :- block svg_intervals2str_aux(-,?,?,?,?). | |
249 | svg_intervals2str_aux(_Done,ESeq,StrResult,Span,_WF) :- | |
250 | sort(ESeq,Sorted), | |
251 | translate_dasharray(Sorted,Span,List,[]), | |
252 | ajoin(List,ResStr), | |
253 | StrResult = string(ResStr). | |
254 | ||
255 | ||
256 | translate_dasharray([],_) --> []. | |
257 | translate_dasharray([Pair|T],Span) --> {get_pair(Pair,V1,V2,Span)}, | |
258 | {get_number(V1,V1A,Span)}, | |
259 | ({V1A =\= 0} -> ['0 ',V1A,' '] ; []), % if first number is /= 0 -> add 0 to avoid first number being interpreted as gap length | |
260 | {get_number(V2,V2A,Span), Diff is V2A - V1A}, | |
261 | [Diff,' '], | |
262 | {Last is V1A + Diff}, | |
263 | translate_dasharray2(T,Last,Span). | |
264 | ||
265 | get_pair((int(_),(V1,V2)),V1,V2,_) :- !. % the predicate works with sequence of pairs | |
266 | get_pair((V1,V2),V1,V2,_) :- !. % or with a set of pairs | |
267 | get_pair(Pair,_,_,Span) :- add_error(svg_dasharray_for_intervals,'Element is not a pair:',Pair,Span),fail. | |
268 | ||
269 | translate_dasharray2([],Last,_) --> {Last < 100, LastLast is 100 - Last}, [LastLast]. % fill dasharray to 100 with a gap | |
270 | translate_dasharray2([],Last,_) --> {Last >= 100}, []. | |
271 | translate_dasharray2([Pair|T],Last,Span) --> {get_pair(Pair,V1,V2,Span)}, | |
272 | {get_number(V1,V1A,Span), get_number(V2,V2A,Span), | |
273 | (V1A =< Last -> (NextV1 = 0, NextV2 is V2A - Last) ; | |
274 | (NextV1 is V1A - Last, NextV2 is V2A - V1A))}, | |
275 | ({(V1A =< Last, V2A =< Last) ; V2A =< V1A } -> | |
276 | ([], {NextLast is Last}) ; | |
277 | ([NextV1,' ',NextV2,' '], {NextLast is Last + NextV1 + NextV2})), | |
278 | translate_dasharray2(T,NextLast,Span). | |
279 | ||
280 | % ------------------------- | |
281 | % Utilities | |
282 | ||
283 | ||
284 | :- use_module(probsrc(kernel_reals),[is_real/2]). | |
285 | :- use_module(probsrc(error_manager),[add_error/4]). | |
286 | :- block get_number(-,?,?). | |
287 | get_number(int(I),Res,_) :- !, Res=I. | |
288 | get_number(Term,Res,_) :- is_real(Term,Real),!,Res=Real. | |
289 | get_number(Nr,Res,_) :- number(Nr),!, Res=Nr. % convenience function for internal use in this module | |
290 | get_number(Term,_,Span) :- | |
291 | add_error(get_number,'Illegal value for external function, is not a number:',Term,Span),fail. | |
292 | ||
293 |