From: Han-Wen Nienhuys Date: Thu, 12 Oct 2006 12:45:07 +0000 (+0000) Subject: * scm/lily.scm (define-scheme-options): add clip-systems option. X-Git-Tag: release/2.10.0-2~193 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=2a8c79664174b846da1fe107f429f23536f8724d;p=lilypond.git * scm/lily.scm (define-scheme-options): add clip-systems option. * scm/framework-ps.scm (dump-stencil-as-EPS-with-bbox): new function (dump-stencil-as-EPS): move bbox calculation from previous dump-stencil-as-EPS (output-framework): use -dclip-systems * scm/lily-library.scm (filtered-map): new function * scm/framework-ps.scm (clip-system-EPS): new function. (clip-system-EPSes): new function. * lily/paper-column.cc: add rhythmic-location to interface * scm/define-grob-properties.scm (all-user-grob-properties): add rhythmic-location property. * scm/clip-region.scm: new file: rhythmic-location data type and system-clipped-x-extent function. * ly/init.ly: use (scm clip-region) * lily/paper-column-engraver.cc (stop_translation_timestep): set rhythmic-location for paper column grobs. * lily/grob-scheme.cc (LY_DEFINE): minor cleanup --- diff --git a/ChangeLog b/ChangeLog index a45abe77c8..60568944f0 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,33 @@ +2006-10-12 Han-Wen Nienhuys + + * scm/lily.scm (define-scheme-options): add clip-systems option. + + * scm/framework-ps.scm (dump-stencil-as-EPS-with-bbox): new + function + (dump-stencil-as-EPS): move bbox calculation from previous + dump-stencil-as-EPS + (output-framework): use -dclip-systems + + * scm/lily-library.scm (filtered-map): new function + + * scm/framework-ps.scm (clip-system-EPS): new function. + (clip-system-EPSes): new function. + + * lily/paper-column.cc: add rhythmic-location to interface + + * scm/define-grob-properties.scm (all-user-grob-properties): add + rhythmic-location property. + + * scm/clip-region.scm: new file: rhythmic-location data type and + system-clipped-x-extent function. + + * ly/init.ly: use (scm clip-region) + + * lily/paper-column-engraver.cc (stop_translation_timestep): set + rhythmic-location for paper column grobs. + + * lily/grob-scheme.cc (LY_DEFINE): minor cleanup + 2006-10-12 Jürgen Reuter * ly/engraver-init.ly: Remove obsolete comment on @@ -34,7 +64,8 @@ * lily/new-fingering-engraver.cc (add_fingering): refactor; make generic for fingering & string number. Use for string-finger. - * scm/define-music-types.scm (music-descriptions): add StringFingerEvent + * scm/define-music-types.scm (music-descriptions): add + StringFingerEvent * lily/fingering-engraver.cc (listen_string_finger): new function diff --git a/Documentation/topdocs/NEWS.tely b/Documentation/topdocs/NEWS.tely index 4800bde69b..701fd2f9f0 100644 --- a/Documentation/topdocs/NEWS.tely +++ b/Documentation/topdocs/NEWS.tely @@ -66,6 +66,18 @@ which scares away people. @end ignore +@item By defining a clip region, a cutout EPS file of a number of measures +may be generated from the complete score. Hence, it is no longer +necessary to create separate files to create extracts of (long) +scores. + +An example is shown in @file{input/regression/clip-systems.ly}. This +feature was sponsored by Rick Hansen. + + + + + @item Lyric texts may include tie symbols by using the @code{~} symbol, diff --git a/lily/grob-scheme.cc b/lily/grob-scheme.cc index 0c56e1fd13..b31447ffac 100644 --- a/lily/grob-scheme.cc +++ b/lily/grob-scheme.cc @@ -19,13 +19,11 @@ LY_DEFINE (ly_grob_property_data, "ly:grob-property-data", 2, 0, 0, (SCM grob, SCM sym), - //, SCM dfault), "Retrieve @var{sym} for @var{grob} but don't process callbacks.") { Grob *sc = unsmob_grob (grob); SCM_ASSERT_TYPE (sc, grob, SCM_ARG1, __FUNCTION__, "grob"); SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, SCM_ARG2, __FUNCTION__, "symbol"); - // SCM_ASSERT_TYPE (ly_is_procedure (proc), proc, SCM_ARG3, __FUNCTION__, "procedure"); return sc->get_property_data (sym); } @@ -69,7 +67,7 @@ LY_DEFINE (ly_grob_property, "ly:grob-property", LY_DEFINE (ly_grob_interfaces, "ly:grob-interfaces", 1, 0, 0, (SCM grob), - "Return the interfaces list of grob @var{grob}.") + "Return the interfaces list of grob @var{grob}.") { Grob *sc = unsmob_grob (grob); SCM_ASSERT_TYPE (sc, grob, SCM_ARG1, __FUNCTION__, "grob"); diff --git a/lily/paper-column-engraver.cc b/lily/paper-column-engraver.cc index af67b67fe2..1bc0c6b0e5 100644 --- a/lily/paper-column-engraver.cc +++ b/lily/paper-column-engraver.cc @@ -202,6 +202,17 @@ Paper_column_engraver::stop_translation_timestep () first_ = false; break_events_.clear (); + + + SCM mpos = get_property ("measurePosition"); + if (unsmob_moment (mpos)) + { + SCM where = scm_cons (get_property ("internalBarNumber"), + mpos); + + command_column_->set_property ("rhythmic-location", where); + musical_column_->set_property ("rhythmic-location", where); + } } void diff --git a/lily/paper-column.cc b/lily/paper-column.cc index aa7d918c8e..0f01da091e 100644 --- a/lily/paper-column.cc +++ b/lily/paper-column.cc @@ -230,6 +230,7 @@ ADD_INTERFACE (Paper_column, "page-break-permission " "page-turn-penalty " "page-turn-permission " + "rhythmic-location " "shortest-playing-duration " "shortest-starter-duration " "spacing " diff --git a/ly/init.ly b/ly/init.ly index 1a9ec369cb..9eeae0c7fc 100644 --- a/ly/init.ly +++ b/ly/init.ly @@ -7,6 +7,8 @@ #(define-public midi-debug #f) + + \version "2.7.39" \include "declarations-init.ly" @@ -18,6 +20,8 @@ #(define $defaultheader #f) #(define version-seen #f) + +#(use-modules (scm clip-region)) \maininput %% there is a problem at the end of the input file diff --git a/scm/clip-region.scm b/scm/clip-region.scm new file mode 100644 index 0000000000..ce1bd4d66b --- /dev/null +++ b/scm/clip-region.scm @@ -0,0 +1,124 @@ +;; +;; clip-region.scm -- implement rhythmic-location and EPS musical clipping +;; +;; source file of the GNU LilyPond music typesetter +;; +;; (c) 2006 Han-Wen Nienhuys +;; + +(define-module (scm clip-region)) + +(use-modules (lily)) + + +(define-public (make-rhythmic-location bar-num num den) + (cons + bar-num (ly:make-moment num den))) + +(define-public (rhythmic-location? a) + (and (pair? a) + (integer? (car a)) + (ly:moment? (cdr a)))) + +(define-public (make-graceless-rhythmic-location loc) + (make-rhythmic-location + (car loc) + (ly:moment-main-numerator (rhythmic-location-measure-position loc)) + (ly:moment-main-denominator (rhythmic-location-measure-position loc)))) + + +(define-public rhythmic-location-measure-position cdr) +(define-public rhythmic-location-bar-number car) + +(define-public (rhythmic-location (car a) (car b)) #f) + (else + (ly:moment=? a b) + (rhythmic-location? a b) + (rhythmic-locationfile-string a) + (format "~a.~a.~a" + (car a) + (ly:moment-main-numerator (cdr a)) + (ly:moment-main-denominator (cdr a)))) + +(define-public (rhythmic-location->string a) + (format "bar ~a ~a" + (car a) + (ly:moment->string (cdr a)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Actual clipping logic. + +(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." + + (let* + ((region-start (car clip-region)) + (columns (ly:grob-object system-grob 'columns)) + (region-end (cdr clip-region)) + (found-grace-end #f) + (candidate-columns + (filter + (lambda (j) + (let* + ((column (ly:grob-array-ref columns j)) + (loc (ly:grob-property column 'rhythmic-location)) + (grace-less (make-graceless-rhythmic-location loc)) + ) + + (and (rhythmic-location? loc) + (rhythmic-location<=? region-start loc) + (or (rhythmic-location= 1 (length candidate-columns)) + #f + (cons (car candidate-columns) + (car (last-pair candidate-columns))))) + + (clipped-x-interval + (if column-range + (cons + + (interval-start + (ly:grob-robust-relative-extent + (if (= 0 (car column-range)) + system-grob + (ly:grob-array-ref columns (car column-range))) + system-grob X)) + + (interval-end + (ly:grob-robust-relative-extent + (if (= (1- (ly:grob-array-length columns)) (cdr column-range)) + system-grob + (ly:grob-array-ref columns (cdr column-range))) + system-grob X))) + + + #f + ))) + + clipped-x-interval)) diff --git a/scm/define-grob-properties.scm b/scm/define-grob-properties.scm index c1c5f43ea2..4edb3c336a 100644 --- a/scm/define-grob-properties.scm +++ b/scm/define-grob-properties.scm @@ -352,6 +352,7 @@ quicker the slur attains it @code{height-limit}.") (remove-empty ,boolean? "If set, remove group if it contains no @code{interesting-items}") (remove-first ,boolean? "Remove the first staff of a orchestral score?") + (rhythmic-location ,ly:moment? "Where (bar number, measure position) in the score.") (right-padding ,ly:dimension? "Space to insert on the right side of an object (eg. between note and its accidentals.)") (rotation ,list? "Number of degrees to rotate this object, and what point to rotate around. #'(45 0 0) means rotate 45 degrees around the center of this object.") diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm index 10934b84e8..957ef0d2da 100644 --- a/scm/framework-ps.scm +++ b/scm/framework-ps.scm @@ -16,6 +16,7 @@ (scm paper-system) (srfi srfi-1) (srfi srfi-13) + (scm clip-region) (lily)) @@ -455,17 +456,19 @@ (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 @@ -479,7 +482,37 @@ (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)) + (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 'pad-eps-boxes) + (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 @@ -504,38 +537,88 @@ (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 'pad-eps-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-system-EPS basename paper paper-system clip-regions + do-pdf) + + (let* + ((system-grob (paper-system-system-grob paper-system)) + (extents-region-pairs + (filtered-map + (lambda (region) + (let* + ((x-ext (system-clipped-x-extent system-grob region))) + + (if x-ext + (cons x-ext region) + #f))) + + clip-regions))) + + (for-each + (lambda (ext-region-pair) + (let* + ((xext (car ext-region-pair)) + (region (cdr ext-region-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))))) + + (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-region-pairs) + + + )) + +(define (clip-system-EPSes basename paper-book) + (let* + ((paper-def (ly:paper-book-paper paper-book)) + (do-pdf (member "pdf" (ly:output-formats))) + + (regions + (ly:output-def-lookup paper-def + 'clip-regions)) + (count 1) + (systems + (ly:paper-book-systems paper-book))) + + (for-each + (lambda (system) + (clip-system-EPS + (format "~a-system-~a" basename count) paper-def system regions + do-pdf) + (set! count (1+ count)) + + ) + systems))) + (define-public (output-preview-framework basename book scopes fields) (let* ((paper (ly:paper-book-paper book)) (systems (ly:paper-book-systems book)) @@ -591,6 +674,7 @@ (postprocess-output book framework-ps-module (format "~a.preview.eps" basename) (ly:output-formats))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-public (convert-to-pdf book name) diff --git a/scm/lily-library.scm b/scm/lily-library.scm index 492e38d5ec..1e6f407b09 100644 --- a/scm/lily-library.scm +++ b/scm/lily-library.scm @@ -228,7 +228,14 @@ found." m)) ;;;;;;;;;;;;;;;; -; list +;; list + + +(define-public (filtered-map proc lst) + (filter + (lambda (x) x) + (map proc lst))) + (define (flatten-list lst) "Unnest LST" diff --git a/scm/lily.scm b/scm/lily.scm index 8385bbdd00..a36cd5eb84 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -19,6 +19,7 @@ (anti-alias-factor 1 "render at higher resolution and scale down result\nto prevent jaggies in PNG") (check-internal-types #f "check every property assignment for types") + (clip-systems #f "Generate cut-out snippets of a score") (debug-gc #f "dump memory debugging statistics") (debug-midi #f "generate human readable MIDI") @@ -29,7 +30,7 @@ (gs-load-fonts #f "load fonts via Ghostscript.") (include-book-title-preview #t "include book-titles in preview images.") - (include-eps-fonts #f "Include fonts in separate-system EPS files.") + (include-eps-fonts #t "Include fonts in separate-system EPS files.") (pad-eps-boxes #f "Pad EPS bounding boxes to guarantee alignment between systems")