sourcelib/Svg.xtl
1⍝# Svg: pictures as SVG text, written for you (a standard library, built
2⍝# into xetal). Import it with an alias of your choice: "v:" u_se< "Svg".
3⍝# An element is its SVG text; a picture is elements joined with c_at
4⍝# inside v:p_icture, which []S_HOW shows and the command line writes.
5⍝# Points are a 2-row matrix, x over y, as []P_ATH and Geometry3D's
6⍝# v:p_roject give them; y grows downward, as SVG's does. Attributes
7⍝# are text made by v:a_ttr, v:f_ill, v:s_troke and the transforms, so
8⍝# no program writes a quote mark or an angle bracket of its own.
9⍝# Names with l: are exported; the others are private to this file.
10
11⍝# An attribute: "id" ᵛa̲ttr "top" is id="top" (with its leading
12⍝# space, so attributes join by c_at). The value is escaped.
13⍝# >> "v:" u_se< "Svg"
14⍝# >> "id" v:a_ttr "a&b"
15⍝# id="a&b"
16ˡa̲ttr ← { name value → " " c̲at name c̲at "=\"" c̲at (ˡe̲scape value) c̲at "\"" }
17
18⍝# Text with &, <, > and the quote mark escaped, as SVG needs it in
19⍝# attributes and text alike. Text with none of them is itself, found
20⍝# with one primitive test (most attribute values and titles are such,
21⍝# and a frame of the Rosetta stone escapes some hundreds of texts).
22⍝# >> "v:" u_se< "Svg"
23⍝# >> v:e_scape "a < b & c"
24⍝# a < b & c
25⍝# >> v:e_scape "ui-monospace, monospace"
26⍝# ui-monospace, monospace
27⍝# >> t_ally v:e_scape ""
28⍝# 0
29ˡe̲scape ← { t →
30 0 = '+ r̲/ t m̲ember? "&<>\"" ? t
31 j̲oin 'e̲sc m̲ap t
32}
33
34⍝# The fill attribute: a color ("#1f2937", "none", a name).
35⍝# >> "v:" u_se< "Svg"
36⍝# >> v:f_ill "none"
37⍝# fill="none"
38ˡf̲ill ← { color → "fill" ˡa̲ttr color }
39
40⍝# A color from red, green and blue levels 0 to 255: ᵛr̲gb 40 80 120
41⍝# is rgb(40,80,120); a level is rounded and kept in range.
42⍝# >> "v:" u_se< "Svg"
43⍝# >> v:r_gb 40 80.4 300
44⍝# rgb(40,80,255)
45ˡr̲gb ← { c →
46 k ← 0 m̲ax 255 m̲in f̲loor 0.5 + f̲loat c
47 "rgb(" c̲at (f̲ormat 1 s̲elect k) c̲at "," c̲at (f̲ormat 2 s̲elect k) c̲at "," c̲at (f̲ormat 3 s̲elect k) c̲at ")"
48}
49
50⍝# The stroke attributes: color ᵛs̲troke width, with round joins.
51⍝# >> "v:" u_se< "Svg"
52⍝# >> "#333" v:s_troke 1.5
53⍝# stroke="#333" stroke-width="1.5" stroke-linejoin="round"
54ˡs̲troke ← { color width → ("stroke" ˡa̲ttr color) c̲at ("stroke-width" ˡa̲ttr f̲ormat width) c̲at " stroke-linejoin=\"round\"" }
55
56⍝# A polygon through the points (2 rows, x over y), closed, with the
57⍝# given attributes: attrs ᵛp̲olygon points.
58⍝# >> "v:" u_se< "Svg"
59⍝# >> (v:f_ill "#ccc") v:p_olygon 2 3 r_eshape 0 10 20 0 10 0
60⍝# <polygon points="0,0 10,10 20,0" fill="#ccc"/>
61ˡp̲olygon ← { attrs points → "<polygon points=\"" c̲at (p̲airs points) c̲at "\"" c̲at attrs c̲at "/>" }
62
63⍝# A polyline through the points, open: attrs ᵛp̲olyline points.
64⍝# >> "v:" u_se< "Svg"
65⍝# >> ((v:f_ill "none") c_at "#000" v:s_troke 1) v:p_olyline 2 2 r_eshape 0 10 0 10
66⍝# <polyline points="0,0 10,10" fill="none" stroke="#000" stroke-width="1" stroke-linejoin="round"/>
67ˡp̲olyline ← { attrs points → "<polyline points=\"" c̲at (p̲airs points) c̲at "\"" c̲at attrs c̲at "/>" }
68
69⍝# The position attributes of text: ᵛa̲t 12 30 is x="12" y="30".
70⍝# >> "v:" u_se< "Svg"
71⍝# >> v:a_t 12 30.5
72⍝# x="12.0" y="30.5"
73ˡa̲t ← { xy → ("x" ˡa̲ttr f̲ormat 1 s̲elect xy) c̲at "y" ˡa̲ttr f̲ormat 2 s̲elect xy }
74
75⍝# Text with its attributes (v:a_t for where, and any others), escaped:
76⍝# attrs ᵛt̲ext "the text".
77⍝# >> "v:" u_se< "Svg"
78⍝# >> ((v:a_t 12 30) c_at "font-size" v:a_ttr "14") v:t_ext "a < b"
79⍝# <text x="12" y="30" font-size="14">a < b</text>
80ˡt̲ext ← { attrs t → "<text" c̲at attrs c̲at ">" c̲at (ˡe̲scape t) c̲at "</text>" }
81
82⍝# A run of text in a color inside a text element: color ᵛs̲pan "text",
83⍝# the text escaped; runs join with c_at into v:m_arkup.
84⍝# >> "v:" u_se< "Svg"
85⍝# >> "#1f2937" v:s_pan "a < b"
86⍝# <tspan fill="#1f2937">a < b</tspan>
87ˡs̲pan ← { color t → "<tspan" c̲at (ˡf̲ill color) c̲at ">" c̲at (ˡe̲scape t) c̲at "</tspan>" }
88
89⍝# Markup at a font size of its own inside a text element, for a line
90⍝# that must fit where a larger one would not: size ᵛs̲ized inner.
91⍝# >> "v:" u_se< "Svg"
92⍝# >> 0.05 v:s_ized "red" v:s_pan "a"
93⍝# <tspan font-size="0.05"><tspan fill="red">a</tspan></tspan>
94ˡs̲ized ← { size inner → "<tspan" c̲at ("font-size" ˡa̲ttr f̲ormat size) c̲at ">" c̲at inner c̲at "</tspan>" }
95
96⍝# Text whose content is already markup (runs from v:s_pan, or escaped
97⍝# text): attrs ᵛm̲arkup inner.
98⍝# >> "v:" u_se< "Svg"
99⍝# >> (v:a_t 1 2) v:m_arkup ("red" v:s_pan "a") c_at "blue" v:s_pan "b"
100⍝# <text x="1" y="2"><tspan fill="red">a</tspan><tspan fill="blue">b</tspan></text>
101ˡm̲arkup ← { attrs inner → "<text" c̲at attrs c̲at ">" c̲at inner c̲at "</text>" }
102
103⍝# A group of elements with attributes (a transform, a clip, a fill
104⍝# for all): attrs ᵛg̲roup elements.
105⍝# >> "v:" u_se< "Svg"
106⍝# >> (v:t_ranslate 5 5) v:g_roup (v:f_ill "red") v:p_olygon 2 3 r_eshape 0 1 2 0 1 0
107⍝# <g transform="translate(5 5)"><polygon points="0,0 1,1 2,0" fill="red"/></g>
108ˡg̲roup ← { attrs elements → "<g" c̲at attrs c̲at ">" c̲at elements c̲at "</g>" }
109
110⍝# The transform attribute moving by dx and dy: ᵛt̲ranslate dx dy.
111⍝# >> "v:" u_se< "Svg"
112⍝# >> v:t_ranslate 5 -2.5
113⍝# transform="translate(5.0 -2.5)"
114ˡt̲ranslate ← { d → "transform" ˡa̲ttr "translate(" c̲at (f̲ormat 1 s̲elect d) c̲at " " c̲at (f̲ormat 2 s̲elect d) c̲at ")" }
115
116⍝# The transform attribute turning by d degrees about the origin
117⍝# (clockwise on the screen, since y grows downward).
118⍝# >> "v:" u_se< "Svg"
119⍝# >> v:r_otate 90
120⍝# transform="rotate(90)"
121ˡr̲otate ← { d → "transform" ˡa̲ttr "rotate(" c̲at (f̲ormat d) c̲at ")" }
122
123⍝# The transform attribute mapping the unit square onto a quadrilateral
124⍝# given by three of its screen corners, top left, top right and bottom
125⍝# left (an affine fit; the fourth corner follows): `v:m_atrix (2 3
126⍝# r_eshape ...)`, the corners as columns, x over y. Text drawn inside
127⍝# it at unit coordinates lands on the face.
128⍝# >> "v:" u_se< "Svg"
129⍝# >> v:m_atrix 2 3 r_eshape 10 30 10 20 20 40
130⍝# transform="matrix(20 0 0 20 10 20)"
131ˡm̲atrix ← { c →
132 tl ← 1 s̲elect₂ c
133 tr ← (2 s̲elect₂ c) − tl
134 bl ← (3 s̲elect₂ c) − tl
135 "transform" ˡa̲ttr "matrix(" c̲at (f̲ormat tr) c̲at " " c̲at (f̲ormat bl) c̲at " " c̲at (f̲ormat tl) c̲at ")"
136}
137
138⍝# The transform attribute scaling by k about the origin.
139⍝# >> "v:" u_se< "Svg"
140⍝# >> v:s_cale 2
141⍝# transform="scale(2)"
142ˡs̲cale ← { k → "transform" ˡa̲ttr "scale(" c̲at (f̲ormat k) c̲at ")" }
143
144⍝# A clip region named id, a polygon through the points, to put among
145⍝# the picture's definitions; id ᵛc̲lipped elements then shows only
146⍝# what falls inside it.
147⍝# >> "v:" u_se< "Svg"
148⍝# >> "top" v:c_lip 2 3 r_eshape 0 10 20 0 10 0
149⍝# <clipPath id="top"><polygon points="0,0 10,10 20,0"/></clipPath>
150ˡc̲lip ← { id points → "<clipPath" c̲at ("id" ˡa̲ttr id) c̲at ">" c̲at ("" ˡp̲olygon points) c̲at "</clipPath>" }
151
152⍝# Elements shown only inside the clip region named id.
153⍝# >> "v:" u_se< "Svg"
154⍝# >> "top" v:c_lipped "<rect/>"
155⍝# <g clip-path="url(#top)"><rect/></g>
156ˡc̲lipped ← { id elements → ("clip-path" ˡa̲ttr "url(#" c̲at id c̲at ")") ˡg̲roup elements }
157
158⍝# A gradient named id from one color at the top to another at the
159⍝# bottom, to put among the definitions; fill with "url(#id)".
160⍝# >> "v:" u_se< "Svg"
161⍝# >> "sky" v:g_radient "#fff" "#88f"
162⍝# <linearGradient id="sky" x1="0" y1="0" x2="0" y2="1"><stop offset="0" stop-color="#fff"/><stop offset="1" stop-color="#88f"/></linearGradient>
163ˡg̲radient ← { id colors →
164 top ← d̲isclose 1 s̲elect colors
165 bottom ← d̲isclose 2 s̲elect colors
166 "<linearGradient" c̲at ("id" ˡa̲ttr id) c̲at " x1=\"0\" y1=\"0\" x2=\"0\" y2=\"1\"><stop offset=\"0\"" c̲at ("stop-color" ˡa̲ttr top) c̲at "/><stop offset=\"1\"" c̲at ("stop-color" ˡa̲ttr bottom) c̲at "/></linearGradient>"
167}
168
169⍝# The picture: w h ᵛp̲icture elements, with the definitions (clips,
170⍝# gradients) first among the elements if any. The view is w by h with
171⍝# the origin at the top left, and the picture scales to its place.
172⍝# >> "v:" u_se< "Svg"
173⍝# >> 20 10 v:p_icture ""
174⍝# <svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 20 10" width="20" height="10" role="img"></svg>
175ˡp̲icture ← { wh elements →
176 w ← f̲ormat 1 s̲elect wh
177 h ← f̲ormat 2 s̲elect wh
178 "<svg xmlns=\"http://www.w3.org/2000/svg\" viewBox=\"0 0 " c̲at w c̲at " " c̲at h c̲at "\"" c̲at ("width" ˡa̲ttr w) c̲at ("height" ˡa̲ttr h) c̲at " role=\"img\">" c̲at elements c̲at "</svg>"
179}
180
181⍝# A picture whose definitions (clips, gradients) come first: `w h
182⍝# v:p_ictureWith (defs; elements) is w h v:p_icture <defs>defs</defs>
183⍝# elements`.
184⍝# >> "v:" u_se< "Svg"
185⍝# >> 2 2 v:p_ictureWith "<clipPath/>" "<rect/>"
186⍝# <svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 2 2" width="2" height="2" role="img"><defs><clipPath/></defs><rect/></svg>
187ˡp̲ictureWith ← { wh parts → wh ˡp̲icture "<defs>" c̲at (d̲isclose 1 s̲elect parts) c̲at "</defs>" c̲at d̲isclose 2 s̲elect parts }
188
189⍝## Private helpers
190
191⍝ One character escaped for SVG text and attributes.
192e̲sc ← { c → c = f̲irst "&" ? "&"◆ c = f̲irst "<" ? "<"◆ c = f̲irst ">" ? ">"◆ c = f̲irst "\"" ? """◆ c }
193
194⍝ Boxed texts joined into one (none is the empty text).
195j̲oin ← { b →
196 0 = t̲ally b ? ""
197 d̲isclose '{ x y → e̲nclose (d̲isclose x) c̲at d̲isclose y } r̲/ b
198}
199
200⍝ The columns of a 2-row matrix as "x,y x,y ...".
201p̲airs ← { points →
202 xs ← 'f̲ormat m̲ap 1 s̲elect points
203 ys ← 'f̲ormat m̲ap 2 s̲elect points
204 ps ← xs '{ x y → e̲nclose (d̲isclose x) c̲at "," c̲at d̲isclose y } e̲ach ys
205 d̲isclose '{ x y → e̲nclose (d̲isclose x) c̲at " " c̲at d̲isclose y } r̲/ ps
206}