tux
286779fdac
* write that as yaml file next to the other outputs * extract lyrics * makes chordpro export work in songbooks * more metadata for chordpro export
551 lines
28 KiB
LilyPond
551 lines
28 KiB
LilyPond
%%% Extrahiert Informationen aus einem ly:music-Objekt und liefert eine alist
|
|
%%% mit String-Werten zurueck (z.B. ((time . "4/4") (key . "d minor"))).
|
|
%%% Benoetigt LilyPond >= 2.26.
|
|
|
|
%% note-name->lily-string liegt im Modul (lily display-lily).
|
|
#(use-modules (lily display-lily))
|
|
|
|
#(begin
|
|
|
|
;; --- Taktangabe --------------------------------------------------------
|
|
|
|
;; Numerator einer Taktangabe kann eine Zahl oder eine Liste sein.
|
|
(define (numerator->string num)
|
|
(if (list? num)
|
|
(string-join (map number->string num) "+")
|
|
(number->string num)))
|
|
|
|
;; Ein einzelner Bruch ist ein Paar (numerator . denominator), der
|
|
;; Numerator eine Zahl oder eine Liste (z.B. 3+3/8).
|
|
(define (fraction->string frac)
|
|
(string-append (numerator->string (car frac)) "/"
|
|
(number->string (cdr frac))))
|
|
|
|
;; Liefert die Taktangabe als String (z.B. "4/4", "3+3/8" oder
|
|
;; "3+3/8 + 2/8") oder #f. time-signature ist ein Bruch oder bei
|
|
;; zusammengesetzten Taktarten (\timeAbbrev, \compoundMeter) eine
|
|
;; Liste von Bruechen.
|
|
(define (time-music->string m)
|
|
(let ((ts (ly:music-property m 'time-signature)))
|
|
(and (pair? ts)
|
|
(if (number? (cdr ts))
|
|
(fraction->string ts)
|
|
(string-join (map fraction->string ts) " + ")))))
|
|
|
|
;; --- Tempo ---------------------------------------------------------------
|
|
|
|
;; Liefert die Tempoangabe als String (z.B. "4 = 130", "4. = 60-70",
|
|
;; "Allegro" oder "Allegro (4 = 130)") oder #f.
|
|
(define (tempo-music->string m)
|
|
(let* ((unit (ly:music-property m 'tempo-unit))
|
|
(count (ly:music-property m 'metronome-count))
|
|
(text (ly:music-property m 'text))
|
|
(unit-s (and (ly:duration? unit)
|
|
(string-append
|
|
(number->string (expt 2 (ly:duration-log unit)))
|
|
(make-string (ly:duration-dot-count unit) #\.))))
|
|
(count-s (cond ((number? count) (number->string count))
|
|
((pair? count) (ly:format "~a-~a" (car count) (cdr count)))
|
|
(else #f)))
|
|
(metronome-s (and unit-s count-s (string-append unit-s " = " count-s)))
|
|
(text-s (and (markup? text) (markup->string text))))
|
|
(cond
|
|
((and text-s metronome-s) (string-append text-s " (" metronome-s ")"))
|
|
(metronome-s metronome-s)
|
|
(text-s text-s)
|
|
(else #f))))
|
|
|
|
;; --- Tonart ------------------------------------------------------------
|
|
|
|
;; Liefert die Tonart als String (z.B. "d minor" oder "c major") oder #f.
|
|
;; Vorgehen wie in LilyPonds eigenem \displayMusic (define-music-display-
|
|
;; methods.scm): pitch-alist nach c zuruecktransponieren und mit den
|
|
;; bekannten Modus-Definitionen vergleichen. note-name->lily-string liefert
|
|
;; den Grundton in der aktuell eingestellten Notensprache.
|
|
(define (key-music->string m)
|
|
(let ((tonic (ly:music-property m 'tonic))
|
|
(alist (ly:music-property m 'pitch-alist)))
|
|
(and (ly:pitch? tonic) (pair? alist)
|
|
(let* ((c-alist (ly:transpose-key-alist alist (- tonic)))
|
|
(mode (any (lambda (mode)
|
|
(and (equal? (ly:parser-lookup mode) c-alist)
|
|
(symbol->string mode)))
|
|
'(major minor))))
|
|
(and mode
|
|
(string-append (symbol->string (note-name->lily-string tonic))
|
|
" " mode))))))
|
|
|
|
;; --- Header-Metadaten ----------------------------------------------------
|
|
|
|
;; Header-Felder, die eigentlich Layoutsachen sind (gehoerten nach paper)
|
|
;; und deshalb nicht mit exportiert werden.
|
|
(define ignored-header-fields
|
|
'(titlesize titletopspace tagline between-poet-and-composer-markup))
|
|
|
|
;; categories ist im Header ein String mit Leerzeichen ("trist satz")
|
|
;; und wird als Liste von Woertern exportiert.
|
|
(define (header-value key value)
|
|
(if (and (eq? key 'categories) (string? value))
|
|
(string-tokenize value)
|
|
value))
|
|
|
|
;; Nimmt einen Bookpart entgegen (wie HEADER aus pool_bottom.ily) und
|
|
;; liefert dessen Header-Felder als alist, z.B.
|
|
;; ((title . "Ako umram") (authors . (("..." text melody))) ...).
|
|
;; Die Werte bleiben unveraendert, wie sie im \header definiert wurden
|
|
;; (Strings, Listen, Markups ...).
|
|
(define (bookpart->header-alist bookpart)
|
|
(let ((header (ly:book-header bookpart)))
|
|
(if (module? header)
|
|
(sort
|
|
(filter-map (lambda (entry)
|
|
(and (variable-bound? (cdr entry))
|
|
(not (memq (car entry) ignored-header-fields))
|
|
(cons (car entry)
|
|
(header-value (car entry)
|
|
(variable-ref (cdr entry))))))
|
|
(module-map cons header))
|
|
(lambda (a b)
|
|
(string<? (symbol->string (car a))
|
|
(symbol->string (car b)))))
|
|
'())))
|
|
|
|
;; --- Lyrics --------------------------------------------------------------
|
|
|
|
;; Silbentext (String oder Markup) als String. Eine Tilde verbindet als
|
|
;; Lyric-Bindebogen zwei Woerter auf einer Note und wird zum Leerzeichen.
|
|
(define (syllable->string text)
|
|
(let ((s (cond ((string? text) text)
|
|
((markup? text) (markup->string text))
|
|
(else ""))))
|
|
(string-map (lambda (c) (if (char=? c #\~) #\space c)) s)))
|
|
|
|
;; Stanza-Beschriftung, wie sie gedruckt wuerde; vgl. handle-stanza-numbers
|
|
;; bzw. refMarkupFormatter/bridgeMarkupFormatter in
|
|
;; basic_format_and_style_settings.ily. text ist ein direkt per
|
|
;; \set stanza = "..." gesetzter Wert und gewinnt. Mit roman? werden die
|
|
;; Nummern roemisch formatiert (\romanStanza, z.B. fremdsprachige
|
|
;; Originalstrophen).
|
|
(define (stanza-label type numbers text roman?)
|
|
(define (number->label n)
|
|
(if roman? (format #f "~@r" n) n))
|
|
(define (joined-numbers)
|
|
(string-join (map (lambda (n) (ly:format "~a" (number->label n))) numbers)
|
|
", "))
|
|
(define (formatted plain with-numbers)
|
|
(if (null? numbers)
|
|
(ly:parser-lookup plain)
|
|
(ly:format (ly:parser-lookup with-numbers) (joined-numbers))))
|
|
(cond
|
|
(text text)
|
|
((eq? type 'ref) (formatted 'refString 'refStringWithNumbers))
|
|
((eq? type 'bridge) (formatted 'bridgeString 'bridgeStringWithNumbers))
|
|
((pair? numbers)
|
|
(string-join
|
|
(map (lambda (n)
|
|
(format #f (ly:parser-lookup 'stanzaFormat) (number->label n)))
|
|
numbers)
|
|
", "))
|
|
(else "")))
|
|
|
|
;; Wandelt ein Lyrics-Music-Objekt (eine Zeile aus \addlyrics bzw. das
|
|
;; Argument von \chordlyrics) in eine Liste von Eintraegen der Form
|
|
;; (marked? nummern . ((stanza . "1.") (type . verse) (text . "Auf die ...")))
|
|
;; Silben werden an HyphenEvents wieder zu Woertern zusammengesetzt.
|
|
;; Strophengrenzen ergeben sich aus den StanzaNumber-Overrides von
|
|
;; #(stanza n), \ref und \bridge sowie aus \set stanza = "...".
|
|
;; marked? ist #f fuer Fortsetzungsfragmente: Abschnitte ohne Marker oder
|
|
;; mit dem Zeilenumbruch-Marker \set stanza = "-" (right-/leftHyphen).
|
|
;; \set stanza mit Markup-Wert (Wiederholungszeichen, "D.S." usw.) ist
|
|
;; reine Dekoration mitten im Vers und beginnt keine neue Strophe.
|
|
(define (lyric-line->stanzas lyrics)
|
|
(let ((stanzas '()) ; fertige Eintraege, rueckwaerts
|
|
(words '()) ; fertige Woerter der aktuellen Strophe, rueckwaerts
|
|
(word "") ; offene Silbenkette
|
|
(type #f) ; 'verse / 'ref / 'bridge
|
|
(numbers '()) ; Strophennummern
|
|
(set-label #f) ; direkt gesetztes \set stanza = "..."
|
|
(roman #f) ; \romanStanza: Nummern roemisch formatieren
|
|
(pending-override #f) ; \override-stanza vor dem naechsten Marker
|
|
(override-numbers #f)) ; gedruckte Nummern der aktuellen Strophe
|
|
(define (flush-word!)
|
|
(unless (string-null? word)
|
|
(set! words (cons word words))
|
|
(set! word "")))
|
|
(define (flush-stanza!)
|
|
(flush-word!)
|
|
(when (or type set-label (pair? words))
|
|
(let ((display-numbers (or override-numbers numbers)))
|
|
(set! stanzas
|
|
(cons (cons* (if (or type (and set-label (not (string=? set-label "-")))) #t #f)
|
|
display-numbers
|
|
(list (cons 'stanza (stanza-label type display-numbers set-label roman))
|
|
(cons 'type (or type 'verse))
|
|
(cons 'text (string-join (reverse words) " "))))
|
|
stanzas)))
|
|
(set! words '())
|
|
(set! type #f)
|
|
(set! numbers '())
|
|
(set! set-label #f)
|
|
(set! override-numbers #f)))
|
|
;; Ein neuer Marker beendet die laufende Strophe, sobald schon Text da ist.
|
|
(define (marker!)
|
|
(when (or (pair? words) (not (string-null? word)))
|
|
(flush-stanza!)))
|
|
(define (handle-lyric-event m)
|
|
(let ((s (syllable->string (ly:music-property m 'text)))
|
|
(hyphen? (any (lambda (a)
|
|
(eq? (ly:music-property a 'name) 'HyphenEvent))
|
|
(ly:music-property m 'articulations '()))))
|
|
;; "_"-Skips (Melisma-Platzhalter) kommen als " " an und werden
|
|
;; ignoriert; ein an einem Trennstrich offenes Wort ("ru -- _ hig")
|
|
;; laeuft darueber weiter.
|
|
(unless (string-null? (string-trim-both s))
|
|
(set! word (string-append word s))
|
|
(unless hyphen? (flush-word!)))))
|
|
(define (handle-override m)
|
|
(when (eq? (ly:music-property m 'symbol) 'StanzaNumber)
|
|
(let ((path (ly:music-property m 'grob-property-path))
|
|
(value (ly:music-property m 'grob-value)))
|
|
(cond
|
|
((equal? path '(details custom-stanza-type))
|
|
(marker!)
|
|
(set! type value)
|
|
;; \override-stanza wirkt (\once) auf den naechsten Marker
|
|
(set! override-numbers pending-override)
|
|
(set! pending-override #f))
|
|
((equal? path '(details custom-stanza-numbers))
|
|
(marker!)
|
|
(set! numbers (if (list? value) value (list value))))
|
|
((equal? path '(details custom-stanzanumber-override))
|
|
(set! pending-override (if (list? value) value (list value))))
|
|
((equal? path '(style))
|
|
(set! roman (eq? value 'roman)))))))
|
|
(define (handle-set m)
|
|
(let ((value (ly:music-property m 'value)))
|
|
;; Nur String-Werte; Markups (Wiederholungszeichen etc.) sind
|
|
;; Dekoration mitten im Vers und keine Strophengrenze.
|
|
(when (and (eq? (ly:music-property m 'symbol) 'stanza)
|
|
(string? value))
|
|
(marker!)
|
|
(set! set-label value))))
|
|
(define (walk m)
|
|
(case (ly:music-property m 'name)
|
|
((LyricEvent) (handle-lyric-event m))
|
|
((OverrideProperty) (handle-override m))
|
|
((PropertySet) (handle-set m))
|
|
(else
|
|
(let ((element (ly:music-property m 'element)))
|
|
(if (ly:music? element) (walk element))
|
|
(for-each (lambda (e) (if (ly:music? e) (walk e)))
|
|
(ly:music-property m 'elements))))))
|
|
(walk lyrics)
|
|
(flush-stanza!)
|
|
(merge-reprinted (reverse stanzas))))
|
|
|
|
;; Beim Zeilenumbruch im Notenbild wird die Strophennummer manchmal erneut
|
|
;; gedruckt (z.B. \firstVerseB #(stanza 1) \firstVerseC). Ein Marker
|
|
;; direkt nach einer Strophe mit gleicher Kennung oder deren
|
|
;; Nummern-Obermenge (#(stanza 2 3) nach Strophe 2) setzt diese fort,
|
|
;; statt eine neue Strophe zu beginnen.
|
|
(define (merge-reprinted entries)
|
|
(let loop ((remaining entries) (acc '()))
|
|
(if (null? remaining)
|
|
(reverse acc)
|
|
(let ((entry (car remaining)))
|
|
(if (and (pair? acc)
|
|
(car entry) ; aktueller Eintrag markiert
|
|
(car (car acc)) ; vorheriger Eintrag markiert
|
|
(let* ((prev (car acc))
|
|
(prev-alist (cddr prev))
|
|
(alist (cddr entry))
|
|
(prev-numbers (cadr prev))
|
|
(prev-label (assq-ref prev-alist 'stanza)))
|
|
(or (and (not (string-null? prev-label))
|
|
(string=? prev-label (assq-ref alist 'stanza)))
|
|
(and (eq? (assq-ref prev-alist 'type)
|
|
(assq-ref alist 'type))
|
|
(pair? prev-numbers)
|
|
(every (lambda (n) (member n (cadr entry)))
|
|
prev-numbers)))))
|
|
(begin
|
|
(append-fragment-text! (cddr (car acc)) (cddr entry))
|
|
(loop (cdr remaining) acc))
|
|
(loop (cdr remaining) (cons entry acc)))))))
|
|
|
|
;; Haengt den Text eines Fortsetzungsfragments an eine Strophe an.
|
|
(define (append-fragment-text! target fragment)
|
|
(let ((target-cell (assq 'text target))
|
|
(fragment-text (assq-ref fragment 'text)))
|
|
(unless (string-null? fragment-text)
|
|
(set-cdr! target-cell
|
|
(if (string-null? (cdr target-cell))
|
|
fragment-text
|
|
(string-append (cdr target-cell) " " fragment-text))))))
|
|
|
|
;; Fuegt die Strophen-Eintraege mehrerer Lyric-Zeilen (Ergebnisse von
|
|
;; lyric-line->stanzas) zu einer flachen Strophenliste zusammen. Manche
|
|
;; Lieder verteilen eine Strophe auf mehrere Zeilen unter den Noten
|
|
;; (Fragmente mit \set stanza = "-" bzw. ohne Marker): Fortsetzungen
|
|
;; werden innerhalb einer Zeile an die vorhergehende markierte Strophe
|
|
;; angehaengt; Zeilen ganz ohne markierte Strophen positionsweise an die
|
|
;; markierten Strophen der letzten Zeile, die welche hatte.
|
|
(define (merge-lyric-lines lines)
|
|
(let ((result '()) ; fertige Strophen-alists, rueckwaerts
|
|
(last-marked '())) ; markierte alists der letzten markierten Zeile
|
|
(for-each
|
|
(lambda (line)
|
|
(let ((line-marked (filter-map (lambda (e) (and (car e) (cddr e))) line)))
|
|
(if (and (null? line-marked) (pair? last-marked))
|
|
;; Zeile nur aus Fortsetzungen: k-tes Fragment an k-te
|
|
;; markierte Strophe der Vorzeile, Ueberzaehlige an deren letzte.
|
|
(let loop ((entries line) (targets last-marked))
|
|
(when (pair? entries)
|
|
(append-fragment-text! (car targets) (cddar entries))
|
|
(loop (cdr entries)
|
|
(if (null? (cdr targets)) targets (cdr targets)))))
|
|
;; Zeile mit markierten Strophen (oder erste Zeile ueberhaupt):
|
|
;; Fortsetzungen an die vorhergehende Strophe der Zeile.
|
|
(begin
|
|
(let loop ((entries line)
|
|
(prev (if (pair? last-marked) (last last-marked) #f)))
|
|
(when (pair? entries)
|
|
(let ((marked? (caar entries))
|
|
(stanza-alist (cddar entries)))
|
|
(if (or marked? (not prev))
|
|
(begin
|
|
(set! result (cons stanza-alist result))
|
|
(loop (cdr entries) stanza-alist))
|
|
(begin
|
|
(append-fragment-text! prev stanza-alist)
|
|
(loop (cdr entries) prev))))))
|
|
(when (pair? line-marked)
|
|
(set! last-marked line-marked))))))
|
|
lines)
|
|
(reverse result)))
|
|
|
|
;; Gruppiert alle LyricCombineMusic-Objekte im music-Baum nach ihrer
|
|
;; Stimme (associated-context, das \addlyrics/\lyricsto zuweisen).
|
|
;; Liefert eine Liste von Gruppen (je eine Liste von Lyrics-Music-
|
|
;; Objekten) in der Reihenfolge, in der die Stimmen zuerst auftauchen.
|
|
(define (voice-groups music)
|
|
(let* ((combines (extract-named-music music 'LyricCombineMusic))
|
|
(contexts (delete-duplicates
|
|
(map (lambda (c) (ly:music-property c 'associated-context))
|
|
combines))))
|
|
(map (lambda (ctx)
|
|
(map (lambda (c) (ly:music-property c 'element))
|
|
(filter (lambda (c)
|
|
(equal? (ly:music-property c 'associated-context) ctx))
|
|
combines)))
|
|
contexts)))
|
|
|
|
;; Liefert die Strophen aller Stimmen unter den Noten, die selbst echte
|
|
;; Strophen/Refrains/Bridges tragen (mindestens einen markierten
|
|
;; Abschnitt haben, vgl. lyric-line->stanzas) -- filtert damit rein
|
|
;; dekorative Gegen- oder Echostimmen heraus (z.B. wiederholte
|
|
;; Lautmalerei ohne eigene Strophennummer). "Die erste Stimme im
|
|
;; Dokument" ist dafuer kein verlaessliches Kriterium: welche Stimme
|
|
;; die Hauptmelodie mit dem vollstaendigen Strophentext singt, wechselt
|
|
;; von Lied zu Lied (mal Stimme 1, mal 2, je nach Satz).
|
|
;; Qualifizierende Stimmen werden zusammengefuehrt (verschiedene
|
|
;; Sprachfassungen tragen z.B. beide eigene Strophen); dabei bildet die
|
|
;; Stimme mit den meisten eigenen Strophen ('verse, nicht Ref/Bridge)
|
|
;; das Rueckgrat, in das die anderen einsortiert werden -- sonst wuerde
|
|
;; ein von mehreren Stimmen gemeinsam gesungener Refrain, der im
|
|
;; Dokument vor der eigentlichen Strophe auftaucht, deren Platz vor der
|
|
;; Strophe 1 belegen.
|
|
(define (main-voice-lyrics music)
|
|
(define (verse-count stanzas)
|
|
(count (lambda (e) (eq? (assq-ref e 'type) 'verse)) stanzas))
|
|
(define (any-marked? lines) (any (lambda (line) (any car line)) lines))
|
|
(let* ((groups (map (lambda (group) (map lyric-line->stanzas group))
|
|
(voice-groups music)))
|
|
(with-marks (filter any-marked? groups))
|
|
;; Der Ausschluss unmarkierter Stimmen lohnt nur, wenn es
|
|
;; ueberhaupt eine ALTERNATIVE gibt: hat KEINE Stimme einen
|
|
;; echten Strophenmarker, gibt es kein "Rueckgrat" zum
|
|
;; Einsortieren -- dann wie frueher nur die erste Stimme nehmen
|
|
;; (sonst wuerden z.B. mehrere Satzstimmen mit identischem,
|
|
;; unmarkiertem Text ihren Kehrreim mehrfach liefern, weil sich
|
|
;; unmarkierte Eintraege ohne Strophennummer nicht als Duplikat
|
|
;; erkennen lassen). Nur EINE Stimme insgesamt ist ein
|
|
;; Sonderfall davon (erste = einzige).
|
|
(qualifying (cond
|
|
((pair? with-marks) with-marks)
|
|
((pair? groups) (list (car groups)))
|
|
(else '())))
|
|
(merged-per-group (map merge-lyric-lines qualifying))
|
|
(ranked (sort (iota (length merged-per-group))
|
|
(lambda (a b) (> (verse-count (list-ref merged-per-group a))
|
|
(verse-count (list-ref merged-per-group b)))))))
|
|
(fold (lambda (i acc) (add-missing-stanzas acc (list-ref merged-per-group i)))
|
|
'() ranked)))
|
|
|
|
;; --- Textseiten-Strophen aus dem Render-Collector ------------------------
|
|
|
|
;; Liest die Strophen der Textseiten aus dem per-Song-Store (chordpro.ily),
|
|
;; den der ChordPro_score_collector beim Rendern der \chordlyrics-Scores
|
|
;; fuellt. Dort ist Tag-Filterung, \override-stanza usw. bereits von
|
|
;; LilyPond selbst entschieden -- unsichtbare Verse tauchen gar nicht
|
|
;; erst auf. Die Dokumentreihenfolge liefert
|
|
;; chordpro-song-ordered-verse-indices (die Interpretation laeuft
|
|
;; rueckwaerts und bei mehrspaltigen group-verses verschraenkt).
|
|
;; Liefert Eintraege wie lyric-line->stanzas:
|
|
;; ((stanza . "2.") (type . verse) (text . "Die Haeuser ..."))
|
|
(define (collector-song->stanzas song)
|
|
;; Silben eines Verses in Sammelreihenfolge; Eintrag: (moment text hyphen? idx)
|
|
(define (verse-syllables idx)
|
|
(reverse (filter (lambda (s) (= (cadddr s) idx))
|
|
(chordpro-song-syllables song))))
|
|
;; Gedruckte Labels koennen Wiederholungszeichen tragen ("2.𝄆") --
|
|
;; die gehoeren nicht ins Label.
|
|
(define (clean-label s)
|
|
(string-trim-both
|
|
(string-delete (lambda (c) (memv c '(#\𝄆 #\𝄇))) s)))
|
|
;; Silben zu Woertern: Trennstriche verbinden, "_"-Extender (kommen als
|
|
;; Whitespace an) werden ueberlaufen, ohne das offene Wort zu schliessen.
|
|
(define (syllables->text syls)
|
|
(let loop ((rest syls) (word "") (words '()))
|
|
(if (null? rest)
|
|
(string-join
|
|
(reverse (if (string-null? word) words (cons word words)))
|
|
" ")
|
|
(let* ((s (syllable->string (cadr (car rest))))
|
|
(hyphen? (caddr (car rest))))
|
|
(if (string-null? (string-trim-both s))
|
|
(loop (cdr rest) word words)
|
|
(if hyphen?
|
|
(loop (cdr rest) (string-append word s) words)
|
|
(loop (cdr rest) ""
|
|
(cons (string-append word s) words))))))))
|
|
(filter-map
|
|
(lambda (idx)
|
|
(let ((syls (verse-syllables idx))
|
|
(entry (assoc idx (chordpro-song-stanza-numbers song))))
|
|
(and (pair? syls)
|
|
(list (cons 'stanza (clean-label
|
|
(or (and entry (cadr entry)) "")))
|
|
(cons 'type (or (and entry (caddr entry)) 'verse))
|
|
(cons 'text (syllables->text syls))))))
|
|
(chordpro-song-ordered-verse-indices song)))
|
|
|
|
;; Dieselbe Strophe? Gleiche Kennung allein reicht nicht: zweisprachige
|
|
;; Lieder nutzen dieselben Nummern fuer Uebersetzung und Original. Die
|
|
;; Texte muessen sich auch aehneln (mindestens die Haelfte der Woerter
|
|
;; der kuerzeren Fassung kommt in der laengeren vor).
|
|
(define (same-stanza-text? a b)
|
|
(define (word-list s)
|
|
(map string-downcase (string-tokenize s char-set:letter)))
|
|
(let* ((wa (word-list a))
|
|
(wb (word-list b))
|
|
(shorter (if (<= (length wa) (length wb)) wa wb))
|
|
(longer (if (<= (length wa) (length wb)) wb wa)))
|
|
(or (null? shorter)
|
|
(>= (count (lambda (w) (member w longer)) shorter)
|
|
(/ (length shorter) 2)))))
|
|
|
|
;; Wie merge-stanza-lists, aber bei Konflikt gewinnt BASE statt der
|
|
;; einzumischenden Liste: fuer das Zusammenfuehren mehrerer Hauptstimmen-
|
|
;; Kandidaten (main-voice-lyrics), wo die 'reichste' Stimme (meiste
|
|
;; eigene Strophen) die kanonische Fassung liefert und andere Stimmen
|
|
;; nur FEHLENDE Strophen ergaenzen duerfen -- z.B. wenn Sopran und Alt
|
|
;; beide "1." tragen, der Alt aber eine gekuerzte Textvariante singt
|
|
;; (vgl. Sieh_des_Herbstes_Geisteshelle: infotext "Strophenteile in
|
|
;; Klammern sind die Textvarianten im Alt").
|
|
(define (add-missing-stanzas base additional)
|
|
(fold
|
|
(lambda (entry acc)
|
|
(let* ((key (assq-ref entry 'stanza))
|
|
(found (and (not (string-null? key))
|
|
(not (string=? key "-"))
|
|
(find (lambda (e) (and (equal? (assq-ref e 'stanza) key)
|
|
(same-stanza-text?
|
|
(assq-ref e 'text)
|
|
(assq-ref entry 'text))))
|
|
acc))))
|
|
(if found acc (append acc (list entry)))))
|
|
base
|
|
additional))
|
|
|
|
;; Fuegt Musik- und Textseiten-Strophen zusammen: gleiche Strophen nur
|
|
;; einmal, wobei die Fassung aus den Textseiten die unter den Noten
|
|
;; ersetzt (dort steht meist die vollstaendige Fassung).
|
|
(define (merge-stanza-lists music-stanzas text-stanzas)
|
|
(let loop ((merged music-stanzas) (remaining text-stanzas))
|
|
(if (null? remaining)
|
|
merged
|
|
(let* ((entry (car remaining))
|
|
(key (assq-ref entry 'stanza))
|
|
(found (and (not (string-null? key))
|
|
(not (string=? key "-"))
|
|
(find (lambda (e)
|
|
(and (equal? (assq-ref e 'stanza) key)
|
|
(same-stanza-text?
|
|
(assq-ref e 'text)
|
|
(assq-ref entry 'text))))
|
|
merged))))
|
|
(loop (if found
|
|
(map (lambda (e) (if (eq? e found) entry e)) merged)
|
|
(append merged (list entry)))
|
|
(cdr remaining))))))
|
|
|
|
;; Extrahiert alle Strophen/Refrain/Bridge-Texte eines Liedes: die Strophen
|
|
;; unter den Noten aus music (die Hauptstimme(n), siehe main-voice-lyrics),
|
|
;; die Textstrophen aus dem Render-Collector-Store des Liedes (song, darf
|
|
;; #f sein).
|
|
(define (extract-lyrics music song)
|
|
(merge-stanza-lists
|
|
(main-voice-lyrics music)
|
|
(if song (collector-song->stanzas song) '())))
|
|
|
|
;; --- Hauptfunktion -----------------------------------------------------
|
|
|
|
;; Liefert das erste Music-Objekt mit gegebenem Namen (oder #f).
|
|
(define (first-named-music music music-name)
|
|
(let ((matches (extract-named-music music music-name)))
|
|
(and (pair? matches) (car matches))))
|
|
|
|
;; Nimmt ly:music entgegen und liefert eine alist mit String-Werten.
|
|
(define (music->data-alist music)
|
|
(let* ((time-m (first-named-music
|
|
music '(TimeSignatureMusic ReferenceTimeSignatureMusic)))
|
|
(key-m (first-named-music music 'KeyChangeEvent))
|
|
(tempo-m (first-named-music music 'TempoChangeEvent))
|
|
(time-s (and time-m (time-music->string time-m)))
|
|
(key-s (and key-m (key-music->string key-m)))
|
|
(tempo-s (and tempo-m (tempo-music->string tempo-m))))
|
|
(append
|
|
(if time-s (list (cons 'time time-s)) '())
|
|
(if key-s (list (cons 'key key-s)) '())
|
|
(if tempo-s (list (cons 'tempo tempo-s)) '()))))
|
|
|
|
;; song ist der per-Song-Store-Eintrag aus chordpro.ily (oder #f, wenn
|
|
;; keine Textseiten gerendert wurden) -- er liefert die Textseiten-
|
|
;; Strophen. Darf erst NACH dem Rendern der Textseiten aufgerufen
|
|
;; werden (delayed stencil), vorher ist der Store leer. song-id ist
|
|
;; der Liedname (Einzellied: Ausgabename; Buch: der bei \includeSong
|
|
;; angegebene Dateiname) und landet unter dem Key song_id.
|
|
(define (extract-song-data header music song song-id)
|
|
(let ((header-alist (bookpart->header-alist header))
|
|
(music-alist (music->data-alist music))
|
|
(lyrics-list (extract-lyrics music song)))
|
|
(append header-alist
|
|
(list (cons 'song_id song-id)
|
|
(cons 'musical music-alist)
|
|
(cons 'lyrics lyrics-list)))))
|
|
|
|
;; Unsichtbarer Stencil fuer die Einzellied-YAML: schreibt <key>.yml
|
|
;; per delay-stencil-evaluation erst bei der Ausgabe, wenn der
|
|
;; Render-Collector alle Textseiten-Strophen gesammelt hat. header und
|
|
;; music werden beim Anhaengen (Parse-Zeit in layout_bottom) gebunden.
|
|
(define (yaml-delayed-song-write key header music)
|
|
(ly:make-stencil
|
|
`(delay-stencil-evaluation
|
|
,(delay (begin
|
|
(scm->yml-file (string-append key ".yml")
|
|
(extract-song-data header music
|
|
(hash-ref chordpro-song-store key)
|
|
key))
|
|
empty-stencil))))))
|