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