mlib-svg.lmt /size: 138 Kb    last modification: 2023-12-21 09:44
1if not modules then modules = { } end modules ['mlib-svg'] = {
2    version   = 1.001,
3    optimize  = true,
4    comment   = "companion to mlib-ctx.mkiv",
5    author    = "Hans Hagen, PRAGMA-ADE, Hasselt NL",
6    copyright = "PRAGMA ADE / ConTeXt Development Team",
7    license   = "see context related readme files",
8}
9
10-- todo: svg stripper
11
12-- todo: check clip: what if larger than bbox
13
14-- todo: when opacity is 1 don't flush it
15
16-- Just a few notes:
17--
18-- There is no real need to boost performance here .. we can always make a fast
19-- variant when really needed. I will also do some of the todo's when I run into
20-- proper fonts. I need to optimize this a bit but will do that once I'm satisfied
21-- with the outcome and don't need more hooks and plugs. At some point I will
22-- optimize the MetaPost part because now we probably have more image wrapping
23-- than needed.
24--
25-- As usual with these standards, things like a path can be very compact while the
26-- rest is very verbose which defeats the point. This is a first attempt. There will
27-- be a converter to MP as well as directly to PDF. This module was made for one of
28-- the dangerous curves talks at the 2019 CTX meeting. I will do the font when I
29-- need it (not that hard).
30--
31-- The fact that in the more recent versions of SVG the older text related elements
32-- are depricated and not even supposed to be supported, combined with the fact that
33-- the text element assumes css styling, demonstrates that there is not so much as a
34-- standard. It basically means that whatever technology dominates at some point
35-- (probably combined with some libraries that at that point exist) determine what
36-- is standard. Anyway, it probably also means that these formats are not that
37-- suitable for long term archival purposes. So don't take the next implementation
38-- too serious. So in the end we now have (1) attributes for properties (which is
39-- nice and clean and what attributes are for, (2) a style attribute that needs to
40-- be parsed, (3) classes that map to styles and (4) element related styles, plus a
41-- kind of inheritance (given the limited number of elements sticking to only <g> as
42-- wrapper would have made much sense. Anyway, we need to deal with it. With all
43-- these style things going on, one can wonder where it will end. Basically svg
44-- became just a html element that way and less clean too. The same is true for
45-- tspan, which means that text itself is nested xml.
46--
47-- We can do a direct conversion to PDF but then we also loose the abstraction which
48-- in the future will be used, and for fonts we need to spawn out to TeX anyway, so
49-- the little overhead of calling MetaPost is okay I guess. Also, we want to
50-- overload labels, share fonts with the main document, etc. and are not aiming at a
51-- general purpose SVG converter. For going to PDF one can just use InkScape.
52--
53-- Written with Anne Clark on speakers as distraction.
54--
55-- Todo when I run into an example (but ony when needed and reasonable):
56--
57--   var(color,color)
58--   --color<decimal>
59--   currentColor : when i run into an example
60--   a bit more shading
61--   clip = [ auto | rect(llx,lly,urx,ury) ] (in svg)
62--   xlink url ... whatever
63--   masks
64--   opacity per group (i need to add that to metafun first, inefficient pdf but
65--   maybe filldraw can help here)
66--
67-- Maybe in metafun:
68--
69--   penciled    n     -> withpen pencircle scaled n
70--   applied     (...) -> transformed bymatrix (...)
71--   withopacity n     -> withtransparency (1,n)
72
73-- When testing mbo files:
74--
75--   empty paths
76--   missing control points
77--   funny fontnames like abcdefverdana etc
78--   paths representing glyphs but also with style specs
79--   all kind of attributes
80--   very weird and inefficient shading
81
82-- One can run into pretty crazy images, like lines that are fills being clipped
83-- to some width. That's the danger of hiding yourself behind an interface I guess.
84--
85-- One would expect official examples to sort of follow the structure guideline,
86-- like putting gradient definitions in a "defs" element but forget about it ...
87-- structure seems not to be important (one can even wonder why "defs" is there at
88-- all). In the end all these systems (tex macro packages included) end up as a
89-- mess simply because conceptually wrong input gets accepted as normal. A side
90-- effect is that one starts to get a disliking. Anyway, at sime point I can just
91-- simplify some code because ugliness is part of the game.
92
93local rawget, rawset, type, tonumber, tostring, next, setmetatable = rawget, rawset, type, tonumber, tostring, next, setmetatable
94
95local P, S, R, C, Ct, Cs, Cc, Cp, Cg, Cf, Carg = lpeg.P, lpeg.S, lpeg.R, lpeg.C, lpeg.Ct, lpeg.Cs, lpeg.Cc, lpeg.Cp, lpeg.Cg, lpeg.Cf, lpeg.Carg
96
97local lpegmatch, lpegpatterns = lpeg.match, lpeg.patterns
98local sqrt, abs = math.sqrt, math.abs
99local concat, setmetatableindex, sortedhash = table.concat, table.setmetatableindex, table.sortedhash
100local gmatch, gsub, find, match = string.gmatch, string.gsub, string.find, string.match
101local formatters, fullstrip = string.formatters, string.fullstrip
102local utfsplit, utfbyte = utf.split, utf.byte
103
104local xmlconvert, xmlcollected, xmlcount, xmlfirst, xmlroot = xml.convert, xml.collected, xml.count, xml.first, xml.root
105local xmltext, xmltextonly = xml.text, xml.textonly
106local css = xml.css or { } -- testing
107
108local function xmlinheritattributes(c,pa)
109    if not c.special then
110        local at = c.at
111        local dt = c.dt
112        if at and dt then
113            if pa then
114                setmetatableindex(at,pa)
115            end
116            for i=1,#dt do
117                local dti = dt[i]
118                if type(dti) == "table" then
119                    xmlinheritattributes(dti,at)
120                end
121            end
122        end
123    end
124end
125
126xml.inheritattributes = xmlinheritattributes
127
128-- Maybe some day helpers will move to the metapost.svg namespace!
129
130metapost       = metapost or { }
131local metapost = metapost
132local context  = context
133
134local report       = logs.reporter("metapost","svg")
135
136local trace        = false  trackers.register("metapost.svg",        function(v) trace        = v end)
137local trace_text   = false  trackers.register("metapost.svg.text",   function(v) trace_text   = v end)
138local trace_path   = false  trackers.register("metapost.svg.path",   function(v) trace_path   = v end)
139local trace_result = false  trackers.register("metapost.svg.result", function(v) trace_result = v end)
140local trace_colors = false  trackers.register("metapost.svg.colors", function(v) trace_colors = v end)
141local trace_fonts  = false  trackers.register("metapost.svg.fonts",  function(v) trace_fonts  = v end)
142
143-- This is just an experiment. Todo: reset hash etc. Also implement an option handler.
144
145local s_draw_image_start <const> = "draw image ("
146local s_draw_image_stop  <const> = ") ;"
147
148local ignoredopacity = 1
149
150local svghash = false  do
151
152    local svglast = 0
153    local svglist = false
154
155    local function checkhash(t,k)
156        local n = svglast + 1
157        svglast = n
158        svglist[n] = k
159        t[k] = n
160        return n
161    end
162
163    function metapost.startsvghashing()
164        svglast = 0
165        svglist = { }
166        svghash = setmetatableindex(checkhash)
167    end
168
169    function metapost.stopsvghashing()
170        svglast = 0
171        svglist = false
172        svghash = false
173    end
174
175    interfaces.implement {
176        name      = "svghashed",
177        arguments = "integer",
178        actions   = function(n)
179            local t = svglist and svglist[n]
180            if t then
181                context(t)
182            end
183        end
184    }
185
186end
187
188-- We have quite some closures because otherwise we run into the local variable
189-- limitations. It doesn't always look pretty now, sorry. I'll clean up this mess
190-- some day (the usual nth iteration of code).
191--
192-- Most of the conversion is rather trivial code till I ran into a file with arcs. A
193-- bit of searching lead to the a2c javascript function but it has some puzzling
194-- thingies (like sin and cos definitions that look like leftovers and possible
195-- division by zero). Anyway, we can if needed optimize it a bit more. Here does it
196-- come from:
197
198-- http://www.w3.org/TR/SVG11/implnote.html#ArcImplementationNotes
199-- https://github.com/adobe-webplatform/Snap.svg/blob/b242f49e6798ac297a3dad0dfb03c0893e394464/src/path.js
200
201local a2c  do
202
203    local pi, sin, cos, tan, asin, abs = math.pi, math.sin, math.cos, math.tan, math.asin, math.abs
204
205    local d120 = (pi * 120) / 180
206    local pi2  = 2 * pi
207
208    a2c = function(x1, y1, rx, ry, angle, large, sweep, x2, y2, f1, f2, cx, cy)
209
210        if (rx == 0 or ry == 0) or (x1 == x2 and y1 == y2) then
211            return { x1, y1, x2, y2, x2, y2 }
212        end
213
214        local recursive = f1
215        local rad       = pi / 180 * angle
216        local res       = nil
217        local cosrad    = cos(-rad) -- local cosrad = cosd(angle)
218        local sinrad    = sin(-rad) -- local sinrad = sind(angle)
219
220        if not recursive then
221
222            x1, y1 = x1 * cosrad - y1 * sinrad, x1 * sinrad + y1 * cosrad
223            x2, y2 = x2 * cosrad - y2 * sinrad, x2 * sinrad + y2 * cosrad
224
225            local x  = (x1 - x2) / 2
226            local y  = (y1 - y2) / 2
227            local xx = x * x
228            local yy = y * y
229            local h  = xx / (rx * rx) + yy / (ry * ry)
230
231            if h > 1 then
232                h  = sqrt(h)
233                rx = h * rx
234                ry = h * ry
235            end
236
237            local rx2   = rx * rx
238            local ry2   = ry * ry
239            local ry2xx = ry2 * xx
240            local rx2yy = rx2 * yy
241            local total = rx2yy + ry2xx -- otherwise overflow
242
243            local k     = total == 0 and 0 or sqrt(abs((rx2 * ry2 - rx2yy - ry2xx) / total))
244
245            if large == sweep then
246                k = -k
247            end
248
249            cx = k *  rx * y / ry + (x1 + x2) / 2
250            cy = k * -ry * x / rx + (y1 + y2) / 2
251
252            f1 = (y1 - cy) / ry -- otherwise crash on a tiny eps
253            f2 = (y2 - cy) / ry -- otherwise crash on a tiny eps
254
255            f1 = asin((f1 < -1.0 and -1.0) or (f1 > 1.0 and 1.0) or f1)
256            f2 = asin((f2 < -1.0 and -1.0) or (f2 > 1.0 and 1.0) or f2)
257
258            if x1 < cx then f1 = pi  - f1 end
259            if x2 < cx then f2 = pi  - f2 end
260
261            if f1 < 0  then f1 = pi2 + f1 end
262            if f2 < 0  then f2 = pi2 + f2 end
263
264            if sweep ~= 0 and f1 > f2 then f1 = f1 - pi2 end
265            if sweep == 0 and f2 > f1 then f2 = f2 - pi2 end
266
267        end
268
269        if abs(f2 - f1) > d120 then
270            local f2old = f2
271            local x2old = x2
272            local y2old = y2
273            f2 = f1 + d120 * ((sweep ~= 0 and f2 > f1) and 1 or -1)
274            x2 = cx + rx * cos(f2)
275            y2 = cy + ry * sin(f2)
276            res = a2c(x2, y2, rx, ry, angle, 0, sweep, x2old, y2old, f2, f2old, cx, cy)
277        end
278
279        local c1 = cos(f1)
280        local s1 = sin(f1)
281        local c2 = cos(f2)
282        local s2 = sin(f2)
283
284        local t  = tan((f2 - f1) / 4)
285        local hx = 4 * rx * t / 3
286        local hy = 4 * ry * t / 3
287
288        local r = { x1 - hx * s1, y1 + hy * c1, x2 + hx * s2, y2 - hy * c2, x2, y2, unpack(res or { }) }
289
290        if not recursive then -- we can also check for sin/cos being 0/1
291            cosrad = cos(rad)
292            sinrad = sin(rad)
293         -- cosrad = cosd(angle)
294         -- sinrad = sind(angle)
295            for i0=1,#r,2 do
296                local i1 = i0 + 1
297                local x  = r[i0]
298                local y  = r[i1]
299                r[i0] = x * cosrad - y * sinrad
300                r[i1] = x * sinrad + y * cosrad
301            end
302        end
303
304        return r
305    end
306
307end
308
309-- We share some patterns.
310
311local p_digit    = lpegpatterns.digit
312local p_hexdigit = lpegpatterns.hexdigit
313local p_space    = lpegpatterns.whitespace
314
315local factors = {
316    ["pt"] =  1.25,
317    ["mm"] =  3.543307,
318    ["cm"] = 35.43307,
319    ["px"] =  1,
320    ["pc"] = 15,
321    ["in"] = 90,
322    ["em"] = 12 * 1.25,
323    ["ex"] =  8 * 1.25,
324    ["%"]  =  0.1,
325    ["bp"] =  1,
326}
327
328metapost.svgfactors = factors
329
330local percentage_r = 1/100
331local percentage_x = percentage_r
332local percentage_y = percentage_r
333
334local asnumber, asnumber_r, asnumber_x, asnumber_y, asnumber_vx, asnumber_vy
335local asnumber_vx_t, asnumber_vy_t
336local p_number, p_separator, p_optseparator, p_numbers, p_fournumbers, p_path
337local p_number_n, p_number_x, p_number_vx, p_number_y, p_number_vy, p_number_r
338
339do
340
341    -- incredible: we can find .123.456 => 0.123 0.456 ...
342
343    local p_command_x  = C(S("Hh"))
344    local p_command_y  = C(S("Vv"))
345    local p_command_xy = C(S("CcLlMmQqSsTt"))
346    local p_command_a  = C(S("Aa"))
347    local p_command    = C(S("Zz"))
348
349    p_optseparator = S("\t\n\r ,")^0
350    p_separator    = S("\t\n\r ,")^1
351    p_number       = (S("+-")^0 * (p_digit^0 * P(".") * p_digit^1 + p_digit^1 * P(".") + p_digit^1))
352                   * (P("e") * S("+-")^0 * p_digit^1)^-1
353
354    local function convert   (n)   n =   tonumber(n)                                                                           return n     end
355    local function convert_p (n,u) n =   tonumber(n) if u == true then return n / 100                                     else return n end end
356    local function convert_r (n,u) n =   tonumber(n) if u == true then return percentage_r * n elseif u then return u * n else return n end end
357    local function convert_x (n,u) n =   tonumber(n) if u == true then return percentage_x * n elseif u then return u * n else return n end end
358    local function convert_y (n,u) n =   tonumber(n) if u == true then return percentage_y * n elseif u then return u * n else return n end end
359    local function convert_vx(n,u) n =   tonumber(n) if u == true then return percentage_x * n elseif u then return u * n else return n end end
360    local function convert_vy(n,u) n = - tonumber(n) if u == true then return percentage_y * n elseif u then return u * n else return n end end
361
362    local p_unit      = (P("p") * S("txc") + P("e") * S("xm") + S("mc") * P("m") + P("in")) / factors
363    local p_percent   = P("%") * Cc(true)
364
365    local c_number_n  = C(p_number)
366    local c_number_u  = C(p_number) * (p_percent + p_unit)^-1
367
368    p_number_n  = c_number_n / convert
369    p_number_u  = c_number_u / convert
370    p_number_x  = c_number_u / convert_x
371    p_number_vx = c_number_u / convert_vx
372    p_number_y  = c_number_u / convert_y
373    p_number_vy = c_number_u / convert_vy
374    p_number_r  = c_number_u / convert_r
375    p_number_p  = c_number_u / convert_p
376
377    asnumber    = function(s) return s and lpegmatch(p_number,   s) or 0 end
378    asnumber_r  = function(s) return s and lpegmatch(p_number_r, s) or 0 end
379    asnumber_p  = function(s) return s and lpegmatch(p_number_p, s) or 0 end
380    asnumber_x  = function(s) return s and lpegmatch(p_number_x, s) or 0 end
381    asnumber_y  = function(s) return s and lpegmatch(p_number_y, s) or 0 end
382    asnumber_vx = function(s) return s and lpegmatch(p_number_vx,s) or 0 end
383    asnumber_vy = function(s) return s and lpegmatch(p_number_vy,s) or 0 end
384
385    local p_number_vx_t = Ct { (p_number_vx + p_separator)^1 }
386    local p_number_vy_t = Ct { (p_number_vy + p_separator)^1 }
387
388    local zerotable = { 0 }
389
390    asnumber_vx_t = function(s) return s and lpegmatch(p_number_vx_t,s) or zerotable end
391    asnumber_vy_t = function(s) return s and lpegmatch(p_number_vy_t,s) or zerotable end
392
393--     local p_numbersep   = p_number_n + p_separator
394    local p_numbersep   = p_number_u + p_separator
395          p_numbers     = p_optseparator * P("(") * p_numbersep^0 * p_optseparator * P(")")
396          p_fournumbers = p_numbersep^4
397          p_path        = Ct ( (
398          p_command_xy * (p_optseparator * p_number_vx *
399                          p_optseparator * p_number_vy )^1
400        + p_command_x  * (p_optseparator * p_number_vx )^1
401        + p_command_y  * (p_optseparator * p_number_vy )^1
402        + p_command_a  * (p_optseparator * p_number_vx *
403                          p_optseparator * p_number_vy *
404                          p_optseparator * p_number_r  *
405                          p_optseparator * p_number_n  * -- flags
406                          p_optseparator * p_number_n  * -- flags
407                          p_optseparator * p_number_vx *
408                          p_optseparator * p_number_vy )^1
409        + p_command
410        + p_separator
411    )^1 )
412
413
414end
415
416-- We can actually use the svg color definitions from the tex end but maybe a user
417-- doesn't want those replace the normal definitions.
418--
419-- local hexhash  = setmetatableindex(function(t,k) local v = lpegmatch(p_hexcolor, k) t[k] = v return v end)  -- per file
420-- local hexhash3 = setmetatableindex(function(t,k) local v = lpegmatch(p_hexcolor3,k) t[k] = v return v end)  -- per file
421--
422-- local function hexcolor (c) return hexhash [c] end -- directly do hexhash [c]
423-- local function hexcolor3(c) return hexhash3[c] end -- directly do hexhash3[c]
424
425local colormap  = false
426
427local function prepared(t)
428    if type(t) == "table" then
429        local mapping = t.mapping or { }
430        local mapper  = t.mapper
431        local colormap = setmetatableindex(mapping)
432        if mapper then
433            setmetatableindex(colormap,function(t,k)
434                local v = mapper(k)
435                t[k] = v or k
436                return v
437            end)
438        end
439        return colormap
440    else
441        return false
442    end
443end
444
445local colormaps = setmetatableindex(function(t,k)
446    local v = false
447    if type(k) == "string" then
448        v = prepared(table.load(k)) -- todo: same path as svg file
449    elseif type(k) == "table" then
450        v = prepared(k)
451        k = k.name or k
452    end
453    t[k] = v
454    return v
455end)
456
457function metapost.svgcolorremapper(colormap)
458    return colormaps[colormap]
459end
460
461-- todo: cache colors per image / remapper
462
463local colorcomponents, withcolor, thecolor, usedcolors  do
464
465    local svgcolors = {
466        aliceblue       = 0xF0F8FF, antiquewhite      = 0xFAEBD7, aqua                  = 0x00FFFF, aquamarine       = 0x7FFFD4,
467        azure           = 0xF0FFFF, beige             = 0xF5F5DC, bisque                = 0xFFE4C4, black            = 0x000000,
468        blanchedalmond  = 0xFFEBCD, blue              = 0x0000FF, blueviolet            = 0x8A2BE2, brown            = 0xA52A2A,
469        burlywood       = 0xDEB887, cadetblue         = 0x5F9EA0, hartreuse             = 0x7FFF00, chocolate        = 0xD2691E,
470        coral           = 0xFF7F50, cornflowerblue    = 0x6495ED, cornsilk              = 0xFFF8DC, crimson          = 0xDC143C,
471        cyan            = 0x00FFFF, darkblue          = 0x00008B, darkcyan              = 0x008B8B, darkgoldenrod    = 0xB8860B,
472        darkgray        = 0xA9A9A9, darkgreen         = 0x006400, darkgrey              = 0xA9A9A9, darkkhaki        = 0xBDB76B,
473        darkmagenta     = 0x8B008B, darkolivegreen    = 0x556B2F, darkorange            = 0xFF8C00, darkorchid       = 0x9932CC,
474        darkred         = 0x8B0000, darksalmon        = 0xE9967A, darkseagreen          = 0x8FBC8F, darkslateblue    = 0x483D8B,
475        darkslategray   = 0x2F4F4F, darkslategrey     = 0x2F4F4F, darkturquoise         = 0x00CED1, darkviolet       = 0x9400D3,
476        deeppink        = 0xFF1493, deepskyblue       = 0x00BFFF, dimgray               = 0x696969, dimgrey          = 0x696969,
477        dodgerblue      = 0x1E90FF, firebrick         = 0xB22222, floralwhite           = 0xFFFAF0, forestgreen      = 0x228B22,
478        fuchsia         = 0xFF00FF, gainsboro         = 0xDCDCDC, ghostwhite            = 0xF8F8FF, gold             = 0xFFD700,
479        goldenrod       = 0xDAA520, gray              = 0x808080, green                 = 0x008000, greenyellow      = 0xADFF2F,
480        grey            = 0x808080, honeydew          = 0xF0FFF0, hotpink               = 0xFF69B4, indianred        = 0xCD5C5C,
481        indigo          = 0x4B0082, ivory             = 0xFFFFF0, khaki                 = 0xF0E68C, lavender         = 0xE6E6FA,
482        lavenderblush   = 0xFFF0F5, lawngreen         = 0x7CFC00, lemonchiffon          = 0xFFFACD, lightblue        = 0xADD8E6,
483        lightcoral      = 0xF08080, lightcyan         = 0xE0FFFF, lightgoldenrodyellow  = 0xFAFAD2, lightgray        = 0xD3D3D3,
484        lightgreen      = 0x90EE90, lightgrey         = 0xD3D3D3, lightpink             = 0xFFB6C1, lightsalmon      = 0xFFA07A,
485        lightseagreen   = 0x20B2AA, lightskyblue      = 0x87CEFA, lightslategray        = 0x778899, lightslategrey   = 0x778899,
486        lightsteelblue  = 0xB0C4DE, lightyellow       = 0xFFFFE0, lime                  = 0x00FF00, limegreen        = 0x32CD32,
487        linen           = 0xFAF0E6, magenta           = 0xFF00FF, maroon                = 0x800000, mediumaquamarine = 0x66CDAA,
488        mediumblue      = 0x0000CD, mediumorchid      = 0xBA55D3, mediumpurple          = 0x9370DB, mediumseagreen   = 0x3CB371,
489        mediumslateblue = 0x7B68EE, mediumspringgreen = 0x00FA9A, mediumturquoise       = 0x48D1CC, mediumvioletred  = 0xC71585,
490        midnightblue    = 0x191970, mintcream         = 0xF5FFFA, mistyrose             = 0xFFE4E1, moccasin         = 0xFFE4B5,
491        navajowhite     = 0xFFDEAD, navy              = 0x000080, oldlace               = 0xFDF5E6, olive            = 0x808000,
492        olivedrab       = 0x6B8E23, orange            = 0xFFA500, orangered             = 0xFF4500, orchid           = 0xDA70D6,
493        palegoldenrod   = 0xEEE8AA, palegreen         = 0x98FB98, paleturquoise         = 0xAFEEEE, palevioletred    = 0xDB7093,
494        papayawhip      = 0xFFEFD5, peachpuff         = 0xFFDAB9, peru                  = 0xCD853F, pink             = 0xFFC0CB,
495        plum            = 0xDDA0DD, powderblue        = 0xB0E0E6, purple                = 0x800080, red              = 0xFF0000,
496        rosybrown       = 0xBC8F8F, royalblue         = 0x4169E1, saddlebrown           = 0x8B4513, salmon           = 0xFA8072,
497        sandybrown      = 0xF4A460, seagreen          = 0x2E8B57, seashell              = 0xFFF5EE, sienna           = 0xA0522D,
498        silver          = 0xC0C0C0, skyblue           = 0x87CEEB, slateblue             = 0x6A5ACD, slategray        = 0x708090,
499        slategrey       = 0x708090, snow              = 0xFFFAFA, springgreen           = 0x00FF7F, steelblue        = 0x4682B4,
500        tan             = 0xD2B48C, teal              = 0x008080, thistle               = 0xD8BFD8, tomato           = 0xFF6347,
501        turquoise       = 0x40E0D0, violet            = 0xEE82EE, wheat                 = 0xF5DEB3, white            = 0xFFFFFF,
502        whitesmoke      = 0xF5F5F5, yellow            = 0xFFFF00, yellowgreen           = 0x9ACD32,
503    }
504
505    local f_rgb      = formatters['    withcolor svgcolor(%.3N,%.3N,%.3N)']
506    local f_cmyk     = formatters['    withcolor svgcmyk(%.3N,%.3N,%.3N,%.3N)']
507    local f_gray     = formatters['    withcolor svggray(%.3N)']
508    local f_rgba     = formatters['    withcolor svgcolor(%.3N,%.3N,%.3N) withopacity %.3N']
509    local f_graya    = formatters['    withcolor svggray(%.3N) withopacity %.3N']
510    local f_name     = formatters['    withcolor "%s"']
511    local f_svgrgb   = formatters['svgcolor(%.3N,%.3N,%.3N)']
512    local f_svgcmyk  = formatters['svgcmyk(%.3N,%.3N,%.3N,%.3N)']
513    local f_svggray  = formatters['svggray(%.3N)']
514    local f_svgname  = formatters['"%s"']
515
516    local triplets = setmetatableindex(function(t,k)
517        -- we delay building all these strings
518        local v = svgcolors[k]
519        if v then
520            v = { ((v>>16)&0xFF)/0xFF, ((v>>8)&0xFF)/0xFF, ((v>>0)&0xFF)/0xFF }
521        else
522            v = false
523        end
524        t[k] = v
525        return v
526    end)
527
528    local p_fraction  = C(p_number) * C("%")^-1  / function(a,b) return tonumber(a) / (b and 100 or 255) end
529    local p_angle     = C(p_number) * P("deg")^0 / function(a)   return tonumber(a) end
530    local p_percent   = C(p_number) * P("%")     / function(a)   return tonumber(a) / 100 end
531    local p_absolute  = C(p_number)              / tonumber
532
533    local p_left      = P("(")
534    local p_right     = P(")")
535    local p_a         = P("a")^-1
536    local p_r_a_color = p_left
537                      * (p_fraction * p_separator^-1)^-3
538                      * p_absolute^0
539                      * p_right
540    local p_c_k_color = p_left
541                      * (p_absolute + p_separator^-1)^-4
542                      * p_right
543    local p_h_a_color = p_left
544                      * p_angle
545                      * p_separator   * p_percent
546                      * p_separator   * p_percent
547                      * p_separator^0 * p_absolute^0
548                      * p_right
549
550    local colors      = attributes.colors
551    local colorvalues = colors.values
552    local colorindex  = attributes.list[attributes.private('color')]
553    local hsvtorgb    = colors.hsvtorgb
554    local hwbtorgb    = colors.hwbtorgb
555    local forcedmodel = colors.forcedmodel
556
557    local p_splitcolor = -- offet lowercase ff
558        P("#") * C(p_hexdigit*p_hexdigit)^1 / function(r,g,b)
559            if not r then
560                return "gray", 0
561            elseif not (g and b) then
562                return "gray",
563                    (r == "00" and 0) or (r == "ff" and 1) or (tonumber(r,16)/255)
564            else
565                return "rgb",
566                    (r == "00" and 0) or (r == "ff" and 1) or (tonumber(r,16)/255),
567                    (g == "00" and 0) or (g == "ff" and 1) or (tonumber(g,16)/255),
568                    (b == "00" and 0) or (b == "ff" and 1) or (tonumber(b,16)/255)
569            end
570        end
571      + P("rgb") * p_a
572      * p_r_a_color / function(r,g,b,a)
573            return "rgb", r or 0, g or 0, b or 0, a or false
574        end
575      + P("cmyk")
576      * p_c_k_color / function(c,m,y,k)
577            return "cmyk", c or 0, m or 0, y or 0, k or 0
578        end
579      + P("hsl") * p_a
580      * p_h_a_color / function(h,s,l,a)
581            local r, g, b = hsvtorgb(h,s,l,a)
582            return "rgb", r or 0, g or 0, b or 0, a or false
583        end
584      + P("hwb") * p_a
585      * p_h_a_color / function(h,w,b,a)
586            local r, g, b = hwbtorgb(h,w,b)
587            return "rgb", r or 0, g or 0, b or 0, a or false
588        end
589
590    function metapost.svgsplitcolor(color)
591        if type(color) == "string" then
592            local what, s1, s2, s3, s4 = lpegmatch(p_splitcolor,color)
593            if not what then
594                local t = triplets[color]
595                if t then
596                    what, s1, s2, s3 = "rgb", t[1], t[2], t[3]
597                end
598            end
599            return what, s1, s2, s3, s4
600        else
601            return "gray", 0, false
602        end
603    end
604
605    local function registeredcolor(name)
606        local color = colorindex[name]
607        if color then
608            local v = colorvalues[color]
609            local t = forcedmodel(v[1])
610            if t == 2 then
611                return "gray", v[2]
612            elseif t == 3 then
613                return "rgb", v[3], v[4], v[5]
614            elseif t == 4 then
615                return "cmyk", v[6], v[7], v[8], v[9]
616            else
617                --
618            end
619        end
620    end
621
622    -- we can have a fast check for #000000
623
624    local function validcolor(color)
625        if usedcolors then
626            usedcolors[color] = usedcolors[color] + 1
627        end
628        if colormap then
629            local c = colormap[color]
630            local t = type(c)
631            if t == "table" then
632                local what = t[1]
633                if what == "rgb" then
634                    return
635                        what,
636                        tonumber(t[2]) or 0,
637                        tonumber(t[3]) or 0,
638                        tonumber(t[4]) or 0,
639                        tonumber(t[5]) or false
640                elseif what == "cmyk" then
641                    return
642                        what,
643                        tonumber(t[2]) or 0,
644                        tonumber(t[3]) or 0,
645                        tonumber(t[4]) or 0,
646                        tonumber(t[5]) or 0
647                elseif what == "gray" then
648                    return
649                        what,
650                        tonumber(t[2]) or 0,
651                        tonumber(t[3]) or false
652                end
653            elseif t == "string" then
654                color = c
655            end
656        end
657        if color == "#000000" then
658            return "rgb", 0, 0, 0
659        elseif color == "#ffffff" then
660            return "rgb", 1, 1, 1
661        else
662            local what, s1, s2, s3, s4 = registeredcolor(color)
663            if not what then
664                what, s1, s2, s3, s4 = lpegmatch(p_splitcolor,color)
665                -- we could cache
666                if not what then
667                    local t = triplets[color]
668                    if t then
669                        s1, s2, s3 = t[1], t[2], t[3]
670                        what = "rgb"
671                    end
672                end
673            end
674            return what, s1, s2, s3, s4
675        end
676    end
677
678    colorcomponents = function(color)
679        local what, s1, s2, s3, s4 = validcolor(color)
680        return s1, s2, s3, s4 -- so 4 means cmyk
681    end
682
683    withcolor = function(color)
684        local what, s1, s2, s3, s4 = validcolor(color)
685        if what == "rgb" then
686            if s4 then
687                if s1 == s2 and s1 == s3 then
688                    return f_graya(s1,s4)
689                else
690                    return f_rgba(s1,s2,s3,s4)
691                end
692            else
693                if s1 == s2 and s1 == s3 then
694                    return f_gray(s1)
695                else
696                    return f_rgb(s1,s2,s3)
697                end
698            end
699        elseif what == "cmyk" then
700            return f_cmyk(s1,s2,s3,s4)
701        elseif what == "gray" then
702            if s2 then
703                return f_graya(s1,s2)
704            else
705                return f_gray(s1)
706            end
707        end
708        return f_name(color)
709    end
710
711    thecolor = function(color)
712        local what, s1, s2, s3, s4 = validcolor(color)
713        if what == "rgb" then
714            if s4 then
715                if s1 == s2 and s1 == s3 then
716                    return f_svggraya(s1,s4)
717                else
718                    return f_svgrgba(s1,s2,s3,s4)
719                end
720            else
721                if s1 == s2 and s1 == s3 then
722                    return f_svggray(s1)
723                else
724                    return f_svgrgb(s1,s2,s3)
725                end
726            end
727        elseif what == "cmyk" then
728            return f_cmyk(s1,s2,s3,s4)
729        elseif what == "gray" then
730            if s2 then
731                return f_svggraya(s1,s2)
732            else
733                return f_svggray(s1)
734            end
735        end
736        return f_svgname(color)
737    end
738
739end
740
741-- actually we can loop faster because we can go to the last one
742
743local grabpath, grablist  do
744
745    local f_moveto    = formatters['(%N,%N)']
746    local f_curveto_z = formatters['controls(%N,%N)and(%N,%N)..(%N,%N)']
747    local f_curveto_n = formatters['..controls(%N,%N)and(%N,%N)..(%N,%N)']
748    local f_lineto_z  = formatters['(%N,%N)']
749    local f_lineto_n  = formatters['--(%N,%N)']
750
751    local m = { __index = function() return 0 end }
752
753 -- local t      = { }    -- no real saving here if we share
754 -- local n      = 0
755
756    grabpath = function(str)
757        local p   = lpegmatch(p_path,str) or { }
758        local np  = #p
759        local all = { entries = np, closed = false, curve = false }
760        if np == 0 then
761            return all
762        end
763        setmetatable(p,m)
764        local t      = { }    -- no real saving here if we share
765        local n      = 0
766     -- n = 0
767        local a      = 0
768        local i      = 0
769        local last   = "M"
770        local prev   = last
771        local kind   = "L"
772        local x, y   = 0, 0
773        local x1, y1 = 0, 0
774        local x2, y2 = 0, 0
775        local rx, ry = 0, 0
776        local ar, al = 0, 0
777        local as, ac = 0, nil
778        local mx, my = 0, 0
779        while i < np do
780            i = i + 1
781            local pi = p[i]
782            if type(pi) ~= "number" then
783                last = pi
784                i    = i + 1
785                pi   = p[i]
786            end
787            -- most often
788            if last == "c" then
789                            x1 = x + pi
790                i = i + 1 ; y1 = y + p[i]
791                i = i + 1 ; x2 = x + p[i]
792                i = i + 1 ; y2 = y + p[i]
793                i = i + 1 ; x  = x + p[i]
794                i = i + 1 ; y  = y + p[i]
795                goto curveto
796            elseif last == "l" then
797                            x = x + pi
798                i = i + 1 ; y = y + p[i]
799                goto lineto
800            elseif last == "h" then
801                x = x + pi
802                goto lineto
803            elseif last == "v" then
804                y = y + pi
805                goto lineto
806            elseif last == "a" then
807                            x1 =     x
808                            y1 =     y
809                            rx =     pi
810                i = i + 1 ; ry =     p[i]
811                i = i + 1 ; ar =     p[i]
812                i = i + 1 ; al =     p[i]
813                i = i + 1 ; as =     p[i]
814                i = i + 1 ; x  = x + p[i]
815                i = i + 1 ; y  = y + p[i]
816                goto arc
817            elseif last == "s" then
818                if prev == "C" then
819                    x1 = 2 * x - x2
820                    y1 = 2 * y - y2
821                else
822                    x1 = x
823                    y1 = y
824                end
825                            x2 = x + pi
826                i = i + 1 ; y2 = y + p[i]
827                i = i + 1 ; x  = x + p[i]
828                i = i + 1 ; y  = y + p[i]
829                goto curveto
830            elseif last == "m" then
831                if n > 0 then
832                    a = a + 1 ; all[a] = concat(t,"",1,n) ; n = 0
833                end
834                            x = x + pi
835                i = i + 1 ; y = y + p[i]
836                goto moveto
837            elseif last == "z" then
838                goto close
839            -- less frequent
840            elseif last == "C" then
841                            x1 = pi
842                i = i + 1 ; y1 = p[i]
843                i = i + 1 ; x2 = p[i]
844                i = i + 1 ; y2 = p[i]
845                i = i + 1 ; x  = p[i]
846                i = i + 1 ; y  = p[i]
847                goto curveto
848            elseif last == "L" then
849                            x = pi
850                i = i + 1 ; y = p[i]
851                goto lineto
852            elseif last == "H" then
853                x = pi
854                goto lineto
855            elseif last == "V" then
856                y = pi
857                goto lineto
858            elseif last == "A" then
859                            x1 = x
860                            y1 = y
861                            rx = pi
862                i = i + 1 ; ry = p[i]
863                i = i + 1 ; ar = p[i]
864                i = i + 1 ; al = p[i]
865                i = i + 1 ; as = p[i]
866                i = i + 1 ; x  = p[i]
867                i = i + 1 ; y  = p[i]
868                goto arc
869            elseif last == "S" then
870                if prev == "C" then
871                    x1 = 2 * x - x2
872                    y1 = 2 * y - y2
873                else
874                    x1 = x
875                    y1 = y
876                end
877                            x2 = pi
878                i = i + 1 ; y2 = p[i]
879                i = i + 1 ; x  = p[i]
880                i = i + 1 ; y  = p[i]
881                goto curveto
882            elseif last == "M" then
883                if n > 0 then
884                    a = a + 1 ; all[a] = concat(t,"",1,n) ; n = 0
885                end
886                            x = pi ;
887                i = i + 1 ; y = p[i]
888                goto moveto
889            elseif last == "Z" then
890                goto close
891            -- very seldom
892            elseif last == "q" then
893                            x1 = x + pi
894                i = i + 1 ; y1 = y + p[i]
895                i = i + 1 ; x2 = x + p[i]
896                i = i + 1 ; y2 = y + p[i]
897                goto quadratic
898            elseif last == "t" then
899                if prev == "C" then
900                    x1 = 2 * x - x1
901                    y1 = 2 * y - y1
902                else
903                    x1 = x
904                    y1 = y
905                end
906                            x2 = x + pi
907                i = i + 1 ; y2 = y + p[i]
908                goto quadratic
909            elseif last == "Q" then
910                            x1 = pi
911                i = i + 1 ; y1 = p[i]
912                i = i + 1 ; x2 = p[i]
913                i = i + 1 ; y2 = p[i]
914                goto quadratic
915            elseif last == "T" then
916                if prev == "C" then
917                    x1 = 2 * x - x1
918                    y1 = 2 * y - y1
919                else
920                    x1 = x
921                    y1 = y
922                end
923                            x2 = pi
924                i = i + 1 ; y2 = p[i]
925                goto quadratic
926            else
927                goto continue
928            end
929            ::moveto::
930                n = n + 1 ; t[n] = f_moveto(x,y)
931                last = last == "M" and "L" or "l"
932                prev = "M"
933                mx = x
934                my = y
935                goto continue
936            ::lineto::
937                n = n + 1 ; t[n] = (n > 0 and f_lineto_n or f_lineto_z)(x,y)
938                prev = "L"
939                goto continue
940            ::curveto::
941                n = n + 1 ; t[n] = (n > 0 and f_curveto_n or f_curveto_z)(x1,y1,x2,y2,x,y)
942                prev = "C"
943                goto continue
944            ::arc::
945                ac = a2c(x1,y1,rx,ry,ar,al,as,x,y)
946                for i=1,#ac,6 do
947                    n = n + 1 ; t[n] = (n > 0 and f_curveto_n or f_curveto_z)(
948                        ac[i],ac[i+1],ac[i+2],ac[i+3],ac[i+4],ac[i+5]
949                    )
950                end
951                prev = "A"
952                goto continue
953            ::quadratic::
954                n = n + 1 ; t[n] = (n > 0 and f_curveto_n or f_curveto_z)(
955                    x  + 2/3 * (x1-x ), y  + 2/3 * (y1-y ),
956                    x2 + 2/3 * (x1-x2), y2 + 2/3 * (y1-y2),
957                    x2,                 y2
958                )
959                x = x2
960                y = y2
961                prev = "C"
962                goto continue
963            ::close::
964            --  n = n + 1 ; t[n] = prev == "C" and "..cycle" or "--cycle"
965                n = n + 1 ; t[n] = "--cycle"
966                if n > 0 then
967                    a = a + 1 ; all[a] = concat(t,"",1,n) ; n = 0
968                end
969                if i == np then
970                    break
971                else
972                    i = i - 1
973                end
974                kind = prev
975                prev = "Z"
976                -- this is kind of undocumented: a close also moves back
977                x = mx
978                y = my
979            ::continue::
980        end
981        if n > 0 then
982            a = a + 1 ; all[a] = concat(t,"",1,n) ; n = 0
983        end
984        if prev == "Z" then
985            all.closed = true
986        end
987        all.curve = (kind == "C" or kind == "A")
988        return all, p
989    end
990
991    -- this is a bit tricky as what are points for a mark ... the next can be simplified
992    -- a lot
993
994    grablist = function(p)
995        local np  = #p
996        if np == 0 then
997            return nil
998        end
999        local t      = { }
1000        local n      = 0
1001        local a      = 0
1002        local i      = 0
1003        local last   = "M"
1004        local prev   = last
1005        local kind   = "L"
1006        local x, y   = 0, 0
1007        local x1, y1 = 0, 0
1008        local x2, y2 = 0, 0
1009        local rx, ry = 0, 0
1010        local ar, al = 0, 0
1011        local as, ac = 0, nil
1012        local mx, my = 0, 0
1013        while i < np do
1014            i = i + 1
1015            local pi = p[i]
1016            if type(pi) ~= "number" then
1017                last = pi
1018                i    = i + 1
1019                pi   = p[i]
1020            end
1021            -- most often
1022            if last == "c" then
1023                            x1 = x + pi
1024                i = i + 1 ; y1 = y + p[i]
1025                i = i + 1 ; x2 = x + p[i]
1026                i = i + 1 ; y2 = y + p[i]
1027                i = i + 1 ; x  = x + p[i]
1028                i = i + 1 ; y  = y + p[i]
1029                goto curveto
1030            elseif last == "l" then
1031                            x = x + pi
1032                i = i + 1 ; y = y + p[i]
1033                goto lineto
1034            elseif last == "h" then
1035                x = x + pi
1036                goto lineto
1037            elseif last == "v" then
1038                y = y + pi
1039                goto lineto
1040            elseif last == "a" then
1041                            x1 =     x
1042                            y1 =     y
1043                            rx =     pi
1044                i = i + 1 ; ry =     p[i]
1045                i = i + 1 ; ar =     p[i]
1046                i = i + 1 ; al =     p[i]
1047                i = i + 1 ; as =     p[i]
1048                i = i + 1 ; x  = x + p[i]
1049                i = i + 1 ; y  = y + p[i]
1050                goto arc
1051            elseif last == "s" then
1052                if prev == "C" then
1053                    x1 = 2 * x - x2
1054                    y1 = 2 * y - y2
1055                else
1056                    x1 = x
1057                    y1 = y
1058                end
1059                            x2 = x + pi
1060                i = i + 1 ; y2 = y + p[i]
1061                i = i + 1 ; x  = x + p[i]
1062                i = i + 1 ; y  = y + p[i]
1063                goto curveto
1064            elseif last == "m" then
1065                            x = x + pi
1066                i = i + 1 ; y = y + p[i]
1067                goto moveto
1068            elseif last == "z" then
1069                goto close
1070            -- less frequent
1071            elseif last == "C" then
1072                            x1 = pi
1073                i = i + 1 ; y1 = p[i]
1074                i = i + 1 ; x2 = p[i]
1075                i = i + 1 ; y2 = p[i]
1076                i = i + 1 ; x  = p[i]
1077                i = i + 1 ; y  = p[i]
1078                goto curveto
1079            elseif last == "L" then
1080                            x = pi
1081                i = i + 1 ; y = p[i]
1082                goto lineto
1083            elseif last == "H" then
1084                x = pi
1085                goto lineto
1086            elseif last == "V" then
1087                y = pi
1088                goto lineto
1089            elseif last == "A" then
1090                            x1 = x
1091                            y1 = y
1092                            rx = pi
1093                i = i + 1 ; ry = p[i]
1094                i = i + 1 ; ar = p[i]
1095                i = i + 1 ; al = p[i]
1096                i = i + 1 ; as = p[i]
1097                i = i + 1 ; x  = p[i]
1098                i = i + 1 ; y  = p[i]
1099                goto arc
1100            elseif last == "S" then
1101                if prev == "C" then
1102                    x1 = 2 * x - x2
1103                    y1 = 2 * y - y2
1104                else
1105                    x1 = x
1106                    y1 = y
1107                end
1108                            x2 = pi
1109                i = i + 1 ; y2 = p[i]
1110                i = i + 1 ; x  = p[i]
1111                i = i + 1 ; y  = p[i]
1112                goto curveto
1113            elseif last == "M" then
1114                            x = pi ;
1115                i = i + 1 ; y = p[i]
1116                goto moveto
1117            elseif last == "Z" then
1118                goto close
1119            -- very seldom
1120            elseif last == "q" then
1121                            x1 = x + pi
1122                i = i + 1 ; y1 = y + p[i]
1123                i = i + 1 ; x2 = x + p[i]
1124                i = i + 1 ; y2 = y + p[i]
1125                goto quadratic
1126            elseif last == "t" then
1127                if prev == "C" then
1128                    x1 = 2 * x - x1
1129                    y1 = 2 * y - y1
1130                else
1131                    x1 = x
1132                    y1 = y
1133                end
1134                            x2 = x + pi
1135                i = i + 1 ; y2 = y + p[i]
1136                goto quadratic
1137            elseif last == "Q" then
1138                            x1 = pi
1139                i = i + 1 ; y1 = p[i]
1140                i = i + 1 ; x2 = p[i]
1141                i = i + 1 ; y2 = p[i]
1142                goto quadratic
1143            elseif last == "T" then
1144                if prev == "C" then
1145                    x1 = 2 * x - x1
1146                    y1 = 2 * y - y1
1147                else
1148                    x1 = x
1149                    y1 = y
1150                end
1151                            x2 = pi
1152                i = i + 1 ; y2 = p[i]
1153                goto quadratic
1154            else
1155                goto continue
1156            end
1157            ::moveto::
1158                n = n + 1 ; t[n] = x
1159                n = n + 1 ; t[n] = y
1160                last = last == "M" and "L" or "l"
1161                prev = "M"
1162                mx = x
1163                my = y
1164                goto continue
1165            ::lineto::
1166                n = n + 1 ; t[n] = x
1167                n = n + 1 ; t[n] = y
1168                prev = "L"
1169                goto continue
1170            ::curveto::
1171                n = n + 1 ; t[n] = x
1172                n = n + 1 ; t[n] = y
1173                prev = "C"
1174                goto continue
1175            ::arc::
1176                ac = a2c(x1,y1,rx,ry,ar,al,as,x,y)
1177                for i=1,#ac,6 do
1178                    n = n + 1 ; t[n] = ac[i+4]
1179                    n = n + 1 ; t[n] = ac[i+5]
1180                end
1181                prev = "A"
1182                goto continue
1183            ::quadratic::
1184                n = n + 1 ; t[n] = x2
1185                n = n + 1 ; t[n] = y2
1186                x = x2
1187                y = y2
1188                prev = "C"
1189                goto continue
1190            ::close::
1191                n = n + 1 ; t[n] = mx
1192                n = n + 1 ; t[n] = my
1193                if i == np then
1194                    break
1195                end
1196                kind = prev
1197                prev = "Z"
1198                x = mx
1199                y = my
1200            ::continue::
1201        end
1202        return t
1203    end
1204
1205end
1206
1207-- todo: viewbox helper
1208
1209local s_wrapped_start <const> = "draw image ("
1210local f_wrapped_stop          = formatters[") shifted (0,%N) scaled %N ;"]
1211
1212local handletransform, handleviewbox  do
1213
1214    local sind = math.sind
1215
1216 -- local f_rotatedaround           = formatters["svg_p := svg_p rotatedaround((%N,%N),%N) ;"]
1217 -- local f_rotated                 = formatters["svg_p := svg_p rotated(%N) ;"]
1218 -- local f_shifted                 = formatters["svg_p := svg_p shifted(%N,%N) ;"]
1219 -- local f_slanted_x               = formatters["svg_p := svg_p xslanted(%N) ;"]
1220 -- local f_slanted_y               = formatters["svg_p := svg_p yslanted(%N) ;"]
1221 -- local f_scaled                  = formatters["svg_p := svg_p scaled(%N) ;"]
1222 -- local f_xyscaled                = formatters["svg_p := svg_p xyscaled(%N,%N) ;"]
1223 -- local f_matrix                  = formatters["svg_p := svg_p transformed bymatrix(%N,%N,%N,%N,%N,%N) ;"]
1224 -- local s_transform_start <const> = "draw image ( begingroup ; save svg_p ; picture svg_p ; svg_p := image ( "
1225 -- local f_transform_stop          = formatters[" ; ) ; %s ; draw svg_p ; endgroup ; ) ; "]
1226
1227    local f_rotatedaround           = formatters["rotatedaround((%N,%N),%N) "]
1228    local f_rotated                 = formatters["rotated(%N) "]
1229    local f_shifted                 = formatters["shifted(%N,%N) "]
1230    local f_slanted_x               = formatters["xslanted(%N) "]
1231    local f_slanted_y               = formatters["yslanted(%N) "]
1232    local f_scaled                  = formatters["scaled(%N) "]
1233    local f_xyscaled                = formatters["xyscaled(%N,%N) "]
1234    local f_matrix                  = formatters["transformed bymatrix(%N,%N,%N,%N,%N,%N) "]
1235    local s_transform_start <const> = "draw image ( "
1236    local f_transform_stop          = formatters[") %s ; "]
1237
1238    local transforms    = { }
1239    local noftransforms = 0
1240
1241    local function rotate(r,x,y)
1242        if r then
1243            noftransforms = noftransforms + 1
1244            if x then
1245                transforms[noftransforms] = f_rotatedaround(x,-(y or x),-r)
1246            else
1247                transforms[noftransforms] = f_rotated(-r)
1248            end
1249        end
1250    end
1251
1252    local function translate(x,y)
1253        if x == 0 then x = false end
1254        if y == 0 then y = false end
1255        if y then
1256            noftransforms = noftransforms + 1
1257            transforms[noftransforms] = f_shifted(x or 0,-y)
1258        elseif x then
1259            noftransforms = noftransforms + 1
1260            transforms[noftransforms] = f_shifted(x,0)
1261        end
1262    end
1263
1264    local function scale(x,y)
1265        if x == 1 then x = false end
1266        if y == 1 then y = false end
1267        if y then
1268            noftransforms = noftransforms + 1
1269            transforms[noftransforms] = f_xyscaled(x or 1,y)
1270        elseif x then
1271            noftransforms = noftransforms + 1
1272            transforms[noftransforms] = f_scaled(x)
1273        end
1274    end
1275
1276    local function skew(x,y)
1277     -- if x = 0 then x = false end
1278     -- if y = 0 then y = false end
1279        if x then
1280            noftransforms = noftransforms + 1
1281            transforms[noftransforms] = f_slanted_x(sind(-x))
1282        end
1283        if y then
1284            noftransforms = noftransforms + 1
1285            transforms[noftransforms] = f_slanted_y(sind(-y))
1286        end
1287    end
1288
1289    local function matrix(rx,sx,sy,ry,tx,ty)
1290        if not ty then
1291            ty = 0
1292        end
1293        if not tx then
1294            tx = 0
1295        end
1296        if not sx then
1297            sx = 0
1298        end
1299        if not sy then
1300            sy = 0
1301        end
1302        if not rx then
1303            rx = 1
1304        end
1305        if not ry then
1306            ry = 1
1307        end
1308        noftransforms = noftransforms + 1
1309     -- transforms[noftransforms] = f_matrix(rx, sx, sy, ry, tx, -ty)
1310        -- https://en.wikipedia.org/wiki/Rotation_matrix : we're counter clockwise
1311        transforms[noftransforms] = f_matrix(rx, -sy, -sx, ry, tx, -ty)
1312    end
1313
1314    local p_transform = (
1315            p_space^0 * (
1316            P("translate")  * (p_numbers / translate)      -- maybe xy
1317          + P("scale")      * (p_numbers / scale)
1318          + P("rotate")     * (p_numbers / rotate)
1319          + P("matrix")     * (p_numbers / matrix)
1320          + P("skew")       * (p_numbers / skew)
1321          + P("translateX") * (p_numbers / translate)
1322          + P("translateY") * (Cc(false) * p_numbers / translate)
1323          + P("scaleX")     * (p_numbers / translate)
1324          + P("scaleY")     * (Cc(false) * p_numbers / translate)
1325          + P("skewX")      * (p_numbers / skew)
1326          + P("skewY")      * (Cc(false) * p_numbers / skew)
1327        )
1328    )^1
1329
1330    -- indeed, we need to reverse the order ... not that pretty and counter intuitive too
1331
1332    local function combined()
1333        if noftransforms == 1 then
1334            return transforms[1]
1335        elseif noftransforms == 2 then
1336            return transforms[2] .. transforms[1]
1337        elseif noftransforms == 3 then
1338            return transforms[3] .. transforms[2] .. transforms[1]
1339        else
1340            -- the rare case (but anything can happen in svg and it gets worse)
1341            local m = noftransforms + 1
1342            for i=1,noftransforms//2 do
1343                local j = m - i
1344                transforms[i], transforms[j] = transforms[j], transforms[i]
1345            end
1346            return concat(transforms,"",1,noftransforms)
1347        end
1348    end
1349
1350    handletransform = function(at)
1351        local t = at.transform
1352        if t then
1353            noftransforms = 0
1354            lpegmatch(p_transform,t)
1355            if noftransforms > 0 then
1356                -- currentpicture
1357                return s_transform_start, f_transform_stop(combined()), t
1358            end
1359        end
1360    end
1361
1362    handletransformstring = function(t)
1363        if t then
1364            noftransforms = 0
1365            lpegmatch(p_transform,t)
1366            return noftransforms > 0 and combined()
1367        end
1368    end
1369
1370    handleviewbox = function(v)
1371        if v then
1372            local x, y, w, h = lpegmatch(p_fournumbers,v)
1373            if h then
1374                return x, y, w, h
1375            end
1376        end
1377    end
1378
1379end
1380
1381local dashed  do
1382
1383    -- actually commas are mandate but we're tolerant
1384
1385    local f_dashed_n = formatters[" dashed dashpattern (%s ) "]
1386    local f_dashed_y = formatters[" dashed dashpattern (%s ) shifted (%N,0) "]
1387
1388    local p_number   = p_optseparator/"" * p_number_r
1389    local p_on       = Cc(" on ")  * p_number
1390    local p_off      = Cc(" off ") * p_number
1391    local p_dashed   = Cs((p_on * p_off^-1)^1)
1392
1393    dashed = function(s,o)
1394        if not find(s,",") then
1395            -- a bit of a hack:
1396            s = s .. " " .. s
1397        end
1398        return (o and f_dashed_y or f_dashed_n)(lpegmatch(p_dashed,s),o)
1399    end
1400
1401end
1402
1403do
1404
1405    local handlers    = { }
1406    local process     = false
1407    local root        = false
1408    local result      = false
1409    local r           = false
1410    local definitions = false
1411    local classstyles = false
1412    local tagstyles   = false
1413
1414    local tags = {
1415        ["a"]                  = true,
1416     -- ["altgGlyph"]          = true,
1417     -- ["altgGlyphDef"]       = true,
1418     -- ["altgGlyphItem"]      = true,
1419     -- ["animate"]            = true,
1420     -- ["animateColor"]       = true,
1421     -- ["animateMotion"]      = true,
1422     -- ["animateTransform"]   = true,
1423        ["circle"]             = true,
1424        ["clipPath"]           = true,
1425     -- ["color-profile"]      = true,
1426     -- ["cursor"]             = true,
1427        ["defs"]               = true,
1428     -- ["desc"]               = true,
1429        ["ellipse"]            = true,
1430     -- ["filter"]             = true,
1431     -- ["font"]               = true,
1432     -- ["font-face"]          = true,
1433     -- ["font-face-format"]   = true,
1434     -- ["font-face-name"]     = true,
1435     -- ["font-face-src"]      = true,
1436     -- ["font-face-uri"]      = true,
1437     -- ["foreignObject"]      = true,
1438        ["g"]                  = true,
1439     -- ["glyph"]              = true,
1440     -- ["glyphRef"]           = true,
1441     -- ["hkern"]              = true,
1442        ["image"]              = true,
1443        ["line"]               = true,
1444        ["linearGradient"]     = true,
1445        ["marker"]             = true,
1446     -- ["mask"]               = true,
1447     -- ["metadata"]           = true,
1448     -- ["missing-glyph"]      = true,
1449     -- ["mpath"]              = true,
1450        ["path"]               = true,
1451        ["pattern"]            = true,
1452        ["polygon"]            = true,
1453        ["polyline"]           = true,
1454        ["radialGradient"]     = true,
1455        ["rect"]               = true,
1456     -- ["script"]             = true,
1457     -- ["set"]                = true,
1458        ["stop"]               = true,
1459        ["style"]              = true,
1460        ["svg"]                = true,
1461     -- ["switch"]             = true,
1462        ["symbol"]             = true,
1463        ["text"]               = true,
1464     -- ["textPath"]           = true,
1465     -- ["title"]              = true,
1466        ["tspan"]              = true,
1467        ["use"]                = true,
1468     -- ["view"]               = true,
1469     -- ["vkern"]              = true,
1470    }
1471
1472    local usetags = {
1473        ["circle"]             = true,
1474        ["ellipse"]            = true,
1475        ["g"]                  = true,
1476        ["image"]              = true,
1477        ["line"]               = true,
1478        ["path"]               = true,
1479        ["polygon"]            = true,
1480        ["polyline"]           = true,
1481        ["rect"]               = true,
1482     -- ["text"]               = true,
1483     -- ["tspan"]              = true,
1484    }
1485
1486    local pathtracer = {
1487        ["stroke"]         = "darkred",
1488        ["stroke-opacity"] = ".5",
1489        ["stroke-width"]   = ".5",
1490        ["fill"]           = "darkgray",
1491        ["fill-opacity"]   = ".75",
1492    }
1493
1494    local skipspace  = p_space^0
1495    local colon      = P(":")
1496    local semicolon  = P(";")
1497    local eos        = P(-1)
1498
1499    local someaction = (
1500        skipspace * C((1 - (skipspace * (semicolon + eos + colon)))^1)
1501      * colon
1502      * skipspace * C((1 - (skipspace * (semicolon + eos)))^0)
1503      * Carg(1) / function(k,v,a) a[k] = v end
1504        + (p_space + semicolon)^1
1505     )^1
1506
1507    local function handlechains(c)
1508        if tags[c.tg] then
1509            local at = c.at
1510            local dt = c.dt
1511            if at and dt then
1512             -- at["inkscape:connector-curvature"] = nil -- clear entry and might prevent table growth
1513                local estyle = rawget(at,"style")
1514                if estyle and estyle ~= "" then
1515                    lpegmatch(someaction,estyle,1,at)
1516                end
1517                local eclass = rawget(at,"class")
1518                if eclass and eclass ~= "" then
1519                    for c in gmatch(eclass,"[^ ]+") do
1520                        local s = classstyles[c]
1521                        if s then
1522                            for k, v in next, s do
1523                                at[k] = v
1524                            end
1525                        end
1526                    end
1527                end
1528                local tstyle = tagstyles[tag]
1529                if tstyle then
1530                    for k, v in next, tstyle do
1531                        at[k] = v
1532                    end
1533                end
1534                if trace_path and pathtracer then
1535                    for k, v in next, pathtracer do
1536                        at[k] = v
1537                    end
1538                end
1539                for i=1,#dt do
1540                    local dti = dt[i]
1541                    if type(dti) == "table" then
1542                        handlechains(dti)
1543                    end
1544                end
1545            end
1546        end
1547    end
1548
1549    local handlestyle  do
1550
1551        -- It can also be CDATA but that is probably dealt with because we only
1552        -- check for style entries and ignore the rest. But maybe we also need
1553        -- to check a style at the outer level?
1554
1555        local p_key   = C((R("az","AZ","09","__","--")^1))
1556        local p_spec  = P("{") * C((1-P("}"))^1) * P("}")
1557        local p_valid = Carg(1) * P(".") * p_key + Carg(2) * p_key
1558        local p_grab  = ((p_valid * p_space^0 * p_spec / rawset) + p_space^1 + P(1))^1
1559
1560        local fontspecification = css.fontspecification
1561
1562        handlestyle = function(c)
1563            local s = xmltext(c)
1564            lpegmatch(p_grab,s,1,classstyles,tagstyles)
1565            for k, v in next, classstyles do
1566                local t = { }
1567                for k, v in gmatch(v,"%s*([^:]+):%s*([^;]+);?") do
1568                    if k == "font" then
1569                        local s = fontspecification(v)
1570                        for k, v in next, s do
1571                            t["font-"..k] = v
1572                        end
1573                    else
1574                        t[k] = v
1575                    end
1576                end
1577                classstyles[k] = t
1578            end
1579            for k, v in next, tagstyles do
1580                local t = { }
1581                for k, v in gmatch(v,"%s*([^:]+):%s*([^;]+);?") do
1582                    if k == "font" then
1583                        local s = fontspecification(v)
1584                        for k, v in next, s do
1585                            t["font-"..k] = v
1586                        end
1587                    else
1588                        t[k] = v
1589                    end
1590                end
1591                tagstyles[k] = t
1592            end
1593        end
1594
1595        function handlers.style()
1596            -- ignore
1597        end
1598
1599    end
1600
1601    -- We can have root in definitions and then do a metatable lookup but use
1602    -- is not used that often I guess.
1603
1604    local function locate(id,c)
1605        if id == none then
1606            return
1607        end
1608        local res = definitions[id]
1609        local ref
1610        if res then
1611            return res
1612        end
1613        ref = gsub(id,"^url%(#(.-)%)$","%1")
1614        ref = gsub(ref,"^#","")
1615        -- we can make a fast id lookup
1616        res = xmlfirst(root,"**[@id='"..ref.."']")
1617        if res then
1618            definitions[id] = res
1619            return res
1620        end
1621        -- we expect resource paths to be specified but for now we want
1622        -- them on the same path .. we could use the url splitter .. todo
1623        ref = url.hashed(id)
1624        if not ref.nosheme and ref.scheme == "file" then
1625            local filename = ref.filename
1626            local fragment = ref.fragment
1627            if filename and filename ~= "" then
1628                local fullname = resolvers.findbinfile(filename)
1629                if lfs.isfile(fullname) then
1630                    report("loading use file: %s",fullname)
1631                    local root = xml.load(fullname)
1632                    res = xmlfirst(root,"**[@id='"..fragment.."']")
1633                    if res then
1634                        xmlinheritattributes(res,c) -- tricky
1635                        setmetatableindex(res.at,c.at)
1636                        definitions[id] = res
1637                        return res
1638                    end
1639                end
1640            end
1641        end
1642        return res
1643    end
1644
1645    -- also locate
1646
1647    local function handleclippath(at)
1648        local clippath = at["clip-path"]
1649
1650        if not clippath then
1651            return
1652        end
1653
1654        local spec = definitions[clippath] or locate(clippath)
1655
1656        -- do we really need this crap
1657        if not spec then
1658            local index = match(clippath,"(%d+)")
1659            if index then
1660                spec = xmlfirst(root,"clipPath["..tostring(tonumber(index) or 0).."]")
1661            end
1662        end
1663        -- so far for the crap
1664
1665        if not spec then
1666            report("unknown clip %a",clippath)
1667            return
1668        elseif spec.tg ~= "clipPath" then
1669            report("bad clip %a",clippath)
1670            return
1671        end
1672
1673      ::again::
1674        for c in xmlcollected(spec,"/(path|use|g)") do
1675            local tg = c.tg
1676            if tg == "use" then
1677                local ca = c.at
1678                local id = ca["xlink:href"]
1679                if id then
1680                    spec = locate(id)
1681                    if spec then
1682                        local sa = spec.at
1683                        setmetatableindex(sa,ca)
1684                        if spec.tg == "path" then
1685                            local d = sa.d
1686                            if d then
1687                                local p = grabpath(d)
1688                                p.evenodd = sa["clip-rule"] == "evenodd"
1689                                p.close = true
1690                                return p, clippath
1691                            else
1692                                return
1693                            end
1694                        else
1695                            goto again
1696                        end
1697                    end
1698                end
1699             -- break
1700            elseif tg == "path" then
1701                local ca = c.at
1702                local d  = rawget(ca,"d")
1703                if d then
1704                    local p = grabpath(d)
1705                    p.evenodd = ca["clip-rule"] == "evenodd"
1706                    p.close   = true
1707                    local transform = rawget(ca,"transform")
1708                    if transform then
1709                        transform = handletransformstring(transform)
1710                    end
1711                    return p, clippath, transform
1712                else
1713                    return
1714                end
1715            else
1716                -- inherit?
1717            end
1718        end
1719    end
1720
1721    -- todo: clip = [ auto | rect(llx,lly,urx,ury) ]
1722
1723    local s_rotation_start <const> = "draw image ( "
1724    local f_rotation_stop          = formatters[") rotatedaround((0,0),-angle((%N,%N))) ;"]
1725    local f_rotation_angle         = formatters[") rotatedaround((0,0),-%N) ;"]
1726
1727    local s_offset_start   <const> = "draw image ( "
1728    local f_offset_stop            = formatters[") shifted (%N,%N) ;"]
1729    local s_size_start     <const> = "draw image ( "
1730    local f_size_stop              = formatters[") xysized (%N,%N) ;"]
1731
1732    local handleoffset, handlesize do
1733
1734        handleoffset = function(at)
1735            local x = asnumber_vx(rawget(at,"x"))
1736            local y = asnumber_vy(rawget(at,"y"))
1737            if x ~= 0 or y ~= 0 then
1738                return s_offset_start, f_offset_stop(x,y)
1739            end
1740        end
1741
1742        handlesize = function(at)
1743            local width  = asnumber_x(rawget(at,"width"))
1744            local height = asnumber_y(rawget(at,"height"))
1745            if width == 0 or height == 0 then
1746                -- bad scaling
1747            elseif width == 1 and height == 1 then
1748                -- no need for scaling
1749            else
1750                return s_size_start, f_size_stop(width,height)
1751            end
1752        end
1753
1754    end
1755
1756    function handlers.symbol(c)
1757        local at  = c.at
1758        -- x y refX refY
1759        local boffset, eoffset = handleoffset(at)
1760        local bsize, esize = handlesize(at)
1761        local btransform, etransform, transform = handletransform(at)
1762
1763        if boffset then
1764            r = r + 1 result[r] = boffset
1765        end
1766        if btransform then
1767            r = r + 1 result[r] = btransform
1768        end
1769        if bsize then
1770            r = r + 1 ; result[r] = bsize
1771        end
1772
1773-- local _x = at.x       at.x      = 0
1774-- local _y = at.y       at.y      = 0
1775-- local _w = at.width   at.width  = 0
1776-- local _h = at.height  at.height = 0
1777
1778        process(c,"/*")
1779-- at.x      = _x
1780-- at.y      = _y
1781-- at.width  = _w
1782-- at.height = _h
1783
1784        if esize then
1785            r = r + 1 result[r] = esize
1786        end
1787        if etransform then
1788            r = r + 1 ; result[r] = etransform
1789        end
1790        if eoffset then
1791            r = r + 1 result[r] = eoffset
1792        end
1793    end
1794
1795    -- do
1796
1797    local s_shade_linear       =            '    withshademethod "linear" '
1798    local s_shade_circular     =            '    withshademethod "circular" '
1799    local f_color              = formatters['    withcolor "%s"']
1800    local f_opacity            = formatters['    withopacity %N']
1801    local f_pen                = formatters['    withpen pencircle scaled %N']
1802
1803
1804    -- todo: gradient unfinished
1805    -- todo: opacity but first we need groups in mp
1806
1807    -- this is rather hard to deal with because browsers differ (at the time of writing)
1808    -- and what they show on screen comes out different (or not at all) in print
1809
1810    -- todo: gradientUnits = "userSpaceOnUse" : use units instead of ratios
1811
1812    -- spreadMethod = "pad"     : default
1813    -- spreadMethod = "repeat"  : crap
1814    -- spreadMethod = "reflect" : crap
1815
1816    -- stop-opacity = "0"       : strange, just use steps for that
1817
1818    -- todo: test for kind independently in caller, make a plug instead
1819
1820    local function pattern(id)
1821        local c = definitions[id] -- no locate !
1822        if c and c.tg == "pattern" then
1823            -- just use result and then prune
1824            local _r      = r
1825            local _result = result
1826            r      = 0
1827            result = { }
1828            --
1829         -- handlers.pattern(spec)
1830            --
1831            -- inlined because of width
1832            --
1833            local at  = c.at
1834
1835            local width  = asnumber_x(rawget(at,"width"))
1836            local height = asnumber_y(rawget(at,"height"))
1837            if width == 0 or height == 0 then
1838                -- bad scaling
1839                width  = nil
1840                height = nil
1841            elseif width == 1 and height == 1 then
1842                -- no need for scaling
1843                width  = nil
1844                height = nil
1845            else
1846                -- for now only relative
1847            end
1848
1849            local boffset, eoffset = handleoffset(at)
1850         -- local bsize, esize = handlesize(at)
1851            local btransform, etransform, transform = handletransform(at)
1852
1853            if boffset then
1854                r = r + 1 result[r] = boffset
1855            end
1856            if btransform then
1857                r = r + 1 result[r] = btransform
1858            end
1859         -- if bsize then
1860         --     r = r + 1 ; result[r] = bsize
1861         -- end
1862
1863            local _x = at.x       at.x      = 0
1864            local _y = at.y       at.y      = 0
1865            local _w = at.width   at.width  = 0
1866            local _h = at.height  at.height = 0
1867
1868            process(c,"/*")
1869
1870            at.x      = _x
1871            at.y      = _y
1872            at.width  = _w
1873            at.height = _h
1874
1875         -- if esize then
1876         --     r = r + 1 result[r] = esize
1877         -- end
1878            if etransform then
1879                r = r + 1 ; result[r] = etransform
1880            end
1881            if eoffset then
1882                r = r + 1 result[r] = eoffset
1883            end
1884            --
1885            local okay
1886            if width and height then
1887                okay = formatters["    withpattern image ( % t )\n    withpatternscale(%N,%N)"](result,width,height)
1888            else
1889                okay = formatters["    withpattern image ( % t )"](result)
1890            end
1891            r      = _r
1892            result = _result
1893            return okay
1894        end
1895    end
1896
1897    local gradient do
1898
1899        local f_shade_step         = formatters['withshadestep ( withshadefraction %N withshadecolors (%s,%s) )']
1900        local f_shade_step_opacity = formatters['withshadestep ( withshadefraction %N withshadecolors (%s,%s) withshadeopacity %N )']
1901        local f_shade_center       = formatters['withshadecenter (%N,%N)']
1902        local f_shade_center_f     = formatters['withshadecenterfraction (%N,%N)']
1903        local f_shade_radius       = formatters['withshaderadius (%N,%N) ']
1904        local f_shade_radius_f     = formatters['withshaderadiusfraction %N']
1905        local f_shade_center_one   = formatters['withshadecenterone (%N,%N)']
1906        local f_shade_center_two   = formatters['withshadecentertwo (%N,%N)']
1907        local f_shade_center_one_f = formatters['withshadecenteronefraction (%N,%N)']
1908        local f_shade_center_two_f = formatters['withshadecentertwofraction (%N,%N)']
1909
1910        gradient = function(id)
1911            local spec = definitions[id] -- no locate !
1912            if spec then
1913                local kind  = spec.tg
1914                local shade = nil
1915                local n     = 1
1916                local a     = spec.at
1917                -- bah
1918                local gu = rawget(a, "gradientUnits")         -- userSpaceOnUse
1919                local gt = rawget(a, "gradientTransform")
1920                local sm = rawget(a, "spreadMethod")
1921                --
1922                local userspace = gu == "userSpaceOnUse"
1923                --
1924                if kind == "linearGradient" then
1925                    shade = { s_shade_linear }
1926                    --
1927                    local x1 = rawget(a,"x1")
1928                    local y1 = rawget(a,"y1")
1929                    local x2 = rawget(a,"x2")
1930                    local y2 = rawget(a,"y2")
1931                    if x1 and y1 then
1932                        n = n + 1 ; shade[n] = f_shade_center_one_f(asnumber_p(x1),1-asnumber_p(y1))
1933                    end
1934                    if x2 and y2 then
1935                        n = n + 1 ; shade[n] = f_shade_center_two_f(asnumber_p(x2),1-asnumber_p(y2))
1936                    end
1937                    --
1938                elseif kind == "radialGradient" then
1939                    shade = { s_shade_circular }
1940                    --
1941                    local cx = rawget(a,"cx") -- x center
1942                    local cy = rawget(a,"cy") -- y center
1943                    local r  = rawget(a,"r" ) -- radius
1944                    local fx = rawget(a,"fx") -- focal points
1945                    local fy = rawget(a,"fy") -- focal points
1946                    --
1947                    if userspace then
1948                        if cx and cy then
1949                            n = n + 1 ; shade[n] = f_shade_center(asnumber_p(cx),asnumber_p(cy))
1950                        end
1951                        if fx and fy then
1952                            n = n + 1 ; shade[n] = f_shade_center_one(asnumber_p(fx),-asnumber_p(fy))
1953                        end
1954                        if r then
1955                            n = n + 1 ; shade[n] = f_shade_radius(asnumber_p(r))
1956                        end
1957                        if fx and fy then
1958                            -- todo
1959                        end
1960                    else
1961                        if cx and cy then
1962                            n = n + 1 ; shade[n] = f_shade_center_f(asnumber_p(cx),1-asnumber_p(cy))
1963                        end
1964                        if fx and fy then
1965                            n = n + 1 ; shade[n] = f_shade_center_one_f(asnumber_p(fx),1-asnumber_p(fy))
1966                        end
1967                        if r then
1968                            n = n + 1 ; shade[n] = f_shade_radius_f(asnumber_p(r))
1969                        end
1970                        if fx and fy then
1971                            -- todo
1972                        end
1973                    end
1974                else
1975                    return
1976                end
1977                local colora, colorb
1978                -- startcolor ?
1979                for c in xmlcollected(spec,"/stop") do
1980                    local a       = c.at
1981                    local offset  = rawget(a,"offset")
1982                    local colorb  = rawget(a,"stop-color")
1983                 -- local opacity = rawget(a,"stop-opacity") -- not in pdf for steps
1984                    if not colora then
1985                        colora = colorb
1986                    end
1987                    -- what if no percentage
1988--                     local fraction = offset and asnumber_r(offset) -- asnumber_p ?
1989local fraction = offset and asnumber_p(offset)
1990                    if not fraction then
1991                        -- for now
1992                        fraction = xmlcount(spec,"/stop")/100      -- asnumber_p ?
1993                    end
1994                    if colora and colorb and colora ~= "" and colorb ~= "" then
1995                        n = n + 1
1996                     -- if opacity then
1997                     --     shade[n] = f_shade_step_opacity(fraction,thecolor(colora),thecolor(colorb),asnumber(o))
1998                     -- else
1999                            if userspace then
2000                                shade[n] = f_shade_step(fraction,thecolor(colora),thecolor(colorb))
2001                            else
2002                                shade[n] = f_shade_step(fraction,thecolor(colora),thecolor(colorb))
2003                            end
2004                     -- end
2005                    end
2006                    colora = colorb
2007                end
2008                return concat(shade,"\n    ")
2009            end
2010        end
2011
2012    end
2013
2014    local function drawproperties(stroke,at,opacity)
2015        local p = at["stroke-width"]
2016        if p then
2017            p = f_pen(asnumber_r(p))
2018        end
2019        local d = at["stroke-dasharray"]
2020        if d == "none" then
2021            d = nil
2022        elseif d then
2023            local o = at["stroke-dashoffset"]
2024            if o and o ~= "none" then
2025                o = asnumber_r(o)
2026            else
2027                o = false
2028            end
2029            d = dashed(d,o)
2030        end
2031        local c = withcolor(stroke)
2032        local o = at["stroke-opacity"] or (opacity and at["opacity"])
2033        if o == "none" then
2034            o = nil
2035        elseif o == "transparent" then
2036            o = f_opacity(0)
2037        elseif o then
2038            o = asnumber_r(o)
2039            if o == ignoredopacity then
2040                o = nil
2041            elseif o then
2042                o = f_opacity(o)
2043            else
2044                o = nil
2045            end
2046        end
2047        return p, d, c, o
2048    end
2049
2050    local s_opacity_start   <const> = "draw image ("
2051    local f_opacity_content         = formatters["setgroup currentpicture to boundingbox currentpicture withopacity %N;"]
2052    local s_opacity_stop    <const> = ") ;"
2053
2054    local function sharedopacity(at)
2055        local o = at["opacity"]
2056        if o and o ~= "none" then
2057            o = asnumber_r(o)
2058            if o == ignoredopacity then
2059                return
2060            end
2061            if o then
2062                return s_opacity_start, f_opacity_content(o), s_opacity_stop
2063            end
2064        end
2065    end
2066
2067    -- it looks like none and transparent are both used (mozilla examples)
2068
2069    local function fillproperties(fill,at,opacity)
2070        local o = at["fill-opacity"] or (opacity and at["opacity"])
2071        local c = nil
2072        if c ~= "none" then
2073            c = gradient(fill)
2074            if not c then
2075                c = pattern(fill)
2076                if c then
2077                    if o and o ~= "none" then
2078                        o = asnumber_r(o)
2079                        if o ~= ignoredopacity then
2080                            return c, f_opacity(o), "pattern"
2081                        end
2082                    end
2083                    return c, false, "pattern"
2084                else
2085                    c = withcolor(fill)
2086                end
2087            end
2088        end
2089        if not o and fill == "transparent" then
2090            return nil, f_opacity(0), true
2091        elseif o and o ~= "none" then
2092            o = asnumber_r(o)
2093            if o == ignoredopacity then
2094                return c
2095            end
2096            if o then
2097                return c, f_opacity(o), (o == 1 and "invisible")
2098            end
2099        end
2100        return c
2101    end
2102
2103    local viewport do
2104
2105        local s_viewport_start  <const> = "draw image ("
2106        local s_viewport_stop   <const> = ") ;"
2107        local f_viewport_shift          = formatters["currentpicture := currentpicture shifted (%N,%N);"]
2108        local f_viewport_scale          = formatters["currentpicture := currentpicture xysized (%N,%N);"]
2109        local f_viewport_clip           = formatters["clip currentpicture to (unitsquare xyscaled (%N,%N));"]
2110
2111        viewport = function(x,y,w,h,noclip,scale)
2112            r = r + 1 ; result[r] = s_viewport_start
2113            return function()
2114                local okay = w ~= 0 and h ~= 0
2115                if okay and scale then
2116                    r = r + 1 ; result[r] = f_viewport_scale(w,h)
2117                end
2118                if x ~= 0 or y ~= 0 then
2119                    r = r + 1 ; result[r] = f_viewport_shift(-x,y)
2120                end
2121                if okay and not noclip then
2122                    r = r + 1 ; result[r] = f_viewport_clip(w,-h)
2123                end
2124
2125                r = r + 1 ; result[r] = s_viewport_stop
2126            end
2127        end
2128
2129    end
2130
2131    -- maybe forget about defs and just always locate (and then backtrack
2132    -- over <g> if needed) .. so, only store after locating
2133
2134    function handledefinitions(c)
2135        for c in xmlcollected(c,"defs/*") do
2136            local a = c.at
2137            if a then
2138                local id = rawget(a,"id")
2139                if id then
2140                    definitions["#"     .. id       ] = c
2141                    definitions["url(#" .. id .. ")"] = c
2142                end
2143            end
2144        end
2145        for c in xmlcollected(c,"(symbol|radialGradient|linearGradient)") do
2146            local id = rawget(c.at,"id")
2147            if id then
2148                definitions["#"     .. id       ] = c
2149                definitions["url(#" .. id .. ")"] = c
2150            end
2151        end
2152    end
2153
2154 --  function handlers.defs(c)
2155 --     for c in xmlcollected(c,"/*") do
2156 --         local a = c.at
2157 --         if a then
2158 --             local id = rawget(a,"id")
2159 --             if id then
2160 --                 definitions["#"     .. id       ] = c
2161 --                 definitions["url(#" .. id .. ")"] = c
2162 --             end
2163 --         end
2164 --     end
2165 -- end
2166
2167    -- lots of stuff todo: transform
2168
2169    local uselevel = 0
2170
2171    function handlers.use(c)
2172        local at  = c.at
2173        local id  = rawget(at,"href") or rawget(at,"xlink:href") -- better a rawget
2174        local res = locate(id,c)
2175        if res then
2176            uselevel = uselevel + 1
2177            local boffset, eoffset = handleoffset(at)
2178            local btransform, etransform, transform = handletransform(at)
2179
2180            if boffset then
2181                r = r + 1 result[r] = boffset
2182            end
2183
2184         -- local clippath  = at.clippath
2185
2186            if btransform then
2187                r = r + 1 result[r] = btransform
2188            end
2189
2190            local _transform = transform
2191            local _clippath  = clippath
2192            at["transform"] = false
2193         -- at["clip-path"] = false
2194
2195setmetatableindex(res.at,at)
2196
2197            local tg = res.tg
2198--             if usetags[tg] then
2199                process(res,".")
2200--             else
2201--                 process(res,"/*")
2202--             end
2203
2204            at["transform"] = _transform
2205         -- at["clip-path"] = _clippath
2206
2207            if etransform then
2208                r = r + 1 ; result[r] = etransform
2209            end
2210
2211            if eoffset then
2212                r = r + 1 result[r] = eoffset
2213            end
2214
2215            uselevel = uselevel - 1
2216        else
2217            report("use: unknown definition %a",id)
2218        end
2219    end
2220
2221    local f_no_draw               = formatters['  nodraw (%s)']
2222    local f_do_draw               = formatters['  draw (%s)']
2223    local f_no_fill_c             = formatters['  nofill closedcurve(%s)']
2224    local f_do_fill_c             = formatters['  fill closedcurve(%s)']
2225    local f_eo_fill_c             = formatters['  eofill closedcurve(%s)']
2226    local f_no_fill_l             = formatters['  nofill closedlines(%s)']
2227    local f_do_fill_l             = formatters['  fill closedlines(%s)']
2228    local f_eo_fill_l             = formatters['  eofill closedlines(%s)']
2229    local f_closed_draw           = formatters['  draw closedcurve(%s)']
2230    local f_do_fill               = f_do_fill_c
2231    local f_eo_fill               = f_eo_fill_c
2232    local f_no_fill               = f_no_fill_c
2233    local s_clip_start    <const> = 'save p ; picture p ; p := image ('
2234    local f_clip_stop_c           = formatters[') ; clip p to closedcurve(%s) %s ; draw p ;']
2235    local f_clip_stop_l           = formatters[') ; clip p to closedlines(%s) %s ; draw p ;']
2236    local f_clip_stop             = f_clip_stop_c
2237    local f_eoclip_stop_c         = formatters[') ; eoclip p to closedcurve(%s) %s ; draw p ;']
2238    local f_eoclip_stop_l         = formatters[') ; eoclip p to closedlines(%s) %s ; draw p ;']
2239    local f_eoclip_stop           = f_eoclip_stop_c
2240
2241    -- could be shared and then beginobject | endobject
2242
2243    local function flushobject(object,at,c,o)
2244        local btransform, etransform = handletransform(at)
2245        local cpath, _, ctransform = handleclippath(at)
2246
2247        if cpath then
2248            r = r + 1 ; result[r] = s_clip_start
2249        end
2250
2251        if btransform then
2252            r = r + 1 ; result[r] = btransform
2253        end
2254
2255        r = r + 1 ; result[r] = f_do_draw(object)
2256
2257        if c then
2258            r = r + 1 ; result[r] = c
2259        end
2260
2261        if o then
2262            r = r + 1 ; result[r] = o
2263        end
2264
2265        if etransform then
2266            r = r + 1 ; result[r] = etransform
2267        end
2268
2269        r = r + 1 ; result[r] = "  ;"
2270
2271        if cpath then
2272            local f_done = cpath.evenodd
2273            if cpath.curve then
2274                f_done = f_done and f_eoclip_stop_c or f_clip_stop_c
2275            else
2276                f_done = f_done and f_eoclip_stop_l or f_clip_stop_l
2277            end
2278            r = r + 1 ; result[r] = f_done(cpath[1],ctransform or "")
2279        end
2280    end
2281
2282    do
2283
2284        local flush
2285
2286        local f_linecap    = formatters["  interim linecap := %s ;"]
2287        local f_linejoin   = formatters["  interim linejoin := %s ;"]
2288        local f_miterlimit = formatters["  interim miterlimit := %s ;"]
2289
2290        local s_begingroup <const> = "begingroup;"
2291        local s_endgroup   <const> = "endgroup;"
2292
2293        local linecaps  = { butt  = "butt",    square = "squared", round = "rounded" }
2294        local linejoins = { miter = "mitered", bevel  = "beveled", round = "rounded" }
2295
2296        local function startlineproperties(at)
2297            local cap   = at["stroke-linecap"]
2298            local join  = at["stroke-linejoin"]
2299            local limit = at["stroke-miterlimit"]
2300            cap   = cap   and linecaps [cap]
2301            join  = join  and linejoins[join]
2302            limit = limit and asnumber_r(limit)
2303            if cap or join or limit then
2304                r = r + 1 ; result[r] = s_begingroup
2305                if cap then
2306                    r = r + 1 ; result[r] = f_linecap(cap)
2307                end
2308                if join then
2309                    r = r + 1 ; result[r] = f_linejoin(join)
2310                end
2311                if limit then
2312                    r = r + 1 ; result[r] = f_miterlimit(limit)
2313                end
2314                return function()
2315                    at["stroke-linecap"]    = false
2316                    at["stroke-linejoin"]   = false
2317                    at["stroke-miterlimit"] = false
2318                    r = r + 1 ; result[r] = s_endgroup
2319                    at["stroke-linecap"]    = cap
2320                    at["stroke-linejoin"]   = join
2321                    at["stroke-miterlimit"] = limit
2322                end
2323            end
2324        end
2325
2326        -- markers are a quite rediculous thing .. let's assume simple usage for now
2327
2328        function handlers.marker()
2329            -- todo: is just a def too
2330        end
2331
2332        -- kind of local svg ... so make a generic one
2333        --
2334        -- todo: combine more (offset+scale+rotation)
2335
2336        local function makemarker(where,c,x1,y1,x2,y2,x3,y3,parentat)
2337            local at     = c.at
2338            local refx   = rawget(at,"refX")
2339            local refy   = rawget(at,"refY")
2340            local width  = rawget(at,"markerWidth")
2341            local height = rawget(at,"markerHeight")
2342            local units  = rawget(at,"markerUnits") -- no parentat["stroke-width"], bad for m4mbo
2343            local view   = rawget(at,"viewBox")
2344            local orient = rawget(at,"orient")
2345         -- local ratio  = rawget(at,"preserveAspectRatio")
2346            local units  = units and asnumber(units) or 1
2347
2348            local angx   = 0
2349            local angy   = 0
2350            local angle  = 0
2351
2352            if where == "beg" then
2353                if orient == "auto" then -- unchecked
2354                    -- no angle
2355                    angx = abs(x2 - x3)
2356                    angy = abs(y2 - y3)
2357                elseif orient == "auto-start-reverse" then -- checked
2358                    -- points to start
2359                    angx = -abs(x2 - x3)
2360                    angy = -abs(y2 - y3)
2361                elseif orient then -- unchecked
2362                    angle = asnumber_r(orient)
2363                end
2364            elseif where == "end" then
2365                -- funny standard .. bug turned feature?
2366                if orient == "auto" or orient == "auto-start-reverse" then
2367                    angx = abs(x1 - x2)
2368                    angy = abs(y1 - y2)
2369                elseif orient then -- unchecked
2370                    angle = asnumber_r(orient)
2371                end
2372            elseif orient then -- unchecked
2373                angle = asnumber_r(orient)
2374            end
2375            -- what wins: viewbox or w/h
2376
2377            refx = asnumber_x(refx)
2378            refy = asnumber_y(refy)
2379
2380            width  = (width  and asnumber_x(width)  or 3) * units
2381            height = (height and asnumber_y(height) or 3) * units
2382
2383            local x = 0
2384            local y = 0
2385            local w = width
2386            local h = height
2387
2388            -- kind of like the main svg
2389
2390            r = r + 1 ; result[r] = s_offset_start
2391
2392            local wrapupviewport
2393-- todo : better viewbox code
2394            local xpct, ypct, rpct
2395            if view then
2396                x, y, w, h = handleviewbox(view)
2397            end
2398
2399            if width ~= 0 then
2400                w = width
2401            end
2402            if height ~= 0 then
2403                h = height
2404            end
2405
2406            if h then
2407                xpct           = percentage_x
2408                ypct           = percentage_y
2409                rpct           = percentage_r
2410                percentage_x   = w / 100
2411                percentage_y   = h / 100
2412                percentage_r   = (sqrt(w^2 + h^2) / sqrt(2)) / 100
2413                wrapupviewport = viewport(x,y,w,h,true,true) -- no clip
2414            end
2415
2416            -- we can combine a lot here:
2417
2418            local hasref = refx ~= 0 or refy ~= 0
2419            local hasrot = angx ~= 0 or angy ~= 0 or angle ~= 0
2420
2421            local btransform, etransform, transform = handletransform(at)
2422
2423            if btransform then
2424                r = r + 1 ; result[r] = btransform
2425            end
2426
2427            if hasrot then
2428                r = r + 1 ; result[r] = s_rotation_start
2429            end
2430
2431            if hasref then
2432                r = r + 1 ; result[r] = s_offset_start
2433            end
2434
2435            local _transform = transform
2436            at["transform"] = false
2437
2438            handlers.g(c)
2439
2440            at["transform"] = _transform
2441
2442            if hasref then
2443                r = r + 1 ; result[r] = f_offset_stop(-refx,refy)
2444            end
2445
2446            if hasrot then
2447                if angle ~= 0 then
2448                    r = r + 1 ; result[r] = f_rotation_angle(angle)
2449                else
2450                    r = r + 1 ; result[r] = f_rotation_stop(angx,angy)
2451                end
2452            end
2453
2454            if etransform then
2455                r = r + 1 ; result[r] = etransform
2456            end
2457
2458            if h then
2459                percentage_x = xpct
2460                percentage_y = ypct
2461                percentage_r = rpct
2462                if wrapupviewport then
2463                    wrapupviewport()
2464                end
2465            end
2466            r = r + 1 ; result[r] = f_offset_stop(x2,y2)
2467
2468        end
2469
2470        -- do we need to metatable the attributes here?
2471
2472        local function addmarkers(list,begmarker,midmarker,endmarker,at)
2473            local n = #list
2474            if n > 3 then
2475                if begmarker then
2476                    local m = locate(begmarker)
2477                    if m then
2478                        makemarker("beg",m,false,false,list[1],list[2],list[3],list[4],at)
2479                    end
2480                end
2481                if midmarker then
2482                    local m = locate(midmarker)
2483                    if m then
2484                        for i=3,n-2,2 do
2485                            makemarker("mid",m,list[i-2],list[i-1],list[i],list[i+1],list[i+2],list[i+3],at)
2486                        end
2487                    end
2488                end
2489                if endmarker then
2490                    local m = locate(endmarker)
2491                    if m then
2492                        makemarker("end",m,list[n-3],list[n-2],list[n-1],list[n],false,false,at)
2493                    end
2494                end
2495            else
2496                -- no line
2497            end
2498        end
2499
2500        local function flush(shape,dofill,at,list,begmarker,midmarker,endmarker)
2501
2502            local fill   = dofill and (at["fill"] or "black")
2503            local stroke = at["stroke"] or "none"
2504
2505            local btransform, etransform = handletransform(at)
2506            local cpath, _, ctransform = handleclippath(at)
2507
2508            if cpath then
2509                r = r + 1 ; result[r] = s_clip_start
2510            end
2511
2512            local has_stroke = stroke and stroke ~= "none"
2513            local has_fill   = fill and fill ~= "none"
2514
2515            local bopacity, copacity, eopacity
2516            if has_stroke and has_fill then
2517                bopacity, copacity, eopacity = sharedopacity(at)
2518            end
2519
2520            if copacity then
2521                r = r + 1 ; result[r] = bopacity
2522            end
2523
2524            if has_fill then
2525                local color, opacity, option = fillproperties(fill,at,not has_stroke)
2526                local f_xx_fill = at["fill-rule"] == "evenodd" and f_eo_fill or f_do_fill
2527                if btransform then
2528                    r = r + 1 ; result[r] = btransform
2529                end
2530                if option == "pattern" then
2531                    r = r + 1 result[r] = f_closed_draw(shape)
2532                else
2533                    r = r + 1 result[r] = f_xx_fill(shape)
2534                end
2535                if color   then
2536                    r = r + 1 ; result[r] = color
2537                end
2538                if opacity then
2539                    r = r + 1 ; result[r] = opacity
2540                end
2541                r = r + 1 ; result[r] = etransform or "  ;"
2542            end
2543
2544            if has_stroke then
2545                local wrapup = startlineproperties(at)
2546                local pen, dashing, color, opacity = drawproperties(stroke,at,not has_fill)
2547                if btransform then
2548                    r = r + 1 ; result[r] = btransform
2549                end
2550                r = r + 1 ; result[r] = f_do_draw(shape)
2551                if pen     then
2552                    r = r + 1 ; result[r] = pen
2553                end
2554                if dashing then
2555                    r = r + 1 ; result[r] = dashing
2556                end
2557                if color then
2558                    r = r + 1 ; result[r] = color
2559                end
2560                if opacity then
2561                    r = r + 1 ; result[r] = opacity
2562                end
2563                r = r + 1 ; result[r] = etransform or "  ;"
2564                --
2565                if list then
2566                    addmarkers(list,begmarker,midmarker,endmarker,at)
2567                end
2568                --
2569                if wrapup then
2570                    wrapup()
2571                end
2572            end
2573
2574            if copacity then
2575                r = r + 1 ; result[r] = copacity
2576                r = r + 1 ; result[r] = eopacity
2577            end
2578
2579            if cpath then
2580                r = r + 1 ; result[r] = (cpath.evenodd and f_eoclip_stop or f_clip_stop)(cpath[1],ctransform)
2581            end
2582
2583        end
2584
2585        local f_rectangle = formatters['unitsquare xyscaled (%N,%N) shifted (%N,%N)']
2586        local f_rounded   = formatters['roundedsquarexy(%N,%N,%N,%N) shifted (%N,%N)']
2587        local f_line      = formatters['((%N,%N)--(%N,%N))']
2588        local f_ellipse   = formatters['(fullcircle xyscaled (%N,%N) shifted (%N,%N))']
2589        local f_circle    = formatters['(fullcircle scaled %N shifted (%N,%N))']
2590
2591        function handlers.line(c)
2592            local at = c.at
2593            local x1 = rawget(at,"x1")
2594            local y1 = rawget(at,"y1")
2595            local x2 = rawget(at,"x2")
2596            local y2 = rawget(at,"y2")
2597
2598            x1 = x1 and asnumber_vx(x1) or 0
2599            y1 = y1 and asnumber_vy(y1) or 0
2600            x2 = x2 and asnumber_vx(x2) or 0
2601            y2 = y2 and asnumber_vy(y2) or 0
2602
2603            flush(f_line(x1,y1,x2,y2),false,at)
2604        end
2605
2606        function handlers.rect(c)
2607            local at     = c.at
2608            local width  = rawget(at,"width")
2609            local height = rawget(at,"height")
2610            local x      = rawget(at,"x")
2611            local y      = rawget(at,"y")
2612            local rx     = rawget(at,"rx")
2613            local ry     = rawget(at,"ry")
2614
2615            width  = width  and asnumber_x(width)  or 0
2616            height = height and asnumber_y(height) or 0
2617            x      = x      and asnumber_vx(x) or 0
2618            y      = y      and asnumber_vy(y) or 0
2619
2620            y      = y - height
2621
2622            if rx then rx = asnumber_x(rx) end
2623            if ry then ry = asnumber_y(ry) end
2624
2625            if rx or ry then
2626                if not rx then rx = ry end
2627                if not ry then ry = rx end
2628                flush(f_rounded(width,height,rx,ry,x,y),true,at)
2629            else
2630                flush(f_rectangle(width,height,x,y),true,at)
2631            end
2632        end
2633
2634        function handlers.ellipse(c)
2635            local at = c.at
2636            local cx = rawget(at,"cx")
2637            local cy = rawget(at,"cy")
2638            local rx = rawget(at,"rx")
2639            local ry = rawget(at,"ry")
2640
2641            cx = cx and asnumber_vx(cx) or 0
2642            cy = cy and asnumber_vy(cy) or 0
2643            rx = rx and asnumber_r (rx) or 0
2644            ry = ry and asnumber_r (ry) or 0
2645
2646            flush(f_ellipse(2*rx,2*ry,cx,cy),true,at)
2647        end
2648
2649        function handlers.circle(c)
2650            local at = c.at
2651            local cx = rawget(at,"cx")
2652            local cy = rawget(at,"cy")
2653            local r  = rawget(at,"r")
2654
2655            cx = cx and asnumber_vx(cx) or 0
2656            cy = cy and asnumber_vy(cy) or 0
2657            r  = r  and asnumber_r (r)  or 0
2658
2659            flush(f_circle(2*r,cx,cy),true,at)
2660        end
2661
2662        local f_lineto_z  = formatters['(%N,%N)']
2663        local f_lineto_n  = formatters['--(%N,%N)']
2664
2665        local p_pair     = p_optseparator * p_number_vx * p_optseparator * p_number_vy
2666        local p_open     = Cc("(")
2667        local p_close    = Carg(1) * P(true) / function(s) return s end
2668        local p_polyline = Cs(p_open * (p_pair / f_lineto_z) * (p_pair / f_lineto_n)^0 * p_close)
2669        local p_polypair = Ct(p_pair^0)
2670
2671        local function poly(c,final)
2672            local at     = c.at
2673            local points = rawget(at,"points")
2674            if points then
2675                local path = lpegmatch(p_polyline,points,1,final)
2676                local list = nil
2677                local begmarker = rawget(at,"marker-start")
2678                local midmarker = rawget(at,"marker-mid")
2679                local endmarker = rawget(at,"marker-end")
2680                if begmarker or midmarker or endmarker then
2681                    list = lpegmatch(p_polypair,points)
2682                end
2683                flush(path,true,at,list,begmarker,midmarker,endmarker)
2684            end
2685        end
2686
2687        function handlers.polyline(c) poly(c,       ")") end
2688        function handlers.polygon (c) poly(c,"--cycle)") end
2689
2690        local s_image_start <const> = "draw image ("
2691        local s_image_stop  <const> = ") ;"
2692
2693        function handlers.path(c)
2694            local at = c.at
2695            local d  = rawget(at,"d")
2696            if d then
2697                local shape, l = grabpath(d)
2698                local fill     = at["fill"] or "black"
2699                local stroke   = at["stroke"] or "none"
2700                local n        = #shape
2701
2702                local btransform, etransform = handletransform(at)
2703                local cpath = handleclippath(at)
2704                if cpath then
2705                    r = r + 1 ; result[r] = s_clip_start
2706                end
2707
2708                -- todo: image (nicer for transform too)
2709
2710                if fill and fill ~= "none" then
2711                    local color, opacity, option = fillproperties(fill,at)
2712                    local f_xx_fill = at["fill-rule"] == "evenodd"
2713                    if option == "pattern" then
2714                        f_xx_fill = f_closed_draw
2715                    elseif shape.closed then
2716                        f_xx_fill = f_xx_fill and f_eo_fill   or f_do_fill
2717                    elseif shape.curve then
2718                        f_xx_fill = f_xx_fill and f_eo_fill_c or f_do_fill_c
2719                    else
2720                        f_xx_fill = f_xx_fill and f_eo_fill_l or f_do_fill_l
2721                    end
2722                    if n == 1 then
2723                        if btransform then
2724                            r = r + 1 ; result[r] = btransform
2725                        end
2726                        r = r + 1 result[r] = f_xx_fill(shape[1])
2727                        if color then
2728                            r = r + 1 ; result[r] = color
2729                        end
2730                        if opacity then
2731                            r = r + 1 ; result[r] = opacity
2732                        end
2733                        r = r + 1 ; result[r] = etransform or "  ;"
2734                    else
2735                        r = r + 1 ; result[r] = btransform or s_image_start
2736                        for i=1,n do
2737                            if i == n then
2738                                r = r + 1 ; result[r] = f_xx_fill(shape[i])
2739                                if color then
2740                                    r = r + 1 ; result[r] = color
2741                                end
2742                                if opacity then
2743                                    r = r + 1 ; result[r] = opacity
2744                                end
2745                            else
2746                                r = r + 1 ; result[r] = f_no_fill(shape[i])
2747                            end
2748                            r = r + 1 ; result[r] = "  ;"
2749                        end
2750                        r = r + 1 ; result[r] = etransform or s_image_stop
2751                    end
2752                end
2753
2754                if stroke and stroke ~= "none" then
2755                    local begmarker = rawget(at,"marker-start")
2756                    local midmarker = rawget(at,"marker-mid")
2757                    local endmarker = rawget(at,"marker-end")
2758                    if begmarker or midmarker or endmarker then
2759                        list = grablist(l)
2760                    end
2761                    local wrapup = startlineproperties(at)
2762                    local pen, dashing, color, opacity = drawproperties(stroke,at)
2763                    if n == 1 and not list then
2764                        if btransform then
2765                            r = r + 1 ; result[r] = btransform
2766                        end
2767                        r = r + 1 result[r] = f_do_draw(shape[1])
2768                        if pen then
2769                            r = r + 1 ; result[r] = pen
2770                        end
2771                        if dashing then
2772                            r = r + 1 ; result[r] = dashing
2773                        end
2774                        if color then
2775                            r = r + 1 ; result[r] = color
2776                        end
2777                        if opacity then
2778                            r = r + 1 ; result[r] = opacity
2779                        end
2780                        r = r + 1 result[r] = etransform or "  ;"
2781                    else
2782                        r = r + 1 result[r] = btransform or s_draw_image_start
2783                        for i=1,n do
2784                            r = r + 1 result[r] = f_do_draw(shape[i])
2785                            if pen then
2786                                r = r + 1 ; result[r] = pen
2787                            end
2788                            if dashing then
2789                                r = r + 1 ; result[r] = dashing
2790                            end
2791                            if color then
2792                                r = r + 1 ; result[r] = color
2793                            end
2794                            if opacity then
2795                                r = r + 1 ; result[r] = opacity
2796                            end
2797                            r = r + 1 ; result[r] = "  ;"
2798                        end
2799                        if list then
2800                            addmarkers(list,begmarker,midmarker,endmarker,at)
2801                        end
2802                        r = r + 1 ; result[r] = etransform or s_draw_image_stop
2803                    end
2804                    if wrapup then
2805                        wrapup()
2806                    end
2807                end
2808
2809                if cpath then
2810                    r = r + 1 ; result[r] = f_clip_stop(cpath[1],"")
2811                end
2812
2813            end
2814        end
2815
2816    end
2817
2818    -- kind of special
2819
2820    do
2821
2822        -- some day:
2823        --
2824        -- specification = identifiers.jpg(data."string")
2825        -- specification.data = data
2826        -- inclusion takes from data
2827        -- specification.data = false
2828
2829     -- local f_image = formatters[ [[figure("%s") xysized (%N,%N) shifted (%N,%N)]] ]
2830        local f_image = formatters[ [[svgembeddedfigure(%i) xysized (%N,%N) shifted (%N,%N)]] ]
2831
2832     -- local nofimages = 0
2833
2834        function handlers.image(c)
2835            local at = c.at
2836            local im = rawget(at,"xlink:href")
2837            if im then
2838                local kind, data = match(im,"^data:image/([a-z]+);base64,(.*)$")
2839                if kind == "png" then
2840                    -- ok
2841                elseif kind == "jpeg" then
2842                    kind = "jpg"
2843                else
2844                    kind = false
2845                end
2846                if kind and data then
2847                    local w  = rawget(at,"width")
2848                    local h  = rawget(at,"height")
2849                    local x  = rawget(at,"x")
2850                    local y  = rawget(at,"y")
2851                    w = w and asnumber_x(w)
2852                    h = h and asnumber_y(h)
2853                    x = x and asnumber_vx(x) or 0
2854                    y = y and asnumber_vy(y) or 0
2855                    local data = basexx.decode64(data)
2856                 -- local name  = "temp-svg-image-" .. nofimages .. "." .. kind
2857                    local index = images.storedata("svg", {
2858                        kind = kind,
2859                        data = data,
2860                        info = graphics.identifiers[kind](data,"string"),
2861                    })
2862                 -- io.savedata(name,data)
2863                    if not w or not h then
2864                        if info then
2865                            -- todo: keep aspect ratio attribute
2866                            local xsize = info.xsize
2867                            local ysize = info.ysize
2868                            if not w then
2869                                if not h then
2870                                    w = xsize
2871                                    h = ysize
2872                                else
2873                                    w = (h / ysize) * xsize
2874                                end
2875                            else
2876                                h = (w / xsize) * ysize
2877                            end
2878                        end
2879                    end
2880                    -- safeguard:
2881                    if not w then w = h or 1 end
2882                    if not h then h = w or 1 end
2883                 -- luatex.registertempfile(name)
2884                 -- flushobject(f_image(name,w,h,x,y - h),at)
2885                    flushobject(f_image(index,w,h,x,y - h),at)
2886                else
2887                    -- nothing done
2888                end
2889            end
2890        end
2891
2892    end
2893
2894    -- these transform: g a text svg symbol
2895
2896    do
2897
2898        function handlers.a(c)
2899            process(c,"/*")
2900        end
2901
2902        function handlers.g(c) -- much like flushobject so better split and share
2903            local at = c.at
2904
2905            local btransform, etransform, transform = handletransform(at)
2906            local cpath, clippath, ctransform = handleclippath(at)
2907
2908            if cpath then
2909                r = r + 1 ; result[r] = s_clip_start
2910            end
2911
2912            if btransform then
2913                r= r + 1 result[r] = btransform
2914            end
2915
2916            local _transform = transform
2917            local _clippath  = clippath
2918            at["transform"] = false
2919            at["clip-path"] = false
2920
2921            process(c,"/!(defs|symbol)") -- /*
2922
2923            at["transform"] = _transform
2924            at["clip-path"] = _clippath
2925
2926            if etransform then
2927                r = r + 1 ; result[r] = etransform
2928            end
2929
2930            if cpath then
2931                local f_done = cpath.evenodd
2932                if cpath.curve then
2933                    f_done = f_done and f_eoclip_stop_c or f_clip_stop_c
2934                else
2935                    f_done = f_done and f_eoclip_stop_l or f_clip_stop_l
2936                end
2937                r = r + 1 ; result[r] = f_done(cpath[1],ctransform or "")
2938            end
2939        end
2940
2941        -- this will never really work out
2942        --
2943        -- todo: register text in lua in mapping with id, then draw mapping unless overloaded
2944        --       using lmt_svglabel with family,style,weight,size,id passed
2945
2946        -- nested tspans are messy: they can have displacements but in inkscape we also
2947        -- see x and y (inner and outer element)
2948
2949        -- The size is a bit of an issue. I assume that the specified size relates to the
2950        -- designsize but we want to be able to use other fonts.
2951
2952        -- a mix of text and spans and possibly wrap (where xy is to be ignored) ... bah ...
2953        -- it's fuzzy when we have a span with positions mixed with text ... basically that
2954        -- is a box and we can assume that an editor then has all positioned
2955
2956        do
2957
2958            local s_start     <const> = "\\svgstart "
2959            local s_stop      <const> = "\\svgstop "
2960            local f_set               = formatters["\\svgset{%N}{%N}"] -- we need a period
2961            local f_color_c           = formatters["\\svgcolorc{%.3N}{%.3N}{%.3N}{"]
2962            local f_color_o           = formatters["\\svgcoloro{%.3N}{"]
2963            local f_color_b           = formatters["\\svgcolorb{%.3N}{%.3N}{%.3N}{%.3N}{"]
2964            local f_poscode           = formatters["\\svgpcode{%N}{%N}{%s}"]
2965            local f_poschar           = formatters["\\svgpchar{%N}{%N}{%s}"]
2966            local f_posspace          = formatters["\\svgpspace{%N}{%N}"]
2967            local f_code              = formatters["\\svgcode{%s}"]
2968            local f_char              = formatters["\\svgchar{%s}"]
2969            local s_space     <const> = "\\svgspace "
2970            local f_size              = formatters["\\svgsize{%0.6f}"]             -- we need a period
2971            local f_font              = formatters["\\svgfont{%s}{%s}{%s}"]
2972            local f_hashed            = formatters["\\svghashed{%s}"]
2973
2974            ----- p_texescape = lpegpatterns.texescape
2975
2976            local anchors = {
2977                ["start"]  = "drt",
2978                ["end"]    = "dlft",
2979                ["middle"] = "d",
2980            }
2981
2982            -- we can now just use the lmt maptext feature
2983
2984            local f_text_normal_svg   = formatters['(onetimetextext.%s("%s") shifted (%N,%N))']
2985            local f_text_simple_svg   = formatters['onetimetextext.%s("%s")']
2986            local f_mapped_normal_svg = formatters['(svgtext("%s") shifted (%N,%N))']
2987            local f_mapped_simple_svg = formatters['svgtext("%s")']
2988
2989            local cssfamily  = css.family
2990            local cssstyle   = css.style
2991            local cssweight  = css.weight
2992            local csssize    = css.size
2993
2994            local usedfonts  = setmetatableindex(function(t,k)
2995                local v = setmetatableindex("table")
2996                t[k] = v
2997                return v
2998            end)
2999
3000            -- For now as I need it for my (some 1500) test files.
3001
3002            local function checkedfamily(name)
3003                if find(name,"^.-verdana.-$") then
3004                    name = "verdana"
3005                end
3006                return name
3007            end
3008
3009            -- todo: only escape some chars and handle space
3010
3011         -- An arbitrary mix of text and spans with x/y is asking for troubles. The fact that the
3012         -- description in the (proposed) standard is so complex indicates this (its also looks
3013         -- like reveng application specs and doesn't aim at simplicity. Basically we have two
3014         -- cases: positioned lines and words and such (text & span with xy), or just stripes of
3015         -- text and span. Free flow automatically broken into lines text is kind of strange in
3016         -- svg and the fact that glyph placement is dropped is both an indication that svg lost
3017         -- part of its purpose and probably also that it never really was a standard (although
3018         -- maybe today standards are just short term specifications. Who knows.
3019
3020         -- text with spans, all with x/y
3021         -- text mixed with spans, no xy in inner elements
3022         --
3023         -- the spec says that nested x/y are absolute
3024
3025            local defaultsize = 10
3026
3027            local sensitive = { -- todo: characters.sensitive
3028                ["#"] = true,
3029                ["$"] = true,
3030                ["%"] = true,
3031                ["&"] = true,
3032               ["\\"] = true,
3033                ["{"] = true,
3034                ["|"] = true,
3035                ["}"] = true,
3036                ["~"] = true,
3037            }
3038
3039            -- messy: in nested spans (they happen) the x/y are not accumulated
3040
3041            local function validdelta(usedscale,d)
3042                if d then
3043                    local value, unit = match(d,"^([%A]-)(%a+)")
3044                    value = tonumber(value) or 0
3045                    if not unit then
3046                        return value .. "bp"
3047                    elseif unit == "ex" or unit == "em" then
3048                        return (usedscale * value) .. unit
3049                    else
3050                        return value .. "bp"
3051                    end
3052                else
3053                    return "0bp"
3054                end
3055            end
3056
3057            local cleanfontname = fonts.names.cleanname
3058
3059            local x_family = false
3060            local x_weight = false
3061            local x_style  = false
3062
3063            local function collect(parent,t,c,x,y,size,scale,family,tx,ty,tdx,tdy)
3064                if c.special then
3065                    return nil
3066                end
3067                local dt           = c.dt
3068                local nt           = #dt
3069                local at           = c.at
3070                local tg           = c.tg
3071                local ax           = rawget(at,"x")
3072                local ay           = rawget(at,"y")
3073                local v_opacity    = tonumber(at["fill-opacity"])
3074                local v_fill       = at["fill"]
3075                local v_family     = at["font-family"]
3076                local v_style      = at["font-style"]
3077                local v_weight     = at["font-weight"]
3078                local v_size       = at["font-size"]
3079                local v_lineheight = at["line-height"]
3080                --
3081                ax = ax and asnumber_vx(ax) or x
3082                ay = ay and asnumber_vy(ay) or y
3083                --
3084                if v_family then v_family = cssfamily(v_family) end
3085                if v_style  then v_style  = cssstyle (v_style)  end
3086                if v_weight then v_weight = cssweight(v_weight) end
3087                if v_size   then v_size   = csssize  (v_size,factors,size/100) or tonumber(v_size) end
3088                --
3089                if not v_family then v_family = family   end
3090                if not v_weight then v_weight = "normal" end
3091                if not v_style  then v_style  = "normal" end
3092                --
3093                if v_family then
3094                    v_family = cleanfontname(v_family)
3095                    v_family = checkedfamily(v_family)
3096                end
3097                --
3098                usedfonts[v_family][v_weight][v_style] = true
3099                --
3100                local lh = v_lineheight and asnumber_vx(v_lineheight) or false
3101                --
3102                ax = ax - x
3103                ay = ay - y
3104                --
3105                local usedsize  = v_size or defaultsize
3106                local usedscale = usedsize / defaultsize
3107                --
3108                -- todo: rotate            : list of numbers
3109                -- todo: lengthAdjust      : spacing|spacingAndGlyphs
3110                -- todo: textLength        : scale to width
3111                -- toto: font-size-adjust
3112                -- toto: font-stretch
3113                -- letter-spacing
3114                -- word-spacing
3115                -- writing-mode:lr-tb
3116                --
3117                local newfont = v_family ~= x_family or v_weight ~= x_weight or v_style ~= x_style
3118                if newfont then
3119                    x_family = v_family
3120                    x_weight = v_weight
3121                    x_style  = v_style
3122                    t[#t+1] = f_font(v_family,v_weight,v_style)
3123                    t[#t+1] = "{"
3124                end
3125                t[#t+1] = f_size(usedscale)
3126                t[#t+1] = "{"
3127                --
3128                if trace_fonts then
3129                    -- we can hash and keep it when no change
3130                    report("element        : %s",c.tg)
3131                    report("  font family  : %s",v_family)
3132                    report("  font weight  : %s",v_weight)
3133                    report("  font style   : %s",v_style)
3134                    report("  parent size  : %s",size)
3135                 -- report("  parent scale : %s",scale)
3136                    report("  used size    : %s",v_size or defaultsize)
3137                end
3138                --
3139                local ecolored = v_fill    ~= ""             and v_fill    or false
3140                local opacity  = v_opacity ~= ignoredopacity and v_opacity or false
3141                --
3142                -- todo cmyk
3143                --
3144                if ecolored then
3145                    local r, g, b = colorcomponents(v_fill)
3146                    if r and g and b then
3147                        if opacity then
3148                            t[#t+1] = f_color_b(r,g,b,opacity)
3149                        else
3150                            t[#t+1] = f_color_c(r,g,b)
3151                        end
3152                    elseif opacity then
3153                        t[#t+1] = f_color_o(opacity)
3154                    else
3155                        ecolored = false
3156                    end
3157                elseif opacity then
3158                    t[#t+1] = f_color_o(opacity)
3159                end
3160                --
3161                local hasa = ax ~= 0 or ay ~= 0
3162                if hasa then
3163                    -- we abuse the fact that flushing layers can be nested
3164                    t[#t+1] = f_set(ax or 0,ay or 0)
3165                    t[#t+1] = "{"
3166                end
3167                for i=1,nt do
3168                    local di = dt[i]
3169                    if type(di) == "table" then
3170                        -- when x or y then absolute else inline
3171                        if #di.dt > 0 then
3172                            collect(tg,t,di,x,y,usedsize,usedscale,v_family)
3173                        end
3174                    else
3175                        -- check for preserve
3176                        if i == 1 then
3177                            di = gsub(di,"^%s+","")
3178                        end
3179                        if i == nt then
3180                            di = gsub(di,"%s+$","")
3181                        end
3182                        local chars = utfsplit(di)
3183                        if svghash then
3184                            -- dx dy
3185                            di = f_hashed(svghash[di])
3186                        else
3187                            if tx or ty or tdx or tdy then
3188                                local txi, tyi, tdxi, tdyi
3189                                for i=1,#chars do
3190                                    txi  = tx  and (tx [i] or txi )
3191                                    tyi  = ty  and (ty [i] or tyi )
3192                                    tdxi = tdx and (tdx[i] or tdxi) or 0
3193                                    tdyi = tdy and (tdy[i] or tdyi) or 0
3194                                    local dx = (txi and (txi - x) or 0) + tdxi
3195                                    local dy = (tyi and (tyi - y) or 0) + tdyi
3196                                    local ci = chars[i]
3197                                    if ci == " " then
3198                                        chars[i] = f_posspace(dx, dy)
3199                                    elseif sensitive[ci] then
3200                                        chars[i] = f_poscode(dx, dy, utfbyte(ci))
3201                                    else
3202                                        chars[i] = f_poschar(dx, dy, ci)
3203                                    end
3204                                end
3205                                di = "{" .. concat(chars) .. "}"
3206                                t[#t+1] = di
3207                            else
3208                                -- this needs to be texescaped ! and even quotes and newlines
3209                                -- or we could register it but that's a bit tricky as we nest
3210                                -- and don't know what we can expect here
3211                             -- di = lpegmatch(p_texescape,di) or di
3212                                for i=1,#chars do
3213                                    local ci = chars[i]
3214                                    if ci == " " then
3215                                        chars[i] = s_space
3216                                    elseif sensitive[ci] then
3217                                        chars[i] = f_code(utfbyte(ci))
3218                                    else
3219                                        chars[i] = f_char(ci)
3220                                     -- chars[i] = ci
3221                                    end
3222                                end
3223                                di = concat(chars)
3224                                t[#t+1] = di
3225                            end
3226                        end
3227                    end
3228                end
3229                if hasa then
3230                    if t[#t] == "{" then
3231                        t[#t] = nil
3232                        t[#t] = nil
3233                    else
3234                        t[#t+1] = "}"
3235                    end
3236                end
3237                --
3238                if opacity or ecolored then
3239                    t[#t+1] = "}"
3240                end
3241                --
3242                t[#t+1] = "}"
3243                --
3244                if newfont then
3245                    t[#t+1] = "}"
3246                end
3247                --
3248                return t
3249            end
3250
3251            -- case 1: just text, maybe with spans
3252            -- case 2: only positioned spans
3253            -- case 3: just text, seen as label
3254
3255            local textlevel = 0
3256
3257            function handlers.text(c)
3258                if textlevel == 0 then
3259                    x_family = v_family
3260                    x_weight = v_weight
3261                    x_style  = v_style
3262                end
3263                --
3264                textlevel = textlevel + 1
3265                -- analyze
3266                local only = fullstrip(xmltextonly(c))
3267                local at   = c.at
3268                local x    = rawget(at,"x")
3269                local y    = rawget(at,"y")
3270
3271                local dx   = rawget(at,"dx")
3272                local dy   = rawget(at,"dy")
3273
3274                local tx   = asnumber_vx_t(x)
3275                local ty   = asnumber_vy_t(y)
3276
3277                local tdx  = asnumber_vx_t(dx)
3278                local tdy  = asnumber_vy_t(dy)
3279
3280                x  = tx[1]  or 0 -- catch bad x/y spec
3281                y  = ty[1]  or 0 -- catch bad x/y spec
3282
3283                dx = tdx[1] or 0 -- catch bad x/y spec
3284                dy = tdy[1] or 0 -- catch bad x/y spec
3285
3286                local v_fill = at["fill"]
3287                if not v_fill or v_fill == "none" then
3288                    v_fill = "black"
3289                end
3290                local color, opacity, option = fillproperties(v_fill,at)
3291                local anchor = anchors[at["text-anchor"] or "start"] or "drt"
3292                local remap = metapost.remappedtext(only)
3293                -- x = x + dx
3294                -- y = y + dy
3295                if remap then
3296                    if x == 0 and y == 0 then
3297                        only = f_mapped_simple_svg(remap.index)
3298                    else
3299                        only = f_mapped_normal_svg(remap.index,x,y)
3300                    end
3301                    flushobject(only,at,color,opacity)
3302                    if trace_text then
3303                        report("text: %s",only)
3304                    end
3305                elseif option == "invisible" then
3306                    if trace_text then
3307                        report("invisible text: %s",only)
3308                    end
3309                else
3310                    local scale  = 1
3311                    local textid = 0
3312                    local result = { }
3313                    local nx     = #tx
3314                    local ny     = #ty
3315                    local ndx    = #tdx
3316                    local ndy    = #tdy
3317                    --
3318                    local t = { }
3319                    t[#t+1] = s_start
3320                    if nx > 1 or ny > 1 or ndx > 1 or ndy > 1 then
3321                        collect(tg,t,c,x,y,defaultsize,1,"serif",tx,ty,tdx,tdy)
3322                    else
3323                        collect(tg,t,c,x,y,defaultsize,1,"serif")
3324                    end
3325                    t[#t+1] = s_stop
3326                    t = concat(t)
3327                    if x == 0 and y == 0 then
3328                        t = f_text_simple_svg(anchor,t)
3329                    else -- dx dy
3330                        t = f_text_normal_svg(anchor,t,x,y)
3331                    end
3332                 -- flushobject(t,at,color,opacity) -- otherwise mixup with transparency
3333                    flushobject(t,at,false,false)
3334                    if trace_text then
3335                        report("text: %s",result)
3336                    end
3337                end
3338                --
3339                textlevel = textlevel - 1
3340            end
3341
3342            function metapost.reportsvgfonts()
3343                for family, weights in sortedhash(usedfonts) do
3344                    for weight, styles in sortedhash(weights) do
3345                        for style in sortedhash(styles) do
3346                            report("used font: %s-%s-%s",family,weight,style)
3347                        end
3348                    end
3349                end
3350            end
3351
3352            statistics.register("used svg fonts",function()
3353                if next(usedfonts) then
3354                    -- also in log file
3355                    logs.startfilelogging(report,"used svg fonts")
3356                    local t = { }
3357                    for family, weights in sortedhash(usedfonts) do
3358                        for weight, styles in sortedhash(weights) do
3359                            for style in sortedhash(styles) do
3360                                report("%s-%s-%s",family,weight,style)
3361                                t[#t+1] = formatters["%s-%s-%s"](family,weight,style)
3362                            end
3363                        end
3364                    end
3365                    logs.stopfilelogging()
3366                    return concat(t," ")
3367                end
3368            end)
3369
3370        end
3371
3372        function handlers.svg(c,x,y,w,h,noclip,notransform,normalize)
3373            local at = c.at
3374
3375            local wrapupviewport
3376            local bhacked
3377            local ehacked
3378            local wd = w
3379         -- local ex, em
3380            local xpct, ypct, rpct
3381
3382            local btransform, etransform, transform = handletransform(at)
3383
3384            if trace then
3385                report("view: %s, xpct %N, ypct %N","before",percentage_x,percentage_y)
3386            end
3387
3388            local viewbox = at.viewBox
3389
3390            if viewbox then
3391                x, y, w, h = handleviewbox(viewbox)
3392                if trace then
3393                    report("viewbox: x %N, y %N, width %N, height %N",x,y,w,h)
3394                end
3395            end
3396            if not w or not h or w == 0 or h == 0 then
3397                noclip = true
3398            end
3399            if h then
3400                --
3401             -- em = factors["em"]
3402             -- ex = factors["ex"]
3403             -- factors["em"] = em
3404             -- factors["ex"] = ex
3405                --
3406                xpct = percentage_x
3407                ypct = percentage_y
3408                rpct = percentage_r
3409                percentage_x = w / 100
3410                percentage_y = h / 100
3411                percentage_r = (sqrt(w^2 + h^2) / sqrt(2)) / 100
3412                if trace then
3413                    report("view: %s, xpct %N, ypct %N","inside",percentage_x,percentage_y)
3414                end
3415                wrapupviewport = viewport(x,y,w,h,noclip)
3416            end
3417            -- todo: combine transform and offset here
3418
3419            -- some fonts need this (bad transforms + viewbox)
3420            if v and normalize and w and wd and w ~= wd and w > 0 and wd > 0 then
3421                bhacked = s_wrapped_start
3422                ehacked = f_wrapped_stop(y or 0,wd/w)
3423            end
3424            if btransform then
3425                r = r + 1 ; result[r] = btransform
3426            end
3427            if bhacked then
3428                r = r + 1 ; result[r] = bhacked
3429            end
3430            local boffset, eoffset = handleoffset(at)
3431            if boffset then
3432                r = r + 1 result[r] = boffset
3433            end
3434
3435            at["transform"] = false
3436            at["viewBox"]   = false
3437
3438            process(c,"/!(defs|symbol)")
3439
3440            at["transform"] = transform
3441            at["viewBox"]   = viewbox
3442
3443            if eoffset then
3444                r = r + 1 result[r] = eoffset
3445            end
3446            if ehacked then
3447                r = r + 1 ; result[r] = ehacked
3448            end
3449            if etransform then
3450                r = r + 1 ; result[r] = etransform
3451            end
3452            if h then
3453                --
3454             -- factors["em"] = em
3455             -- factors["ex"] = ex
3456                --
3457                percentage_x = xpct
3458                percentage_y = ypct
3459                percentage_r = rpct
3460                if wrapupviewport then
3461                    wrapupviewport()
3462                end
3463            end
3464            if trace then
3465                report("view: %s, xpct %N, ypct %N","after",percentage_x,percentage_y)
3466            end
3467        end
3468
3469    end
3470
3471    process = function(x,p)
3472        for c in xmlcollected(x,p) do
3473            local tg = c.tg
3474            local h  = handlers[c.tg]
3475            if h then
3476                h(c)
3477            end
3478        end
3479    end
3480
3481    -- For huge inefficient files there can be lots of garbage to collect so
3482    -- maybe we should run the collector when a file is larger than say 50K.
3483
3484    function metapost.svgtomp(specification,pattern,notransform,normalize)
3485        local mps = ""
3486        local svg = specification.data
3487        images.resetstore("svg")
3488        if type(svg) == "string" then
3489            svg = xmlconvert(svg)
3490        end
3491        if svg then
3492            local c = xmlfirst(svg,pattern or "/svg")
3493            if c then
3494                root        = svg
3495                result      = { }
3496                r           = 0
3497                definitions = { }
3498                tagstyles   = { }
3499                classstyles = { }
3500                colormap    = specification.colormap
3501                usedcolors  = trace_colors and setmetatableindex("number") or false
3502                for s in xmlcollected(c,"style") do -- can also be in a def, so let's play safe
3503                    handlestyle(c)
3504                end
3505                handlechains(c)
3506                xmlinheritattributes(c) -- put this in handlechains
3507                handledefinitions(c)
3508                handlers.svg (
3509                    c,
3510                    specification.x,
3511                    specification.y,
3512                    specification.width,
3513                    specification.height,
3514                    specification.noclip,
3515                    notransform,
3516                    normalize,
3517                    specification.remap
3518                )
3519                if trace_result == "file" then
3520                    io.savedata(
3521                        tex.jobname .. "-svg-to-mp.tex",
3522                        "\\startMPpage[instance=doublefun]\n" .. concat(result,"\n") .. "\n\\stopMPpage\n"
3523                    )
3524                elseif trace_result then
3525                    report("result graphic:\n    %\n    t",result)
3526                end
3527                if usedcolors and next(usedcolors) then
3528                    report("graphic %a uses colors: %s",specification.id or "unknown",table.sequenced(usedcolors))
3529                end
3530                mps         = concat(result," ")
3531                root        = false
3532                result      = false
3533                r           = false
3534                definitions = false
3535                tagstyles   = false
3536                classstyles = false
3537                colormap    = false
3538            else
3539                report("missing svg root element")
3540            end
3541        else
3542            report("bad svg blob")
3543        end
3544        return mps
3545    end
3546
3547end
3548
3549-- These helpers might move to their own module .. some day ... also they will become
3550-- a bit more efficient, because we now go to mp and back which is kind of redundant,
3551-- but for now it will do.
3552
3553do
3554
3555    local bpfactor = number.dimenfactors.bp
3556
3557    function metapost.includesvgfile(filename,offset) -- offset in sp
3558        local fullname = resolvers.findbinfile(filename)
3559        if lfs.isfile(fullname) then
3560            context.startMPcode("doublefun")
3561                context('draw lmt_svg [ filename = "%s", offset = %N ] ;',filename,(offset or 0)*bpfactor)
3562            context.stopMPcode()
3563        end
3564    end
3565
3566    function metapost.includesvgbuffer(name,offset) -- offset in sp
3567        context.startMPcode("doublefun")
3568            context('draw lmt_svg [ buffer = "%s", offset = %N ] ;',name or "",(offset or 0)*bpfactor)
3569        context.stopMPcode()
3570    end
3571
3572    interfaces.implement {
3573        name      = "includesvgfile",
3574        actions   = metapost.includesvgfile,
3575        arguments = { "string", "dimension" },
3576    }
3577
3578    interfaces.implement {
3579        name      = "includesvgbuffer",
3580        actions   = metapost.includesvgbuffer,
3581        arguments = { "string", "dimension" },
3582    }
3583
3584    function metapost.showsvgpage(data)
3585        local dd = data.data
3586        if not dd then
3587            local filename = data.filename
3588            local fullname = filename and resolvers.findbinfile(filename)
3589            dd = fullname and table.load(fullname)
3590        end
3591        if type(dd) == "table" then
3592            local comment = data.comment
3593            local offset  = data.pageoffset
3594            local index   = data.index
3595            local first   = math.max(index or 1,1)
3596            local last    = math.min(index or #dd,#dd)
3597            for i=first,last do
3598                local d = setmetatableindex( {
3599                    data       = dd[i],
3600                    comment    = comment and i or false,
3601                    pageoffset = offset or nil,
3602                }, data)
3603                metapost.showsvgpage(d)
3604            end
3605        elseif data.method == "code" then
3606            context.startMPcode(doublefun)
3607                context(metapost.svgtomp(data))
3608            context.stopMPcode()
3609        else
3610            context.startMPpage { instance = "doublefun", offset = data.pageoffset or nil }
3611                context(metapost.svgtomp(data))
3612                local comment = data.comment
3613                if comment then
3614                    context("draw boundingbox currentpicture withcolor .6red ;")
3615                    context('draw textext.bot("\\strut\\tttf %s") ysized (10pt) shifted center bottomboundary currentpicture ;',comment)
3616                end
3617            context.stopMPpage()
3618        end
3619    end
3620
3621    function metapost.typesvgpage(data)
3622        local dd = data.data
3623        if not dd then
3624            local fn = data.filename
3625            dd = fn and table.load(fn)
3626        end
3627        if type(dd) == "table" then
3628            local index = data.index
3629            if index and index > 0 and index <= #dd then
3630                data = dd[index]
3631            else
3632                data = nil
3633            end
3634        end
3635        if type(data) == "string" and data ~= "" then
3636            buffers.assign("svgpage",data)
3637            context.typebuffer ({ "svgpage" }, { option = "XML", strip = "yes" })
3638        end
3639    end
3640
3641    function metapost.svgtopdf(data,...)
3642        local mps = metapost.svgtomp(data,...)
3643        if mps then
3644            -- todo: special instance, only basics needed
3645            local pdf = metapost.simple("metafun",mps,true,false,"svg")
3646            if pdf then
3647                return pdf
3648            else
3649                -- message
3650            end
3651        else
3652            -- message
3653        end
3654    end
3655
3656end
3657
3658do
3659
3660    local runner = sandbox.registerrunner {
3661        name     = "otfsvg2pdf",
3662        program  = "context",
3663        template = "--batchmode --purgeall --runs=2 %filename%",
3664        reporter = report_svg,
3665    }
3666
3667    -- By using an independent pdf file instead of pdf streams we can use resources and still
3668    -- cache. This is the old method updated. Maybe a future version will just do this runtime
3669    -- but for now this is the most efficient method.
3670
3671    local decompress = gzip.decompress
3672    local compress   = gzip.compress
3673
3674    function metapost.svgshapestopdf(svgshapes,pdftarget,report_svg)
3675        local texname   = "temp-otf-svg-to-pdf.tex"
3676        local pdfname   = "temp-otf-svg-to-pdf.pdf"
3677        local tucname   = "temp-otf-svg-to-pdf.tuc"
3678        local nofshapes = #svgshapes
3679        local pdfpages  = { filename = pdftarget }
3680        local pdfpage   = 0
3681        local t         = { }
3682        local n         = 0
3683        --
3684        os.remove(texname)
3685        os.remove(pdfname)
3686        os.remove(tucname)
3687        --
3688        if report_svg then
3689            report_svg("processing %i svg containers",nofshapes)
3690            statistics.starttiming(pdfpages)
3691        end
3692        --
3693        -- can be option:
3694        --
3695     -- n = n + 1 ; t[n] = "\\nopdfcompression"
3696        --
3697        n = n + 1 ; t[n] = "\\starttext"
3698        n = n + 1 ; t[n] = "\\setupMPpage[alternative=offset,instance=doublefun]"
3699        --
3700        for i=1,nofshapes do
3701            local entry = svgshapes[i]
3702            local data  = entry.data
3703            if decompress then
3704                data = decompress(data) or data
3705            end
3706            local specification = {
3707                data   = xmlconvert(data),
3708                x      = 0,
3709                y      = 1000,
3710                width  = 1000,
3711                height = 1000,
3712                noclip = true,
3713            }
3714            for index=entry.first,entry.last do
3715                if not pdfpages[index] then
3716                    pdfpage = pdfpage + 1
3717                    pdfpages[index] = pdfpage
3718                    local pattern = "/svg[@id='glyph" .. index .. "']"
3719                    n = n + 1 ; t[n] = "\\startMPpage"
3720                    n = n + 1 ; t[n] = metapost.svgtomp(specification,pattern,true,true) or ""
3721                    n = n + 1 ; t[n] = "\\stopMPpage"
3722                end
3723            end
3724        end
3725        n = n + 1 ; t[n] = "\\stoptext"
3726        io.savedata(texname,concat(t,"\n"))
3727        runner { filename = texname }
3728        os.remove(pdftarget)
3729        file.copy(pdfname,pdftarget)
3730        if report_svg then
3731            statistics.stoptiming(pdfpages)
3732            report_svg("svg conversion time %s",statistics.elapsedseconds(pdfpages))
3733        end
3734        os.remove(texname)
3735        os.remove(pdfname)
3736        os.remove(tucname)
3737        return pdfpages
3738    end
3739
3740    function metapost.svgshapestomp(svgshapes,report_svg)
3741        local nofshapes = #svgshapes
3742        local mpshapes = { }
3743        if report_svg then
3744            report_svg("processing %i svg containers",nofshapes)
3745            statistics.starttiming(mpshapes)
3746        end
3747        for i=1,nofshapes do
3748            local entry = svgshapes[i]
3749            local data  = entry.data
3750            if decompress then
3751                data = decompress(data) or data
3752            end
3753            local specification = {
3754                data   = xmlconvert(data),
3755                x      = 0,
3756                y      = 1000,
3757                width  = 1000,
3758                height = 1000,
3759                noclip = true,
3760            }
3761            for index=entry.first,entry.last do
3762                if not mpshapes[index] then
3763                    local pattern = "/svg[@id='glyph" .. index .. "']"
3764                    local mpcode  = metapost.svgtomp(specification,pattern,true,true) or ""
3765                    if mpcode ~= "" and compress then
3766                        mpcode = compress(mpcode) or mpcode
3767                    end
3768                    mpshapes[index] = mpcode
3769                end
3770            end
3771        end
3772        if report_svg then
3773            statistics.stoptiming(mpshapes)
3774            report_svg("svg conversion time %s",statistics.elapsedseconds(mpshapes))
3775        end
3776        return mpshapes
3777    end
3778
3779    function metapost.svgglyphtomp(fontname,unicode)
3780        if fontname and unicode then
3781            local id = fonts.definers.internal { name = fontname }
3782            if id then
3783                local tfmdata = fonts.hashes.identifiers[id]
3784                if tfmdata then
3785                    local properties = tfmdata.properties
3786                    local svg        = properties.svg
3787                    local hash       = svg and svg.hash
3788                    local timestamp  = svg and svg.timestamp
3789                    if hash then
3790                        local svgfile   = containers.read(fonts.handlers.otf.svgcache,hash)
3791                        local svgshapes = svgfile and svgfile.svgshapes
3792                        if svgshapes then
3793                            if type(unicode) == "string" then
3794                                unicode = utfbyte(unicode)
3795                            end
3796                            local chardata = tfmdata.characters[unicode]
3797                            local index    = chardata and chardata.index
3798                            if index then
3799                                for i=1,#svgshapes do
3800                                    local entry = svgshapes[i]
3801                                    if index >= entry.first and index <= entry.last then
3802                                        local data  = entry.data
3803                                        if data then
3804                                            local root = xml.convert(gzip.decompress(data) or data)
3805                                            return metapost.svgtomp (
3806                                                {
3807                                                    data   = root,
3808                                                    x      = 0,
3809                                                    y      = 1000,
3810                                                    width  = 1000,
3811                                                    height = 1000,
3812                                                    noclip = true,
3813                                                },
3814                                                "/svg[@id='glyph" .. index .. "']",
3815                                                true,
3816                                                true
3817                                            )
3818                                        end
3819                                    end
3820                                end
3821                            end
3822                        end
3823                    end
3824                end
3825            end
3826        end
3827    end
3828
3829end
3830