Author SHA1 Message Date
tux 295a841a37 new engraver for spacing in chordlyrics 2025-12-15 01:26:54 +01:00
21 changed files with 434 additions and 3366 deletions
+1 -1
View File
@@ -1,8 +1,8 @@
# ---> Lilypond # ---> Lilypond
*.pdf *.pdf
*.cho
*.ps *.ps
*.midi *.midi
*.mid *.mid
*.log *.log
*~ *~
+1 -7
View File
@@ -20,8 +20,7 @@
"scm" file-name-separator-string filename "scm" file-name-separator-string filename
))))) )))))
(scm-load "resolve_inherits.scm") (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) #(define (song-includes-data-path filename)
(string-join (string-join
@@ -39,10 +38,7 @@
\include "eps_file_from_song_dir.ily" \include "eps_file_from_song_dir.ily"
\include "title_with_category_images.ily" \include "title_with_category_images.ily"
\include "chord_settings.ily" \include "chord_settings.ily"
\include "chordpro.ily"
\include "data_extractor.ily"
\include "transposition.ily" \include "transposition.ily"
\include "markup_tag_groups_hack.ily"
\include "verses_with_chords.ily" \include "verses_with_chords.ily"
\include "arrows_in_scores.ily" \include "arrows_in_scores.ily"
\include "swing_style.ily" \include "swing_style.ily"
@@ -60,5 +56,3 @@ TEXT_PAGES = #f
verseChords = {} verseChords = {}
firstVoice = {} firstVoice = {}
global = {} global = {}
\resetTagGroups
@@ -29,11 +29,6 @@
(if (null? stanzanumbers) (if (null? stanzanumbers)
refString refString
(ly:format refStringWithNumbers (string-join (map (lambda (stanzanumber) (ly:format "~a" stanzanumber)) stanzanumbers) ", "))))) (ly:format refStringWithNumbers (string-join (map (lambda (stanzanumber) (ly:format "~a" stanzanumber)) stanzanumbers) ", ")))))
bridgeMarkupFormatter = #(lambda (layout props stanzanumbers)
(interpret-markup layout props
(if (null? stanzanumbers)
bridgeString
(ly:format bridgeStringWithNumbers (string-join (map (lambda (stanzanumber) (ly:format "~a" stanzanumber)) stanzanumbers) ", ")))))
} }
generalLayout = \layout { generalLayout = \layout {
@@ -57,7 +52,6 @@ generalLayout = \layout {
\remove "Metronome_mark_engraver" \remove "Metronome_mark_engraver"
\RemoveEmptyStaves \RemoveEmptyStaves
\override VerticalAxisGroup.remove-first = ##t \override VerticalAxisGroup.remove-first = ##t
\numericTimeSignature
\overrideTimeSignatureSettings \overrideTimeSignatureSettings
4/4 % timeSignatureFraction 4/4 % timeSignatureFraction
1/4 % baseMomentFraction 1/4 % baseMomentFraction
@@ -85,11 +79,6 @@ generalLayout = \layout {
} }
} }
#(define (customized-layout base-layout)
(let
((custom-size (ly:output-def-lookup base-layout 'size #f)))
(if custom-size (layout-set-staff-size custom-size))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% kleine Helferlein: %%% kleine Helferlein:
@@ -145,26 +134,18 @@ override-stanza =
#} #}
) )
#(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 (stanza . 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-realstanza = ##t % set this to signal that there is a real stanza and no repeat signs
\once \override StanzaNumber.details.custom-stanza-type = #'verse
\once \override StanzaNumber.details.custom-stanza-numbers = #stanzanumbers
\applyContext \applyContext
#(lambda (context) #(lambda (context)
(handle-stanza-numbers context stanzanumbers (let* ((stanzanumbers-override (ly:assoc-get 'custom-stanzanumber-override (ly:assoc-get 'details (ly:context-grob-definition context 'StanzaNumber) '()) #f))
(lambda (numbers) (string-join (map (lambda (n) (format #f stanzaFormat n)) numbers) ", ")))) (stanza-style (ly:assoc-get 'style (ly:context-grob-definition context 'StanzaNumber)))
(stanza-format (lambda (stanzanumber) (format #f (if (eq? stanza-style 'roman) romanStanzaFormat stanzaFormat) stanzanumber))))
(ly:context-set-property! context 'stanza
(string-join (map stanza-format
(if stanzanumbers-override stanzanumbers-override stanzanumbers))
", "))))
#} #}
) )
@@ -172,35 +153,7 @@ ref =
#(define-music-function (stanzanumbers lyrics) ((number-list? (list)) ly:music?) #(define-music-function (stanzanumbers lyrics) ((number-list? (list)) ly:music?)
#{ \lyricmode { #{ \lyricmode {
\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-realstanza = ##t % set this to signal that there is a real stanza and no repeat signs
\once \override StanzaNumber.details.custom-stanza-type = #'ref \set stanza = #(make-on-the-fly-markup (lambda (layout props m) ((ly:output-def-lookup layout 'refMarkupFormatter) layout props stanzanumbers)) (make-null-markup))
\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
}
#}
)
bridge =
#(define-music-function (stanzanumbers lyrics) ((number-list? (list)) ly:music?)
#{ \lyricmode {
\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 #lyrics
} }
#} #}
@@ -208,11 +161,8 @@ bridge =
% prints a repStart Sign as stanza if the tag 'repeats is kept. % prints a repStart Sign as stanza if the tag 'repeats is kept.
% if there was a stanza already set by the stanza function with StanzaNumber.details.custom-realstanza = ##t we set that also as stanza. % 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 = \lyricmode { repStartWithTag = \lyricmode {
\tag #'repeats { \tag #'repeats {
\once \override StanzaNumber.details.custom-inline-text = \repStart
\once \override StanzaNumber.details.custom-inline-direction = #LEFT
\applyContext \applyContext
#(lambda (context) #(lambda (context)
(let ((lastStanza (ly:context-property context 'stanza)) (let ((lastStanza (ly:context-property context 'stanza))
@@ -230,11 +180,9 @@ repStartWithTag = \lyricmode {
repStopWithTag = \lyricmode { repStopWithTag = \lyricmode {
\tag #'repeats { \tag #'repeats {
\once \override StanzaNumber.details.custom-inline-text = \repStop
\once \override StanzaNumber.details.custom-inline-direction = #RIGHT
\once \override StanzaNumber.font-series = #'normal \once \override StanzaNumber.font-series = #'normal
\once \override StanzaNumber.direction = 1 \once \override StanzaNumber.direction = 1
\set stanza = \markup { \pad-x-right #1 \repStop } \set stanza = \markup { \repStop }
} }
} }
@@ -318,17 +266,3 @@ rufWithMarkup =
ruf = ruf =
#(define-music-function (text) (string?) #(define-music-function (text) (string?)
(rufWithMarkup (make-ruf-style-markup text))) (rufWithMarkup (make-ruf-style-markup text)))
underlineOn =
#(define-music-function () ()
#{
\override LyricText.stencil =
#(lambda (grob)
(grob-interpret-markup grob (make-underline-markup (ly:grob-property grob 'text))))
#})
underlineOff =
#(define-music-function () ()
#{
\revert LyricText.stencil
#})
+60 -12
View File
@@ -40,19 +40,34 @@ shiftChords = #(define-music-function (parser location xshift chords) (number? l
altChord = altChord =
#(define-music-function (parser location mainchord altchord) (ly:music? ly:music?) #(define-music-function (parser location mainchord altchord) (ly:music? ly:music?)
(let* ((chord-name (lambda (in-pitches bass inversion context) (let* ((remove-point-and-click
(make-line-markup (list (lambda (grob)
(ignatzek-chord-names in-pitches bass inversion context) (ly:grob-set-property! grob 'cause #f)
(make-hspace-markup 0.3) (ly:text-interface::print grob)))
(parenthesis-ignatzek-chord-names (music-pitches (transposable (cons (car (music-pitches mainchord)) (car in-pitches)) (music-clone altchord))) '() '() context) (chord-name (lambda (in-pitches bass inversion context) #{
)) \markup {
))) \translate #'(-0.5 . 0)
\score {
\chords { \transposable #(cons (car (music-pitches mainchord)) (car in-pitches)) { #(music-clone mainchord) \klamm #(music-clone altchord) } }
\layout {
\LAYOUT
\context {
\ChordNames
\override ChordName.extra-spacing-width = #'(0 . 0.3)
\override ChordName.stencil = #remove-point-and-click
}
\context {
\Score
\override SpacingSpanner.spacing-increment = 0
}
}
}
}#})))
#{ #{
\once \set chordNameFunction = #chord-name \once \set chordNameFunction = #chord-name
#mainchord #mainchord
#})) #}))
% Akkorde werden so transponiert, dass sie passen, wenn man mit Kapo im angegebenen Bund spielt % Akkorde werden so transponiert, dass sie passen, wenn man mit Kapo im angegebenen Bund spielt
capoTranspose = capoTranspose =
#(define-music-function (fret chords) (number? ly:music?) #(define-music-function (fret chords) (number? ly:music?)
@@ -65,8 +80,41 @@ capoTranspose =
(ly:make-pitch 0 0) (ly:make-pitch 0 0)
chords)) chords))
% kleine Mollakkorde und Alteration ausgeschrieben
#(define (note-name->german-markup-nosym pitch lowercase?)
(define (pitch-alteration-semitones pitch) (inexact->exact (round (* (ly:pitch-alteration pitch) 2))))
(define (accidental->markup alteration name)
(if (= alteration 0)
(make-line-markup (list empty-markup))
(if (= alteration FLAT)
(if (equal? name "B")
""
; (make-line-markup (list (make-hspace-markup 0.2)
; (make-tiny-markup (make-raise-markup 1.2
; (make-musicglyph-markup (assoc-get alteration standard-alteration-glyph-name-alist ""))))
; ))
(if (or (equal? name "E") (equal? name "A")) "s" "es"))
"is")
))
(define (conditional-string-downcase str condition)
(if condition (string-downcase str) str))
(let* ((name (ly:pitch-notename pitch))
(alt-semitones (pitch-alteration-semitones pitch))
(n-a (if (member (cons name alt-semitones) `((6 . -1) (6 . -2)))
(cons 7 (+ 0 alt-semitones))
(cons name alt-semitones))))
(make-line-markup
(list
(make-simple-markup
(conditional-string-downcase
(vector-ref #("C" "D" "E" "F" "G" "A" "H" "B") (car n-a))
lowercase?))
(accidental->markup (/ (cdr n-a) 2) (vector-ref #("C" "D" "E" "F" "G" "A" "H" "B") (car n-a)) ))))
)
% additional bass notes should get uppercased % additional bass notes should get uppercased
#(define (bassnote-name->german-markup-nosym pitch lowercase?)((chord-name:name-markup 'deutsch) pitch #f)) #(define (bassnote-name->german-markup-nosym pitch lowercase?)(note-name->german-markup-nosym pitch #f))
defaultChordPrintings = { defaultChordPrintings = {
<c g>-\markup { \super "5" } <c g>-\markup { \super "5" }
@@ -109,15 +157,15 @@ generalLayout = \layout {
\generalLayout \generalLayout
\context { \context {
\ChordNames \ChordNames
\semiGermanChords
\override ChordName.font-size = \songScoreChordFontSize \override ChordName.font-size = \songScoreChordFontSize
\override ChordName.font-series = \songChordFontSeries \override ChordName.font-series = \songChordFontSeries
\override ChordName.font-family = #'serif \override ChordName.font-family = #'serif
chordNameLowercaseMinor = ##t chordNameLowercaseMinor = ##t
chordChanges = ##t chordChanges = ##t
chordRootNamer = #(chord-name:name-markup 'deutsch) % eigenen chordRootNamer damit F# = Fis und Gb = Ges (also alteration ausgeschrieben)
chordRootNamer = #note-name->german-markup-nosym
chordNoteNamer = #bassnote-name->german-markup-nosym chordNoteNamer = #bassnote-name->german-markup-nosym
additionalPitchPrefix = ""
majorSevenSymbol = "maj7" majorSevenSymbol = "maj7"
chordNameExceptions = \chordNameExceptions chordNameExceptions = \chordNameExceptions
} }
File diff suppressed because it is too large Load Diff
-550
View File
@@ -1,550 +0,0 @@
%%% 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))))))
@@ -2,18 +2,16 @@
poetPrefix = "Worte:" poetPrefix = "Worte:"
composerPrefix = "Weise:" composerPrefix = "Weise:"
compositionPrefix = "Satz:" compositionPrefix = "Satz:"
adaptionTextPrefix = "Bearbeitung:" adaptionTextPrefix = "Bearbeitung Text:"
adaptionMusicPrefix = "Bearbeitung:" adaptionMusicPrefix = "Bearbeitung Musik:"
poetAndComposerEqualPrefix = "Worte und Weise:" poetAndComposerEqualPrefix = "Worte und Weise:"
voicePrefix = "Stimme:" voicePrefix = "Stimme:"
versePrefix = "Strophe:" versePrefix = "Strophe:"
refPrefix = "Refrain:"
translationAuthorPrefix = "Übersetzung:" translationAuthorPrefix = "Übersetzung:"
translationPrefix = "Übersetzung:" translationPrefix = "Übersetzung:"
pronunciationPrefix = "Aussprache:" pronunciationPrefix = "Aussprache:"
interludePrefix = "Zwischenspiel:" interludePrefix = "Zwischenspiel:"
bridgePrefix = "Bridge:" bridgePrefix = "Bridge:"
author-joiner = #(lambda (author-list) (string-join author-list ", "))
authorFormat = authorFormat =
#(lambda (noDetails name trail_name birth_year death_year organization) #(lambda (noDetails name trail_name birth_year death_year organization)
@@ -33,114 +31,6 @@
"" ""
))) )))
authorContributionFormat =
#(lambda* (render-contribution-group render-partial-contribution-group #:key
(poetIds '())
(translatorIds '())
(versePoetData '())
(composerIds '())
(verseComposerData '())
(refComposerIds '())
(voiceComposerData '())
(compositionIds '())
(adaptionTextIds '())
(adaptionMusicIds '())
(bridgeIds '())
(interludeIds '())
(year_text #f)
(year_translation #f)
(year_melody #f)
(year_melody_meloref #f)
(year_composition #f)
(year_adaption_text #f)
(year_adaption_music #f)
(poetAndComposerEqualPrefix "")
(poetPrefix "")
(composerPrefix "")
(translationAuthorPrefix "")
(pronunciationPrefix "")
(compositionPrefix "")
(adaptionTextPrefix "")
(adaptionMusicPrefix "")
(bridgePrefix "")
(interludePrefix "")
(refPrefix ""))
(if (and
(equal? poetIds composerIds)
(null? translatorIds)
(null? versePoetData)
(null? verseComposerData)
(null? refComposerIds)
(null? voiceComposerData)
(null? compositionIds)
(null? adaptionTextIds)
(null? adaptionMusicIds)
(null? bridgeIds)
(null? interludeIds))
(list
(join-present (list
(render-contribution-group poetAndComposerEqualPrefix poetIds)
(if (equal? year_text year_melody) year_text (join-present (list year_text year_melody) "/"))
) ", ")
#f)
(list
(if (and (null? poetIds) (null? versePoetData) (null? translatorIds)) #f
(string-append
poetPrefix
" "
(join-present (list
(join-present (list
(render-contribution-group "" poetIds)
year_text
) ", ")
(render-partial-contribution-group 'versePrefix versePoetData)
(join-present (list
(render-contribution-group adaptionTextPrefix adaptionTextIds)
year_adaption_text
) ", ")
(join-present (list
(render-contribution-group translationAuthorPrefix translatorIds)
year_translation
) ", ")
) "; ")
))
(if (and
(null? composerIds)
(null? compositionIds)
(null? adaptionMusicIds)
(null? verseComposerData)
(null? refComposerIds)
(null? voiceComposerData)
(null? bridgeIds)
(null? interludeIds)) #f
(string-append
composerPrefix
" "
(join-present (list
(join-present (list
(render-contribution-group "" composerIds)
year_melody
) ", ")
(render-partial-contribution-group 'versePrefix verseComposerData)
(join-present (list
(render-contribution-group refPrefix refComposerIds)
year_melody_meloref
) ", ")
(render-partial-contribution-group 'voicePrefix voiceComposerData)
(join-present (list
(render-contribution-group compositionPrefix compositionIds)
year_composition
) ", ")
(join-present (list
(render-contribution-group adaptionMusicPrefix adaptionMusicIds)
year_adaption_music
) ", ")
(render-contribution-group bridgePrefix bridgeIds)
(render-contribution-group interludePrefix interludeIds)
) "; ")
)))))
songinfoMarkup = songinfoMarkup =
#(make-on-the-fly-markup #(make-on-the-fly-markup
(lambda (layout props m) (lambda (layout props m)
@@ -155,15 +45,13 @@
(year_melody (chain-assoc-get 'songinfo:year_melody props #f)) (year_melody (chain-assoc-get 'songinfo:year_melody props #f))
(poet-with-year (if (and poet-maybe-with-composer year_text) (string-append poet-maybe-with-composer ", " year_text) poet-maybe-with-composer)) (poet-with-year (if (and poet-maybe-with-composer year_text) (string-append poet-maybe-with-composer ", " year_text) poet-maybe-with-composer))
(composer-with-year (if (and composer year_melody) (string-append composer ", " year_melody) composer)) (composer-with-year (if (and composer year_melody) (string-append composer ", " year_melody) composer))
(concat-markupped-strings (lambda (text)
(ly:regex-replace (ly:make-regex "(\\S+)(\\\\\\w+(?:\\s+\\[^\\{\\s]*|\\s*\\{[^\\}]*\\}))(\\S*)") text "\\concat {" 1 "\\line {" 2 "}" 3 "}")))
(string-with-paragraphs->markuplist (lambda (prefix text) (string-with-paragraphs->markuplist (lambda (prefix text)
(if text (if text
(apply append (apply append
(map (map
(lambda (paragraph) (lambda (paragraph)
(make-wordwrap-internal-markup-list #t (make-wordwrap-internal-markup-list #t
#{ \markuplist { $(ly:parser-include-string (concat-markupped-strings paragraph)) } #})) #{ \markuplist { $(ly:parser-include-string paragraph) } #}))
(ly:regex-split (ly:make-regex "\r?\n[ \t\r\n]*\n[ \t\r\n]*") (string-append prefix text)))) (ly:regex-split (ly:make-regex "\r?\n[ \t\r\n]*\n[ \t\r\n]*") (string-append prefix text))))
'()))) '())))
(poet-and-composer-markup-list (poet-and-composer-markup-list
+1 -2
View File
@@ -16,10 +16,9 @@ songTocColumns = 3
globalSize = 15 globalSize = 15
lyricSize = 1.6 lyricSize = 1.6
stanzaFormat = "~a." stanzaFormat = "~a."
romanStanzaFormat = "~@r."
refString = "Ref.:" refString = "Ref.:"
refStringWithNumbers = "Ref. ~a:" refStringWithNumbers = "Ref. ~a:"
bridgeString = "Bridge:"
bridgeStringWithNumbers = "Bridge ~a:"
% hübsche Wiederholungszeichen für den Liedtext % hübsche Wiederholungszeichen für den Liedtext
repStart = "𝄆" repStart = "𝄆"
repStop = "𝄇" repStop = "𝄇"
@@ -6,20 +6,10 @@
#(define-markup-command (customEps layout props ysize filename)(number? string?) #(define-markup-command (customEps layout props ysize filename)(number? string?)
#:properties ((songfilename "")) #:properties ((songfilename ""))
(interpret-markup layout props (interpret-markup layout props
(let* ((defaulttitlemarkup (ly:output-def-lookup layout 'defaultTitleMarkup)) (let ((defaulttitlemarkup (ly:output-def-lookup layout 'defaultTitleMarkup))
;; Determine the song directory to resolve the EPS relative to. (filepath (if (string-null? songfilename)
;; In TEXT the name arrives via the markup props (\setsongfilename), filename
;; but inside MUSIC (e.g. \mark) the props do not carry it, so we (ly:format "~a/~a/~a" songPath songfilename filename))))
;; fall back to the value stored in the score's \layout block.
(layout-songfilename (ly:output-def-lookup layout 'songfilename #f))
(songdir (cond ((not (string-null? songfilename)) songfilename)
((and (string? layout-songfilename)
(not (string-null? layout-songfilename)))
layout-songfilename)
(else #f)))
(filepath (if songdir
(ly:format "~a/~a/~a" songPath songdir filename)
filename)))
(if (file-exists? filepath) (if (file-exists? filepath)
(make-epsfile-markup Y ysize filepath) (make-epsfile-markup Y ysize filepath)
(if defaulttitlemarkup (if defaulttitlemarkup
+93 -38
View File
@@ -30,9 +30,6 @@
(lambda (a b) (< (cadr a) (cadr b)))) (lambda (a b) (< (cadr a) (cadr b))))
(list))) (list)))
#(define (join-present items joiner)
(string-join (filter (lambda (item) (and (string? item) (not (string-null? (string-trim-both item))))) items) joiner))
#(define-markup-command (print-songinfo layout props) () #(define-markup-command (print-songinfo layout props) ()
(define (songinfo-from songId key) (define (songinfo-from songId key)
(let ((song (if (defined? 'SONG_DATA) (assoc-ref SONG_DATA songId) #f))) (let ((song (if (defined? 'SONG_DATA) (assoc-ref SONG_DATA songId) #f)))
@@ -77,7 +74,11 @@
(define (render-contribution-group contributionPrefix authorIds) (define (render-contribution-group contributionPrefix authorIds)
(if (null? authorIds) (if (null? authorIds)
"" ""
(string-append contributionPrefix " " ((ly:output-def-lookup layout 'author-joiner) (format-authors authorIds)))) (string-append contributionPrefix " " (string-join (format-authors authorIds) ", ")))
)
(define (join-present items joiner)
(string-join (filter (lambda (item) (and (string? item) (not (string-null? (string-trim-both item))))) items) joiner)
) )
(define (render-partial-contribution-group prefixLookup authorData) (define (render-partial-contribution-group prefixLookup authorData)
@@ -93,39 +94,93 @@
(define (poet-and-composer-from-authors authors) (define (poet-and-composer-from-authors authors)
(if authors (if authors
((ly:output-def-lookup layout 'authorContributionFormat) (let (
render-contribution-group (poetIds (find-author-ids-by 'text authors))
render-partial-contribution-group (translatorIds (find-author-ids-by 'translation authors))
#:poetIds (find-author-ids-by 'text authors) (versePoetData (find-author-id-with-part-numbers 'verse authors))
#:translatorIds (find-author-ids-by 'translation authors) (composerIds (find-author-ids-by 'melody authors))
#:versePoetData (find-author-id-with-part-numbers 'verse authors) (verseComposerData (find-author-id-with-part-numbers 'meloverse authors))
#:composerIds (find-author-ids-by 'melody authors) (voiceComposerData (find-author-id-with-part-numbers 'voice authors))
#:verseComposerData (find-author-id-with-part-numbers 'meloverse authors) (compositionIds (find-author-ids-by 'composition authors))
#:refComposerIds (find-author-ids-by 'meloref authors) (adaptionTextIds (find-author-ids-by 'adaption_text authors))
#:voiceComposerData (find-author-id-with-part-numbers 'voice authors) (adaptionMusicIds (find-author-ids-by 'adaption_music authors))
#:compositionIds (find-author-ids-by 'composition authors) (bridgeIds (find-author-ids-by 'bridge authors))
#:adaptionTextIds (find-author-ids-by 'adaption_text authors) (interludeIds (find-author-ids-by 'interlude authors))
#:adaptionMusicIds (find-author-ids-by 'adaption_music authors) (year_text (chain-assoc-get 'header:year_text props #f))
#:bridgeIds (find-author-ids-by 'bridge authors) (year_translation (chain-assoc-get 'header:year_translation props #f))
#:interludeIds (find-author-ids-by 'interlude authors) (year_melody (chain-assoc-get 'header:year_melody props #f))
#:year_text (chain-assoc-get 'header:year_text props #f) (year_composition (chain-assoc-get 'header:year_composition props #f))
#:year_translation (chain-assoc-get 'header:year_translation props #f) (year_adaption_text (chain-assoc-get 'header:year_adaption_text props #f))
#:year_melody (chain-assoc-get 'header:year_melody props #f) (year_adaption_music (chain-assoc-get 'header:year_adaption_music props #f))
#:year_melody_meloref (chain-assoc-get 'header:year_melody_meloref props #f) )
#:year_composition (chain-assoc-get 'header:year_composition props #f) (if (and
#:year_adaption_text (chain-assoc-get 'header:year_adaption_text props #f) (equal? poetIds composerIds)
#:year_adaption_music (chain-assoc-get 'header:year_adaption_music props #f) (null? translatorIds)
#:poetAndComposerEqualPrefix (ly:output-def-lookup layout 'poetAndComposerEqualPrefix) (null? versePoetData)
#:poetPrefix (ly:output-def-lookup layout 'poetPrefix) (null? verseComposerData)
#:composerPrefix (ly:output-def-lookup layout 'composerPrefix) (null? voiceComposerData)
#:translationAuthorPrefix (ly:output-def-lookup layout 'translationAuthorPrefix) (null? compositionIds)
#:pronunciationPrefix (ly:output-def-lookup layout 'pronunciationPrefix) (null? adaptionTextIds)
#:compositionPrefix (ly:output-def-lookup layout 'compositionPrefix) (null? adaptionMusicIds)
#:adaptionTextPrefix (ly:output-def-lookup layout 'adaptionTextPrefix) (null? bridgeIds)
#:adaptionMusicPrefix (ly:output-def-lookup layout 'adaptionMusicPrefix) (null? interludeIds))
#:bridgePrefix (ly:output-def-lookup layout 'bridgePrefix) (list
#:interludePrefix (ly:output-def-lookup layout 'interludePrefix) (join-present (list
#:refPrefix (ly:output-def-lookup layout 'refPrefix)) (render-contribution-group (ly:output-def-lookup layout 'poetAndComposerEqualPrefix) poetIds)
(if (equal? year_text year_melody) year_text (join-present (list year_text year_melody) "/"))
) ", ")
#f)
(list
(if (and (null? poetIds) (null? versePoetData) (null? translatorIds)) #f
(string-append
(ly:output-def-lookup layout 'poetPrefix)
" "
(join-present (list
(join-present (list
(render-contribution-group "" poetIds)
year_text
) ", ")
(render-partial-contribution-group 'versePrefix versePoetData)
(join-present (list
(render-contribution-group (ly:output-def-lookup layout 'translationAuthorPrefix) translatorIds)
year_translation
) ", ")
(join-present (list
(render-contribution-group (ly:output-def-lookup layout 'adaptionTextPrefix) adaptionTextIds)
year_adaption_text
) ", ")
) "; ")
))
(if (and
(null? composerIds)
(null? compositionIds)
(null? adaptionMusicIds)
(null? verseComposerData)
(null? voiceComposerData)
(null? bridgeIds)
(null? interludeIds)) #f
(string-append
(ly:output-def-lookup layout 'composerPrefix)
" "
(join-present (list
(join-present (list
(render-contribution-group "" composerIds)
year_melody
) ", ")
(render-partial-contribution-group 'versePrefix verseComposerData)
(render-partial-contribution-group 'voicePrefix voiceComposerData)
(join-present (list
(render-contribution-group (ly:output-def-lookup layout 'compositionPrefix) compositionIds)
year_composition
) ", ")
(join-present (list
(render-contribution-group (ly:output-def-lookup layout 'adaptionMusicPrefix) adaptionMusicIds)
year_adaption_music
) ", ")
(render-contribution-group (ly:output-def-lookup layout 'bridgePrefix) bridgeIds)
(render-contribution-group (ly:output-def-lookup layout 'interludePrefix) interludeIds)
) "; ")
)))))
(list #f #f) (list #f #f)
) )
) )
@@ -145,7 +200,7 @@
(translation (chain-assoc-get 'header:translation props #f)) (translation (chain-assoc-get 'header:translation props #f))
(pronunciation (chain-assoc-get 'header:pronunciation props #f)) (pronunciation (chain-assoc-get 'header:pronunciation props #f))
(year_text (if (string? (car poet-and-composers)) #f (chain-assoc-get 'header:year_text props #f))) (year_text (if (string? (car poet-and-composers)) #f (chain-assoc-get 'header:year_text props #f)))
(year_melody (if (string? (cadr poet-and-composers)) #f (chain-assoc-get 'header:year_melody props #f)))) (year_melody (if (string? (car poet-and-composers)) #f (chain-assoc-get 'header:year_melody props #f))))
(markup (markup
#:override (cons 'songinfo:poet-maybe-with-composer #:override (cons 'songinfo:poet-maybe-with-composer
(if (and poet-maybe-with-composer (not (and (string? poet-maybe-with-composer) (string-null? poet-maybe-with-composer)))) poet-maybe-with-composer #f)) (if (and poet-maybe-with-composer (not (and (string? poet-maybe-with-composer) (string-null? poet-maybe-with-composer)))) poet-maybe-with-composer #f))
@@ -1,16 +0,0 @@
% We have to record the tag groups for markup, so we use the right tag groups during markup interpretiton.
recordedTagGroups = #'()
tagGroup =
#(define-void-function (tags) (symbol-list?)
(let ((err (define-tag-group tags)))
(if err (ly:parser-error err (*location*))
(set! recordedTagGroups (cons tags recordedTagGroups)))))
#(define-markup-command (handle-tag-groups layout props recorded-groups m) (list? markup?)
(resetTagGroups)
(for-each
(lambda (group)
(define-tag-group group))
recorded-groups)
(interpret-markup layout props m))
+127 -232
View File
@@ -1,259 +1,154 @@
(use-modules (ice-9 rdelim) (ice-9 regex) (ice-9 receive) (srfi srfi-1)) (use-modules (ice-9 rdelim) (ice-9 regex) (ice-9 pretty-print) (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) (define (yml-file->scm filename)
;; --- Zeilen einlesen ------------------------------------------------ ;; Utility: Zeile einlesen
(define (read-lines filename)
;; 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 (call-with-input-file filename
(lambda (port) (lambda (port)
(let loop ((items '())) (let loop ((lines '()))
(let ((line (read-line port))) (let ((line (read-line port)))
(if (eof-object? line) (if (eof-object? line)
(reverse items) (reverse lines)
(let* ((line (if (string-suffix? "\r" line) (let ((clean (string-trim line)))
(string-drop-right line 1) (if (or (string=? clean "---") (string-null? clean))
line)) (loop lines) ;; Ignoriere "---" oder leere Zeile
(content (string-trim-both line))) (loop (cons line lines))))))))))
(if (or (string-null? content)
(string-prefix? "#" content)
(string=? content "---")
(string=? content "..."))
(loop items)
(loop (cons (cons (line-indent line) content)
items))))))))))
(define (item-indent item) (car item)) ;; Einrückung bestimmen (Anzahl Leerzeichen am Anfang)
(define (item-content item) (cdr item)) (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
;; --- Skalare ---------------------------------------------------------- ;; Kommentar entfernen
(define (strip-comment line)
(let ((m (string-match "#.*" line)))
(if m
(string-trim-right (string-take line (match:start m)))
line)))
;; Position des schließenden Double-Quotes ab start (oder #f); ;; Hilfsfunktion: Whitespace entfernen
;; Backslash escaped das Folgezeichen. (define (clean-line line)
(define (closing-double-quote s start) (string-trim (strip-comment line)))
(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))))))
;; Position des schließenden Single-Quotes ab start (oder #f); ;; Ist Zeile leer (nach Entfernen von Kommentar & Whitespace)?
;; '' ist ein escaptes Quote. (define (blank-or-comment? line)
(define (closing-single-quote s start) (string-null? (clean-line line)))
(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))))))
;; \\ -> \, \" -> ", \n -> Zeilenumbruch ;; Skalare Werte interpretieren
(define (unescape-double s) (define (parse-scalar str)
(let loop ((chars (string->list s)) (acc '())) (define (strip-quotes s)
(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 (cond
((member s '("{}" "[]" "null")) '()) ((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))
((string=? s "true") #t) ((string=? s "true") #t)
((string=? s "false") #f) ((string=? s "false") #f)
((string-match "^-?[0-9]+(\\.[0-9]+)?$" s) (string->number s)) ((string=? s "null") '())
(else s))) (else s))))
;; 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
((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
(interpret-plain (string-trim-right (strip-plain-comment s)))))))
;; --- Struktur ---------------------------------------------------------- ;; 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))))))
;; Erste Key-Trennstelle: ":" am Zeilenende oder gefolgt von Leerzeichen. ;; Hilfsfunktion: N Zeilen überspringen
;; Beginnt die Zeile mit einem gequoteten Key (oder Skalar), zaehlt ein (define (drop lst n)
;; ":" innerhalb der Quotes nicht als Trennstelle. (let loop ((l lst) (i n))
(define (key-split-index s) (if (or (zero? i) (null? l))
(let ((start (if (string-null? s) l
0 (loop (cdr l) (- i 1)))))
(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 ;; Listenparsing: Liest Zeilen mit `-` als Listeneinträge
;; Strings), unquoted Keys bleiben unveraendert (define (parse-list lines current-indent)
(define (parse-key s) (let loop ((ls lines) (result '()))
(let ((k (string-trim-both s))) (if (null? ls)
(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) (reverse result)
(let* ((content (item-content (car items))) (let* ((line (clean-line (car ls))))
(split (key-split-index content))) (if (string-match "^-" line)
(if (not split) (let* ((indent (line-indent (car ls)))
(begin (item-str (string-trim (string-drop line 1)))
(format (current-error-port) (next-lines (cdr ls)))
"YAML-Syntaxfehler: Ungültige Zeile: ~a\n" content) (if (or (null? next-lines)
(loop (cdr items) result)) (> (line-indent (car next-lines)) indent))
(let ((key (parse-key (string-take content split))) ;; Verschachtelter Inhalt
(value-str (effective-value (let* ((sub (take-indented next-lines (+ indent 2)))
(string-drop content (+ split 1))))) (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)))
(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) (if (string-null? value-str)
;; Wert steht im eingerückten Block darunter ;; Wert auf nachfolgender Einrückungsebene
(receive (children rest) (let* ((sub (take-indented next-lines (+ current-indent 2)))
(span (lambda (it) (> (item-indent it) map-indent)) (parsed (parse-lines sub (+ current-indent 2)))
(cdr items)) (remaining (drop next-lines (length sub))))
(loop rest (loop remaining
(cons (cons key (parse-block children)) (cons (cons key parsed) result)))
result))) ;; Einfacher Key:Value
(loop (cdr items) (loop next-lines
(cons (cons key (parse-scalar value-str)) (cons (cons key (parse-scalar value-str)) result)))))
result))))))))))
;; Liste: "- wert", "- key: value" (Inline-Mapping) oder "-" mit ;; Fehlerhafte Zeile
;; eingerücktem Block darunter (else
(define (parse-list items) ;; Vermeide Fehlermeldung für Leerzeilen oder leere Objekte
(let ((list-indent (item-indent (car items)))) (if (or (string-null? (string-trim line))
(let loop ((items items) (result '())) (member line '("{}" "[]")))
(if (null? items) (loop (cdr ls) result)
(reverse result)
(let ((content (item-content (car items))))
(if (not (dash-line? content))
(begin (begin
(format (current-error-port) (format (current-error-port)
"YAML-Syntaxfehler: Ungültiges Listenelement: ~a\n" "Syntaxfehler: Ungültige Zeile: ~a\n" raw-line)
content) (loop (cdr ls) result))))
(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))) (let ((lines (read-lines filename)))
(parse-lines lines 0)))
(define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename))) (define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename)))
-162
View File
@@ -1,162 +0,0 @@
(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))))
+3 -3
View File
@@ -1,4 +1,4 @@
swing = \textMark \markup { swing = \mark \markup {
\line \general-align #Y #DOWN { \line \general-align #Y #DOWN {
\score { \score {
\new Staff \with { \new Staff \with {
@@ -47,7 +47,7 @@ swing = \textMark \markup {
} }
} }
swingOff = \textMark \markup { swingOff = \mark \markup {
\line \general-align #Y #DOWN { \line \general-align #Y #DOWN {
\score { \score {
\new Staff \with { \new Staff \with {
@@ -99,7 +99,7 @@ swingOff = \textMark \markup {
\include "swing.ly" \include "swing.ly"
swingMusic = swingMusic =
#(define-music-function (music) (ly:music?) #(define-music-function (parser location music) (ly:music?)
(define (partial-duration-length m) (define (partial-duration-length m)
(let ((name (ly:music-property m 'name)) (let ((name (ly:music-property m 'name))
(es (ly:music-property m 'elements)) (es (ly:music-property m 'elements))
@@ -1,5 +1,6 @@
#(define-markup-command (bookTitleMarkupCustom layout props)() #(define-markup-command (bookTitleMarkupCustom layout props)()
(interpret-markup layout props (interpret-markup layout
(prepend-alist-chain 'songfilename (chain-assoc-get 'header:songfilename props "") props)
(make-column-markup (make-column-markup
(list (list
(make-vspace-markup (chain-assoc-get 'header:titletopspace props 0)) (make-vspace-markup (chain-assoc-get 'header:titletopspace props 0))
@@ -26,59 +27,34 @@
#(define pdf-encode (@@ (lily framework-ps) pdf-encode)) #(define pdf-encode (@@ (lily framework-ps) pdf-encode))
% PDF tags % PDF tags
% Erzeugt ein PDF-Lesezeichen (Outline-Eintrag) auf der aktuellen Seite. #(define-markup-command (title-to-pdf-toc layout props title) (string?)
% count = Anzahl der direkten Unterpunkte, die (in Seitenreihenfolge) direkt
% nachfolgen. 0 = Blatt-Eintrag (kein /Count), >0 = aufgeklappt,
% <0 = zugeklappt (Betrag = Anzahl direkter Kinder).
#(define (make-pdf-toc-stencil title count)
(if (string-null? title) (if (string-null? title)
empty-stencil empty-stencil
(ly:make-stencil (ly:make-stencil
(list 'embedded-ps (list 'embedded-ps
(ly:format (ly:format
"[~a/Action /GoTo /View [/XYZ -4 currentpagedevice /PageSize get 1 get 4 add null] /Title (~a) /OUT pdfmark" "[/Action /GoTo /View [/XYZ -4 currentpagedevice /PageSize get 1 get 4 add null] /Title (~a) /OUT pdfmark" (pdf-encode title)))
(if (= count 0) "" (ly:format "/Count ~a " count))
(pdf-encode title)))
empty-interval empty-interval empty-interval empty-interval
;'(0 . 0) '(0 . 0) ;'(0 . 0) '(0 . 0)
))) )))
% Einzelner (Blatt-)Eintrag im PDF-Inhaltsverzeichnis. #(define-markup-command (title-with-category-images layout props right)(boolean?)
#(define-markup-command (title-to-pdf-toc layout props title) (string?) (interpret-markup layout props
(make-pdf-toc-stencil title 0))
% Kapitel-Eintrag mit verschachtelten Unterpunkten.
% count = Anzahl der direkt nachfolgenden Einträge, die diesem Kapitel
% untergeordnet werden sollen (positiv = aufgeklappt, negativ = zugeklappt).
#(define-markup-command (chapter-to-pdf-toc layout props count title) (integer? string?)
(make-pdf-toc-stencil title count))
#(define-markup-command (build-full-title layout props right)(boolean?)
(interpret-markup layout (prepend-alist-chain 'songfilename (chain-assoc-get 'header:songfilename props "") props)
(let* ((title (chain-assoc-get 'header:title props "")) (let* ((title (chain-assoc-get 'header:title props ""))
(starttext (chain-assoc-get 'header:starttext props #f)) (starttext (chain-assoc-get 'header:starttext props #f))
(pdfbookmark (if starttext (string-append starttext " | " title) title)) (pdfbookmark (if starttext (string-append starttext " | " title) title)))
(chaptertitle (chain-assoc-get 'header:chaptertitle props #f))
(chaptercount (chain-assoc-get 'header:chaptercount props 0))
(title-markup (ly:output-def-lookup layout (if right 'oddTitleLineMarkup 'evenTitleLineMarkup))))
(if title (if title
;; Ist dieses Lied das erste eines Kapitels, wird der Kapitel-Eintrag (if right
;; unmittelbar vor dem Lied-Eintrag ausgegeben, damit die pdfmark-/OUT- #{\markup { \title-to-pdf-toc #pdfbookmark \fill-line \general-align #Y #UP { \null \bookTitleMarkupCustom \category-images } } #}
;; Reihenfolge (Elternteil vor Kindern) im PDF-Stream garantiert stimmt. #{\markup { \title-to-pdf-toc #pdfbookmark \fill-line \general-align #Y #UP { \category-images \bookTitleMarkupCustom \null } } #})
(if (and (string? chaptertitle) (not (string-null? chaptertitle))) #{ \markup { " " } #})
(markup #:chapter-to-pdf-toc chaptercount chaptertitle
#:title-to-pdf-toc pdfbookmark title-markup)
(markup #:title-to-pdf-toc pdfbookmark title-markup))
make-null-markup)
))) )))
\paper { \paper {
bookTitleMarkup = \markup \null bookTitleMarkup = \markup \null
scoreTitleMarkup = \markup \null scoreTitleMarkup = \markup \null
oddHeaderMarkup = \markup { \if \on-first-page-of-part \build-full-title ##t } oddHeaderMarkup = \markup { \if \on-first-page-of-part \title-with-category-images ##t }
evenHeaderMarkup = \markup { \if \on-first-page-of-part \build-full-title ##f } evenHeaderMarkup = \markup { \if \on-first-page-of-part \title-with-category-images ##f }
oddTitleLineMarkup = \markup { \fill-line \general-align #Y #UP { \null \bookTitleMarkupCustom \category-images } }
evenTitleLineMarkup = \markup { \fill-line \general-align #Y #UP { \category-images \bookTitleMarkupCustom \null } }
defaultTitleMarkup = \markup { defaultTitleMarkup = \markup {
\override #'(baseline-skip . 3.5) \override #'(baseline-skip . 3.5)
\center-column { \center-column {
+1 -6
View File
@@ -2,12 +2,7 @@ TRANSPOSITION = #(cons #f #f)
transposeGlobal = transposeGlobal =
#(define-void-function (from to) (ly:pitch? ly:pitch?) #(define-void-function (from to) (ly:pitch? ly:pitch?)
(if (not (car TRANSPOSITION)) (set! TRANSPOSITION (cons from to)))
(set! TRANSPOSITION (cons from to))
(let ((current_to (cdr TRANSPOSITION))
(interval (ly:pitch-diff to from)))
(set! TRANSPOSITION (cons (car TRANSPOSITION)
(ly:pitch-transpose current_to interval))))))
transposable = transposable =
#(define-music-function (fromto music) (pair? ly:music?) #(define-music-function (fromto music) (pair? ly:music?)
+27 -45
View File
@@ -60,15 +60,14 @@
% Text über Text mittig darstellen % Text über Text mittig darstellen
#(define-markup-command (textup layout props text uptext) (markup? markup?) #(define-markup-command (textup layout props text uptext) (markup? markup?)
#:properties ((verselayout generalLayout) #:properties ((verselayout generalLayout))
(verse-text-chord-distance songTextChordDistance))
"Markup über Text mittig darstellen." "Markup über Text mittig darstellen."
(interpret-markup layout props (interpret-markup layout props
#{\markup { #{\markup {
\size-box-to-box-style-dependent ##t ##f \size-box-to-box-style-dependent ##t ##f
\general-align #X #LEFT \override #`(direction . ,UP) \override #'(baseline-skip . 1) \dir-column \chord-alignment-style-dependent { \general-align #X #LEFT \override #`(direction . ,UP) \override #'(baseline-skip . 1.0) \dir-column \chord-alignment-style-dependent {
\pad-to-box #'(0 . 0) #`(0 . ,(- verse-text-chord-distance 0.8)) { #text } \pad-to-box #'(0 . 0) #'(0 . 2.0) { #text }
\size-box-to-box ##f ##t #uptext \score { \chords { g4:m a } \layout { $verselayout #(customized-layout verselayout) } } \size-box-to-box ##f ##t #uptext \score { \chords { g4:m a } \layout { $verselayout } }
} }
#text #text
} }
@@ -89,7 +88,7 @@
(if (and (string? arg) (string-null? arg)) (if (and (string? arg) (string-null? arg))
" " " "
#{\markup #{\markup
\score { \new Lyrics { \lyricmode { #(if (ly:music? arg) arg #{ \set stanza = #arg #}) "" } } \layout { $verselayout #(customized-layout verselayout) } } \score { \new Lyrics { \lyricmode { #(if (ly:music? arg) arg #{ \set stanza = #arg #}) "" } } \layout { $verselayout } }
#} #}
))) )))
@@ -141,7 +140,7 @@
(make-wrap-newline-markup (make-wrap-newline-markup
(ly:regex-replace (ly:make-regex "\\(( *)([^,()]*)( *),([^)]*)\\)") (ly:regex-replace (ly:make-regex "\\(( *)([^,()]*)( *),([^)]*)\\)")
(ly:regex-replace (ly:make-regex "(([^ \n]*\\([^()]*,[^()]+\\)[^ \n(]*)+)") (handle-custom-newlines custom-verse-breaks verse) " \\concat { " 1 " } ") (ly:regex-replace (ly:make-regex "(([^ \n]*\\([^()]*,[^()]+\\)[^ \n(]*)+)") (handle-custom-newlines custom-verse-breaks verse) " \\concat { " 1 " } ")
"\\textup \\line { \"" 1 "\" " 2 " \"" 3 "\" } \\score { " transp " \\chords { s4 " 4 " } \\layout { $verselayout #(customized-layout verselayout) } }") "\\textup \\line { \"" 1 "\" " 2 " \"" 3 "\" } \\score { " transp " \\chords { s4 " 4 " } \\layout { $verselayout } }")
) )
)))) ))))
@@ -182,19 +181,7 @@
((if reverses fold fold-right) (lambda (element filled-list) ((if reverses fold fold-right) (lambda (element filled-list)
(cons element (if (null? filled-list) '() (cons markup-between filled-list)))) (cons element (if (null? filled-list) '() (cons markup-between filled-list))))
'() elements)) '() elements))
;; Dokumentposition fuer den ChordPro-/Data-Collector: jede Gruppe nimmt (let* ((column-item-count (ceiling (/ (length versegroup) verse-cols)))
;; 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))) (column-data (make-list verse-cols)))
(let columnize-list ((index 0) (items versegroup)) (let columnize-list ((index 0) (items versegroup))
(if (not (null? items)) (if (not (null? items))
@@ -215,9 +202,23 @@
#(define-markup-command (pad-left layout props amount arg) #(define-markup-command (pad-left layout props amount arg)
(number? markup?) (number? markup?)
(let* ((m (interpret-markup layout props arg))
(x (ly:stencil-extent m X))
(y (ly:stencil-extent m Y)))
(ly:stencil-translate (ly:stencil-translate
(interpret-markup layout props (make-pad-x-left-markup amount arg)) (ly:make-stencil (ly:stencil-expr m)
`(,amount . 0))) (cons (- (car x) amount) (cdr x))
y)
`(,amount . 0))))
#(define-markup-command (pad-right layout props amount arg)
(number? markup?)
(let* ((m (interpret-markup layout props arg))
(x (ly:stencil-extent m X))
(y (ly:stencil-extent m Y)))
(ly:make-stencil (ly:stencil-expr m)
(cons (car x) (+ (cdr x) amount))
y)))
#(define-markup-command (score-equal-height-with-indents layout props lines) #(define-markup-command (score-equal-height-with-indents layout props lines)
(markup-list?) (markup-list?)
@@ -248,7 +249,7 @@
(let ((text (ly:grob-property grob 'text))) (let ((text (ly:grob-property grob 'text)))
(grob-interpret-markup grob (if (string? text) (grob-interpret-markup grob (if (string? text)
(make-pad-x-right-markup -0.1 (make-tied-lyric-markup text)) (make-pad-right-markup -0.1 (make-tied-lyric-markup text))
text)))) text))))
Chord_lyrics_spacing_engraver = Chord_lyrics_spacing_engraver =
@@ -300,10 +301,9 @@ Chord_lyrics_spacing_engraver =
(ly:grob-set-property! grob 'extra-spacing-width (ly:grob-set-property! grob 'extra-spacing-width
(cons (- chord-width-since-last-lyric) (cdr (ly:grob-property grob 'extra-spacing-width '(0 . 0))))) (cons (- chord-width-since-last-lyric) (cdr (ly:grob-property grob 'extra-spacing-width '(0 . 0)))))
(if last-printed-chord (if last-printed-chord
(let ((gap-for-starting-rest 2.0)) (begin
(if stanza (ly:grob-set-property! stanza 'padding (+ 1 gap-for-starting-rest))) (if stanza (ly:grob-set-property! stanza 'padding chord-width-since-last-lyric))
(ly:grob-set-parent! grob X last-printed-chord) (place-at-right-edge grob last-printed-chord 0)
(ly:grob-set-property! grob 'X-offset gap-for-starting-rest)
))) )))
) )
(set! last-lyric-syllable grob) (set! last-lyric-syllable grob)
@@ -353,20 +353,6 @@ Chord_lyrics_spacing_engraver =
(transposition (cons #f #f)) (transposition (cons #f #f))
(verselayout generalLayout)) (verselayout generalLayout))
"Vers mit Akkorden" "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 (interpret-markup layout props
#{ #{
\markup { \markup {
@@ -379,7 +365,6 @@ Chord_lyrics_spacing_engraver =
>> >>
\layout { \layout {
$verselayout $verselayout
#(customized-layout verselayout)
ragged-right = ##t ragged-right = ##t
\context { \context {
\Lyrics \Lyrics
@@ -405,15 +390,12 @@ Chord_lyrics_spacing_engraver =
\override SpacingSpanner.spacing-increment = 0 \override SpacingSpanner.spacing-increment = 0
% \override SpacingSpanner.packed-spacing = ##t % \override SpacingSpanner.packed-spacing = ##t
\consists \Chord_lyrics_spacing_engraver \consists \Chord_lyrics_spacing_engraver
% ChordPro engraver in Score context to collect all data
\consists \ChordPro_score_collector
\remove Bar_number_engraver \remove Bar_number_engraver
\remove Mark_engraver \remove Mark_engraver
\remove Jump_engraver \remove Jump_engraver
\remove Volta_engraver \remove Volta_engraver
\remove Parenthesis_engraver \remove Parenthesis_engraver
\remove Metronome_mark_engraver \remove Metronome_mark_engraver
\remove Text_mark_engraver
} }
\context { \context {
\Staff \Staff
+27 -290
View File
@@ -65,26 +65,6 @@ additionalPageNumbers =
display-pages-list 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: % TODO:
% Eigentlich können wir das direkt in oddFooderMarkup und evenFooterMarkup aufrufen % 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 % vermutlich sogar ohne den delay kram. Wir sollten außerdem einfach nur die property
@@ -117,7 +97,12 @@ width may require additional tweaking.)"
(if (assq-ref additional-page-switch-label-list label) (if (assq-ref additional-page-switch-label-list label)
(make-concat-markup (list (number-format number-type display-page) (make-concat-markup (list (number-format number-type display-page)
(make-char-markup (+ 97 (- real-current-page (real-page-number layout (make-char-markup (+ 97 (- real-current-page (real-page-number layout
(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)))
))))))
(number-format number-type (+ display-page (- real-current-page (real-page-number layout label)))) (number-format number-type (+ display-page (- real-current-page (real-page-number layout label))))
)) ))
(page-stencil (interpret-markup layout props page-markup)) (page-stencil (interpret-markup layout props page-markup))
@@ -133,141 +118,44 @@ width may require additional tweaking.)"
(make-filled-box-stencil x-ext y-ext)))) (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 = includeSong =
#(define-void-function (filename) (string?) #(define-void-function (parser location filename) (string?)
#{ #{
\bookOutputName #filename \bookOutputName #filename
#} #}
(ly:parser-parse-string (ly:parser-clone) (ly:parser-parse-string (ly:parser-clone)
(ly:format "\\include \"~a/~a/~a.ly\"" songPath filename filename)) (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"))) (let ((label (gensym "index")))
(set! additional-page-switch-label-list (set! additional-page-switch-label-list
(acons label additional-page-numbers additional-page-switch-label-list)) (acons label additional-page-numbers additional-page-switch-label-list))
(set! song-list (set! song-list
(acons (string->symbol filename) (acons (string->symbol filename)
`( (acons 'label label
(label . ,label) (acons 'header HEADER
(header . ,HEADER) (acons 'music MUSIC
(music . ,MUSIC) (acons 'layout LAYOUT
(layout . ,LAYOUT) (acons 'text-pages
(text-pages . ,(map (lambda (text) (map (lambda (text)
#{ \markuplist \setsongfilename $filename $text #}) #{ \markuplist \setsongfilename $filename $text #})
TEXT_PAGES)) TEXT_PAGES)
) '())))))
song-list)) song-list))
)) ))
blankpage = blankpage =
#(define-void-function () () #(define-void-function (parser location) ()
(set! song-list (set! song-list
(acons 'emptyPage (acons 'emptyPage
'() '()
song-list))) song-list)))
imagepage = imagepage =
#(define-void-function (xsize filename) (number? string?) #(define-void-function (parser location xsize filename) (number? string?)
(set! song-list (set! song-list
(acons 'imagePage (acons 'imagePage
`((xsize . ,xsize) (acons 'xsize xsize (acons 'filename filename '()))
(filename . ,filename))
song-list))) song-list)))
markuppage =
#(define-void-function (mkup) (markup?)
(set! song-list
(acons 'markupPage
`((markup . ,mkup))
song-list)))
#(define chapters '())
songsChapter =
#(define-void-function (title) (string?)
(set! chapters
(cons (cons title (length song-list)) chapters)))
#(define-markup-command (pagecenter layout props stuff)(markup?) #(define-markup-command (pagecenter layout props stuff)(markup?)
(interpret-markup layout props (interpret-markup layout props
(let ((halfpaperheight (/ (ly:output-def-lookup layout 'paper-height) 2)) (let ((halfpaperheight (/ (ly:output-def-lookup layout 'paper-height) 2))
@@ -276,86 +164,16 @@ songsChapter =
))) )))
songs = songs =
#(define-void-function () () #(define-void-function (parser location) ()
(let* ((ordered (reverse song-list))
(total (length ordered))
;; Ein Lied erzeugt nur dann einen PDF-Outline-Eintrag (/OUT), wenn
;; title oder starttext gesetzt sind (siehe build-full-title). Nur solche
;; 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.
(emits-bookmark?
(lambda (e)
(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) (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.
(chapters-asc (sort chapters (lambda (a b) (< (cdr a) (cdr b)))))
;; pending: aufsteigende Liste von (start title count); count = Anzahl
;; der Lesezeichen-Lieder von diesem Kapitel bis zum Beginn des naechsten.
(pending
(let loop ((chs chapters-asc) (acc '()))
(if (null? chs)
(reverse acc)
(let* ((title (caar chs))
(start (cdar chs))
(end (if (null? (cdr chs)) total (cdadr chs)))
(cnt (count-bookmark-songs start end)))
(loop (cdr chs) (cons (list start title cnt) acc))))))
;; Aktuell aktives Kapitel (Titel-String) waehrend des Durchlaufs. Wird
;; gesetzt, sobald ein Kapitel aktiviert (aus `pending` entfernt) wird --
;; egal ob auf einer Seite (chapter-prefixed-markup) oder auf dem ersten
;; Song. Jeder danach folgende Song erhaelt dieses Kapitel als
;; chapterref-Header-Feld, woraus toc_include.ily den Kapitel-Index baut.
(current-chapter #f)
;; Stellt einer beliebigen Seite (markup-/image-/emptyPage) den Kapitel-
;; Eintrag (chapter-to-pdf-toc) bei, falls an Position `this-index` ein
;; Kapitel faellig ist, und entfernt es aus `pending`. So fuehrt die
;; Kapitel-Referenz zur ersten Seite nach dem \songsChapter -- egal
;; welcher Seitentyp das ist. Der Eintrag wird als unsichtbares Overlay
;; (\combine) beigelegt, damit er das Seitenlayout nicht veraendert;
;; \with-dimensions gibt dem sonst extent-losen pdfmark einen minimalen
;; Extent, damit er auch auf leeren Seiten nicht verworfen wird.
(chapter-prefixed-markup
(lambda (this-index base-markup)
(if (and (pair? pending) (<= (car (car pending)) this-index))
(let ((cnt (caddr (car pending)))
(title (cadr (car pending))))
(set! pending (cdr pending))
(set! current-chapter title)
(make-combine-markup
base-markup
(make-with-dimensions-markup '(0 . 0) '(0 . 0.1)
(make-chapter-to-pdf-toc-markup cnt title))))
base-markup)))
(index 0))
(for-each (lambda (songitems) (for-each (lambda (songitems)
(let ((this-index index))
(set! index (+ index 1))
(ly:book-add-bookpart! (ly:parser-lookup '$current-book) (ly:book-add-bookpart! (ly:parser-lookup '$current-book)
(let ((filename (car songitems)) (let ((filename (car songitems))
(songvars (cdr songitems))) (songvars (cdr songitems)))
(if (eq? filename 'emptyPage) (if (eq? filename 'emptyPage)
#{ \bookpart { \markup { $(chapter-prefixed-markup this-index (make-null-markup)) } } #} #{ \bookpart { \markup { \null } } #}
(if (eq? filename 'markupPage)
;; Kapitelanfang auf einer markuppage: Kapitel-Eintrag wird dieser
;; Seite beigelegt (siehe chapter-prefixed-markup).
#{ \bookpart { \markup { $(chapter-prefixed-markup this-index (assq-ref songvars 'markup)) } } #}
(if (eq? filename 'imagePage) (if (eq? filename 'imagePage)
(let* ((xsize (assq-ref songvars 'xsize)) (let ((xsize (assq-ref songvars 'xsize))
(filename (ly:format "~a/~a" imagePagePath (assq-ref songvars 'filename))) (filename (ly:format "~a/~a" imagePagePath (assq-ref songvars 'filename))))
(img-markup #{ \markup { \pagecenter { \epsfile #X #xsize #filename } } #}))
#{ \bookpart { #{ \bookpart {
\paper { \paper {
%{ %{
@@ -369,111 +187,30 @@ songs =
last-bottom-spacing = #'((basic-distance . 0) (minimum-distance . 0) (padding . 0)) last-bottom-spacing = #'((basic-distance . 0) (minimum-distance . 0) (padding . 0))
page-count = 1 page-count = 1
} }
\markup { $(chapter-prefixed-markup this-index img-markup) } \markup { \pagecenter { \epsfile #X #xsize #filename } }
} #} } #}
) )
;; Ist ein Kapitel faellig (Start <= aktuelle Position) und dies ein
;; echtes Lied, wird die Kapitelinfo an dieses Lied gehaengt und aus
;; `pending` entfernt.
(let* ((newnumber (+ 1 song-number)) (let* ((newnumber (+ 1 song-number))
(chaptertitle (if (and (pair? pending) (<= (car (car pending)) this-index))
(cadr (car pending)) #f))
(chaptercount (if chaptertitle (caddr (car pending)) 0))
;; Startet das Kapitel erst auf diesem Song (nicht schon auf
;; einer vorangehenden Seite), wird current-chapter jetzt
;; gesetzt und pending entfernt -- vor dem Bau des Headers,
;; damit chapterref bereits das neue Kapitel enthaelt.
(_ (if chaptertitle
(begin (set! current-chapter chaptertitle)
(set! pending (cdr pending)))))
(header #{ \bookpart { $(assq-ref songvars 'header) \header { (header #{ \bookpart { $(assq-ref songvars 'header) \header {
songfilename = $(symbol->string filename) songfilename = $(symbol->string filename)
myindexlabel = #(assq-ref songvars 'label) myindexlabel = #(assq-ref songvars 'label)
songnumber = #(number->string newnumber) songnumber = #(number->string newnumber)
chaptertitle = #chaptertitle
chaptercount = #chaptercount
chapterref = #current-chapter
} } #}) } } #})
(music (assq-ref songvars 'music)) (music (assq-ref songvars 'music))
(layout (assq-ref songvars 'layout)) (layout (assq-ref songvars 'layout))
(text-pages (assq-ref songvars 'text-pages)) (text-pages (assq-ref songvars 'text-pages))
(label (assq-ref songvars 'label))) (label (assq-ref songvars 'label)))
(set! song-number newnumber) (set! song-number newnumber)
;; 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 { \bookpart {
$header $header
\headerToTOC #header #label \headerToTOC #header #label
\score { \score { $music \layout { $layout } }
$score-music
$song-layout
}
$(add-text-pages text-pages) $(add-text-pages text-pages)
} }
#}))))))))) #}))))))
ordered (reverse song-list)
))) ))
#(define (boernel-stats) #(define (boernel-stats)
(let ( (let (
+8 -52
View File
@@ -132,37 +132,6 @@
author-index-hash) author-index-hash)
(lambda (a b) (string-ci<? (car a) (car b)))))))) (lambda (a b) (string-ci<? (car a) (car b))))))))
% code for chapter index
% Anders als bei Kategorien/Autoren ergibt sich die Kapitelzugehoerigkeit nicht
% aus dem Song-Header, sondern aus dem \songsChapter, das dem Song vorangeht
% (in book_include.ily als Header-Feld chapterref an jeden Song gehaengt).
% Die Kapitel behalten hier ihre Auftritts-Reihenfolge (nicht alphabetisch),
% ebenso die Songs innerhalb eines Kapitels ihre Song-Reihenfolge.
#(define*-public (add-chapter-index-item! chapter markup-symbol textoptions #:optional label) #f)
#(define-public (chapter-index-items) #f)
#(let ((chapter-index-hash (make-hash-table))
(chapter-order '()))
(set! add-chapter-index-item!
(lambda* (chapter markup-symbol textoptions #:optional (label (gensym "index")))
(let* ((chaptersym (string->symbol chapter))
(existing (hashq-ref chapter-index-hash chaptersym #f))
(chapterlist (or existing
(begin
(set! chapter-order (cons chaptersym chapter-order))
(list (list label 'indexChapterMarkup `(((combine-with-next . #t) (rawtext . ,chapter))))))))
)
(hashq-set! chapter-index-hash chaptersym
(cons (list label markup-symbol textoptions) chapterlist)))
(make-music 'EventChord
'page-marker #t
'page-label label
'elements (list (make-music 'LabelEvent
'page-label label)))))
(set! chapter-index-items (lambda ()
(append-map (lambda (chaptersym) (reverse (hashq-ref chapter-index-hash chaptersym (list))))
(reverse chapter-order)))))
#(define-markup-command (with-link-symbol-ref layout props symbol arg) #(define-markup-command (with-link-symbol-ref layout props symbol arg)
(symbol? markup?) (symbol? markup?)
@@ -246,11 +215,6 @@
(make-null-markup)) (make-null-markup))
\vspace #.4 \vspace #.4
} }
indexChapterMarkup = \markup \override #'(baseline-skip . 1.5) \left-column {
\vspace #1
\sans \bold \fontsize #3 \fromproperty #'index:text
\vspace #.4
}
} }
#(define (prepare-item-markup items layout) #(define (prepare-item-markup items layout)
@@ -283,8 +247,7 @@
(let ((items (case index-type (let ((items (case index-type
((alphabetical) index-items) ((alphabetical) index-items)
((categories) category-index-items) ((categories) category-index-items)
((authors) author-index-items) ((authors) author-index-items)))
((chapters) chapter-index-items)))
(title (interpret-markup layout props title-markup))) (title (interpret-markup layout props title-markup)))
(cons title (cons title
(interpret-markup-list layout props (interpret-markup-list layout props
@@ -320,18 +283,17 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
(versePoetData (find-author-id-with-part-numbers 'verse authors)) (versePoetData (find-author-id-with-part-numbers 'verse authors))
(composerIds (find-author-ids-by 'melody authors)) (composerIds (find-author-ids-by 'melody authors))
(verseComposerData (find-author-id-with-part-numbers 'meloverse authors)) (verseComposerData (find-author-id-with-part-numbers 'meloverse authors))
(refComposerIds (find-author-ids-by 'meloref authors))
(voiceComposerData (find-author-id-with-part-numbers 'voice authors)) (voiceComposerData (find-author-id-with-part-numbers 'voice authors))
(compositionIds (find-author-ids-by 'composition authors)) (compositionIds (find-author-ids-by 'composition authors))
(adaptionIds (find-author-ids-by 'adaption authors)) (adaptionIds (find-author-ids-by 'adaption authors))
(bridgeIds (find-author-ids-by 'bridge authors)) (bridgeIds (find-author-ids-by 'bridge authors))
(interludeIds (find-author-ids-by 'interlude authors))) (interludeIds (find-author-ids-by 'interlude authors)))
(delete-duplicates (delete-duplicates
(append poetIds translatorIds (map car versePoetData) composerIds (map car verseComposerData) refComposerIds (map car voiceComposerData) compositionIds adaptionIds bridgeIds interludeIds)) (append poetIds translatorIds (map car versePoetData) composerIds (map car verseComposerData) (map car voiceComposerData) compositionIds adaptionIds bridgeIds interludeIds))
)) ))
(let* (let*
( (
(extractedheadervars (extract-and-check-vars-from-header header '(title starttext alttitle categorytitle categories authors songnumber chapterref))) (extractedheadervars (extract-and-check-vars-from-header header '(title starttext alttitle categorytitle categories authors songnumber)))
(title (assq-ref extractedheadervars 'title)) (title (assq-ref extractedheadervars 'title))
(starttext (assq-ref extractedheadervars 'starttext)) (starttext (assq-ref extractedheadervars 'starttext))
(alttitle (assq-ref extractedheadervars 'alttitle)) (alttitle (assq-ref extractedheadervars 'alttitle))
@@ -339,14 +301,12 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
(categories (assq-ref extractedheadervars 'categories)) (categories (assq-ref extractedheadervars 'categories))
(authors (assq-ref extractedheadervars 'authors)) (authors (assq-ref extractedheadervars 'authors))
(songnumber (assq-ref extractedheadervars 'songnumber)) (songnumber (assq-ref extractedheadervars 'songnumber))
(chapterref (assq-ref extractedheadervars 'chapterref))
(textoptions (lambda (text alternative) `(((rawtext . ,text) (alternative . ,alternative) (songnumber . ,songnumber))))) (textoptions (lambda (text alternative) `(((rawtext . ,text) (alternative . ,alternative) (songnumber . ,songnumber)))))
(add-to-toc! (lambda (toctitle alternative) (add-to-toc! (lambda (toctitle alternative)
(add-index-item! 'indexItemMarkup (textoptions toctitle alternative) toctitle label))) (add-index-item! 'indexItemMarkup (textoptions toctitle alternative) toctitle label)))
) )
(if categories (add-category-index-item! (string-tokenize categories) 'indexItemMarkup (textoptions (if categorytitle categorytitle title) #f) label)) (if categories (add-category-index-item! (string-tokenize categories) 'indexItemMarkup (textoptions (if categorytitle categorytitle title) #f) label))
(if authors (add-author-index-item! (all-author-ids authors) 'indexItemMarkup (textoptions (if categorytitle categorytitle title) #f) label)) (if authors (add-author-index-item! (all-author-ids authors) 'indexItemMarkup (textoptions (if categorytitle categorytitle title) #f) label))
(if chapterref (add-chapter-index-item! chapterref 'indexItemMarkup (textoptions (if categorytitle categorytitle title) #f) label))
(if starttext (add-to-toc! starttext #t)) (if starttext (add-to-toc! starttext #t))
(if alttitle (if alttitle
(if (list? alttitle) (if (list? alttitle)
@@ -370,9 +330,6 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
#(define csv-write sxml->csv) #(define csv-write sxml->csv)
#(define-markup-command (write-toc-csv layout props) () #(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) (define (csv-escape field)
(if (string-null? field) (if (string-null? field)
field field
@@ -408,7 +365,7 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
(let ((song-lines (map (lambda (song) (let ((song-lines (map (lambda (song)
(let* ((filename (symbol->string (car song))) (let* ((filename (symbol->string (car song)))
(songvars (cdr song)) (songvars (cdr song))
(page-number (assoc-get (assq-ref songvars 'label) labelPageTable)) (page-number (number->string (assoc-get (assq-ref songvars 'label) labelPageTable)))
(extractedheadervars (extract-and-check-vars-from-header (assq-ref songvars 'header) (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))) '(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) (headervar-or-empty (lambda (varsym)
@@ -420,7 +377,6 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
(versePoetData (find-author-id-with-part-numbers 'verse authors)) (versePoetData (find-author-id-with-part-numbers 'verse authors))
(composerIds (find-author-ids-by 'melody authors)) (composerIds (find-author-ids-by 'melody authors))
(verseComposerData (find-author-id-with-part-numbers 'meloverse authors)) (verseComposerData (find-author-id-with-part-numbers 'meloverse authors))
(refComposerIds (find-author-ids-by 'meloref authors))
(voiceComposerData (find-author-id-with-part-numbers 'voice authors)) (voiceComposerData (find-author-id-with-part-numbers 'voice authors))
(compositionIds (find-author-ids-by 'composition authors)) (compositionIds (find-author-ids-by 'composition authors))
(adaptionTextIds (find-author-ids-by 'adaption_text authors)) (adaptionTextIds (find-author-ids-by 'adaption_text authors))
@@ -442,7 +398,7 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
(headervar-or-empty 'categories) (headervar-or-empty 'categories)
(format-authors (append poetIds adaptionTextIds (map car versePoetData))) (format-authors (append poetIds adaptionTextIds (map car versePoetData)))
(format-authors translatorIds) (format-authors translatorIds)
(format-authors (append composerIds compositionIds adaptionMusicIds bridgeIds interludeIds (map car voiceComposerData) (map car verseComposerData) refComposerIds)) (format-authors (append composerIds compositionIds adaptionMusicIds bridgeIds interludeIds (map car voiceComposerData) (map car verseComposerData)))
(headervar-or-empty 'year_text) (headervar-or-empty 'year_text)
(headervar-or-empty 'year_melody) (headervar-or-empty 'year_melody)
(headervar-or-empty 'year_translation) (headervar-or-empty 'year_translation)
@@ -455,8 +411,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 'translation))
(format-info-paragraphs (headervar-or-empty 'pronunciation)) (format-info-paragraphs (headervar-or-empty 'pronunciation))
)))) ))))
(alist-delete 'markupPage (alist-delete 'imagePage (alist-delete 'emptyPage song-list)))))) (alist-delete 'imagePage (alist-delete 'emptyPage song-list)))))
(call-with-output-file csv-filename (call-with-output-file "toc.csv"
(lambda (port) (lambda (port)
(csv-write (cons '( (csv-write (cons '(
"filename" "filename"
@@ -485,6 +441,6 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
; we use a delayed stencil to have all the page references available ; we use a delayed stencil to have all the page references available
(ly:make-stencil (ly:make-stencil
`(delay-stencil-evaluation `(delay-stencil-evaluation
,(delay (let* ((table (ly:output-def-lookup layout 'label-page-string-table))) ,(delay (let* ((table (ly:output-def-lookup layout 'label-page-table)))
(generate-toc-csv (if (list? table) table '())) (generate-toc-csv (if (list? table) table '()))
empty-stencil))))) empty-stencil)))))
+4 -77
View File
@@ -2,7 +2,9 @@ MUSIC = { \transposable #TRANSPOSITION \MUSIC }
LAYOUT = \layout { LAYOUT = \layout {
\LAYOUT \LAYOUT
#(customized-layout LAYOUT) #(let
((custom-size (ly:output-def-lookup LAYOUT 'size #f)))
(if custom-size (layout-set-staff-size custom-size)))
} }
verselayout = \layout { verselayout = \layout {
@@ -18,7 +20,6 @@ TEXT = \markuplist {
\override #`(verselayout . ,verselayout) \override #`(verselayout . ,verselayout)
\override #`(verse-chords . ,#{ \chords { \verseChords } #}) \override #`(verse-chords . ,#{ \chords { \verseChords } #})
\override #`(verse-reference-voice . ,#{ \global \firstVoice #}) \override #`(verse-reference-voice . ,#{ \global \firstVoice #})
\handle-tag-groups \recordedTagGroups
\TEXT \TEXT
} }
@@ -30,7 +31,6 @@ TEXT = \markuplist {
\override #`(verselayout . ,verselayout) \override #`(verselayout . ,verselayout)
\override #`(verse-chords . ,#{ \chords { \verseChords } #}) \override #`(verse-chords . ,#{ \chords { \verseChords } #})
\override #`(verse-reference-voice . ,#{ \global \firstVoice #}) \override #`(verse-reference-voice . ,#{ \global \firstVoice #})
\handle-tag-groups \recordedTagGroups
#text #text
} }
#}) #})
@@ -41,20 +41,6 @@ TEXT = \markuplist {
TEXT_PAGES TEXT_PAGES
(list TEXT)))) (list TEXT))))
%% Add invisible ChordPro write trigger to last TEXT_PAGES markuplist
#(when (and (defined? 'chordpro-export-enabled) chordpro-export-enabled (pair? TEXT_PAGES))
(let* ((last-index (- (length TEXT_PAGES) 1))
(last-page (list-ref TEXT_PAGES last-index))
(modified-last-page #{
\markuplist {
#last-page
\chordpro-delayed-write
}
#}))
(set! TEXT_PAGES
(append (list-head TEXT_PAGES last-index)
(list modified-last-page)))))
#(define (add-text-pages text-pages) #(define (add-text-pages text-pages)
(if (pair? text-pages) (if (pair? text-pages)
(begin (begin
@@ -71,71 +57,12 @@ TEXT = \markuplist {
(if header (set! $defaultheader header)) (if header (set! $defaultheader header))
(if paper (set! $defaultpaper paper)) (if paper (set! $defaultpaper paper))
) )
;; 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)
(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 #{ (add-score #{
\score { \score {
\MUSIC \MUSIC
\layout { \LAYOUT } \layout { \LAYOUT }
}#})) }#})
(add-text-pages TEXT_PAGES) (add-text-pages TEXT_PAGES)
(add-score #{ (add-score #{
\score { \score {
\unfoldRepeats { \MUSIC \INLINESCOREMUSIC } \unfoldRepeats { \MUSIC \INLINESCOREMUSIC }