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