X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;ds=sidebyside;f=scm%2Fframework-ps.scm;h=032f0c5de1f263beae33126e2ce1edd09b3b9233;hb=c58b9bd118958423656e674c25d940cdec71f58a;hp=a179295cf5087f168f9999645d6c46b594e9a867;hpb=15eceefc16218ef60042259bb3878a52101d7d55;p=lilypond.git diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm index a179295cf5..032f0c5de1 100644 --- a/scm/framework-ps.scm +++ b/scm/framework-ps.scm @@ -1,6 +1,6 @@ ;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; Copyright (C) 2004--2010 Han-Wen Nienhuys +;;;; Copyright (C) 2004--2011 Han-Wen Nienhuys ;;;; ;;;; LilyPond is free software: you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -267,10 +267,12 @@ (let* ((dir-name (tmpnam)) (files '()) (status 0) - (embed #f)) + (embed #f) + (cwd (getcwd))) (mkdir dir-name #o700) - (set! status (ly:system - (format "cd ~a && fondu -force '~a'" dir-name filename))) + (chdir dir-name) + (set! status (ly:system (list "fondu" "-force" file-name))) + (chdir cwd) (set! files (dir-listing dir-name)) (for-each (lambda (f) @@ -377,6 +379,7 @@ (pfas (map font-loader font-names))) pfas)) + (display "%%BeginProlog\n" port) (format port @@ -396,6 +399,30 @@ (display "%%EndProlog\n" port) (display "%%BeginSetup\ninit-lilypond-parameters\n%%EndSetup\n\n" port)) +;;; Create DOCINFO pdfmark containing metadata +;;; header fields with pdf prefix override those without the prefix +(define (handle-metadata header port) + (define (metadata-lookup-output overridevar fallbackvar field) + (let* ((overrideval (ly:modules-lookup (list header) overridevar)) + (fallbackval (ly:modules-lookup (list header) fallbackvar)) + (val (if overrideval overrideval fallbackval))) + (if val + (format port "/~a (~a)\n" field (markup->string val))))) + (display "[ " port) + (metadata-lookup-output 'pdfcomposer 'composer "Author") + (format port "/Creator (LilyPond ~a)\n" (lilypond-version)) + (metadata-lookup-output 'pdftitle 'title "Title") + (metadata-lookup-output 'pdfsubject 'subject "Subject") + (metadata-lookup-output 'pdfkeywords 'keywords "Keywords") + (metadata-lookup-output 'pdfmodDate 'modDate "ModDate") + (metadata-lookup-output 'pdfsubtitle 'subtitle "Subtitle") + (metadata-lookup-output 'pdfcomposer 'composer "Composer") + (metadata-lookup-output 'pdfarranger 'arranger "Arranger") + (metadata-lookup-output 'pdfpoet 'poet "Poet") + (metadata-lookup-output 'pdfcopyright 'copyright "Copyright") + (display "/DOCINFO pdfmark\n\n" port)) + + (define-public (output-framework basename book scopes fields) (let* ((filename (format "~a.ps" basename)) (outputter (ly:make-paper-outputter @@ -405,6 +432,7 @@ (open-file filename "wb") 'ps)) (paper (ly:paper-book-paper book)) + (header (ly:paper-book-header book)) (systems (ly:paper-book-systems book)) (page-stencils (map page-stencil (ly:paper-book-pages book))) (landscape? (eq? (ly:output-def-lookup paper 'landscape) #t)) @@ -420,6 +448,8 @@ ;; don't do BeginDefaults PageMedia: A4 ;; not necessary and wrong (write-preamble paper #t port) + (if (module? header) + (handle-metadata header port)) (for-each (lambda (page) (set! page-number (1+ page-number)) @@ -460,9 +490,9 @@ (define-public (dump-stencil-as-EPS-with-bbox paper dump-me filename load-fonts bbox) - "Create an EPS file from stencil DUMP-ME to FILENAME. BBOX has -format (left-x, lower-y, right x, up-y). If LOAD-FONTS set, include -fonts inline." + "Create an EPS file from stencil @var{dump-me} to @var{filename}. +@var{bbox} has format @code{(left-x, lower-y, right-x, upper-y)}. If +@var{load-fonts} set, include fonts inline." (define (to-rounded-bp-box box) "Convert box to 1/72 inch with rounding to enlarge the box." (let* ((scale (ly:output-def-lookup paper 'output-scale)) @@ -593,9 +623,8 @@ fonts inline." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define-public (convert-to-pdf book name) - (let* ((defs (ly:paper-book-paper book)) - (landscape (ly:output-def-lookup defs 'landscape)) +(define (output-width-height defs) + (let* ((landscape (ly:output-def-lookup defs 'landscape)) (output-scale (ly:output-def-lookup defs 'output-scale)) (convert (lambda (x) (* x output-scale (/ (ly:bp 1))))) @@ -603,25 +632,35 @@ fonts inline." (paper-height (convert (ly:output-def-lookup defs 'paper-height))) (w (if landscape paper-height paper-width)) (h (if landscape paper-width paper-height))) - (if (equal? (basename name ".ps") "-") - (set! name (string-append "./" name))) - (postscript->pdf w h name))) + (cons w h))) + +(define (output-resolution defs) + (let ((defs-resolution (ly:output-def-lookup defs 'pngresolution))) + (if (number? defs-resolution) + defs-resolution + (ly:get-option 'resolution)))) + +(define (output-filename name) + (if (equal? (basename name ".ps") "-") + (string-append "./" name) + name)) + +(define-public (convert-to-pdf book name) + (let* ((defs (ly:paper-book-paper book)) + (width-height (output-width-height defs)) + (width (car width-height)) + (height (cdr width-height)) + (filename (output-filename name))) + (postscript->pdf width height filename))) (define-public (convert-to-png book name) (let* ((defs (ly:paper-book-paper book)) - (defs-resolution (ly:output-def-lookup defs 'pngresolution)) - (resolution (if (number? defs-resolution) - defs-resolution - (ly:get-option 'resolution))) - (paper-width (ly:output-def-lookup defs 'paper-width)) - (paper-height (ly:output-def-lookup defs 'paper-height)) - (output-scale (ly:output-def-lookup defs 'output-scale))) - (if (equal? (basename name ".ps") "-") - (set! name (string-append "./" name))) - (postscript->png resolution - (* paper-width output-scale (/ (ly:bp 1))) - (* paper-height output-scale (/ (ly:bp 1))) - name))) + (resolution (output-resolution defs)) + (width-height (output-width-height defs)) + (width (car width-height)) + (height (cdr width-height)) + (filename (output-filename name))) + (postscript->png resolution width height filename))) (define-public (convert-to-ps book name) #t)