@ -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))
