boernel/lilypond-common-includes
10
0
Fork 0
Code Issues 12 Pull Requests Packages Projects Releases Wiki Activity

rework authorsystem

Browse Source 
* add translation, interlude, bridge and meloverse
* fix rendering bugs
This commit is contained in:
tux 2024-05-12 11:01:06 +02:00
parent 199f515be9
commit 5884ab9d2c
2 changed files with 99 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
default_songinfo_style.ly
View File

@ -3,6 +3,11 @@
composerPrefix = "Weise:" composerPrefix = "Weise:"
compositionPrefix = "Satz:" compositionPrefix = "Satz:"
poetAndComposerEqualPrefix = "Worte und Weise:" poetAndComposerEqualPrefix = "Worte und Weise:"
voicePrefix = "Stimme:"
versePrefix = "Strophe:"
translationPrefix = "Übersetzung:"
interludePrefix = "Zwischenspiel:"
bridgePrefix = "Bridge:"
authorFormat = authorFormat =
#(lambda (noDetails name trail_name birth_year death_year organization) #(lambda (noDetails name trail_name birth_year death_year organization)

119
footer_with_songinfo.ly
View File

@ -1,3 +1,4 @@
#(use-modules (ice-9 receive))
#(define-markup-command (print-songinfo layout props) () #(define-markup-command (print-songinfo layout props) ()
(define (songinfo-from songId key) (define (songinfo-from songId key)
(let ((song (if (defined? 'SONG_DATA) (assoc-ref SONG_DATA songId) #f))) (let ((song (if (defined? 'SONG_DATA) (assoc-ref SONG_DATA songId) #f)))
@ -39,40 +40,108 @@
)) authors) )) authors)
) )
(define (render-contribution-numbers contributionNumbers) (define (numbered-contribution-prefix contributionNumbers prefixLookup)
(string-join (map (lambda (contributionNumber) (ly:format "~a." contributionNumber)) contributionNumbers) ", ") (string-append
) (string-join (map (lambda (contributionNumber) (ly:format "~a." contributionNumber)) contributionNumbers) ", ")
(define (render-verse-contribution contributionNumbers) " "
(string-append (render-contribution-numbers contributionNumbers) " Strophe: ") (ly:output-def-lookup layout prefixLookup)
)
) )
(define (render-voice-contribution contributionNumbers) (define referencedAuthors '())
(string-append (render-contribution-numbers contributionNumbers) " Stimme: ")
(define (format-authors authorIds)
(map (lambda (authorId)
(format-author
authorId
(if (member authorId referencedAuthors)
#t
(begin
(set! referencedAuthors (cons authorId referencedAuthors))
#f)))
) authorIds)
)
(define (render-contribution-group contributionPrefix authorIds)
(if (null? authorIds)
""
(string-append contributionPrefix " " (string-join (format-authors authorIds) ", ")))
)
(define (render-partial-contribution-group prefixLookup authorData)
(if (null? authorData)
""
(let ((firstAuthorContributions (cdar authorData)))
(receive (authorDataSame authorDataOther)
(partition (lambda (authorEntry) (equal? (cdr authorEntry) firstAuthorContributions)) authorData)
(string-append
(render-contribution-group (numbered-contribution-prefix firstAuthorContributions prefixLookup) (map car authorDataSame))
" "
(render-partial-contribution-group prefixLookup authorDataOther)
))))
)
(define (join-present items joiner)
(string-join (filter (lambda (item) (and (string? item) (not (string-null? (string-trim-both item))))) items) joiner)
) )
(define (poet-and-composer-from-authors authors) (define (poet-and-composer-from-authors authors)
(if authors (if authors
(let* ( (let (
(poetIds (find-author-ids-by 'text authors)) (poetIds (find-author-ids-by 'text authors))
(translatorIds (find-author-ids-by 'translation authors))
(versePoetData (find-author-id-with-part-numbers 'verse authors)) (versePoetData (find-author-id-with-part-numbers 'verse authors))
(allPoetIds (append poetIds (map car versePoetData)))
(composerIds (find-author-ids-by 'melody authors)) (composerIds (find-author-ids-by 'melody authors))
(compositionIds (find-author-ids-by 'composition 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))
(poets (append (compositionIds (find-author-ids-by 'composition authors))
(map (lambda (poetId) (format-author poetId #f)) poetIds) (bridgeIds (find-author-ids-by 'bridge authors))
(map (lambda (versePoetEntry) (string-append (render-verse-contribution (cdr versePoetEntry)) (format-author (car versePoetEntry) (member (car versePoetEntry) poetIds)))) versePoetData) (interludeIds (find-author-ids-by 'interlude authors))
)) (year_text (chain-assoc-get 'header:year_text props #f))
(composers (append (year_translation (chain-assoc-get 'header:year_translation props #f))
(map (lambda (composerId) (format-author composerId (member composerId allPoetIds))) composerIds) (year_melody (chain-assoc-get 'header:year_melody props #f))
(map (lambda (composerId) (string-append (ly:output-def-lookup layout 'compositionPrefix) " " (format-author composerId (member composerId allPoetIds)))) compositionIds) (year_composition (chain-assoc-get 'header:year_composition props #f))
(map (lambda (voiceComposerEntry) (string-append (render-voice-contribution (cdr voiceComposerEntry)) (format-author (car voiceComposerEntry) (member (car voiceComposerEntry) allPoetIds)))) voiceComposerData) )
))) (if (and (equal? poetIds composerIds) (null? translatorIds) (null? versePoetData) (null? verseComposerData) (null? voiceComposerData) (null? compositionIds) (null? bridgeIds) (null? interludeIds))
(if (and (equal? poetIds composerIds) (null? versePoetData) (null? voiceComposerData) (null? compositionIds))
(list (string-append (ly:output-def-lookup layout 'poetAndComposerEqualPrefix) " " (string-join poets ", ")) #f)
(list (list
(string-append (ly:output-def-lookup layout 'poetPrefix) " " (string-join poets ", ")) (render-contribution-group (ly:output-def-lookup layout 'poetAndComposerEqualPrefix) poetIds)
(string-append (ly:output-def-lookup layout 'composerPrefix) " " (string-join composers ", "))))) #f)
(list
(if (and (null? poetIds) (null? versePoetData) (null? translatorIds)) #f
(string-append
(ly:output-def-lookup layout 'poetPrefix)
" "
(join-present (list
(join-present (list
(render-contribution-group "" poetIds)
year_text
) ", ")
(render-partial-contribution-group 'versePrefix versePoetData)
(join-present (list
(render-contribution-group (ly:output-def-lookup layout 'translationPrefix) translatorIds)
year_translation
) ", ")
) "; ")
))
(if (and (null? composerIds) (null? compositionIds) (null? verseComposerData) (null? voiceComposerData) (null? bridgeIds) (null? interludeIds)) #f
(string-append
(ly:output-def-lookup layout 'composerPrefix)
" "
(join-present (list
(join-present (list
(render-contribution-group "" composerIds)
year_melody
) ", ")
(render-partial-contribution-group 'versePrefix verseComposerData)
(render-partial-contribution-group 'voicePrefix voiceComposerData)
(join-present (list
(render-contribution-group (ly:output-def-lookup layout 'compositionPrefix) compositionIds)
year_composition
) ", ")
(render-contribution-group (ly:output-def-lookup layout 'bridgePrefix) bridgeIds)
(render-contribution-group (ly:output-def-lookup layout 'interludePrefix) interludeIds)
) "; ")
)))))
(list #f #f) (list #f #f)
) )
) )
@ -91,8 +160,8 @@
(copyright (chain-assoc-get 'header:copyright props #f)) (copyright (chain-assoc-get 'header:copyright props #f))
(translation (chain-assoc-get 'header:translation props #f)) (translation (chain-assoc-get 'header:translation props #f))
(pronunciation (chain-assoc-get 'header:pronunciation props #f)) (pronunciation (chain-assoc-get 'header:pronunciation props #f))
(year_text (chain-assoc-get 'header:year_text props #f)) (year_text (if (string? (car poet-and-composers)) #f (chain-assoc-get 'header:year_text props #f)))
(year_melody (chain-assoc-get 'header:year_melody props #f))) (year_melody (if (string? (car poet-and-composers)) #f (chain-assoc-get 'header:year_melody props #f))))
(markup (markup
#:override (cons 'songinfo:poet-maybe-with-composer #:override (cons 'songinfo:poet-maybe-with-composer
(if (and poet-maybe-with-composer (not (and (string? poet-maybe-with-composer) (string-null? poet-maybe-with-composer)))) poet-maybe-with-composer #f)) (if (and poet-maybe-with-composer (not (and (string? poet-maybe-with-composer) (string-null? poet-maybe-with-composer)))) poet-maybe-with-composer #f))