Prolog "vector"
Admin User, created Apr 23. 2025
/**
* 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(misc/markup)).
:- ensure_loaded(library(util/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, '<svg width="~gem" height="~gem"\
viewBox="0 0 ~g ~g"~w>', [DW, DH, SW, SH, C]);
tag_format(S, '<svg width="~gem" height="~gem"\
viewBox="0 0 ~g ~g"~w xmlns="http://www.w3.org/2000/svg">', [DW, DH, SW, SH, C]),
sys_style_include(Css, S)).
% sys_style_include(+Atom, +Stream)
sys_style_include(Css, S) :-
tag(S, '<style>'),
open(Css, read, File),
(enum_atoms(File, Line),
write(S, Line), fail; true),
close(File),
tag(S, '</style>').
/**
* 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>').
/**
* svg_group_begin(X, Y, A):
* svg_group_begin(S, X, Y, A):
* The predicate succeeds. As a side effect a SVG group with
* translation X,Y and rotation A is created. The quaternary
* predicate allows specifying a markup writer S.
*/
% svg_group_begin(+Float, +Float, +Float)
svg_group_begin(X, Y, A) :-
current_output(S),
svg_group_begin(S, X, Y, A).
% svg_group_begin(+Stream, +Float, +Float, +Float)
svg_group_begin(S, X, Y, A) :-
B is A*180/pi,
tag_format(S, '<g transform="translate(~g, ~g)\
rotate(~g)">', [X, Y, B]).
/**
* 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, '</g>').
/*******************************************************************/
/* 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, +Atom)
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, +Atom)
svg_rect(S, X, Y, W, H, L) :-
sys_style_list(L, R),
atom_join(R, C),
tag_format(S, '<rect x="~g" y="~g" width="~g" height="~g"~w/>', [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, '<line x1="~g" y1="~g" x2="~g" y2="~g"~w/>', [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, '<text x="~g" y="~g"~w>', [X, Y, C]),
write(S, T),
tag(S, '</text>').
/**
* 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, +Atom)
svg_circle(X, Y, R, L) :-
current_output(S),
svg_circle(S, X, Y, R, L).
% svg_circle(+Stream, +Float, +Float, +Float, +Atom)
svg_circle(S, X, Y, T, L) :-
sys_style_list(L, R),
atom_join(R, C),
tag_format(S, '<circle cx="~g" cy="~g" r="~g"~w/>', [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, '<path d="~a"~w/>', [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(type_error(svg_shape,S),_)).
/**
* svg_image(X, Y, W, H, U):
* svg_image(S, X, Y, W, H, U):
* The predicate succeeds. As a side effect an image element at (X,Y)
* with width W, height H and image URL U s added to the SVG output area.
* The sixternary predicate allows * specifying a markup writer S.
*/
% svg_image(+Float, +Float, +Float, +Float, +Atom)
svg_image(X, Y, W, H, U) :-
current_output(S),
svg_image(S, X, Y, W, H, U).
% svg_image(+Stream, +Float, +Float, +Float, +Float, +Atom)
svg_image(S, X, Y, W, H, U) :-
tag_format(S, '<image x="~g" y="~g" width="~g" height="~g"\
href="~a" preserveAspectRatio="none" pointer-events="none"/>', [X, Y, W, H, U]).
/*******************************************************************/
/* 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(class(X), Y) :- !,
format_atom(' class="~a"', [X], Y).
sys_style_elem(style(X), Y) :- !,
format_atom(' style="~a"', [X], Y).
sys_style_elem(S, _) :-
throw(error(type_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(class(C), v(P,R-[class(C)|L]), v(P,R-L)) :- !.
sys_svg_opt(style(S), v(P,R-[style(S)|L]), v(P,R-L)) :- !.
sys_svg_opt(O, _, _) :-
throw(error(type_error(svg_option,O),_)).
/*******************************************************************/
/* Foreign Predicates */
/*******************************************************************/
% svg_view_inverse(E, I):
% defined in foreign(misc/portlib)
% svg_apply_transform(I, CX, CY, SX, SY):
% defined in foreign(misc/portlib)
:- ensure_loaded(foreign(misc/portlib)).