librarylib/Svg.xtl
Svg: pictures as SVG text, written for you (a standard library, built into xetal). Import it with an alias of your choice: "v:" u_se< "Svg". An element is its SVG text; a picture is elements joined with c_at inside v:p_icture, which []S_HOW shows and the command line writes. Points are a 2-row matrix, x over y, as []P_ATH and Geometry3D's v:p_roject give them; y grows downward, as SVG's does. Attributes are text made by v:a_ttr, v:f_ill, v:s_troke and the transforms, so no program writes a quote mark or an angle bracket of its own. Names with l: are exported; the others are private to this file.
ˡa̲ttr : Char -> Char -> Char
An attribute: "id" ᵛa̲ttr "top" is id="top" (with its leading
space, so attributes join by c_at). The value is escaped.
ᵛ⁼u̲se< "Svg"
"id" ᵛa̲ttr "a&b" id="a&b"
ˡa̲ttr ← { name value → " " c̲at name c̲at "=\"" c̲at (ˡe̲scape value) c̲at "\"" }
ˡe̲scape : Char -> Char
Text with &, <, > and the quote mark escaped, as SVG needs it in attributes and text alike. Text with none of them is itself, found with one primitive test (most attribute values and titles are such, and a frame of the Rosetta stone escapes some hundreds of texts).
ᵛ⁼u̲se< "Svg"
ᵛe̲scape "a < b & c" a < b & c
ᵛe̲scape "ui-monospace, monospace" ui-monospace, monospace
t̲ally ᵛe̲scape "" 0
ˡe̲scape ← { t → 0 = '+ r̲/ t m̲ember? "&<>\"" ? t j̲oin 'e̲sc m̲ap t }
ˡr̲gb : Num a => a -> Char
A color from red, green and blue levels 0 to 255: ᵛr̲gb 40 80 120
is rgb(40,80,120); a level is rounded and kept in range.
ᵛ⁼u̲se< "Svg"
ᵛr̲gb 40 80.4 300 rgb(40,80,255)
ˡr̲gb ← { c → k ← 0 m̲ax 255 m̲in f̲loor 0.5 + f̲loat c "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 ")" }
ˡs̲troke : Char -> a -> Char
The stroke attributes: color ᵛs̲troke width, with round joins.
ᵛ⁼u̲se< "Svg"
"#333" ᵛs̲troke 1.5 stroke="#333" stroke-width="1.5" stroke-linejoin="round"
ˡs̲troke ← { color width → ("stroke" ˡa̲ttr color) c̲at ("stroke-width" ˡa̲ttr f̲ormat width) c̲at " stroke-linejoin=\"round\"" }
ˡp̲olygon : Char -> a -> Char
A polygon through the points (2 rows, x over y), closed, with the
given attributes: attrs ᵛp̲olygon points.
ᵛ⁼u̲se< "Svg"
(ᵛf̲ill "#ccc") ᵛp̲olygon 2 3 r̲eshape 0 10 20 0 10 0 <polygon points="0,0 10,10 20,0" fill="#ccc"/>
ˡp̲olygon ← { attrs points → "<polygon points=\"" c̲at (p̲airs points) c̲at "\"" c̲at attrs c̲at "/>" }
ˡp̲olyline : Char -> a -> Char
A polyline through the points, open: attrs ᵛp̲olyline points.
ᵛ⁼u̲se< "Svg"
((ᵛf̲ill "none") c̲at "#000" ᵛs̲troke 1) ᵛp̲olyline 2 2 r̲eshape 0 10 0 10 <polyline points="0,0 10,10" fill="none" stroke="#000" stroke-width="1" stroke-linejoin="round"/>
ˡp̲olyline ← { attrs points → "<polyline points=\"" c̲at (p̲airs points) c̲at "\"" c̲at attrs c̲at "/>" }
ˡa̲t : a -> Char
The position attributes of text: ᵛa̲t 12 30 is x="12" y="30".
ᵛ⁼u̲se< "Svg"
ᵛa̲t 12 30.5 x="12.0" y="30.5"
ˡa̲t ← { xy → ("x" ˡa̲ttr f̲ormat 1 s̲elect xy) c̲at "y" ˡa̲ttr f̲ormat 2 s̲elect xy }
ˡt̲ext : Char -> Char -> Char
Text with its attributes (v:a_t for where, and any others), escaped:
attrs ᵛt̲ext "the text".
ᵛ⁼u̲se< "Svg"
((ᵛa̲t 12 30) c̲at "font-size" ᵛa̲ttr "14") ᵛt̲ext "a < b" <text x="12" y="30" font-size="14">a < b</text>
ˡt̲ext ← { attrs t → "<text" c̲at attrs c̲at ">" c̲at (ˡe̲scape t) c̲at "</text>" }
ˡs̲pan : Char -> Char -> Char
A run of text in a color inside a text element: color ᵛs̲pan "text",
the text escaped; runs join with c_at into v:m_arkup.
ᵛ⁼u̲se< "Svg"
"#1f2937" ᵛs̲pan "a < b" <tspan fill="#1f2937">a < b</tspan>
ˡs̲pan ← { color t → "<tspan" c̲at (ˡf̲ill color) c̲at ">" c̲at (ˡe̲scape t) c̲at "</tspan>" }
ˡs̲ized : a -> Char -> Char
Markup at a font size of its own inside a text element, for a line
that must fit where a larger one would not: size ᵛs̲ized inner.
ᵛ⁼u̲se< "Svg"
0.05 ᵛs̲ized "red" ᵛs̲pan "a" <tspan font-size="0.05"><tspan fill="red">a</tspan></tspan>
ˡs̲ized ← { size inner → "<tspan" c̲at ("font-size" ˡa̲ttr f̲ormat size) c̲at ">" c̲at inner c̲at "</tspan>" }
ˡm̲arkup : Char -> Char -> Char
Text whose content is already markup (runs from v:s_pan, or escaped
text): attrs ᵛm̲arkup inner.
ᵛ⁼u̲se< "Svg"
(ᵛa̲t 1 2) ᵛm̲arkup ("red" ᵛs̲pan "a") c̲at "blue" ᵛs̲pan "b" <text x="1" y="2"><tspan fill="red">a</tspan><tspan fill="blue">b</tspan></text>
ˡm̲arkup ← { attrs inner → "<text" c̲at attrs c̲at ">" c̲at inner c̲at "</text>" }
ˡg̲roup : Char -> Char -> Char
A group of elements with attributes (a transform, a clip, a fill
for all): attrs ᵛg̲roup elements.
ᵛ⁼u̲se< "Svg"
(ᵛt̲ranslate 5 5) ᵛg̲roup (ᵛf̲ill "red") ᵛp̲olygon 2 3 r̲eshape 0 1 2 0 1 0 <g transform="translate(5 5)"><polygon points="0,0 1,1 2,0" fill="red"/></g>
ˡg̲roup ← { attrs elements → "<g" c̲at attrs c̲at ">" c̲at elements c̲at "</g>" }
ˡt̲ranslate : a -> Char
The transform attribute moving by dx and dy: ᵛt̲ranslate dx dy.
ᵛ⁼u̲se< "Svg"
ᵛt̲ranslate 5 -2.5 transform="translate(5.0 -2.5)"
ˡ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 ")" }
ˡr̲otate : a -> Char
The transform attribute turning by d degrees about the origin (clockwise on the screen, since y grows downward).
ᵛ⁼u̲se< "Svg"
ᵛr̲otate 90 transform="rotate(90)"
ˡr̲otate ← { d → "transform" ˡa̲ttr "rotate(" c̲at (f̲ormat d) c̲at ")" }
ˡm̲atrix : Num a => a -> Char
The transform attribute mapping the unit square onto a quadrilateral
given by three of its screen corners, top left, top right and bottom
left (an affine fit; the fourth corner follows): ᵛm̲atrix (2 3
r̲eshape ...), the corners as columns, x over y. Text drawn inside
it at unit coordinates lands on the face.
ᵛ⁼u̲se< "Svg"
ᵛm̲atrix 2 3 r̲eshape 10 30 10 20 20 40 transform="matrix(20 0 0 20 10 20)"
ˡm̲atrix ← { c → tl ← 1 s̲elect₂ c tr ← (2 s̲elect₂ c) − tl bl ← (3 s̲elect₂ c) − tl "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 ")" }
ˡc̲lip : Char -> a -> Char
A clip region named id, a polygon through the points, to put among
the picture's definitions; id ᵛc̲lipped elements then shows only
what falls inside it.
ᵛ⁼u̲se< "Svg"
"top" ᵛc̲lip 2 3 r̲eshape 0 10 20 0 10 0 <clipPath id="top"><polygon points="0,0 10,10 20,0"/></clipPath>
ˡc̲lip ← { id points → "<clipPath" c̲at ("id" ˡa̲ttr id) c̲at ">" c̲at ("" ˡp̲olygon points) c̲at "</clipPath>" }
ˡc̲lipped : Char -> Char -> Char
Elements shown only inside the clip region named id.
ᵛ⁼u̲se< "Svg"
"top" ᵛc̲lipped "<rect/>" <g clip-path="url(#top)"><rect/></g>
ˡc̲lipped ← { id elements → ("clip-path" ˡa̲ttr "url(#" c̲at id c̲at ")") ˡg̲roup elements }
ˡg̲radient : Char -> Box Char -> Char
A gradient named id from one color at the top to another at the
bottom, to put among the definitions; fill with "url(#id)".
ᵛ⁼u̲se< "Svg"
"sky" ᵛg̲radient "#fff" "#88f" <linearGradient id="sky" x1="0" y1="0" x2="0" y2="1"><stop offset="0" stop-color="#fff"/><stop offset="1" stop-color="#88f"/></linearGradient>
ˡg̲radient ← { id colors → top ← d̲isclose 1 s̲elect colors bottom ← d̲isclose 2 s̲elect colors "<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>" }
ˡp̲icture : a -> Char -> Char
The picture: w h ᵛp̲icture elements, with the definitions (clips,
gradients) first among the elements if any. The view is w by h with
the origin at the top left, and the picture scales to its place.
ᵛ⁼u̲se< "Svg"
20 10 ᵛp̲icture "" <svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 20 10" width="20" height="10" role="img"></svg>
ˡp̲icture ← { wh elements → w ← f̲ormat 1 s̲elect wh h ← f̲ormat 2 s̲elect wh "<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>" }
ˡp̲ictureWith : a -> Box Char -> Char
A picture whose definitions (clips, gradients) come first: w h
ᵛp̲ictureWith (defs◆ elements) is w h ᵛp̲icture <defs>defs<÷defs>
elements.
ᵛ⁼u̲se< "Svg"
2 2 ᵛp̲ictureWith "<clipPath/>" "<rect/>" <svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 2 2" width="2" height="2" role="img"><defs><clipPath/></defs><rect/></svg>
ˡ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 }
Private helpers
e̲sc : Char -> Char
e̲sc ← { c → c = f̲irst "&" ? "&"◆ c = f̲irst "<" ? "<"◆ c = f̲irst ">" ? ">"◆ c = f̲irst "\"" ? """◆ c }