;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
-;;;; Copyright (C) 1998--2012 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 1998--2014 Jan Nieuwenhuizen <janneke@gnu.org>
;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
;;;;
;;;; LilyPond is free software: you can redistribute it and/or modify
(use-modules (scm safe-utility-defs))
(use-modules (ice-9 optargs))
+(use-modules (srfi srfi-11))
;;; ly:music-property with setter
;;; (ly:music-property my-music 'elements)
(max 0 (+ dot (ly:duration-dot-count d)))
cp)))
(set! (ly:music-property music 'duration) nd)))
+ ;clear cached length, since it's no longer valid
+ (set! (ly:music-property music 'length) '())
music))
(define-public (shift-duration-log music shift dot)
(music-map (lambda (x) (shift-one-duration-log x shift dot))
music))
-(define-public (make-repeat name times main alts)
- "Create a repeat music expression, with all properties initialized
-properly."
+(define-public (tremolo::get-music-list tremolo)
+ "Given a tremolo repeat, return a list of music to engrave for it.
+This will be a stretched copy of its body, plus a TremoloEvent or
+TremoloSpanEvent.
+
+This is called only by Chord_tremolo_iterator."
(define (first-note-duration music)
- "Finds the duration of the first NoteEvent by searching depth-first
-through MUSIC."
+ "Finds the duration of the first NoteEvent by searching
+depth-first through MUSIC."
;; 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))
(if (ly:duration? dur)
dur
(loop (cdr elts))))))))
-
- (let ((talts (if (< times (length alts))
- (begin
- (ly:warning (_ "More alternatives than repeats. Junking excess alternatives"))
- (take alts times))
- alts))
- (r (make-repeated-music name)))
- (set! (ly:music-property r 'element) main)
- (set! (ly:music-property r 'repeat-count) (max times 1))
- (set! (ly:music-property r 'elements) talts)
- (if (and (equal? name "tremolo")
- (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 (extract-named-music main '(EventChord
- NoteEvent)))
- ;; \repeat tremolo n c4
- 1))
- ;; # of dots is equal to the 1 in bitwise representation (minus 1)!
- (dots (1- (logcount (* times children))))
- ;; The remaining missing multiplicator to scale the notes by
+ (let* ((times (ly:music-property tremolo 'repeat-count))
+ (body (ly:music-property tremolo 'element))
+ (children (if (music-is-of-type? body 'sequential-music)
+ ;; \repeat tremolo n { ... }
+ (length (extract-named-music body '(EventChord
+ NoteEvent)))
+ ;; \repeat tremolo n c4
+ 1))
+ (tremolo-type (if (positive? children)
+ (let* ((note-duration (first-note-duration body))
+ (duration-log (if (ly:duration? note-duration)
+ (ly:duration-log note-duration)
+ 1)))
+ (ash 1 duration-log))
+ '()))
+ (stretched (ly:music-deep-copy body)))
+ (if (positive? children)
+ ;; # of dots is equal to the 1 in bitwise representation (minus 1)!
+ (let* ((dots (1- (logcount (* times children))))
+ ;; The remaining missing multiplier to scale the notes by
;; times * children
(mult (/ (* times children (ash 1 dots)) (1- (ash 2 dots))))
- (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)
+ (shift (- (ly:intlog2 (floor mult)))))
(if (not (and (integer? mult) (= (logcount mult) 1)))
(ly:music-warning
- main
+ body
(ly:format (_ "invalid tremolo repeat count: ~a") times)))
- ;; Adjust the time of the notes
- (ly:music-compress r (ly:make-moment 1 children))
+ ;; Make each note take the full duration
+ (ly:music-compress stretched (ly:make-moment 1 children))
;; Adjust the displayed note durations
- (shift-duration-log r shift dots))
- r)))
+ (shift-duration-log stretched shift dots)))
+ ;; Return the stretched body plus a tremolo event
+ (if (= children 1)
+ (list (make-music 'TremoloEvent
+ 'repeat-count times
+ 'tremolo-type tremolo-type
+ 'origin (ly:music-property tremolo 'origin))
+ stretched)
+ (list (make-music 'TremoloSpanEvent
+ 'span-direction START
+ 'repeat-count times
+ 'tremolo-type tremolo-type
+ 'origin (ly:music-property tremolo 'origin))
+ stretched
+ (make-music 'TremoloSpanEvent
+ 'span-direction STOP
+ 'origin (ly:music-property tremolo 'origin))))))
+
+(define-public (make-repeat name times main alts)
+ "Create a repeat music expression, with all properties initialized
+properly."
+ (let ((type (or (assoc-get name '(("volta" . VoltaRepeatedMusic)
+ ("unfold" . UnfoldedRepeatedMusic)
+ ("percent" . PercentRepeatedMusic)
+ ("tremolo" . TremoloRepeatedMusic)))
+ (begin (ly:warning (_ "unknown repeat type `~S': must be volta, unfold, percent, or tremolo") name)
+ 'VoltaRepeatedMusic)))
+ (talts (if (< times (length alts))
+ (begin
+ (ly:warning (_ "More alternatives than repeats. Junking excess alternatives"))
+ (take alts times))
+ alts)))
+ (make-music type
+ 'element main
+ 'repeat-count (max times 1)
+ 'elements talts)))
(define (calc-repeat-slash-count music)
"Given the child-list @var{music} in @code{PercentRepeatMusic},
(define-public (unfold-repeats music)
"Replace all repeats with unfolded repeats."
-
(let ((es (ly:music-property music 'elements))
(e (ly:music-property music 'element)))
-
(if (music-is-of-type? music 'repeated-music)
- (let* ((props (ly:music-mutable-properties music))
- (old-name (ly:music-property music 'name))
- (flattened (flatten-alist props)))
- (set! music (apply make-music (cons 'UnfoldedRepeatedMusic
- flattened)))
-
- (if (and (equal? old-name 'TremoloRepeatedMusic)
- (pair? (extract-named-music e '(EventChord NoteEvent))))
- ;; This works for single-note and multi-note tremolos!
- (let* ((children (if (music-is-of-type? e 'sequential-music)
- ;; \repeat tremolo n { ... }
- (length (extract-named-music e '(EventChord
- NoteEvent)))
- ;; \repeat tremolo n c4
- 1))
- (times (ly:music-property music 'repeat-count))
-
- ;; # of dots is equal to the 1 in bitwise representation (minus 1)!
- (dots (1- (logcount (* times children))))
- ;; The remaining missing multiplicator to scale the notes by
- ;; times * children
- (mult (/ (* times children (ash 1 dots)) (1- (ash 2 dots))))
- (shift (- (ly:intlog2 (floor mult)))))
-
- ;; Adjust the time of the notes
- (ly:music-compress music (ly:make-moment children 1))
- ;; Adjust the displayed note durations
- (shift-duration-log music (- shift) (- dots))))))
-
+ (set! music (make-music 'UnfoldedRepeatedMusic music)))
(if (pair? es)
(set! (ly:music-property music 'elements)
(map unfold-repeats es)))
(and (music-is-of-type? m 'unfolded-repeated-music)
(make-sequential-music
(ly:music-deep-copy
- (let loop ((n (ly:music-property m 'repeat-count))
- (alts (ly:music-property m 'elements))
- (body (ly:music-property m 'element)))
+ (let ((n (ly:music-property m 'repeat-count))
+ (alts (ly:music-property m 'elements))
+ (body (ly:music-property m 'element)))
(cond ((<= n 0) '())
- ((null? alts)
- (cons body (loop (1- n) alts body)))
+ ((null? alts) (make-list n body))
(else
- (cons* body (car alts)
- (loop (1- n)
- (if (pair? (cdr alts))
- (cdr alts)
- alts)
- body)))))))))
+ (concatenate
+ (zip (make-list n body)
+ (append! (make-list (max 0 (- n (length alts)))
+ (car alts))
+ alts))))))))))
(unfold-repeats music)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(make-music 'PropertyUnset
'symbol sym))
-(define-safe-public (make-articulation name)
- (make-music 'ArticulationEvent
- 'articulation-type name))
+(define-safe-public (make-articulation name . properties)
+ (apply make-music 'ArticulationEvent
+ 'articulation-type name
+ properties))
(define-public (make-lyric-event string duration)
(make-music 'LyricEvent
(else music))))
-(define-public toplevel-music-functions
+(define-session-public toplevel-music-functions
(list
(lambda (music parser) (expand-repeat-chords!
(cons 'rhythmic-event
(cons #f (not (or (equal? acc key-acc)
(and (equal? entrybn barnum) (equal? entrymp measurepos)))))))))
+(define-public (dodecaphonic-no-repeat-rule context pitch barnum measurepos)
+ "An accidental rule that typesets an accidental before every note
+(just as in the dodecaphonic accidental style) @emph{except} if the note
+is immediately preceded by a note with the same pitch. This is a common
+accidental style in contemporary notation."
+ (let* ((keysig (ly:context-property context 'localKeySignature))
+ (entry (find-pitch-entry keysig pitch #t #t)))
+ (if (not entry)
+ (cons #f #t)
+ (let* ((entrymp (key-entry-measure-position entry))
+ (entrybn (key-entry-bar-number entry)))
+ (cons #f
+ (not
+ (and (equal? entrybn barnum) (equal? entrymp measurepos))))))))
+
(define-public (teaching-accidental-rule context pitch barnum measurepos)
"An accidental rule that typesets a cautionary accidental if it is
included in the key signature @emph{and} does not directly follow a note
`(Staff ,(lambda (c p bn mp) '(#f . #t)))
'()
context))
+ ;; As in dodecaphonic style with the exception that immediately
+ ;; repeated notes (in the same voice) don't get an accidental
+ ((equal? style 'dodecaphonic-no-repeat)
+ (set-accidentals-properties #f
+ `(Staff ,(make-accidental-rule 'same-octave 0)
+ ,dodecaphonic-no-repeat-rule)
+ '()
+ 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 canceled across voices.
(map (lambda (x) (ly:music-property x 'pitch))
(event-chord-notes event-chord)))
+(define-public (event-chord-reduce music)
+ "Reduces event chords in @var{music} to their first note event,
+retaining only the chord articulations. Returns the modified music."
+ (map-some-music
+ (lambda (m)
+ (and (music-is-of-type? m 'event-chord)
+ (let*-values (((notes arts) (partition
+ (lambda (mus)
+ (music-is-of-type? mus 'rhythmic-event))
+ (ly:music-property m 'elements)))
+ ((dur) (ly:music-property m 'duration))
+ ((full-arts) (append arts
+ (ly:music-property m 'articulations)))
+ ((first-note) (and (pair? notes) (car notes))))
+ (cond (first-note
+ (set! (ly:music-property first-note 'articulations)
+ full-arts)
+ first-note)
+ ((ly:duration? dur)
+ ;; A repeat chord. Produce an unpitched note.
+ (make-music 'NoteEvent
+ 'duration dur
+ 'articulations full-arts))
+ (else
+ (ly:music-error m (_ "Missing duration"))
+ (make-music 'NoteEvent
+ 'duration (ly:make-duration 2 0 0)
+ 'articulations full-arts))))))
+ music))
+
+
(defmacro-public make-relative (variables reference music)
"The list of pitch or music variables in @var{variables} is used as
a sequence for creating relativable music from @var{music}.