X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=e63f9579a26e522ab711538d40da66fe69ce5acc;hb=c7f6756446b3c2f68afdd503ae689fce3fd3b168;hp=2aa410772de0b8776a8b1da86129b380af197804;hpb=dccf66d6efc98f1c6e531fcdc3ee9b6016f9f504;p=lilypond.git diff --git a/scm/music-functions.scm b/scm/music-functions.scm index 2aa410772d..e63f9579a2 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -1,11 +1,11 @@ -;;;; music-functions.scm -- implement Scheme output routines for PostScript +;;;; music-functions.scm -- ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; ;;;; (c) 1998--2004 Jan Nieuwenhuizen -;;;; Han-Wen Nienhuys +;;;; Han-Wen Nienhuys -(use-modules (ice-9 optargs)) +;; (use-modules (ice-9 optargs)) ;;; ly:music-property with setter ;;; (ly:music-property my-music 'elements) @@ -130,22 +130,30 @@ (define-public (unfold-repeats music) " -This function replaces all repeats with unfold repeats. It was -written by Rune Zedeler. " +This function replaces all repeats with unfold repeats. " (let ((es (ly:music-property music 'elements)) (e (ly:music-property music 'element)) (n (ly:music-name music))) (if (equal? n "Repeated_music") - (let* - ((seq-arg? (memq 'sequential-music - (ly:music-property e 'types)))) + (begin (if (equal? (ly:music-property music 'iterator-ctor) Chord_tremolo_iterator::constructor) - (begin + (let* + ((seq-arg? (memq 'sequential-music + (ly:music-property e 'types))) + (count (ly:music-property music 'repeat-count)) + (dot-shift (if (= 0 (remainder count 3)) + -1 0)) + ) + + (if (= 0 -1) + (set! count (* 2 (quotient count 3)))) + (shift-duration-log music (+ (if seq-arg? 1 0) - (ly:intlog2 (ly:music-property music 'repeat-count))) 0) + (ly:intlog2 count)) dot-shift) + (if seq-arg? (ly:music-compress e (ly:make-moment (length (ly:music-property e 'elements)) 1))) )) @@ -258,6 +266,7 @@ i.e. this is not an override" (define-public (make-skip-music dur) (make-music 'SkipMusic 'duration dur)) + (define-public (make-grace-music music) (make-music 'GraceMusic 'element music)) @@ -280,7 +289,7 @@ i.e. this is not an override" "Check if we have R1*4-\\markup { .. }, and if applicable convert to a property set for MultiMeasureRestNumber." (define (script-to-mmrest-text script-music) - "Extract 'direction and 'text from SCRIPT-MUSIC, and transform into property sets." + "Extract 'direction and 'text from SCRIPT-MUSIC, and transform into property sets." (let ((dir (ly:music-property script-music 'direction)) (p (make-music 'MultiMeasureTextEvent 'text (ly:music-property script-music 'text)))) @@ -334,8 +343,8 @@ OTTAVATION to `8va', or whatever appropriate." (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 " + "Set properties for time signature NUM/DEN. Rest can contain a list +of beat groupings " (let* ((set1 (make-property-set 'timeSignatureFraction (cons num den))) (beat (ly:make-moment 1 den)) (len (ly:make-moment num den)) @@ -349,7 +358,7 @@ Rest can contain a list of beat groupings " (context-spec-music (make-sequential-music basic) 'Timing) 'Score))) (define-public (make-mark-set label) - "make the music for the \\mark command." + "Make the music for the \\mark command." (let* ((set (if (integer? label) (context-spec-music (make-property-set 'rehearsalMark label) 'Score) @@ -365,9 +374,10 @@ Rest can contain a list of beat groupings " (define-public (set-time-signature num den . rest) (ly:export (apply make-time-signature-set `(,num ,den . ,rest)))) -(define-public (make-penalty-music pen) +(define-public (make-penalty-music pen page-pen) (make-music 'BreakEvent - 'penalty pen)) + 'penalty pen + 'page-penalty page-pen)) (define-public (make-articulation name) (make-music 'ArticulationEvent @@ -570,6 +580,27 @@ without context specification. Called from parser." (if (vector? props) (vector-reverse-map execute-1 props)))) + + +(defmacro-public def-grace-function (start stop) + `(def-music-function (location music) (ly:music?) + (make-music 'GraceMusic + 'origin location + 'element (make-music 'SequentialMusic + 'elements (list (ly:music-deep-copy ,start) + music + (ly:music-deep-copy ,stop)))))) + +(defmacro-public def-music-function (args signature . body) + "Helper macro for `ly:make-music-function'. +Syntax: + (def-music-function (location arg1 arg2 ...) (arg1-type? arg2-type? ...) + ...function body...) +" + `(ly:make-music-function (list ,@signature) + (lambda (,@args) + ,@body))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; switch it on here, so parsing and init isn't checked (too slow!) ;; @@ -636,11 +667,11 @@ without context specification. Called from parser." (define-public (set-accidental-style style . rest) "Set accidental style to STYLE. Optionally takes a context argument, e.g. 'Staff or 'Voice. The context defaults to Voice, except for piano styles, which -use PianoStaff as a context. " +use GrandStaff as a context. " (let ((context (if (pair? rest) (car rest) 'Staff)) (pcontext (if (pair? rest) - (car rest) 'PianoStaff))) + (car rest) 'GrandStaff))) (ly:export (cond ;; accidentals as they were common in the 18th century. @@ -684,14 +715,14 @@ use PianoStaff as a context. " ((equal? style 'piano) (set-accidentals-properties #f '( Staff (same-octave . 0) (any-octave . 0) (same-octave . 1) - PianoStaff (any-octave . 0) (same-octave . 1)) + GrandStaff (any-octave . 0) (same-octave . 1)) '() pcontext)) ((equal? style 'piano-cautionary) (set-accidentals-properties #f '(Staff (same-octave . 0)) '(Staff (any-octave . 0) (same-octave . 1) - PianoStaff (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. @@ -713,5 +744,3 @@ use PianoStaff as a context. " (else (ly:warn (string-append "Unknown accidental style: " (symbol->string style))) (make-sequential-music '())))))) - -