lilypond-common-includes/footer_with_songinfo.ly

226 lines
11 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

#(use-modules (ice-9 receive))
#(define (format-author layout authorId noDetails)
(let ((author (if (defined? 'AUTHOR_DATA) (assoc-ref AUTHOR_DATA authorId) #f)))
(if author
((ly:output-def-lookup layout 'authorFormat)
noDetails
(assoc-ref author "name")
(assoc-ref author "trail_name")
(assoc-ref author "birth_year")
(assoc-ref author "death_year")
(assoc-ref author "organization")
)
"unbekannt")))
#(define (find-author-ids-by contributionType authors)
(filter-map (lambda (authordata) (if (member contributionType (cdr authordata)) (car authordata) #f)) authors))
#(define (find-author-id-with-part-numbers contributionType authors)
(filter-map (lambda (authordata)
(let ((contributionNumbers (filter-map (lambda (contribution) (if (and (list? contribution) (equal? contributionType (car contribution))) (cadr contribution) #f)) (cdr authordata)))
(authorId (car authordata)))
(if (null? contributionNumbers) #f (cons authorId contributionNumbers))
)) authors))
#(define-markup-command (print-songinfo layout props) ()
(define (songinfo-from songId key)
(let ((song (if (defined? 'SONG_DATA) (assoc-ref SONG_DATA songId) #f)))
(if song
(assoc-ref song key)
(ly:warning (ly:format "song with id ~a not found" songId)))))
(define (format-poet poetId)
(string-append (ly:output-def-lookup layout 'poetPrefix) " " (format-author layout poetId #f)))
(define (format-composer composerId)
(string-append (ly:output-def-lookup layout 'composerPrefix) " " (format-author layout composerId #f)))
(define (format-poet-and-composer authorId)
(string-append (ly:output-def-lookup layout 'poetAndComposerEqualPrefix) " " (format-author layout authorId #f)))
(define (numbered-contribution-prefix contributionNumbers prefixLookup)
(string-append
(string-join (map (lambda (contributionNumber) (ly:format "~a." contributionNumber)) contributionNumbers) ", ")
" "
(ly:output-def-lookup layout prefixLookup)
)
)
(define referencedAuthors '())
(define (format-authors authorIds)
(map (lambda (authorId)
(format-author
layout
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)
(if authors
(let (
(poetIds (find-author-ids-by 'text authors))
(translatorIds (find-author-ids-by 'translation authors))
(versePoetData (find-author-id-with-part-numbers 'verse authors))
(composerIds (find-author-ids-by 'melody authors))
(verseComposerData (find-author-id-with-part-numbers 'meloverse authors))
(voiceComposerData (find-author-id-with-part-numbers 'voice authors))
(compositionIds (find-author-ids-by 'composition authors))
(bridgeIds (find-author-ids-by 'bridge authors))
(interludeIds (find-author-ids-by 'interlude authors))
(year_text (chain-assoc-get 'header:year_text props #f))
(year_translation (chain-assoc-get 'header:year_translation props #f))
(year_melody (chain-assoc-get 'header:year_melody props #f))
(year_composition (chain-assoc-get 'header:year_composition props #f))
)
(if (and (equal? poetIds composerIds) (null? translatorIds) (null? versePoetData) (null? verseComposerData) (null? voiceComposerData) (null? compositionIds) (null? bridgeIds) (null? interludeIds))
(list
(join-present (list
(render-contribution-group (ly:output-def-lookup layout 'poetAndComposerEqualPrefix) poetIds)
(if (equal? year_text year_melody) year_text (join-present (list year_text year_melody) "/"))
) ", ")
#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)
)
)
(interpret-markup layout props
(if (chain-assoc-get 'page:is-bookpart-last-page props #f)
(let* ((authors (chain-assoc-get 'header:authors props #f))
(poet-and-composers (poet-and-composer-from-authors authors))
(songId (chain-assoc-get 'header:songId props #f))
(poetId (chain-assoc-get 'header:poetId props (if songId (songinfo-from songId "poet") #f)))
(composerId (chain-assoc-get 'header:composerId props (if songId (songinfo-from songId "composer") #f)))
(poet-and-composer-same (equal? poetId composerId)))
(let ((infotext (chain-assoc-get 'header:infotext props (chain-assoc-get 'header:songinfo props #f)))
(poet-maybe-with-composer (chain-assoc-get 'header:poet props (if poetId (if poet-and-composer-same (format-poet-and-composer poetId) (format-poet poetId)) (car poet-and-composers))))
(composer (chain-assoc-get 'header:composer props (if (and composerId (not poet-and-composer-same)) (format-composer composerId) (cadr poet-and-composers))))
(copyright (chain-assoc-get 'header:copyright props #f))
(translation (chain-assoc-get 'header:translation props #f))
(pronunciation (chain-assoc-get 'header:pronunciation props #f))
(year_text (if (string? (car poet-and-composers)) #f (chain-assoc-get 'header:year_text props #f)))
(year_melody (if (string? (car poet-and-composers)) #f (chain-assoc-get 'header:year_melody props #f))))
(markup
#: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))
#:override (cons 'songinfo:composer
(if (and composer (not (and (string? composer) (string-null? composer)))) composer #f))
#:override (cons 'songinfo:copyright
(if (and copyright (not (and (string? copyright) (string-null? copyright)))) copyright #f))
#:override (cons 'songinfo:infotext
(if (and infotext (not (and (string? infotext) (string-null? infotext)))) infotext #f))
#:override (cons 'songinfo:translation
(if (and translation (not (and (string? translation) (string-null? translation)))) translation #f))
#:override (cons 'songinfo:pronunciation
(if (and pronunciation (not (and (string? pronunciation) (string-null? pronunciation)))) pronunciation #f))
#:override (cons 'songinfo:year_text
(if (and year_text (not (and (string? year_text) (string-null? year_text)))) year_text #f))
#:override (cons 'songinfo:year_melody
(if (and year_melody (not (and (string? year_melody) (string-null? year_melody)))) year_melody #f))
#:override '(baseline-skip . 3.0)
#:fontsize songInfoFontSize
#:sans
(ly:output-def-lookup layout 'songinfoMarkup)
)))
(make-null-markup)))
)
#(define-markup-command (print-pagenumber layout props)()
(let ((label (chain-assoc-get 'header:myindexlabel props #f)))
(interpret-markup layout props
(markup #:large #:bold
(if label
(make-custom-page-number-markup label (chain-assoc-get 'page:page-number props 0))
(make-fromproperty-markup 'page:page-number-string)
)
))))
#(define-markup-command (fractional-line-width layout props arg)(markup?)
(interpret-markup layout props
(make-override-markup
`(line-width . ,(* (chain-assoc-get 'header:songinfo-size-factor props songInfoLineWidthFraction) (ly:output-def-lookup layout 'line-width)))
arg)))
\paper {
print-first-page-number = ##t
first-page-number = #0
oddFooterMarkup = \markup {
\fill-line {
\line { \null }
\line { \general-align #Y #DOWN \fractional-line-width \print-songinfo }
\line { \if \should-print-page-number \print-pagenumber }
}
}
evenFooterMarkup = \markup {
\fill-line {
\line { \if \should-print-page-number \print-pagenumber }
\line { \general-align #Y #DOWN \fractional-line-width \print-songinfo }
\line { \null }
}
}
}