| 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 |