+2006-10-12 Han-Wen Nienhuys <hanwen@lilypond.org>
+
+ * 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 <reuter@ipd.uka.de>
* ly/engraver-init.ly: Remove obsolete comment on
* 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
@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,
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);
}
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");
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
"page-break-permission "
"page-turn-penalty "
"page-turn-permission "
+ "rhythmic-location "
"shortest-playing-duration "
"shortest-starter-duration "
"spacing "
#(define-public midi-debug #f)
+
+
\version "2.7.39"
\include "declarations-init.ly"
#(define $defaultheader #f)
#(define version-seen #f)
+
+#(use-modules (scm clip-region))
\maininput
%% there is a problem at the end of the input file
--- /dev/null
+;;
+;; clip-region.scm -- implement rhythmic-location and EPS musical clipping
+;;
+;; source file of the GNU LilyPond music typesetter
+;;
+;; (c) 2006 Han-Wen Nienhuys <hanwen@lilypond.org>
+;;
+
+(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<? a b)
+ (cond
+ ((< (car a) (car b)) #t)
+ ((> (car a) (car b)) #f)
+ (else
+ (ly:moment<? (cdr a) (cdr b)))))
+
+(define-public (rhythmic-location<=? a b)
+ (not (rhythmic-location<? b a)))
+(define-public (rhythmic-location>=? a b)
+ (rhythmic-location<? a b))
+(define-public (rhythmic-location>? a b)
+ (rhythmic-location<? b a))
+
+(define-public (rhythmic-location=? a b)
+ (and (rhythmic-location<=? a b)
+ (rhythmic-location<=? b a)))
+
+
+(define-public (rhythmic-location->file-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<? grace-less region-end)
+ (and (rhythmic-location=? grace-less region-end)
+ (eq? #t (ly:grob-property column 'non-musical))
+
+ )))
+
+ ))
+
+ (iota (ly:grob-array-length columns))))
+
+ (column-range
+ (if (>= 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))
(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.")
(scm paper-system)
(srfi srfi-1)
(srfi srfi-13)
+ (scm clip-region)
(lily))
(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))
+ (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
(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))
(postprocess-output book framework-ps-module
(format "~a.preview.eps" basename)
(ly:output-formats)))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (convert-to-pdf book name)
m))
;;;;;;;;;;;;;;;;
-; list
+;; list
+
+
+(define-public (filtered-map proc lst)
+ (filter
+ (lambda (x) x)
+ (map proc lst)))
+
(define (flatten-list lst)
"Unnest LST"
(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")
(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")
projects / lilypond.git / commitdiff