From 218fb91e0225d2f7f4efa2d3d02cfcbab0c0f581 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Sun, 10 Jan 2021 14:33:17 +0100 Subject: Add pict->pdf. --- pict.scm | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) 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 "#" 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 -- cgit v1.2.3