(make-procedure-with-setter ly:music-property
ly:music-set-property!))
+(define-safe-public (music-is-of-type? mus type)
+ "Does @code{mus} belong to the music class @code{type}?"
+ (memq type (ly:music-property mus 'types)))
;; TODO move this
(define-public ly:grob-property
(set! (ly:music-property music 'duration) nd)))
music))
-
-
(define-public (shift-duration-log music shift dot)
(music-map (lambda (x) (shift-one-duration-log x shift dot))
music))
;; mmrest
(define-public (make-multi-measure-rest duration location)
- (make-music 'MultiMeasureRestMusicGroup
+ (make-music 'MultiMeasureRestMusic
'origin location
- 'elements (list (make-music 'BarCheck
- 'origin location)
- (make-event-chord (list (make-music 'MultiMeasureRestEvent
- 'origin location
- 'duration duration)))
- (make-music 'BarCheck
- 'origin location))))
-
-(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 MultiMeasureTextEvent"
- (let ((dir (ly:music-property script-music 'direction))
- (p (make-music 'MultiMeasureTextEvent
- 'text (ly:music-property script-music 'text))))
- (if (ly:dir? dir)
- (set! (ly:music-property p 'direction) dir))
- p))
-
- (if (eq? (ly:music-property music 'name) 'MultiMeasureRestMusicGroup)
- (let* ((text? (lambda (x) (memq 'script-event (ly:music-property x 'types))))
- (event? (lambda (x) (memq 'event (ly:music-property x 'types))))
- (group-elts (ly:music-property music 'elements))
- (texts '())
- (events '())
- (others '()))
-
- (set! texts
- (map script-to-mmrest-text (filter text? group-elts)))
- (set! group-elts
- (remove text? group-elts))
-
- (set! events (filter event? group-elts))
- (set! others (remove event? group-elts))
-
- (if (or (pair? texts) (pair? events))
- (set! (ly:music-property music 'elements)
- (cons (make-event-chord
- (append texts events))
- others)))
-
- ))
-
- music)
-
+ 'duration duration))
(define-public (make-property-set sym val)
(make-music 'PropertySet
'symbol sym
'value val))
+(define-public (make-property-unset sym)
+ (make-music 'PropertyUnset
+ 'symbol sym))
+
(define-public (make-ottava-set octavation)
(let ((m (make-music 'ApplyContext)))
(define (ottava-modify context)
(define-public (make-time-signature-set num den . rest)
"Set properties for time signature NUM/DEN. Rest can contain a list
of beat groupings "
+
+ (define (standard-beat-grouping num den)
+
+ "Some standard subdivisions for time signatures."
+ (let*
+ ((key (cons num den))
+ (entry (assoc key '(((6 . 8) . (3 3))
+ ((5 . 8) . (3 2))
+ ((9 . 8) . (3 3 3))
+ ((12 . 8) . (3 3 3 3))
+ ((8 . 8) . (3 3 2))
+ ))))
+
+ (if entry
+ (cdr entry)
+ '())))
+
(let* ((set1 (make-property-set 'timeSignatureFraction (cons num den)))
(beat (ly:make-moment 1 den))
(len (ly:make-moment num den))
(set3 (make-property-set 'measureLength len))
(set4 (make-property-set 'beatGrouping (if (pair? rest)
(car rest)
- '())))
+ (standard-beat-grouping num den))))
(basic (list set1 set2 set3 set4)))
(descend-to-context
(context-spec-music (make-sequential-music basic) 'Timing) 'Score)))
(define-public toplevel-music-functions
(list
(lambda (music parser) (voicify-music music))
- (lambda (x parser) (music-map glue-mm-rest-texts x))
(lambda (x parser) (music-map music-check-error x))
(lambda (x parser) (music-map precompute-music-length x))
(lambda (music parser)