X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=78efe3e7460a6ba0eb33e49be80c638db3e00a66;hb=b64a626ff01b560e36937575b5579b0408a7b58f;hp=011cdaf2abc27eeb3b784bd7c019185b4b66683b;hpb=1c122290caffd067b81c60a18c97e61d1c6b209e;p=lilypond.git diff --git a/scm/music-functions.scm b/scm/music-functions.scm index 011cdaf2ab..78efe3e746 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -48,6 +48,10 @@ (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. @@ -130,7 +134,7 @@ For instance, ((and (not (string? arg)) (markup? arg)) ;; a markup (inner-markup->make-markup arg)) (else ;; scheme arg - arg))) + (music->make-music arg)))) (define (inner-markup->make-markup mrkup) (if (string? mrkup) `(#:simple ,mrkup) @@ -266,7 +270,8 @@ through MUSIC." (set! (ly:music-property r 'repeat-count) (max times 1)) (set! (ly:music-property r 'elements) talts) (if (and (equal? name "tremolo") - (pair? (ly:music-property main 'elements))) + (or (pair? (ly:music-property main 'elements)) + (ly:music? (ly:music-property main 'element)))) ;; This works for single-note and multi-note tremolos! (let* ((children (if (music-is-of-type? main 'sequential-music) ;; \repeat tremolo n { ... } @@ -275,7 +280,7 @@ through MUSIC." 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 + ;; 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)))) @@ -320,7 +325,6 @@ through 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))) @@ -487,89 +491,24 @@ i.e. this is not an override" (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." - (make-beam-rule-time-signature-set num 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/den}. 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)))) - -(define-public (make-beam-rule-time-signature-set 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)." - - (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." - (let* ((set (if (integer? label) - (context-spec-music (make-property-set 'rehearsalMark label) - 'Score) - #f)) - (ev (make-music 'MarkEvent)) - (ch (make-event-chord (list ev)))) - (if set - (make-sequential-music (list set ch)) - (begin - (set! (ly:music-property ev 'label) label) - ch)))) + (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 @@ -950,7 +889,7 @@ Syntax: 'Score)))) (define (skip-as-needed music parser) - "Replace MUSIC by + "Replace MUSIC by << { \\set skipTypesetting = ##f LENGTHOF(\\showFirstLength) \\set skipTypesetting = ##t @@ -961,51 +900,56 @@ Syntax: 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