X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=57f17baaa2a6588777d535457f07c06ab2ae4d47;hb=f57ce7a426d8255f3856fde708227ff6fcf25fbf;hp=1372a15a526e34cb6009c190d56d69cf231692a8;hpb=794dcbdb52faf4292036cd1b0270a956cf4316a3;p=lilypond.git diff --git a/scm/music-functions.scm b/scm/music-functions.scm index 1372a15a52..57f17baaa2 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!)) @@ -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) @@ -346,8 +365,7 @@ i.e. this is not an override" 'pop-first #t)) (define-public (make-grob-property-override grob gprop val) - "Make a Music expression that sets GPROP to VAL in GROB. Does a pop first, -i.e. this is not an override" + "Make a Music expression that overrides GPROP to VAL in GROB." (make-music 'OverrideProperty 'symbol grob 'grob-property gprop @@ -384,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) @@ -481,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))) @@ -564,7 +582,42 @@ included in .ly file." (make-music type 'span-direction span-dir)) -(define-public (set-mus-properties! m alist) +(define-public (override-head-style heads style) + "Override style for @var{heads} to @var{style}." + (make-sequential-music + (if (pair? heads) + (map (lambda (h) + (make-grob-property-override h 'style style)) + heads) + (list (make-grob-property-override heads 'style style))))) + +(define-public (revert-head-style heads) + "Revert style for @var{heads}." + (make-sequential-music + (if (pair? heads) + (map (lambda (h) + (make-grob-property-revert h 'style)) + heads) + (list (make-grob-property-revert heads 'style))))) + +(define-public (style-note-heads heads style music) + "Set @var{style} for all @var{heads} in @var{music}. Works both +inside of and outside of chord construct." + ;; are we inside a <...>? + (if (eq? (ly:music-property music 'name) 'NoteEvent) + ;; yes -> use a tweak + (begin + (set! (ly:music-property music 'tweaks) + (acons 'style style (ly:music-property music 'tweaks))) + music) + ;; not in <...>, so use overrides + (make-sequential-music + (list + (override-head-style heads style) + music + (revert-head-style heads))))) + + (define-public (set-mus-properties! m alist) "Set all of ALIST as properties of M." (if (pair? alist) (begin @@ -591,7 +644,7 @@ included in .ly file." (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) @@ -623,7 +676,7 @@ included in .ly file." ;; 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) @@ -637,7 +690,7 @@ included in .ly file." " (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)))) @@ -1040,15 +1093,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)) @@ -1259,6 +1312,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)