Hello Marc,
for me this problem leads to the question how to name variables and how
store music. I am using my own functions to store music and typeset it
into a template.
If this template is capable of some stanza option, it can produce Lyric
contexts as needed. The file attached is my current
next-version-development-alpha-stuff.
If you look into it, you will first see a lot lot lot of scheme code. At
the end of the file is a little example, that does not use stanzas right
now - so this is more an invitation to develop.
The key functions are:
\putTemplate #'(template path) #(define-music-function (parser location
piece options)(list? list?) #{ ... #}
\setDefaultTemplate #'(music path) #'(template path) #'((option .
a-list)) % sets current music-path context
\putMusic #'(rel music path) { [the music] } % stores music relative to
current music-path
\createScore #'(rel music path) % instantiates music relative to current
music-path (will most times be #'() )
If this is of interest for you, I could explain it more deeply and do
changes from the comments of someone else.
Cheers,
Jan-Peter
Am 02.12.2011 11:26, schrieb Marc Hohl:
Hello list,
I have a lot of small music pieces with several stanzas which I store
like this
textA = \lyricmode {
\set stanza = "1. "
this is the first stan -- za.
}
textB = \lyricmode {
\set stanza = "2. "
and this one is the se -- cond.
}
textC = ...
together with the melody in files called data01.ily, data02.ily etc.
Now these files should be processed by some kind of generator file,
which consists of something like this:
\include "data01.ily"
\score {
\new Staff {
\new Voice { \melody }
\addlyrics { \textA }
\addlyrics { \textB }
\addlyrics { \textC }
}
}
Now the data files contain different numbers of stanzas, and ideally,
the generator file
should be intelligent enough to include all stanzas which are present.
Has someone an idea
how to create a loop which scans for textA, textB, textC etc. and puts
a command that acts like
\addlyrics for each hit?
I could do this with some shell scripting, but a lilypondish solution
would be better to
maintain, I think.
Thanks in advance,
Marc
_______________________________________________
lilypond-user mailing list
lilypond-user@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-user
\version "2.14.2"
#(use-modules (oop goops))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define (glue-list lst glue)
(string-join (map (lambda (s)(format "~A" s)) lst) glue 'infix))
#(define-public (assoc-set-all! lst vls)
(begin
(for-each (lambda (p)
(if (pair? p) (set! lst (assoc-set! lst (car p) (cdr p)))) ) vls)
lst))
#(define-public (normalize-path path)
(let ((ret '()))
(for-each (lambda (e)
(set! ret (if (eq? e '..)
(if (> (length ret) 1) (cdr ret) '())
`(,e ,@ret)))) path)
(reverse ret)))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define-class <stack> ()
(store #:accessor store #:setter set-stack! #:init-value '())
)
#(define-method (push (stack <stack>) val)
(set! (store stack) `(,val ,@(store stack))))
#(define-method (get (stack <stack>))
(let ((st (store stack)))
(if (> (length st) 0)
(car st)
#f)))
#(define-method (pop (stack <stack>))
(let ((st (store stack)))
(if (> (length st) 0)
(let ((ret (car st)))
(set! (store stack) (cdr st))
ret)
#f)))
#(define-method (display (stack <stack>) port)
(for-each (lambda (e)
(display "stack> ")(display e)(newline)) (store stack)))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define-class <tree> ()
(children #:accessor children #:setter set-children! #:init-value '())
(key #:accessor key #:init-keyword #:key #:init-value 'node)
(value #:accessor value #:setter set-value! #:init-value #f)
)
#(define-method (tree-set! (tree <tree>) (path <list>) val)
(if (= (length path) 0)
(set! (value tree) val)
(let ((ckey (car path))
(cpath (cdr path)))
(let ((child (assoc-get ckey (children tree)) ))
(if (not (is-a? child <tree>))
(begin (set! child (make <tree> #:key ckey))
(set! (children tree) (assoc-set! (children tree) ckey child ) )))
(tree-set! child cpath val)
))
))
#(define-method (tree-get (tree <tree>) (path <list>))
(if (= (length path) 0)
(value tree)
(let* ((ckey (car path))
(cpath (cdr path))
(child (assoc-get ckey (children tree)) ))
(if (is-a? child <tree>)
(tree-get child cpath)
#f)
)))
#(define-method (tree-dispatch (tree <tree>) (path <list>) (relative <list>) def)
(let ((val (value tree)))
(if (= (length path) 0)
(if val (cons '() val)(cons relative def))
(let* ((ckey (car path))
(cpath (cdr path))
(child (assoc-get ckey (children tree)) ))
(if (or val (not (list? relative))) (set! relative '()))
(if val (set! def (value tree)))
(if (is-a? child <tree>)
(tree-dispatch child cpath `(,@relative ,ckey) def)
`((,@relative ,@path) . ,def))
))))
#(define-method (tree-collect (tree <tree>) (path <list>) (vals <stack>))
(let ((val (value tree)))
(if (> (length path) 0)
(let* ((ckey (car path))
(cpath (cdr path))
(child (assoc-get ckey (children tree)) ))
(if (is-a? child <tree>) (tree-collect child cpath vals))
))
(if val (push vals val))
(store vals)
))
#(define-method (tree-walk (tree <tree>) (path <list>) (callback <procedure>) . opts)
(let ((dosort (assoc-get 'sort opts))
(doempty (assoc-get 'empty opts)))
(if (or doempty (value tree))
(callback path (key tree) (value tree)))
(for-each (lambda (p)
(tree-walk (cdr p) `(,@path ,(car p)) callback `(sort . ,dosort) `(empty . ,doempty)))
(if dosort (sort (children tree) (lambda (p1 p2) (string-ci<? (format "~A" (car p1)) (format "~A" (car p2)))))
(children tree)))
))
#(define-public (tree-display tree . opt)
(let ((indsp (lambda (n) #f))
(glue-list (lambda (lst glue)
(string-join (map (lambda (s)(format "~A" s)) lst) glue 'infix)))
(dosort (ly:assoc-get 'sort opt #t #f))
(empty (ly:assoc-get 'empty opt #f #f))
(dval (ly:assoc-get 'value opt #t #f))
(vformat (ly:assoc-get 'vformat opt (lambda (v)(format "~A" v)) #f)))
(tree-walk tree '()
(lambda (path k val)
(format #t "[~A] ~A" (key tree) (glue-list path "/"))
(if (and dval val) (begin
(display ": ")
(display (vformat val))
))
(display "\n")
) `(sort . ,dosort) `(empty . ,empty) ))
)
#(define-method (display (tree <tree>) port)
(let ((tkey (key tree)))
(tree-display tree)))
#(define-public (tree? tree)(is-a? tree <tree>))
#(define-public (tree-create . key)
(let ((k (if (> (length key) 0)(car key) 'node)))
(make <tree> #:key k)
))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define-public (put-music path music) #f)
#(define-public (get-music path location) #f)
#(define-public (display-music-pieces) #f)
#(let ((music-tree (tree-create 'music)))
(set! put-music (lambda (path music)
(tree-set! music-tree path music)))
(set! get-music (lambda (path location)
(let ((p (tree-get music-tree path)))
(if (ly:music? p) (ly:music-deep-copy p)
(begin
(if location (ly:input-message location "unknown music '~A'" (glue-list path "/"))
(ly:message "unknown music '~A'" (glue-list path "/")))
(make-music 'SequentialMusic 'void #t))
))))
(set! display-music-pieces (lambda ()
(tree-display music-tree `(vformat . ,(lambda (v) "*")) )))
)
#(define-public aGetMusic (define-music-function (parser location path)(list?)
(get-music path location)))
#(define-public aPutMusic (define-music-function (parser location path music)(list? ly:music?)
(put-music path music)
(make-music 'SimultaneousMusic 'void #t)))
#(define-public aDelMusic (define-music-function (parser location path)(list?)
(put-music path #f)
(make-music 'SimultaneousMusic 'void #t)))
#(define-public aScratchMusic (define-music-function (parser location path music)(list? ly:music?)
(put-music path music)
music))
#(define-public aSkipMusic (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 ))))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define-public (put-template name music) #f)
#(define-public (get-template name) #f)
#(define-public (call-template name parser location piece options) #f)
#(define-public (display-templates) #f)
#(define-public (get-current-music) #f)
#(define-public (display-music-stack) #f)
#(define-public (get-current-template) #f)
#(define-public (display-template-stack) #f)
#(let* ((templ-tree (tree-create 'templates))
(empty-function (define-music-function (parser location piece options)(symbol? list?)
(get-music (list piece) location)
))
(call-music-stack (make <stack>))
(call-template-stack (make <stack>))
(call-template-extra '())
)
(set! put-template (lambda (name fun)
(tree-set! templ-tree name fun) ))
(set! get-template (lambda (name location)
(let* ((f (tree-get templ-tree name))
(error (lambda () (if location
(ly:input-message location "unknown template '~A'" name)
(ly:message "unknown template '~A'" name)))))
(if (not (ly:music-function? f))(set! f
(begin (error) empty-function)))
f)))
(set! call-template (lambda (name parser location piece options)
(let ((tmpl (get-template name location)))
(if (ly:music-function? tmpl)
(let ((mus #f))
(push call-template-stack name)
(push call-music-stack piece)
(set! mus ((ly:music-function-extract tmpl) parser location piece options))
(pop call-music-stack)
(pop call-template-stack)
mus)
(make-music 'SimultaneousMusic 'void #t))
)))
(set! get-current-music (lambda () (get call-music-stack)))
(set! display-music-stack (lambda () (display call-music-stack)))
(set! get-current-template (lambda () (get call-template-stack)))
(set! display-template-stack (lambda () (display call-template-stack)))
(set! display-templates (lambda ()
(tree-display templ-tree `(vformat . ,(lambda (v) "*")) )))
)
#(define-public putTemplate (define-music-function (parser location name fun)(list? ly:music-function?)
(put-template name fun)
(make-music 'SequentialMusic 'void #t)))
#(define (ctmpl tabs path)
(if tabs path
(let ((cpart (get-current-template)))
(normalize-path (if (list? cpart)(append cpart path) path)))))
#(define (cmusic mabs path)
(if mabs path
(let ((cpart (get-current-music)))
(if (not (list? cpart)) (set! cpart (get-current-music-name)))
(normalize-path (if (list? cpart)(append cpart path) path)))))
#(define-public callTemplate (define-music-function
(parser location tabs name mabs music options)
(boolean? list? boolean? list? list?)
(call-template (ctmpl tabs name) parser location (cmusic mabs music) options)))
#(define-public stackTemplate (define-music-function
(parser location tabs name mabs piece options sym vals)
(boolean? list? boolean? list? list? symbol? list?)
(let ((tmpl (ctmpl tabs name))
(music (cmusic mabs name)))
(make-music
'SimultaneousMusic
'elements
(map (lambda (x)
(call-template tmpl parser location music (assoc-set! options sym x))
) vals)))))
#(define-public loopTemplate (define-music-function
(parser location kind tabs name mabs piece options sym vals)
(symbol? boolean? list? boolean? list? list? symbol? list?)
(let ((tmpl (ctmpl tabs name))
(music (cmusic mabs name)))
(make-music
kind
'elements
(map (lambda (x)
(call-template tmpl parser location music (assoc-set! options sym x))
) vals)))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define-public (get-current-music-name) #f)
#(define-public (set-current-music-name! 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)
#(define-public (display-default-music) #f)
#(let ((templates (tree-create 'defaults))
(current-piece #f))
(set! get-current-music-name (lambda () current-piece))
(set! set-current-music-name! (lambda (piece) (set! current-piece piece)))
(set! set-default-template (lambda (piece tmpl options)
(set! current-piece piece)
(tree-set! templates piece (cons tmpl options))))
(set! get-default-template (lambda (piece location)
(let ((p (tree-get templates piece)))
(if (pair? p) (car p) 'NOTFOUND))))
(set! get-default-options (lambda (piece location)
(let ((oplist (tree-collect templates piece (make <stack>)))
(opts '()))
(for-each (lambda (p)
(let* ((o (if (pair? p)(cdr p) '()))
(ohead (ly:assoc-get 'header opts '() #f))
(nhead (ly:assoc-get 'header o '() #f))
(head (assoc-set-all! ohead nhead)))
(set! opts (assoc-set-all! opts o))
(if (> (length head))(assoc-set! opts 'header head))
)) oplist)
opts
)))
(set! display-default-music (lambda ()
(tree-display templates `(vformat . ,(lambda (v)
(format "~A: ~A" (car v) (cdr v)))) )))
)
#(define-public setDefaultTemplate (define-music-function (parser location piece template options)(list? list? list?)
(begin
(set-default-template piece template options)
(make-music 'SequentialMusic 'void #t))))
#(define-public aCreateScore (define-music-function (parser location music)(list?)
(call-template (get-default-template music location)
parser location music (get-default-options music location))))
#(define-public createScore (define-music-function (parser location music)(list?)
(let ((piece (cmusic #f music)))
(call-template (get-default-template piece location)
parser location piece (get-default-options piece location)))))
#(define-public setCurrentMusic (define-music-function (parser location music)(list?)
(set-current-music-name! music)
(make-music 'SequentialMusic 'void #t)))
#(define-public (set-default-header parser location piece field value)
(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)
))
#(define-public aSetDefaultHeader
(define-music-function (parser location piece field value)(list? symbol? markup?)
(begin
(set-default-header parser location piece field value)
(make-music 'SequentialMusic 'void #t)
)))
#(define (current-music-header-set! parser location field value)
(begin
(set-default-header parser location (get-current-music-name) field value)
(make-music 'SequentialMusic 'void #t)
))
#(define-public setDefaultHeader
(define-music-function (parser location field value)(symbol? scheme?)
(current-music-header-set! parser location field value)))
#(define-public setTitle
(define-music-function (parser location value)(markup?)
(current-music-header-set! parser location 'title value)))
#(define-public setSubTitle
(define-music-function (parser location value)(markup?)
(current-music-header-set! parser location 'subtitle value)))
#(define-public setSubSubTitle
(define-music-function (parser location value)(markup?)
(current-music-header-set! parser location 'subsubtitle value)))
#(define-public setPiece
(define-music-function (parser location value)(markup?)
(current-music-header-set! parser location 'piece value)))
#(define-public setOpus
(define-music-function (parser location value)(markup?)
(current-music-header-set! parser location 'opus value)))
#(define-public setInstrument
(define-music-function (parser location value)(markup?)
(current-music-header-set! parser location 'instrument value)))
#(define-public (get-current-music-header-field field . default)
(let* ((opts (get-default-options (get-current-music-name) #f))
(header (ly:assoc-get 'header opts '() #f)))
(ly:assoc-get field header (if (>= (length default) 1) (car default) #f) #f)))
#(define-markup-command (current-music-header-field layout props field)(symbol?)
(let* ((text (get-current-music-header-field field)))
(if text
(interpret-markup layout props (markup text))
empty-stencil)
))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define-public getMusic (define-music-function (parser location path)(list?)
(let ((p (cmusic #f path)))
(get-music p location))))
#(define-public putMusic (define-music-function (parser location path music)(list? ly:music?)
(let ((p (cmusic #f path)))
(put-music p music)
(make-music 'SimultaneousMusic 'void #t))))
#(define-public scratchMusic (define-music-function (parser location path music)(list? ly:music?)
(let ((p (cmusic #f path)))
(put-music p music)
music)))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%5
#(define-public (create-quote path location)
(add-quotable parser (glue-list path ":") (get-music path location)))
#(define-public createquote (define-music-function (parser location path)(list?)
(create-quote path location)
(make-music 'SequentialMusic 'void #t)))
#(define-public createQuote (define-music-function (parser location path)(list?)
(let ((p (cmusic #f path)))
(create-quote p location)
(make-music 'SequentialMusic 'void #t))))
#(define-public cuemusic (define-music-function (parser location path dir mus)(list? integer? ly:music?)
#{
\cueDuring #(glue-list $path ":") #$dir $mus
#}))
#(define-public cueMusic (define-music-function (parser location path dir mus)(list? integer? ly:music?)
(let ((p (cmusic #f path)))
#{
\cueDuring #(glue-list $p ":") #$dir $mus
#})))
#(define-public quotemusic (define-music-function (parser location path mus)(list? ly:music?)
#{
\quoteDuring #(glue-list $path ":") $mus
#}))
#(define-public quoteMusic (define-music-function (parser location path mus)(list? ly:music?)
(let ((p (cmusic #f path)))
#{
\quoteDuring #(glue-list $p ":") $mus
#})))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Example %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\putTemplate #'(single) #(define-music-function (parser location piece options)(list? list?)
#{
<<
\callTemplate ##f #'(a) ##f #'(noten) #$options
>>
#})
\putTemplate #'(single a) #(define-music-function (parser location piece options)(list? list?)
(display-music-stack)
(display-template-stack)
(display options)(newline)
#{
\createQuote #'(ten)
\new StaffGroup <<
\new Staff <<
\getMusic #'(.. meta)
\getMusic #'(ten)
>>
\new Staff <<
\getMusic #'(.. meta)
\relative c' { r4 \cueMusic #'(ten) #UP { e8 f g } a8 b cis d4 }
>>
>>
#})
\setCurrentMusic #'(jan-peter)
\setDefaultHeader #'composer "Jan-Peter Voigt"
\setDefaultTemplate #'(jan-peter altehits christine) #'(single) #'((test . abc))
\setTitle "Musik"
\putMusic #'(meta) {
s1*2 \bar "|."
}
\putMusic #'(noten ten) \relative c''' {
g8 f \scratchMusic #'(x) { e f4 } e8 r \getMusic #'(x)
}
#(display-music-pieces)
#(display-templates)
#(display-default-music)
\header {
title = #(get-current-music-header-field 'title)
composer = #(get-current-music-header-field 'composer)
}
\score {
\createScore #'()
\layout { }
\midi { }
}
_______________________________________________
lilypond-user mailing list
lilypond-user@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-user
