Compare commits
5
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
39d9e8c0d5 | ||
|
|
dfd72cd64d | ||
|
|
d0db6fae69 | ||
|
|
2359a7c5ae | ||
|
|
809100b2f3 |
No files matched your search
@@ -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
|
||||||
@@ -34,13 +33,14 @@
|
|||||||
#(define AUTHOR_DATA (if (defined? 'AUTHOR_DATA) AUTHOR_DATA (parse-yml-file (song-includes-data-path "authors.yml"))))
|
#(define AUTHOR_DATA (if (defined? 'AUTHOR_DATA) AUTHOR_DATA (parse-yml-file (song-includes-data-path "authors.yml"))))
|
||||||
#(define SONG_DATA (if (defined? 'SONG_DATA) SONG_DATA (parse-yml-file (song-includes-data-path "songs.yml"))))
|
#(define SONG_DATA (if (defined? 'SONG_DATA) SONG_DATA (parse-yml-file (song-includes-data-path "songs.yml"))))
|
||||||
|
|
||||||
|
\include #(if (ly:version? < '(2 27 0)) "compat_lilypond_2_26.ily" "../void.ily")
|
||||||
\include "merge_rests_engraver_override.ily"
|
\include "merge_rests_engraver_override.ily"
|
||||||
\include "basic_format_and_style_settings.ily"
|
\include "basic_format_and_style_settings.ily"
|
||||||
\include "eps_file_from_song_dir.ily"
|
\include "eps_file_from_song_dir.ily"
|
||||||
|
\include "embedded_songs.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 "chordpro.ily"
|
||||||
\include "data_extractor.ily"
|
|
||||||
\include "transposition.ily"
|
\include "transposition.ily"
|
||||||
\include "markup_tag_groups_hack.ily"
|
\include "markup_tag_groups_hack.ily"
|
||||||
\include "verses_with_chords.ily"
|
\include "verses_with_chords.ily"
|
||||||
@@ -56,6 +56,7 @@ HEADER = {}
|
|||||||
MUSIC = {}
|
MUSIC = {}
|
||||||
TEXT = \markuplist {}
|
TEXT = \markuplist {}
|
||||||
TEXT_PAGES = #f
|
TEXT_PAGES = #f
|
||||||
|
EMBEDDED_SONGS = #'()
|
||||||
|
|
||||||
verseChords = {}
|
verseChords = {}
|
||||||
firstVoice = {}
|
firstVoice = {}
|
||||||
|
|||||||
@@ -58,6 +58,7 @@ generalLayout = \layout {
|
|||||||
\RemoveEmptyStaves
|
\RemoveEmptyStaves
|
||||||
\override VerticalAxisGroup.remove-first = ##t
|
\override VerticalAxisGroup.remove-first = ##t
|
||||||
\numericTimeSignature
|
\numericTimeSignature
|
||||||
|
rehearsalMarkFormatter = #format-mark-box-alphabet
|
||||||
\overrideTimeSignatureSettings
|
\overrideTimeSignatureSettings
|
||||||
4/4 % timeSignatureFraction
|
4/4 % timeSignatureFraction
|
||||||
1/4 % baseMomentFraction
|
1/4 % baseMomentFraction
|
||||||
@@ -90,6 +91,22 @@ generalLayout = \layout {
|
|||||||
((custom-size (ly:output-def-lookup base-layout 'size #f)))
|
((custom-size (ly:output-def-lookup base-layout 'size #f)))
|
||||||
(if custom-size (layout-set-staff-size custom-size))))
|
(if custom-size (layout-set-staff-size custom-size))))
|
||||||
|
|
||||||
|
% Scores in Markups (z.B. inline-score) kopieren ihr \layout schon beim Parsen,
|
||||||
|
% also bevor customized-layout greift. Deshalb nachträglich anpassen.
|
||||||
|
#(define (customize-embedded-score-layouts! obj)
|
||||||
|
(cond
|
||||||
|
((ly:score? obj)
|
||||||
|
(for-each
|
||||||
|
(lambda (def)
|
||||||
|
(let ((custom-size (ly:output-def-lookup def 'size #f))
|
||||||
|
(scope (ly:output-def-scope def)))
|
||||||
|
(if custom-size
|
||||||
|
(layout-set-absolute-staff-size-in-module scope (* custom-size (eval 'pt scope))))))
|
||||||
|
(ly:score-output-defs obj)))
|
||||||
|
((pair? obj)
|
||||||
|
(customize-embedded-score-layouts! (car obj))
|
||||||
|
(customize-embedded-score-layouts! (cdr obj)))))
|
||||||
|
|
||||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||||
%%% kleine Helferlein:
|
%%% kleine Helferlein:
|
||||||
|
|
||||||
@@ -138,50 +155,83 @@ romanStanza =
|
|||||||
#(define-music-function (parser location) ()
|
#(define-music-function (parser location) ()
|
||||||
#{ \override StanzaNumber.style = #'roman #})
|
#{ \override StanzaNumber.style = #'roman #})
|
||||||
|
|
||||||
|
#(define (number-or-number-list? x) (or (number? x) (number-list? x)))
|
||||||
|
|
||||||
|
% "1,4" -> (1 4); Einträge, die keine Zahl sind, bleiben Strings ("1b,2b" -> ("1b" "2b"))
|
||||||
|
#(define (stanza-numbers-from-string str)
|
||||||
|
(map (lambda (s) (or (string->number s) s))
|
||||||
|
(remove string-null? (map string-trim-both (string-split str #\,)))))
|
||||||
|
|
||||||
|
% Kein number? hier, sonst kann der Parser 1,4 nicht mehr als Liste lesen
|
||||||
|
#(define (stanza-numbers? x) (or (number-list? x) (string? x)))
|
||||||
|
|
||||||
override-stanza =
|
override-stanza =
|
||||||
#(define-music-function (parser location stanzanumbers) (number-list?)
|
#(define-music-function (stanzanumbers) (number-or-number-list?)
|
||||||
#{
|
#{
|
||||||
\once \override StanzaNumber.details.custom-stanzanumber-override = #stanzanumbers
|
\once \override StanzaNumber.details.custom-stanzanumber-override = #(if (number? stanzanumbers) (list stanzanumbers) stanzanumbers)
|
||||||
#}
|
#}
|
||||||
)
|
)
|
||||||
|
|
||||||
#(define (handle-stanza-numbers context numbers number-formater)
|
#(define (romanize-stanza-numbers numbers style)
|
||||||
(let* ((stanzanumbers (ly:assoc-get 'custom-stanzanumber-override (ly:assoc-get 'details (ly:context-grob-definition context 'StanzaNumber) '()) numbers))
|
(if (eq? style 'roman)
|
||||||
(stanza-style (ly:assoc-get 'style (ly:context-grob-definition context 'StanzaNumber)))
|
(map (lambda (n) (if (number? n) (format #f "~@r" n) n)) numbers)
|
||||||
(roman-format (lambda (stanzanumber) (format #f "~@r" stanzanumber))))
|
numbers))
|
||||||
(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 (format-stanza-numbers numbers style)
|
||||||
|
(string-join
|
||||||
|
(map (lambda (n) (format #f stanzaFormat n)) (romanize-stanza-numbers numbers style))
|
||||||
|
", "))
|
||||||
|
|
||||||
|
% Strophennummer, die erst beim Setzen aus den Eigenschaften des StanzaNumber-Grobs gebaut wird
|
||||||
|
% (details.custom-stanza-type, details.custom-stanza-numbers, style, details.custom-inline-text).
|
||||||
|
% So können \fstanza, \ref, \bridge und \repStartWithTag im selben Zeitschritt kombiniert werden.
|
||||||
|
#(define-markup-command (formatted-stanza layout props) ()
|
||||||
|
#:properties ((details '()) (style #f))
|
||||||
|
(let* ((realstanza (ly:assoc-get 'custom-realstanza details #f))
|
||||||
|
(type (ly:assoc-get 'custom-stanza-type details 'verse))
|
||||||
|
(numbers (ly:assoc-get 'custom-stanzanumber-override details
|
||||||
|
(ly:assoc-get 'custom-stanza-numbers details '())))
|
||||||
|
(inline-text (ly:assoc-get 'custom-inline-text details #f))
|
||||||
|
(inline-direction (ly:assoc-get 'custom-inline-direction details CENTER))
|
||||||
|
(rep-start (and inline-text (eqv? inline-direction LEFT)))
|
||||||
|
(roman-numbers (romanize-stanza-numbers numbers style))
|
||||||
|
(stanza-stencil
|
||||||
|
(and realstanza
|
||||||
|
(case type
|
||||||
|
((ref) ((ly:output-def-lookup layout 'refMarkupFormatter) layout props roman-numbers))
|
||||||
|
((bridge) ((ly:output-def-lookup layout 'bridgeMarkupFormatter) layout props roman-numbers))
|
||||||
|
(else (interpret-markup layout props (format-stanza-numbers numbers style))))))
|
||||||
|
(padded-stanza-stencil
|
||||||
|
(and stanza-stencil
|
||||||
|
(interpret-markup layout props (make-pad-left-markup 1 (make-stencil-markup stanza-stencil))))))
|
||||||
|
(if rep-start
|
||||||
|
(interpret-markup layout props
|
||||||
|
(make-concat-markup
|
||||||
|
(append
|
||||||
|
(if padded-stanza-stencil (list (make-stencil-markup padded-stanza-stencil) (make-hspace-markup 1)) '())
|
||||||
|
(list (make-override-markup '(font-series . normal) inline-text)))))
|
||||||
|
(or padded-stanza-stencil empty-stencil))))
|
||||||
|
|
||||||
|
#(define (formatted-stanza-music type stanzanumbers)
|
||||||
#{
|
#{
|
||||||
\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-type = #type
|
||||||
\once \override StanzaNumber.details.custom-stanza-numbers = #stanzanumbers
|
\once \override StanzaNumber.details.custom-stanza-numbers = #stanzanumbers
|
||||||
\applyContext
|
\stanza \markup \formatted-stanza
|
||||||
#(lambda (context)
|
#})
|
||||||
(handle-stanza-numbers context stanzanumbers
|
|
||||||
(lambda (numbers) (string-join (map (lambda (n) (format #f stanzaFormat n)) numbers) ", "))))
|
% \fstanza 1 -> "1."
|
||||||
#}
|
% \fstanza 1,4 -> "1., 4." (nur im Notenmodus, z.B. \chordverse { \fstanza 1,4 } ...)
|
||||||
)
|
% \fstanza "1,4" -> "1., 4." (auch im \lyricmode, dort versteht LilyPond 1,4 nicht als Liste)
|
||||||
|
fstanza =
|
||||||
|
#(define-music-function (stanzanumbers) (stanza-numbers?)
|
||||||
|
(formatted-stanza-music 'verse
|
||||||
|
(if (string? stanzanumbers) (stanza-numbers-from-string stanzanumbers) stanzanumbers)))
|
||||||
|
|
||||||
ref =
|
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
|
#(formatted-stanza-music 'ref stanzanumbers)
|
||||||
\once \override StanzaNumber.details.custom-stanza-type = #'ref
|
|
||||||
\once \override StanzaNumber.details.custom-stanza-numbers = #stanzanumbers
|
|
||||||
\applyContext
|
|
||||||
#(lambda (context)
|
|
||||||
(handle-stanza-numbers context stanzanumbers
|
|
||||||
(lambda (numbers)
|
|
||||||
(make-on-the-fly-markup
|
|
||||||
(lambda (layout props m)
|
|
||||||
((ly:output-def-lookup layout 'refMarkupFormatter) layout props numbers))
|
|
||||||
(make-null-markup)))))
|
|
||||||
#lyrics
|
#lyrics
|
||||||
}
|
}
|
||||||
#}
|
#}
|
||||||
@@ -190,43 +240,24 @@ ref =
|
|||||||
bridge =
|
bridge =
|
||||||
#(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
|
#(formatted-stanza-music 'bridge stanzanumbers)
|
||||||
\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
|
||||||
}
|
}
|
||||||
#}
|
#}
|
||||||
)
|
)
|
||||||
|
|
||||||
% 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 is a stanza set by \fstanza in the same moment, \formatted-stanza prints both.
|
||||||
% Sets custom-inline-text for ChordPro export so it can collect the repeat sign separately
|
% Sets custom-inline-text for ChordPro export so it can collect the repeat sign separately
|
||||||
repStartWithTag = \lyricmode {
|
repStartWithTag =
|
||||||
|
#(define-music-function () ()
|
||||||
|
#{ \lyricmode {
|
||||||
\tag #'repeats {
|
\tag #'repeats {
|
||||||
\once \override StanzaNumber.details.custom-inline-text = \repStart
|
\once \override StanzaNumber.details.custom-inline-text = \repStart
|
||||||
\once \override StanzaNumber.details.custom-inline-direction = #LEFT
|
\once \override StanzaNumber.details.custom-inline-direction = #LEFT
|
||||||
\applyContext
|
\stanza \markup \formatted-stanza
|
||||||
#(lambda (context)
|
|
||||||
(let ((lastStanza (ly:context-property context 'stanza))
|
|
||||||
(printLastStanza (ly:assoc-get 'custom-realstanza (ly:assoc-get 'details (ly:context-grob-definition context 'StanzaNumber) '()) #f))
|
|
||||||
(stanzaFontSeries (ly:assoc-get 'font-series (ly:context-grob-definition context 'StanzaNumber) 'normal)))
|
|
||||||
(ly:context-set-property! context 'stanza
|
|
||||||
(make-concat-markup
|
|
||||||
(if printLastStanza
|
|
||||||
(list (make-override-markup `(font-series . ,stanzaFontSeries) lastStanza) (make-hspace-markup 1) repStart)
|
|
||||||
(list repStart)
|
|
||||||
)))))
|
|
||||||
\once \override StanzaNumber.font-series = #'normal
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
} #})
|
||||||
|
|
||||||
repStopWithTag = \lyricmode {
|
repStopWithTag = \lyricmode {
|
||||||
\tag #'repeats {
|
\tag #'repeats {
|
||||||
@@ -234,19 +265,19 @@ repStopWithTag = \lyricmode {
|
|||||||
\once \override StanzaNumber.details.custom-inline-direction = #RIGHT
|
\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 }
|
\stanza \markup { \pad-x-right #1 \repStop }
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
rightHyphen = \lyricmode {
|
rightHyphen = \lyricmode {
|
||||||
\once \override StanzaNumber.font-series = #'normal
|
\once \override StanzaNumber.font-series = #'normal
|
||||||
\once \override StanzaNumber.direction = 1
|
\once \override StanzaNumber.direction = 1
|
||||||
\set stanza = "-"
|
\stanza "-"
|
||||||
}
|
}
|
||||||
|
|
||||||
leftHyphen = \lyricmode {
|
leftHyphen = \lyricmode {
|
||||||
\once \override StanzaNumber.font-series = #'normal
|
\once \override StanzaNumber.font-series = #'normal
|
||||||
\set stanza = "-"
|
\stanza "-"
|
||||||
}
|
}
|
||||||
|
|
||||||
multiVerseSkips =
|
multiVerseSkips =
|
||||||
@@ -312,7 +343,7 @@ rufWithMarkup =
|
|||||||
\lyricmode {
|
\lyricmode {
|
||||||
\once \override StanzaNumber.font-series = #'normal
|
\once \override StanzaNumber.font-series = #'normal
|
||||||
\once \override StanzaNumber.direction = 1
|
\once \override StanzaNumber.direction = 1
|
||||||
\set stanza = #text
|
\stanza #text
|
||||||
}
|
}
|
||||||
#})
|
#})
|
||||||
ruf =
|
ruf =
|
||||||
|
|||||||
@@ -155,7 +155,7 @@ Ensure_first_chord_after_line_break_printed_engraver =
|
|||||||
; the current chord handling implementation in lilypond uses 'begin-of-line-visible to mark repeated chords
|
; the current chord handling implementation in lilypond uses 'begin-of-line-visible to mark repeated chords
|
||||||
(ly:grob-set-property! grob 'begin-of-line-visible #f))
|
(ly:grob-set-property! grob 'begin-of-line-visible #f))
|
||||||
(set! last-system-column-rank current-system-column-rank)
|
(set! last-system-column-rank current-system-column-rank)
|
||||||
(ly:chord-name::after-line-breaking grob)
|
(item::enforce-musical-break-visibility grob)
|
||||||
)))))))
|
)))))))
|
||||||
|
|
||||||
% If you add this engraver to ChordNames Context chords get only printed on chordchanges and not at newline.
|
% If you add this engraver to ChordNames Context chords get only printed on chordchanges and not at newline.
|
||||||
|
|||||||
+341
-917
File diff suppressed because it is too large.
Load diff
@@ -0,0 +1,11 @@
|
|||||||
|
% Abwärtskompatibilität zu LilyPond 2.26.
|
||||||
|
% Wird von all.ily nur eingebunden, wenn die laufende LilyPond-Version älter als 2.27 ist.
|
||||||
|
% Alles andere ist für die aktuelle 2.27 geschrieben.
|
||||||
|
|
||||||
|
% Ab 2.27 gibt es \stanza als Musikfunktion (StanzaEvent), in 2.26 nur die Kontext-Property stanza.
|
||||||
|
stanza =
|
||||||
|
#(define-music-function (text) (markup?)
|
||||||
|
(context-spec-music (make-property-set 'stanza text) 'Bottom))
|
||||||
|
|
||||||
|
% Ab 2.27 heißt ly:chord-name::after-line-breaking item::enforce-musical-break-visibility.
|
||||||
|
#(define item::enforce-musical-break-visibility ly:chord-name::after-line-breaking)
|
||||||
@@ -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))))))
|
|
||||||
@@ -0,0 +1,157 @@
|
|||||||
|
%% Mehrere Lieder in einer Liederdatei (z.B. zwei Lieder auf einer Seite)
|
||||||
|
%%
|
||||||
|
%% Das erste Lied ist das Hauptlied (HEADER), alle weiteren werden als
|
||||||
|
%% eingebettete Lieder angemeldet. Eingebettete Lieder bekommen eigene
|
||||||
|
%% Eintraege im Inhaltsverzeichnis, in den Kategorie-, Autoren- und
|
||||||
|
%% Kapitelverzeichnissen, im PDF-Inhaltsverzeichnis, in der toc.csv und
|
||||||
|
%% eine eigene Liednummer. Im Footer steht die Songinfo des letzten
|
||||||
|
%% eingebetteten Lieds (abschaltbar mit footersong = ##f im HEADER bzw. mit
|
||||||
|
%% footersong = \andereslied umstellbar), die Songinfo des Hauptlieds wird
|
||||||
|
%% mit \songinfo-of selbst platziert.
|
||||||
|
%%
|
||||||
|
%% Beispiel:
|
||||||
|
%%
|
||||||
|
%% \include "../../lilypond-song-includes/liedbausteine/lied_a.ly"
|
||||||
|
%% liedA = \captureSong
|
||||||
|
%% \include "../../lilypond-song-includes/liedbausteine/lied_b.ly"
|
||||||
|
%% liedB = \captureSong
|
||||||
|
%%
|
||||||
|
%% TEXT = \markuplist {
|
||||||
|
%% \songinfo-of \liedA
|
||||||
|
%% \vspace #2
|
||||||
|
%% \embedded-song-title \liedB
|
||||||
|
%% \vspace #.5
|
||||||
|
%% \score { \songMusic \liedB \layout { \LAYOUT } }
|
||||||
|
%% \with-song \liedB {
|
||||||
|
%% \chordlyrics \secondVerse
|
||||||
|
%% }
|
||||||
|
%% }
|
||||||
|
%%
|
||||||
|
%% \restoreSong \liedA
|
||||||
|
%% \embedSong \liedB
|
||||||
|
%% \include "public_includes/layout_bottom.ily"
|
||||||
|
%%
|
||||||
|
%% \captureSong sichert den Header (basicSongInfo) und die Variablen aus
|
||||||
|
%% captured-song-variable-names, damit das naechste \include sie nicht
|
||||||
|
%% ueberschreibt. Das Ergebnis ist ein normales Header-Modul, es kann also
|
||||||
|
%% auch in \header { \liedA } verwendet werden.
|
||||||
|
%%
|
||||||
|
%% \restoreSong setzt basicSongInfo, HEADER und diese Variablen zurueck,
|
||||||
|
%% TEXT aber nicht. TEXT also vor \restoreSong schreiben, solange darin noch
|
||||||
|
%% Variablen des zuletzt eingebundenen Lieds (\secondVerse usw.) stehen.
|
||||||
|
%%
|
||||||
|
%% Ohne \with-song beziehen sich Strophen mit Akkorden auf das Hauptlied.
|
||||||
|
%%
|
||||||
|
%% Alle Verzeichniseintraege zeigen auf die erste Seite des Hauptlieds.
|
||||||
|
|
||||||
|
#(define captured-song-variable-names '(MUSIC global firstVoice verseChords))
|
||||||
|
|
||||||
|
#(define (song-variable song name)
|
||||||
|
(assq-ref (module-ref song 'captured-song-variables '()) name))
|
||||||
|
|
||||||
|
#(define (extract-and-check-vars-from-module headermodule varlist)
|
||||||
|
(let* ((headervars (if (module? headermodule) (hash-map->list cons (struct-ref headermodule 0)) '()))
|
||||||
|
(extract-var-and-check (lambda (headervar)
|
||||||
|
(let* ((variableref (assoc-ref headervars headervar))
|
||||||
|
(extracted (if variableref (variable-ref variableref) #f)))
|
||||||
|
(if (and extracted (not (and (string? extracted) (string-null? extracted)))) extracted #f)))))
|
||||||
|
(map (lambda (varsymbol)
|
||||||
|
(cons varsymbol (extract-var-and-check varsymbol))
|
||||||
|
) varlist)))
|
||||||
|
|
||||||
|
% Text des PDF-Lesezeichens eines Lieds, #f wenn es keins bekommt.
|
||||||
|
% Gleiche Regel wie in build-full-title.
|
||||||
|
#(define (song-pdf-bookmark-title headermodule)
|
||||||
|
(let* ((vars (extract-and-check-vars-from-module headermodule '(title starttext)))
|
||||||
|
(title (assq-ref vars 'title))
|
||||||
|
(starttext (assq-ref vars 'starttext))
|
||||||
|
(as-string (lambda (m) (if (markup? m) (markup->string m) ""))))
|
||||||
|
(cond ((and title starttext) (string-append (as-string starttext) " | " (as-string title)))
|
||||||
|
(title (as-string title))
|
||||||
|
(starttext (string-append (as-string starttext) " | "))
|
||||||
|
(else #f))))
|
||||||
|
|
||||||
|
#(define (embedded-song-list songs)
|
||||||
|
(if (list? songs) (filter module? songs) '()))
|
||||||
|
|
||||||
|
#(define (embedded-songs-of-header headermodule)
|
||||||
|
(if (module? headermodule)
|
||||||
|
(embedded-song-list (module-ref headermodule 'embeddedsongs '()))
|
||||||
|
'()))
|
||||||
|
|
||||||
|
% Ersetzt alle header:*-Properties durch die Felder aus headermodule, damit
|
||||||
|
% keine Felder des Hauptlieds in das andere Lied durchsickern.
|
||||||
|
#(define (header-module->props headermodule props)
|
||||||
|
(let ((header-key? (lambda (entry)
|
||||||
|
(and (pair? entry) (symbol? (car entry))
|
||||||
|
(string-prefix? "header:" (symbol->string (car entry)))))))
|
||||||
|
(cons
|
||||||
|
(map (lambda (kv) (cons (symbol-append 'header: (car kv)) (cdr kv)))
|
||||||
|
(ly:module->alist headermodule))
|
||||||
|
(map (lambda (alist) (remove header-key? alist)) props))))
|
||||||
|
|
||||||
|
captureSong =
|
||||||
|
#(define-scheme-function () ()
|
||||||
|
(let ((song (make-module)))
|
||||||
|
(ly:module-copy song basicSongInfo)
|
||||||
|
(module-define! song 'captured-song-variables
|
||||||
|
(filter-map
|
||||||
|
(lambda (name)
|
||||||
|
(let ((value (ly:parser-lookup name)))
|
||||||
|
(and (not (null? value)) (cons name value))))
|
||||||
|
captured-song-variable-names))
|
||||||
|
song))
|
||||||
|
|
||||||
|
% Stellt basicSongInfo, HEADER und die gesicherten Variablen eines Lieds
|
||||||
|
% wieder her, als waere es das zuletzt eingebundene.
|
||||||
|
restoreSong =
|
||||||
|
#(define-void-function (song) (module?)
|
||||||
|
(for-each
|
||||||
|
(lambda (kv) (ly:parser-define! (car kv) (cdr kv)))
|
||||||
|
(module-ref song 'captured-song-variables '()))
|
||||||
|
(ly:parser-define! 'basicSongInfo song)
|
||||||
|
(ly:parser-define! 'HEADER #{ \bookpart { \header { $song } } #}))
|
||||||
|
|
||||||
|
embedSong =
|
||||||
|
#(define-void-function (song) (module?)
|
||||||
|
(set! EMBEDDED_SONGS (append EMBEDDED_SONGS (list song))))
|
||||||
|
|
||||||
|
songMusic =
|
||||||
|
#(define-music-function (song) (module?)
|
||||||
|
(let ((music (song-variable song 'MUSIC)))
|
||||||
|
(if (ly:music? music) music (make-music 'SequentialMusic))))
|
||||||
|
|
||||||
|
% Strophen, \fromproperty #'header:... usw. beziehen sich innerhalb auf das
|
||||||
|
% angegebene Lied. Die Transposition des Hauptlieds wird nicht uebernommen.
|
||||||
|
#(define-markup-list-command (with-song layout props song args) (module? markup-list?)
|
||||||
|
(let* ((music-or-empty (lambda (name)
|
||||||
|
(let ((music (song-variable song name)))
|
||||||
|
(if (ly:music? music) music (make-music 'SequentialMusic)))))
|
||||||
|
(verseChords (music-or-empty 'verseChords))
|
||||||
|
(global (music-or-empty 'global))
|
||||||
|
(firstVoice (music-or-empty 'firstVoice)))
|
||||||
|
(interpret-markup-list layout
|
||||||
|
(prepend-alist-chain 'verse-chords #{ \chords { $verseChords } #}
|
||||||
|
(prepend-alist-chain 'verse-reference-voice #{ $global $firstVoice #}
|
||||||
|
(prepend-alist-chain 'transposition (cons #f #f)
|
||||||
|
(header-module->props song props))))
|
||||||
|
args)))
|
||||||
|
|
||||||
|
#(define-markup-command (songinfo-of layout props song) (module?)
|
||||||
|
(interpret-markup layout (header-module->props song props)
|
||||||
|
(make-fractional-line-width-markup (make-songinfo-content-markup))))
|
||||||
|
|
||||||
|
#(define-markup-command (embedded-song-title layout props song) (module?)
|
||||||
|
(interpret-markup layout (header-module->props song props)
|
||||||
|
(make-fill-line-markup (list (ly:output-def-lookup layout 'defaultTitleMarkup)))))
|
||||||
|
|
||||||
|
% PDF-Lesezeichen der eingebetteten Lieder, wird von build-full-title direkt
|
||||||
|
% nach dem Lesezeichen des Hauptlieds ausgegeben.
|
||||||
|
#(define-markup-command (embedded-songs-to-pdf-toc layout props) ()
|
||||||
|
(apply ly:stencil-add
|
||||||
|
(cons empty-stencil
|
||||||
|
(filter-map
|
||||||
|
(lambda (song)
|
||||||
|
(let ((bookmark (song-pdf-bookmark-title song)))
|
||||||
|
(and bookmark (make-pdf-toc-stencil bookmark 0))))
|
||||||
|
(embedded-song-list (chain-assoc-get 'header:embeddedsongs props '()))))))
|
||||||
@@ -33,7 +33,8 @@
|
|||||||
#(define (join-present items joiner)
|
#(define (join-present items joiner)
|
||||||
(string-join (filter (lambda (item) (and (string? item) (not (string-null? (string-trim-both item))))) 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) ()
|
% Songinfo aus den header:*-Properties, ohne Pruefung auf die letzte Seite.
|
||||||
|
#(define-markup-command (songinfo-content 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)))
|
||||||
(if song
|
(if song
|
||||||
@@ -131,7 +132,6 @@
|
|||||||
)
|
)
|
||||||
|
|
||||||
(interpret-markup layout props
|
(interpret-markup layout props
|
||||||
(if (chain-assoc-get 'page:is-bookpart-last-page props #f)
|
|
||||||
(let* ((authors (chain-assoc-get 'header:authors props #f))
|
(let* ((authors (chain-assoc-get 'header:authors props #f))
|
||||||
(poet-and-composers (poet-and-composer-from-authors authors))
|
(poet-and-composers (poet-and-composer-from-authors authors))
|
||||||
(songId (chain-assoc-get 'header:songId props #f))
|
(songId (chain-assoc-get 'header:songId props #f))
|
||||||
@@ -167,10 +167,25 @@
|
|||||||
#:fontsize songInfoFontSize
|
#:fontsize songInfoFontSize
|
||||||
#:sans
|
#:sans
|
||||||
(ly:output-def-lookup layout 'songinfoMarkup)
|
(ly:output-def-lookup layout 'songinfoMarkup)
|
||||||
)))
|
))))
|
||||||
(make-null-markup)))
|
|
||||||
)
|
)
|
||||||
|
|
||||||
|
% Songinfo im Footer, nur auf der letzten Seite des Bookparts. Gibt es
|
||||||
|
% eingebettete Lieder (siehe embedded_songs.ily), steht hier die Songinfo des
|
||||||
|
% letzten eingebetteten Lieds, ausser im Header ist footersong gesetzt
|
||||||
|
% (##f = Hauptlied, oder ein mit \captureSong gesichertes Lied).
|
||||||
|
#(define-markup-command (print-songinfo layout props) ()
|
||||||
|
(if (chain-assoc-get 'page:is-bookpart-last-page props #f)
|
||||||
|
(let* ((footersong (chain-assoc-get 'header:footersong props 'auto))
|
||||||
|
(embedded (embedded-song-list (chain-assoc-get 'header:embeddedsongs props '())))
|
||||||
|
(song (if (eq? footersong 'auto)
|
||||||
|
(and (pair? embedded) (last embedded))
|
||||||
|
footersong)))
|
||||||
|
(interpret-markup layout
|
||||||
|
(if (module? song) (header-module->props song props) props)
|
||||||
|
(make-songinfo-content-markup)))
|
||||||
|
(interpret-markup layout props (make-null-markup))))
|
||||||
|
|
||||||
#(define-markup-command (print-pagenumber layout props)()
|
#(define-markup-command (print-pagenumber layout props)()
|
||||||
(let ((label (chain-assoc-get 'header:myindexlabel props #f)))
|
(let ((label (chain-assoc-get 'header:myindexlabel props #f)))
|
||||||
(interpret-markup layout props
|
(interpret-markup layout props
|
||||||
|
|||||||
@@ -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)))
|
||||||
@@ -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))))
|
|
||||||
|
|
||||||
@@ -65,10 +65,11 @@
|
|||||||
;; Ist dieses Lied das erste eines Kapitels, wird der Kapitel-Eintrag
|
;; Ist dieses Lied das erste eines Kapitels, wird der Kapitel-Eintrag
|
||||||
;; unmittelbar vor dem Lied-Eintrag ausgegeben, damit die pdfmark-/OUT-
|
;; unmittelbar vor dem Lied-Eintrag ausgegeben, damit die pdfmark-/OUT-
|
||||||
;; Reihenfolge (Elternteil vor Kindern) im PDF-Stream garantiert stimmt.
|
;; Reihenfolge (Elternteil vor Kindern) im PDF-Stream garantiert stimmt.
|
||||||
|
;; Eingebettete Lieder (embedded_songs.ily) folgen direkt nach dem Lied.
|
||||||
(if (and (string? chaptertitle) (not (string-null? chaptertitle)))
|
(if (and (string? chaptertitle) (not (string-null? chaptertitle)))
|
||||||
(markup #:chapter-to-pdf-toc chaptercount chaptertitle
|
(markup #:chapter-to-pdf-toc chaptercount chaptertitle
|
||||||
#:title-to-pdf-toc pdfbookmark title-markup)
|
#:title-to-pdf-toc pdfbookmark #:embedded-songs-to-pdf-toc title-markup)
|
||||||
(markup #:title-to-pdf-toc pdfbookmark title-markup))
|
(markup #:title-to-pdf-toc pdfbookmark #:embedded-songs-to-pdf-toc title-markup))
|
||||||
make-null-markup)
|
make-null-markup)
|
||||||
)))
|
)))
|
||||||
|
|
||||||
|
|||||||
@@ -89,7 +89,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 #{ \stanza #arg #}) "" } } \layout { $verselayout #(customized-layout verselayout) } }
|
||||||
#}
|
#}
|
||||||
)))
|
)))
|
||||||
|
|
||||||
@@ -182,19 +182,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))
|
||||||
@@ -261,6 +249,13 @@ Chord_lyrics_spacing_engraver =
|
|||||||
(lyrics-seen-since-break #f)
|
(lyrics-seen-since-break #f)
|
||||||
(have-a-rest #f)
|
(have-a-rest #f)
|
||||||
(stanza #f)
|
(stanza #f)
|
||||||
|
; Akkord auf einer Skip-Silbe "_" nach Wortende soll über die folgende Silbe
|
||||||
|
(word-continues #f)
|
||||||
|
(continuation-this-step #f)
|
||||||
|
(lyric-skip-this-step #f)
|
||||||
|
(syllable-this-step #f)
|
||||||
|
(chord-this-step #f)
|
||||||
|
(chord-on-lyric-skip #f)
|
||||||
(place-at-right-edge
|
(place-at-right-edge
|
||||||
(lambda (grob anchor padding)
|
(lambda (grob anchor padding)
|
||||||
(let ((anchor-width (interval-length (ly:grob-extent anchor anchor X))))
|
(let ((anchor-width (interval-length (ly:grob-extent anchor anchor X))))
|
||||||
@@ -268,6 +263,25 @@ Chord_lyrics_spacing_engraver =
|
|||||||
(ly:grob-set-property! grob 'X-offset (+ padding anchor-width))
|
(ly:grob-set-property! grob 'X-offset (+ padding anchor-width))
|
||||||
))))
|
))))
|
||||||
(make-engraver
|
(make-engraver
|
||||||
|
((start-translation-timestep engraver)
|
||||||
|
(set! continuation-this-step #f)
|
||||||
|
(set! lyric-skip-this-step #f)
|
||||||
|
(set! syllable-this-step #f)
|
||||||
|
(set! chord-this-step #f)
|
||||||
|
)
|
||||||
|
((stop-translation-timestep engraver)
|
||||||
|
(if (and chord-on-lyric-skip (not (eq? chord-on-lyric-skip chord-this-step)))
|
||||||
|
(begin
|
||||||
|
(if (and syllable-this-step (not chord-this-step))
|
||||||
|
(begin
|
||||||
|
(ly:grob-set-parent! chord-on-lyric-skip X syllable-this-step)
|
||||||
|
(ly:grob-set-property! chord-on-lyric-skip 'X-offset 0)
|
||||||
|
(ly:grob-set-property! chord-on-lyric-skip 'extra-spacing-width '(+inf.0 . -inf.0))
|
||||||
|
(set! lyric-width-since-last-chord (interval-length (ly:grob-extent syllable-this-step syllable-this-step X)))))
|
||||||
|
(set! chord-on-lyric-skip #f)))
|
||||||
|
(if syllable-this-step
|
||||||
|
(set! word-continues continuation-this-step))
|
||||||
|
)
|
||||||
(listeners
|
(listeners
|
||||||
((multi-measure-rest-event engraver event)
|
((multi-measure-rest-event engraver event)
|
||||||
(set! have-a-rest #t)
|
(set! have-a-rest #t)
|
||||||
@@ -275,8 +289,19 @@ Chord_lyrics_spacing_engraver =
|
|||||||
((rest-event engraver event)
|
((rest-event engraver event)
|
||||||
(set! have-a-rest #t)
|
(set! have-a-rest #t)
|
||||||
)
|
)
|
||||||
|
((hyphen-event engraver event)
|
||||||
|
(set! continuation-this-step #t)
|
||||||
|
)
|
||||||
|
((extender-event engraver event)
|
||||||
|
(set! continuation-this-step #t)
|
||||||
|
)
|
||||||
((lyric-event engraver event)
|
((lyric-event engraver event)
|
||||||
(set! have-a-rest #f)
|
(set! have-a-rest #f)
|
||||||
|
; "_" wird zu " " und erzeugt keine LyricText
|
||||||
|
(if (equal? (ly:event-property event 'text) " ")
|
||||||
|
(begin
|
||||||
|
(set! lyric-skip-this-step #t)
|
||||||
|
(set! chord-on-lyric-skip #f)))
|
||||||
(set! music-columns-for-last-syllable 0)
|
(set! music-columns-for-last-syllable 0)
|
||||||
)
|
)
|
||||||
((break-event engraver event)
|
((break-event engraver event)
|
||||||
@@ -286,6 +311,7 @@ Chord_lyrics_spacing_engraver =
|
|||||||
(set! last-printed-chord #f)
|
(set! last-printed-chord #f)
|
||||||
(set! chord-width-since-last-lyric 0)
|
(set! chord-width-since-last-lyric 0)
|
||||||
(set! lyrics-seen-since-break #f)
|
(set! lyrics-seen-since-break #f)
|
||||||
|
(set! chord-on-lyric-skip #f)
|
||||||
))
|
))
|
||||||
(acknowledgers
|
(acknowledgers
|
||||||
((musical-paper-column-interface this-engraver grob source-engraver)
|
((musical-paper-column-interface this-engraver grob source-engraver)
|
||||||
@@ -306,6 +332,7 @@ Chord_lyrics_spacing_engraver =
|
|||||||
(ly:grob-set-property! grob 'X-offset gap-for-starting-rest)
|
(ly:grob-set-property! grob 'X-offset gap-for-starting-rest)
|
||||||
)))
|
)))
|
||||||
)
|
)
|
||||||
|
(set! syllable-this-step grob)
|
||||||
(set! last-lyric-syllable grob)
|
(set! last-lyric-syllable grob)
|
||||||
(set! chord-width-since-last-lyric 0)
|
(set! chord-width-since-last-lyric 0)
|
||||||
(set! lyrics-seen-since-break #t)
|
(set! lyrics-seen-since-break #t)
|
||||||
@@ -333,6 +360,9 @@ Chord_lyrics_spacing_engraver =
|
|||||||
(cons (car (ly:grob-property last-lyric-syllable 'extra-spacing-width '(0 . 0))) (+ chord-gap chord-overwidth)))
|
(cons (car (ly:grob-property last-lyric-syllable 'extra-spacing-width '(0 . 0))) (+ chord-gap chord-overwidth)))
|
||||||
)
|
)
|
||||||
(set! lyric-width-since-last-chord (* (if last-lyric-syllable (interval-length (ly:grob-extent last-lyric-syllable last-lyric-syllable X)) 0) (- 1 (/ 1.0 music-columns-for-last-syllable))))
|
(set! lyric-width-since-last-chord (* (if last-lyric-syllable (interval-length (ly:grob-extent last-lyric-syllable last-lyric-syllable X)) 0) (- 1 (/ 1.0 music-columns-for-last-syllable))))
|
||||||
|
(set! chord-this-step grob)
|
||||||
|
(if (and lyric-skip-this-step (not have-a-rest) (not word-continues))
|
||||||
|
(set! chord-on-lyric-skip grob))
|
||||||
(set! last-printed-chord grob)
|
(set! last-printed-chord grob)
|
||||||
(set! last-lyric-syllable #f)
|
(set! last-lyric-syllable #f)
|
||||||
)
|
)
|
||||||
@@ -353,20 +383,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 {
|
||||||
|
|||||||
@@ -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,79 +118,6 @@ 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 (filename) (string?)
|
||||||
#{
|
#{
|
||||||
@@ -213,15 +125,6 @@ includeSong =
|
|||||||
#}
|
#}
|
||||||
(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))
|
||||||
@@ -284,20 +187,24 @@ songs =
|
|||||||
;; Lieder duerfen als Kapitel-Kinder gezaehlt werden -- sonst wird die
|
;; Lieder duerfen als Kapitel-Kinder gezaehlt werden -- sonst wird die
|
||||||
;; /Count zu hoch und der erste Folgeeintrag (z.B. ein spaeteres Kapitel)
|
;; /Count zu hoch und der erste Folgeeintrag (z.B. ein spaeteres Kapitel)
|
||||||
;; rutscht faelschlich als Kind mit hinein.
|
;; rutscht faelschlich als Kind mit hinein.
|
||||||
(emits-bookmark?
|
;; Eingebettete Lieder (embedded_songs.ily) haben jeweils ein eigenes
|
||||||
|
;; Lesezeichen, daher die Anzahl statt eines Booleans.
|
||||||
|
(bookmark-count
|
||||||
(lambda (e)
|
(lambda (e)
|
||||||
(and (not (eq? (car e) 'emptyPage))
|
(if (or (eq? (car e) 'emptyPage)
|
||||||
(not (eq? (car e) 'imagePage))
|
(eq? (car e) 'imagePage)
|
||||||
(not (eq? (car e) 'markupPage))
|
(eq? (car e) 'markupPage))
|
||||||
(let ((vars (extract-and-check-vars-from-header
|
0
|
||||||
(assq-ref (cdr e) 'header) '(title starttext))))
|
(let* ((headermodule (ly:book-header (assq-ref (cdr e) 'header)))
|
||||||
(if (or (assq-ref vars 'title) (assq-ref vars 'starttext)) #t #f)))))
|
(vars (extract-and-check-vars-from-module headermodule '(title starttext))))
|
||||||
|
(+ (if (or (assq-ref vars 'title) (assq-ref vars 'starttext)) 1 0)
|
||||||
|
(count song-pdf-bookmark-title (embedded-songs-of-header headermodule)))))))
|
||||||
(count-bookmark-songs
|
(count-bookmark-songs
|
||||||
(lambda (start end)
|
(lambda (start end)
|
||||||
(let loop ((i 0) (l ordered) (c 0))
|
(let loop ((i 0) (l ordered) (c 0))
|
||||||
(cond ((or (null? l) (>= i end)) c)
|
(cond ((or (null? l) (>= i end)) c)
|
||||||
((< i start) (loop (+ i 1) (cdr l) c))
|
((< i start) (loop (+ i 1) (cdr l) c))
|
||||||
(else (loop (+ i 1) (cdr l) (if (emits-bookmark? (car l)) (+ c 1) c)))))))
|
(else (loop (+ i 1) (cdr l) (+ c (bookmark-count (car l)))))))))
|
||||||
;; chapters: (title . start-index). start-index = Anzahl der song-list-
|
;; chapters: (title . start-index). start-index = Anzahl der song-list-
|
||||||
;; Eintraege beim Aufruf von songsChapter = Index in `ordered`, ab dem
|
;; Eintraege beim Aufruf von songsChapter = Index in `ordered`, ab dem
|
||||||
;; das Kapitel beginnt.
|
;; das Kapitel beginnt.
|
||||||
@@ -397,81 +304,27 @@ songs =
|
|||||||
(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))
|
||||||
|
(toc-music (header-module-to-toc! (ly:book-header header) label)))
|
||||||
(set! song-number newnumber)
|
(set! song-number newnumber)
|
||||||
;; ChordPro_music_collector (Strophen unter den Noten, siehe
|
;; Eingebettete Lieder: eigene Liednummer, gleiche Seite (label)
|
||||||
;; chordpro.ily) braucht den Song-Key beim tatsaechlichen
|
(for-each
|
||||||
;; Interpretieren dieses Songs' Hauptscore. Im Buch ist DAS
|
(lambda (song)
|
||||||
;; NICHT synchron zu dieser for-each-Schleife -- LilyPond
|
(let ((tocheader (make-module)))
|
||||||
;; interpretiert die \score-Bloecke aller Lieder gesammelt fuer
|
(set! song-number (+ 1 song-number))
|
||||||
;; das Seitenlayout, oft NACHDEM die Schleife schon beim
|
(ly:module-copy tocheader song)
|
||||||
;; naechsten (oder letzten) Lied angelangt ist. Ein globaler
|
(module-define! tocheader 'songnumber (number->string song-number))
|
||||||
;; chordpro-active-song-key waere zu diesem Zeitpunkt also auf
|
(module-define! tocheader 'chapterref current-chapter)
|
||||||
;; ein ANDERES Lied gesetzt -- die gesammelten Strophen landen
|
(header-module-to-toc! tocheader label)))
|
||||||
;; dann fälschlich im Store-Eintrag des zuletzt verarbeiteten
|
(embedded-songs-of-header (ly:book-header header)))
|
||||||
;; 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
|
$toc-music
|
||||||
\score {
|
\score { $music \layout { $layout songfilename = $(symbol->string filename) } }
|
||||||
$score-music
|
|
||||||
$song-layout
|
|
||||||
}
|
|
||||||
$(add-text-pages text-pages)
|
$(add-text-pages text-pages)
|
||||||
}
|
}
|
||||||
#})))))))))
|
#}))))))))
|
||||||
ordered
|
ordered
|
||||||
)))
|
)))
|
||||||
|
|
||||||
|
|||||||
@@ -304,16 +304,9 @@ indexSection =
|
|||||||
(add-index-item! 'indexSectionMarkup (prepend-alist-chain 'combine-with-next #t (prepend-alist-chain 'rawtext text '())) sorttext))
|
(add-index-item! 'indexSectionMarkup (prepend-alist-chain 'combine-with-next #t (prepend-alist-chain 'rawtext text '())) sorttext))
|
||||||
|
|
||||||
#(define (extract-and-check-vars-from-header bookheader varlist)
|
#(define (extract-and-check-vars-from-header bookheader varlist)
|
||||||
(let* ((headervars (hash-map->list cons (struct-ref (ly:book-header bookheader) 0)))
|
(extract-and-check-vars-from-module (ly:book-header bookheader) varlist))
|
||||||
(extract-var-and-check (lambda (headervar)
|
|
||||||
(let* ((variableref (assoc-ref headervars headervar))
|
|
||||||
(extracted (if variableref (variable-ref variableref) #f)))
|
|
||||||
(if (and extracted (not (and (string? extracted) (string-null? extracted)))) extracted #f)))))
|
|
||||||
(map (lambda (varsymbol)
|
|
||||||
(cons varsymbol (extract-var-and-check varsymbol))
|
|
||||||
) varlist)))
|
|
||||||
|
|
||||||
headerToTOC = #(define-music-function (parser location header label) (ly:book? symbol?)
|
#(define (header-module-to-toc! headermodule label)
|
||||||
(define (all-author-ids authors)
|
(define (all-author-ids authors)
|
||||||
(let ((poetIds (find-author-ids-by 'text authors))
|
(let ((poetIds (find-author-ids-by 'text authors))
|
||||||
(translatorIds (find-author-ids-by 'translation authors))
|
(translatorIds (find-author-ids-by 'translation authors))
|
||||||
@@ -331,7 +324,7 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
|
|||||||
))
|
))
|
||||||
(let*
|
(let*
|
||||||
(
|
(
|
||||||
(extractedheadervars (extract-and-check-vars-from-header header '(title starttext alttitle categorytitle categories authors songnumber chapterref)))
|
(extractedheadervars (extract-and-check-vars-from-module headermodule '(title starttext alttitle categorytitle categories authors songnumber chapterref)))
|
||||||
(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))
|
||||||
@@ -357,6 +350,9 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
|
|||||||
(if title (add-to-toc! title #f) #{ #})
|
(if title (add-to-toc! title #f) #{ #})
|
||||||
))
|
))
|
||||||
|
|
||||||
|
headerToTOC = #(define-music-function (parser location header label) (ly:book? symbol?)
|
||||||
|
(header-module-to-toc! (ly:book-header header) label))
|
||||||
|
|
||||||
|
|
||||||
%% https://github.com/NalaGinrut/guile-csv/blob/master/csv/csv.scm
|
%% https://github.com/NalaGinrut/guile-csv/blob/master/csv/csv.scm
|
||||||
|
|
||||||
@@ -370,9 +366,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
|
||||||
@@ -405,11 +398,8 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
|
|||||||
(para-lines (map cleanup-whitespaces para-strings)))
|
(para-lines (map cleanup-whitespaces para-strings)))
|
||||||
(string-join para-lines "\n")))
|
(string-join para-lines "\n")))
|
||||||
(define (generate-toc-csv labelPageTable)
|
(define (generate-toc-csv labelPageTable)
|
||||||
(let ((song-lines (map (lambda (song)
|
(define (song-line filename page-number headermodule)
|
||||||
(let* ((filename (symbol->string (car song)))
|
(let* ((extractedheadervars (extract-and-check-vars-from-module headermodule
|
||||||
(songvars (cdr song))
|
|
||||||
(page-number (assoc-get (assq-ref songvars 'label) labelPageTable))
|
|
||||||
(extractedheadervars (extract-and-check-vars-from-header (assq-ref songvars 'header)
|
|
||||||
'(title starttext alttitle categorytitle categories authors year_text year_melody year_translation year_composition year_adaption infotext translation pronunciation copyright source)))
|
'(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)
|
||||||
(let ((extracted (assq-ref extractedheadervars varsym)))
|
(let ((extracted (assq-ref extractedheadervars varsym)))
|
||||||
@@ -455,8 +445,17 @@ 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))
|
||||||
))))
|
))))
|
||||||
|
;; Eingebettete Lieder (embedded_songs.ily) bekommen eigene Zeilen mit
|
||||||
|
;; Dateiname und Seite des Hauptlieds.
|
||||||
|
(let ((song-lines (append-map (lambda (song)
|
||||||
|
(let* ((filename (symbol->string (car song)))
|
||||||
|
(songvars (cdr song))
|
||||||
|
(page-number (assoc-get (assq-ref songvars 'label) labelPageTable))
|
||||||
|
(headermodule (ly:book-header (assq-ref songvars 'header))))
|
||||||
|
(map (lambda (module) (song-line filename page-number module))
|
||||||
|
(cons headermodule (embedded-songs-of-header headermodule)))))
|
||||||
(alist-delete 'markupPage (alist-delete 'imagePage (alist-delete 'emptyPage song-list))))))
|
(alist-delete 'markupPage (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"
|
||||||
|
|||||||
@@ -1,10 +1,17 @@
|
|||||||
MUSIC = { \transposable #TRANSPOSITION \MUSIC }
|
MUSIC = { \transposable #TRANSPOSITION \MUSIC }
|
||||||
|
|
||||||
|
%% Eingebettete Lieder (siehe embedded_songs.ily) im Header des Hauptlieds
|
||||||
|
%% vermerken, daraus bauen Footer, PDF-Lesezeichen und Verzeichnisse.
|
||||||
|
#(if (and (pair? EMBEDDED_SONGS) (ly:book? HEADER) (ly:book-header HEADER))
|
||||||
|
(module-define! (ly:book-header HEADER) 'embeddedsongs EMBEDDED_SONGS))
|
||||||
|
|
||||||
LAYOUT = \layout {
|
LAYOUT = \layout {
|
||||||
\LAYOUT
|
\LAYOUT
|
||||||
#(customized-layout LAYOUT)
|
#(customized-layout LAYOUT)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#(customize-embedded-score-layouts! (list TEXT TEXT_PAGES))
|
||||||
|
|
||||||
verselayout = \layout {
|
verselayout = \layout {
|
||||||
\LAYOUT
|
\LAYOUT
|
||||||
\context {
|
\context {
|
||||||
@@ -72,68 +79,34 @@ TEXT = \markuplist {
|
|||||||
(if paper (set! $defaultpaper paper))
|
(if paper (set! $defaultpaper paper))
|
||||||
)
|
)
|
||||||
|
|
||||||
;; Meta-Daten des Liedes als YAML neben die Ausgabedatei schreiben
|
;; ChordPro export: Store filename and extract metadata from basicSongInfo FIRST
|
||||||
;; (<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)
|
(when (and (defined? 'chordpro-export-enabled) chordpro-export-enabled)
|
||||||
(set! chordpro-default-song-key (ly:parser-output-name))
|
;; Use ly:parser-output-name which returns the output basename
|
||||||
(chordpro-register-song-metadata chordpro-default-song-key HEADER))
|
;; This will write relative to current working directory (same as PDF)
|
||||||
|
(let ((output-name (ly:parser-output-name)))
|
||||||
|
(set! chordpro-current-filename output-name))
|
||||||
|
|
||||||
|
;; Try to extract metadata from the HEADER (falls back to basicSongInfo)
|
||||||
|
(let ((header-module (if (and (ly:book? HEADER) (ly:book-header HEADER))
|
||||||
|
(ly:book-header HEADER)
|
||||||
|
(and (defined? 'basicSongInfo) basicSongInfo))))
|
||||||
|
(when header-module
|
||||||
|
(let* ((header-alist (ly:module->alist header-module))
|
||||||
|
(title (assoc-ref header-alist 'title))
|
||||||
|
(authors (assoc-ref header-alist 'authors)))
|
||||||
|
(when title
|
||||||
|
(set! chordpro-header-title
|
||||||
|
(if (markup? title)
|
||||||
|
(markup->string title)
|
||||||
|
(if (string? title) title "Untitled"))))
|
||||||
|
(when authors
|
||||||
|
(set! chordpro-header-authors authors))))))
|
||||||
|
|
||||||
;; 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 #{
|
||||||
|
|||||||
Reference in new issue
Block a user