6 Commits

4 changed files with 176 additions and 35 deletions

View File

@@ -2,11 +2,14 @@
poetPrefix = "Worte:" poetPrefix = "Worte:"
composerPrefix = "Weise:" composerPrefix = "Weise:"
compositionPrefix = "Satz:" compositionPrefix = "Satz:"
adaptionPrefix = "Bearbeitung:" adaptionTextPrefix = "Bearbeitung Text:"
adaptionMusicPrefix = "Bearbeitung Musik:"
poetAndComposerEqualPrefix = "Worte und Weise:" poetAndComposerEqualPrefix = "Worte und Weise:"
voicePrefix = "Stimme:" voicePrefix = "Stimme:"
versePrefix = "Strophe:" versePrefix = "Strophe:"
translationAuthorPrefix = "Übersetzung:"
translationPrefix = "Übersetzung:" translationPrefix = "Übersetzung:"
pronunciationPrefix = "Aussprache:"
interludePrefix = "Zwischenspiel:" interludePrefix = "Zwischenspiel:"
bridgePrefix = "Bridge:" bridgePrefix = "Bridge:"
@@ -42,8 +45,6 @@
(year_melody (chain-assoc-get 'songinfo:year_melody props #f)) (year_melody (chain-assoc-get 'songinfo:year_melody props #f))
(poet-with-year (if (and poet-maybe-with-composer year_text) (string-append poet-maybe-with-composer ", " year_text) poet-maybe-with-composer)) (poet-with-year (if (and poet-maybe-with-composer year_text) (string-append poet-maybe-with-composer ", " year_text) poet-maybe-with-composer))
(composer-with-year (if (and composer year_melody) (string-append composer ", " year_melody) composer)) (composer-with-year (if (and composer year_melody) (string-append composer ", " year_melody) composer))
(poet-and-composer-oneliner (if (and poet-with-year composer-with-year) (markup poet-with-year between-poet-and-composer-markup composer-with-year) #f))
(current-line-width (chain-assoc-get 'line-width props (ly:output-def-lookup layout 'line-width)))
(string-with-paragraphs->markuplist (lambda (prefix text) (string-with-paragraphs->markuplist (lambda (prefix text)
(if text (if text
(apply append (apply append
@@ -51,22 +52,26 @@
(lambda (paragraph) (lambda (paragraph)
(make-wordwrap-internal-markup-list #t (make-wordwrap-internal-markup-list #t
#{ \markuplist { $(ly:parser-include-string paragraph) } #})) #{ \markuplist { $(ly:parser-include-string paragraph) } #}))
(ly:regex-split (ly:make-regex "\n[ \t\n]*\n[ \t\n]*") text))) (ly:regex-split (ly:make-regex "\n[ \t\n]*\n[ \t\n]*") (string-append prefix text))))
'())))) '())))
(poet-and-composer-markup-list
(string-with-paragraphs->markuplist "" (string-append
(if poet-with-year (string-append "\n\n" poet-with-year) "")
(if composer-with-year (string-append "\n\n" composer-with-year) "")
)))
(poet-and-composer-oneliner (if (and poet-with-year composer-with-year) (make-line-markup (cons (cadr poet-and-composer-markup-list) (cons between-poet-and-composer-markup (cddr poet-and-composer-markup-list)))) #f))
(current-line-width (chain-assoc-get 'line-width props (ly:output-def-lookup layout 'line-width))))
(stack-lines DOWN 0.0 (chain-assoc-get 'baseline-skip props) (stack-lines DOWN 0.0 (chain-assoc-get 'baseline-skip props)
(interpret-markup-list layout props (interpret-markup-list layout props
(append (append
(if (and poet-and-composer-oneliner (< (interval-length (ly:stencil-extent (interpret-markup layout props poet-and-composer-oneliner) X)) current-line-width)) (if (and poet-and-composer-oneliner (< (interval-length (ly:stencil-extent (interpret-markup layout props poet-and-composer-oneliner) X)) current-line-width))
(list poet-and-composer-oneliner) (list poet-and-composer-oneliner)
(make-wordwrap-string-internal-markup-list #t (string-append poet-and-composer-markup-list)
(if poet-with-year (string-append "\n\n" poet-with-year) "") (string-with-paragraphs->markuplist "" (string-append
(if composer-with-year (string-append "\n\n" composer-with-year) "")
)))
(make-wordwrap-string-internal-markup-list #t (string-append
(if copyright (string-append "\n\n© " copyright) ""))) (if copyright (string-append "\n\n© " copyright) "")))
(string-with-paragraphs->markuplist "" infotext) (string-with-paragraphs->markuplist "" infotext)
(string-with-paragraphs->markuplist "Übersetzung: " translation) (string-with-paragraphs->markuplist (string-append (ly:output-def-lookup layout 'translationPrefix) " ") translation)
(string-with-paragraphs->markuplist "Aussprache: " pronunciation) (string-with-paragraphs->markuplist (string-append (ly:output-def-lookup layout 'pronunciationPrefix) " ") pronunciation)
))))) )))))
(make-null-markup) (make-null-markup)
) )

View File

@@ -102,16 +102,28 @@
(verseComposerData (find-author-id-with-part-numbers 'meloverse authors)) (verseComposerData (find-author-id-with-part-numbers 'meloverse authors))
(voiceComposerData (find-author-id-with-part-numbers 'voice authors)) (voiceComposerData (find-author-id-with-part-numbers 'voice authors))
(compositionIds (find-author-ids-by 'composition authors)) (compositionIds (find-author-ids-by 'composition authors))
(adaptionIds (find-author-ids-by 'adaption authors)) (adaptionTextIds (find-author-ids-by 'adaption_text authors))
(adaptionMusicIds (find-author-ids-by 'adaption_music authors))
(bridgeIds (find-author-ids-by 'bridge authors)) (bridgeIds (find-author-ids-by 'bridge authors))
(interludeIds (find-author-ids-by 'interlude authors)) (interludeIds (find-author-ids-by 'interlude authors))
(year_text (chain-assoc-get 'header:year_text props #f)) (year_text (chain-assoc-get 'header:year_text props #f))
(year_translation (chain-assoc-get 'header:year_translation props #f)) (year_translation (chain-assoc-get 'header:year_translation props #f))
(year_melody (chain-assoc-get 'header:year_melody props #f)) (year_melody (chain-assoc-get 'header:year_melody props #f))
(year_composition (chain-assoc-get 'header:year_composition props #f)) (year_composition (chain-assoc-get 'header:year_composition props #f))
(year_adaption (chain-assoc-get 'header:year_adaption props #f)) (year_adaption_text (chain-assoc-get 'header:year_adaption_text props #f))
(year_adaption_music (chain-assoc-get 'header:year_adaption_music props #f))
) )
(if (and (equal? poetIds composerIds) (null? translatorIds) (null? versePoetData) (null? verseComposerData) (null? voiceComposerData) (null? compositionIds) (null? adaptionIds) (null? bridgeIds) (null? interludeIds)) (if (and
(equal? poetIds composerIds)
(null? translatorIds)
(null? versePoetData)
(null? verseComposerData)
(null? voiceComposerData)
(null? compositionIds)
(null? adaptionTextIds)
(null? adaptionMusicIds)
(null? bridgeIds)
(null? interludeIds))
(list (list
(join-present (list (join-present (list
(render-contribution-group (ly:output-def-lookup layout 'poetAndComposerEqualPrefix) poetIds) (render-contribution-group (ly:output-def-lookup layout 'poetAndComposerEqualPrefix) poetIds)
@@ -130,12 +142,23 @@
) ", ") ) ", ")
(render-partial-contribution-group 'versePrefix versePoetData) (render-partial-contribution-group 'versePrefix versePoetData)
(join-present (list (join-present (list
(render-contribution-group (ly:output-def-lookup layout 'translationPrefix) translatorIds) (render-contribution-group (ly:output-def-lookup layout 'translationAuthorPrefix) translatorIds)
year_translation year_translation
) ", ") ) ", ")
(join-present (list
(render-contribution-group (ly:output-def-lookup layout 'adaptionTextPrefix) adaptionTextIds)
year_adaption_text
) ", ")
) "; ") ) "; ")
)) ))
(if (and (null? composerIds) (null? compositionIds) (null? adaptionIds) (null? verseComposerData) (null? voiceComposerData) (null? bridgeIds) (null? interludeIds)) #f (if (and
(null? composerIds)
(null? compositionIds)
(null? adaptionMusicIds)
(null? verseComposerData)
(null? voiceComposerData)
(null? bridgeIds)
(null? interludeIds)) #f
(string-append (string-append
(ly:output-def-lookup layout 'composerPrefix) (ly:output-def-lookup layout 'composerPrefix)
" " " "
@@ -151,8 +174,8 @@
year_composition year_composition
) ", ") ) ", ")
(join-present (list (join-present (list
(render-contribution-group (ly:output-def-lookup layout 'adaptionPrefix) adaptionIds) (render-contribution-group (ly:output-def-lookup layout 'adaptionMusicPrefix) adaptionMusicIds)
year_adaption year_adaption_music
) ", ") ) ", ")
(render-contribution-group (ly:output-def-lookup layout 'bridgePrefix) bridgeIds) (render-contribution-group (ly:output-def-lookup layout 'bridgePrefix) bridgeIds)
(render-contribution-group (ly:output-def-lookup layout 'interludePrefix) interludeIds) (render-contribution-group (ly:output-def-lookup layout 'interludePrefix) interludeIds)

View File

@@ -253,6 +253,113 @@
(make-pad-right-markup -0.1 (make-tied-lyric-markup text)) (make-pad-right-markup -0.1 (make-tied-lyric-markup text))
text)))) text))))
Chord_lyrics_spacing_engraver =
#(lambda (ctx)
(let ((last-note-head #f)
(note-head-extended #f)
(last-lyric-syllable-width 0)
(lyric-width-since-last-chord 0)
(notes-on-syllable-count 0)
(last-chord-name #f)
(remaining-chord-width 0)
(last-rest #f)
(rest-count 0)
(multi-measure-rest-count 0)
(stanza-shift 0))
(make-engraver
(listeners
((multi-measure-rest-event engraver event)
(set! multi-measure-rest-count (+ multi-measure-rest-count 1))
)
((break-event engraver event)
(set! last-note-head #f)
(set! note-head-extended #f)
(set! last-lyric-syllable-width 0)
(set! lyric-width-since-last-chord 0)
(set! notes-on-syllable-count 0)
(set! last-chord-name #f)
(set! remaining-chord-width 0)
(set! last-rest #f)
(set! rest-count 0)
(set! multi-measure-rest-count 0)
(set! stanza-shift 0)
))
(acknowledgers
((note-head-interface this-engraver grob source-engraver)
(if (and (> rest-count 0) (not last-note-head))
(let ((rest-spacing-on-line-start 1.2))
(ly:grob-set-property! grob 'minimum-X-extent (cons (- rest-spacing-on-line-start) 0))
(set! stanza-shift rest-spacing-on-line-start)
))
(set! notes-on-syllable-count (+ 1 notes-on-syllable-count))
(set! last-note-head grob)
(set! note-head-extended #f)
(set! last-rest #f)
(set! rest-count 0)
(set! multi-measure-rest-count 0)
)
((lyric-syllable-interface this-engraver grob source-engraver)
(set! remaining-chord-width (max 0 (- remaining-chord-width lyric-width-since-last-chord)))
(set! last-lyric-syllable-width (- (cdr (ly:grob-extent grob grob X)) 0.2))
(set! lyric-width-since-last-chord (+ lyric-width-since-last-chord last-lyric-syllable-width))
(if last-note-head (set! notes-on-syllable-count 1))
)
((chord-name-interface this-engraver grob source-engraver)
(if (not (and
(boolean? (ly:grob-property grob 'begin-of-line-visible))
(ly:grob-property grob 'begin-of-line-visible)))
(let ((on-a-rest (> rest-count 0)))
(if (not on-a-rest)
(set! notes-on-syllable-count (- notes-on-syllable-count 1)))
(if (and last-chord-name (= multi-measure-rest-count 1) (> lyric-width-since-last-chord remaining-chord-width))
(ly:grob-set-property! last-chord-name 'extra-spacing-width (cons -0.1 (+ 0.1 (- lyric-width-since-last-chord remaining-chord-width)))))
(if last-note-head
(let* ((last-note-min-x-extent (ly:grob-property last-note-head 'minimum-X-extent))
(last-note-min-x-lower (if (pair? last-note-min-x-extent) (car last-note-min-x-extent) 0))
(last-note-min-x-upper (if (pair? last-note-min-x-extent) (cdr last-note-min-x-extent) 0)))
(if on-a-rest
(begin
(if (not note-head-extended)
(begin
(ly:grob-set-property! last-note-head 'minimum-X-extent
(cons last-note-min-x-lower (- last-lyric-syllable-width -2 (* 2.2 rest-count))))
(set! note-head-extended #t)
))
(ly:grob-set-property! last-rest 'minimum-X-extent (cons 0 2))
)
(if (and (> lyric-width-since-last-chord 0)
(> remaining-chord-width lyric-width-since-last-chord))
(ly:grob-set-property! last-note-head 'minimum-X-extent
(cons (- -1.2 (- remaining-chord-width lyric-width-since-last-chord)) last-note-min-x-upper))
(let* ((width-per-note-head 0.5)
(note-width-since-last-chord (* width-per-note-head notes-on-syllable-count)))
(if (> remaining-chord-width note-width-since-last-chord)
(ly:grob-set-property! last-note-head 'minimum-X-extent
(cons (- note-width-since-last-chord remaining-chord-width) last-note-min-x-upper))
)
)
)
)))
(set! last-chord-name grob)
(set! remaining-chord-width
(if (and on-a-rest (equal? (ly:prob-property (ly:grob-property grob 'cause) 'duration) (ly:prob-property (ly:grob-property last-rest 'cause) 'duration)))
0
(cdr (ly:grob-extent grob grob X))))
(set! lyric-width-since-last-chord 0)
(set! notes-on-syllable-count (if on-a-rest 0 1))
))
)
((rest-interface this-engraver grob source-engraver)
(set! rest-count (+ 1 rest-count))
(set! last-rest grob)
(set! multi-measure-rest-count 0)
)
((stanza-number-interface this-engraver grob source-engraver)
(ly:grob-set-property! grob 'padding (+ 1 stanza-shift)))
))))
%#(ly:set-option 'debug-skylines #t)
#(define-markup-command (chordlyrics layout props lyrics) (ly:music?) #(define-markup-command (chordlyrics layout props lyrics) (ly:music?)
#:properties ((verse-chords #{#}) #:properties ((verse-chords #{#})
(verse-reference-voice #{#}) (verse-reference-voice #{#})
@@ -298,6 +405,8 @@
% \override SpacingSpanner.strict-note-spacing = ##t % \override SpacingSpanner.strict-note-spacing = ##t
\override SpacingSpanner.uniform-stretching = ##t \override SpacingSpanner.uniform-stretching = ##t
\override SpacingSpanner.spacing-increment = 0 \override SpacingSpanner.spacing-increment = 0
%\override SpacingSpanner.packed-spacing = ##t
\consists \Chord_lyrics_spacing_engraver
\remove Bar_number_engraver \remove Bar_number_engraver
\remove Mark_engraver \remove Mark_engraver
\remove Jump_engraver \remove Jump_engraver
@@ -331,9 +440,10 @@
\NullVoice \NullVoice
\consists Rest_engraver \consists Rest_engraver
\omit Rest \omit Rest
\override Rest.X-extent = #'(0 . 0)
\undo \omit NoteHead \undo \omit NoteHead
\hide NoteHead \hide NoteHead
\override NoteHead.X-extent = #'(0 . 0) \override NoteHead.X-extent = #'(0 . 0.5)
} }
} }
} }

View File

@@ -56,11 +56,11 @@
#(let ((index-item-list (list))) #(let ((index-item-list (list)))
(set! add-index-item! (set! add-index-item!
(lambda* (markup-symbol text sorttext #:optional (label (gensym "index"))) (lambda* (markup-symbol textoptions sorttext #:optional (label (gensym "index")))
(set! index-item-list (set! index-item-list
;; We insert index items sorted from the beginning on and do ;; We insert index items sorted from the beginning on and do
;; not sort them later - this saves pretty much computing time ;; not sort them later - this saves pretty much computing time
(insert-alphabetical-sorted! (list label markup-symbol text (insert-alphabetical-sorted! (list label markup-symbol textoptions
;; this crazy hack is necessary because lilypond depends on guile 1.8 atm ;; this crazy hack is necessary because lilypond depends on guile 1.8 atm
;; and so the cool unicode conversion functions cannot be used ;; and so the cool unicode conversion functions cannot be used
(ly:string-substitute " " "" (ly:string-substitute " " ""
@@ -92,20 +92,20 @@
(cons (car ilist) (insert-alphabetical-sorted! iitem (cdr ilist)))))) (cons (car ilist) (insert-alphabetical-sorted! iitem (cdr ilist))))))
% code for category index % code for category index
#(define*-public (add-category-index-item! categories markup-symbol text #:optional label) #f) #(define*-public (add-category-index-item! categories markup-symbol textoptions #:optional label) #f)
#(define-public (category-index-items) #f) #(define-public (category-index-items) #f)
#(let ((category-index-hash (make-hash-table))) #(let ((category-index-hash (make-hash-table)))
(set! add-category-index-item! (set! add-category-index-item!
(lambda* (categories markup-symbol text #:optional (label (gensym "index"))) (lambda* (categories markup-symbol textoptions #:optional (label (gensym "index")))
(for-each (lambda (category) (for-each (lambda (category)
(let* ((catsym (string->symbol category)) (let* ((catsym (string->symbol category))
(catlist (hashq-ref category-index-hash catsym (catlist (hashq-ref category-index-hash catsym
(list (list label 'indexCategoryMarkup category))))) (list (list label 'indexCategoryMarkup `(((rawtext . ,category))))))))
(if (assq catsym category-names) (if (assq catsym category-names)
(hashq-set! category-index-hash catsym (hashq-set! category-index-hash catsym
(cons (list label markup-symbol text) catlist)) (cons (list label markup-symbol textoptions) catlist))
(ly:error "song: <~a> category ~a is not defined!" (markup->string text) category)))) (ly:error "song: <~a> category ~a is not defined!" (markup->string (chain-assoc-get 'rawtext textoptions)) category))))
categories) categories)
(make-music 'EventChord (make-music 'EventChord
'page-marker #t 'page-marker #t
@@ -121,13 +121,13 @@
#(let ((author-index-hash (make-hash-table))) #(let ((author-index-hash (make-hash-table)))
(set! add-author-index-item! (set! add-author-index-item!
(lambda* (authorIDs markup-symbol text #:optional (label (gensym "index"))) (lambda* (authorIDs markup-symbol textoptions #:optional (label (gensym "index")))
(for-each (lambda (authorID) (for-each (lambda (authorID)
(let* ((authorsym (string->symbol authorID)) (let* ((authorsym (string->symbol authorID))
(authorlist (hashq-ref author-index-hash authorsym (authorlist (hashq-ref author-index-hash authorsym
(list (list label 'indexAuthorMarkup authorID))))) (list (list label 'indexAuthorMarkup `(((rawtext . ,authorID))))))))
(hashq-set! author-index-hash authorsym (hashq-set! author-index-hash authorsym
(cons (list label markup-symbol text) authorlist)) (cons (list label markup-symbol textoptions) authorlist))
)) ))
authorIDs) authorIDs)
(make-music 'EventChord (make-music 'EventChord
@@ -381,7 +381,8 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
(verseComposerData (find-author-id-with-part-numbers 'meloverse authors)) (verseComposerData (find-author-id-with-part-numbers 'meloverse authors))
(voiceComposerData (find-author-id-with-part-numbers 'voice authors)) (voiceComposerData (find-author-id-with-part-numbers 'voice authors))
(compositionIds (find-author-ids-by 'composition authors)) (compositionIds (find-author-ids-by 'composition authors))
(adaptionIds (find-author-ids-by 'adaption authors)) (adaptionTextIds (find-author-ids-by 'adaption_text authors))
(adaptionMusicIds (find-author-ids-by 'adaption_music authors))
(bridgeIds (find-author-ids-by 'bridge authors)) (bridgeIds (find-author-ids-by 'bridge authors))
(interludeIds (find-author-ids-by 'interlude authors))) (interludeIds (find-author-ids-by 'interlude authors)))
(map csv-escape (map csv-escape
@@ -397,14 +398,15 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
(headervar-or-empty 'categorytitle) (headervar-or-empty 'categorytitle)
(headervar-or-empty 'categories) (headervar-or-empty 'categories)
(format-authors (append poetIds (map car versePoetData))) (format-authors (append poetIds adaptionTextIds (map car versePoetData)))
(format-authors translatorIds) (format-authors translatorIds)
(format-authors (append composerIds compositionIds adaptionIds bridgeIds interludeIds (map car voiceComposerData) (map car verseComposerData))) (format-authors (append composerIds compositionIds adaptionMusicIds bridgeIds interludeIds (map car voiceComposerData) (map car verseComposerData)))
(headervar-or-empty 'year_text) (headervar-or-empty 'year_text)
(headervar-or-empty 'year_melody) (headervar-or-empty 'year_melody)
(headervar-or-empty 'year_translation) (headervar-or-empty 'year_translation)
(headervar-or-empty 'year_composition) (headervar-or-empty 'year_composition)
(headervar-or-empty 'year_adaption) (headervar-or-empty 'year_adaption_text)
(headervar-or-empty 'year_adaption_music)
(headervar-or-empty 'copyright) (headervar-or-empty 'copyright)
(headervar-or-empty 'source) (headervar-or-empty 'source)
(format-info-paragraphs (headervar-or-empty 'infotext)) (format-info-paragraphs (headervar-or-empty 'infotext))
@@ -429,7 +431,8 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
"year_melody" "year_melody"
"year_translation" "year_translation"
"year_composition" "year_composition"
"year_adaption" "year_adaption_text"
"year_adaption_music"
"copyright" "copyright"
"source" "source"
"infotext" "infotext"