diff options
-rw-r--r-- | pict.scm | 26 |
1 files changed, 26 insertions, 0 deletions
@@ -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 |