X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=1a1af41991760e401dbad3c76393cf8d2f05385a;hb=db202a305fb517db6e3104707ccd0ada356f0077;hp=61895f0c4c1e836cc565f41d611e4703e951e454;hpb=b80bd92a8e44e4e55aa6749dc1c7d5499b0a155f;p=lilypond.git diff --git a/scm/music-functions.scm b/scm/music-functions.scm index 61895f0c4c..1a1af41991 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -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) @@ -210,7 +225,7 @@ Returns `obj'. "create a repeat music expression, with all properties initialized properly" (let ((talts (if (< times (length alts)) (begin - (ly:warning (_ "More alternatives than repeats. Junking excess alternatives")) + (ly:warning (_ "More alternatives than repeats. Junking excess alternatives")) (take alts times)) alts)) (r (make-repeated-music name))) @@ -228,10 +243,15 @@ Returns `obj'. (if (memq 'sequential-music (ly:music-property main 'types)) ;; \repeat "tremolo" { c4 d4 } (let ((children (length (ly:music-property main 'elements)))) - (if (not (= children 2)) + + ;; fixme: should be more generic. + (if (and (not (= children 2)) + (not (= children 1))) (ly:warning (_ "expecting 2 elements for chord tremolo, found ~a") children)) (ly:music-compress r (ly:make-moment 1 children)) - (shift-duration-log r (1- shift) dots)) + (shift-duration-log r + (if (= children 2) (1- shift) shift) + dots)) ;; \repeat "tremolo" c4 (shift-duration-log r shift dots))) r))) @@ -410,23 +430,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 . "8va bassa") - (-2 . "15ma bassa")))))) - (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))) @@ -491,9 +514,9 @@ of beat groupings " 'duration duration 'text string)) -(define-safe-public (make-span-event type spandir) +(define-safe-public (make-span-event type span-dir) (make-music type - 'span-direction spandir)) + 'span-direction span-dir)) (define-public (set-mus-properties! m alist) "Set all of ALIST as properties of M." @@ -550,9 +573,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) @@ -597,19 +619,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))) @@ -617,25 +649,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. @@ -745,7 +758,7 @@ Syntax: (set! (ly:music-property music 'quoted-events) quoted-vector) (set! (ly:music-property music 'iterator-ctor) ly:quote-iterator::constructor)) - (ly:warning (_ "can't find quoted music `~S'" quoted-name)))) + (ly:warning (_ "cannot find quoted music: `~S'") quoted-name))) music)) @@ -921,11 +934,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))