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)
))
+(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
)
))
-
(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 (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
))
(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
))
(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)
(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))))
;;; splitting chords into voices.
-
(define (voicify-list lst number)
"Make a list of Musics.
(make-simultaneous-music (car lst))))
'Voice (number->string number))
- (voicify-list (cdr lst) (+ number 1))
+ (voicify-list (cdr lst) (1+ number))
))
)
(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
(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)))
+
+ ))))
+
+