X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=29194e3326b4745a73b41641282b59553a2c04e8;hb=fe1eb832e9e1e92e2bf98c33011465658192f033;hp=5af90d22606c00012469bd194f4551a81b077257;hpb=673d79f588003877a86a8c31a27ab8c6d8787398;p=lilypond.git diff --git a/scm/music-functions.scm b/scm/music-functions.scm index 5af90d2260..29194e3326 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -189,6 +189,19 @@ i.e. this is not an override" m )) +(define-public (make-grob-property-override grob gprop val) + + "Make a Music expression that sets GPROP to VAL in GROB. Does a pop first, +i.e. this is not an override" + + (let* ((m (make-music-by-name 'OverrideProperty))) + (ly:set-mus-property! m 'symbol grob) + (ly:set-mus-property! m 'grob-property gprop) + (ly:set-mus-property! m 'grob-value val) + + m + + )) (define-public (make-grob-property-revert grob gprop) @@ -201,13 +214,15 @@ i.e. this is not an override" )) +(define direction-polyphonic-grobs + '(Tie Rest Slur Script TextScript Stem Dots DotColumn)) (define-public (make-voice-props-set n) (make-sequential-music (append (map (lambda (x) (make-grob-property-set x 'direction (if (odd? n) -1 1))) - '(Tie Slur Script TextScript Stem Dots)) + direction-polyphonic-grobs) (list (make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2)) (make-grob-property-set 'MultiMeasureRest 'staff-position @@ -218,21 +233,19 @@ i.e. this is not an override" ) )) - (define-public (make-voice-props-revert) (make-sequential-music - (list - (make-grob-property-revert 'Tie 'direction) - (make-grob-property-revert 'Dots 'direction) - (make-grob-property-revert 'Stem 'direction) - (make-grob-property-revert 'Slur 'direction) - (make-grob-property-revert 'NoteColumn 'horizontal-shift) + (append + (map (lambda (x) (make-grob-property-revert x 'direction)) + direction-polyphonic-grobs) + + (list (make-grob-property-revert 'NoteColumn 'horizontal-shift)) )) ) (define-public (context-spec-music m context . rest) - "Add \context CONTEXT = foo to M. " + "Add \\context CONTEXT = foo to M. " (let* ((cm (make-music-by-name 'ContextSpeccedMusic))) (ly:set-mus-property! cm 'element m) @@ -270,8 +283,8 @@ i.e. this is not an override" )) -(define-public (make-nonevent-skip dur) - (let* ((m (make-music-by-name 'NonEventSkip))) +(define-public (make-skip-music dur) + (let* ((m (make-music-by-name 'SkipMusic))) (ly:set-mus-property! m 'duration dur) m )) @@ -283,24 +296,18 @@ i.e. this is not an override" (let* ( (start (make-music-by-name 'MultiMeasureRestEvent)) - (stop (make-music-by-name 'MultiMeasureRestEvent)) - (skip ( make-music-by-name 'SkipEvent)) (ch (make-music-by-name 'BarCheck)) (ch2 (make-music-by-name 'BarCheck)) - (seq (make-music-by-name 'MultiMeasureRestMusicGroup)) + (seq (make-music-by-name 'MultiMeasureRestMusicGroup)) ) (map (lambda (x) (ly:set-mus-property! x 'origin location)) - (list start stop skip ch ch2 seq)) - (ly:set-mus-property! start 'span-direction START) - (ly:set-mus-property! stop 'span-direction STOP) - (ly:set-mus-property! skip 'duration duration) + (list start ch ch2 seq)) + (ly:set-mus-property! start 'duration duration) (ly:set-mus-property! seq 'elements (list ch (make-event-chord (list start)) - (make-event-chord (list skip)) - (make-event-chord (list stop)) ch2 )) @@ -308,7 +315,7 @@ i.e. this is not an override" )) (define-public (glue-mm-rest-texts music) - "Check if we have R1*4-\markup { .. }, and if applicable convert to + "Check if we have R1*4-\\markup { .. }, and if applicable convert to a property set for MultiMeasureRestNumber." (define (script-to-mmrest-text script-music) @@ -363,9 +370,10 @@ a property set for MultiMeasureRestNumber." (define (ottava-modify context) - "Either reset centralCPosition to the stored original, -or remember old centralCPosition, add OCTAVATION to centralCPosition, -and set OTTAVATION to `8va', or whatever appropriate." + "Either reset centralCPosition to the stored original, or remember +old centralCPosition, add OCTAVATION to centralCPosition, and set +OTTAVATION to `8va', or whatever appropriate." + (if (number? (ly:get-context-property context 'centralCPosition)) (if (= octavation 0) @@ -422,6 +430,27 @@ Rest can contain a list of beat groupings (context-spec-music (make-sequential-music basic) 'Timing))) +(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-by-name 'MarkEvent)) + (ch (make-event-chord (list ev))) + ) + + + (if set + (make-sequential-music (list set ch)) + (begin + (ly:set-mus-property! ev 'label label) + ch)))) + + + (define-public (set-time-signature num den . rest) (ly:export (apply make-time-signature-set `(,num ,den . ,rest)))) @@ -472,7 +501,6 @@ Rest can contain a list of beat groupings ;;; splitting chords into voices. - (define (voicify-list lst number) "Make a list of Musics. @@ -488,7 +516,7 @@ Rest can contain a list of beat groupings (make-simultaneous-music (car lst)))) 'Voice (number->string number)) - (voicify-list (cdr lst) (+ number 1)) + (voicify-list (cdr lst) (1+ number)) )) ) @@ -519,7 +547,7 @@ Rest can contain a list of beat groupings (if (and (equal? (ly:music-name m) "Simultaneous_music") (reduce (lambda (x y ) (or x y)) #f (map music-separator? es))) - (voicify-chord m) + (set! m (context-spec-music (voicify-chord m) 'Staff)) ) m @@ -711,10 +739,50 @@ Rest can contain a list of beat groupings m) (define-public toplevel-music-functions - (list check-start-chords + (list +;; check-start-chords ; ; no longer needed with chord syntax. voicify-music (lambda (x) (music-map glue-mm-rest-texts x)) ; switch-on-debugging )) + + +;;;;;;;;;;;;;;;;; +;; lyrics + +(define (apply-durations lyric-music durations) + (define (apply-duration music) + (if (and (not (equal? (ly:music-length music) ZERO-MOMENT)) + (ly:duration? (ly:get-mus-property music 'duration))) + (begin + (ly:set-mus-property! music 'duration (car durations)) + (set! durations (cdr durations)) + ))) + + (music-map apply-duration lyric-music)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; + + +(define-public ((add-balloon-text object-name text off) grob orig-context cur-context) + "Usage: see input/regression/balloon.ly " + (let* + ((meta (ly:get-grob-property grob 'meta)) + (nm (if (pair? meta) (cdr (assoc 'name meta)) "nonexistant")) + (cb (ly:get-grob-property grob 'print-function))) + + (if (equal? nm object-name) + (begin + (ly:set-grob-property! grob 'print-function Balloon_interface::print) + (ly:set-grob-property! grob 'balloon-original-callback cb) + (ly:set-grob-property! grob 'balloon-text text) + (ly:set-grob-property! grob 'balloon-text-offset off) + (ly:set-grob-property! grob 'balloon-text-props '((font-family . roman))) + + )))) + +