-(define-public (make-ottava-set octavation)
- (let ((m (make-music 'ApplyContext)))
- (define (ottava-modify context)
- "Either reset middleCPosition to the stored original, or remember
-old middleCPosition, add OCTAVATION to middleCPosition, and set
-OTTAVATION to `8va', or whatever appropriate."
- (if (number? (ly:context-property context 'middleCOffset))
- (let ((where (ly:context-property-where-defined context 'middleCOffset)))
- (ly:context-unset-property where 'middleCOffset)
- (ly:context-unset-property where 'ottavation)))
-
- (let* ((offset (* -7 octavation))
- (string (cdr (assoc octavation '((2 . "15ma")
- (1 . "8va")
- (0 . #f)
- (-1 . "8vb")
- (-2 . "15mb"))))))
- (ly:context-set-property! context 'middleCOffset offset)
- (ly:context-set-property! context 'ottavation string)
- (ly:set-middle-C! context)))
- (set! (ly:music-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 "
-
- (define (standard-beat-grouping num den)
-
- "Some standard subdivisions for time signatures."
- (let*
- ((key (cons num den))
- (entry (assoc key '(
- ; Simple time signatures
- (( 3 . 8) . (3))
- (( 4 . 8) . (2 2))
- ; Compound time signatures
- (( 6 . 4) . (3 3))
- (( 6 . 8) . (3 3))
- (( 6 . 16) . (3 3))
- (( 9 . 4) . (3 3 3))
- (( 9 . 8) . (3 3 3))
- (( 9 . 16) . (3 3 3))
- ((12 . 4) . (3 3 3 3))
- ((12 . 8) . (3 3 3 3))
- ((12 . 16) . (3 3 3 3))
- ; Some common irregular time signatures
- (( 5 . 8) . (3 2))
- (( 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))
- (set2 (make-property-set 'beatLength beat))
- (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 (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 'MarkEvent))
- (ch (make-event-chord (list ev))))
- (if set
- (make-sequential-music (list set ch))
- (begin
- (set! (ly:music-property ev 'label) label)
- ch))))