X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=011cdaf2abc27eeb3b784bd7c019185b4b66683b;hb=d7c0f4263534307616c82d9b2ce6fdef9472456f;hp=b3d58db60a916f7753fa9f2ee9542ed5da0824a8;hpb=7461c479c7a2e448b2d1da9759246b0cc1c9257a;p=lilypond.git diff --git a/scm/music-functions.scm b/scm/music-functions.scm index b3d58db60a..011cdaf2ab 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -1,9 +1,20 @@ -;;;; music-functions.scm -- +;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; source file of the GNU LilyPond music typesetter -;;;; -;;;; (c) 1998--2009 Jan Nieuwenhuizen +;;;; Copyright (C) 1998--2010 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys +;;;; +;;;; LilyPond is free software: you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation, either version 3 of the License, or +;;;; (at your option) any later version. +;;;; +;;;; LilyPond is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with LilyPond. If not, see . ;; (use-modules (ice-9 optargs)) @@ -25,6 +36,14 @@ (make-procedure-with-setter ly:grob-property ly:grob-set-property!)) +(define-public ly:grob-object + (make-procedure-with-setter ly:grob-object + ly:grob-set-object!)) + +(define-public ly:grob-parent + (make-procedure-with-setter ly:grob-parent + ly:grob-set-parent!)) + (define-public ly:prob-property (make-procedure-with-setter ly:prob-property ly:prob-set-property!)) @@ -246,9 +265,19 @@ through MUSIC." (set! (ly:music-property r 'element) main) (set! (ly:music-property r 'repeat-count) (max times 1)) (set! (ly:music-property r 'elements) talts) - (if (equal? name "tremolo") - (let* ((dots (1- (logcount times))) - (mult (/ (* times (ash 1 dots)) (1- (ash 2 dots)))) + (if (and (equal? name "tremolo") + (pair? (ly:music-property main 'elements))) + ;; This works for single-note and multi-note tremolos! + (let* ((children (if (music-is-of-type? main 'sequential-music) + ;; \repeat tremolo n { ... } + (length (ly:music-property main 'elements)) + ;; \repeat tremolo n c4 + 1)) + ;; # of dots is equal to the 1 in bitwise representation (minus 1)! + (dots (1- (logcount (* times children)))) + ;; The remaining missing multiplicator to scale the notes by + ;; times * children + (mult (/ (* times children (ash 1 dots)) (1- (ash 2 dots)))) (shift (- (ly:intlog2 (floor mult)))) (note-duration (first-note-duration r)) (duration-log (if (ly:duration? note-duration) @@ -258,20 +287,10 @@ through MUSIC." (set! (ly:music-property r 'tremolo-type) tremolo-type) (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)))) - - ;; 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 - (if (= children 2) (1- shift) shift) - dots)) - ;; \repeat "tremolo" c4 - (shift-duration-log r shift dots))) + ;; Adjust the time of the notes + (ly:music-compress r (ly:make-moment 1 children)) + ;; Adjust the displayed note durations + (shift-duration-log r shift dots)) r))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -292,17 +311,15 @@ through MUSIC." ;; repeats. (define-public (unfold-repeats music) - " -This function replaces all repeats with unfold repeats. " + "This function replaces all repeats with unfolded repeats." (let ((es (ly:music-property music 'elements)) - (e (ly:music-property music 'element)) - ) + (e (ly:music-property music 'element))) + (if (memq 'repeated-music (ly:music-property music 'types)) - (let* - ((props (ly:music-mutable-properties music)) - (old-name (ly:music-property music 'name)) - (flattened (flatten-alist props))) + (let* ((props (ly:music-mutable-properties music)) + (old-name (ly:music-property music 'name)) + (flattened (flatten-alist props))) (set! music (apply make-music (cons 'UnfoldedRepeatedMusic flattened))) @@ -310,20 +327,22 @@ This function replaces all repeats with unfold repeats. " (if (equal? old-name 'TremoloRepeatedMusic) (let* ((seq-arg? (memq 'sequential-music (ly:music-property e 'types))) - (count (ly:music-property music 'repeat-count)) + (count (ly:music-property music 'repeat-count)) (dot-shift (if (= 0 (remainder count 3)) - -1 0))) + -1 0)) + (child-count (if seq-arg? + (length (ly:music-property e 'elements)) + 0))) (if (= 0 -1) (set! count (* 2 (quotient count 3)))) - (shift-duration-log music (+ (if seq-arg? 1 0) + (shift-duration-log music (+ (if (= 2 child-count) + 1 0) (ly:intlog2 count)) dot-shift) (if seq-arg? - (ly:music-compress e (ly:make-moment (length (ly:music-property - e 'elements)) 1))))))) - + (ly:music-compress e (ly:make-moment child-count 1))))))) (if (pair? es) (set! (ly:music-property music 'elements) @@ -383,11 +402,11 @@ i.e. this is not an override" ;; TODO: take this from voicedGraceSettings or similar. '((Voice Stem font-size -3) (Voice NoteHead font-size -3) - (Voice TabNoteHead font-size -4) + (Voice TabNoteHead font-size -4) (Voice Dots font-size -3) (Voice Stem length-fraction 0.8) (Voice Stem no-stem-extend #t) - (Voice Beam thickness 0.384) + (Voice Beam beam-thickness 0.384) (Voice Beam length-fraction 0.8) (Voice Accidental font-size -4) (Voice AccidentalCautionary font-size -4) @@ -480,11 +499,11 @@ OTTAVATION to `8va', or whatever appropriate." (ly:context-unset-property where 'ottavation))) (let* ((offset (* -7 octavation)) - (string (cdr (assoc octavation '((2 . "15ma") - (1 . "8va") - (0 . #f) - (-1 . "8vb") - (-2 . "15mb")))))) + (string (assoc-get 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))) @@ -502,8 +521,8 @@ OTTAVATION to `8va', or whatever appropriate." ;;; Used for calls that include beat-grouping setting (define-public (set-time-signature num den . rest) "Set properties for time signature @var{num/den}. -If @var{rest} is present, it is used to make a default -@code{beamSetting} rule." +If @var{rest} is present, it is used to set +@code{beatStructure}." (ly:export (apply make-beam-rule-time-signature-set (list num den rest)))) @@ -511,30 +530,32 @@ If @var{rest} is present, it is used to make a default "Implement settings for new time signature. Can be called from either make-time-signature-set (used by \time in parser) or set-time-signature (called from scheme code -included in .ly file." - - (define (make-default-beaming-rule context) - (override-property-setting - context - 'beamSettings - (list (cons num den) 'end) - (list (cons '* (car rest))))) - - (let* ((set1 (make-property-set 'timeSignatureFraction (cons num den))) - (beat (ly:make-moment 1 den)) - (len (ly:make-moment num den)) - (set2 (make-property-set 'beatLength beat)) - (set3 (make-property-set 'measureLength len)) - (beaming-rule - (if (null? rest) - '() - (list (make-apply-context make-default-beaming-rule)))) - (output (cons* set1 set2 set3 beaming-rule))) - (descend-to-context - (context-spec-music - (make-sequential-music output) - 'Timing) - 'Score))) +included in .ly file)." + + (let ((m (make-music 'ApplyContext))) + (define (make-time-settings context) + (let* ((fraction (cons num den)) + (time-signature-settings (ly:context-property context 'timeSignatureSettings)) + (my-base-fraction (base-fraction fraction time-signature-settings)) + (my-beat-structure (if (null? rest) + (beat-structure my-base-fraction + fraction + time-signature-settings) + (car rest))) + (beaming-exception + (beam-exceptions fraction time-signature-settings)) + (new-measure-length (ly:make-moment num den))) + (ly:context-set-property! context 'timeSignatureFraction fraction) + (ly:context-set-property! + context 'baseMoment (fraction->moment my-base-fraction)) + (ly:context-set-property! context 'beatStructure my-beat-structure) + (ly:context-set-property! context 'beamExceptions beaming-exception) + (ly:context-set-property! context 'measureLength new-measure-length))) + (set! (ly:music-property m 'procedure) make-time-settings) + (descend-to-context + (context-spec-music m 'Timing) + 'Score))) + (define-public (make-mark-set label) "Make the music for the \\mark command." @@ -625,7 +646,7 @@ inside of and outside of chord construct." (make-sequential-music (list (make-voice-props-set number) (make-simultaneous-music (car lst)))) - 'Voice (number->string (1+ number))) + 'Bottom (number->string (1+ number))) (voicify-list (cdr lst) (1+ number))))) (define (voicify-chord ch) @@ -657,7 +678,7 @@ inside of and outside of chord construct." ;; Make a function that checks score element for being of a specific type. (define-public (make-type-checker symbol) (lambda (elt) - (not (eq? #f (memq symbol (ly:grob-property elt 'interfaces)))))) + (grob::has-interface elt symbol))) (define-public ((outputproperty-compatibility func sym val) grob g-context ao-context) (if (func grob) @@ -671,7 +692,7 @@ inside of and outside of chord construct." " (let ((meta (ly:grob-property grob 'meta))) - (if (equal? (cdr (assoc 'name meta)) grob-name) + (if (equal? (assoc-get 'name meta) grob-name) (set! (ly:grob-property grob symbol) val)))) @@ -1074,15 +1095,15 @@ specifies whether accidentals should be canceled in different octaves." (need-accidental #f) (previous-alteration #f) (from-other-octaves #f) - (from-same-octave (ly:assoc-get pitch-handle local-key-sig)) - (from-key-sig (ly:assoc-get notename local-key-sig))) + (from-same-octave (assoc-get pitch-handle local-key-sig)) + (from-key-sig (assoc-get notename local-key-sig))) ;; If no key signature match is found from localKeySignature, we may have a custom ;; type with octave-specific entries of the form ((octave . pitch) alteration) ;; instead of (pitch . alteration). Since this type cannot coexist with entries in ;; localKeySignature, try extracting from keySignature instead. (if (equal? from-key-sig #f) - (set! from-key-sig (ly:assoc-get pitch-handle key-sig))) + (set! from-key-sig (assoc-get pitch-handle key-sig))) ;; loop through localKeySignature to search for a notename match from other octaves (let loop ((l local-key-sig)) @@ -1293,6 +1314,29 @@ use GrandStaff as a context. " ,(make-accidental-rule 'same-octave 1) ,neo-modern-accidental-rule) context)) + ((equal? style 'neo-modern-voice) + (set-accidentals-properties #f + `(Voice ,(make-accidental-rule 'same-octave 0) + ,(make-accidental-rule 'any-octave 0) + ,(make-accidental-rule 'same-octave 1) + ,neo-modern-accidental-rule + Staff ,(make-accidental-rule 'same-octave 0) + ,(make-accidental-rule 'any-octave 0) + ,(make-accidental-rule 'same-octave 1) + ,neo-modern-accidental-rule) + '() + context)) + ((equal? style 'neo-modern-voice-cautionary) + (set-accidentals-properties #f + `(Voice ,(make-accidental-rule 'same-octave 0)) + `(Voice ,(make-accidental-rule 'any-octave 0) + ,(make-accidental-rule 'same-octave 1) + ,neo-modern-accidental-rule + Staff ,(make-accidental-rule 'same-octave 0) + ,(make-accidental-rule 'any-octave 0) + ,(make-accidental-rule 'same-octave 1) + ,neo-modern-accidental-rule) + context)) ;; Accidentals as they were common in dodecaphonic music with no tonality. ;; Each note gets one accidental. ((equal? style 'dodecaphonic)