neues System für Autorenangaben

This commit is contained in:
tux
2023-12-30 20:07:57 +01:00
parent 4f43791541
commit f5d5e1b020
4 changed files with 72 additions and 54 deletions

View File

@ -5,36 +5,59 @@
(assoc-ref song key)
(ly:warning (ly:format "song with id ~a not found" songId)))))
(define (format-author authorId)
(define (format-author authorId noDetails)
(let ((author (if (defined? 'AUTHOR_DATA) (assoc-ref AUTHOR_DATA authorId) #f)))
(if author
(markup
#:override (cons 'author:name (assoc-ref author "name"))
#:override (cons 'author:trail_name (assoc-ref author "trail_name"))
#:override (cons 'author:birth_year (assoc-ref author "birth_year"))
#:override (cons 'author:death_year (assoc-ref author "death_year"))
#:override (cons 'author:organization (assoc-ref author "organization"))
(ly:output-def-lookup layout 'authorMarkup))
((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")
)
(ly:warning (ly:format "author with id ~a not found" authorId)))))
(define (format-poet poetId)
(markup #:override (cons 'author (format-author poetId)) (ly:output-def-lookup layout 'poetMarkup)))
(string-append (ly:output-def-lookup layout 'poetPrefix) " " (format-author poetId #f)))
(define (format-composer composerId)
(markup #:override (cons 'author (format-author composerId)) (ly:output-def-lookup layout 'composerMarkup)))
(string-append (ly:output-def-lookup layout 'composerPrefix) " " (format-author composerId #f)))
(define (format-poet-and-composer authorId)
(markup #:override (cons 'author (format-author authorId)) (ly:output-def-lookup layout 'poetAndComposerEqualMarkup)))
(string-append (ly:output-def-lookup layout 'poetAndComposerEqualPrefix) " " (format-author authorId #f)))
(define (find-authors-by authorType authors)
(filter-map (lambda (authordata) (if (member authorType authordata) (car authordata) #f)) authors)
)
(define (poet-and-composer-from-authors authors)
(if authors
(let* (
(poetIds (find-authors-by 'text authors))
(composerIds (find-authors-by 'melody authors))
(poets (map (lambda (poetId) (format-author poetId #f)) poetIds))
(composers (map (lambda (composerId) (format-author composerId (member composerId poetIds))) composerIds)))
(if (equal? poetIds composerIds)
(list (string-append (ly:output-def-lookup layout 'poetAndComposerEqualPrefix) " " (string-join poets ", ")) #f)
(list
(string-append (ly:output-def-lookup layout 'poetPrefix) " " (string-join poets ", "))
(string-append (ly:output-def-lookup layout 'composerPrefix) " " (string-join composers ", ")))))
(list #f #f)
)
)
(interpret-markup layout props
(if (chain-assoc-get 'page:is-bookpart-last-page props #f)
(let* ((songId (chain-assoc-get 'header:songId 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)) #f)))
(composer (chain-assoc-get 'header:composer props (if (and composerId (not poet-and-composer-same)) (format-composer composerId) #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))