Hello list,
I created some functions to store music in a hierarchical tree. This
"music store" leads to the possibility to store music in one place and
to get voices/parts in a defined template.
If you have to put several choral pieces in one book, you can first fill
all voices in this tree with a structure <piece>/notes/[sop|alt|ten|bas]
and then later refer to that music in a common SATB-template. If your
book shall have another look for all choral pieces, you only have to
change the template. And if you want to combine several pieces in one
bookpart, you can first \include all music definitions, then display the
music where you like to.
In this example file, I inserted one choral piece (SATB), wich is first
displayed in a four-stave-four-lyric-system, then in a
two-stave-one-lyric-system.
In the underlying tree, wich is an alist, you can access values by path,
wich is a list of symbols - for example (tree-get tree '(path to value))
One value can be stored in path '()
Like with assoc-set!, the actual tree is not modified, but the modified
is returned.
These tree-functions are used in the get/put-music-functions, wich are
actually defined in a closure.
If I typeset pieces, I use a modified include-function, wich only
includes, if the outname equals the location-name. This way I can
"\includeLocal" a testfile, wich instantiates the current piece (wich is
set before) only if I am working on that specific file:
--snip--
#(define-public includeLocal (define-music-function (parser location
file)(string?)
(let ((outname (format "~A.ly" (ly:parser-output-name parser)))
(locname (car (ly:input-file-line-char-column location))))
(if (string=? outname locname)
(let ((content (ly:gulp-file file)))
(ly:parser-include-string parser content)))
(make-music 'SequentialMusic 'void #t))))
--snip--
I know, this is another way to handle this
multi-score-in-one-book-thing. But perhaps it includes at least some
useful ideas.
If this is of interest, I'd like to get respond and suggestions to
improve it.
Cheers,
Jan-Peter
\version "2.14.2"
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% template and music store mechanism
%%% (c) 2011 by Jan-Peter Voigt
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% helpers
#(define-public (path->string lst)
(string-join (map (lambda (s)(format "~A" s)) lst) "/" 'infix))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% a tree in scheme
%%% tree = (key . (val . (list)))
% tree predicate
#(define-public (tree? t)
(let ((and-list (lambda (l) (let ((b #t)) (for-each (lambda (x) (set! b (and b x))) l) b))))
(and (pair? t)
(symbol? (car t))
(pair? (cdr t))
(list? (cdr (cdr t)))
;; (and-list (map (lambda (x) (tree? x)) (cdr (cdr t))))
)
))
% create an empty tree
#(define-public (tree-create sym)(cons sym (cons #f (list))))
% set value in tree, path is a list
#(define-public (tree-set! tree path val)
(let ((sym (if (and (list? path)(> (length path) 0))(car path) #f))
(leaf (= (length path) 0)))
(if (not (tree? tree)) (set! tree (tree-create 'root)))
(let ((cval (car (cdr tree)))
(clst (cdr (cdr tree))))
(set! tree
(cons (car tree)
(if leaf
(cons val clst)
(cons cval (assoc-set! clst sym (cdr (tree-set! (assoc sym clst) (if (> (length path) 1) (cdr path) '()) val )) ))
)
))
)
tree))
% get value from tree, path is a list
#(define-public (tree-get tree path)
(let ((sym (if (and (list? path)(> (length path) 0))(car path) #f))
(leaf (= (length path) 0)))
(if (tree? tree)
(if leaf (car (cdr tree)) (tree-get (assoc sym (cdr (cdr tree))) (if (> (length path) 1) (cdr path) '())) )
#f)
))
% get branch from tree
#(define-public (tree-get-tree tree path)
(let ((sym (if (and (list? path)(> (length path) 0))(car path) #f)))
(if (tree? tree)
(if sym
(tree-get-tree (assoc sym (cdr (cdr tree))) (if (> (length path) 1) (cdr path) '()))
tree)
#f)
))
% walk through the tree and call (callback path key value)
% where path is the node path in the tree, key is the node name and value the value
#(define-public (tree-walk tree callback . opt)
(if (tree? tree)
(let ((path (ly:assoc-get 'path opt (list) #f))
(dosort (ly:assoc-get 'sort opt #f #f)))
(if (not (list? path)) (set! path (list path)))
(callback path (car tree) (car (cdr tree)))
(for-each (lambda (p)
(tree-walk p callback `(path . ,(append path (list (car p)))) `(sort . ,dosort)))
(if dosort
(sort (cdr (cdr tree)) (lambda (p1 p2) (string-ci<? (format "~A" (car p1)) (format "~A" (car p2)))))
(cdr (cdr tree)))
)
)
))
% convenience method to display a tree
#(define-public (tree-display tree . opt)
(let ((indsp (lambda (n) #f))
(dosort (ly:assoc-get 'sort opt #t #f))
(empty (ly:assoc-get 'empty opt #f #f))
(dval (ly:assoc-get 'value opt #f #f))
(vformat (ly:assoc-get 'vformat opt (lambda (v)(format "~A" v)) #f)))
(set! indsp (let ((str " . "))
(lambda (n) (if (> n 0) (string-append str (indsp (- n 1))) ""))))
(tree-walk tree
(lambda (path key val)
(if (or val empty)(begin
(if empty
(begin (display (indsp (length path))) (display key))
(display (path->string path)))
(if (and dval val) (begin
(display ": ")
(display (vformat val))
))
(display "\n")))
) `(sort . ,dosort) `(empty . ,empty) `(value . ,dval) `(vformat . ,vformat)))
)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% store music in a tree
#(define-public (put-music path music) #f)
#(define-public (get-music path location) #f)
#(define-public (display-music-pieces) #f)
#(let ((table (tree-create 'music)))
(set! put-music (lambda (path music)
(set! table (tree-set! table path music))))
(set! get-music (lambda (path location)
(let* ((p (tree-get table path))
(m (if (ly:music? p) p
(begin
(ly:input-message location "unknown music '~A'" (path->string path))
(make-music 'SequentialMusic 'void #t))
)))
(ly:music-deep-copy m))))
(set! display-music-pieces (lambda ()
(tree-display table '(sort . #t) '(value . #t) '(empty . #f)
`(vformat . ,(lambda (v)
(let ((mom (ly:music-length v)))
(format "~A/~A" (ly:moment-main-numerator mom) (ly:moment-main-denominator mom))
))) )))
)
%%% get music for path
#(define-public getmusic (define-music-function (parser location path)(list?)
(get-music path location)))
%%% store music for path. returns void
#(define-public putmusic (define-music-function (parser location path music)(list? ly:music?)
(put-music path music)
(make-music 'SimultaneousMusic 'void #t)))
%%% remove music for path
#(define-public delmusic (define-music-function (parser location path)(list?)
(put-music path #f)
(make-music 'SimultaneousMusic 'void #t)))
%%% store music for path. returns music
#(define-public savemusic (define-music-function (parser location path music)(list? ly:music?)
(put-music path music)
music))
%%% create skip event with duration of music stored in path
#(define-public skipmusic (define-music-function (parser location path)(list?)
(let* ((music (get-music path location))
(m (ly:music-length music)))
(make-music 'SkipEvent
'duration (ly:make-duration 0 0 (ly:moment-main-numerator m)(ly:moment-main-denominator m ))))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% store templates in an alist
#(define-public (put-template name music) #f)
#(define-public (get-template name) #f)
#(define-public (display-templates) #f)
#(let* ((table (list))
(empty-function (define-music-function (parser location piece options)(symbol? list?)
(get-music (list piece) location)
)))
(set! put-template (lambda (name fun)
(set! table (assoc-set! table name fun))))
(set! get-template (lambda (name location)
(let ((p (assoc name table))
(f empty-function)
(error (lambda () (ly:input-message location "unknown template '~A'" name))))
(if (pair? p)(set! f (cdr p)) (error))
(if (not (ly:music-function? f))(set! f
(begin (error) empty-function)))
f)))
(set! display-templates (lambda ()
(for-each (lambda (p)
(display (format "template '~A'\n" (car p))))
(sort table (lambda (p1 p2) (string-ci<? (format "~A" (car p1)) (format "~A" (car p2)))))
)))
)
#(define-public puttemplate (define-music-function (parser location name fun)(symbol? ly:music-function?)
(put-template name fun)
(make-music 'SequentialMusic 'void #t)))
#(define-public calltemplate (define-music-function (parser location name music options)(symbol? list-or-symbol? list?)
((ly:music-function-extract (get-template name location)) parser location music options)))
#(define-public (loop-template parser location kind name piece options sym vals)
(make-music
kind
'elements
(map (lambda (x)
((ly:music-function-extract (get-template name location)) parser location piece (assoc-set! options sym x))
) vals)))
#(define-public loopTemplate (define-music-function (parser location kind name piece options sym vals)(symbol? symbol? list-or-symbol? list? symbol? list?)
(loop-template parser location kind name piece options sym vals)))
#(define-public stackTemplate (define-music-function (parser location name piece options sym vals)(symbol? list-or-symbol? list? symbol? list?)
(loop-template parser location 'SimultaneousMusic name piece options sym vals)))
#(define-public repeatTemplate (define-music-function (parser location name piece options sym vals)(symbol? list-or-symbol? list? symbol? list?)
(loop-template parser location 'SequentialMusic name piece options sym vals)))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% store default template and options for a piece
%%% get/set current piece
#(define-public (get-current-piece) #f)
#(define-public (set-current-piece piece) #f)
#(define-public (set-default-template piece tmpl options) #f)
#(define-public (get-default-template piece location) #f)
#(define-public (get-default-options piece location) #f)
#(let ((templates (tree-create 'default))
(current-piece #f))
(set! get-current-piece (lambda () current-piece))
(set! set-current-piece (lambda (piece) (set! current-piece piece)))
(set! set-default-template (lambda (piece tmpl options)
(if (not (list? piece))(set! piece (list piece)))
(set! current-piece piece)
(set! templates (tree-set! templates piece (cons tmpl options)))))
(set! get-default-template (lambda (piece location)
(if (not (list? piece))(set! piece (list piece)))
(let ((p (tree-get templates piece)))
(if (pair? p) (car p) 'NOTFOUND))))
(set! get-default-options (lambda (piece location)
(if (not (list? piece))(set! piece (list piece)))
(let ((p (tree-get templates piece)))
(if (pair? p) (cdr p) '()))))
)
%%% set default template and options for music at path (sets current piece)
#(define-public setDefaultTemplate (define-music-function (parser location piece template options)(list-or-symbol? symbol? list?)
(begin
(set-default-template piece template options)
(make-music 'SequentialMusic 'void #t))))
%%% call template with options stored for piece
#(define-public createmusic (define-music-function (parser location piece)(list-or-symbol?)
((ly:music-function-extract (get-template (get-default-template piece location) location))
parser location piece (get-default-options piece location))))
%%% set current piece
#(define-public setCurrentPiece (define-music-function (parser location piece)(list-or-symbol?)
(if (not (list? piece)) (set! piece (list piece)))
(set-current-piece piece)
(make-music 'SequentialMusic 'void #t)))
%%% header information is stored in an alist with key 'header in default options for piece
#(define-public setDefaultHeader
(define-music-function (parser location piece field value)(list-or-symbol? symbol? scheme?)
(let* ((tmpl (get-default-template piece location))
(opts (get-default-options piece location))
(header (ly:assoc-get 'header opts '() #f)))
(set! header (assoc-set! header field value))
(set! opts (assoc-set! opts 'header header))
(set-default-template piece tmpl opts)
(make-music 'SequentialMusic 'void #t)
)))
#(define-public (get-header-field piece field . default)
(let* ((opts (get-default-options piece #f))
(header (ly:assoc-get 'header opts '() #f)))
(ly:assoc-get field header (if (>= (length default) 1) (car default) #f) #f)))
%%% get header field for current piece
#(define-public (get-current-header-field field . default)
(get-header-field (get-current-piece) field (if (>= (length default) 1) (car default) #f)))
%%% get header field for current piece markup command
#(define-markup-command (current-header-field layout props field)(symbol?)
(let* ((text (get-current-header-field field)))
(if text
(interpret-markup layout props (markup text))
empty-stencil)
))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% two choral templates
%{
A template is expected to be a music-function with a signature like this:
#(define-music-function (parser location piece options)(list-or-symbol? list?) ...)
This function can make use of the \getmusic command, to get the music stored before.
Right now is has to append the piece list "by hand": \getmusic #(append $piece '(global))
%}
% 4-stave satb system with lyrics for all staffs
\puttemplate #'satb-lied-4 #(define-music-function (parser location piece options)(list-or-symbol? list?)
(if (not (list? piece))(set! piece (list piece))) ; is piece already a list?
#{
\new StaffGroup \with {
\override SpanBar #'transparent = ##t
} <<
\new Staff \with {
instrumentName = "S"
} <<
\new Voice { \keepWithTag #'frauen \getmusic #(append $piece '(meta)) }
\new Voice = "sop" { \getmusic #(append $piece '(global)) \getmusic #(append $piece '(noten sop)) }
>>
\new Lyrics \lyricsto "sop" { \getmusic #(append $piece '(text A)) }
\new Staff \with {
instrumentName = "A"
} <<
\new Voice { \keepWithTag #'frauen \getmusic #(append $piece '(meta)) }
\new Voice = "alt" { \getmusic #(append $piece '(global)) \getmusic #(append $piece '(noten alt)) }
>>
\new Lyrics \lyricsto "alt" { \getmusic #(append $piece '(text A)) }
\new Staff \with {
instrumentName = "T"
} <<
\new Voice { \clef "G_8" \keepWithTag #'maenner \getmusic #(append $piece '(meta)) }
\new Voice = "ten" { \getmusic #(append $piece '(global)) \getmusic #(append $piece '(noten ten)) }
>>
\new Lyrics \lyricsto "ten" { \getmusic #(append $piece '(text A)) }
\new Staff \with {
instrumentName = "B"
} <<
\new Voice { \clef "bass" \keepWithTag #'maenner \getmusic #(append $piece '(meta)) }
\new Voice = "bas" { \getmusic #(append $piece '(global)) \getmusic #(append $piece '(noten bas)) }
>>
\new Lyrics \lyricsto "bas" { \getmusic #(append $piece '(text A)) }
>>
#})
% 2-stave satb system with centered lyrics
\puttemplate #'satb-lied-2 #(define-music-function (parser location piece options)(list-or-symbol? list?)
(if (not (list? piece))(set! piece (list piece)))
(let ((verses (ly:assoc-get 'verses options '(A) #f)))
#{
\new StaffGroup \with {
\override SpanBar #'transparent = ##t
} <<
\new Staff = "frauen" \with {
instrumentName = \markup { \right-column { S A } }
} <<
\new Voice { \keepWithTag #'frauen \getmusic #(append $piece '(meta)) }
\new Voice = "sop" { \getmusic #(append $piece '(global)) \voiceOne \getmusic #(append $piece '(noten sop)) }
\new Voice = "alt" { \getmusic #(append $piece '(global)) \voiceTwo \getmusic #(append $piece '(noten alt)) }
>>
\stackTemplate #'satb-lied-2-lyrics #$piece #$options #'vers #$verses
\new Staff = "maenner" \with {
instrumentName = \markup { \right-column { T B } }
} <<
\new Voice { \clef "bass" \keepWithTag #'maenner \getmusic #(append $piece '(meta)) }
\new Voice = "ten" { \getmusic #(append $piece '(global)) \voiceOne \getmusic #(append $piece '(noten ten)) }
\new Voice = "bas" { \getmusic #(append $piece '(global)) \voiceTwo \getmusic #(append $piece '(noten bas)) }
>>
>>
#}))
\puttemplate #'satb-lied-2-lyrics #(define-music-function (parser location piece options)(list-or-symbol? list?)
(if (not (list? piece))(set! piece (list piece)))
#{
\new Lyrics \with {
\override VerticalAxisGroup #'staff-affinity = #CENTER
} \lyricsto "sop" { \getmusic #(append $piece (list 'text (cdr (assoc 'vers $options)))) }
#})
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% an example
% set template for the piece ... this will also set current-piece
\setDefaultTemplate #'(choral satb altatrinita) #'satb-lied-4 #'()
% set header information (title etc.)
\setDefaultHeader #'(choral satb altatrinita) #'title "Alta Trinità Beata"
\setDefaultHeader #'(choral satb altatrinita) #'composer "Italy 15. century"
%%%
% the previous defined choral templates expect a global part
\putmusic #'(choral satb altatrinita global) {
% faster midi
\set Score.tempoWholesPerMinute = #(ly:make-moment 120 4)
% vocal music usally has dynamics above the stave to let lyrics and dynamics as close as possible to the notes
% I prefer melisma by beam ... well, the demo piece ain't got beams ...
\autoBeamOff \dynamicUp
}
% the previous defined choral templates expect a meta part
\putmusic #'(choral satb altatrinita meta) {
\key f \major \time 2/2
% for choral music I like a StaffGroup with transparent SpanBars, so that I can once display them for endings.
\repeat volta 2 { s1*16 \once \override StaffGroup.SpanBar #'transparent = ##f }
\repeat volta 2 { s1*8 \once \override StaffGroup.SpanBar #'transparent = ##f }
}
% the lyrics for verse A (this is the only one in this piece)
\putmusic #'(choral satb altatrinita text A) \lyricmode {
Al -- ta Tri -- ni -- tà be -- a -- ta,
da noi sem -- pre ad -- o -- ra -- ta,
Tri -- ni -- tà glo -- ri -- o -- sa
u -- ni -- tà ma -- ra -- vi -- glio -- sa,
Tu sei man -- na sa -- po -- ro -- sa
e tut -- ta de -- si -- de -- ro -- sa.
}
% soprano notes
\putmusic #'(choral satb altatrinita noten sop) \relative c' {
f2 f4( g) | a2 g4( f) | bes2 a4( g) | a2 a |
g2 a4( bes) | a2 g4( f) | g( bes) a( g) | f2 f \breathe |
c'2 c4( d) | bes1 | c4( bes) a( g) | a2 a |
g4( f) bes( g) | f2 bes4( a) | g( f) bes( g) | f2 f |
c'2 c4( d) | bes2 c4( d) | ees( d) c( a) | bes2 g |
f2 g4( a) | bes2 a | g4( f) bes( g) | f2 f |
}
% alto notes
\putmusic #'(choral satb altatrinita noten alt) \relative c' {
c2 c4( e) | f2 e4( f) | f2 f4( e) | f2 f |
e2 f | f e4( f) | e( f) f( e) | c2 c \breathe |
a'2 a | g1 | g2 f4( e) | f2 f |
e4( d) d( e) | f2 f | e4( d) d( e) | c2 c |
a'2 a4( f) | g2 g4( bes) | c( bes) g( f) | f2 e |
c2 e4( f) | f2 f | e4( d) d( e) | c2 c |
}
% tenor notes
\putmusic #'(choral satb altatrinita noten ten) \relative c' {
a2 a4( c) | c2 c | d c | c c |
c2 c4( d) | c2 c4( a) | c( d) c2 | a a \breathe |
f'2 f | d1 | e2 c | c c |
c4( a) bes( c) | c2 d4( c) | c( a) bes( c) | a2 a |
f'2 f | d ees4( f) | g( f) ees( c) | d2 c |
a2 c | d c | c4( a) bes( c) | a2 a |
}
% bass notes
\putmusic #'(choral satb altatrinita noten bas) \relative c {
f2 f4( c) | f2 c4( f) | bes,2 f'4( c) | f2 f |
c2 f4( bes,) | f'2 c4( d) | c( bes) f'( c) | f,2 f \breathe |
f'2 f4( d) | g1 | c,2 f4( c) | f2 f |
c4( d) g,( c) | f2 bes,4( f') | c( d) g,( c) | f2 f |
f2 f4( d) | g2 ees4( d) | c( d) ees( f) | bes,2 c |
f2 c4( f) | bes,2 f' | c4( d) g,( c) | f,2 f |
}
%%%%%%%%%%%%%%
% instantiation
% prepare paper and layout ...
#(set-global-staff-size 18)
\paper {
score-system-spacing = #'((basic-distance . 20)
(minimum-distance . 6)
(padding . 4)
(stretchability . 15))
system-system-spacing = #'((basic-distance . 20)
(minimum-distance . 6)
(padding . 2)
(stretchability . 10))
ragged-last = ##f
ragged-last-bottom = ##f
}
\layout {
indent = 3
\context {
\Staff
\override InstrumentName #'self-alignment-X = #RIGHT
\override InstrumentName #'padding = #1
}
}
%%% create bookparts
% using the current-piece/header functions, you can use an include
% I. write out the music in four staffs
\bookpart {
\header {
title = #(get-current-header-field 'title)
subtitle = #(get-current-header-field 'subtitle)
subsubtitle = #(get-current-header-field 'subsubtitle)
composer = #(get-current-header-field 'composer "Anonymous")
poet = #(get-current-header-field 'poet)
}
\score {
\createmusic #(get-current-piece)
\layout { }
\midi { }
}
}
% II. write out the music in two staffs with centered lyrics
\bookpart {
\paper {
ragged-last-bottom = ##t
}
\header {
title = #(get-current-header-field 'title)
subtitle = #(get-current-header-field 'subtitle)
subsubtitle = #(get-current-header-field 'subsubtitle)
composer = #(get-current-header-field 'composer "Anonymous")
poet = #(get-current-header-field 'poet)
}
\score {
\calltemplate #'satb-lied-2 #(get-current-piece) #'((verses . (A)))
\layout { }
}
}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% for debugging purposes
#(display (format "current piece: ~A\n" (path->string (get-current-piece))))
#(display "templates:\n")
#(display-templates)
#(display "music-tree:\n")
#(display-music-pieces)
_______________________________________________
lilypond-devel mailing list
[email protected]
https://lists.gnu.org/mailman/listinfo/lilypond-devel
