+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; tuplets.
-(define-public (denominator-tuplet-formatter mus)
- (number->string (ly:get-mus-property mus 'denominator)))
+(define-public (music-map function music)
+ "Apply @var{function} to @var{music} and all of the music it contains. "
+ (let* ((es (ly:get-mus-property music 'elements))
+ (e (ly:get-mus-property music 'element))
+ )
-(define-public (fraction-tuplet-formatter mus)
- (string-append (number->string (ly:get-mus-property mus 'numerator))
- ":"
- (number->string (ly:get-mus-property mus 'denominator))
- ))
+ (ly:set-mus-property! music 'elements
+ (map (lambda (y) (music-map function y)) es))
+ (if (ly:music? e)
+ (ly:set-mus-property! music 'element (music-map function e)))
+ (function music)
+ ))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define-public (display-music music)
+ "Display music, not done with music-map for clarity of presentation."
+ (display music)
+ (display ": { ")
+
+ (let* ((es (ly:get-mus-property music 'elements))
+ (e (ly:get-mus-property music 'element))
+ )
+ (display (ly:get-mutable-properties music))
-(define-public (shift-duration-log music shift dot)
- "Recurse through music, adding SHIFT to ly:duration-log and optionally
+ (if (pair? es)
+ (begin (display "\nElements: {\n")
+ (map display-music es)
+ (display "}\n")
+ ))
+
+
+ (if (ly:music? e)
+ (begin
+ (display "\nChild:")
+ (display-music e)
+ )
+ )
+ )
+ (display " }\n")
+ music
+ )
+
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (shift-one-duration-log music shift dot)
+ " add SHIFT to ly:duration-log and optionally
a dot to any note encountered. This scales the music up by a factor
2^shift * (2 - (1/2)^dot)"
- (let* ((es (ly:get-mus-property music 'elements))
- (e (ly:get-mus-property music 'element))
- (n (ly:music-name music))
- (f (lambda (x) (shift-duration-log x shift dot)))
- )
- ;; FIXME: broken by the great music rename.
- (if (or (equal? n "Note_req")
- (equal? n "Rest_req"))
+ (let*
+ (
+ (d (ly:get-mus-property music 'duration))
+ )
+ (if (ly:duration? d)
(let* (
- (d (ly:get-mus-property music 'duration))
(cp (ly:duration-factor d))
(nd (ly:make-duration (+ shift (ly:duration-log d))
- (+ dot (duration-dot-count d))
- (car cp)
- (cdr cp)))
+ (+ dot (ly:duration-dot-count d))
+ (car cp)
+ (cdr cp)))
)
(ly:set-mus-property! music 'duration nd)
))
-
- (if (pair? es)
- (ly:set-mus-property!
- music 'elements
- (map f es)))
-
- (if (ly:music? e)
- (ly:set-mus-property!
- music 'element
- (f e)))
-
music))
+
+(define-public (shift-duration-log music shift dot)
+ (music-map (lambda (x) (shift-one-duration-log x shift dot))
+ music))
+
+
+
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; repeats.
music))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (pitchify-scripts music)
- "Copy the pitch fields of the Note_requests into Text_script_requests, to aid
-Fingering_engraver."
- (define (find-note musics)
- (filter-list (lambda (m) (equal? (ly:music-name m) "Note_req")) musics)
- )
- (define (find-scripts musics)
- (filter-list (lambda (m) (equal? (ly:music-name m) "Text_script_req")) musics))
-
- (let* (
- (e (ly:get-mus-property music 'element))
- (es (ly:get-mus-property music 'elements))
- (notes (find-note es))
- (pitch (if (pair? notes) (ly:get-mus-property (car notes) 'pitch) #f))
- )
-
- (if pitch
- (map (lambda (x) (ly:set-mus-property! x 'pitch pitch)) (find-scripts es))
- )
-
- (if (pair? es)
- (ly:set-mus-property!
- music 'elements
- (map pitchify-scripts es)))
-
- (if (ly:music? e)
- (ly:set-mus-property!
- music 'element
- (pitchify-scripts e)))
-
- music))
-
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; property setting music objs.
+
(define-public (make-grob-property-set grob gprop val)
- "Make a M-exp that sets GPROP to VAL in GROBS. Does a pop first, i.e.
-this is not an override
-"
+
+ "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)
m
))
-
+
+
(define-public (make-voice-props-set n)
(make-sequential-music
(append
)
))
+
(define-public (make-voice-props-revert)
(make-sequential-music
(list
))
)
+
(define-public (context-spec-music m context . rest)
"Add \context CONTEXT = foo to M. "
cm
))
+(define-public (make-apply-context func)
+ (let*
+ (
+ (m (make-music-by-name 'ApplyContext))
+ )
+
+ (ly:set-mus-property! m 'procedure func)
+ m
+ ))
+
(define-public (make-sequential-music elts)
(let* ((m (make-music-by-name 'SequentialMusic)))
(ly:set-mus-property! m 'elements elts)
m
))
-
+;;;;;;;;;;;;;;;;
+;; mmrest
(define-public (make-multi-measure-rest duration location)
(let*
(
(skip ( make-music-by-name 'SkipEvent))
(ch (make-music-by-name 'BarCheck))
(ch2 (make-music-by-name 'BarCheck))
+ (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)
- (map (lambda (x) (ly:set-mus-property! x 'origin location))
- (list start stop skip ch ch2))
- (make-sequential-music
+ (ly:set-mus-property! seq 'elements
(list
ch
(make-event-chord (list start))
(make-event-chord (list stop))
ch2
))
+
+ seq
))
+(define-public (glue-mm-rest-texts music)
+ "Check if we have R1*4-\markup { .. }, and if applicable convert to
+a property set for MultiMeasureRestNumber."
+
+ (define (script-to-mmrest-text script-music)
+ "Extract 'direction and 'text from SCRIPT-MUSIC, and transform into property sets."
+
+ (let*
+ (
+ (text (ly:get-mus-property script-music 'text))
+ (dir (ly:get-mus-property script-music 'direction))
+ (p (make-music-by-name 'MultiMeasureTextEvent))
+ )
+
+ (if (ly:dir? dir)
+ (ly:set-mus-property! p 'direction dir))
+ (ly:set-mus-property! p 'text text)
+ p
+ ))
+
+ (if (eq? (ly:get-mus-property music 'name) 'MultiMeasureRestMusicGroup)
+ (let*
+ (
+ (text? (lambda (x) (memq 'script-event (ly:get-mus-property x 'types))))
+ (es (ly:get-mus-property music 'elements))
+ (texts (map script-to-mmrest-text (filter-list text? es)))
+ (others (filter-out-list text? es))
+ )
+ (if (pair? texts)
+ (ly:set-mus-property!
+ music 'elements
+ (cons (make-event-chord texts) others)
+ ))
+ ))
+ music
+ )
+
(define-public (make-property-set sym val)
(let*
m
))
+
+
+(define-public (make-ottava-set octavation)
+ (let*
+ (
+ (m (make-music-by-name 'ApplyContext))
+ )
+
+
+ (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."
+ (if (number? (ly:get-context-property context 'centralCPosition))
+
+ (if (= octavation 0)
+ (let*
+ ((where (ly:context-property-where-defined context 'centralCPosition))
+ (oc0 (ly:get-context-property context 'originalCentralCPosition)))
+
+ (ly:set-context-property context 'centralCPosition oc0)
+ (ly:unset-context-property where 'originalCentralCPosition)
+ (ly:unset-context-property where 'ottavation))
+
+ (let*
+ ((where (ly:context-property-where-defined context 'centralCPosition))
+ (c0 (ly:get-context-property context 'centralCPosition))
+ (new-c0 (+ c0 (* -7 octavation)))
+ (string (cdr
+ (assoc octavation '((2 . "15ma")
+ (1 . "8va")
+ (0 . #f)
+ (-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-mus-property! m 'procedure ottava-modify)
+ (context-spec-music m "Staff")
+ ))
+
+(define-public (set-octavation ottavation)
+ (ly:export (make-ottava-set ottavation)))
+
(define-public (make-time-signature-set num den . rest)
" Set properties for time signature NUM/DEN.
Rest can contain a list of beat groupings
(set4 (make-property-set 'beatGrouping (if (pair? rest)
(car rest)
'())))
- (basic (list set1 set2 set3 set4))
-
- )
+ (basic (list set1 set2 set3 set4)))
(context-spec-music
(make-sequential-music basic) "Timing")))
(define-public (set-time-signature num den . rest)
- (ly:export (apply make-time-signature-set `(,num ,den . ,rest)))
- )
+ (ly:export (apply make-time-signature-set `(,num ,den . ,rest))))
(define-public (make-penalty-music pen)
(let
(memq 'separator ts)
))
-(define (split-one sep? l acc)
- "Split off the first parts before separator and return both parts.
-
-"
- (if (null? l)
- (cons acc '())
- (if (sep? (car l))
- (cons acc (cdr l))
- (split-one sep? (cdr l) (cons (car l) acc))
- )
- ))
-
-(define-public (split-list l sep?)
- "
-
-(display (split-list '(a b c / d e f / g) (lambda (x) (equal? x '/))) )
-=>
- ...
-
-"
- (if (null? l)
- '()
- (let* ((c (split-one sep? l '())))
- (cons (reverse! (car c) '()) (split-list (cdr c) sep?))
- )
- )
- )
;;; splitting chords into voices.
))
(define (ly:music-message music msg)
- (let* (
+ (let*
+ (
(ip (ly:get-mus-property music 'origin))
)
music
)
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; switch it on here, so parsing and init isn't checked (too slow!)
(define-public toplevel-music-functions
(list check-start-chords
voicify-music
-
+ (lambda (x) (music-map glue-mm-rest-texts x))
; switch-on-debugging
))
projects / lilypond.git / blobdiff