From 05eecd83a8dd0764ede93b2e500ccf2714ed6d8f Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Wed, 29 May 2019 22:04:28 +0200 Subject: pict: Add pict->file. * pict.scm (pict->file): New procedure. --- pict.scm | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) 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 -- cgit v1.2.3