rgchris/svg-experiments.red

## svg-experiments.red
#!/usr/local/bin/red

Red [
    Title: "Parse SVG"
    Date: 23-Dec-2018
    Author: "Christopher Ross-Gill"
    Rights: http://opensource.org/licenses/Apache-2.0
]

; do %altxml.red
do https://raw.githubusercontent.com/rgchris/Scripts/master/experimental/altxml.red

neaten: func [
    block [block!] /pairs /flat /words
][
    either words [
        forall block [
            new-line block to logic! all [
                any-word? block/1
                not find [off _ x] block/1
            ]
        ]
    ][
        new-line/all/skip block not flat either pairs [2] [1]
    ]

    head block
]

load-svg: func [
    svg [string! binary!]
    /local kid kids desc defs
] bind [
    case/all [
        binary? svg [
            svg: to string! svg
        ]
        string? svg [
            svg: load-xml/dom svg
        ]
    ]

    neaten/words collect [
        keep 'svg
        keep handle-attributes svg
        keep/only either empty? kids: collect [
            foreach kid svg/children [
                if kid/type = 'element [
                    ; switch/default kid/name [
                    ;     ; defs [defs: handle-defs kid]
                    ;     desc [desc: kid/text]
                    ; ][
                        keep handle-kid kid
                    ; ]
                ]
            ]
        ][
            '_
        ][
            kids
        ]
    ]
]

make object! [
    adjust: func [
        value [integer! float! percent!]
    ][
        switch type?/word value [
            float! percent! [round/to value 0.001]
            integer! [value]
        ]
    ]

    number*: charset "-.0123456789"

    as-number: func [
        number [string!]
    ][
        case [
            not parse number [some number* opt "%"][number]
            #"%" = last number [to percent! number]
            find number "." [to decimal! number]
        ]
    ]

    as-pair: func [
        x [integer! float!]
        y [integer! float!]
    ][
        to paren! reduce (adjust x adjust y)
    ]

    parse-path: func [
        path [string!]
        /local part
    ][
        path: parse/case path [
            collect any [
                  #" " | #"^/"
                | #"A" keep ('arc)
                | #"C" keep ('curve)
                | #"H" keep ('hline)
                | #"L" keep ('line)
                | #"M" keep ('move)
                | #"Q" keep ('qcurve)
                | #"S" keep ('curv)
                | #"T" keep ('qcurv)
                | #"V" keep ('vline)
                | #"Z" keep ('close)
                | #"a" keep (quote 'arc)
                | #"c" keep (quote 'curve)
                | #"h" keep (quote 'hline)
                | #"l" keep (quote 'line)
                | #"m" keep (quote 'move)
                | #"q" keep (quote 'qcurve)
                | #"s" keep (quote 'curv)
                | #"t" keep (quote 'qcurv)
                | #"v" keep (quote 'vline)
                | #"z" keep ('close)
                | #"," ; keep ('x)
                | copy part some number* keep (
                    adjust load part
                )
            ]
        ]

        neaten/words path
    ]

    parse-style: func [
        style [string!]
        attributes [map!]
        /local key value
    ][
        ; quickie parsing for now
        style: split style charset ":;"
        foreach [key value] style [
            key: to word! trim/head/tail key
            value: trim/head/tail value
            attributes/(key): any [
                attempt [load value]
                value
            ]
        ]
    ]

    parse-transformation: func [
        transformation [string!]
        /local type part value
    ][
        transformation: if parse transformation [
            copy type [
                "matrix" | "rotate" | "scale" | "translate" | "skew" | "clip"
            ]
            "(" copy part to ")" skip
        ][
            collect [
                keep to word! type
                keep parse-path part
            ]
        ]
    ]

    handle-attributes: func [
        node [object!]
        /local facet red-facet style attribute value
    ][
        attributes: make map! collect [
            foreach attribute node/attributes [
                unless attribute/name = 'style [
                    keep attribute/name
                    keep/only switch/default attribute/name [
                        viewbox [
                            if all [
                                value: attempt [load attribute/value]
                                parse value [4 integer!]
                            ][
                                reduce [
                                    adjust value/1 'x adjust value/2
                                    adjust value/3 'x adjust value/4
                                ]
                            ]
                        ]

                        fill stroke [
                            any [
                                attempt [load attribute/value]
                                attribute/value
                            ]
                        ]

                        id [
                            attribute/value
                        ]

                        d points stroke-dasharray [
                            parse-path attribute/value
                        ]

                        transform [
                            parse-transformation attribute/value
                        ]

                        x y cx cy r width height stroke-width font-size [
                            switch/default to word! type? value: attempt [load attribute/value][
                                integer! float! [adjust value]
                                percent! [value]
                            ][
                                attribute/value
                            ]
                        ]

                        font-family [
                            attribute/value
                        ]
                    ][
                        any [
                            attempt [load attribute/value]
                            attribute/value
                        ]
                    ]
                ]
            ]
        ]

        if style: node/get #style [
            parse-style style attributes
        ]

        attributes
    ]

    handle-kid: func [
        node [object!]
        /local attributes kids kid
    ][
        neaten/words collect [
            keep switch/default node/name [
                g ['group]
            ][
                node/name
            ]
            keep attributes: handle-attributes node
            keep/only either empty? kids: collect [
                foreach kid node/children [
                    switch/default kid/type [
                        element [
                            keep handle-kid kid
                        ]
                        text [
                            keep quote 'text
                            keep '_
                            keep kid/value
                        ]
                        whitespace
                    ][
                        probe kid/type
                    ]
                ]
            ][
                '_
            ][
                kids
            ]
        ]
    ]
]

svg-to-draw: func [
    svg-block [block!] "Block created from LOAD-SVG function"
    /scale scalar [integer!]
    /local node attributes kids
] bind [
    scalar: to float! any [:scalar 1]

    neaten/words collect [
        foreach [node attributes kids] svg-block [
            switch/default node [
                svg [
                    keep compose [
                        (set-style attributes)
                        (svg-to-draw/scale kids to integer! scalar)
                    ]
                ]

                defs [
                    ; to follow
                ]

                clippath [
                    ; to follow
                ]

                group [
                    keep 'push
                    keep/only compose [
                        (set-style attributes)
                        (svg-to-draw/scale kids to integer! scalar)
                    ]
                ]

                rect [
                    keep 'push
                    keep/only neaten/words collect [
                        keep set-style attributes
                        keep 'box
                        keep as-pair attributes/x attributes/y
                        keep as-pair attributes/x + attributes/width attributes/y + attributes/height
                        ; only one radius dimension allowed...
                        if any [
                            attributes/rx
                            attributes/ry
                        ][
                            keep any [
                                attributes/rx
                                attributes/ry
                            ]
                        ]
                    ]
                ]

                circle [
                    keep 'push
                    keep/only neaten/words compose [
                        (set-style attributes)
                        circle
                        (as-pair attributes/cx attributes/cy)
                        (attributes/r)
                    ]
                ]

                ellipse [
                    keep 'push
                    keep/only neaten/words compose [
                        (set-style attributes)
                        circle
                        (as-pair attributes/cx attributes/cy)
                        (attributes/rx)
                        (attributes/ry)
                    ]
                ]

                line [
                    keep 'push
                    keep/only neaten/words compose [
                        (set-style attributes)
                        line
                        (as-pair attributes/x1 attributes/y1)
                        (as-pair attributes/x2 attributes/y2)
                    ]
                ]

                polyline [
                    keep 'push
                    keep/only neaten/words compose [
                        (set-style attributes)
                        line (numbers-to-points attributes/points)
                    ]
                ]

                polygon [
                    keep 'push
                    keep/only neaten/words compose [
                        (set-style attributes)
                        polygon (numbers-to-points attributes/points)
                    ]
                ]

                path [
                    keep 'push
                    keep/only neaten/words compose/deep [
                        (set-style attributes)
                        shape [(path-to-points attributes/d)]
                    ]
                ]

                text [
                    ; Here be dragons
                    ; keep 'text
                    ; keep compose [
                    ;     (set-style attributes)
                    ;     text
                    ; ]
                ]
            ][
                probe node
            ]
        ]
    ]
]

make object! [
    path-to-points: func [
        path [block!]
        /local
        mark part
    ][
        parse path [
            collect some [
                mark:
                ['move | quote 'move | 'line | quote 'line] 2 number!
                keep (mark/1)
                keep (as-pair mark/2 mark/3)
                |
                ['hline | quote 'hline | 'vline | quote 'vline] number!
                keep (mark/1)
                keep (mark/2)
                |
                ['arc | quote 'arc] 7 number!
                keep (mark/1)
                keep (as-pair mark/7 mark/8)
                keep (mark/2)
                keep (mark/3)
                keep (mark/4)
                opt [if (mark/6 = 1) keep ('sweep)]
                opt [if (mark/5 = 1) keep ('large)]
                |
                ['curve | quote 'curve] 6 number!
                keep (mark/1)
                keep (as-pair mark/2 mark/3)
                keep (as-pair mark/4 mark/5)
                keep (as-pair mark/6 mark/7)
                |
                ['qcurv | quote 'qcurv] 2 number!
                keep (mark/1)
                keep (as-pair mark/2 mark/3)
                |
                'close
                keep (mark/1)
                |
                skip ; should not happen
                keep (mark/1)
            ]
        ]
    ]

    numbers-to-points: func [
        numbers [block!]
        /local mark
    ][
        parse numbers [
            collect [
                some [
                    mark: number! number!
                    keep (as-pair mark/1 mark/2)
                ]
            ]
        ]
    ]

    colors: #(
        none: off
        transparent: off
        black: #000000
        navy: #000080
        darkblue: #00008b
        mediumblue: #0000cd
        blue: #0000ff
        darkgreen: #006400
        green: #008000
        teal: #008080
        darkcyan: #008b8b
        deepskyblue: #00bfff
        darkturquoise: #00ced1
        mediumspringgreen: #00fa9a
        lime: #00ff00
        springgreen: #00ff7f
        cyan: #00ffff
        aqua: #00ffff
        midnightblue: #191970
        dodgerblue: #1e90ff
        lightseagreen: #20b2aa
        forestgreen: #228b22
        seagreen: #2e8b57
        darkslategray: #2f4f4f
        darkslategrey: #2f4f4f
        limegreen: #32cd32
        mediumseagreen: #3cb371
        turquoise: #40e0d0
        royalblue: #4169e1
        steelblue: #4682b4
        darkslateblue: #483d8b
        mediumturquoise: #48d1cc
        indigo: #4b0082
        darkolivegreen: #556b2f
        cadetblue: #5f9ea0
        cornflowerblue: #6495ed
        mediumaquamarine: #66cdaa
        dimgrey: #696969
        dimgray: #696969
        slateblue: #6a5acd
        olivedrab: #6b8e23
        slategrey: #708090
        slategray: #708090
        lightslategray: #778899
        lightslategrey: #778899
        mediumslateblue: #7b68ee
        lawngreen: #7cfc00
        chartreuse: #7fff00
        aquamarine: #7fffd4
        maroon: #800000
        purple: #800080
        olive: #808000
        gray: #808080
        grey: #808080
        skyblue: #87ceeb
        lightskyblue: #87cefa
        blueviolet: #8a2be2
        darkred: #8b0000
        darkmagenta: #8b008b
        saddlebrown: #8b4513
        darkseagreen: #8fbc8f
        lightgreen: #90ee90
        mediumpurple: #9370db
        darkviolet: #9400d3
        palegreen: #98fb98
        darkorchid: #9932cc
        yellowgreen: #9acd32
        sienna: #a0522d
        brown: #a52a2a
        darkgray: #a9a9a9
        darkgrey: #a9a9a9
        lightblue: #add8e6
        greenyellow: #adff2f
        paleturquoise: #afeeee
        lightsteelblue: #b0c4de
        powderblue: #b0e0e6
        firebrick: #b22222
        darkgoldenrod: #b8860b
        mediumorchid: #ba55d3
        rosybrown: #bc8f8f
        darkkhaki: #bdb76b
        silver: #c0c0c0
        mediumvioletred: #c71585
        indianred: #cd5c5c
        peru: #cd853f
        chocolate: #d2691e
        tan: #d2b48c
        lightgray: #d3d3d3
        lightgrey: #d3d3d3
        thistle: #d8bfd8
        orchid: #da70d6
        goldenrod: #daa520
        palevioletred: #db7093
        crimson: #dc143c
        gainsboro: #dcdcdc
        plum: #dda0dd
        burlywood: #deb887
        lightcyan: #e0ffff
        lavender: #e6e6fa
        darksalmon: #e9967a
        violet: #ee82ee
        palegoldenrod: #eee8aa
        lightcoral: #f08080
        khaki: #f0e68c
        aliceblue: #f0f8ff
        honeydew: #f0fff0
        azure: #f0ffff
        sandybrown: #f4a460
        wheat: #f5deb3
        beige: #f5f5dc
        whitesmoke: #f5f5f5
        mintcream: #f5fffa
        ghostwhite: #f8f8ff
        salmon: #fa8072
        antiquewhite: #faebd7
        linen: #faf0e6
        lightgoldenrodyellow: #fafad2
        oldlace: #fdf5e6
        red: #ff0000
        fuchsia: #ff00ff
        magenta: #ff00ff
        deeppink: #ff1493
        orangered: #ff4500
        tomato: #ff6347
        hotpink: #ff69b4
        coral: #ff7f50
        darkorange: #ff8c00
        lightsalmon: #ffa07a
        orange: #ffa500
        lightpink: #ffb6c1
        pink: #ffc0cb
        gold: #ffd700
        peachpuff: #ffdab9
        navajowhite: #ffdead
        moccasin: #ffe4b5
        bisque: #ffe4c4
        mistyrose: #ffe4e1
        blanchedalmond: #ffebcd
        papayawhip: #ffefd5
        lavenderblush: #fff0f5
        seashell: #fff5ee
        cornsilk: #fff8dc
        lemonchiffon: #fffacd
        floralwhite: #fffaf0
        snow: #fffafa
        yellow: #ffff00
        lightyellow: #ffffe0
        ivory: #fffff0
        white: #ffffff
    )

    hex: charset "0123456789abcdef"

    set-style: func [
        attributes [map!]
        /local value facet keepers
    ][
        neaten/pairs collect [
            foreach [facet keepers][
                stroke-width [
                    keep 'line-width
                    keep value
                ]

                stroke-linejoin [
                    keep 'line-join
                    keep value
                ]

                stroke [
                    keep 'pen
                    keep case [
                        word? value [
                            any [
                                select colors value
                                'off
                            ]
                        ]
                        tuple? value [value]
                        issue? value [
                            either parse probe to string! value [3 hex | 6 hex][
                                value
                            ][
                                ; Pending DEFS resolution
                                'off
                            ]
                        ]
                        /else ['off]
                    ]
                ]

                fill [
                    keep 'fill-pen
                    keep case [
                        word? value [
                            any [
                                select colors value
                                'off
                            ]
                        ]
                        tuple? value [value]
                        issue? value [
                            either parse to string! value [3 hex | 6 hex][
                                value
                            ][
                                ; Pending DEFS resolution
                                'off
                            ]
                        ]
                        /else ['off]
                    ]
                ]
            ][
                if value: select attributes facet keepers
            ]
        ]
    ]
]

pinkie: load-svg read http://reb4.me/x/red-pinkie.svg

view [
    box 240x240 draw svg-to-draw pinkie
]
	#!/usr/local/bin/red

	Red [
	Title: "Parse SVG"
	Date: 23-Dec-2018
	Author: "Christopher Ross-Gill"
	Rights: http://opensource.org/licenses/Apache-2.0
	]

	; do %altxml.red
	do https://raw.githubusercontent.com/rgchris/Scripts/master/experimental/altxml.red

	neaten: func [
	block [block!] /pairs /flat /words
	][
	either words [
	forall block [
	new-line block to logic! all [
	any-word? block/1
	not find [off _ x] block/1
	]
	]
	][
	new-line/all/skip block not flat either pairs [2] [1]
	]

	head block
	]

	load-svg: func [
	svg [string! binary!]
	/local kid kids desc defs
	] bind [
	case/all [
	binary? svg [
	svg: to string! svg
	]
	string? svg [
	svg: load-xml/dom svg
	]
	]

	neaten/words collect [
	keep 'svg
	keep handle-attributes svg
	keep/only either empty? kids: collect [
	foreach kid svg/children [
	if kid/type = 'element [
	; switch/default kid/name [
	; ; defs [defs: handle-defs kid]
	; desc [desc: kid/text]
	; ][
	keep handle-kid kid
	; ]
	]
	]
	][
	'_
	][
	kids
	]
	]
	]

	make object! [
	adjust: func [
	value [integer! float! percent!]
	][
	switch type?/word value [
	float! percent! [round/to value 0.001]
	integer! [value]
	]
	]

	number*: charset "-.0123456789"

	as-number: func [
	number [string!]
	][
	case [
	not parse number [some number* opt "%"][number]
	#"%" = last number [to percent! number]
	find number "." [to decimal! number]
	]
	]

	as-pair: func [
	x [integer! float!]
	y [integer! float!]
	][
	to paren! reduce (adjust x adjust y)
	]

	parse-path: func [
	path [string!]
	/local part
	][
	path: parse/case path [
	collect any [
	#" " \| #"^/"
	\| #"A" keep ('arc)
	\| #"C" keep ('curve)
	\| #"H" keep ('hline)
	\| #"L" keep ('line)
	\| #"M" keep ('move)
	\| #"Q" keep ('qcurve)
	\| #"S" keep ('curv)
	\| #"T" keep ('qcurv)
	\| #"V" keep ('vline)
	\| #"Z" keep ('close)
	\| #"a" keep (quote 'arc)
	\| #"c" keep (quote 'curve)
	\| #"h" keep (quote 'hline)
	\| #"l" keep (quote 'line)
	\| #"m" keep (quote 'move)
	\| #"q" keep (quote 'qcurve)
	\| #"s" keep (quote 'curv)
	\| #"t" keep (quote 'qcurv)
	\| #"v" keep (quote 'vline)
	\| #"z" keep ('close)
	\| #"," ; keep ('x)
	\| copy part some number* keep (
	adjust load part
	)
	]
	]

	neaten/words path
	]

	parse-style: func [
	style [string!]
	attributes [map!]
	/local key value
	][
	; quickie parsing for now
	style: split style charset ":;"
	foreach [key value] style [
	key: to word! trim/head/tail key
	value: trim/head/tail value
	attributes/(key): any [
	attempt [load value]
	value
	]
	]
	]

	parse-transformation: func [
	transformation [string!]
	/local type part value
	][
	transformation: if parse transformation [
	copy type [
	"matrix" \| "rotate" \| "scale" \| "translate" \| "skew" \| "clip"
	]
	"(" copy part to ")" skip
	][
	collect [
	keep to word! type
	keep parse-path part
	]
	]
	]

	handle-attributes: func [
	node [object!]
	/local facet red-facet style attribute value
	][
	attributes: make map! collect [
	foreach attribute node/attributes [
	unless attribute/name = 'style [
	keep attribute/name
	keep/only switch/default attribute/name [
	viewbox [
	if all [
	value: attempt [load attribute/value]
	parse value [4 integer!]
	][
	reduce [
	adjust value/1 'x adjust value/2
	adjust value/3 'x adjust value/4
	]
	]
	]

	fill stroke [
	any [
	attempt [load attribute/value]
	attribute/value
	]
	]

	id [
	attribute/value
	]

	d points stroke-dasharray [
	parse-path attribute/value
	]

	transform [
	parse-transformation attribute/value
	]

	x y cx cy r width height stroke-width font-size [
	switch/default to word! type? value: attempt [load attribute/value][
	integer! float! [adjust value]
	percent! [value]
	][
	attribute/value
	]
	]

	font-family [
	attribute/value
	]
	][
	any [
	attempt [load attribute/value]
	attribute/value
	]
	]
	]
	]
	]

	if style: node/get #style [
	parse-style style attributes
	]

	attributes
	]

	handle-kid: func [
	node [object!]
	/local attributes kids kid
	][
	neaten/words collect [
	keep switch/default node/name [
	g ['group]
	][
	node/name
	]
	keep attributes: handle-attributes node
	keep/only either empty? kids: collect [
	foreach kid node/children [
	switch/default kid/type [
	element [
	keep handle-kid kid
	]
	text [
	keep quote 'text
	keep '_
	keep kid/value
	]
	whitespace
	][
	probe kid/type
	]
	]
	][
	'_
	][
	kids
	]
	]
	]
	]

	svg-to-draw: func [
	svg-block [block!] "Block created from LOAD-SVG function"
	/scale scalar [integer!]
	/local node attributes kids
	] bind [
	scalar: to float! any [:scalar 1]

	neaten/words collect [
	foreach [node attributes kids] svg-block [
	switch/default node [
	svg [
	keep compose [
	(set-style attributes)
	(svg-to-draw/scale kids to integer! scalar)
	]
	]

	defs [
	; to follow
	]

	clippath [
	; to follow
	]

	group [
	keep 'push
	keep/only compose [
	(set-style attributes)
	(svg-to-draw/scale kids to integer! scalar)
	]
	]

	rect [
	keep 'push
	keep/only neaten/words collect [
	keep set-style attributes
	keep 'box
	keep as-pair attributes/x attributes/y
	keep as-pair attributes/x + attributes/width attributes/y + attributes/height
	; only one radius dimension allowed...
	if any [
	attributes/rx
	attributes/ry
	][
	keep any [
	attributes/rx
	attributes/ry
	]
	]
	]
	]

	circle [
	keep 'push
	keep/only neaten/words compose [
	(set-style attributes)
	circle
	(as-pair attributes/cx attributes/cy)
	(attributes/r)
	]
	]

	ellipse [
	keep 'push
	keep/only neaten/words compose [
	(set-style attributes)
	circle
	(as-pair attributes/cx attributes/cy)
	(attributes/rx)
	(attributes/ry)
	]
	]

	line [
	keep 'push
	keep/only neaten/words compose [
	(set-style attributes)
	line
	(as-pair attributes/x1 attributes/y1)
	(as-pair attributes/x2 attributes/y2)
	]
	]

	polyline [
	keep 'push
	keep/only neaten/words compose [
	(set-style attributes)
	line (numbers-to-points attributes/points)
	]
	]

	polygon [
	keep 'push
	keep/only neaten/words compose [
	(set-style attributes)
	polygon (numbers-to-points attributes/points)
	]
	]

	path [
	keep 'push
	keep/only neaten/words compose/deep [
	(set-style attributes)
	shape [(path-to-points attributes/d)]
	]
	]

	text [
	; Here be dragons
	; keep 'text
	; keep compose [
	; (set-style attributes)
	; text
	; ]
	]
	][
	probe node
	]
	]
	]
	]

	make object! [
	path-to-points: func [
	path [block!]
	/local
	mark part
	][
	parse path [
	collect some [
	mark:
	['move \| quote 'move \| 'line \| quote 'line] 2 number!
	keep (mark/1)
	keep (as-pair mark/2 mark/3)
	\|
	['hline \| quote 'hline \| 'vline \| quote 'vline] number!
	keep (mark/1)
	keep (mark/2)
	\|
	['arc \| quote 'arc] 7 number!
	keep (mark/1)
	keep (as-pair mark/7 mark/8)
	keep (mark/2)
	keep (mark/3)
	keep (mark/4)
	opt [if (mark/6 = 1) keep ('sweep)]
	opt [if (mark/5 = 1) keep ('large)]
	\|
	['curve \| quote 'curve] 6 number!
	keep (mark/1)
	keep (as-pair mark/2 mark/3)
	keep (as-pair mark/4 mark/5)
	keep (as-pair mark/6 mark/7)
	\|
	['qcurv \| quote 'qcurv] 2 number!
	keep (mark/1)
	keep (as-pair mark/2 mark/3)
	\|
	'close
	keep (mark/1)
	\|
	skip ; should not happen
	keep (mark/1)
	]
	]
	]

	numbers-to-points: func [
	numbers [block!]
	/local mark
	][
	parse numbers [
	collect [
	some [
	mark: number! number!
	keep (as-pair mark/1 mark/2)
	]
	]
	]
	]

	colors: #(
	none: off
	transparent: off
	black: #000000
	navy: #000080
	darkblue: #00008b
	mediumblue: #0000cd
	blue: #0000ff
	darkgreen: #006400
	green: #008000
	teal: #008080
	darkcyan: #008b8b
	deepskyblue: #00bfff
	darkturquoise: #00ced1
	mediumspringgreen: #00fa9a
	lime: #00ff00
	springgreen: #00ff7f
	cyan: #00ffff
	aqua: #00ffff
	midnightblue: #191970
	dodgerblue: #1e90ff
	lightseagreen: #20b2aa
	forestgreen: #228b22
	seagreen: #2e8b57
	darkslategray: #2f4f4f
	darkslategrey: #2f4f4f
	limegreen: #32cd32
	mediumseagreen: #3cb371
	turquoise: #40e0d0
	royalblue: #4169e1
	steelblue: #4682b4
	darkslateblue: #483d8b
	mediumturquoise: #48d1cc
	indigo: #4b0082
	darkolivegreen: #556b2f
	cadetblue: #5f9ea0
	cornflowerblue: #6495ed
	mediumaquamarine: #66cdaa
	dimgrey: #696969
	dimgray: #696969
	slateblue: #6a5acd
	olivedrab: #6b8e23
	slategrey: #708090
	slategray: #708090
	lightslategray: #778899
	lightslategrey: #778899
	mediumslateblue: #7b68ee
	lawngreen: #7cfc00
	chartreuse: #7fff00
	aquamarine: #7fffd4
	maroon: #800000
	purple: #800080
	olive: #808000
	gray: #808080
	grey: #808080
	skyblue: #87ceeb
	lightskyblue: #87cefa
	blueviolet: #8a2be2
	darkred: #8b0000
	darkmagenta: #8b008b
	saddlebrown: #8b4513
	darkseagreen: #8fbc8f
	lightgreen: #90ee90
	mediumpurple: #9370db
	darkviolet: #9400d3
	palegreen: #98fb98
	darkorchid: #9932cc
	yellowgreen: #9acd32
	sienna: #a0522d
	brown: #a52a2a
	darkgray: #a9a9a9
	darkgrey: #a9a9a9
	lightblue: #add8e6
	greenyellow: #adff2f
	paleturquoise: #afeeee
	lightsteelblue: #b0c4de
	powderblue: #b0e0e6
	firebrick: #b22222
	darkgoldenrod: #b8860b
	mediumorchid: #ba55d3
	rosybrown: #bc8f8f
	darkkhaki: #bdb76b
	silver: #c0c0c0
	mediumvioletred: #c71585
	indianred: #cd5c5c
	peru: #cd853f
	chocolate: #d2691e
	tan: #d2b48c
	lightgray: #d3d3d3
	lightgrey: #d3d3d3
	thistle: #d8bfd8
	orchid: #da70d6
	goldenrod: #daa520
	palevioletred: #db7093
	crimson: #dc143c
	gainsboro: #dcdcdc
	plum: #dda0dd
	burlywood: #deb887
	lightcyan: #e0ffff
	lavender: #e6e6fa
	darksalmon: #e9967a
	violet: #ee82ee
	palegoldenrod: #eee8aa
	lightcoral: #f08080
	khaki: #f0e68c
	aliceblue: #f0f8ff
	honeydew: #f0fff0
	azure: #f0ffff
	sandybrown: #f4a460
	wheat: #f5deb3
	beige: #f5f5dc
	whitesmoke: #f5f5f5
	mintcream: #f5fffa
	ghostwhite: #f8f8ff
	salmon: #fa8072
	antiquewhite: #faebd7
	linen: #faf0e6
	lightgoldenrodyellow: #fafad2
	oldlace: #fdf5e6
	red: #ff0000
	fuchsia: #ff00ff
	magenta: #ff00ff
	deeppink: #ff1493
	orangered: #ff4500
	tomato: #ff6347
	hotpink: #ff69b4
	coral: #ff7f50
	darkorange: #ff8c00
	lightsalmon: #ffa07a
	orange: #ffa500
	lightpink: #ffb6c1
	pink: #ffc0cb
	gold: #ffd700
	peachpuff: #ffdab9
	navajowhite: #ffdead
	moccasin: #ffe4b5
	bisque: #ffe4c4
	mistyrose: #ffe4e1
	blanchedalmond: #ffebcd
	papayawhip: #ffefd5
	lavenderblush: #fff0f5
	seashell: #fff5ee
	cornsilk: #fff8dc
	lemonchiffon: #fffacd
	floralwhite: #fffaf0
	snow: #fffafa
	yellow: #ffff00
	lightyellow: #ffffe0
	ivory: #fffff0
	white: #ffffff
	)

	hex: charset "0123456789abcdef"

	set-style: func [
	attributes [map!]
	/local value facet keepers
	][
	neaten/pairs collect [
	foreach [facet keepers][
	stroke-width [
	keep 'line-width
	keep value
	]

	stroke-linejoin [
	keep 'line-join
	keep value
	]

	stroke [
	keep 'pen
	keep case [
	word? value [
	any [
	select colors value
	'off
	]
	]
	tuple? value [value]
	issue? value [
	either parse probe to string! value [3 hex \| 6 hex][
	value
	][
	; Pending DEFS resolution
	'off
	]
	]
	/else ['off]
	]
	]

	fill [
	keep 'fill-pen
	keep case [
	word? value [
	any [
	select colors value
	'off
	]
	]
	tuple? value [value]
	issue? value [
	either parse to string! value [3 hex \| 6 hex][
	value
	][
	; Pending DEFS resolution
	'off
	]
	]
	/else ['off]
	]
	]
	][
	if value: select attributes facet keepers
	]
	]
	]
	]

	pinkie: load-svg read http://reb4.me/x/red-pinkie.svg

	view [
	box 240x240 draw svg-to-draw pinkie
	]