Author SHA1 Message Date
tux 286779fdac extract meta data from lilypond compilation
* write that as yaml file next to the other outputs
* extract lyrics
* makes chordpro export work in songbooks
* more metadata for chordpro export
2026-07-12 23:11:36 +02:00
15 changed files with 2219 additions and 883 deletions

No files matched your search

+3 -4
View File
@@ -20,7 +20,8 @@
"scm" file-name-separator-string filename
)))))
(scm-load "resolve_inherits.scm")
(scm-load "yaml_parser.scm")))
(scm-load "yaml_parser.scm")
(scm-load "yaml_writer.scm")))
#(define (song-includes-data-path filename)
(string-join
@@ -33,14 +34,13 @@
#(define AUTHOR_DATA (if (defined? 'AUTHOR_DATA) AUTHOR_DATA (parse-yml-file (song-includes-data-path "authors.yml"))))
#(define SONG_DATA (if (defined? 'SONG_DATA) SONG_DATA (parse-yml-file (song-includes-data-path "songs.yml"))))
\include #(if (ly:version? < '(2 27 0)) "compat_lilypond_2_26.ily" "../void.ily")
\include "merge_rests_engraver_override.ily"
\include "basic_format_and_style_settings.ily"
\include "eps_file_from_song_dir.ily"
\include "embedded_songs.ily"
\include "title_with_category_images.ily"
\include "chord_settings.ily"
\include "chordpro.ily"
\include "data_extractor.ily"
\include "transposition.ily"
\include "markup_tag_groups_hack.ily"
\include "verses_with_chords.ily"
@@ -56,7 +56,6 @@ HEADER = {}
MUSIC = {}
TEXT = \markuplist {}
TEXT_PAGES = #f
EMBEDDED_SONGS = #'()
verseChords = {}
firstVoice = {}
@@ -58,7 +58,6 @@ generalLayout = \layout {
\RemoveEmptyStaves
\override VerticalAxisGroup.remove-first = ##t
\numericTimeSignature
rehearsalMarkFormatter = #format-mark-box-alphabet
\overrideTimeSignatureSettings
4/4 % timeSignatureFraction
1/4 % baseMomentFraction
@@ -91,22 +90,6 @@ generalLayout = \layout {
((custom-size (ly:output-def-lookup base-layout 'size #f)))
(if custom-size (layout-set-staff-size custom-size))))
% Scores in Markups (z.B. inline-score) kopieren ihr \layout schon beim Parsen,
% also bevor customized-layout greift. Deshalb nachträglich anpassen.
#(define (customize-embedded-score-layouts! obj)
(cond
((ly:score? obj)
(for-each
(lambda (def)
(let ((custom-size (ly:output-def-lookup def 'size #f))
(scope (ly:output-def-scope def)))
(if custom-size
(layout-set-absolute-staff-size-in-module scope (* custom-size (eval 'pt scope))))))
(ly:score-output-defs obj)))
((pair? obj)
(customize-embedded-score-layouts! (car obj))
(customize-embedded-score-layouts! (cdr obj)))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% kleine Helferlein:
@@ -155,83 +138,50 @@ romanStanza =
#(define-music-function (parser location) ()
#{ \override StanzaNumber.style = #'roman #})
#(define (number-or-number-list? x) (or (number? x) (number-list? x)))
% "1,4" -> (1 4); Einträge, die keine Zahl sind, bleiben Strings ("1b,2b" -> ("1b" "2b"))
#(define (stanza-numbers-from-string str)
(map (lambda (s) (or (string->number s) s))
(remove string-null? (map string-trim-both (string-split str #\,)))))
% Kein number? hier, sonst kann der Parser 1,4 nicht mehr als Liste lesen
#(define (stanza-numbers? x) (or (number-list? x) (string? x)))
override-stanza =
#(define-music-function (stanzanumbers) (number-or-number-list?)
#(define-music-function (parser location stanzanumbers) (number-list?)
#{
\once \override StanzaNumber.details.custom-stanzanumber-override = #(if (number? stanzanumbers) (list stanzanumbers) stanzanumbers)
\once \override StanzaNumber.details.custom-stanzanumber-override = #stanzanumbers
#}
)
#(define (romanize-stanza-numbers numbers style)
(if (eq? style 'roman)
(map (lambda (n) (if (number? n) (format #f "~@r" n) n)) numbers)
numbers))
#(define (handle-stanza-numbers context numbers number-formater)
(let* ((stanzanumbers (ly:assoc-get 'custom-stanzanumber-override (ly:assoc-get 'details (ly:context-grob-definition context 'StanzaNumber) '()) numbers))
(stanza-style (ly:assoc-get 'style (ly:context-grob-definition context 'StanzaNumber)))
(roman-format (lambda (stanzanumber) (format #f "~@r" stanzanumber))))
(ly:context-set-property! context 'stanza
(make-pad-left-markup 1
(number-formater
(if (eq? stanza-style 'roman)
(map roman-format stanzanumbers)
stanzanumbers))))))
#(define (format-stanza-numbers numbers style)
(string-join
(map (lambda (n) (format #f stanzaFormat n)) (romanize-stanza-numbers numbers style))
", "))
% Strophennummer, die erst beim Setzen aus den Eigenschaften des StanzaNumber-Grobs gebaut wird
% (details.custom-stanza-type, details.custom-stanza-numbers, style, details.custom-inline-text).
% So können \fstanza, \ref, \bridge und \repStartWithTag im selben Zeitschritt kombiniert werden.
#(define-markup-command (formatted-stanza layout props) ()
#:properties ((details '()) (style #f))
(let* ((realstanza (ly:assoc-get 'custom-realstanza details #f))
(type (ly:assoc-get 'custom-stanza-type details 'verse))
(numbers (ly:assoc-get 'custom-stanzanumber-override details
(ly:assoc-get 'custom-stanza-numbers details '())))
(inline-text (ly:assoc-get 'custom-inline-text details #f))
(inline-direction (ly:assoc-get 'custom-inline-direction details CENTER))
(rep-start (and inline-text (eqv? inline-direction LEFT)))
(roman-numbers (romanize-stanza-numbers numbers style))
(stanza-stencil
(and realstanza
(case type
((ref) ((ly:output-def-lookup layout 'refMarkupFormatter) layout props roman-numbers))
((bridge) ((ly:output-def-lookup layout 'bridgeMarkupFormatter) layout props roman-numbers))
(else (interpret-markup layout props (format-stanza-numbers numbers style))))))
(padded-stanza-stencil
(and stanza-stencil
(interpret-markup layout props (make-pad-left-markup 1 (make-stencil-markup stanza-stencil))))))
(if rep-start
(interpret-markup layout props
(make-concat-markup
(append
(if padded-stanza-stencil (list (make-stencil-markup padded-stanza-stencil) (make-hspace-markup 1)) '())
(list (make-override-markup '(font-series . normal) inline-text)))))
(or padded-stanza-stencil empty-stencil))))
#(define (formatted-stanza-music type stanzanumbers)
#(define (stanza . stanzanumbers)
#{
\once \override StanzaNumber.details.custom-realstanza = ##t % set this to signal that there is a real stanza and no repeat signs
\once \override StanzaNumber.details.custom-stanza-type = #type
\once \override StanzaNumber.details.custom-stanza-type = #'verse
\once \override StanzaNumber.details.custom-stanza-numbers = #stanzanumbers
\stanza \markup \formatted-stanza
#})
% \fstanza 1 -> "1."
% \fstanza 1,4 -> "1., 4." (nur im Notenmodus, z.B. \chordverse { \fstanza 1,4 } ...)
% \fstanza "1,4" -> "1., 4." (auch im \lyricmode, dort versteht LilyPond 1,4 nicht als Liste)
fstanza =
#(define-music-function (stanzanumbers) (stanza-numbers?)
(formatted-stanza-music 'verse
(if (string? stanzanumbers) (stanza-numbers-from-string stanzanumbers) stanzanumbers)))
\applyContext
#(lambda (context)
(handle-stanza-numbers context stanzanumbers
(lambda (numbers) (string-join (map (lambda (n) (format #f stanzaFormat n)) numbers) ", "))))
#}
)
ref =
#(define-music-function (stanzanumbers lyrics) ((number-list? (list)) ly:music?)
#{ \lyricmode {
#(formatted-stanza-music 'ref stanzanumbers)
\once \override StanzaNumber.details.custom-realstanza = ##t % set this to signal that there is a real stanza and no repeat signs
\once \override StanzaNumber.details.custom-stanza-type = #'ref
\once \override StanzaNumber.details.custom-stanza-numbers = #stanzanumbers
\applyContext
#(lambda (context)
(handle-stanza-numbers context stanzanumbers
(lambda (numbers)
(make-on-the-fly-markup
(lambda (layout props m)
((ly:output-def-lookup layout 'refMarkupFormatter) layout props numbers))
(make-null-markup)))))
#lyrics
}
#}
@@ -240,24 +190,43 @@ ref =
bridge =
#(define-music-function (stanzanumbers lyrics) ((number-list? (list)) ly:music?)
#{ \lyricmode {
#(formatted-stanza-music 'bridge stanzanumbers)
\once \override StanzaNumber.details.custom-realstanza = ##t % set this to signal that there is a real stanza and no repeat signs
\once \override StanzaNumber.details.custom-stanza-type = #'bridge
\once \override StanzaNumber.details.custom-stanza-numbers = #stanzanumbers
\applyContext
#(lambda (context)
(handle-stanza-numbers context stanzanumbers
(lambda (numbers)
(make-on-the-fly-markup
(lambda (layout props m)
((ly:output-def-lookup layout 'bridgeMarkupFormatter) layout props numbers))
(make-null-markup)))))
#lyrics
}
#}
)
% prints a repStart Sign as stanza if the tag 'repeats is kept.
% if there is a stanza set by \fstanza in the same moment, \formatted-stanza prints both.
% if there was a stanza already set by the stanza function with StanzaNumber.details.custom-realstanza = ##t we set that also as stanza.
% Sets custom-inline-text for ChordPro export so it can collect the repeat sign separately
repStartWithTag =
#(define-music-function () ()
#{ \lyricmode {
repStartWithTag = \lyricmode {
\tag #'repeats {
\once \override StanzaNumber.details.custom-inline-text = \repStart
\once \override StanzaNumber.details.custom-inline-direction = #LEFT
\stanza \markup \formatted-stanza
\applyContext
#(lambda (context)
(let ((lastStanza (ly:context-property context 'stanza))
(printLastStanza (ly:assoc-get 'custom-realstanza (ly:assoc-get 'details (ly:context-grob-definition context 'StanzaNumber) '()) #f))
(stanzaFontSeries (ly:assoc-get 'font-series (ly:context-grob-definition context 'StanzaNumber) 'normal)))
(ly:context-set-property! context 'stanza
(make-concat-markup
(if printLastStanza
(list (make-override-markup `(font-series . ,stanzaFontSeries) lastStanza) (make-hspace-markup 1) repStart)
(list repStart)
)))))
\once \override StanzaNumber.font-series = #'normal
}
}
} #})
repStopWithTag = \lyricmode {
\tag #'repeats {
@@ -265,19 +234,19 @@ repStopWithTag = \lyricmode {
\once \override StanzaNumber.details.custom-inline-direction = #RIGHT
\once \override StanzaNumber.font-series = #'normal
\once \override StanzaNumber.direction = 1
\stanza \markup { \pad-x-right #1 \repStop }
\set stanza = \markup { \pad-x-right #1 \repStop }
}
}
rightHyphen = \lyricmode {
\once \override StanzaNumber.font-series = #'normal
\once \override StanzaNumber.direction = 1
\stanza "-"
\set stanza = "-"
}
leftHyphen = \lyricmode {
\once \override StanzaNumber.font-series = #'normal
\stanza "-"
\set stanza = "-"
}
multiVerseSkips =
@@ -343,7 +312,7 @@ rufWithMarkup =
\lyricmode {
\once \override StanzaNumber.font-series = #'normal
\once \override StanzaNumber.direction = 1
\stanza #text
\set stanza = #text
}
#})
ruf =
+1 -1
View File
@@ -155,7 +155,7 @@ Ensure_first_chord_after_line_break_printed_engraver =
; the current chord handling implementation in lilypond uses 'begin-of-line-visible to mark repeated chords
(ly:grob-set-property! grob 'begin-of-line-visible #f))
(set! last-system-column-rank current-system-column-rank)
(item::enforce-musical-break-visibility grob)
(ly:chord-name::after-line-breaking grob)
)))))))
% If you add this engraver to ChordNames Context chords get only printed on chordchanges and not at newline.
File diff suppressed because it is too large. Load diff
@@ -1,11 +0,0 @@
% Abwärtskompatibilität zu LilyPond 2.26.
% Wird von all.ily nur eingebunden, wenn die laufende LilyPond-Version älter als 2.27 ist.
% Alles andere ist für die aktuelle 2.27 geschrieben.
% Ab 2.27 gibt es \stanza als Musikfunktion (StanzaEvent), in 2.26 nur die Kontext-Property stanza.
stanza =
#(define-music-function (text) (markup?)
(context-spec-music (make-property-set 'stanza text) 'Bottom))
% Ab 2.27 heißt ly:chord-name::after-line-breaking item::enforce-musical-break-visibility.
#(define item::enforce-musical-break-visibility ly:chord-name::after-line-breaking)
+550
View File
@@ -0,0 +1,550 @@
%%% 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))))))
-157
View File
@@ -1,157 +0,0 @@
%% Mehrere Lieder in einer Liederdatei (z.B. zwei Lieder auf einer Seite)
%%
%% Das erste Lied ist das Hauptlied (HEADER), alle weiteren werden als
%% eingebettete Lieder angemeldet. Eingebettete Lieder bekommen eigene
%% Eintraege im Inhaltsverzeichnis, in den Kategorie-, Autoren- und
%% Kapitelverzeichnissen, im PDF-Inhaltsverzeichnis, in der toc.csv und
%% eine eigene Liednummer. Im Footer steht die Songinfo des letzten
%% eingebetteten Lieds (abschaltbar mit footersong = ##f im HEADER bzw. mit
%% footersong = \andereslied umstellbar), die Songinfo des Hauptlieds wird
%% mit \songinfo-of selbst platziert.
%%
%% Beispiel:
%%
%% \include "../../lilypond-song-includes/liedbausteine/lied_a.ly"
%% liedA = \captureSong
%% \include "../../lilypond-song-includes/liedbausteine/lied_b.ly"
%% liedB = \captureSong
%%
%% TEXT = \markuplist {
%% \songinfo-of \liedA
%% \vspace #2
%% \embedded-song-title \liedB
%% \vspace #.5
%% \score { \songMusic \liedB \layout { \LAYOUT } }
%% \with-song \liedB {
%% \chordlyrics \secondVerse
%% }
%% }
%%
%% \restoreSong \liedA
%% \embedSong \liedB
%% \include "public_includes/layout_bottom.ily"
%%
%% \captureSong sichert den Header (basicSongInfo) und die Variablen aus
%% captured-song-variable-names, damit das naechste \include sie nicht
%% ueberschreibt. Das Ergebnis ist ein normales Header-Modul, es kann also
%% auch in \header { \liedA } verwendet werden.
%%
%% \restoreSong setzt basicSongInfo, HEADER und diese Variablen zurueck,
%% TEXT aber nicht. TEXT also vor \restoreSong schreiben, solange darin noch
%% Variablen des zuletzt eingebundenen Lieds (\secondVerse usw.) stehen.
%%
%% Ohne \with-song beziehen sich Strophen mit Akkorden auf das Hauptlied.
%%
%% Alle Verzeichniseintraege zeigen auf die erste Seite des Hauptlieds.
#(define captured-song-variable-names '(MUSIC global firstVoice verseChords))
#(define (song-variable song name)
(assq-ref (module-ref song 'captured-song-variables '()) name))
#(define (extract-and-check-vars-from-module headermodule varlist)
(let* ((headervars (if (module? headermodule) (hash-map->list cons (struct-ref headermodule 0)) '()))
(extract-var-and-check (lambda (headervar)
(let* ((variableref (assoc-ref headervars headervar))
(extracted (if variableref (variable-ref variableref) #f)))
(if (and extracted (not (and (string? extracted) (string-null? extracted)))) extracted #f)))))
(map (lambda (varsymbol)
(cons varsymbol (extract-var-and-check varsymbol))
) varlist)))
% Text des PDF-Lesezeichens eines Lieds, #f wenn es keins bekommt.
% Gleiche Regel wie in build-full-title.
#(define (song-pdf-bookmark-title headermodule)
(let* ((vars (extract-and-check-vars-from-module headermodule '(title starttext)))
(title (assq-ref vars 'title))
(starttext (assq-ref vars 'starttext))
(as-string (lambda (m) (if (markup? m) (markup->string m) ""))))
(cond ((and title starttext) (string-append (as-string starttext) " | " (as-string title)))
(title (as-string title))
(starttext (string-append (as-string starttext) " | "))
(else #f))))
#(define (embedded-song-list songs)
(if (list? songs) (filter module? songs) '()))
#(define (embedded-songs-of-header headermodule)
(if (module? headermodule)
(embedded-song-list (module-ref headermodule 'embeddedsongs '()))
'()))
% Ersetzt alle header:*-Properties durch die Felder aus headermodule, damit
% keine Felder des Hauptlieds in das andere Lied durchsickern.
#(define (header-module->props headermodule props)
(let ((header-key? (lambda (entry)
(and (pair? entry) (symbol? (car entry))
(string-prefix? "header:" (symbol->string (car entry)))))))
(cons
(map (lambda (kv) (cons (symbol-append 'header: (car kv)) (cdr kv)))
(ly:module->alist headermodule))
(map (lambda (alist) (remove header-key? alist)) props))))
captureSong =
#(define-scheme-function () ()
(let ((song (make-module)))
(ly:module-copy song basicSongInfo)
(module-define! song 'captured-song-variables
(filter-map
(lambda (name)
(let ((value (ly:parser-lookup name)))
(and (not (null? value)) (cons name value))))
captured-song-variable-names))
song))
% Stellt basicSongInfo, HEADER und die gesicherten Variablen eines Lieds
% wieder her, als waere es das zuletzt eingebundene.
restoreSong =
#(define-void-function (song) (module?)
(for-each
(lambda (kv) (ly:parser-define! (car kv) (cdr kv)))
(module-ref song 'captured-song-variables '()))
(ly:parser-define! 'basicSongInfo song)
(ly:parser-define! 'HEADER #{ \bookpart { \header { $song } } #}))
embedSong =
#(define-void-function (song) (module?)
(set! EMBEDDED_SONGS (append EMBEDDED_SONGS (list song))))
songMusic =
#(define-music-function (song) (module?)
(let ((music (song-variable song 'MUSIC)))
(if (ly:music? music) music (make-music 'SequentialMusic))))
% Strophen, \fromproperty #'header:... usw. beziehen sich innerhalb auf das
% angegebene Lied. Die Transposition des Hauptlieds wird nicht uebernommen.
#(define-markup-list-command (with-song layout props song args) (module? markup-list?)
(let* ((music-or-empty (lambda (name)
(let ((music (song-variable song name)))
(if (ly:music? music) music (make-music 'SequentialMusic)))))
(verseChords (music-or-empty 'verseChords))
(global (music-or-empty 'global))
(firstVoice (music-or-empty 'firstVoice)))
(interpret-markup-list layout
(prepend-alist-chain 'verse-chords #{ \chords { $verseChords } #}
(prepend-alist-chain 'verse-reference-voice #{ $global $firstVoice #}
(prepend-alist-chain 'transposition (cons #f #f)
(header-module->props song props))))
args)))
#(define-markup-command (songinfo-of layout props song) (module?)
(interpret-markup layout (header-module->props song props)
(make-fractional-line-width-markup (make-songinfo-content-markup))))
#(define-markup-command (embedded-song-title layout props song) (module?)
(interpret-markup layout (header-module->props song props)
(make-fill-line-markup (list (ly:output-def-lookup layout 'defaultTitleMarkup)))))
% PDF-Lesezeichen der eingebetteten Lieder, wird von build-full-title direkt
% nach dem Lesezeichen des Hauptlieds ausgegeben.
#(define-markup-command (embedded-songs-to-pdf-toc layout props) ()
(apply ly:stencil-add
(cons empty-stencil
(filter-map
(lambda (song)
(let ((bookmark (song-pdf-bookmark-title song)))
(and bookmark (make-pdf-toc-stencil bookmark 0))))
(embedded-song-list (chain-assoc-get 'header:embeddedsongs props '()))))))
+4 -19
View File
@@ -33,8 +33,7 @@
#(define (join-present items joiner)
(string-join (filter (lambda (item) (and (string? item) (not (string-null? (string-trim-both item))))) items) joiner))
% Songinfo aus den header:*-Properties, ohne Pruefung auf die letzte Seite.
#(define-markup-command (songinfo-content layout props) ()
#(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
@@ -132,6 +131,7 @@
)
(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))
@@ -167,25 +167,10 @@
#:fontsize songInfoFontSize
#:sans
(ly:output-def-lookup layout 'songinfoMarkup)
))))
)))
(make-null-markup)))
)
% Songinfo im Footer, nur auf der letzten Seite des Bookparts. Gibt es
% eingebettete Lieder (siehe embedded_songs.ily), steht hier die Songinfo des
% letzten eingebetteten Lieds, ausser im Header ist footersong gesetzt
% (##f = Hauptlied, oder ein mit \captureSong gesichertes Lied).
#(define-markup-command (print-songinfo layout props) ()
(if (chain-assoc-get 'page:is-bookpart-last-page props #f)
(let* ((footersong (chain-assoc-get 'header:footersong props 'auto))
(embedded (embedded-song-list (chain-assoc-get 'header:embeddedsongs props '())))
(song (if (eq? footersong 'auto)
(and (pair? embedded) (last embedded))
footersong)))
(interpret-markup layout
(if (module? song) (header-module->props song props) props)
(make-songinfo-content-markup)))
(interpret-markup layout props (make-null-markup))))
#(define-markup-command (print-pagenumber layout props)()
(let ((label (chain-assoc-get 'header:myindexlabel props #f)))
(interpret-markup layout props
+236 -131
View File
@@ -1,154 +1,259 @@
(use-modules (ice-9 rdelim) (ice-9 regex) (ice-9 pretty-print) (srfi srfi-1))
(use-modules (ice-9 rdelim) (ice-9 regex) (ice-9 receive) (srfi srfi-1))
;; YAML-Parser: liest eine Teilmenge von YAML (Block-Syntax, keine
;; Flow-Collections, keine Block-Skalare) in verschachtelte
;; alist/list-Strukturen. Gegenstück zu yaml_writer.scm.
;;
;; Ergebnisformat:
;; - Mapping -> alist mit String-Keys, Reihenfolge wie in der Datei
;; - Liste -> Liste (auch als "- key: value"-Inline-Mappings)
;; - Skalare -> String, Zahl, #t/#f, '() (null / {} / [])
;;
;; Skalar-Interpretation:
;; - unquoted und 'single-quoted' Werte werden interpretiert
;; (Zahl, true/false/null). Das Interpretieren von single-quoted
;; Werten ist Kompatibilitätsverhalten zum alten Parser:
;; authors.yml notiert Zahlen als '1898'.
;; - "double-quoted" Werte bleiben immer Strings; \\, \" und \n
;; werden entescaped (so schreibt sie der yaml_writer).
;; - Kommentare (#) werden nur außerhalb von Quotes entfernt und nur,
;; wenn ihnen ein Leerzeichen oder der Zeilenanfang vorausgeht.
;; Hauptparsingfunktion
(define (yml-file->scm filename)
;; Utility: Zeile einlesen
(define (read-lines filename)
;; --- Zeilen einlesen ------------------------------------------------
;; Anzahl führender Leerzeichen
(define (line-indent line)
(let loop ((i 0))
(if (and (< i (string-length line))
(char=? (string-ref line i) #\space))
(loop (+ i 1))
i)))
;; Liefert Items (indent . inhalt); Leerzeilen, reine Kommentarzeilen
;; und Dokumentmarker (--- / ...) werden übersprungen.
(define (read-items filename)
(call-with-input-file filename
(lambda (port)
(let loop ((lines '()))
(let loop ((items '()))
(let ((line (read-line port)))
(if (eof-object? line)
(reverse lines)
(let ((clean (string-trim line)))
(if (or (string=? clean "---") (string-null? clean))
(loop lines) ;; Ignoriere "---" oder leere Zeile
(loop (cons line lines))))))))))
(reverse items)
(let* ((line (if (string-suffix? "\r" line)
(string-drop-right line 1)
line))
(content (string-trim-both line)))
(if (or (string-null? content)
(string-prefix? "#" content)
(string=? content "---")
(string=? content "..."))
(loop items)
(loop (cons (cons (line-indent line) content)
items))))))))))
;; Einrückung bestimmen (Anzahl Leerzeichen am Anfang)
(define (line-indent line)
(let ((match (string-match "^ *" line)))
(if match
(match:end match) ; Anzahl der Leerzeichen = Position nach Leerzeichen
0))) ; Falls kein Match → 0
(define (item-indent item) (car item))
(define (item-content item) (cdr item))
;; Kommentar entfernen
(define (strip-comment line)
(let ((m (string-match "#.*" line)))
(if m
(string-trim-right (string-take line (match:start m)))
line)))
;; --- Skalare ----------------------------------------------------------
;; Hilfsfunktion: Whitespace entfernen
(define (clean-line line)
(string-trim (strip-comment line)))
;; Position des schließenden Double-Quotes ab start (oder #f);
;; Backslash escaped das Folgezeichen.
(define (closing-double-quote s start)
(let loop ((i start))
(cond ((>= i (string-length s)) #f)
((char=? (string-ref s i) #\\) (loop (+ i 2)))
((char=? (string-ref s i) #\") i)
(else (loop (+ i 1))))))
;; Ist Zeile leer (nach Entfernen von Kommentar & Whitespace)?
(define (blank-or-comment? line)
(string-null? (clean-line line)))
;; Position des schließenden Single-Quotes ab start (oder #f);
;; '' ist ein escaptes Quote.
(define (closing-single-quote s start)
(let loop ((i start))
(cond ((>= i (string-length s)) #f)
((char=? (string-ref s i) #\')
(if (and (< (+ i 1) (string-length s))
(char=? (string-ref s (+ i 1)) #\'))
(loop (+ i 2))
i))
(else (loop (+ i 1))))))
;; Skalare Werte interpretieren
(define (parse-scalar str)
(define (strip-quotes s)
;; \\ -> \, \" -> ", \n -> Zeilenumbruch
(define (unescape-double s)
(let loop ((chars (string->list s)) (acc '()))
(cond ((null? chars) (list->string (reverse acc)))
((and (char=? (car chars) #\\) (pair? (cdr chars)))
(loop (cddr chars)
(cons (if (char=? (cadr chars) #\n)
#\newline
(cadr chars))
acc)))
(else (loop (cdr chars) (cons (car chars) acc))))))
;; '' -> '
(define (unescape-single s)
(regexp-substitute/global #f "''" s 'pre "'" 'post))
;; Kommentar in einem unquoted Wert entfernen:
;; # zählt nur am Anfang oder nach Leerzeichen
(define (strip-plain-comment s)
(let loop ((i 0))
(cond ((>= i (string-length s)) s)
((and (char=? (string-ref s i) #\#)
(or (zero? i)
(char-whitespace? (string-ref s (- i 1)))))
(string-take s i))
(else (loop (+ i 1))))))
;; Unquoted/single-quoted Werte interpretieren
(define (interpret-plain s)
(cond
((and (string-prefix? "\"" s) (string-suffix? "\"" s))
(string-drop-right (string-drop s 1) 1))
((and (string-prefix? "'" s) (string-suffix? "'" s))
(string-drop-right (string-drop s 1) 1))
(else s)))
(let ((s (strip-quotes (string-trim str))))
(cond
((string=? s "{}") '()) ;; leere Map
((string=? s "[]") '()) ;; leere Liste
((string-match "^[0-9]+$" s) (string->number s))
((member s '("{}" "[]" "null")) '())
((string=? s "true") #t)
((string=? s "false") #f)
((string=? s "null") '())
(else s))))
((string-match "^-?[0-9]+(\\.[0-9]+)?$" s) (string->number s))
(else s)))
;; Hilfsfunktion: Zeilen mit gleicher oder höherer Einrückung sammeln
(define (take-indented lines min-indent)
(let loop ((ls lines) (acc '()))
(if (null? ls)
(reverse acc)
(let ((line (car ls)))
(if (or (blank-or-comment? line)
(>= (line-indent line) min-indent))
(loop (cdr ls) (cons line acc))
(reverse acc))))))
;; Hilfsfunktion: N Zeilen überspringen
(define (drop lst n)
(let loop ((l lst) (i n))
(if (or (zero? i) (null? l))
l
(loop (cdr l) (- i 1)))))
;; Listenparsing: Liest Zeilen mit `-` als Listeneinträge
(define (parse-list lines current-indent)
(let loop ((ls lines) (result '()))
(if (null? ls)
(reverse result)
(let* ((line (clean-line (car ls))))
(if (string-match "^-" line)
(let* ((indent (line-indent (car ls)))
(item-str (string-trim (string-drop line 1)))
(next-lines (cdr ls)))
(if (or (null? next-lines)
(> (line-indent (car next-lines)) indent))
;; Verschachtelter Inhalt
(let* ((sub (take-indented next-lines (+ indent 2)))
(parsed (if (null? sub)
(parse-scalar item-str)
(parse-lines sub (+ indent 2))))
(remaining (drop next-lines (length sub))))
(loop remaining (cons parsed result)))
;; Einfacher Skalar
(loop next-lines (cons (parse-scalar item-str) result))))
;; Nicht mehr Teil der Liste
(reverse result))))))
;; Hauptparser für Key-Value oder Listen
(define (parse-lines lines current-indent)
(let loop ((ls lines) (result '()))
(if (null? ls)
(reverse result)
(let* ((raw-line (car ls))
(line (clean-line raw-line)))
;; Skalar parsen; Rest hinter einem schließenden Quote wird ignoriert
;; (darf nur ein Kommentar sein)
(define (parse-scalar str)
(let ((s (string-trim-both str)))
(cond
;; Kommentar oder leere Zeile
((blank-or-comment? raw-line)
(loop (cdr ls) result))
;; Liste
((string-match "^- " line)
(let ((list-lines (take-indented ls current-indent)))
(let ((parsed-list (parse-list list-lines current-indent)))
(loop (drop ls (length list-lines))
(cons parsed-list result)))))
;; Key: Value
((string-match "^[^:]+:" line)
(let* ((kv (string-split line #\:))
(key (string-trim (car kv)))
(value-str (string-trim (string-join (cdr kv) ":")))
(next-lines (cdr ls)))
(if (string-null? value-str)
;; Wert auf nachfolgender Einrückungsebene
(let* ((sub (take-indented next-lines (+ current-indent 2)))
(parsed (parse-lines sub (+ current-indent 2)))
(remaining (drop next-lines (length sub))))
(loop remaining
(cons (cons key parsed) result)))
;; Einfacher Key:Value
(loop next-lines
(cons (cons key (parse-scalar value-str)) result)))))
;; Fehlerhafte Zeile
((string-null? s) "")
((char=? (string-ref s 0) #\")
(let ((end (closing-double-quote s 1)))
(if end
(unescape-double (substring s 1 end))
(string-trim-right (strip-plain-comment s)))))
((char=? (string-ref s 0) #\')
(let ((end (closing-single-quote s 1)))
(if end
(interpret-plain (unescape-single (substring s 1 end)))
(string-trim-right (strip-plain-comment s)))))
(else
;; Vermeide Fehlermeldung für Leerzeilen oder leere Objekte
(if (or (string-null? (string-trim line))
(member line '("{}" "[]")))
(loop (cdr ls) result)
(interpret-plain (string-trim-right (strip-plain-comment s)))))))
;; --- Struktur ----------------------------------------------------------
;; Erste Key-Trennstelle: ":" am Zeilenende oder gefolgt von Leerzeichen.
;; Beginnt die Zeile mit einem gequoteten Key (oder Skalar), zaehlt ein
;; ":" innerhalb der Quotes nicht als Trennstelle.
(define (key-split-index s)
(let ((start (if (string-null? s)
0
(case (string-ref s 0)
((#\") (let ((end (closing-double-quote s 1)))
(if end (+ end 1) 0)))
((#\') (let ((end (closing-single-quote s 1)))
(if end (+ end 1) 0)))
(else 0)))))
(let loop ((i start))
(cond ((>= i (string-length s)) #f)
((and (char=? (string-ref s i) #\:)
(or (= i (- (string-length s) 1))
(char=? (string-ref s (+ i 1)) #\space)))
i)
(else (loop (+ i 1)))))))
;; Key interpretieren: gequotete Keys werden entquotet (Strings bleiben
;; Strings), unquoted Keys bleiben unveraendert
(define (parse-key s)
(let ((k (string-trim-both s)))
(cond
((string-null? k) k)
((char=? (string-ref k 0) #\")
(let ((end (closing-double-quote k 1)))
(if end (unescape-double (substring k 1 end)) k)))
((char=? (string-ref k 0) #\')
(let ((end (closing-single-quote k 1)))
(if end (unescape-single (substring k 1 end)) k)))
(else k))))
(define (dash-line? content)
(or (string=? content "-") (string-prefix? "- " content)))
;; Wert-String hinter "key:" bzw. "-": reiner Kommentar zählt als leer
(define (effective-value str)
(let ((s (string-trim-both str)))
(if (string-prefix? "#" s) "" s)))
;; Einen Block von Items parsen; das erste Item bestimmt die Blockart
(define (parse-block items)
(cond
((null? items) '())
((dash-line? (item-content (car items))) (parse-list items))
;; einzelne Zeile ohne Key: Skalar (z.B. eine Datei, die nur {} enthält)
((and (null? (cdr items))
(not (key-split-index (item-content (car items)))))
(parse-scalar (item-content (car items))))
(else (parse-map items))))
;; Mapping: alle Items auf map-indent sind Keys, tiefer eingerückte
;; Items gehören zum jeweils vorangehenden Key
(define (parse-map items)
(let ((map-indent (item-indent (car items))))
(let loop ((items items) (result '()))
(if (null? items)
(reverse result)
(let* ((content (item-content (car items)))
(split (key-split-index content)))
(if (not split)
(begin
(format (current-error-port)
"Syntaxfehler: Ungültige Zeile: ~a\n" raw-line)
(loop (cdr ls) result))))
)))))
"YAML-Syntaxfehler: Ungültige Zeile: ~a\n" content)
(loop (cdr items) result))
(let ((key (parse-key (string-take content split)))
(value-str (effective-value
(string-drop content (+ split 1)))))
(if (string-null? value-str)
;; Wert steht im eingerückten Block darunter
(receive (children rest)
(span (lambda (it) (> (item-indent it) map-indent))
(cdr items))
(loop rest
(cons (cons key (parse-block children))
result)))
(loop (cdr items)
(cons (cons key (parse-scalar value-str))
result))))))))))
(let ((lines (read-lines filename)))
(parse-lines lines 0)))
;; Liste: "- wert", "- key: value" (Inline-Mapping) oder "-" mit
;; eingerücktem Block darunter
(define (parse-list items)
(let ((list-indent (item-indent (car items))))
(let loop ((items items) (result '()))
(if (null? items)
(reverse result)
(let ((content (item-content (car items))))
(if (not (dash-line? content))
(begin
(format (current-error-port)
"YAML-Syntaxfehler: Ungültiges Listenelement: ~a\n"
content)
(loop (cdr items) result))
(receive (children rest)
(span (lambda (it) (> (item-indent it) list-indent))
(cdr items))
(let* ((after-dash (string-drop content 1))
(inline (effective-value after-dash)))
(cond
((and (string-null? inline) (null? children))
(loop rest (cons '() result)))
((string-null? inline)
(loop rest (cons (parse-block children) result)))
(else
;; Inline-Inhalt: als synthetisches Item mit der
;; Spalte des Inhalts vor die Kinder stellen, so
;; funktioniert auch "- key: value" mit weiteren
;; Keys auf den Folgezeilen
(let* ((offset (- (string-length content)
(string-length
(string-trim after-dash))))
(synth (cons (+ list-indent offset) inline)))
(loop rest
(cons (parse-block (cons synth children))
result)))))))))))))
(parse-block (read-items filename)))
(define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename)))
+162
View File
@@ -0,0 +1,162 @@
(use-modules (ice-9 regex) (srfi srfi-1))
;; YAML-Writer: Gegenstück zu yaml_parser.scm.
;; Schreibt verschachtelte alist/list-Strukturen als YAML, so dass
;; yml-file->scm sie wieder einlesen kann.
;;
;; Datenmodell (wie vom Parser erzeugt):
;; - Mapping: Liste von Paaren (key . value), key als String oder Symbol
;; - Liste: Liste von beliebigen Werten
;; - Skalare: String, Zahl, #t/#f, '() (leer/null, wird als [] geschrieben)
;;
;; Andere Werte werden vorab automatisch umgewandelt: Markups zu Strings,
;; alles Unbekannte über ~a formatiert (siehe yml-sanitize).
;; Steuert, ob layout_bottom.ily die Header-Daten des Liedes als
;; YAML-Datei exportiert; aktivierbar per (set! yaml-export-enabled #t)
;; oder durch Definieren der Variable vor dem Laden der Includes.
(define yaml-export-enabled
(if (defined? 'yaml-export-enabled) yaml-export-enabled #f))
;; Beliebige Werte in YAML-taugliche Daten umwandeln.
;; (Benötigt die LilyPond-Umgebung für markup? und markup->string.)
(define (yml-sanitize v)
(cond
((or (string? v) (number? v) (boolean? v) (symbol? v) (null? v)) v)
((markup? v) (markup->string v))
((list? v) (map yml-sanitize v))
((pair? v) (cons (yml-sanitize (car v)) (yml-sanitize (cdr v))))
(else (format #f "~a" v))))
(define (scm->yml-string data)
;; Ist data ein Mapping (alist)? Nicht-leere Liste, deren Elemente
;; alle Paare mit String- oder Symbol-Key sind.
;; Achtung: eine Liste von Listen, deren erste Elemente Strings sind,
;; ist davon nicht unterscheidbar und wird als Mapping interpretiert.
(define (mapping? data)
(and (pair? data)
(list? data)
(every (lambda (entry)
(and (pair? entry)
(or (string? (car entry))
(symbol? (car entry)))))
data)))
(define (scalar? v)
(or (string? v) (symbol? v) (number? v) (boolean? v) (null? v)))
(define (key->string k)
(if (symbol? k) (symbol->string k) k))
;; Muss der String gequotet werden, damit er beim Einlesen wieder
;; als derselbe String erkannt wird?
(define (needs-quotes? s)
(or (string-null? s)
(member s '("true" "false" "null" "{}" "[]"))
(string->number s) ;; zahlartig ("1981", "1.", "-5") würde zur Zahl
(string-index s #\#) ;; würde als Kommentar abgeschnitten
(string-index s #\:) ;; würde als Key: Value gelesen
(string-index s #\newline) ;; mehrzeilig
(string-index s #\")
(string-prefix? "-" s) ;; würde als Listenelement gelesen
(string-prefix? "'" s)
(not (string=? s (string-trim-both s))))) ;; führende/folgende Leerzeichen
;; Doppelt gequoteter YAML-String; Backslash, Anführungszeichen und
;; Zeilenumbrüche werden escaped, damit alles auf einer Zeile bleibt.
(define (quote-string s)
(string-append
"\""
(string-concatenate
(map (lambda (c)
(cond
((char=? c #\\) "\\\\")
((char=? c #\") "\\\"")
((char=? c #\newline) "\\n")
(else (string c))))
(string->list s)))
"\""))
(define (scalar->string v)
(cond
((eq? v #t) "true")
((eq? v #f) "false")
((null? v) "[]")
((number? v) (number->string v))
((symbol? v) (scalar->string (symbol->string v)))
((string? v) (if (needs-quotes? v) (quote-string v) v))
(else (error "scm->yml-string: nicht unterstützter Wert" v))))
(define (indent-string n) (make-string n #\space))
;; Key ggf. quoten (leere oder zahlartige Keys, Sonderzeichen)
(define (key->yml-string k)
(let ((s (key->string k)))
(if (needs-quotes? s) (quote-string s) s)))
;; Doppelte Keys sind in YAML nicht erlaubt: Werte gleicher Keys werden
;; zu einer Liste zusammengefasst, z.B. authors mit (voice 2) (voice 3)
;; -> voice: [2, 3].
(define (merge-duplicate-keys data)
(define (value->list v)
(if (and (list? v) (not (mapping? v))) v (list v)))
(let loop ((entries data) (result '()))
(if (null? entries)
(reverse result)
(let* ((entry (car entries))
(existing (find (lambda (e) (equal? (car e) (car entry)))
result)))
(if existing
(begin
(set-cdr! existing (append (value->list (cdr existing))
(value->list (cdr entry))))
(loop (cdr entries) result))
(loop (cdr entries)
(cons (cons (car entry) (cdr entry)) result)))))))
;; Mapping schreiben: "key: skalar" oder "key:" mit eingerücktem Inhalt
(define (write-mapping data indent port)
(for-each
(lambda (entry)
(let ((key (key->yml-string (car entry)))
(value (cdr entry)))
(if (scalar? value)
(format port "~a~a: ~a\n"
(indent-string indent) key (scalar->string value))
(begin
(format port "~a~a:\n" (indent-string indent) key)
(write-node value (+ indent 2) port)))))
(merge-duplicate-keys data)))
;; Liste schreiben: "- skalar" oder "-" mit eingerücktem Inhalt
;; (Verschachtelter Inhalt darf NICHT auf der "-"-Zeile beginnen,
;; weil parse-list den Inhalt der "-"-Zeile verwirft, sobald
;; eingerückte Folgezeilen existieren.)
(define (write-list data indent port)
(for-each
(lambda (item)
(if (scalar? item)
(format port "~a- ~a\n"
(indent-string indent) (scalar->string item))
(begin
(format port "~a-\n" (indent-string indent))
(write-node item (+ indent 2) port))))
data))
(define (write-node data indent port)
(cond
((mapping? data) (write-mapping data indent port))
((and (list? data) (not (null? data))) (write-list data indent port))
(else (format port "~a~a\n" (indent-string indent) (scalar->string data)))))
(call-with-output-string
(lambda (port) (write-node (yml-sanitize data) 0 port))))
;; Daten als YAML-Datei schreiben
(define (scm->yml-file filename data)
(call-with-output-file filename
(lambda (port)
(display "---\n" port)
(display (scm->yml-string data) port))))
@@ -65,11 +65,10 @@
;; Ist dieses Lied das erste eines Kapitels, wird der Kapitel-Eintrag
;; unmittelbar vor dem Lied-Eintrag ausgegeben, damit die pdfmark-/OUT-
;; Reihenfolge (Elternteil vor Kindern) im PDF-Stream garantiert stimmt.
;; Eingebettete Lieder (embedded_songs.ily) folgen direkt nach dem Lied.
(if (and (string? chaptertitle) (not (string-null? chaptertitle)))
(markup #:chapter-to-pdf-toc chaptercount chaptertitle
#:title-to-pdf-toc pdfbookmark #:embedded-songs-to-pdf-toc title-markup)
(markup #:title-to-pdf-toc pdfbookmark #:embedded-songs-to-pdf-toc title-markup))
#:title-to-pdf-toc pdfbookmark title-markup)
(markup #:title-to-pdf-toc pdfbookmark title-markup))
make-null-markup)
)))
+28 -44
View File
@@ -89,7 +89,7 @@
(if (and (string? arg) (string-null? arg))
" "
#{\markup
\score { \new Lyrics { \lyricmode { #(if (ly:music? arg) arg #{ \stanza #arg #}) "" } } \layout { $verselayout #(customized-layout verselayout) } }
\score { \new Lyrics { \lyricmode { #(if (ly:music? arg) arg #{ \set stanza = #arg #}) "" } } \layout { $verselayout #(customized-layout verselayout) } }
#}
)))
@@ -182,7 +182,19 @@
((if reverses fold fold-right) (lambda (element filled-list)
(cons element (if (null? filled-list) '() (cons markup-between filled-list))))
'() elements))
(let* ((column-item-count (ceiling (/ (length versegroup) verse-cols)))
;; Dokumentposition fuer den ChordPro-/Data-Collector: jede Gruppe nimmt
;; sich eine Sequenznummer, jeder Vers traegt seine Position innerhalb
;; der Gruppe in den Props -- die Spalten-Verteilung unten verschraenkt
;; sonst die Interpretationsreihenfolge.
(set! chordpro-doc-seq-counter (1+ chordpro-doc-seq-counter))
(let* ((doc-seq chordpro-doc-seq-counter)
(versegroup (index-map
(lambda (index item)
(make-override-markup
(cons 'chordpro-doc-order (cons doc-seq index))
item))
versegroup))
(column-item-count (ceiling (/ (length versegroup) verse-cols)))
(column-data (make-list verse-cols)))
(let columnize-list ((index 0) (items versegroup))
(if (not (null? items))
@@ -249,13 +261,6 @@ Chord_lyrics_spacing_engraver =
(lyrics-seen-since-break #f)
(have-a-rest #f)
(stanza #f)
; Akkord auf einer Skip-Silbe "_" nach Wortende soll über die folgende Silbe
(word-continues #f)
(continuation-this-step #f)
(lyric-skip-this-step #f)
(syllable-this-step #f)
(chord-this-step #f)
(chord-on-lyric-skip #f)
(place-at-right-edge
(lambda (grob anchor padding)
(let ((anchor-width (interval-length (ly:grob-extent anchor anchor X))))
@@ -263,25 +268,6 @@ Chord_lyrics_spacing_engraver =
(ly:grob-set-property! grob 'X-offset (+ padding anchor-width))
))))
(make-engraver
((start-translation-timestep engraver)
(set! continuation-this-step #f)
(set! lyric-skip-this-step #f)
(set! syllable-this-step #f)
(set! chord-this-step #f)
)
((stop-translation-timestep engraver)
(if (and chord-on-lyric-skip (not (eq? chord-on-lyric-skip chord-this-step)))
(begin
(if (and syllable-this-step (not chord-this-step))
(begin
(ly:grob-set-parent! chord-on-lyric-skip X syllable-this-step)
(ly:grob-set-property! chord-on-lyric-skip 'X-offset 0)
(ly:grob-set-property! chord-on-lyric-skip 'extra-spacing-width '(+inf.0 . -inf.0))
(set! lyric-width-since-last-chord (interval-length (ly:grob-extent syllable-this-step syllable-this-step X)))))
(set! chord-on-lyric-skip #f)))
(if syllable-this-step
(set! word-continues continuation-this-step))
)
(listeners
((multi-measure-rest-event engraver event)
(set! have-a-rest #t)
@@ -289,19 +275,8 @@ Chord_lyrics_spacing_engraver =
((rest-event engraver event)
(set! have-a-rest #t)
)
((hyphen-event engraver event)
(set! continuation-this-step #t)
)
((extender-event engraver event)
(set! continuation-this-step #t)
)
((lyric-event engraver event)
(set! have-a-rest #f)
; "_" wird zu " " und erzeugt keine LyricText
(if (equal? (ly:event-property event 'text) " ")
(begin
(set! lyric-skip-this-step #t)
(set! chord-on-lyric-skip #f)))
(set! music-columns-for-last-syllable 0)
)
((break-event engraver event)
@@ -311,7 +286,6 @@ Chord_lyrics_spacing_engraver =
(set! last-printed-chord #f)
(set! chord-width-since-last-lyric 0)
(set! lyrics-seen-since-break #f)
(set! chord-on-lyric-skip #f)
))
(acknowledgers
((musical-paper-column-interface this-engraver grob source-engraver)
@@ -332,7 +306,6 @@ Chord_lyrics_spacing_engraver =
(ly:grob-set-property! grob 'X-offset gap-for-starting-rest)
)))
)
(set! syllable-this-step grob)
(set! last-lyric-syllable grob)
(set! chord-width-since-last-lyric 0)
(set! lyrics-seen-since-break #t)
@@ -360,9 +333,6 @@ Chord_lyrics_spacing_engraver =
(cons (car (ly:grob-property last-lyric-syllable 'extra-spacing-width '(0 . 0))) (+ chord-gap chord-overwidth)))
)
(set! lyric-width-since-last-chord (* (if last-lyric-syllable (interval-length (ly:grob-extent last-lyric-syllable last-lyric-syllable X)) 0) (- 1 (/ 1.0 music-columns-for-last-syllable))))
(set! chord-this-step grob)
(if (and lyric-skip-this-step (not have-a-rest) (not word-continues))
(set! chord-on-lyric-skip grob))
(set! last-printed-chord grob)
(set! last-lyric-syllable #f)
)
@@ -383,6 +353,20 @@ Chord_lyrics_spacing_engraver =
(transposition (cons #f #f))
(verselayout generalLayout))
"Vers mit Akkorden"
;; Dem ChordPro-Collector sagen, zu welchem Lied dieser Vers gehoert
;; (Buch: songfilename aus den Props via \setsongfilename; Einzellied:
;; Fallback-Key aus layout_bottom). Die Score-Interpretation darunter
;; laeuft synchron, der Engraver liest den Key in initialize. Die Props
;; braucht er zum Aufloesen von Markup-Silben (tags-to-keep).
(set! chordpro-active-song-key (chordpro-resolve-song-key props))
(set! chordpro-active-props props)
;; Dokumentposition: von \group-verses gestempelt; ausserhalb einer
;; Gruppe nimmt sich der Vers selbst eine Sequenznummer.
(set! chordpro-active-doc-order
(or (chain-assoc-get 'chordpro-doc-order props #f)
(begin
(set! chordpro-doc-seq-counter (1+ chordpro-doc-seq-counter))
(cons chordpro-doc-seq-counter 0))))
(interpret-markup layout props
#{
\markup {
+180 -33
View File
@@ -65,6 +65,26 @@ additionalPageNumbers =
display-pages-list
)
% Fuer Zusatzseiten: Label der ersten Seite des zusammenhaengenden
% Zusatzseiten-Blocks, zu dem label gehoert (bestimmt den Buchstaben-Suffix a, b, ...).
#(define (earliest-additional-label label)
(let find-earliest-additional-label
((rest-additional-page-switch-label-list (member (cons label #t) additional-page-switch-label-list)))
(if (cdadr rest-additional-page-switch-label-list)
(find-earliest-additional-label (cdr rest-additional-page-switch-label-list))
(caar rest-additional-page-switch-label-list))))
% Sichtbare Seitenzahl der Seite mit diesem Label: normalerweise eine Zahl,
% auf Zusatzseiten ein String mit Buchstaben-Suffix (z.B. "12a"); gleiche
% Logik wie custom-page-number unten.
#(define (visible-page-value layout label)
(let ((display-page (assq-ref (build-display-pages-list layout) label)))
(if (assq-ref additional-page-switch-label-list label)
(ly:format "~a~a" display-page
(string (integer->char (+ 97 (- (real-page-number layout label)
(real-page-number layout (earliest-additional-label label)))))))
display-page)))
% TODO:
% Eigentlich können wir das direkt in oddFooderMarkup und evenFooterMarkup aufrufen
% vermutlich sogar ohne den delay kram. Wir sollten außerdem einfach nur die property
@@ -97,12 +117,7 @@ width may require additional tweaking.)"
(if (assq-ref additional-page-switch-label-list label)
(make-concat-markup (list (number-format number-type display-page)
(make-char-markup (+ 97 (- real-current-page (real-page-number layout
(let find-earliest-additional-label
((rest-additional-page-switch-label-list (member (cons label #t) additional-page-switch-label-list)))
(if (cdadr rest-additional-page-switch-label-list)
(find-earliest-additional-label (cdr rest-additional-page-switch-label-list))
(caar rest-additional-page-switch-label-list)))
))))))
(earliest-additional-label label)))))))
(number-format number-type (+ display-page (- real-current-page (real-page-number layout label))))
))
(page-stencil (interpret-markup layout props page-markup))
@@ -118,6 +133,79 @@ width may require additional tweaking.)"
(make-filled-box-stencil x-ext y-ext))))
%% Schreibt die Daten aller Lieder des Buchs (extract-song-data, siehe
%% data_extractor.ily) als YAML-Datei: oberster Key contents, darunter eine
%% Liste mit den Lied-Daten, jeweils angereichert um den Key page mit der
%% sichtbaren Seitenzahl des Liedanfangs. Einbinden wie \write-toc-csv in
%% einem Markup des Buchs; wie dort passiert das Schreiben ueber ein
%% delayed stencil, weil die Label->Seiten-Tabelle erst beim Ausgeben des
%% Buchs feststeht. Der Dateiname ist der Ausgabename des Buchs
%% (\bookOutputName, sonst der .ly-Basisname) mit angehaengtem .yml --
%% landet also wie das PDF relativ zum Arbeitsverzeichnis.
#(define-markup-command (write-book-yaml layout props) ()
(let ((filename (string-append (ly:parser-output-name) ".yml")))
(ly:make-stencil
`(delay-stencil-evaluation
,(delay
(begin
(scm->yml-file filename
(list (cons 'contents
(map (lambda (song)
(let ((songvars (cdr song)))
(cons (cons 'page (visible-page-value layout (assq-ref songvars 'label)))
(extract-song-data (assq-ref songvars 'header)
(assq-ref songvars 'music)
;; Textseiten-Strophen aus dem Render-
;; Collector-Store (Key = Liedname); beim
;; Ausgeben des Buchs sind alle Textseiten
;; bereits interpretiert.
(hash-ref chordpro-song-store
(symbol->string (car song)))
(symbol->string (car song))))))
(reverse (alist-delete 'markupPage
(alist-delete 'imagePage
(alist-delete 'emptyPage song-list))))))))
empty-stencil))))))
%% Schreibt den ChordPro-Export aller Lieder des Buchs (in Dokument-
%% reihenfolge) als EINE Datei statt als Einzeldateien pro Lied. Lieder
%% werden mit der ChordPro-Direktive {new_song} getrennt; vor dem ersten
%% Lied ist sie nicht noetig, sie gilt am Dateianfang implizit (siehe
%% https://www.chordpro.org/chordpro/directives-new_song/). Einbinden wie
%% \write-book-yaml an beliebiger Stelle im Buch -- unabhaengig von
%% chordpro-export-enabled (das steuert nur den Pro-Song-Export), beide
%% Befehle koennen auch gleichzeitig genutzt werden. Wie bei
%% \write-book-yaml passiert das Schreiben ueber ein delayed stencil,
%% weil der Render-Collector-Store erst beim Ausgeben des Buchs
%% vollstaendig gefuellt ist. Der Dateiname ist wie bei \write-book-yaml
%% der Ausgabename des Buchs mit angehaengtem .cho.
#(define-markup-command (write-book-chordpro layout props) ()
(let ((filename (string-append (ly:parser-output-name) ".cho")))
(ly:make-stencil
`(delay-stencil-evaluation
,(delay
(begin
(with-output-to-file filename
(lambda ()
(let loop ((songs (filter
;; \chordlyrics-Strophen ODER (bei
;; chordpro-include-music-lyrics) aus der
;; Musik nachgeholte Kandidaten.
(lambda (song) (or (> (chordpro-song-verse-index song) 0)
(pair? (chordpro-song-music-candidates song))))
(filter-map
(lambda (song) (hash-ref chordpro-song-store
(symbol->string (car song))))
(reverse (alist-delete 'markupPage
(alist-delete 'imagePage
(alist-delete 'emptyPage song-list)))))))
(first? #t))
(when (pair? songs)
(unless first? (display "{new_song}\n"))
(display (chordpro-format-song (car songs)))
(loop (cdr songs) #f)))))
empty-stencil))))))
includeSong =
#(define-void-function (filename) (string?)
#{
@@ -125,6 +213,15 @@ includeSong =
#}
(ly:parser-parse-string (ly:parser-clone)
(ly:format "\\include \"~a/~a/~a.ly\"" songPath filename filename))
;; ChordPro: Titel/Autoren dieses Lieds im Render-Collector-Store
;; registrieren -- basicSongInfo haelt direkt nach dem Include genau
;; dieses Lied. Der Key ist der Liedname; die Collector-Daten (Verse,
;; Akkorde) kommen spaeter beim Rendern ueber \setsongfilename unter
;; demselben Key dazu. Unabhaengig von chordpro-export-enabled, damit
;; sowohl der Pro-Song-Export (der die Flag braucht) als auch
;; \write-book-chordpro (das nur explizit aufgerufen werden muss) auf
;; vollstaendige Metadaten zugreifen koennen.
(chordpro-register-song-metadata filename HEADER)
(let ((label (gensym "index")))
(set! additional-page-switch-label-list
(acons label additional-page-numbers additional-page-switch-label-list))
@@ -187,24 +284,20 @@ songs =
;; Lieder duerfen als Kapitel-Kinder gezaehlt werden -- sonst wird die
;; /Count zu hoch und der erste Folgeeintrag (z.B. ein spaeteres Kapitel)
;; rutscht faelschlich als Kind mit hinein.
;; Eingebettete Lieder (embedded_songs.ily) haben jeweils ein eigenes
;; Lesezeichen, daher die Anzahl statt eines Booleans.
(bookmark-count
(emits-bookmark?
(lambda (e)
(if (or (eq? (car e) 'emptyPage)
(eq? (car e) 'imagePage)
(eq? (car e) 'markupPage))
0
(let* ((headermodule (ly:book-header (assq-ref (cdr e) 'header)))
(vars (extract-and-check-vars-from-module headermodule '(title starttext))))
(+ (if (or (assq-ref vars 'title) (assq-ref vars 'starttext)) 1 0)
(count song-pdf-bookmark-title (embedded-songs-of-header headermodule)))))))
(and (not (eq? (car e) 'emptyPage))
(not (eq? (car e) 'imagePage))
(not (eq? (car e) 'markupPage))
(let ((vars (extract-and-check-vars-from-header
(assq-ref (cdr e) 'header) '(title starttext))))
(if (or (assq-ref vars 'title) (assq-ref vars 'starttext)) #t #f)))))
(count-bookmark-songs
(lambda (start end)
(let loop ((i 0) (l ordered) (c 0))
(cond ((or (null? l) (>= i end)) c)
((< i start) (loop (+ i 1) (cdr l) c))
(else (loop (+ i 1) (cdr l) (+ c (bookmark-count (car l)))))))))
(else (loop (+ i 1) (cdr l) (if (emits-bookmark? (car l)) (+ c 1) c)))))))
;; chapters: (title . start-index). start-index = Anzahl der song-list-
;; Eintraege beim Aufruf von songsChapter = Index in `ordered`, ab dem
;; das Kapitel beginnt.
@@ -304,27 +397,81 @@ songs =
(music (assq-ref songvars 'music))
(layout (assq-ref songvars 'layout))
(text-pages (assq-ref songvars 'text-pages))
(label (assq-ref songvars 'label))
(toc-music (header-module-to-toc! (ly:book-header header) label)))
(label (assq-ref songvars 'label)))
(set! song-number newnumber)
;; Eingebettete Lieder: eigene Liednummer, gleiche Seite (label)
(for-each
(lambda (song)
(let ((tocheader (make-module)))
(set! song-number (+ 1 song-number))
(ly:module-copy tocheader song)
(module-define! tocheader 'songnumber (number->string song-number))
(module-define! tocheader 'chapterref current-chapter)
(header-module-to-toc! tocheader label)))
(embedded-songs-of-header (ly:book-header header)))
;; ChordPro_music_collector (Strophen unter den Noten, siehe
;; chordpro.ily) braucht den Song-Key beim tatsaechlichen
;; Interpretieren dieses Songs' Hauptscore. Im Buch ist DAS
;; NICHT synchron zu dieser for-each-Schleife -- LilyPond
;; interpretiert die \score-Bloecke aller Lieder gesammelt fuer
;; das Seitenlayout, oft NACHDEM die Schleife schon beim
;; naechsten (oder letzten) Lied angelangt ist. Ein globaler
;; chordpro-active-song-key waere zu diesem Zeitpunkt also auf
;; ein ANDERES Lied gesetzt -- die gesammelten Strophen landen
;; dann fälschlich im Store-Eintrag des zuletzt verarbeiteten
;; Lieds (beobachtet: mehrere Lieder ohne eigene \chordlyrics
;; wurden alle in den letzten Song der Test-Bibliothek
;; geschrieben). Deshalb setzen wir den Key per \applyContext
;; DIREKT IN DER MUSIK in chordpro-context-song-keys (siehe
;; chordpro.ily) -- das laeuft synchron zur tatsaechlichen
;; Interpretation dieses Scores und ist deshalb robust gegen die
;; verzoegerte/gesammelte Verarbeitung (eine LilyPond-Context-
;; Property ueber den \layout-Block waere hier keine Alternative:
;; LilyPond verwirft \applyContext-\ly:context-set-property!-
;; Aufrufe fuer nicht deklarierte Properties stillschweigend).
;; Der Music_collector liest bevorzugt diese Tabelle,
;; chordpro-active-song-key bleibt nur als Fallback
;; (Einzellied-Standalone-Pfad, dort synchron genug).
;; \consists nur bei chordpro-include-music-lyrics -- sonst
;; keine Kosten (Grob-Acknowledger fuer JEDEN Akkord/jede
;; Silbe/Strophenmarker des Hauptscores) fuer Buecher, die das
;; Feature nicht nutzen. Bewusst NICHT zusaetzlich an
;; chordpro-export-enabled gekoppelt -- die steuert nur, ob
;; \write-book-chordpro/\chordpro-delayed-write am Ende etwas
;; schreiben, nicht ob hier gesammelt wird.
(set! chordpro-active-song-key (symbol->string filename))
(let* ((collect-music-lyrics? (and (defined? 'chordpro-include-music-lyrics) chordpro-include-music-lyrics))
(song-layout
(if collect-music-lyrics?
#{
\layout {
$layout
songfilename = $(symbol->string filename)
\context {
\Score
\consists \ChordPro_music_collector
}
}
#}
#{
\layout {
$layout
songfilename = $(symbol->string filename)
}
#}))
(score-music
(if collect-music-lyrics?
#{
<<
\applyContext
#(let ((key (symbol->string filename)))
(lambda (ctx)
(hashq-set! chordpro-context-song-keys ctx key)))
$music
>>
#}
music)))
#{
\bookpart {
$header
$toc-music
\score { $music \layout { $layout songfilename = $(symbol->string filename) } }
\headerToTOC #header #label
\score {
$score-music
$song-layout
}
$(add-text-pages text-pages)
}
#}))))))))
#})))))))))
ordered
)))
+19 -18
View File
@@ -304,9 +304,16 @@ indexSection =
(add-index-item! 'indexSectionMarkup (prepend-alist-chain 'combine-with-next #t (prepend-alist-chain 'rawtext text '())) sorttext))
#(define (extract-and-check-vars-from-header bookheader varlist)
(extract-and-check-vars-from-module (ly:book-header bookheader) varlist))
(let* ((headervars (hash-map->list cons (struct-ref (ly:book-header bookheader) 0)))
(extract-var-and-check (lambda (headervar)
(let* ((variableref (assoc-ref headervars headervar))
(extracted (if variableref (variable-ref variableref) #f)))
(if (and extracted (not (and (string? extracted) (string-null? extracted)))) extracted #f)))))
(map (lambda (varsymbol)
(cons varsymbol (extract-var-and-check varsymbol))
) varlist)))
#(define (header-module-to-toc! headermodule label)
headerToTOC = #(define-music-function (parser location header label) (ly:book? symbol?)
(define (all-author-ids authors)
(let ((poetIds (find-author-ids-by 'text authors))
(translatorIds (find-author-ids-by 'translation authors))
@@ -324,7 +331,7 @@ indexSection =
))
(let*
(
(extractedheadervars (extract-and-check-vars-from-module headermodule '(title starttext alttitle categorytitle categories authors songnumber chapterref)))
(extractedheadervars (extract-and-check-vars-from-header header '(title starttext alttitle categorytitle categories authors songnumber chapterref)))
(title (assq-ref extractedheadervars 'title))
(starttext (assq-ref extractedheadervars 'starttext))
(alttitle (assq-ref extractedheadervars 'alttitle))
@@ -350,9 +357,6 @@ indexSection =
(if title (add-to-toc! title #f) #{ #})
))
headerToTOC = #(define-music-function (parser location header label) (ly:book? symbol?)
(header-module-to-toc! (ly:book-header header) label))
%% https://github.com/NalaGinrut/guile-csv/blob/master/csv/csv.scm
@@ -366,6 +370,9 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
#(define csv-write sxml->csv)
#(define-markup-command (write-toc-csv layout props) ()
;; Dateiname wie bei \write-book-yaml/\write-book-chordpro: der
;; Ausgabename des Buchs mit angehaengtem .csv statt fest "toc.csv".
(define csv-filename (string-append (ly:parser-output-name) ".csv"))
(define (csv-escape field)
(if (string-null? field)
field
@@ -398,8 +405,11 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
(para-lines (map cleanup-whitespaces para-strings)))
(string-join para-lines "\n")))
(define (generate-toc-csv labelPageTable)
(define (song-line filename page-number headermodule)
(let* ((extractedheadervars (extract-and-check-vars-from-module headermodule
(let ((song-lines (map (lambda (song)
(let* ((filename (symbol->string (car song)))
(songvars (cdr song))
(page-number (assoc-get (assq-ref songvars 'label) labelPageTable))
(extractedheadervars (extract-and-check-vars-from-header (assq-ref songvars 'header)
'(title starttext alttitle categorytitle categories authors year_text year_melody year_translation year_composition year_adaption infotext translation pronunciation copyright source)))
(headervar-or-empty (lambda (varsym)
(let ((extracted (assq-ref extractedheadervars varsym)))
@@ -445,17 +455,8 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
(format-info-paragraphs (headervar-or-empty 'translation))
(format-info-paragraphs (headervar-or-empty 'pronunciation))
))))
;; Eingebettete Lieder (embedded_songs.ily) bekommen eigene Zeilen mit
;; Dateiname und Seite des Hauptlieds.
(let ((song-lines (append-map (lambda (song)
(let* ((filename (symbol->string (car song)))
(songvars (cdr song))
(page-number (assoc-get (assq-ref songvars 'label) labelPageTable))
(headermodule (ly:book-header (assq-ref songvars 'header))))
(map (lambda (module) (song-line filename page-number module))
(cons headermodule (embedded-songs-of-header headermodule)))))
(alist-delete 'markupPage (alist-delete 'imagePage (alist-delete 'emptyPage song-list))))))
(call-with-output-file "toc.csv"
(call-with-output-file csv-filename
(lambda (port)
(csv-write (cons '(
"filename"
+56 -29
View File
@@ -1,17 +1,10 @@
MUSIC = { \transposable #TRANSPOSITION \MUSIC }
%% Eingebettete Lieder (siehe embedded_songs.ily) im Header des Hauptlieds
%% vermerken, daraus bauen Footer, PDF-Lesezeichen und Verzeichnisse.
#(if (and (pair? EMBEDDED_SONGS) (ly:book? HEADER) (ly:book-header HEADER))
(module-define! (ly:book-header HEADER) 'embeddedsongs EMBEDDED_SONGS))
LAYOUT = \layout {
\LAYOUT
#(customized-layout LAYOUT)
}
#(customize-embedded-score-layouts! (list TEXT TEXT_PAGES))
verselayout = \layout {
\LAYOUT
\context {
@@ -79,34 +72,68 @@ TEXT = \markuplist {
(if paper (set! $defaultpaper paper))
)
;; ChordPro export: Store filename and extract metadata from basicSongInfo FIRST
;; Meta-Daten des Liedes als YAML neben die Ausgabedatei schreiben
;; (<ly:parser-output-name>.yml, landet wie das PDF relativ zum
;; Arbeitsverzeichnis). Die Textseiten-Strophen kommen aus dem
;; Render-Collector (chordpro.ily), deshalb wird erst bei der Ausgabe
;; geschrieben: unsichtbarer delayed Stencil an der letzten Textseite.
;; Ohne (nicht-leere) Textseiten gibt es keine Collector-Daten und die
;; yml wird sofort geschrieben.
(when (and (defined? 'yaml-export-enabled) yaml-export-enabled)
;; Collector-Daten auch ohne ChordPro-Flag unter dem Ausgabenamen sammeln
(set! chordpro-default-song-key (ly:parser-output-name))
(if (any pair? TEXT_PAGES)
(let* ((last-index (- (length TEXT_PAGES) 1))
(last-page (list-ref TEXT_PAGES last-index))
(trigger-stencil (yaml-delayed-song-write
(ly:parser-output-name) HEADER MUSIC))
(modified-last-page #{
\markuplist {
#last-page
\stencil #trigger-stencil
}
#}))
(set! TEXT_PAGES
(append (list-head TEXT_PAGES last-index)
(list modified-last-page))))
(scm->yml-file
(string-append (ly:parser-output-name) ".yml")
(extract-song-data HEADER MUSIC #f (ly:parser-output-name)))))
;; ChordPro export (Einzellied): Song-Key ist der Ausgabename (die .cho
;; landet wie das PDF relativ zum Arbeitsverzeichnis); Titel/Autoren
;; kommen aus HEADER in den per-Song-Store.
(when (and (defined? 'chordpro-export-enabled) chordpro-export-enabled)
;; Use ly:parser-output-name which returns the output basename
;; This will write relative to current working directory (same as PDF)
(let ((output-name (ly:parser-output-name)))
(set! chordpro-current-filename output-name))
;; Try to extract metadata from the HEADER (falls back to basicSongInfo)
(let ((header-module (if (and (ly:book? HEADER) (ly:book-header HEADER))
(ly:book-header HEADER)
(and (defined? 'basicSongInfo) basicSongInfo))))
(when header-module
(let* ((header-alist (ly:module->alist header-module))
(title (assoc-ref header-alist 'title))
(authors (assoc-ref header-alist 'authors)))
(when title
(set! chordpro-header-title
(if (markup? title)
(markup->string title)
(if (string? title) title "Untitled"))))
(when authors
(set! chordpro-header-authors authors))))))
(set! chordpro-default-song-key (ly:parser-output-name))
(chordpro-register-song-metadata chordpro-default-song-key HEADER))
;; ChordPro_music_collector (Strophen unter den Noten, siehe chordpro.ily)
;; braucht den aktiven Song-Key VOR der Interpretation des Hauptscores.
;; \consists nur bei chordpro-include-music-lyrics -- sonst keine Kosten
;; (Grob-Acknowledger fuer JEDEN Akkord/jede Silbe/Strophenmarker des
;; Hauptscores) fuer Lieder/Buecher, die das Feature nicht nutzen. Bewusst
;; NICHT zusaetzlich an chordpro-export-enabled gekoppelt: die Flag ist
;; eigenstaendig gedacht (steuert nur, ob \chordpro-delayed-write bzw.
;; \write-book-chordpro am Ende tatsaechlich etwas schreiben -- ob dafuer
;; Daten gesammelt wurden, ist eine davon unabhaengige Entscheidung).
(set! chordpro-active-song-key (ly:parser-output-name))
(if (and (defined? 'chordpro-include-music-lyrics) chordpro-include-music-lyrics)
(add-score #{
\score {
\MUSIC
\layout {
\LAYOUT
\context {
\Score
\consists \ChordPro_music_collector
}
}
}#})
(add-score #{
\score {
\MUSIC
\layout { \LAYOUT }
}#})
}#}))
(add-text-pages TEXT_PAGES)
(add-score #{