;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
-;;;; Copyright (C) 1998--2011 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 1998--2012 Jan Nieuwenhuizen <janneke@gnu.org>
;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
;;;;
;;;; LilyPond is free software: you can redistribute it and/or modify
;;;; You should have received a copy of the GNU General Public License
;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
-;; (use-modules (ice-9 optargs))
+; for define-safe-public when byte-compiling using Guile V2
+(use-modules (scm safe-utility-defs))
+
+(use-modules (ice-9 optargs))
;;; ly:music-property with setter
;;; (ly:music-property my-music 'elements)
@var{music}."
(let ((es (ly:music-property music 'elements))
(e (ly:music-property music 'element)))
- (set! (ly:music-property music 'elements)
- (map (lambda (y) (music-map function y)) es))
+ (if (pair? es)
+ (set! (ly:music-property music 'elements)
+ (map (lambda (y) (music-map function y)) es)))
(if (ly:music? e)
(set! (ly:music-property music 'element)
(music-map function e)))
(inner-music-filter pred? e)
e))
(filtered-es (filter ly:music? (map (lambda (y) (inner-music-filter pred? y)) es))))
- (set! (ly:music-property music 'element) filtered-e)
- (set! (ly:music-property music 'elements) filtered-es)
- (set! (ly:music-property music 'articulations) filtered-as)
+ (if (not (null? e))
+ (set! (ly:music-property music 'element) filtered-e))
+ (if (not (null? es))
+ (set! (ly:music-property music 'elements) filtered-es))
+ (if (not (null? as))
+ (set! (ly:music-property music 'articulations) filtered-as))
;; if filtering emptied the expression, we remove it completely.
(if (or (not (pred? music))
(and (eq? filtered-es '()) (not (ly:music? e))
music
(make-music 'Music))) ;must return music.
-(define-public (display-music music)
+(define*-public (display-music music #:optional (port (current-output-port)))
"Display music, not done with @code{music-map} for clarity of
presentation."
-
- (display music)
- (display ": { ")
+ (display music port)
+ (display ": { " port)
(let ((es (ly:music-property music 'elements))
(e (ly:music-property music 'element)))
- (display (ly:music-mutable-properties music))
+ (display (ly:music-mutable-properties music) port)
(if (pair? es)
- (begin (display "\nElements: {\n")
- (map display-music es)
- (display "}\n")))
+ (begin (display "\nElements: {\n" port)
+ (for-each (lambda (m) (display-music m port)) es)
+ (display "}\n" port)))
(if (ly:music? e)
(begin
- (display "\nChild:")
- (display-music e))))
- (display " }\n")
+ (display "\nChild:" port)
+ (display-music e port))))
+ (display " }\n" port)
music)
;;;
(use-modules (ice-9 pretty-print))
(define*-public (display-scheme-music obj #:optional (port (current-output-port)))
"Displays `obj', typically a music expression, in a friendly fashion,
-which often can be read back in order to generate an equivalent expression.
-
-Returns `obj'.
-"
+which often can be read back in order to generate an equivalent expression."
(pretty-print (music->make-music obj) port)
- (newline)
- obj)
+ (newline port))
;;;
;;; Scheme music expression --> Lily-syntax-using string translator
(use-modules (srfi srfi-39)
(scm display-lily))
-(define*-public (display-lily-music expr parser #:key force-duration)
+(define*-public (display-lily-music expr parser #:optional (port (current-output-port))
+ #:key force-duration)
"Display the music expression using LilyPond syntax"
(memoize-clef-names supported-clefs)
(parameterize ((*indent* 0)
(*previous-duration* (ly:make-duration 2))
(*force-duration* force-duration))
- (display (music->lily-string expr parser))
- (newline)))
+ (display (music->lily-string expr parser) port)
+ (newline port)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (shift-one-duration-log music shift dot)
"Add @var{shift} to @code{duration-log} of @code{'duration} in
-@var{music} and optionally @var{dot} to any note encountered. This
-scales the music up by a factor `2^@var{shift} * (2 - (1/2)^@var{dot})'."
+@var{music} and optionally @var{dot} to any note encountered.
+The number of dots in the shifted music may not be less than zero."
(let ((d (ly:music-property music 'duration)))
(if (ly:duration? d)
(let* ((cp (ly:duration-factor d))
- (nd (ly:make-duration (+ shift (ly:duration-log d))
- (+ dot (ly:duration-dot-count d))
- (car cp)
- (cdr cp))))
+ (nd (ly:make-duration
+ (+ shift (ly:duration-log d))
+ (max 0 (+ dot (ly:duration-dot-count d)))
+ (car cp)
+ (cdr cp))))
(set! (ly:music-property music 'duration) nd)))
music))
(define (first-note-duration music)
"Finds the duration of the first NoteEvent by searching depth-first
through MUSIC."
- (if (memq 'note-event (ly:music-property music 'types))
+ ;; NoteEvent or a non-expanded chord-repetition
+ ;; We just take anything that actually sports an announced duration.
+ (if (ly:duration? (ly:music-property music 'duration))
(ly:music-property music 'duration)
(let loop ((elts (if (ly:music? (ly:music-property music 'element))
(list (ly:music-property music 'element))
(set! (ly:music-property r 'repeat-count) (max times 1))
(set! (ly:music-property r 'elements) talts)
(if (and (equal? name "tremolo")
- (or (pair? (ly:music-property main 'elements))
- (ly:music? (ly:music-property main 'element))))
+ (pair? (extract-named-music main '(EventChord NoteEvent))))
;; This works for single-note and multi-note tremolos!
(let* ((children (if (music-is-of-type? main 'sequential-music)
;; \repeat tremolo n { ... }
- (length (ly:music-property main 'elements))
+ (length (extract-named-music main '(EventChord
+ NoteEvent)))
;; \repeat tremolo n c4
1))
;; # of dots is equal to the 1 in bitwise representation (minus 1)!
(define (calc-repeat-slash-count music)
"Given the child-list @var{music} in @code{PercentRepeatMusic},
calculate the number of slashes based on the durations. Returns @code{0}
-if durations in in @var{music} vary, allowing slash beats and double-percent
+if durations in @var{music} vary, allowing slash beats and double-percent
beats to be distinguished."
- (let* ((durs (map (lambda (elt)
- (duration-of-note elt))
- (extract-named-music music 'EventChord)))
+ (let* ((durs (map duration-of-note
+ (extract-named-music music '(EventChord NoteEvent
+ RestEvent SkipEvent))))
(first-dur (car durs)))
(if (every (lambda (d) (equal? d first-dur)) durs)
'grob-property gprop))
(define direction-polyphonic-grobs
- '(DotColumn
+ '(AccidentalSuggestion
+ DotColumn
Dots
Fingering
LaissezVibrerTie
+ LigatureBracket
PhrasingSlur
RepeatTie
Rest
Slur
Stem
TextScript
- Tie))
+ Tie
+ TupletBracket
+ TrillSpanner))
(define-safe-public (make-voice-props-set n)
(make-sequential-music
(append
(map (lambda (x) (make-grob-property-set x 'direction
- (if (odd? n) -1 1)))
+ (if (odd? n) -1 1)))
direction-polyphonic-grobs)
(list
(make-property-set 'graceSettings
;; TODO: take this from voicedGraceSettings or similar.
'((Voice Stem font-size -3)
+ (Voice Flag font-size -3)
(Voice NoteHead font-size -3)
(Voice TabNoteHead font-size -4)
(Voice Dots font-size -3)
(make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2))
(make-grob-property-set 'MultiMeasureRest 'staff-position (if (odd? n) -4 4))))))
+(define-safe-public (make-voice-props-override n)
+ (make-sequential-music
+ (append
+ (map (lambda (x) (make-grob-property-override x 'direction
+ (if (odd? n) -1 1)))
+ direction-polyphonic-grobs)
+ (list
+ (make-property-set 'graceSettings
+ ;; TODO: take this from voicedGraceSettings or similar.
+ '((Voice Stem font-size -3)
+ (Voice Flag font-size -3)
+ (Voice NoteHead font-size -3)
+ (Voice TabNoteHead font-size -4)
+ (Voice Dots font-size -3)
+ (Voice Stem length-fraction 0.8)
+ (Voice Stem no-stem-extend #t)
+ (Voice Beam beam-thickness 0.384)
+ (Voice Beam length-fraction 0.8)
+ (Voice Accidental font-size -4)
+ (Voice AccidentalCautionary font-size -4)
+ (Voice Script font-size -3)
+ (Voice Fingering font-size -8)
+ (Voice StringNumber font-size -8)))
+
+ (make-grob-property-override 'NoteColumn 'horizontal-shift (quotient n 2))
+ (make-grob-property-override 'MultiMeasureRest 'staff-position (if (odd? n) -4 4))))))
+
(define-safe-public (make-voice-props-revert)
(make-sequential-music
(append
(make-music 'PropertyUnset
'symbol sym))
-;;; Need to keep this definition for \time calls from parser
-(define-public (make-time-signature-set num den)
- "Set properties for time signature @var{num}/@var{den}."
- (make-music 'TimeSignatureMusic
- 'numerator num
- 'denominator den
- 'beat-structure '()))
-
-;;; Used for calls that include beat-grouping setting
-(define-public (set-time-signature num den . rest)
- "Set properties for time signature @var{num}/@var{den}.
-If @var{rest} is present, it is used to set @code{beatStructure}."
- (ly:export
- (make-music 'TimeSignatureMusic
- 'numerator num
- 'denominator den
- 'beat-structure (if (null? rest) rest (car rest)))))
-
(define-safe-public (make-articulation name)
(make-music 'ArticulationEvent
'articulation-type name))
(let ((ts (ly:music-property m 'types)))
(memq 'separator ts)))
+;;; expanding repeat chords
+(define-public (copy-repeat-chord original-chord repeat-chord duration
+ event-types)
+ "Copies all events in @var{event-types} (be sure to include
+@code{rhythmic-events}) from @var{original-chord} over to
+@var{repeat-chord} with their articulations filtered as well. Any
+duration is replaced with the specified @var{duration}."
+ ;; First remove everything from event-types that can already be
+ ;; found in the repeated chord. We don't need to look for
+ ;; articulations on individual events since they can't actually get
+ ;; into a repeat chord given its input syntax.
+ (for-each (lambda (e)
+ (for-each (lambda (x)
+ (set! event-types (delq x event-types)))
+ (ly:music-property e 'types)))
+ (ly:music-property repeat-chord 'elements))
+ ;; now treat the elements
+ (set! (ly:music-property repeat-chord 'elements)
+ (append!
+ (filter-map
+ (lambda (m)
+ (and (any (lambda (t) (music-is-of-type? m t)) event-types)
+ (begin
+ (set! m (ly:music-deep-copy m))
+ (if (pair? (ly:music-property m 'articulations))
+ (set! (ly:music-property m 'articulations)
+ (filter
+ (lambda (a)
+ (any (lambda (t) (music-is-of-type? a t))
+ event-types))
+ (ly:music-property m 'articulations))))
+ (if (ly:duration? (ly:music-property m 'duration))
+ (set! (ly:music-property m 'duration) duration))
+ m)))
+ (ly:music-property original-chord 'elements))
+ (ly:music-property repeat-chord 'elements))))
+
+(define-public (expand-repeat-chords! event-types music)
+ "Walks through @var{music} and fills repeated chords (notable by
+having a duration in @code{duration}) with the notes from their
+respective predecessor chord."
+ (let loop ((music music) (last-chord #f))
+ (if (music-is-of-type? music 'event-chord)
+ (let ((chord-repeat (ly:music-property music 'duration)))
+ (cond
+ ((not (ly:duration? chord-repeat))
+ (if (any (lambda (m) (ly:duration?
+ (ly:music-property m 'duration)))
+ (ly:music-property music 'elements))
+ music
+ last-chord))
+ (last-chord
+ (set! (ly:music-property music 'duration) '())
+ (copy-repeat-chord last-chord music chord-repeat event-types)
+ music)
+ (else
+ (ly:music-warning music (_ "Bad chord repetition"))
+ #f)))
+ (let ((elt (ly:music-property music 'element)))
+ (fold loop (if (ly:music? elt) (loop elt last-chord) last-chord)
+ (ly:music-property music 'elements)))))
+ music)
+
;;; splitting chords into voices.
(define (voicify-list lst number)
"Make a list of Musics.
m))
(define-public (empty-music)
- (ly:export (make-music 'Music)))
+ (make-music 'Music))
;; Make a function that checks score element for being of a specific type.
(define-public (make-type-checker symbol)
(set! (ly:grob-property grob symbol) val))))
-;;
-(define-public (smart-bar-check n)
- "Make a bar check that checks for a specific bar number."
- (let ((m (make-music 'ApplyContext)))
- (define (checker tr)
- (let* ((bn (ly:context-property tr 'currentBarNumber)))
- (if (= bn n)
- #t
- (ly:error
- ;; FIXME: uncomprehensable message
- (_ "Bar check failed. Expect to be at ~a, instead at ~a")
- n bn))))
- (set! (ly:music-property m 'procedure) checker)
- m))
-
-
(define-public (skip->rest mus)
"Replace @var{mus} by @code{RestEvent} of the same duration if it is a
@code{SkipEvent}. Useful for extracting parts from crowded scores."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; warn for bare chords at start.
-
(define-public (ly:music-message music msg)
(let ((ip (ly:music-property music 'origin)))
(if (ly:input-location? ip)
- (ly:input-message ip msg)
- (ly:warning msg))))
+ (ly:input-message ip msg)
+ (ly:message msg))))
+
+(define-public (ly:music-warning music msg)
+ (let ((ip (ly:music-property music 'origin)))
+ (if (ly:input-location? ip)
+ (ly:input-warning ip msg)
+ (ly:warning msg))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
(new-settings (append current
(list (list context-name grob sym val)))))
(ly:context-set-property! where 'graceSettings new-settings)))
- (ly:export (context-spec-music (make-apply-context set-prop) 'Voice)))
+ (context-spec-music (make-apply-context set-prop) 'Voice))
(define-public (remove-grace-property context-name grob sym)
"Remove all @var{sym} for @var{grob} in @var{context-name}."
(set! new-settings (delete x new-settings)))
prop-settings)
(ly:context-set-property! where 'graceSettings new-settings)))
- (ly:export (context-spec-music (make-apply-context delete-prop) 'Voice)))
+ (context-spec-music (make-apply-context delete-prop) 'Voice))
music
(ly:music-deep-copy ,stop))))))
-(defmacro-public define-music-function (args signature . body)
+(defmacro-public define-syntax-function (type args signature . body)
"Helper macro for `ly:make-music-function'.
Syntax:
- (define-music-function (parser location arg1 arg2 ...) (arg1-type? arg2-type? ...)
+ (define-syntax-function (result-type? parser location arg1 arg2 ...) (result-type? arg1-type arg2-type ...)
...function body...)
-"
-(if (and (pair? body) (pair? (car body)) (eqv? '_i (caar body)))
+
+argX-type can take one of the forms @code{predicate?} for mandatory
+arguments satisfying the predicate, @code{(predicate?)} for optional
+parameters of that type defaulting to @code{#f}, @code{@w{(predicate?
+value)}} for optional parameters with a specified default
+value (evaluated at definition time). An optional parameter can be
+omitted in a call only when it can't get confused with a following
+parameter of different type.
+
+Predicates with syntactical significance are @code{ly:pitch?},
+@code{ly:duration?}, @code{ly:music?}, @code{markup?}. Other
+predicates require the parameter to be entered as Scheme expression.
+
+@code{result-type?} can specify a default in the same manner as
+predicates, to be used in case of a type error in arguments or
+result."
+
+ (set! signature (map (lambda (pred)
+ (if (pair? pred)
+ `(cons ,(car pred)
+ ,(and (pair? (cdr pred)) (cadr pred)))
+ pred))
+ (cons type signature)))
+ (if (and (pair? body) (pair? (car body)) (eqv? '_i (caar body)))
;; When the music function definition contains a i10n doc string,
;; (_i "doc string"), keep the literal string only
(let ((docstring (cadar body))
(body (cdr body)))
`(ly:make-music-function (list ,@signature)
- (lambda (,@args)
+ (lambda ,args
,docstring
,@body)))
`(ly:make-music-function (list ,@signature)
- (lambda (,@args)
+ (lambda ,args
,@body))))
+(defmacro-public define-music-function rest
+ "Defining macro returning music functions.
+Syntax:
+ (define-music-function (parser location arg1 arg2 ...) (arg1-type? arg2-type? ...)
+ ...function body...)
+
+argX-type can take one of the forms @code{predicate?} for mandatory
+arguments satisfying the predicate, @code{(predicate?)} for optional
+parameters of that type defaulting to @code{#f}, @code{@w{(predicate?
+value)}} for optional parameters with a specified default
+value (evaluated at definition time). An optional parameter can be
+omitted in a call only when it can't get confused with a following
+parameter of different type.
+
+Predicates with syntactical significance are @code{ly:pitch?},
+@code{ly:duration?}, @code{ly:music?}, @code{markup?}. Other
+predicates require the parameter to be entered as Scheme expression.
+
+Must return a music expression. The @code{origin} is automatically
+set to the @code{location} parameter."
+
+ `(define-syntax-function (ly:music? (make-music 'Music 'void #t)) ,@rest))
+
+
+(defmacro-public define-scheme-function rest
+ "Defining macro returning Scheme functions.
+Syntax:
+ (define-scheme-function (parser location arg1 arg2 ...) (arg1-type? arg2-type? ...)
+ ...function body...)
+
+argX-type can take one of the forms @code{predicate?} for mandatory
+arguments satisfying the predicate, @code{(predicate?)} for optional
+parameters of that type defaulting to @code{#f}, @code{@w{(predicate?
+value)}} for optional parameters with a specified default
+value (evaluated at definition time). An optional parameter can be
+omitted in a call only when it can't get confused with a following
+parameter of different type.
+
+Predicates with syntactical significance are @code{ly:pitch?},
+@code{ly:duration?}, @code{ly:music?}, @code{markup?}. Other
+predicates require the parameter to be entered as Scheme expression.
+
+Can return arbitrary expressions. If a music expression is returned,
+its @code{origin} is automatically set to the @code{location}
+parameter."
+
+ `(define-syntax-function scheme? ,@rest))
+
+(defmacro-public define-void-function rest
+ "This defines a Scheme function like @code{define-scheme-function} with
+void return value (i.e., what most Guile functions with `unspecified'
+value return). Use this when defining functions for executing actions
+rather than returning values, to keep Lilypond from trying to interpret
+the return value."
+ `(define-syntax-function (void? *unspecified*) ,@rest *unspecified*))
+
+(defmacro-public define-event-function rest
+ "Defining macro returning event functions.
+Syntax:
+ (define-event-function (parser location arg1 arg2 ...) (arg1-type? arg2-type? ...)
+ ...function body...)
+
+argX-type can take one of the forms @code{predicate?} for mandatory
+arguments satisfying the predicate, @code{(predicate?)} for optional
+parameters of that type defaulting to @code{#f}, @code{@w{(predicate?
+value)}} for optional parameters with a specified default
+value (evaluated at definition time). An optional parameter can be
+omitted in a call only when it can't get confused with a following
+parameter of different type.
+
+Predicates with syntactical significance are @code{ly:pitch?},
+@code{ly:duration?}, @code{ly:music?}, @code{markup?}. Other
+predicates require the parameter to be entered as Scheme expression.
+
+Must return an event expression. The @code{origin} is automatically
+set to the @code{location} parameter."
+
+ `(define-syntax-function (ly:event? (make-music 'Event 'void #t)) ,@rest))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (null? clef)
(make-music 'Music)
(make-cue-clef-set clef))
- (context-spec-music (make-voice-props-set cue-voice) 'CueVoice "cue")
+ (context-spec-music (make-voice-props-override cue-voice) 'CueVoice "cue")
quote-music
(context-spec-music (make-voice-props-revert) 'CueVoice "cue")
(if (null? clef)
(set! main-music
(make-sequential-music
(list
- (make-voice-props-set main-voice)
+ (make-voice-props-override main-voice)
main-music
(make-voice-props-revert))))
(set! (ly:music-property quote-music 'element) main-music)))
(define-public ((quote-substitute quote-tab) music)
(let* ((quoted-name (ly:music-property music 'quoted-music-name))
- (quoted-vector (if (string? quoted-name)
- (hash-ref quote-tab quoted-name #f)
- #f)))
+ (quoted-vector (and (string? quoted-name)
+ (hash-ref quote-tab quoted-name #f))))
(if (string? quoted-name)
(set! (ly:music-property music 'quoted-events) quoted-vector)
(set! (ly:music-property music 'iterator-ctor)
ly:quote-iterator::constructor))
- (ly:warning (_ "cannot find quoted music: `~S'") quoted-name)))
+ (ly:music-warning music (ly:format (_ "cannot find quoted music: `~S'") quoted-name))))
music))
(let*
((show-last (ly:parser-lookup parser 'showLastLength))
(show-first (ly:parser-lookup parser 'showFirstLength))
- (show-last-length (if (ly:music? show-last)
- (ly:music-length show-last)
- #f))
- (show-first-length (if (ly:music? show-first)
- (ly:music-length show-first)
- #f))
+ (show-last-length (and (ly:music? show-last)
+ (ly:music-length show-last)))
+ (show-first-length (and (ly:music? show-first)
+ (ly:music-length show-first)))
(orig-length (ly:music-length music)))
;;FIXME: if using either showFirst- or showLastLength,
(define-public toplevel-music-functions
(list
+ (lambda (music parser) (expand-repeat-chords!
+ (cons 'rhythmic-event
+ (ly:parser-lookup parser '$chord-repeat-events))
+ music))
(lambda (music parser) (voicify-music music))
(lambda (x parser) (music-map music-check-error x))
(lambda (x parser) (music-map precompute-music-length x))
;; accidentals
(define (recent-enough? bar-number alteration-def laziness)
- (if (or (number? alteration-def)
- (equal? laziness #t))
- #t
+ (or (number? alteration-def)
+ (equal? laziness #t)
(<= bar-number (+ (cadr alteration-def) laziness))))
-(define (accidental-voided? alteration-def)
- "Checks an alteration entry for being voided.
+(define (accidental-invalid? alteration-def)
+ "Checks an alteration entry for being invalid.
-Non-key alterations are voided when tying into the next bar or when
-there is a clef change, since neither repetition nor cancellation can
-be omitted when the same note occurs again.
+Non-key alterations are invalidated when tying into the next bar or
+when there is a clef change, since neither repetition nor cancellation
+can be omitted when the same note occurs again.
-Returns @code{#f} or the reason for the voiding, a symbol."
+Returns @code{#f} or the reason for the invalidation, a symbol."
(let* ((def (if (pair? alteration-def)
(car alteration-def)
alteration-def)))
(previous-alteration #f)
(from-other-octaves #f)
(from-same-octave (assoc-get pitch-handle local-key-sig))
- (from-key-sig (assoc-get notename local-key-sig)))
+ (from-key-sig (or (assoc-get notename local-key-sig)
;; If no key signature match is found from localKeySignature, we may have a custom
;; type with octave-specific entries of the form ((octave . pitch) alteration)
;; instead of (pitch . alteration). Since this type cannot coexist with entries in
;; localKeySignature, try extracting from keySignature instead.
- (if (equal? from-key-sig #f)
- (set! from-key-sig (assoc-get pitch-handle key-sig)))
+ (assoc-get pitch-handle key-sig))))
;; loop through localKeySignature to search for a notename match from other octaves
(let loop ((l local-key-sig))
;; find previous alteration-def for comparison with pitch
(cond
;; from same octave?
- ((and (eq? ignore-octave #f)
- (not (equal? from-same-octave #f))
+ ((and (not ignore-octave)
+ from-same-octave
(recent-enough? barnum from-same-octave laziness))
(set! previous-alteration from-same-octave))
;; from any octave?
- ((and (eq? ignore-octave #t)
- (not (equal? from-other-octaves #f))
+ ((and ignore-octave
+ from-other-octaves
(recent-enough? barnum from-other-octaves laziness))
(set! previous-alteration from-other-octaves))
;; not recent enough, extract from key signature/local key signature
- ((not (equal? from-key-sig #f))
+ (from-key-sig
(set! previous-alteration from-key-sig)))
- (if (accidental-voided? previous-alteration)
+ (if (accidental-invalid? previous-alteration)
(set! need-accidental #t)
(let* ((prev-alt (extract-alteration previous-alteration))
(begin
(set! need-accidental #t)
(if (and (not (= this-alt 0))
- (or (< (abs this-alt) (abs prev-alt))
- (< (* prev-alt this-alt) 0)))
+ (and (< (abs this-alt) (abs prev-alt))
+ (> (* prev-alt this-alt) 0)))
(set! need-restore #t))))))
(cons need-restore need-accidental)))
@var{laziness} states over how many bars an accidental should be remembered.
@code{0}@tie{}is the default -- accidental lasts over 0@tie{}bar lines, that
is, to the end of current measure. A positive integer means that the
-accidental lasts over that many bar lines. @code{-1} is `forget
+accidental lasts over that many bar lines. @w{@code{-1}} is `forget
immediately', that is, only look at key signature. @code{#t} is `forever'."
(check-pitch-against-signature context pitch barnum laziness octaveness))
@var{accept-global} states whether key signature entries should be included.
@var{accept-local} states whether local accidentals should be included.
If no matching entry is found, @var{#f} is returned."
- (if (pair? keysig)
- (let* ((entry (car keysig))
- (entryoct (key-entry-octave entry))
- (entrynn (key-entry-notename entry))
- (oct (ly:pitch-octave pitch))
- (nn (ly:pitch-notename pitch)))
- (if (and (equal? nn entrynn)
- (or (and accept-global (equal? #f entryoct))
- (and accept-local (equal? oct entryoct))))
- entry
- (find-pitch-entry (cdr keysig) pitch accept-global accept-local)))
- #f))
+ (and (pair? keysig)
+ (let* ((entry (car keysig))
+ (entryoct (key-entry-octave entry))
+ (entrynn (key-entry-notename entry))
+ (oct (ly:pitch-octave pitch))
+ (nn (ly:pitch-notename pitch)))
+ (if (and (equal? nn entrynn)
+ (or (and accept-global (not entryoct))
+ (and accept-local (equal? oct entryoct))))
+ entry
+ (find-pitch-entry (cdr keysig) pitch accept-global accept-local)))))
(define-public (neo-modern-accidental-rule context pitch barnum measurepos)
"An accidental rule that typesets an accidental if it differs from the
look at bar lines nor different accidentals at the same note name."
(let* ((keysig (ly:context-property context 'localKeySignature))
(entry (find-pitch-entry keysig pitch #t #t)))
- (if (equal? #f entry)
+ (if (not entry)
(cons #f #f)
(let* ((global-entry (find-pitch-entry keysig pitch #t #f))
(key-acc (key-entry-alteration global-entry))
on the same staff line."
(let* ((keysig (ly:context-property context 'localKeySignature))
(entry (find-pitch-entry keysig pitch #t #t)))
- (if (equal? #f entry)
+ (if (not entry)
(cons #f #f)
(let* ((global-entry (find-pitch-entry keysig pitch #f #f))
(key-acc (key-entry-alteration global-entry))
(car rest) 'Staff))
(pcontext (if (pair? rest)
(car rest) 'GrandStaff)))
- (ly:export
- (cond
+ (cond
;; accidentals as they were common in the 18th century.
((equal? style 'default)
(set-accidentals-properties #t
`(Staff ,(make-accidental-rule 'same-octave 0))
'()
context))
- ;; accidentals from one voice do NOT get cancelled in other voices
+ ;; accidentals from one voice do NOT get canceled in other voices
((equal? style 'voice)
(set-accidentals-properties #t
`(Voice ,(make-accidental-rule 'same-octave 0))
'()
context))
;; accidentals as suggested by Kurt Stone, Music Notation in the 20th century.
- ;; This includes all the default accidentals, but accidentals also needs cancelling
+ ;; This includes all the default accidentals, but accidentals also needs canceling
;; in other octaves and in the next measure.
((equal? style 'modern)
(set-accidentals-properties #f
context))
;; Multivoice accidentals to be read both by musicians playing one voice
;; and musicians playing all voices.
- ;; Accidentals are typeset for each voice, but they ARE cancelled across voices.
+ ;; Accidentals are typeset for each voice, but they ARE canceled across voices.
((equal? style 'modern-voice)
(set-accidentals-properties #f
`(Voice ,(make-accidental-rule 'same-octave 0)
,(make-accidental-rule 'same-octave 1))
context))
;; stone's suggestions for accidentals on grand staff.
- ;; Accidentals are cancelled across the staves in the same grand staff as well
+ ;; Accidentals are canceled across the staves in the same grand staff as well
((equal? style 'piano)
(set-accidentals-properties #f
`(Staff ,(make-accidental-rule 'same-octave 0)
context))
(else
(ly:warning (_ "unknown accidental style: ~S") style)
- (make-sequential-music '()))))))
+ (make-sequential-music '())))))
(define-public (invalidate-alterations context)
"Invalidate alterations in @var{context}.
(lambda (entry)
(let* ((localalt (key-entry-alteration entry))
(localoct (key-entry-octave entry)))
- (if (or (accidental-voided? localalt)
+ (if (or (accidental-invalid? localalt)
(not localoct)
(= localalt
(key-entry-alteration
entry
(cons (car entry) (cons 'clef (cddr entry))))))
(ly:context-property context 'localKeySignature)))))
-
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (skip-of-length mus)
(ly:music-property (car evs) 'pitch))))
(define-public (duration-of-note event-chord)
- (let ((evs (filter (lambda (x)
- (music-has-type x 'rhythmic-event))
- (ly:music-property event-chord 'elements))))
-
- (and (pair? evs)
- (ly:music-property (car evs) 'duration))))
+ (cond
+ ((pair? event-chord)
+ (or (duration-of-note (car event-chord))
+ (duration-of-note (cdr event-chord))))
+ ((ly:music? event-chord)
+ (let ((dur (ly:music-property event-chord 'duration)))
+ (if (ly:duration? dur)
+ dur
+ (duration-of-note (ly:music-property event-chord 'elements)))))
+ (else #f)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define-public (map-some-music map? music)
+ "Walk through @var{music}, transform all elements calling @var{map?}
+and only recurse if this returns @code{#f}."
+ (let loop ((music music))
+ (or (map? music)
+ (let ((elt (ly:music-property music 'element))
+ (elts (ly:music-property music 'elements))
+ (arts (ly:music-property music 'articulations)))
+ (if (ly:music? elt)
+ (set! (ly:music-property music 'element)
+ (loop elt)))
+ (if (pair? elts)
+ (set! (ly:music-property music 'elements)
+ (map loop elts)))
+ (if (pair? arts)
+ (set! (ly:music-property music 'articulations)
+ (map loop arts)))
+ music))))
+
+(define-public (for-some-music stop? music)
+ "Walk through @var{music}, process all elements calling @var{stop?}
+and only recurse if this returns @code{#f}."
+ (let loop ((music music))
+ (if (not (stop? music))
+ (let ((elt (ly:music-property music 'element)))
+ (if (ly:music? elt)
+ (loop elt))
+ (for-each loop (ly:music-property music 'elements))
+ (for-each loop (ly:music-property music 'articulations))))))
+
+(define-public (fold-some-music pred? proc init music)
+ "This works recursively on music like @code{fold} does on a list,
+calling @samp{(@var{pred?} music)} on every music element. If
+@code{#f} is returned for an element, it is processed recursively
+with the same initial value of @samp{previous}, otherwise
+@samp{(@var{proc} music previous)} replaces @samp{previous}
+and no recursion happens.
+The top @var{music} is processed using @var{init} for @samp{previous}."
+ (let loop ((music music) (previous init))
+ (if (pred? music)
+ (proc music previous)
+ (fold loop
+ (fold loop
+ (let ((elt (ly:music-property music 'element)))
+ (if (null? elt)
+ previous
+ (loop elt previous)))
+ (ly:music-property music 'elements))
+ (ly:music-property music 'articulations)))))
+
+(define-public (extract-music music pred?)
+ "Return a flat list of all music matching @var{pred?} inside of
+@var{music}, not recursing into matches themselves."
+ (reverse! (fold-some-music pred? cons '() music)))
+
(define-public (extract-named-music music music-name)
- "Return a flat list of all music named @var{music-name} from @var{music}."
- (let ((extracted-list
- (if (ly:music? music)
- (if (eq? (ly:music-property music 'name) music-name)
- (list music)
- (let ((elt (ly:music-property music 'element))
- (elts (ly:music-property music 'elements)))
- (if (ly:music? elt)
- (extract-named-music elt music-name)
- (if (null? elts)
- '()
- (map (lambda(x)
- (extract-named-music x music-name ))
- elts)))))
- '())))
- (flatten-list extracted-list)))
+ "Return a flat list of all music named @var{music-name} (either a
+single event symbol or a list of alternatives) inside of @var{music},
+not recursing into matches themselves."
+ (extract-music
+ music
+ (if (cheap-list? music-name)
+ (lambda (m) (memq (ly:music-property m 'name) music-name))
+ (lambda (m) (eq? (ly:music-property m 'name) music-name)))))
+
+(define-public (extract-typed-music music type)
+ "Return a flat list of all music with @var{type} (either a single
+type symbol or a list of alternatives) inside of @var{music}, not
+recursing into matches themselves."
+ (extract-music
+ music
+ (if (cheap-list? type)
+ (lambda (m)
+ (any (lambda (t) (music-is-of-type? m t)) type))
+ (lambda (m) (music-is-of-type? m type)))))
+
+(define*-public (event-chord-wrap! music #:optional parser)
+ "Wrap isolated rhythmic events and non-postevent events in
+@var{music} inside of an @code{EventChord}. If the optional
+@var{parser} argument is given, chord repeats @samp{q} are expanded
+using the default settings. Otherwise, you need to cater for them
+yourself."
+ (map-some-music
+ (lambda (m)
+ (cond ((music-is-of-type? m 'event-chord)
+ (if (pair? (ly:music-property m 'articulations))
+ (begin
+ (set! (ly:music-property m 'elements)
+ (append (ly:music-property m 'elements)
+ (ly:music-property m 'articulations)))
+ (set! (ly:music-property m 'articulations) '())))
+ m)
+ ((music-is-of-type? m 'rhythmic-event)
+ (let ((arts (ly:music-property m 'articulations)))
+ (if (pair? arts)
+ (set! (ly:music-property m 'articulations) '()))
+ (make-event-chord (cons m arts))))
+ (else #f)))
+ (if parser
+ (expand-repeat-chords!
+ (cons 'rhythmic-event
+ (ly:parser-lookup parser '$chord-repeat-events))
+ music)
+ music)))
(define-public (event-chord-notes event-chord)
"Return a list of all notes from @var{event-chord}."
projects / lilypond.git / blobdiff