X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=681c2c7b082bcc6719601d03f054e9f72aeaab50;hb=7d27bb3e9e8a0cce4e621a67421b28acfc3f186b;hp=86d2f2e0ddd5a509acc3e900ed40ac46e511225d;hpb=7eaeba29769613cb105e71ac40a71746d1601d90;p=lilypond.git diff --git a/scm/music-functions.scm b/scm/music-functions.scm index 86d2f2e0dd..681c2c7b08 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -74,6 +74,7 @@ First it recurses over the children, then the function is applied to MUSIC. (define-public (display-music music) "Display music, not done with music-map for clarity of presentation." + (display music) (display ": { ") (let ((es (ly:music-property music 'elements)) @@ -112,9 +113,11 @@ For instance, (else ;; scheme arg arg))) (define (inner-markup->make-markup mrkup) - (let ((cmd (proc->command-keyword (car mrkup))) - (args (map transform-arg (cdr mrkup)))) - `(,cmd ,@args))) + (if (string? mrkup) + `(#:simple ,mrkup) + (let ((cmd (proc->command-keyword (car mrkup))) + (args (map transform-arg (cdr mrkup)))) + `(,cmd ,@args)))) ;; body: (if (string? markup-expression) markup-expression @@ -183,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) @@ -207,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))) @@ -225,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))) @@ -407,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))) @@ -488,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." @@ -526,7 +552,7 @@ of beat groupings " "Split the parts of a chord into different Voices using separator" (let ((es (ly:music-property ch 'elements))) (set! (ly:music-property ch 'elements) - (voicify-list (split-list es music-separator?) 0)) + (voicify-list (split-list-by-separator es music-separator?) 0)) ch)) (define-public (voicify-music m) @@ -594,7 +620,7 @@ 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)) @@ -602,11 +628,6 @@ SkipEvent. Useful for extracting parts from crowded scores" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 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))) @@ -614,25 +635,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. @@ -742,7 +744,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)) @@ -798,12 +800,15 @@ if appropriate. (list (make-sequential-music (list - (context-spec-music (make-property-set 'skipTypesetting #t) 'Score) + (context-spec-music (make-property-set 'skipTypesetting #t) + 'Score) (make-music 'SkipMusic 'duration - (ly:make-duration 0 0 - (ly:moment-main-numerator skip-length) - (ly:moment-main-denominator skip-length))) - (context-spec-music (make-property-set 'skipTypesetting #f) 'Score))) + (ly:make-duration + 0 0 + (ly:moment-main-numerator skip-length) + (ly:moment-main-denominator skip-length))) + (context-spec-music (make-property-set 'skipTypesetting #f) + 'Score))) music))) music))) @@ -839,23 +844,6 @@ if appropriate. (music-map apply-duration lyric-music)) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; - -(define-public ((add-balloon-text object-name text off) grob orig-context cur-context) - "Usage: see input/regression/balloon.ly " - (let* ((meta (ly:grob-property grob 'meta)) - (cb (ly:grob-property-data grob 'stencil)) - (nm (if (pair? meta) (cdr (assoc 'name meta)) "nonexistant"))) - (if (and (equal? nm object-name) - (procedure? cb)) - (begin - (ly:grob-set-property! grob 'stencil ly:balloon-interface::print) - (set! (ly:grob-property grob 'original-stencil) cb) - (set! (ly:grob-property grob 'balloon-text) text) - (set! (ly:grob-property grob 'balloon-text-offset) off) - (set! (ly:grob-property grob 'balloon-text-props) '((font-family . roman))))))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; accidentals @@ -932,11 +920,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))