-;;;; 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 <janneke@gnu.org>
+;;;; Copyright (C) 1998--2010 Jan Nieuwenhuizen <janneke@gnu.org>
;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;;
+;;;; 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 <http://www.gnu.org/licenses/>.
;; (use-modules (ice-9 optargs))
(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!))
+(define-public ly:context-property
+ (make-procedure-with-setter ly:context-property
+ ly:context-set-property!))
+
(define-public (music-map function music)
"Apply @var{function} to @var{music} and all of the music it contains.
(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)
(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)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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)))
(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)
;; 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)
(make-music 'PropertyUnset
'symbol sym))
-(define-public (make-ottava-set octavation)
- (let ((m (make-music 'ApplyContext)))
- (define (ottava-modify context)
- "Either reset middleCPosition to the stored original, or remember
-old middleCPosition, add OCTAVATION to middleCPosition, and set
-OTTAVATION to `8va', or whatever appropriate."
- (if (number? (ly:context-property context 'middleCOffset))
- (let ((where (ly:context-property-where-defined context 'middleCOffset)))
- (ly:context-unset-property where 'middleCOffset)
- (ly:context-unset-property where 'ottavation)))
-
- (let* ((offset (* -7 octavation))
- (string (cdr (assoc 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)))
- (set! (ly:music-property m 'procedure) ottava-modify)
- (context-spec-music m 'Staff)))
-
-(define-public (set-octavation ottavation)
- (ly:export (make-ottava-set ottavation)))
-
;;; Need to keep this definition for \time calls from parser
(define-public (make-time-signature-set num den)
"Set properties for time signature NUM/DEN."
;;; 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))))
"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."
(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)
;; 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)
"
(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))))
(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))
,(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)
projects / lilypond.git / blobdiff