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}