summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRicardo Wurmus <rekado@elephly.net>2021-01-10 14:33:17 +0100
committerRicardo Wurmus <rekado@elephly.net>2021-01-10 14:33:17 +0100
commit218fb91e0225d2f7f4efa2d3d02cfcbab0c0f581 (patch)
tree4d763010b66f6d05d5f5d0d7b5b8bbb9e5e79a11
parent1d39a878915d786b300926adebab5be7c581c587 (diff)
Add pict->pdf.
-rw-r--r--pict.scm26
1 files changed, 26 insertions, 0 deletions
diff --git a/pict.scm b/pict.scm
index 34dfe84..3e3f11a 100644
--- a/pict.scm
+++ b/pict.scm
@@ -41,6 +41,7 @@
pict-height
pict-rotation
pict->file
+ pict->pdf
pict-from-file
;; modifiers
@@ -150,6 +151,31 @@ the file to determine the file name. Return the file name."
(format port "#<Image: ~a>" name))))
(define %dpi 72) ; like cairo
+
+(define* (pict->pdf pict out #:key page-height page-width)
+ "Read SVG from picture PICT and write a PDF file to OUT."
+ (define svg
+ `(svg (@ (width ,(pict-width pict))
+ (height ,(pict-height pict))
+ (xmlns "http://www.w3.org/2000/svg"))
+ ,(pict-sxml pict)))
+ (let* ((port (mkstemp! (string-copy "/tmp/pictXXXXXXX")))
+ (name (port-filename port)))
+ (sxml->xml svg port)
+ (close-port port)
+ (let*-values (((d) (rsvg-set-default-dpi-x-y %dpi %dpi))
+ ((handle) (rsvg-handle-new-from-file name))
+ ((c) (rsvg-handle-close handle))
+ ((width height em ex) (rsvg-handle-get-dimensions handle)))
+ (let* ((surf (if (and page-height page-width)
+ (cairo-pdf-surface-create page-width page-height out)
+ (cairo-pdf-surface-create width height out)))
+ (ctx (cairo-create surf)))
+ (rsvg-handle-render-cairo handle ctx)
+ (cairo-show-page ctx)
+ (cairo-surface-finish surf)
+ out))))
+
;;; Miscellaneous utilities