X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=1e7c524241141b0c4ab6e8dff817a59b077b0544;hb=ece2e45d587f63565e81af44e1937ebe1f5e47a8;hp=049f27ea3ae63cf69e77267c9c4227a9a7b8652f;hpb=3ee551fa4f2a2c3736a06f9f85f29b9f7bd89818;p=lilypond.git diff --git a/scm/music-functions.scm b/scm/music-functions.scm index 049f27ea3a..1e7c524241 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -2,7 +2,7 @@ ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 1998--2006 Jan Nieuwenhuizen +;;;; (c) 1998--2007 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys ;; (use-modules (ice-9 optargs)) @@ -233,13 +233,11 @@ Returns `obj'. (set! (ly:music-property r 'repeat-count) (max times 1)) (set! (ly:music-property r 'elements) talts) (if (equal? name "tremolo") - (let* ((dot? (zero? (modulo times 3))) - (dots (if dot? 1 0)) - (mult (if dot? - (quotient (* times 2) 3) - times)) - (shift (- (ly:intlog2 mult)))) - + (let* ((dots (1- (logcount times))) + (mult (/ (* times (ash 1 dots)) (1- (ash 2 dots)))) + (shift (- (ly:intlog2 (floor mult))))) + (if (not (integer? mult)) + (ly:warning (_ "invalid tremolo repeat count: ~a") times)) (if (memq 'sequential-music (ly:music-property main 'types)) ;; \repeat "tremolo" { c4 d4 } (let ((children (length (ly:music-property main 'elements)))) @@ -351,6 +349,17 @@ i.e. this is not an override" (if (odd? n) -1 1))) direction-polyphonic-grobs) (list + (make-property-set 'graceSettings + ;; TODO: take this from voicedGraceSettings or similar. + '((Voice Stem font-size -3) + (Voice NoteHead font-size -3) + (Voice Dots font-size -3) + (Voice Stem length-fraction 0.8) + (Voice Stem no-stem-extend #t) + (Voice Beam thickness 0.384) + (Voice Beam length-fraction 0.8) + (Voice Accidental font-size -4))) + (make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2)) (make-grob-property-set 'MultiMeasureRest 'staff-position (if (odd? n) -4 4)))))) @@ -359,8 +368,9 @@ i.e. this is not an override" (append (map (lambda (x) (make-grob-property-revert x 'direction)) direction-polyphonic-grobs) - (list (make-grob-property-revert 'NoteColumn 'horizontal-shift)) - (list (make-grob-property-revert 'MultiMeasureRest 'staff-position))))) + (list (make-property-unset 'graceSettings) + (make-grob-property-revert 'NoteColumn 'horizontal-shift) + (make-grob-property-revert 'MultiMeasureRest 'staff-position))))) (define-safe-public (context-spec-music m context #:optional id) @@ -429,27 +439,20 @@ i.e. this is not an override" "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 'middleCPosition)) - (begin - (if (number? (ly:context-property context 'originalMiddleCPosition)) - (let ((where (ly:context-property-where-defined context 'middleCPosition))) - - (ly:context-set-property! context 'middleCPosition - (ly:context-property context 'originalMiddleCPosition)) - (ly:context-unset-property where 'originalMiddleCPosition) - (ly:context-unset-property where 'ottavation))) -ot - (let* ((where (ly:context-property-where-defined context 'middleCPosition)) - (c0 (ly:context-property context 'middleCPosition)) - (new-c0 (+ c0 (* -7 octavation))) - (string (cdr (assoc octavation '((2 . "15ma") - (1 . "8va") - (0 . #f) - (-1 . "8vb") - (-2 . "15mb")))))) - (ly:context-set-property! context 'middleCPosition new-c0) - (ly:context-set-property! context 'originalMiddleCPosition c0) - (ly:context-set-property! context 'ottavation string))))) + (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))) @@ -573,9 +576,8 @@ of beat groupings " (define-public (empty-music) (ly:export (make-music 'Music))) -;;; - ; Make a function that checks score element for being of a specific type. +;; Make a function that checks score element for being of a specific type. (define-public (make-type-checker symbol) (lambda (elt) ;;(display symbol) @@ -620,11 +622,26 @@ of beat groupings " "Replace MUS by RestEvent of the same duration if it is a SkipEvent. Useful for extracting parts from crowded scores" - (if (equal? (ly:music-property mus 'name) 'SkipEvent) + (if (memq (ly:music-property mus 'name) '(SkipEvent SkipMusic)) (make-music 'RestEvent 'duration (ly:music-property mus 'duration)) mus)) +(define-public (music-has-type music type) + (memq type (ly:music-property music 'types))) + +(define-public (music-clone music) + (define (alist->args alist acc) + (if (null? alist) + acc + (alist->args (cdr alist) + (cons (caar alist) (cons (cdar alist) acc))))) + + (apply + make-music + (ly:music-property music 'name) + (alist->args (ly:music-mutable-properties music) '()))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; warn for bare chords at start. @@ -920,11 +937,14 @@ use GrandStaff as a context. " '(Staff (any-octave . 0) (same-octave . 1) GrandStaff (any-octave . 0) (same-octave . 1)) pcontext)) + ;; do not set localKeySignature when a note alterated differently from ;; localKeySignature is found. ;; Causes accidentals to be printed at every note instead of ;; remembered for the duration of a measure. - ;; accidentals not being remembered, causing accidentals always to be typeset relative to the time signature + ;; accidentals not being remembered, causing accidentals always to + ;; be typeset relative to the time signature + ((equal? style 'forget) (set-accidentals-properties '() '(Staff (same-octave . -1))