Skip to content

Instantly share code, notes, and snippets.

@SteeveGit
Created July 1, 2016 15:44
Show Gist options
  • Save SteeveGit/67186225b5f69dbd08b1dcaa756680d4 to your computer and use it in GitHub Desktop.
Save SteeveGit/67186225b5f69dbd08b1dcaa756680d4 to your computer and use it in GitHub Desktop.
REBOL []
src: read %lizard.svg
transparent: 0.0.0.255
;** Stack operations
pile: tail reduce [copy [pen transparent]] ;** by default, no pen color
rollback: does [pile: back pile]
;r3 push: does [clear pile: change/only pile copy []]
push: does [pile: tail append/only clear pile copy []]
commit: func [v][
rollback
unless empty? pile/1 [
append/only append new-line pile/0 true :v new-line pile/1 true
]
]
pop-flat: does [rollback out pile/1]
;r3 out: func [v][append pile/0 :v]
out: func [v][append pile/-1 :v]
opacity: fill-opacity: stroke-opacity: stop-opacity: 1 ;** full opacity by default
Box: copy [10000x10000 0x0] ;** bounding box used by gradients sometimes
;*** charsets
digit: charset "0123456789"
_: charset " ^-^/"
__: [some _]
;*** datatypes parsing extractions
rgb: 0
rgb=: [#"#" copy rgb [6 skip] if (attempt [rgb: to-tuple debase/base rgb 16])]
num: 0
to-decimal: func [s][to float! s] ;***red only
num=: [
copy num [
opt #"-" some digit opt [#"." any digit] opt [#"e" [#"+" | #"-"] some digit]]
(num: to-decimal num)
]
out-num: [num= (out num)]
unit: 0
unit=: [
opt #"^"" num= [
"pt" (unit: 1.25 * num)
| "pc" (unit: 15 * num)
| "mm" (unit: 3.543307 * num)
| "cm" (unit: 35.43307 * num)
| "in" (unit: 90 * num)
| "%" (unit: num / 100)
| opt "px" (unit: num)
]
]
out-pair: [
pair=
(
bound x y
out as-pair x y
)
]
bound: func [{Update the bounding box} x y][
box/1/x: min box/1/x x
box/2/x: max box/2/x x
box/1/y: min box/1/y y
box/2/y: max box/2/y y
]
pair=: [unit= (x: unit) any [not unit= skip] unit= (y: unit)]
valid-tag: [
#"<" here: copy tag [
any [
to [#">" | "=^""] not #">" 2 skip thru #"^""
]
to #">"
] skip
| here: (
print ["--Can't load markup at" index? here "--Error:" copy/part here 1000])
#"<" any [to [#">" | "=^""] not #">" copy att [2 skip thru #"^""] (?? att) ] thru #">"
| (halt)
]
get-attribut: [
#"^"" copy attribut to #"^"" skip
| here: (
print [
"--Can't load the attribut at" index? here
"--Error:" copy/part here 50
]
halt)
]
path: funco [tag /local path node][
push
Box: copy [10000x10000 0x0] ;** bounding box
parse tag [thru " d=" get-attribut (d-block attribut)]
path: new-line copy pile/0 true
clear pile/0
parse tag [thru " style=" get-attribut (style attribut)]
out path
commit 'push
]
cmd: charset [#"a" - #"z" #"A" - #"Z"]
d-block: funco [attribut][
push
parse/case attribut [
some [
#"M" any _ (out 'move) out-pair
| #"C" (out 'curve) some [any _ out-pair ]
| #"S" (out 'curv) some [any _ out-pair]
| #"Q" (out 'qcurve) some [any _ out-pair]
| #"T" (out 'qcurv) some [any _ out-pair]
| #"L" (out 'line ) some [any _ out-pair]
| #"H" any _ (out 'hline) out-num
| #"V" any _ (out 'vline) out-num
| [#"Z" | #"z"] (out ['move 0x0]) ;** 'move 0x0
| #"A" any _ out-shape-arc
| not [cmd | unit] skip
| not end error: to [#" " | end] (print ["-- Skipped d path:" mold head error] halt) skip
]
]
commit 'shape
]
out-shape-arc: use [rx ry large sweep angle][[
pair (rx: x ry: y) __ unit (angle: &unit)
__ unit (large: &unit) __ unit (sweep: &unit)
(out 'arc)
__ out-pair ;** end-point
(
out reduce [rx ry angle]
if sweep = 1 [out 'sweep]
if large = 1 [out 'large]
)
]]
fill-url: [
"url(#" copy url to #")" skip
(
push
xlink url
rollback
if all [object? pile/1/1 pile/1/1/id = 'gradient][grad-pen pile/1/1]
clear pile
recycle
)
]
xlink: funco [url /local idx][
either idx: select ids url [parse at src idx content true][print ["-- url:" url "not found"] false]
]
opacify: func [color [tuple!] factor][color/4: 1 - factor * 255 color]
style: funco [attribut /local savings][
savings: reduce [opacity fill-opacity stroke-opacity stop-opacity]
parse attribut [ ;** At first, refresh all opacity attributes
some [
"opacity:" num (opacity: &num)
| "fill-opacity:" num (fill-opacity: &num)
| "stroke-opacity:" num (stroke-opacity: &num)
| "stop-opacity:" num (stop-opacity: &num)
| thru #";"
]
]
parse attribut [
some [
"fill:none" (out [fill-pen #[none]])
| "fill:" [rgb (out 'fill-pen out opacify &rgb (opacity * fill-opacity)) | fill-url]
| "stroke:none" (out [pen 0.0.0.255])
| "stroke:" rgb (out 'pen out opacify &rgb (opacity * stroke-opacity) )
| "stroke-linejoin:miter" (out [line-join miter])
| "stroke-linejoin:bevel" (out [line-join bevel])
| "stroke-linejoin:round" (out [line-join round])
| "stroke-linecap:butt" (out [line-cap butt])
| "stroke-linecap:square" (out [line-cap square])
| "stroke-linecap:round" (out [line-cap round])
| "fill-rule:evenodd" (out [fill-rule even-odd])
| "fill-rule:nonzero" (out [fill-rule non-zero])
| "stroke-width:" unit (out 'line-width out max 0.01 &unit)
| "stop-color:" rgb (out opacify &rgb (opacity * stop-opacity * fill-opacity) )
| thru #";"
;| not end copy error thru [#";" | end] (print ["-- Skipped style:" error])
]
]
set [opacity fill-opacity stroke-opacity stop-opacity] savings
]
g-group: funco [tag][
parse tag [
thru " transform=" get-attribut (transform attribut)
]
]
rect: funco [tag /local x y width height rx ry][
x: y: width: height: 0
parse tag [thru " transform=" get-attribut (transform attribut)]
parse tag [
thru #" "
some [
some [_ | #"^""]
| "style=" get-attribut (style attribut)
| "x=" unit (x: &unit)
| "y=" unit (y: &unit)
| "rx=" unit (rx: &unit)
| "ry=" unit (ry: &unit)
| "width=" unit (width: &unit)
| "height=" unit (height: &unit)
| not end copy error to [#" " | end] skip (print ["-- Skipped rect attribute:" error])
]
]
out reduce ['box as-pair x y as-pair x + width y + height]
if any [rx ry][out any [rx ry]] ;** corner radius
]
transform: funco [attribut][
parse attribut [
some [
__
| matrix
| translate
| scale
| not end copy error thru [#" " | end] (print ["-- Skipped transform:" error])
]
]
]
matrix: ["matrix(" (push) out-num 5 [#"," out-num] #")" (commit 'matrix)]
translate: ["translate(" (out 'translate) out-pair #")"]
scale: ["scale(" (out 'scale) out-num [#"," out-num | (out &num)] #")"]
xlink-href: funco [tag][
parse tag [thru " xlink:href=^"#" copy url to #"^"" (push xlink url rollback) to end]
]
gradient: funco [tag /local grad][
push
out either xlink-href tag [pile/1/1][
context [
id: 'gradient
type: 'linear
mode: 'normal
units: "objectBoundingBox"
cx: cy: 50%
x1: y1: x2: y2: fx: fy: none
r: 50%
colors: copy []
matrix: none ;for matrix transformations
]
]
grad: pile/0/1
parse tag [
["linear" (grad/type: 'linear) | "radial" (grad/type: 'radial)] "Gradient"
any [
some _
| {spreadMethod="reflect"} (grad/mode: 'reflect)
| {spreadMethod="repeat"} (grad/mode: 'repeat)
| {spreadMethod="pad"} (grad/mode: 'normal)
| "gradientTransform=" get-attribut (push transform attribut rollback) (
switch pile/1/1 [
scale [grad/matrix: reduce [pile/1/2 0 0 pile/1/3 0 0]]
matrix [grad/matrix: pile/1/2]
]
)
| {gradientUnits="userSpaceOnUse"} (grad/units: "userSpaceOnUse")
| {gradientUnits="objectBoundingBox"} (grad/units: "objectBoundingBox")
| "x1=" unit (grad/x1: &unit)
| "y1=" unit (grad/y1: &unit)
| "cx=" unit (grad/cx: &unit)
| "cy=" unit (grad/cy: &unit)
| "fx=" unit (grad/fx: &unit)
| "fy=" unit (grad/fy: &unit)
| "r=" unit (grad/r: &unit)
| "x2=" unit (grad/x2: &unit)
| "y2=" unit (grad/y2: &unit)
| not end copy error to #" " ;skip (print ["-- Skipped gardient attribute:" error])
]
]
]
mulm: func [
{multiply a matrix [a b c d e f] by coordinates x y, return coordinates [x' y']}
x y m [block!]
][
reuse [x * m/1 + (y * m/3) + m/5 x * m/2 + (y * m/4) + m/6]
]
reuse: funco [b [block!]][head reduce/into b clear []]
atan2: func [
{Angle of the vector (0,0)-(x,y) with artangent y / x. The resulting angle is extended to -pi,+pi}
x y
][
if x = 0 [x: 0.0000000001]
add arctangent y / x pick [0 180] x > 0
]
Project: func [
{orthogonal projection of a point P on a line AB, return coordinates [x y]}
ax ay bx by px py
/local sx sy ux uy ratio
][
sx: bx - ax
sy: by - ay
ux: px - ax
uy: py - ay
ratio: sx * ux + (sy * uy) / (sx * sx + (sy * sy))
reuse [ratio * sx + ax ratio * sy + ay]
]
vector-length: func [x1 y1 x2 y2][square-root add x2 - x1 ** 2 y2 - y1 ** 2]
grad-pen: use [id type mode x1 y1 cx cy x2 y2 fx fy r colors matrix units][
funco [
{http://www.rebol.net/wiki/Grad-Pen} grad
/local angle sx sy
][
resolve/all bind? 'id grad
special: copy []
out 'grad-pen
out type
out mode
switch type [
linear [
unless x2 [x2: x1]
unless y2 [y2: y1]
if units = "objectBoundingBox" [
print "Linear objectBoundingBox"
x1: box/2/x - box/1/x * x1 + box/1/x
y1: box/2/y - box/1/y * y1 + box/1/y
x2: box/2/x - box/1/x * x2 + box/1/x
y2: box/2/y - box/1/y * y2 + box/1/y
;** if the roundingBox is not square, we have to calculate a scaling matrix
;matrix: probe reduce [1 0 0 ( (box/2/y - box/1/y) / (box/2/x - box/1/x)) 0 0]
]
if matrix [
; ** apply the matrix on the vector rotated of 90°, then rotate it back, gives the vector V1
set [y1' x1'] mulm y1 negate x1 matrix
set [y2' x2'] mulm y2 negate x2 matrix
x1': negate x1'
x2': negate x2'
;** apply the matrix on the initial vector, gives the vector V2
set [x1 y1] mulm x1 y1 matrix
set [x2 y2] mulm x2 y2 matrix
;** project the vector V2 on the line V1
set [x1 y1] project x1' y1' x2' y2' x1 y1
set [x2 y2] project x1' y1' x2' y2' x2 y2
]
angle: atan2 x2 - x1 y2 - y1
out as-pair x1 y1 ;** offset
out 0 ;** start rng
;out max abs x2 - x1 * cosine angle abs y2 - y1 * sine angle
out vector-length x1 y1 x2 y2 ;** stop rng
out angle ;** angle
]
radial [
unless fx [fx: cx]
unless fy [fy: cy]
if matrix [
;** The matrix in SVG, is used to produce rotated ellipsoids containing a radial gradient.
;** Rebol can manage them with 2 scale factors (sx and sy) and an angle used by grad-pen.
sx: sy: 1
angle: 0
;** Construct 2 vectors (fx,fy fx,fy+r) and (fx,fy fx+r,fy) starting at fx,cy
;** 1 vertical and 1 horizontal of length r
;** apply the matrix on these 2 vectors (3 points)
set [x2 y2] mulm fx fy + r matrix
set [x3 y3] mulm fx + r fy matrix
set [fx fy] mulm fx fy matrix
;** calculate the scaling transformation on the horizontal vector
sx: (vector-length fx fy x3 y3) / r
;** calculate the scaling transformation on the vertical vector
sy: (vector-length fx fy x2 y2) / r
;** calculate the rotation of the ellipsoid.
angle: atan2 x3 - fx y3 - fy
]
if units = "objectBoundingBox" [
print "Radial objectBoundingBox"
fx: box/2/x - box/1/x * fx + box/1/x
fy: box/2/y - box/1/y * fy + box/1/x
r: r * min box/2/x - box/1/x box/2/y - box/1/y
]
out as-pair fx fy ;** offset = focal point
out 0 ;** start rng
out r ;** stop rng = radius
out angle ;** angle (produces rotated ellipsoids)
out sx ;** horizontal scaling transformation (produces ellipsoids)
out sy ;** vertical scaling transformation
]
]
out reuse [colors] ;** colors
]
]
child?: does [#"/" <> last tag]
ids: copy []
collect-id: funco [tag idx][
parse tag [
thru " id=" get-attribut
(reduce/into [copy attribut -1 + index? idx] tail ids)
]
]
stop: funco [tag][
parse tag [thru " style=" get-attribut (style attribut)]
parse tag [thru " offset=^"" out-num ]
]
stop-tag: [
(push) any [to #"<" and ["<stop" _] valid-tag (stop tag)]
(rollback pile/0/1/colors: pile/1)
]
content: [
and ["<defs" _] 9 opt [if (child?) some [to #"<" not "</defs>" [valid-tag (collect-id tag here)]]]
| "<desc>" copy desc to "</desc>" (s desc) "</desc>"
| and ["<g" _] valid-tag (push g-group tag)
| "</g>" (commit 'push)
| and ["<path" _] valid-tag (path tag)
| and ["<rect" _] valid-tag (rect tag)
| and ["<radialGradient" _] valid-tag (gradient tag) opt [
if (child?) stop-tag to #"<" "</radialGradient>"
] (pop-flat)
| and ["<linearGradient" _] valid-tag (gradient tag) opt [
if (child?) stop-tag to #"<" "</linearGradient>"
] (pop-flat)
| copy error thru [#" " | #">"] ;(print ["-- Skipped tag:" error])
]
svg: funco [tag][
parse tag [thru " width=" get-attribut (parse attribut [unit (width: &unit)])]
parse tag [thru " height=" get-attribut (parse attribut [unit (eight: &unit)])]
]
parse src [to "<svg" and ["<svg" _] valid-tag (svg tag) some [to #"<" not "</svg>" content]]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment