From: Han-Wen Nienhuys Date: Fri, 13 Oct 2006 12:44:55 +0000 (+0000) Subject: (clip-system-EPSes): change ordering, so X-Git-Tag: release/2.10.0-2~181 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=c4b604cde47ac2f7fcc4cb4f57a6bc8b6b58efa9;p=lilypond.git (clip-system-EPSes): change ordering, so system-count starts at 0 for each clip-region. Change name to file-FROM-TO-clip-COUNT. Take clip-regions from layout block, per score. --- diff --git a/ChangeLog b/ChangeLog index fdf468055b..d79178e76a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2006-10-13 Han-Wen Nienhuys + + * scm/framework-ps.scm (clip-system-EPSes): change ordering, so + system-count starts at 0 for each clip-region. Change name to + file-FROM-TO-clip-COUNT. Take clip-regions from layout block, per + score. + 2006-10-13 Erik Sandberg * lily/input-smob.cc: add equal_p for Input @@ -31,6 +38,8 @@ 2006-10-12 Han-Wen Nienhuys + * VERSION: release 2.9.23 + * lily/paper-column-engraver.cc (stop_translation_timestep): also typecheck barnumber. diff --git a/scm/clip-region.scm b/scm/clip-region.scm index ce1bd4d66b..eaf473058a 100644 --- a/scm/clip-region.scm +++ b/scm/clip-region.scm @@ -63,6 +63,13 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Actual clipping logic. +;; +;; the total of this will be +;; O(#systems * #regions) +;; +;; we can actually do better by sorting the regions as well, +;; but let's leave that for future extensions. +;; (define-public (system-clipped-x-extent system-grob clip-region) "Return the X-extent of the SYSTEM-GROB when clipped with CLIP-REGION. Return #f if not appropriate." diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm index 8cb0d3610b..fbab6a03a2 100644 --- a/scm/framework-ps.scm +++ b/scm/framework-ps.scm @@ -553,35 +553,39 @@ -(define (clip-system-EPS basename paper paper-system clip-regions - do-pdf) +(define (clip-systems-to-region + basename paper systems region + do-pdf) (let* - ((system-grob (paper-system-system-grob paper-system)) - (extents-region-pairs + ((extents-system-pairs (filtered-map - (lambda (region) + (lambda (paper-system) (let* - ((x-ext (system-clipped-x-extent system-grob region))) + ((x-ext (system-clipped-x-extent + (paper-system-system-grob paper-system) + region))) (if x-ext - (cons x-ext region) + (cons x-ext paper-system) #f))) - clip-regions))) + systems)) + (count 0)) (for-each - (lambda (ext-region-pair) + (lambda (ext-system-pair) (let* - ((xext (car ext-region-pair)) - (region (cdr ext-region-pair)) + ((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 (format "~a-clip-~a-~a" basename - (rhythmic-location->file-string (car region)) - (rhythmic-location->file-string (cdr region))))) + (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) @@ -593,32 +597,65 @@ (postscript->pdf 0 0 (format "~a.eps" filename))) )) - extents-region-pairs) - - + 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* - ((paper-def (ly:paper-book-paper paper-book)) - (do-pdf (member "pdf" (ly:output-formats))) + ((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)))) - (regions - (ly:output-def-lookup paper-def - 'clip-regions)) - (count 1) - (systems - (ly:paper-book-systems paper-book))) + ;; pass value. + system) + + #f + systems) (for-each - (lambda (system) - (clip-system-EPS - (format "~a-system-~a" basename count) paper-def system regions - do-pdf) - (set! count (1+ count)) - - ) - systems))) + (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)) diff --git a/scm/paper-system.scm b/scm/paper-system.scm index d3a140531f..55e48ebed8 100644 --- a/scm/paper-system.scm +++ b/scm/paper-system.scm @@ -17,6 +17,14 @@ (define-public (paper-system-stencil system) (ly:prob-property system 'stencil)) +(define-public (paper-system-layout system) + (let* + ((g (paper-system-system-grob system))) + + (if (ly:grob? g) + (ly:grob-layout g) + #f))) + (define-public (paper-system-system-grob paper-system) (ly:prob-property paper-system 'system-grob)) @@ -150,4 +158,4 @@ (ly:stencil-expr annotations) (ly:stencil-extent empty-stencil X) (ly:stencil-extent empty-stencil Y))))) - (ly:prob-property system 'stencil))) \ No newline at end of file + (ly:prob-property system 'stencil)))