The Lispworks toolset and whole Common Lisp economy is lacking a way to render SVG in a standalone and reliable way, and there's also not a exist binding for libraries such as librsvg. To easily access some useful SVG resources, I once tried to write some codes aiming to translate SVG Paths to Lispworks' Graphics Port drawing operations.
Limited to my knowledge and mental state, these codes are still working in progress and can produce lots of malform results. But they're already enough to undertake some simple tasks, like render simple SVG icons like Google's Material Icons/Symbols. Here is my practice, anyone can feel free to use or modify them.
The translate part is the most important. Currently I've only implemented the translation of the d element without eclipse support, and take respect to the width, height and viewbox as well.
After translation, I choosed to draw the translated path to a pixmap port, scale & move it to desired size, then makes the drawing to an image associated with givent Graphics Port. I can externalize or write it to a file in later manipulation.
FIXME: In the W3 standard, multiple coordinates in a single
Mcommand should be connected using line (L). There seem some problems here...
(defun convert-svg-command (elements)
(declare (type single-float
cpx cpy ocx1 ocy1 ocx2 ocy2
x y nx ny
rcx1 rcy1 rcx2 rcy2 rnx rny
qcx1 qcy1 rqcx1 rqcy1)
(optimize (float 0)))
(loop with cpx = 0
with cpy = 0
with ocx2
with ocy2
with oqx
with oqy
for last-cubic-p = nil then (member command '(#\C #\c #\S #\s))
for last-quadratic-p = nil then (member command '(#\Q #\q #\T #\t))
for last-move-p = nil then (find command '(#\M #\m))
for (command . args) in elements
nconc
(case command
(#\M
(loop for (x y) on args by #'cddr
do (setf cpx x cpy y)
collect (list (if last-move-p :line :move) x y)))
(#\m
(loop for (x y) on args by #'cddr
do (incf cpx x)
do (incf cpy y)
collect (list (if last-move-p :line :move) cpx cpy)))
(#\Z
(list :close))
(#\z
(list :close))
(#\L
(loop for (x y) on args by #'cddr
collect (list :line x y)
do (setf cpx x cpy y)))
(#\l
(loop for (x y) on args by #'cddr
do (incf cpx x)
do (incf cpy y)
collect (list :line cpx cpy)))
(#\H
(loop for x in args
collect (list :line x cpy)
do (setf cpx x)))
(#\V
(loop for y in args
collect (list :line cpx y)
do (setf cpy y)))
(#\h
(loop for x in args
do (incf cpx x)
collect (list :line cpx cpy)))
(#\v
(loop for y in args
do (incf cpy y)
collect (list :line cpx cpy)))
(#\C
(loop for (cx1 cy1 cx2 cy2 nx ny) on args
by #'(lambda (lst) (nthcdr 6 lst))
do (setf cpx nx cpy ny
ocx2 cx2 ocy2 cy2)
collect (list :bezier cx1 cy1 cx2 cy2 nx ny)))
(#\c
(loop for (rcx1 rcy1 rcx2 rcy2 rnx rny) on args
by #'(lambda (lst) (nthcdr 6 lst))
collect
(let ((cx1 (- rcx1 cpx)) (cy1 (- rcy1 cpy))
(cx2 (- rcx2 cpx)) (cy2 (- rcy2 cpy))
(nx (- rnx cpx)) (ny (- rny cpy)))
(setf cpx nx cpy ny
ocx2 cx2 ocy2 cy2)
(list :bezier cx1 cy1 cx2 cy2 nx ny))))
(#\S
(loop for (cx2 cy2 nx ny) on args
by #'(lambda (lst) (nthcdr 6 lst))
collect
(let ((cx1 (if last-cubic-p (- (* 2 cpx) ocx2)
cpx))
(cy1 (if last-cubic-p (- (* 2 cpy) ocy2)
cpy)))
(setf cpx nx cpy ny
ocx2 cx2 ocy2 cy2
last-cubic-p t)
(list :bezier cx1 cy1 cx2 cy2 nx ny))))
(#\s
(loop for (rcx2 rcy2 rnx rny) on args
by #'(lambda (lst) (nthcdr 6 lst))
collect
(let ((cx1 (if last-cubic-p (- (* 2 cpx) ocx2)
cpx))
(cy1 (if last-cubic-p (- (* 2 cpy) ocy2)
cpy))
(cx2 (+ cpx rcx2)) (cy2 (+ cpy rcy2))
(nx (+ cpx rnx)) (ny (+ cpy rny)))
(setf cpx nx cpy ny
ocx2 cx2 ocy2 cy2
last-cubic-p t)
(list :bezier cx1 cy1 cx2 cy2 nx ny))))
(#\Q
(loop for (qcx1 qcy1 nx ny) on args by #'cddddr
collect
(let ((cx1 (+ cpx (/ (* (- qcx1 cpx) 2) 3)))
(cy1 (+ cpy (/ (* (- qcy1 cpy) 2) 3)))
(cx2 (+ nx (/ (* (- qcx1 nx) 2) 3)))
(cy2 (+ ny (/ (* (- qcy1 ny) 2) 3))))
(setf oqx qcx1 oqy qcy1
last-quadratic-p t)
(list :bezier cx1 cy1 cx2 cy2 nx ny))
do (setf cpx nx cpy ny)))
(#\q
(loop for (rqcx1 rqcy1 rnx rny) on args by #'cddddr
collect
(let ((qcx1 (+ cpx rqcx1))
(qcy1 (+ cpy rqcy1))
(nx (+ cpx rnx))
(ny (+ cpy rny)))
(let ((cx1 (+ cpx (/ (* (- qcx1 cpx) 2) 3)))
(cy1 (+ cpy (/ (* (- qcy1 cpy) 2) 3)))
(cx2 (+ nx (/ (* (- qcx1 nx) 2) 3)))
(cy2 (+ ny (/ (* (- qcy1 ny) 2) 3))))
(setf oqx qcx1 oqy qcy1
last-quadratic-p t)
(list :bezier cx1 cy1 cx2 cy2 nx ny)))
do (incf cpx rnx)
do (incf cpy rny)))
(#\T
(loop for (nx ny) on args by #'cddr
collect
(if last-quadratic-p
(let ((qcx1 (- (* 2 cpx) oqx))
(qcy1 (- (* 2 cpy) oqy)))
(let ((cx1 (+ cpx (/ (* (- qcx1 cpx) 2) 3)))
(cy1 (+ cpy (/ (* (- qcy1 cpy) 2) 3)))
(cx2 (+ nx (/ (* (- qcx1 nx) 2) 3)))
(cy2 (+ ny (/ (* (- qcy1 ny) 2) 3))))
(setf oqx qcx1 oqy qcy1
last-quadratic-p t)
(list :bezier cx1 cy1 cx2 cy2 nx ny)))
(list :line nx ny))
do (setf cpx nx cpy ny)))
(#\t
(loop for (rnx rny) on args by #'cddr
for nx = (+ cpx rnx)
for ny = (+ cpy rny)
collect
(if last-quadratic-p
(let ((qcx1 (- (* 2 cpx) oqx))
(qcy1 (- (* 2 cpy) oqy)))
(let ((cx1 (+ cpx (/ (* (- qcx1 cpx) 2) 3)))
(cy1 (+ cpy (/ (* (- qcy1 cpy) 2) 3)))
(cx2 (+ nx (/ (* (- qcx1 nx) 2) 3)))
(cy2 (+ ny (/ (* (- qcy1 ny) 2) 3))))
(setf oqx qcx1 oqy qcy1
last-quadratic-p t)
(list :bezier cx1 cy1 cx2 cy2 nx ny)))
(list :line nx ny))
do (setf cpx nx cpy ny))))))
(defun parse-svg-path (path)
(loop with elements
with command
with arg-list
with current-arg
for c of-type base-char across path
do (cond ((alpha-char-p c)
(when command
(when current-arg
(push (parse-float (coerce current-arg 'string))
arg-list)
(setf current-arg nil))
(push-end (cons command (reverse arg-list)) elements))
(setf command c
arg-list nil))
((digit-char-p c)
(push-end c current-arg))
((char= c #\-)
(when current-arg
(push (parse-float (coerce current-arg 'string))
arg-list))
(setf current-arg '(#\-)))
((char= c #\.)
(if (member #\. current-arg)
(progn (push (parse-float (coerce current-arg 'string))
arg-list)
(setf current-arg '(#\.)))
(push-end c current-arg)))
(t
(when current-arg
(push (parse-float (coerce current-arg 'string))
arg-list)
(setf current-arg nil))))
finally (when command
(when current-arg
(push (parse-float (coerce current-arg 'string))
arg-list))
(push-end (cons command (reverse arg-list)) elements)
(setf command nil)
(return (convert-svg-command elements)))))
(defvar *viewbox-scanner*
(ppcre:create-scanner "(?<=viewBox\\=[\"']).+?(?=[\"'])"))
(defvar *width-scanner*
(ppcre:create-scanner "(?<=width\\=[\"']).+?(?=[\"'])"))
(defvar *height-scanner*
(ppcre:create-scanner "(?<=height\\=[\"']).+?(?=[\"'])"))
(defvar *d-scanner*
(ppcre:create-scanner "(?<=d\\=[\"'])[\\s\\S]+?(?=[\"'])"))
(defun parse-svg-string (port code graphics-args)
(let* ((viewbox
(when-let (sub (ppcre:scan-to-strings *viewbox-scanner* code))
(mapcar #'parse-float (split-sequence '(#\space) sub))))
(width (parse-integer (ppcre:scan-to-strings *width-scanner* code)))
(height (parse-integer (ppcre:scan-to-strings *height-scanner* code)))
(paths
(loop for d in (ppcre:all-matches-as-strings *d-scanner* code)
collect (parse-svg-path d))))
(destructuring-bind (left top width height)
(or (mapcar #'truncate viewbox) (list 0 0 width height))
(let ((transform (gp:make-transform)))
(gp:apply-translation transform (- left) (- top))
(let ((w (or (getf graphics-args :width) 0))
(h (or (getf graphics-args :height) 0)))
(unless (= w h 0)
(gp:apply-scale transform (/ w width) (/ h height))))
(gp:with-pixmap-graphics-port
(origin port width height
:relative t :clear t
:background (or (getf graphics-args :background) :transparent))
(gp:with-graphics-transform (origin transform)
(loop for p in paths
do (apply #'gp:draw-path origin p 0 0
:shape-mode :best :relative t
graphics-args)))
(gp:make-image-from-port origin 0 0 width height))))))I also defined an entry function called convert-svg to provide an interface to the translator:
(defun convert-svg (port data &rest graphics-args)
(parse-svg-string port (if (pathnamep data) (file-string data) data)
graphics-args))To use the translator to render material symbols, I built some helper functions to easily fetch svgs I want (with a simple cache). I used dexador library in this part.
(defvar *material-symbol-svgs* (make-hash-table :test 'equal))
(defun material-symbol-fullname
(name &key (style :outlined) (weight 400) grade fill (optical-size 24) &allow-other-keys)
(let ((style-part (string-append "materialsymbols" (string-downcase style) "/"))
(name-part (string-append name "/"))
(attr-part
(if (or (and weight (/= weight 400)) grade fill)
(apply #'string-append
(append (when (and weight (/= weight 400))
(list "wght" (princ-to-string weight)))
(case grade
(200 '("grad200"))
(-25 '("gradN25")))
(when fill '("fill1"))
'("/")))
"default/"))
(size-part (string-append (princ-to-string optical-size) "px")))
(string-append style-part name-part attr-part size-part)))
(defun material-symbol-svg
(name &rest args &key (style :outlined) (weight 400) grade fill (optical-size 24) &allow-other-keys)
(or (gethash (list name style weight grade fill optical-size) *material-symbol-svgs*)
(let* ((base "https://fonts.gstatic.com/s/i/short-term/release/")
(fullname (apply #'material-symbol-fullname name args))
(uri (string-append base fullname ".svg")))
(setf (gethash fullname *material-symbol-svgs*)
(dex:get uri :force-string t)))))The last step, I wrote a register-material-symbols function to bulk render the SVGs, externalize them and register images to symbols, for CAPI use.
(defun register-material-symbols (lambda-lists &optional data-file)
"Register material symbols to symbols.
`lambda-lists' is a list of lists, the CAR is symbol being registered,
and the CDR is treated as arguments of `material-symbol-svg'."
(let* ((port (make-instance 'capi:output-pane))
(itf (make-instance
'capi:interface
:layout (make-instance 'capi:simple-layout
:description (list port))
:display-state :hidden))
(db (when (and data-file (probe-file data-file))
(with-open-file (s data-file)
(read s)))))
(capi:display itf)
(let ((svgs (mapcar
#'(lambda (i)
(destructuring-bind (id name &rest args) i
(let ((svg (or (car (last (assoc (list name args) db :test 'equal)))
(apply #'material-symbol-svg name args))))
(gp:register-image-translation
id
(gp:externalize-image
port (apply 'convert-svg port svg
(loop for i in '(:style :weight :grade :fill :optical-size) do
(remf args i)
finally (return args)))
:type :png))
(list name args svg))))
lambda-lists)))
(when data-file
(with-open-file (s data-file :direction :output :if-exists :supersede)
(format s "~S" svgs))))
(capi:destroy itf)))The whole process is still messy and buggy, but hopefully it works in simple use case. And, as you can see, it's not difficult actually, if we just want to archive our little goal - it worth a try. I may improve these codes when I get better.