-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (music-map function music)
(function music)
))
+(define-public (music-filter pred? music)
+ "Filter out music expressions that do not satisfy PRED."
+
+ (define (inner-music-filter pred? music)
+ "Recursive function."
+ (let* ((es (ly:get-mus-property music 'elements))
+ (e (ly:get-mus-property music 'element))
+ (as (ly:get-mus-property music 'articulations))
+ (filtered-as (filter ly:music? (map (lambda (y) (inner-music-filter pred? y)) as)))
+ (filtered-e (if (ly:music? e)
+ (inner-music-filter pred? e)
+ e))
+ (filtered-es (filter ly:music? (map (lambda (y) (inner-music-filter pred? y)) es)))
+ )
+
+ (ly:set-mus-property! music 'element filtered-e)
+ (ly:set-mus-property! music 'elements filtered-es)
+ (ly:set-mus-property! music 'articulations filtered-as)
+
+ ;; if filtering emptied the expression, we remove it completely.
+ (if (or (pred? music)
+ (and (eq? filtered-es '()) (not (ly:music? e))
+ (or (not (eq? es '()))
+ (ly:music? e))))
+ (set! music '()))
+
+ music))
+
+ (set! music (inner-music-filter pred? music))
+ (if (ly:music? music)
+ music
+ (make-music-by-name 'Music) ;must return music.
+ ))
+
+(define-public (remove-tag tag)
+ (lambda (mus)
+ (music-filter
+ (lambda (m)
+ (let* ((tags (ly:get-mus-property m 'tags))
+ (res (memq tag tags)))
+ res)) mus)))
+
(define-public (display-music music)
"Display music, not done with music-map for clarity of presentation."
(display music)
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))
+ 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 (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)
))
-(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-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)
(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)
((where (ly:context-property-where-defined context 'centralCPosition))
(oc0 (ly:get-context-property context 'originalCentralCPosition)))
- (ly:set-context-property context 'centralCPosition oc0)
+ (ly:set-context-property! context 'centralCPosition oc0)
(ly:unset-context-property where 'originalCentralCPosition)
(ly:unset-context-property where 'ottavation))
(-1 . "8va bassa")
(-2 . "15ma bassa"))))))
- (ly:set-context-property context 'centralCPosition new-c0)
- (ly:set-context-property context 'originalCentralCPosition c0)
- (ly:set-context-property context 'ottavation string)
+ (ly:set-context-property! context 'centralCPosition new-c0)
+ (ly:set-context-property! context 'originalCentralCPosition c0)
+ (ly:set-context-property! context 'ottavation string)
))))
(ly:set-mus-property! m 'procedure ottava-modify)
- (context-spec-music m "Staff")
+ (context-spec-music m 'Staff)
))
(define-public (set-octavation ottavation)
(basic (list set1 set2 set3 set4)))
(context-spec-music
- (make-sequential-music basic) "Timing")))
+ (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-voice-props-set number)
(make-simultaneous-music (car lst))))
- "Voice" (number->string number))
- (voicify-list (cdr lst) (+ number 1))
+ 'Voice (number->string number))
+ (voicify-list (cdr lst) (1+ number))
))
)
(define (voicify-chord ch)
"Split the parts of a chord into different Voices using separator"
(let* ((es (ly:get-mus-property ch 'elements)))
-
-
+
(ly:set-mus-property! ch 'elements
(voicify-list (split-list es music-separator?) 0))
ch
(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
;;(eq? #t (ly:get-grob-property elt symbol))
(not (eq? #f (memq symbol (ly:get-grob-property elt 'interfaces))))))
+(define-public ((outputproperty-compatibility func sym val) grob g-context ao-context)
+ (if (func grob)
+ (ly:set-grob-property! grob sym val)))
+
+
+(define-public ((set-output-property grob-name symbol val) grob grob-c context)
+ "Usage:
+
+\\applyoutput #(set-output-property 'Clef 'extra-offset '(0 . 1))
+
+"
+
+ (let*
+ ((meta (ly:get-grob-property grob 'meta)))
+
+ (if (equal? (cdr (assoc 'name meta)) grob-name)
+ (ly:set-grob-property! grob symbol val)
+ )))
+
;;
(define-public (smart-bar-check n)
)
(ly:set-context-property! where 'graceSettings new-settings)))
- (ly:export (context-spec-music (make-apply-context set-prop) "Voice")))
+ (ly:export (context-spec-music (make-apply-context set-prop) 'Voice)))
(define-public (set-start-grace-properties context)
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)))
+
+ ))))
+
+