;;;;
;;;; source file of the GNU LilyPond music typesetter
;;;;
-;;;; (c) 2004--2006 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; (c) 2004--2006 Han-Wen Nienhuys <hanwen@xs4all.nl>
(define-module (scm framework-ps))
(scm paper-system)
(srfi srfi-1)
(srfi srfi-13)
+ (scm clip-region)
(lily))
(sort (apply append all-font-names)
(lambda (x y) (string<? (cadr x) (cadr y))))))
-
- (font-loader (if (ly:get-option 'gs-font-load)
+ (font-loader (if (ly:get-option 'gs-load-fonts)
load-font-via-GS
load-font))
(page-count (length page-stencils))
(port (ly:outputter-port outputter)))
+
+ (if (ly:get-option 'clip-systems)
+ (clip-system-EPSes basename book))
+
(if (ly:get-option 'dump-signatures)
(write-system-signatures basename (ly:paper-book-systems book) 1))
(output-scopes scopes fields basename)
(display (file-header paper page-count #t) port)
-
;; don't do BeginDefaults PageMedia: A4
;; not necessary and wrong
-
(write-preamble paper #t port)
(for-each
(postprocess-output book framework-ps-module filename
(ly:output-formats))))
-(define-public (dump-stencil-as-EPS paper dump-me filename load-fonts?)
+(define-public (dump-stencil-as-EPS paper dump-me filename
+ load-fonts)
+
+ (let*
+ ((xext (ly:stencil-extent dump-me X))
+ (yext (ly:stencil-extent dump-me Y))
+ (left-overshoot (ly:get-option 'eps-box-padding))
+ (bbox
+ (map
+ (lambda (x)
+ (if (or (nan? x) (inf? x)
+ ;; FIXME: huh?
+ (equal? (format #f "~S" x) "+#.#")
+ (equal? (format #f "~S" x) "-#.#"))
+ 0.0 x))
+
+ ;; the left-overshoot is to make sure that
+ ;; bar numbers stick out of margin uniformly.
+ ;;
+ (list
+
+ (if (number? left-overshoot)
+ (min left-overshoot (car xext))
+ (car xext))
+ (car yext) (cdr xext) (cdr yext)))))
+
+ (dump-stencil-as-EPS-with-bbox paper dump-me filename load-fonts bbox)
+ ))
+
+
+(define-public (dump-stencil-as-EPS-with-bbox paper dump-me filename
+ load-fonts
+ bbox)
(define (to-bp-box mmbox)
(let* ((scale (ly:output-def-lookup paper 'output-scale))
(box (map
(open-file (format "~a.eps" filename) "wb")
"ps"))
- (left-overshoot -3)
(port (ly:outputter-port outputter))
- (xext (ly:stencil-extent dump-me X))
- (yext (ly:stencil-extent dump-me Y))
- (bbox
- (map
- (lambda (x)
- (if (or (nan? x) (inf? x)
- ;; FIXME: huh?
- (equal? (format #f "~S" x) "+#.#")
- (equal? (format #f "~S" x) "-#.#"))
- 0.0 x))
-
- ;; the left-overshoot is to make sure that
- ;; bar numbers stick out of margin uniformly.
- ;;
- (list
-
- (if (ly:get-option 'eps-pad-boxes)
- (min left-overshoot (car xext))
- (car xext))
- (car yext) (cdr xext) (cdr yext))))
-
(rounded-bbox (to-bp-box bbox))
(port (ly:outputter-port outputter))
- (header (eps-header paper rounded-bbox load-fonts?)))
+ (header (eps-header paper rounded-bbox load-fonts)))
(display header port)
- (write-preamble paper load-fonts? port)
+ (write-preamble paper load-fonts port)
(display "gsave set-ps-scale-to-lily-scale \n" port)
(ly:outputter-dump-stencil outputter dump-me)
(display "stroke grestore\n%%Trailer\n%%EOF\n" port)
(ly:outputter-close outputter)))
+
+
+(define (clip-systems-to-region
+ basename paper systems region
+ do-pdf)
+
+ (let*
+ ((extents-system-pairs
+ (filtered-map
+ (lambda (paper-system)
+ (let*
+ ((x-ext (system-clipped-x-extent
+ (paper-system-system-grob paper-system)
+ region)))
+
+ (if x-ext
+ (cons x-ext paper-system)
+ #f)))
+
+ systems))
+ (count 0))
+
+ (for-each
+ (lambda (ext-system-pair)
+ (let*
+ ((xext (car ext-system-pair))
+ (paper-system (cdr ext-system-pair))
+ (yext (paper-system-extent paper-system Y))
+ (bbox (list (car xext) (car yext)
+ (cdr xext) (cdr yext)))
+ (filename (if (< 0 count)
+ (format "~a-~a" basename count)
+ basename)))
+
+ (set! count (1+ count))
+ (dump-stencil-as-EPS-with-bbox
+ paper
+ (paper-system-stencil paper-system)
+ filename
+ (ly:get-option 'include-eps-fonts)
+ bbox)
+
+ (if do-pdf
+ (postscript->pdf 0 0 (format "~a.eps" filename)))
+ ))
+
+ extents-system-pairs)
+ ))
+
+
+(define (clip-system-EPSes basename paper-book)
+ (define do-pdf (member "pdf" (ly:output-formats)))
+
+ (define (clip-score-systems basename systems)
+ (let*
+ ((layout (ly:grob-layout (paper-system-system-grob (car systems))))
+ (regions (ly:output-def-lookup layout 'clip-regions)))
+
+ (for-each
+ (lambda (region)
+ (clip-systems-to-region
+ (format "~a-from-~a-to-~a-clip"
+ basename
+ (rhythmic-location->file-string (car region))
+ (rhythmic-location->file-string (cdr region)))
+ layout systems region
+ do-pdf))
+
+ regions)))
+
+
+ ;; partition in system lists sharing their layout blocks
+ (let*
+ ((systems (ly:paper-book-systems paper-book))
+ (count 0)
+ (score-system-list '()))
+
+ (fold
+ (lambda (system last-system)
+
+
+ (if (not (and last-system
+ (equal? (paper-system-layout last-system)
+ (paper-system-layout system))))
+ (set! score-system-list (cons '() score-system-list)))
+
+ (if (paper-system-layout system)
+ (set-car! score-system-list (cons system (car score-system-list))))
+
+ ;; pass value.
+ system)
+
+ #f
+ systems)
+
+ (for-each
+ (lambda (system-list)
+ (clip-score-systems
+ (if (> count 0)
+ (format "~a-~a" basename count)
+ basename)
+ system-list))
+
+ score-system-list)))
+
+
(define-public (output-preview-framework basename book scopes fields)
(let* ((paper (ly:paper-book-paper book))
(systems (ly:paper-book-systems book))
(postprocess-output book framework-ps-module
(format "~a.preview.eps" basename)
(ly:output-formats)))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (convert-to-pdf book name)
projects / lilypond.git / blobdiff