(make-procedure-with-setter ly:prob-property
ly:prob-set-property!))
+(define-public ly:context-property
+ (make-procedure-with-setter ly:context-property
+ ly:context-set-property!))
+
(define-public (music-map function music)
"Apply @var{function} to @var{music} and all of the music it contains.
(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 (equal? name "tremolo")
- (let* ((dots (1- (logcount times)))
- (mult (/ (* times (ash 1 dots)) (1- (ash 2 dots))))
+ (if (and (equal? name "tremolo")
+ (pair? (ly:music-property main 'elements)))
+ ;; 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))
+ ;; \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
+ ;; 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)
(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))
- ;; \repeat "tremolo" { c4 d4 }
- (let ((children (length (ly:music-property main 'elements))))
-
- ;; fixme: should be more generic.
- (if (and (not (= children 2))
- (not (= children 1)))
- (ly:warning (_ "expecting 2 elements for chord tremolo, found ~a") children))
- (ly:music-compress r (ly:make-moment 1 children))
- (shift-duration-log r
- (if (= children 2) (1- shift) shift)
- dots))
- ;; \repeat "tremolo" c4
- (shift-duration-log r shift dots)))
+ ;; Adjust the time of the notes
+ (ly:music-compress r (ly:make-moment 1 children))
+ ;; Adjust the displayed note durations
+ (shift-duration-log r shift dots))
r)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; repeats.
(define-public (unfold-repeats music)
- "
-This function replaces all repeats with unfold repeats. "
+ "This function replaces all repeats with unfolded repeats."
(let ((es (ly:music-property music 'elements))
- (e (ly:music-property music 'element))
- )
+ (e (ly:music-property music 'element)))
+
(if (memq 'repeated-music (ly:music-property music 'types))
- (let*
- ((props (ly:music-mutable-properties music))
- (old-name (ly:music-property music 'name))
- (flattened (flatten-alist props)))
+ (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 (equal? old-name 'TremoloRepeatedMusic)
(let* ((seq-arg? (memq 'sequential-music
(ly:music-property e 'types)))
- (count (ly:music-property music 'repeat-count))
+ (count (ly:music-property music 'repeat-count))
(dot-shift (if (= 0 (remainder count 3))
- -1 0)))
+ -1 0))
+ (child-count (if seq-arg?
+ (length (ly:music-property e 'elements))
+ 0)))
(if (= 0 -1)
(set! count (* 2 (quotient count 3))))
- (shift-duration-log music (+ (if seq-arg? 1 0)
+ (shift-duration-log music (+ (if (= 2 child-count)
+ 1 0)
(ly:intlog2 count)) dot-shift)
(if seq-arg?
- (ly:music-compress e (ly:make-moment (length (ly:music-property
- e 'elements)) 1)))))))
-
+ (ly:music-compress e (ly:make-moment child-count 1)))))))
(if (pair? es)
(set! (ly:music-property music 'elements)
(make-music 'PropertyUnset
'symbol sym))
-(define-public (make-ottava-set octavation)
- (let ((m (make-music 'ApplyContext)))
- (define (ottava-modify context)
- "Either reset middleCPosition to the stored original, or remember
-old middleCPosition, add OCTAVATION to middleCPosition, and set
-OTTAVATION to `8va', or whatever appropriate."
- (if (number? (ly:context-property context 'middleCOffset))
- (let ((where (ly:context-property-where-defined context 'middleCOffset)))
- (ly:context-unset-property where 'middleCOffset)
- (ly:context-unset-property where 'ottavation)))
-
- (let* ((offset (* -7 octavation))
- (string (assoc-get octavation '((2 . "15ma")
- (1 . "8va")
- (0 . #f)
- (-1 . "8vb")
- (-2 . "15mb")))))
- (ly:context-set-property! context 'middleCOffset offset)
- (ly:context-set-property! context 'ottavation string)
- (ly:set-middle-C! context)))
- (set! (ly:music-property m 'procedure) ottava-modify)
- (context-spec-music m 'Staff)))
-
-(define-public (set-octavation ottavation)
- (ly:export (make-ottava-set ottavation)))
-
;;; Need to keep this definition for \time calls from parser
(define-public (make-time-signature-set num den)
"Set properties for time signature NUM/DEN."
;;; Used for calls that include beat-grouping setting
(define-public (set-time-signature num den . rest)
"Set properties for time signature @var{num/den}.
-If @var{rest} is present, it is used to make a default
-@code{beamSetting} rule."
+If @var{rest} is present, it is used to set
+@code{beatStructure}."
(ly:export (apply make-beam-rule-time-signature-set
(list num den rest))))
"Implement settings for new time signature. Can be
called from either make-time-signature-set (used by \time
in parser) or set-time-signature (called from scheme code
-included in .ly file."
-
- (define (make-default-beaming-rule context)
- (override-property-setting
- context
- 'beamSettings
- (list (cons num den) 'end)
- (list (cons '* (car rest)))))
-
- (let* ((set1 (make-property-set 'timeSignatureFraction (cons num den)))
- (beat (ly:make-moment 1 den))
- (len (ly:make-moment num den))
- (set2 (make-property-set 'beatLength beat))
- (set3 (make-property-set 'measureLength len))
- (beaming-rule
- (if (null? rest)
- '()
- (list (make-apply-context make-default-beaming-rule))))
- (output (cons* set1 set2 set3 beaming-rule)))
- (descend-to-context
- (context-spec-music
- (make-sequential-music output)
- 'Timing)
- 'Score)))
+included in .ly file)."
+
+ (let ((m (make-music 'ApplyContext)))
+ (define (make-time-settings context)
+ (let* ((fraction (cons num den))
+ (time-signature-settings (ly:context-property context 'timeSignatureSettings))
+ (my-base-fraction (base-fraction fraction time-signature-settings))
+ (my-beat-structure (if (null? rest)
+ (beat-structure my-base-fraction
+ fraction
+ time-signature-settings)
+ (car rest)))
+ (beaming-exception
+ (beam-exceptions fraction time-signature-settings))
+ (new-measure-length (ly:make-moment num den)))
+ (ly:context-set-property! context 'timeSignatureFraction fraction)
+ (ly:context-set-property!
+ context 'baseMoment (fraction->moment my-base-fraction))
+ (ly:context-set-property! context 'beatStructure my-beat-structure)
+ (ly:context-set-property! context 'beamExceptions beaming-exception)
+ (ly:context-set-property! context 'measureLength new-measure-length)))
+ (set! (ly:music-property m 'procedure) make-time-settings)
+ (descend-to-context
+ (context-spec-music m 'Timing)
+ 'Score)))
+
(define-public (make-mark-set label)
"Make the music for the \\mark command."
;; Make a function that checks score element for being of a specific type.
(define-public (make-type-checker symbol)
(lambda (elt)
- (not (eq? #f (memq symbol (ly:grob-property elt 'interfaces))))))
+ (grob::has-interface elt symbol)))
(define-public ((outputproperty-compatibility func sym val) grob g-context ao-context)
(if (func grob)
projects / lilypond.git / blobdiff