X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=5585eebdb734c9ff59690f5edde7491d8d2b3e26;hb=c790b5919ec06fb292e380a2d3d7856e86f16417;hp=76b8cf2edc710e8b9a7b803de6d0d28e5aa1fc5c;hpb=d8723823611d16a172dd47b0e39b3ef1621d3ddb;p=lilypond.git diff --git a/scm/music-functions.scm b/scm/music-functions.scm index 76b8cf2edc..5585eebdb7 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)) @@ -186,6 +186,21 @@ Returns `obj'. (newline) obj) +;;; +;;; Scheme music expression --> Lily-syntax-using string translator +;;; +(use-modules (srfi srfi-39) + (scm display-lily)) + +(define*-public (display-lily-music expr parser #:key force-duration) + "Display the music expression using LilyPond syntax" + (memoize-clef-names supported-clefs) + (parameterize ((*indent* 0) + (*previous-duration* (ly:make-duration 2)) + (*force-duration* force-duration)) + (display (music->lily-string expr parser)) + (newline))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-public (shift-one-duration-log music shift dot) @@ -218,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)))) @@ -336,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)))))) @@ -344,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) @@ -415,23 +440,26 @@ i.e. this is not an override" old middleCPosition, add OCTAVATION to middleCPosition, and set OTTAVATION to `8va', or whatever appropriate." (if (number? (ly:context-property context 'middleCPosition)) - (if (= octavation 0) - (let ((where (ly:context-property-where-defined context 'middleCPosition)) - (oc0 (ly:context-property context 'originalCentralCPosition))) - (ly:context-set-property! context 'middleCPosition oc0) - (ly:context-unset-property where 'originalCentralCPosition) - (ly:context-unset-property where 'ottavation)) - (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 'originalCentralCPosition c0) - (ly:context-set-property! context 'ottavation string))))) + (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))))) (set! (ly:music-property m 'procedure) ottava-modify) (context-spec-music m 'Staff))) @@ -555,9 +583,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) @@ -602,19 +629,29 @@ 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. -(define (has-request-chord elts) - (reduce (lambda (x y) (or x y)) #f - (map (lambda (x) - (equal? (ly:music-property x 'name) 'RequestChord)) - elts))) (define-public (ly:music-message music msg) (let ((ip (ly:music-property music 'origin))) @@ -622,25 +659,6 @@ SkipEvent. Useful for extracting parts from crowded scores" (ly:input-message ip msg) (ly:warning msg)))) -(define (check-start-chords music) - "Check music expression for a Simultaneous_music containing notes\n(ie. Request_chords), -without context specification. Called from parser." - (let ((es (ly:music-property music 'elements)) - (e (ly:music-property music 'element)) - (name (ly:music-property music 'name))) - (cond ((equal? name "Context_specced_music") #t) - ((equal? name "Simultaneous_music") - (if (has-request-chord es) - (ly:music-message music "Starting score with a chord.\nInsert an explicit \\context before chord") - (map check-start-chords es))) - ((equal? name "SequentialMusic") - (if (pair? es) - (check-start-chords (car es)))) - (else (if (ly:music? e) (check-start-chords e))))) - music) - - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; setting stuff for grace context. @@ -926,11 +944,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))