/** * This file provides SVG writing predicates. * * Warranty & Liability * To the extent permitted by applicable law and unless explicitly * otherwise agreed upon, XLOG Technologies AG makes no warranties * regarding the provided information. XLOG Technologies AG assumes * no liability that any problems might be solved with the information * provided by XLOG Technologies AG. * * Rights & License * All industrial property rights regarding the information - copyright * and patent rights in particular - are the sole property of XLOG * Technologies AG. If the company was not the originator of some * excerpts, XLOG Technologies AG has at least obtained the right to * reproduce, change and translate the information. * * Reproduction is restricted to the whole unaltered document. Reproduction * of the information is only allowed for non-commercial uses. Selling, * giving away or letting of the execution of the library is prohibited. * The library can be distributed as part of your applications and libraries * for execution provided this comment remains unchanged. * * Restrictions * Only to be distributed with programs that add significant and primary * functionality to the library. Not to be distributed with additional * software intended to replace any components of the library. * * Trademarks * Jekejeke is a registered trademark of XLOG Technologies AG. */ :- ensure_loaded(library(text/markup)). :- ensure_loaded(library(text/charsio)). /*******************************************************************/ /* SVG Containers */ /*******************************************************************/ /** * svg_begin(O): * svg_begin(S, O): * The predicate succeeds. As a side effect a new SVG output area with * options O. The binary predicate allows specifying a markup writer S. */ % svg_begin(+List) svg_begin(O) :- current_output(S), svg_begin(S, O). % svg_begin(+Stream, +List) svg_begin(S, O) :- sys_svg_opts(O, v(100-100,''-L), v(W-H,Css-[])), SW is W*500/100, SH is H*400/100, DW is SW/12, DH is SH/12, sys_style_list(L, R), atom_join(R, C), (Css = '' -> tag_format(S, '', [DW, DH, SW, SH, C]); tag_format(S, '', [DW, DH, SW, SH, C]), sys_style_include(Css, S), svg_rect(S, 0, 0, SW, SH, [class(brush)])). % sys_style_include(+Atom, +Stream) sys_style_include(Css, S) :- tag(S, ''). /** * svg_end: * svg_end(S): * The predicate succeeds. As a side effect the SVG output * area is closed. The unary predicate allows specifying * a markup writer S. */ % svg_end svg_end :- current_output(S), svg_end(S). % svg_end(+Stream) svg_end(S) :- tag(S, ''). /** * svg_group_begin(X, Y, L): * svg_group_begin(S, X, Y, L): * The predicate succeeds. As a side effect a SVG group with * translation X,Y and style L is created. The quaternary predicate * allows specifying a markup writer S. */ % svg_group_begin(+Float, +Float, +List) svg_group_begin(X, Y, L) :- current_output(S), svg_group_begin(S, X, Y, L). % svg_group_begin(+Stream, +Float, +Float, +List) svg_group_begin(S, X, Y, L) :- sys_style_list(L, R), atom_join(R, C), tag_format(S, '', [X, Y, C]). /** * svg_group_end: * svg_group_end(S): * The predicate succeeds. As a side effect the SVG group is closed. * The unary predicate allows specifying a markup writer S. */ % svg_group_end svg_group_end :- current_output(S), svg_group_end(S). % svg_group_end(+Stream) svg_group_end(S) :- tag(S, ''). /*******************************************************************/ /* SVG Drawings */ /*******************************************************************/ /** * svg_rect(X, Y, W, H, L): * svg_rect(S, X, Y, W, H, L): * The predicate succeeds. As a side effect a rectangle element at (X,Y) * with dimension (W,H) and style L is added to the SVG output area. The * septenary predicate allows specifying a markup writer S. */ % svg_rect(+Float, +Float, +Float, +Float, +List) svg_rect(X, Y, W, H, L) :- current_output(S), svg_rect(S, X, Y, W, H, L). % svg_rect(+Stream, +Float, +Float, +Float, +Float, +List) svg_rect(S, X, Y, W, H, L) :- sys_style_list(L, R), atom_join(R, C), tag_format(S, '', [X, Y, W, H, C]). /** * svg_line(X1, Y1, X2, Y2, L): * svg_line(S, X1, Y1, X2, Y2, L): * The predicate succeeds. As a side effect a line element from (X1,Y1) * to (X2,Y2) with style L is added to the SVG output area. The * septenary predicate allows specifying a markup writer S. */ % svg_line(+Float, +Float, +Float, +Float, +List) svg_line(X1, Y1, X2, Y2, L) :- current_output(S), svg_line(S, X1, Y1, X2, Y2, L). % svg_line(+Stream, +Float, +Float, +Float, +Float, +List) svg_line(S, X1, Y1, X2, Y2, L) :- sys_style_list(L, R), atom_join(R, C), tag_format(S, '', [X1, Y1, X2, Y2, C]). /** * svg_text(X, Y, T, L): * svg_text(S, X, Y, T, L): * The predicate succeeds. As a side effect a text element at (X,Y) * with content T and style L is added to the SVG output area. The * pentamery predicate allows specifying a markup writer S. */ % svg_text(+Float, +Float, +Atom, +List) svg_text(X, Y, T, L) :- current_output(S), svg_text(S, X, Y, T, L). % svg_text(+Stream, +Float, +Float, +Atom, +List) svg_text(S, X, Y, T, L) :- sys_style_list(L, R), atom_join(R, C), tag_format(S, '', [X, Y, C]), write(S, T), tag(S, ''). /** * svg_circle(X, Y, R, L): * svg_circle(S, X, Y, R, L): * The predicate succeeds. As a side effect a circle element at (X,Y) * with radius R and style L is added to the SVG output area. The * pentamery predicate allows specifying a markup writer S. */ % svg_circle(+Float, +Float, +Float, +List) svg_circle(X, Y, R, L) :- current_output(S), svg_circle(S, X, Y, R, L). % svg_circle(+Stream, +Float, +Float, +Float, +List) svg_circle(S, X, Y, T, L) :- sys_style_list(L, R), atom_join(R, C), tag_format(S, '', [X, Y, T, C]). /** * svg_path(P, L): * svg_path(S, P, L): * The predicate succeeds. As a side effect a path element with shape P * and style L is added to the SVG output area. The ternary predicate allows * specifying a markup writer S. */ % svg_path(+List, +List) svg_path(P, L) :- current_output(S), svg_path(S, P, L). % svg_path(+Stream, +List, +List) svg_path(S, P, L) :- sys_shape_list(P, Q), atom_join(Q, D), sys_style_list(L, R), atom_join(R, C), tag_format(S, '', [D, C]). % sys_shape_list(+List, +List) sys_shape_list(V, _) :- var(V), throw(error(instantiation_error,_)). sys_shape_list([X|P], [Y|Q]) :- !, sys_shape_elem(X, Y), sys_shape_list(P, Q). sys_shape_list([], []) :- !. sys_shape_list(P, _) :- throw(error(type_error(list,P),_)). % sys_shape_elem(+Atomic, -Atom) sys_shape_elem(V, _) :- var(V), throw(error(instantiation_error,_)). sys_shape_elem(X, Y) :- atom(X), !, format_atom('~w ', [X], Y). sys_shape_elem(X, Y) :- number(X), !, format_atom('~g ', [X], Y). sys_shape_elem(S, _) :- throw(error(domain_error(svg_path,S),_)). /** * svg_image(X, Y, W, H, U, L): * svg_image(S, X, Y, W, H, U, L): * The predicate succeeds. As a side effect an image element at (X,Y) * with width W, height H, image URL U and style L added to the SVG * output area. The septernary predicate allows specifying a * markup writer S. */ % svg_image(+Float, +Float, +Float, +Float, +Atom, +List) svg_image(X, Y, W, H, U, L) :- current_output(S), svg_image(S, X, Y, W, H, U, L). % svg_image(+Stream, +Float, +Float, +Float, +Float, +Atom, +List) svg_image(S, X, Y, W, H, U, L) :- sys_style_list(L, R), atom_join(R, C), tag_format(S, '', [X, Y, W, H, U, C]). /*******************************************************************/ /* Style Lists */ /*******************************************************************/ /** * sys_style_list(L, R): * The predicate succeeds in R with the XML attributes from the options L. */ % sys_style_list(+List, -List) sys_style_list(V, _) :- var(V), throw(error(instantiation_error,_)). sys_style_list([X|L], [Y|R]) :- !, sys_style_elem(X, Y), sys_style_list(L, R). sys_style_list([], []) :- !. sys_style_list(L, _) :- throw(error(type_error(list,L),_)). % sys_style_elem(+Term, -Atom) sys_style_elem(V, _) :- var(V), throw(error(instantiation_error,_)). sys_style_elem(X, Z) :- X =.. [F,Y], !, format_atom(' ~w="~a"', [F,Y], Z). sys_style_elem(F-X, Z) :- X =.. [G,Y], !, format_atom(' ~w-~w="~a"', [F,G,Y], Z). sys_style_elem(S, _) :- throw(error(domain_error(svg_style,S),_)). /*******************************************************************/ /* SVG Options */ /*******************************************************************/ /** * sys_svg_opts(L, F, G): * The predicate succeeds in G with the options L starting with defaults F. */ % sys_svg_opts(+List, +Pair, -Pair) sys_svg_opts(V, _, _) :- var(V), throw(error(instantiation_error,_)). sys_svg_opts([X|L], I, O) :- !, sys_svg_opt(X, I, H), sys_svg_opts(L, H, O). sys_svg_opts([], H, H) :- !. sys_svg_opts(L, _, _) :- throw(error(type_error(list,L),_)). % sys_svg_opt(+Option, +Pair, -Pair) sys_svg_opt(V, _, _) :- var(V), throw(error(instantiation_error,_)). sys_svg_opt(width(W), v(_-H,P), v(W-H,P)) :- !. sys_svg_opt(height(H), v(W-_,P), v(W-H,P)) :- !. sys_svg_opt(css(R), v(P,_-L), v(P,R-L)) :- !. sys_svg_opt(X, v(P,R-[X|L]), v(P,R-L)) :- callable(X), !. sys_svg_opt(S, _, _) :- throw(error(domain_error(svg_option,S),_)). /****************************************************************/ /* Error Texts */ /****************************************************************/ % strings(+Atom, +Atom, -Atom) :- multifile(strings/3). strings('domain_error.svg_option', de, 'SVG-Option erwartet, gefunden ~q.'). strings('domain_error.svg_path', de, 'Pfadelement erwartet, gefunden ~q.'). strings('domain_error.svg_style', de, 'Stilelement erwartet, gefunden ~q.'). strings('domain_error.svg_option', '', 'SVG option expected, found ~q.'). strings('domain_error.svg_path', '', 'Path element expected, found ~q.'). strings('domain_error.svg_style', '', 'Style element expected, found ~q.'). /*******************************************************************/ /* Foreign Predicates */ /*******************************************************************/ % svg_view_inverse(E, I): % defined in foreign(text/portlib) % svg_apply_transform(I, CX, CY, SX, SY): % defined in foreign(text/portlib) :- ensure_loaded(foreign(text/portlib)).