;;;;
;;;; source file of the GNU LilyPond music typesetter
;;;;
-;;;; (c) 1998--2007 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; (c) 1998--2009 Jan Nieuwenhuizen <janneke@gnu.org>
;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
;; (use-modules (ice-9 optargs))
(define-public (make-repeat name times main alts)
"create a repeat music expression, with all properties initialized properly"
+ (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))
+ (ly:music-property music 'duration)
+ (let loop ((elts (if (ly:music? (ly:music-property music 'element))
+ (list (ly:music-property music 'element))
+ (ly:music-property music 'elements))))
+ (and (pair? elts)
+ (let ((dur (first-note-duration (car elts))))
+ (if (ly:duration? dur)
+ dur
+ (loop (cdr elts))))))))
+
(let ((talts (if (< times (length alts))
(begin
(ly:warning (_ "More alternatives than repeats. Junking excess alternatives"))
(if (equal? name "tremolo")
(let* ((dots (1- (logcount times)))
(mult (/ (* times (ash 1 dots)) (1- (ash 2 dots))))
- (shift (- (ly:intlog2 (floor mult)))))
+ (shift (- (ly:intlog2 (floor mult))))
+ (note-duration (first-note-duration r))
+ (duration-log (if (ly:duration? note-duration)
+ (ly:duration-log note-duration)
+ 1))
+ (tremolo-type (ash 1 duration-log)))
+ (set! (ly:music-property r 'tremolo-type) tremolo-type)
(if (not (integer? mult))
(ly:warning (_ "invalid tremolo repeat count: ~a") times))
(if (memq 'sequential-music (ly:music-property main 'types))
-(defmacro-public def-grace-function (start stop)
+(defmacro-public def-grace-function (start stop . docstring)
+ "Helper macro for defining grace music"
`(define-music-function (parser location music) (ly:music?)
+ ,@docstring
(make-music 'GraceMusic
'origin location
'element (make-music 'SequentialMusic
(define-music-function (parser location arg1 arg2 ...) (arg1-type? arg2-type? ...)
...function body...)
"
- `(ly:make-music-function (list ,@signature)
- (lambda (,@args)
- ,@body)))
+(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)
+ ,docstring
+ ,@body)))
+ `(ly:make-music-function (list ,@signature)
+ (lambda (,@args)
+ ,@body))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(ly:music-length music))
music)
-(define (skip-to-last music parser)
+(define-public (make-duration-of-length moment)
+ "Make duration of the given MOMENT length."
+ (ly:make-duration 0 0
+ (ly:moment-main-numerator moment)
+ (ly:moment-main-denominator moment)))
- "Replace MUSIC by
+(define (skip-this moment)
+ "set skipTypesetting, make SkipMusic of the given MOMENT length,
+ and then unset skipTypesetting."
+ (make-sequential-music
+ (list
+ (context-spec-music (make-property-set 'skipTypesetting #t)
+ 'Score)
+ (make-music 'SkipMusic 'duration
+ (make-duration-of-length moment))
+ (context-spec-music (make-property-set 'skipTypesetting #f)
+ 'Score))))
+
+(define (unskip-this moment)
+ "unset skipTypesetting, make SkipMusic of the given MOMENT length,
+ and then set skipTypesetting."
+ (make-sequential-music
+ (list
+ (context-spec-music (make-property-set 'skipTypesetting #f)
+ 'Score)
+ (make-music 'SkipMusic 'duration
+ (make-duration-of-length moment))
+ (context-spec-music (make-property-set 'skipTypesetting #t)
+ 'Score))))
+
+(define (skip-as-needed music parser)
+ "Replace MUSIC by
+ << { \\set skipTypesetting = ##f
+ LENGTHOF(\\showFirstLength)
+ \\set skipTypesetting = ##t
+ LENGTHOF(\\showLastLength) }
+ MUSIC >>
+ if appropriate.
+
+ When only showFirstLength is set,
+ the 'length property of the music is
+ overridden to speed up compiling."
+ (let*
+ ((show-last (ly:parser-lookup parser 'showLastLength))
+ (show-first (ly:parser-lookup parser 'showFirstLength)))
+ (cond
+
+ ;; both properties may be set.
+ ((and (ly:music? show-first) (ly:music? show-last))
+ (let*
+ ((orig-length (ly:music-length music))
+ (skip-length (ly:moment-sub orig-length (ly:music-length show-last)))
+ (begin-length (ly:music-length show-first)))
+ (make-simultaneous-music
+ (list
+ (make-sequential-music
+ (list
+ (skip-this skip-length)
+ ;; let's draw a separator between the beginning and the end
+ (context-spec-music (make-property-set 'whichBar "||")
+ 'Timing)))
+ (unskip-this begin-length)
+ music))))
+
+ ;; we may only want to print the last length
+ ((ly:music? show-last)
+ (let*
+ ((orig-length (ly:music-length music))
+ (skip-length (ly:moment-sub orig-length (ly:music-length show-last))))
+ (make-simultaneous-music
+ (list
+ (skip-this skip-length)
+ music))))
+
+ ;; we may only want to print the beginning; in this case
+ ;; only the first length will be processed (much faster).
+ ((ly:music? show-first)
+ (let*
+ ((orig-length (ly:music-length music))
+ (begin-length (ly:music-length show-first)))
+ ;; the first length must not exceed the original length.
+ (if (ly:moment<? begin-length orig-length)
+ (set! (ly:music-property music 'length)
+ (ly:music-length show-first)))
+ music))
-<< { \\set skipTypesetting = ##t
- LENGTHOF(\\showLastLength)
- \\set skipTypesetting = ##t }
- MUSIC >>
+ (else music))))
-if appropriate.
- "
- (let*
- ((show-last (ly:parser-lookup parser 'showLastLength)))
-
- (if (ly:music? show-last)
- (let*
- ((orig-length (ly:music-length music))
- (skip-length (ly:moment-sub orig-length (ly:music-length show-last))))
-
- (make-simultaneous-music
- (list
- (make-sequential-music
- (list
- (context-spec-music (make-property-set 'skipTypesetting #t)
- 'Score)
- (make-music 'SkipMusic 'duration
- (ly:make-duration
- 0 0
- (ly:moment-main-numerator skip-length)
- (ly:moment-main-denominator skip-length)))
- (context-spec-music (make-property-set 'skipTypesetting #f)
- 'Score)))
- music)))
- music)))
-
(define-public toplevel-music-functions
(list
(lambda (x parser) (music-map cue-substitute x))
(lambda (x parser)
- (skip-to-last x parser)
+ (skip-as-needed x parser)
)))
+;;;;;;;;;;
+;;; general purpose music functions
+
+(define (shift-octave pitch octave-shift)
+ (_i "Add @var{octave-shift} to the octave of @var{pitch}.")
+ (ly:make-pitch
+ (+ (ly:pitch-octave pitch) octave-shift)
+ (ly:pitch-notename pitch)
+ (ly:pitch-alteration pitch)))
+
;;;;;;;;;;;;;;;;;
;; lyrics
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; accidentals
-(define-public ((make-accidental-rule octaveness lazyness) context pitch barnum measurepos)
+(define (recent-enough? bar-number alteration-def laziness)
+ (if (or (number? alteration-def)
+ (equal? laziness #t))
+ #t
+ (<= bar-number (+ (cadr alteration-def) laziness))))
+
+(define (is-tied? alteration-def)
+ (let* ((def (if (pair? alteration-def)
+ (car alteration-def)
+ alteration-def)))
+
+ (if (equal? def 'tied) #t #f)))
+
+(define (extract-alteration alteration-def)
+ (cond ((number? alteration-def)
+ alteration-def)
+ ((pair? alteration-def)
+ (car alteration-def))
+ (else 0)))
+
+(define (check-pitch-against-signature context pitch barnum laziness octaveness)
+ "Checks the need for an accidental and a @q{restore} accidental against
+@code{localKeySignature}. The @var{laziness} is the number of measures
+for which reminder accidentals are used (i.e., if @var{laziness} is zero,
+only cancel accidentals in the same measure; if @var{laziness} is three,
+we cancel accidentals up to three measures after they first appear.
+@var{octaveness} is either @code{'same-octave} or @code{'any-octave} and
+specifies whether accidentals should be canceled in different octaves."
+ (let* ((ignore-octave (cond ((equal? octaveness 'any-octave) #t)
+ ((equal? octaveness 'same-octave) #f)
+ (else
+ (ly:warning (_ "Unknown octaveness type: ~S ") octaveness)
+ (ly:warning (_ "Defaulting to 'any-octave."))
+ #t)))
+ (key-sig (ly:context-property context 'keySignature))
+ (local-key-sig (ly:context-property context 'localKeySignature))
+ (notename (ly:pitch-notename pitch))
+ (octave (ly:pitch-octave pitch))
+ (pitch-handle (cons octave notename))
+ (need-restore #f)
+ (need-accidental #f)
+ (previous-alteration #f)
+ (from-other-octaves #f)
+ (from-same-octave (ly:assoc-get pitch-handle local-key-sig))
+ (from-key-sig (ly: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 (ly:assoc-get pitch-handle key-sig)))
+
+ ;; loop through localKeySignature to search for a notename match from other octaves
+ (let loop ((l local-key-sig))
+ (if (pair? l)
+ (let ((entry (car l)))
+ (if (and (pair? (car entry))
+ (= (cdar entry) notename))
+ (set! from-other-octaves (cdr entry))
+ (loop (cdr l))))))
+
+ ;; find previous alteration-def for comparison with pitch
+ (cond
+ ;; from same octave?
+ ((and (eq? ignore-octave #f)
+ (not (equal? from-same-octave #f))
+ (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))
+ (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))
+ (set! previous-alteration from-key-sig)))
+
+ (if (is-tied? previous-alteration)
+ (set! need-accidental #t)
+
+ (let* ((prev-alt (extract-alteration previous-alteration))
+ (this-alt (ly:pitch-alteration pitch)))
+
+ (if (not (= this-alt prev-alt))
+ (begin
+ (set! need-accidental #t)
+ (if (and (not (= this-alt 0))
+ (or (< (abs this-alt) (abs prev-alt))
+ (< (* prev-alt this-alt) 0)))
+ (set! need-restore #t))))))
+
+ (cons need-restore need-accidental)))
+
+(define-public ((make-accidental-rule octaveness laziness) context pitch barnum measurepos)
"Creates an accidental rule that makes its decision based on the octave of the note
and a laziness value.
octaveness is either 'same-octave or 'any-octave and defines whether the rule should
normal way to typeset accidentals - an accidental is made if the alteration is different
from the last active pitch in the same octave. 'any-octave looks at the last active pitch
in any octave.
- lazyness states over how many bars an accidental should be remembered.
+ laziness states over how many bars an accidental should be remembered.
0 is default - accidental lasts over 0 bar lines, that is, to the end of current measure.
A positive integer means that the accidental lasts over that many bar lines.
-1 is 'forget immediately', that is, only look at key signature.
#t is forever."
- (let ((keysig (ly:context-property context 'localKeySignature)))
- (ly:find-accidentals-simple keysig pitch barnum lazyness octaveness)))
+ (check-pitch-against-signature context pitch barnum laziness octaveness))
(define (key-entry-notename entry)
"Return the pitch of an entry in localKeySignature. The entry is either of the form