Hello all,
Several years ago David Nalesnik very kindly and generously created a
Scheme script that would automatically apply ottava markings to a
score when needed (according to my own instrument definitions). I
needed this function because my Lilypond scores are all generated
automatically by my software and there is no human intervention
allowed in that process.
So I've been using that function daily for years and it works
wonderfully. Just recently, however, I started working on adding
chords to my music generating program (before you could have many
different voices but just not chords) and that's when I noticed a
problem.
The following works as intended:
<c e g> or
<c e g>4
but these produce errors:
<c e g>\f or
<c e g>4\f
The error message:
GNU LilyPond 2.19.82
Processing `auto-ottava.ly'
Parsing...auto-ottava.ly:24:15: In procedure ly:pitch-steps in
expression (ly:pitch-steps p):
auto-ottava.ly:24:15: Wrong type argument in position 1 (expecting Pitch): ()
The problem seems to be when there are dynamics involved with chords.
Note, this does *not* happen with single notes and dynamics, only with
chords and dynamics.
I emailed David several days ago but haven't heard from him. I'm not
sure if it was a good email address or if he's just not available
these days. In any case, I'm hoping someone on the list can spot the
problem and offer up a solution. I've attached a copy of the Scheme
script.
Thanks,
Dave Bellows
%% This program, auto-ottava.ly. creates automatic ottavation of GNU Lilypond input.
%% Copyright (C) 2014-2015 David Nalesnik
%% This program 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.
%% This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
\version "2.19.82"
#(define (ledger-line-no middle-C-pos p)
"Returns the number of ledger-lines a pitch @var{p} will have with
middle C position @var{middle-C-pos} expressed as staff-steps from the
middle staff line."
(let* ((ps (ly:pitch-steps p))
(mid-staff-steps (- middle-C-pos))
(top-line (+ mid-staff-steps 4))
(bottom-line (- mid-staff-steps 4))
(above? (> ps top-line))
(below? (< ps bottom-line))
(steps-outside-staff
(cond
(below? (- ps bottom-line))
(above? (- ps top-line))
(else 0))))
(truncate (/ steps-outside-staff 2))))
#(define (find-clefMiddleCPosition mus)
(let ((clef-pos -6)) ; treble is default
(for-some-music
(lambda (x)
(let ((n (ly:music-property x 'symbol)))
(and (eq? n 'middleCClefPosition)
(set! clef-pos (ly:music-property x 'value)))))
mus)
clef-pos))
#(define clefs
; An alist of (clef . position of middle C) pairs. Center line of staff = 0.
; For use when \ottavate is called on a music expression which begins with a
; clef other than treble, which has been set before that expression.
'((treble . -6)
(treble_8 . 1)
(bass . 6)
(bass_8 . 13)
(alto . 0)
(tenor . 2)))
#(define (make-ottava-music arg)
(list (make-music
'OttavaMusic
'ottava-number arg)))
#(define (select-ottava-music str)
(let ((options
'(("up-an-octave" . 1)
("down-an-octave" . -1)
("up-two-octaves" . 2)
("down-two-octaves" . -2)
("loco" . 0))))
(make-ottava-music (assoc-get str options))))
#(define naming-options
'((short . (("up-an-octave" . "8")
("down-an-octave" . "8")
("up-two-octaves" . "15")
("down-two-octaves" . "15")
("loco" . #f)))
(long . (("up-an-octave" . "8va")
("down-an-octave" . "8va bassa")
("up-two-octaves" . "15ma")
("down-two-octaves" . "15ma")
("loco" , #f)))
(default . #f)))
#(define (make-alternate-name name)
(let* ((ps (make-music
'PropertySet
'symbol 'ottavation
'value name))
(csm (make-music
'ContextSpeccedMusic
'element ps
'context-type 'Staff)))
(list csm)))
#(define (select-name displacement name-style)
(let* ((style (assoc-get name-style naming-options))
(name (if style
(assoc-get displacement style)
#f)))
(if name
(make-alternate-name name)
'())))
ottavate =
#(define-music-function (parser location upper lower options mus)
(number-pair? number-pair? list? ly:music?)
"Create ottavas for music based on numbers of ledger lines. Both @var{upper}
and @var{lower} are pairs specifying a range of ledger lines: @var{upper}
determines @code{8va} and @code{15ma}, and @var{lower} determines @var{8vb} and
@var{15mb}. Within this range (inclusive), an @code{8va} or @code{8ba} will
be created. Notes with numbers of ledger lines exceeding these ranges will be
assigned @code{15ma} or @code{15mb}.
Numbers of ledger lines above the staff are specified in @var{upper} as
positive integers, while ledger lines below the staff are specified in @var{lower}
as negative numbers.
The parameter @var{options} is an alist of symbol/value pairs. The symbol
@var{name-style} may be paired with @var{short}, @var{long}, or @var{default}.
The symbol @var{opening-clef} is for use when the music expression on which
@code{ottavate} is called begins with a clef other than treble which has been
set before that music expression.
The parameter @var{options} is not optional. Any symbol left out will be assigned
its default value. The empty list selects all default values.
"
(let* ((upper8 (car upper))
(upper15 (cdr upper))
(lower8 (car lower))
(lower15 (cdr lower))
(name-style (assoc-get 'name-style options 'default))
;; Since clef information is found by scanning the music expression, any clef
;; change must be within the music expression fed to ottavate. There is no access
;; to context properties from within a music function. User needs to tell
;; \ottavate the opening clef if it is other than treble and not set within
;; the music expression on which \ottavate is called.
(opening-clef (assoc-get 'opening-clef options 'treble))
(opening-middle-C-pos (assoc-get opening-clef clefs))
(loco (make-ottava-music 0)))
(define (select-displacement-string ledger-count)
(cond
((> ledger-count upper15)
"up-two-octaves")
((>= ledger-count upper8)
"up-an-octave")
((< ledger-count lower15)
"down-two-octaves")
((<= ledger-count lower8)
"down-an-octave")
(else "loco")))
(define (calc-displacement clef-pos mus-expr)
; Return a string designating displacement. "Loco" means "as written."
; Chords have the ledger-line count of their members averaged.
; Algorithm ought to be more sophisticated, and take context into consideration.
; We should not lose an ottava if one note in a passage dips below the
; threshold.
(cond
((music-is-of-type? mus-expr 'event-chord)
(let* ((elts (ly:music-property mus-expr 'elements))
(ledger-list
(map (lambda (e)
(ledger-line-no clef-pos (ly:music-property e 'pitch)))
elts))
(lowest (apply min ledger-list))
(highest (apply max ledger-list)))
(cond
((every positive? ledger-list)
(select-displacement-string lowest))
((every negative? ledger-list)
(select-displacement-string highest))
(else "loco"))))
((music-is-of-type? mus-expr 'note-event)
(let* ((pitch (ly:music-property mus-expr 'pitch))
(ledger-count (ledger-line-no clef-pos pitch)))
(select-displacement-string ledger-count)))))
(define (build-new-elts mus-expr new-expr prev clef-pos)
(if (null? mus-expr)
new-expr
(begin
(if (music-is-of-type? (car mus-expr) 'context-specification)
(set! clef-pos (find-clefMiddleCPosition (car mus-expr))))
(cond
;; We do not extend across rests for now.
((music-is-of-type? (car mus-expr) 'rest-event)
(build-new-elts
(cdr mus-expr)
(append
new-expr
loco
(list (car mus-expr)))
"loco" clef-pos))
((or (music-is-of-type? (car mus-expr) 'event-chord)
(music-is-of-type? (car mus-expr) 'note-event))
(let ((d (calc-displacement clef-pos (car mus-expr))))
(cond
((and d (not (string=? d prev)))
(build-new-elts
(cdr mus-expr)
(append
new-expr
(select-ottava-music d)
(select-name d name-style)
(list (car mus-expr)))
d clef-pos))
(else
(build-new-elts
(cdr mus-expr)
(append new-expr (list (car mus-expr)))
prev clef-pos)))))
; ew.
(else
(build-new-elts
(cdr mus-expr)
(append new-expr (list (car mus-expr)))
prev clef-pos))))))
(define (recurse music)
(let ((elts (ly:music-property music 'elements))
(e (ly:music-property music 'element)))
(if (ly:music? e)
(recurse e))
(if (pair? elts)
(if (or
(any (lambda (elt) (music-is-of-type? elt 'note-event)) elts)
(any (lambda (elt) (music-is-of-type? elt 'event-chord)) elts)
(any (lambda (elt) (music-is-of-type? elt 'rest-event)) elts))
(set! (ly:music-property music 'elements)
(build-new-elts elts '() "loco" opening-middle-C-pos))
(map recurse elts)))))
(recurse mus)
;(display-scheme-music mus) ; for testing
mus))
% %%%%%%%%%%% EXAMPLE %%%%%%%%%%%%
% {
% f''' g''' \clef bass g,, e,,
% }
% {
% \ottavate #'(4 . 7) #'(-4 . -7) #'((name-style . short)) { f''' g''' \clef bass g,, e,,}
% }
% music = { c d e f }
% % WRONG!
% {
% \clef bass \ottavate #'(4 . 7) #'(-4 . -7) #'() \music
% }
% % RIGHT!
% {
% \clef bass % not visible to \ottavate...
% \ottavate #'(4 . 7) #'(-4 . -7) #'((opening-clef . bass)) \music
% }
% musFour = \relative c' {
% <c e g> <e g c> <g c e>
% <c e g> <e g c> <g c e>
% <c e g> <e g c> <g c e>
% <c e g> <e g c> <g c e>
% <c e g> <g c e> <e g c>
% <c e g> <g c e> <e g c>
% <c e g> <g c e> <e g c>
% <c e g> <g c e> <e g c>
% }
% {
% \musFour
% }
% {
% \ottavate #'(3 . 6) #'(-3 . -6) #'((name-style . short)) \musFour
% }_______________________________________________
lilypond-user mailing list
lilypond-user@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-user
