X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=29194e3326b4745a73b41641282b59553a2c04e8;hb=3da2e3bab450a9282c5530438e2fc38ed8f66dc8;hp=41a725101a4f6a55d2fd455058d5dbcbee07de30;hpb=4ba016b96df4ec610212643c445bf96c019e3d70;p=lilypond.git diff --git a/scm/music-functions.scm b/scm/music-functions.scm index 41a725101a..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 DotColumn)) + direction-polyphonic-grobs) (list (make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2)) (make-grob-property-set 'MultiMeasureRest 'staff-position @@ -218,15 +233,13 @@ 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)) )) ) @@ -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 )) @@ -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 @@ -736,3 +764,25 @@ Rest can contain a list of beat groupings (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))) + + )))) + +