summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRicardo Wurmus <rekado@elephly.net>2019-05-29 22:04:28 +0200
committerRicardo Wurmus <rekado@elephly.net>2019-05-29 22:04:28 +0200
commit05eecd83a8dd0764ede93b2e500ccf2714ed6d8f (patch)
treeb0042bcde3cb86e1ba5b4b3c6c9092091ac3bd6b
parent1ea8b78a8bceb4f7e5eaeb3e76987072267f99bb (diff)
pict: Add pict->file.
* pict.scm (pict->file): New procedure.
-rw-r--r--pict.scm17
1 files changed, 16 insertions, 1 deletions
diff --git a/pict.scm b/pict.scm
index 579cde3..58d3394 100644
--- a/pict.scm
+++ b/pict.scm
@@ -37,7 +37,7 @@
pict-width
pict-height
pict-rotation
-
+ pict->file
pict-from-file
;; modifiers
@@ -117,6 +117,21 @@
pict?
(sxml pict-sxml))
+(define (pict->file pict file-name)
+ "Write the PICT to a file with name FILE-NAME. If FILE-NAME is a
+procedure, it is called with the XML that is supposed to be written to
+the file to determine the file name. Return the file name."
+ (let* ((xml (with-output-to-string
+ (lambda _ (sxml->xml `(svg (@ (width ,(pict-width pict))
+ (height ,(pict-height pict))
+ (xmlns "http://www.w3.org/2000/svg"))
+ ,(pict-sxml pict))))))
+ (name (if (procedure? file-name)
+ (file-name xml) file-name)))
+ (with-output-to-file name
+ (lambda _ (display xml)))
+ name))
+
;; XXX: This is a hack to let Geiser display the image.
;; Since Geiser only supports the display of images that are
;; associated with a file we write out the SVG to a temp file and