21 Commits

Author SHA1 Message Date
85c05cec5d Chordpro export 2026-04-14 10:09:40 +02:00
6e528a5328 fix markup tag group trouble accross songs 2026-04-10 14:29:20 +02:00
71c8c0385c switch swingStyle to textMark 2026-03-31 18:55:12 +02:00
f075946777 use right translationAuthorPrefix in authorContributionFormat 2026-03-12 22:25:50 +01:00
a0de02126c no "add" as additionalPitchPrefix 2026-03-10 19:17:40 +01:00
7ece3b9c10 underline for LyricText 2026-03-09 17:01:21 +01:00
7fc99e8883 use new chords and page references of LilyPond 2.25.35 2026-03-08 13:37:31 +01:00
b3feb3aa6d padding for stop tags and refactoring 2026-02-22 20:33:18 +01:00
7b166f6fc3 pad left for stanzas to have a minimum distance to SystemStartBar 2026-02-22 13:22:45 +01:00
9c437d0f06 reset tag groups for each song 2026-02-10 17:18:52 +01:00
a52f993678 more flexible titeling 2026-02-01 01:45:10 +01:00
bbd6d44455 Autorensystem flexibilisiert 2026-01-11 20:03:31 +01:00
f68e2f10ae implement default bridge style 2025-12-29 18:06:00 +01:00
463d61fbd9 fix customize layout sizing 2025-12-22 11:29:32 +01:00
tux
2d14a5b632 new engraver for spacing in chordlyrics 2025-12-15 21:41:45 +01:00
368a1b96aa rework stanza handler 2025-12-15 11:49:30 +01:00
f57b1c4ec3 customize text chord distance in old system, too 2025-12-15 01:47:05 +01:00
e530bdf090 make verselayout really work 2025-12-15 01:26:19 +01:00
c97c856b05 Use \tempo command for midi speed
* Remove Metronome mark engraver
* Remove midiQuarterNoteSpeed
2025-12-13 12:50:01 +01:00
76b81a9968 no breaks in toc after section title 2025-11-24 20:45:00 +01:00
3ff5a36106 better load song include data in windows 2025-11-24 16:47:13 +01:00
15 changed files with 1444 additions and 355 deletions

2
.gitignore vendored
View File

@@ -1,8 +1,8 @@
# ---> Lilypond # ---> Lilypond
*.pdf *.pdf
*.cho
*.ps *.ps
*.midi *.midi
*.mid *.mid
*.log *.log
*~ *~

View File

@@ -21,15 +21,26 @@
))))) )))))
(scm-load "resolve_inherits.scm") (scm-load "resolve_inherits.scm")
(scm-load "yaml_parser.scm"))) (scm-load "yaml_parser.scm")))
#(define AUTHOR_DATA (if (defined? 'AUTHOR_DATA) AUTHOR_DATA (parse-yml-file "../../lilypond-song-includes/data/authors.yml")))
#(define SONG_DATA (if (defined? 'SONG_DATA) SONG_DATA (parse-yml-file "../../lilypond-song-includes/data/songs.yml"))) #(define (song-includes-data-path filename)
(string-join
(list
(dirname (dirname (dirname (dirname (current-filename)))))
"lilypond-song-includes"
"data"
filename)
file-name-separator-string))
#(define AUTHOR_DATA (if (defined? 'AUTHOR_DATA) AUTHOR_DATA (parse-yml-file (song-includes-data-path "authors.yml"))))
#(define SONG_DATA (if (defined? 'SONG_DATA) SONG_DATA (parse-yml-file (song-includes-data-path "songs.yml"))))
\include "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 "title_with_category_images.ily" \include "title_with_category_images.ily"
\include "chord_settings.ily" \include "chord_settings.ily"
\include "chordpro.ily"
\include "transposition.ily" \include "transposition.ily"
\include "markup_tag_groups_hack.ily"
\include "verses_with_chords.ily" \include "verses_with_chords.ily"
\include "arrows_in_scores.ily" \include "arrows_in_scores.ily"
\include "swing_style.ily" \include "swing_style.ily"
@@ -47,3 +58,5 @@ TEXT_PAGES = #f
verseChords = {} verseChords = {}
firstVoice = {} firstVoice = {}
global = {} global = {}
\resetTagGroups

View File

@@ -29,6 +29,11 @@
(if (null? stanzanumbers) (if (null? stanzanumbers)
refString refString
(ly:format refStringWithNumbers (string-join (map (lambda (stanzanumber) (ly:format "~a" stanzanumber)) stanzanumbers) ", "))))) (ly:format refStringWithNumbers (string-join (map (lambda (stanzanumber) (ly:format "~a" stanzanumber)) stanzanumbers) ", ")))))
bridgeMarkupFormatter = #(lambda (layout props stanzanumbers)
(interpret-markup layout props
(if (null? stanzanumbers)
bridgeString
(ly:format bridgeStringWithNumbers (string-join (map (lambda (stanzanumber) (ly:format "~a" stanzanumber)) stanzanumbers) ", ")))))
} }
generalLayout = \layout { generalLayout = \layout {
@@ -49,6 +54,7 @@ generalLayout = \layout {
\context { \context {
\Score \Score
\remove "Bar_number_engraver" \remove "Bar_number_engraver"
\remove "Metronome_mark_engraver"
\RemoveEmptyStaves \RemoveEmptyStaves
\override VerticalAxisGroup.remove-first = ##t \override VerticalAxisGroup.remove-first = ##t
\overrideTimeSignatureSettings \overrideTimeSignatureSettings
@@ -78,6 +84,11 @@ generalLayout = \layout {
} }
} }
#(define (customized-layout base-layout)
(let
((custom-size (ly:output-def-lookup base-layout 'size #f)))
(if custom-size (layout-set-staff-size custom-size))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% kleine Helferlein: %%% kleine Helferlein:
@@ -133,18 +144,26 @@ override-stanza =
#} #}
) )
#(define (handle-stanza-numbers context numbers number-formater)
(let* ((stanzanumbers (ly:assoc-get 'custom-stanzanumber-override (ly:assoc-get 'details (ly:context-grob-definition context 'StanzaNumber) '()) numbers))
(stanza-style (ly:assoc-get 'style (ly:context-grob-definition context 'StanzaNumber)))
(roman-format (lambda (stanzanumber) (format #f "~@r" stanzanumber))))
(ly:context-set-property! context 'stanza
(make-pad-left-markup 1
(number-formater
(if (eq? stanza-style 'roman)
(map roman-format stanzanumbers)
stanzanumbers))))))
#(define (stanza . stanzanumbers) #(define (stanza . stanzanumbers)
#{ #{
\once \override StanzaNumber.details.custom-realstanza = ##t % set this to signal that there is a real stanza and no repeat signs \once \override StanzaNumber.details.custom-realstanza = ##t % set this to signal that there is a real stanza and no repeat signs
\once \override StanzaNumber.details.custom-stanza-type = #'verse
\once \override StanzaNumber.details.custom-stanza-numbers = #stanzanumbers
\applyContext \applyContext
#(lambda (context) #(lambda (context)
(let* ((stanzanumbers-override (ly:assoc-get 'custom-stanzanumber-override (ly:assoc-get 'details (ly:context-grob-definition context 'StanzaNumber) '()) #f)) (handle-stanza-numbers context stanzanumbers
(stanza-style (ly:assoc-get 'style (ly:context-grob-definition context 'StanzaNumber))) (lambda (numbers) (string-join (map (lambda (n) (format #f stanzaFormat n)) numbers) ", "))))
(stanza-format (lambda (stanzanumber) (format #f (if (eq? stanza-style 'roman) romanStanzaFormat stanzaFormat) stanzanumber))))
(ly:context-set-property! context 'stanza
(string-join (map stanza-format
(if stanzanumbers-override stanzanumbers-override stanzanumbers))
", "))))
#} #}
) )
@@ -152,7 +171,35 @@ ref =
#(define-music-function (stanzanumbers lyrics) ((number-list? (list)) ly:music?) #(define-music-function (stanzanumbers lyrics) ((number-list? (list)) ly:music?)
#{ \lyricmode { #{ \lyricmode {
\once \override StanzaNumber.details.custom-realstanza = ##t % set this to signal that there is a real stanza and no repeat signs \once \override StanzaNumber.details.custom-realstanza = ##t % set this to signal that there is a real stanza and no repeat signs
\set stanza = #(make-on-the-fly-markup (lambda (layout props m) ((ly:output-def-lookup layout 'refMarkupFormatter) layout props stanzanumbers)) (make-null-markup)) \once \override StanzaNumber.details.custom-stanza-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
}
#}
)
bridge =
#(define-music-function (stanzanumbers lyrics) ((number-list? (list)) ly:music?)
#{ \lyricmode {
\once \override StanzaNumber.details.custom-realstanza = ##t % set this to signal that there is a real stanza and no repeat signs
\once \override StanzaNumber.details.custom-stanza-type = #'bridge
\once \override StanzaNumber.details.custom-stanza-numbers = #stanzanumbers
\applyContext
#(lambda (context)
(handle-stanza-numbers context stanzanumbers
(lambda (numbers)
(make-on-the-fly-markup
(lambda (layout props m)
((ly:output-def-lookup layout 'bridgeMarkupFormatter) layout props numbers))
(make-null-markup)))))
#lyrics #lyrics
} }
#} #}
@@ -160,8 +207,11 @@ ref =
% prints a repStart Sign as stanza if the tag 'repeats is kept. % prints a repStart Sign as stanza if the tag 'repeats is kept.
% if there was a stanza already set by the stanza function with StanzaNumber.details.custom-realstanza = ##t we set that also as stanza. % if there was a stanza already set by the stanza function with StanzaNumber.details.custom-realstanza = ##t we set that also as stanza.
% Sets custom-inline-text for ChordPro export so it can collect the repeat sign separately
repStartWithTag = \lyricmode { repStartWithTag = \lyricmode {
\tag #'repeats { \tag #'repeats {
\once \override StanzaNumber.details.custom-inline-text = \repStart
\once \override StanzaNumber.details.custom-inline-direction = #LEFT
\applyContext \applyContext
#(lambda (context) #(lambda (context)
(let ((lastStanza (ly:context-property context 'stanza)) (let ((lastStanza (ly:context-property context 'stanza))
@@ -179,9 +229,11 @@ repStartWithTag = \lyricmode {
repStopWithTag = \lyricmode { repStopWithTag = \lyricmode {
\tag #'repeats { \tag #'repeats {
\once \override StanzaNumber.details.custom-inline-text = \repStop
\once \override StanzaNumber.details.custom-inline-direction = #RIGHT
\once \override StanzaNumber.font-series = #'normal \once \override StanzaNumber.font-series = #'normal
\once \override StanzaNumber.direction = 1 \once \override StanzaNumber.direction = 1
\set stanza = \markup { \repStop } \set stanza = \markup { \pad-x-right #1 \repStop }
} }
} }
@@ -264,4 +316,18 @@ rufWithMarkup =
#}) #})
ruf = ruf =
#(define-music-function (text) (string?) #(define-music-function (text) (string?)
(rufWithMarkup (make-ruf-style-markup text))) (rufWithMarkup (make-ruf-style-markup text)))
underlineOn =
#(define-music-function () ()
#{
\override LyricText.stencil =
#(lambda (grob)
(grob-interpret-markup grob (make-underline-markup (ly:grob-property grob 'text))))
#})
underlineOff =
#(define-music-function () ()
#{
\revert LyricText.stencil
#})

View File

@@ -40,34 +40,19 @@ shiftChords = #(define-music-function (parser location xshift chords) (number? l
altChord = altChord =
#(define-music-function (parser location mainchord altchord) (ly:music? ly:music?) #(define-music-function (parser location mainchord altchord) (ly:music? ly:music?)
(let* ((remove-point-and-click (let* ((chord-name (lambda (in-pitches bass inversion context)
(lambda (grob) (make-line-markup (list
(ly:grob-set-property! grob 'cause #f) (ignatzek-chord-names in-pitches bass inversion context)
(ly:text-interface::print grob))) (make-hspace-markup 0.3)
(chord-name (lambda (in-pitches bass inversion context) #{ (parenthesis-ignatzek-chord-names (music-pitches (transposable (cons (car (music-pitches mainchord)) (car in-pitches)) (music-clone altchord))) '() '() context)
\markup { ))
\translate #'(-0.5 . 0) )))
\score {
\chords { \transposable #(cons (car (music-pitches mainchord)) (car in-pitches)) { #(music-clone mainchord) \klamm #(music-clone altchord) } }
\layout {
\LAYOUT
\context {
\ChordNames
\override ChordName.extra-spacing-width = #'(0 . 0.3)
\override ChordName.stencil = #remove-point-and-click
}
\context {
\Score
\override SpacingSpanner.spacing-increment = 0
}
}
}
}#})))
#{ #{
\once \set chordNameFunction = #chord-name \once \set chordNameFunction = #chord-name
#mainchord #mainchord
#})) #}))
% Akkorde werden so transponiert, dass sie passen, wenn man mit Kapo im angegebenen Bund spielt % Akkorde werden so transponiert, dass sie passen, wenn man mit Kapo im angegebenen Bund spielt
capoTranspose = capoTranspose =
#(define-music-function (fret chords) (number? ly:music?) #(define-music-function (fret chords) (number? ly:music?)
@@ -80,41 +65,8 @@ capoTranspose =
(ly:make-pitch 0 0) (ly:make-pitch 0 0)
chords)) chords))
% kleine Mollakkorde und Alteration ausgeschrieben
#(define (note-name->german-markup-nosym pitch lowercase?)
(define (pitch-alteration-semitones pitch) (inexact->exact (round (* (ly:pitch-alteration pitch) 2))))
(define (accidental->markup alteration name)
(if (= alteration 0)
(make-line-markup (list empty-markup))
(if (= alteration FLAT)
(if (equal? name "B")
""
; (make-line-markup (list (make-hspace-markup 0.2)
; (make-tiny-markup (make-raise-markup 1.2
; (make-musicglyph-markup (assoc-get alteration standard-alteration-glyph-name-alist ""))))
; ))
(if (or (equal? name "E") (equal? name "A")) "s" "es"))
"is")
))
(define (conditional-string-downcase str condition)
(if condition (string-downcase str) str))
(let* ((name (ly:pitch-notename pitch))
(alt-semitones (pitch-alteration-semitones pitch))
(n-a (if (member (cons name alt-semitones) `((6 . -1) (6 . -2)))
(cons 7 (+ 0 alt-semitones))
(cons name alt-semitones))))
(make-line-markup
(list
(make-simple-markup
(conditional-string-downcase
(vector-ref #("C" "D" "E" "F" "G" "A" "H" "B") (car n-a))
lowercase?))
(accidental->markup (/ (cdr n-a) 2) (vector-ref #("C" "D" "E" "F" "G" "A" "H" "B") (car n-a)) ))))
)
% additional bass notes should get uppercased % additional bass notes should get uppercased
#(define (bassnote-name->german-markup-nosym pitch lowercase?)(note-name->german-markup-nosym pitch #f)) #(define (bassnote-name->german-markup-nosym pitch lowercase?)((chord-name:name-markup 'deutsch) pitch #f))
defaultChordPrintings = { defaultChordPrintings = {
<c g>-\markup { \super "5" } <c g>-\markup { \super "5" }
@@ -157,15 +109,15 @@ generalLayout = \layout {
\generalLayout \generalLayout
\context { \context {
\ChordNames \ChordNames
\semiGermanChords
\override ChordName.font-size = \songScoreChordFontSize \override ChordName.font-size = \songScoreChordFontSize
\override ChordName.font-series = \songChordFontSeries \override ChordName.font-series = \songChordFontSeries
\override ChordName.font-family = #'serif \override ChordName.font-family = #'serif
chordNameLowercaseMinor = ##t chordNameLowercaseMinor = ##t
chordChanges = ##t chordChanges = ##t
% eigenen chordRootNamer damit F# = Fis und Gb = Ges (also alteration ausgeschrieben) chordRootNamer = #(chord-name:name-markup 'deutsch)
chordRootNamer = #note-name->german-markup-nosym
chordNoteNamer = #bassnote-name->german-markup-nosym chordNoteNamer = #bassnote-name->german-markup-nosym
additionalPitchPrefix = ""
majorSevenSymbol = "maj7" majorSevenSymbol = "maj7"
chordNameExceptions = \chordNameExceptions chordNameExceptions = \chordNameExceptions
} }
@@ -214,4 +166,4 @@ Ignoring_newline_chord_changes_engraver =
((chord-name-interface this-engraver grob source-engraver) ((chord-name-interface this-engraver grob source-engraver)
(when (and (ly:context-property ctx 'chordChanges #f) (ly:grob-property grob 'begin-of-line-visible #f)) (when (and (ly:context-property ctx 'chordChanges #f) (ly:grob-property grob 'begin-of-line-visible #f))
(ly:grob-suicide! grob) (ly:grob-suicide! grob)
))))) )))))

View File

@@ -0,0 +1,997 @@
%% ChordPro Export Engraver
%% =========================
%% Single engraver in Score context that collects all data
#(use-modules (ice-9 format))
#(use-modules (srfi srfi-1))
%% Helper function to convert German minor chord notation to standard major form
%% Used for generating {define:} directives
#(define (german-minor-to-major-form chord-str)
"Convert lowercase German minor chords (e.g., 'a7', 'fis') to standard form (e.g., 'Am7', 'Fism')"
(if (or (not (string? chord-str)) (string-null? chord-str))
chord-str
(let* ((first-char (string-ref chord-str 0)))
(if (char-lower-case? first-char)
;; It's a minor chord - capitalize first letter and add 'm' after accidentals
(let* ((rest-str (if (> (string-length chord-str) 1)
(substring chord-str 1)
""))
;; Find where to insert 'm': after 'is' or 'es' if present, otherwise right after root
(insert-pos (cond
((string-prefix? "is" rest-str) 2)
((string-prefix? "es" rest-str) 2)
(else 0)))
(before-m (substring rest-str 0 insert-pos))
(after-m (substring rest-str insert-pos)))
(string-append (string (char-upcase first-char)) before-m "m" after-m))
;; Already uppercase - return as is
chord-str))))
%% Helper function to convert German accidentals to international format
#(define (german-accidentals-to-international chord-str)
"Convert German 'is' to '#' and 'es' to 'b' (e.g., 'fis' -> 'F#', 'as' -> 'Ab')"
(if (or (not (string? chord-str)) (string-null? chord-str))
chord-str
(let* ((first-char (string-ref chord-str 0))
(rest-str (if (> (string-length chord-str) 1)
(substring chord-str 1)
""))
;; Check for 'is' (sharp) or 'es' (flat)
(has-is (string-prefix? "is" rest-str))
(has-es (string-prefix? "es" rest-str))
;; Convert root note
(root-upper (string (char-upcase first-char)))
;; Process accidentals and rest
(processed-rest
(cond
(has-is ; fis -> F#, cis -> C#
(string-append "#" (substring rest-str 2)))
(has-es ; as -> Ab, es -> Eb
(string-append "b" (substring rest-str 2)))
(else rest-str))))
;; Special case: if it's a minor chord (lowercase), add 'm' after accidental
(if (char-lower-case? first-char)
;; Minor: add 'm' after accidental
(if (or has-is has-es)
(string-append root-upper (substring processed-rest 0 1) "m" (substring processed-rest 1))
(string-append root-upper "m" processed-rest))
;; Major: just return converted
(string-append root-upper processed-rest)))))
%% Helper function to convert B/b chords to Bb/Bbm form for {define:} directives
#(define (german-b-to-bb-form chord-str)
"Convert B/b chords to Bb/Bbm format (e.g., 'B7' -> 'Bb7', 'b' -> 'Bbm', 'b7' -> 'Bbm7')"
(if (or (not (string? chord-str)) (string-null? chord-str))
chord-str
(let ((first-char (string-ref chord-str 0)))
(cond
;; Uppercase B -> Bb + rest
((char=? first-char #\B)
(string-append "Bb" (substring chord-str 1)))
;; Lowercase b -> Bbm + rest (it's b-minor)
((char=? first-char #\b)
(let ((rest-str (if (> (string-length chord-str) 1)
(substring chord-str 1)
"")))
(string-append "Bbm" rest-str)))
(else chord-str)))))
%% Helper function to convert H/h chords to B/Bm form for {define:} directives
#(define (german-h-to-b-form chord-str)
"Convert H/h chords to B/Bm format (e.g., 'H7' -> 'B7', 'h' -> 'Bm', 'h7' -> 'Bm7')"
(if (or (not (string? chord-str)) (string-null? chord-str))
chord-str
(let ((first-char (string-ref chord-str 0)))
(cond
;; Uppercase H -> B + rest
((char=? first-char #\H)
(string-append "B" (substring chord-str 1)))
;; Lowercase h -> Bm + rest (it's h-minor)
((char=? first-char #\h)
(let ((rest-str (if (> (string-length chord-str) 1)
(substring chord-str 1)
"")))
(string-append "Bm" rest-str)))
(else chord-str)))))
%% Helper function to track minor/B/H/accidental chords and return original
#(define (track-and-return-chord chord-str)
"Track chords that need {define:} directives and return original."
(if (or (not (string? chord-str)) (string-null? chord-str))
chord-str
(let* ((first-char (string-ref chord-str 0))
(rest-str (if (> (string-length chord-str) 1)
(substring chord-str 1)
""))
(has-is (string-prefix? "is" rest-str))
(has-es (string-prefix? "es" rest-str))
(has-accidental (or has-is has-es)))
(cond
;; H/h chords (German H = English B)
((char=? first-char #\H)
(unless (member chord-str chordpro-h-chords-used)
(set! chordpro-h-chords-used (cons chord-str chordpro-h-chords-used))))
((char=? first-char #\h)
(unless (member chord-str chordpro-h-chords-used)
(set! chordpro-h-chords-used (cons chord-str chordpro-h-chords-used))))
;; B/b chords (German B = English Bb)
((char=? first-char #\B)
(unless (member chord-str chordpro-b-chords-used)
(set! chordpro-b-chords-used (cons chord-str chordpro-b-chords-used))))
((char=? first-char #\b)
(unless (member chord-str chordpro-b-chords-used)
(set! chordpro-b-chords-used (cons chord-str chordpro-b-chords-used))))
;; Chords with accidentals (is/es)
(has-accidental
(unless (member chord-str chordpro-accidental-chords-used)
(set! chordpro-accidental-chords-used (cons chord-str chordpro-accidental-chords-used))))
;; Other lowercase chords (minor without B/H/accidentals)
((char-lower-case? first-char)
(unless (member chord-str chordpro-minor-chords-used)
(set! chordpro-minor-chords-used (cons chord-str chordpro-minor-chords-used)))))
;; Always return original
chord-str)))
%% Helper function to convert chord music object to chord name string
#(define (music-to-chord-name chord-music)
"Extract pitches from a chord music object and convert to German chord name"
(if (not chord-music)
""
(let* ((pitches (music-pitches chord-music)))
(if (or (not pitches) (null? pitches))
"" ; No pitches found
(let* (;; Use ignatzek chord naming with German root names
(chord-markup ((chord-name:name-markup 'deutsch) pitches #f #f #f))
;; Convert markup to string
(chord-str (if (markup? chord-markup)
(markup->string chord-markup)
""))
;; Remove spaces
(cleaned (string-delete #\space chord-str)))
cleaned)))))
%% Helper function to normalize multiple spaces to single space
#(define (normalize-spaces str)
"Replace multiple consecutive spaces with a single space"
(let loop ((chars (string->list str))
(result '())
(prev-was-space #f))
(if (null? chars)
(list->string (reverse result))
(let ((char (car chars)))
(if (char=? char #\space)
(if prev-was-space
;; Skip this space
(loop (cdr chars) result #t)
;; Keep this space
(loop (cdr chars) (cons char result) #t))
;; Not a space
(loop (cdr chars) (cons char result) #f))))))
%% Helper function to extract chord names from markup, handling \altChord format
#(define (extract-chord-names-from-markup markup)
"Extract chord names from markup, handling complex structures like \altChord which produces 'B(Gm)' format"
(let* ((raw-str (cond
((string? markup) markup)
((markup? markup) (markup->string markup))
((pair? markup) (extract-chord-names-from-markup (car markup)))
(else (format #f "~a" markup))))
;; Remove all spaces
(clean-str (string-delete #\space raw-str)))
;; Check if this is an altChord format: "B(Gm)" or similar
(if (string-index clean-str #\()
;; Multiple chords: split by parentheses
(let* ((open-paren (string-index clean-str #\())
(close-paren (string-index clean-str #\)))
(first-chord (substring clean-str 0 open-paren))
(second-chord (if (and open-paren close-paren)
(substring clean-str (+ open-paren 1) close-paren)
"")))
;; Format as:[B][(Gm)] - first chord normal, second in parens
(string-append first-chord "][(" second-chord ")"))
;; Single chord: return as is
clean-str)))
%% Global state - shared across all engraver instances!
#(define chordpro-syllables-collected '())
#(define chordpro-chords-collected '())
#(define chordpro-breaks-collected '())
#(define chordpro-stanza-numbers '())
%% Format: (moment verse-idx text direction) for inline text markers like repStart/repStop
#(define chordpro-inline-texts-collected '())
%%Track break moments to detect verse changes
#(define chordpro-seen-break-moments '())
%% Increments with each verse (each chordlyrics call)
#(define chordpro-current-verse-index 0)
%% Collected minor chords (lowercase German chords) for {define:} directives
#(define chordpro-minor-chords-used '())
%% Collected B chords (German B = English Bb) for {define:} directives
#(define chordpro-b-chords-used '())
%% Collected H chords (German H = English B) for {define:} directives
#(define chordpro-h-chords-used '())
%% Collected chords with accidentals (is/es) for {define:} directives
#(define chordpro-accidental-chords-used '())
%% Configuration and metadata (set by layout_bottom.ily or song file)
#(define chordpro-export-enabled #t)
#(define chordpro-current-filename "output")
#(define chordpro-header-title "Untitled")
#(define chordpro-header-authors #f)
%% Write flag (ensures we only write once, not for each finalize call)
#(define chordpro-file-written #f)
%% Helper function to format stanza label for ChordPro
#(define (format-chordpro-stanza-label stanza-type stanza-numbers)
"Generate ChordPro label based on stanza type and optional numbers"
(let* ((has-numbers (and stanza-numbers (not (null? stanza-numbers))))
(numbers-string (if has-numbers
(string-join (map (lambda (n) (format #f "~a" n)) stanza-numbers) ", ")
"")))
(cond
((eq? stanza-type 'ref)
(if has-numbers
(format #f (if (defined? 'refStringWithNumbers) refStringWithNumbers "Ref. ~a:") numbers-string)
(if (defined? 'refString) refString "Ref.:")))
((eq? stanza-type 'bridge)
(if has-numbers
(format #f (if (defined? 'bridgeStringWithNumbers) bridgeStringWithNumbers "Bridge ~a:") numbers-string)
(if (defined? 'bridgeString) bridgeString "Bridge:")))
(else #f))))
%% Single engraver in Score context
#(define ChordPro_score_collector
(lambda (context)
(let ((pending-syllable #f)
(this-verse-index #f))
(make-engraver
;; Initialize - called when engraver is created (once per \chordlyrics)
((initialize engraver)
;; Each \chordlyrics call creates a new Score, so this marks a new verse
(when (> chordpro-current-verse-index 0)
;; Reset break tracking for new verse
(set! chordpro-seen-break-moments '()))
;; Store the verse index for this instance
(set! this-verse-index chordpro-current-verse-index)
;; Increment global index for next verse
(set! chordpro-current-verse-index (+ chordpro-current-verse-index 1)))
;; Event listeners
(listeners
;; LyricEvent from Lyrics context
((lyric-event engraver event)
(let ((text (ly:event-property event 'text))
(moment (ly:context-current-moment context)))
(when (string? text)
;; On first lyric event for this engraver instance, capture the verse index
(when (not this-verse-index)
(set! this-verse-index chordpro-current-verse-index)
(set! chordpro-current-verse-index (+ chordpro-current-verse-index 1)))
;; Save previous syllable if any (it had no hyphen)
(when pending-syllable
(set! chordpro-syllables-collected
(cons (list (car pending-syllable) (cadr pending-syllable) #f (caddr pending-syllable))
chordpro-syllables-collected)))
;; Store new syllable as pending (with THIS instance's verse index)
(set! pending-syllable (list moment text this-verse-index)))))
;; HyphenEvent from Lyrics context
((hyphen-event engraver event)
(when pending-syllable
(set! chordpro-syllables-collected
(cons (list (car pending-syllable) (cadr pending-syllable) #t (caddr pending-syllable))
chordpro-syllables-collected))
(set! pending-syllable #f)))
;; BreakEvent - store break moment
((break-event engraver event)
(let ((moment (ly:context-current-moment context)))
;; Store break with this instance's verse index
(set! chordpro-breaks-collected
(cons (cons moment this-verse-index) chordpro-breaks-collected)))))
;; Acknowledge grobs from child contexts
(acknowledgers
;; StanzaNumber grobs to extract stanza type and text
((stanza-number-interface engraver grob source-engraver)
(let* ((details (ly:grob-property grob 'details '()))
(custom-realstanza (ly:assoc-get 'custom-realstanza details #f))
(stanza-type (ly:assoc-get 'custom-stanza-type details 'verse))
(stanza-numbers (ly:assoc-get 'custom-stanza-numbers details '()))
;; Check for custom inline text (e.g., repStart/repStop with direction)
(custom-inline-text (ly:assoc-get 'custom-inline-text details #f))
(custom-inline-direction (ly:assoc-get 'custom-inline-direction details CENTER))
;; Try to read stanza text from multiple sources:
;; 1. From the grob's text property
(stanza-text-from-grob (ly:grob-property grob 'text #f))
;; 2. From the Lyrics context's stanza property
(lyrics-context (ly:translator-context source-engraver))
(stanza-text-from-context (if lyrics-context
(ly:context-property lyrics-context 'stanza #f)
#f))
;; Use context property if available, otherwise grob property
(stanza-markup (or stanza-text-from-context stanza-text-from-grob))
;; For ref/bridge, always use format-chordpro-stanza-label
;; For verse, extract from markup (includes roman numerals if \romanStanza was used)
(stanza-text (if (or (eq? stanza-type 'ref) (eq? stanza-type 'bridge))
(format-chordpro-stanza-label stanza-type stanza-numbers)
(if (markup? stanza-markup)
(markup->string stanza-markup)
(if stanza-markup
(format #f "~a" stanza-markup)
#f))))
(existing (assoc this-verse-index chordpro-stanza-numbers))
(moment (ly:context-current-moment (ly:translator-context source-engraver)))
(direction (ly:grob-property grob 'direction CENTER)))
;; If custom-inline-text is set, always collect it as inline text (regardless of realstanza)
;; This allows repStart/repStop to be collected even when combined with real stanza numbers
(when custom-inline-text
(set! chordpro-inline-texts-collected
(cons (list moment this-verse-index custom-inline-text custom-inline-direction)
chordpro-inline-texts-collected)))
;; If this is NOT a real stanza marker (custom-realstanza not set or ##f),
;; collect it as inline text with direction info
(when (and (not custom-realstanza) (not custom-inline-text))
(when stanza-text ; Only if there's text to display
(set! chordpro-inline-texts-collected
(cons (list moment this-verse-index stanza-text direction)
chordpro-inline-texts-collected))))
;; Store or update stanza info for this verse (only if it's a real stanza marker)
;; Entry format: (verse-idx stanza-text stanza-type realstanza-flag)
(when custom-realstanza
(if existing
;; Update existing entry with type and text if available
;; IMPORTANT: Don't overwrite realstanza=##t markers and their text
(let* ((existing-text (cadr existing))
(existing-type (caddr existing))
(existing-realstanza (if (> (length existing) 3) (cadddr existing) #f)))
(set! chordpro-stanza-numbers
(map (lambda (entry)
(if (= (car entry) this-verse-index)
(list (car entry)
;; If existing entry is a real stanza, don't overwrite text
;; Otherwise, use new text if available
(if existing-realstanza
existing-text
(or stanza-text existing-text))
;; Update type only if custom-realstanza is set
(if custom-realstanza stanza-type existing-type)
;; Preserve ##t realstanza flag
(or existing-realstanza custom-realstanza))
entry))
chordpro-stanza-numbers)))
;; Create new entry with type, text, and realstanza flag
(set! chordpro-stanza-numbers
(cons (list this-verse-index stanza-text stanza-type custom-realstanza)
chordpro-stanza-numbers)))))) ; closes set!, if, when, stanza-number-interface
;; ChordName grobs from ChordNames context
;; Store grob reference - visibility will be recorded by ChordPro_chord_visibility_recorder
((chord-name-interface engraver grob source-engraver)
(let* ((moment (ly:context-current-moment context))
;; Get details property to check for altChord
(details (ly:grob-property grob 'details '()))
(alt-main-name (assoc-get 'alt-chord-main-name details #f))
(alt-alt-name (assoc-get 'alt-chord-alt-name details #f))
;; Extract chord name
(chord-name-final
(if (and alt-main-name alt-alt-name)
;; This is an altChord - use the pre-extracted names
(let ((main (track-and-return-chord alt-main-name))
(alt (track-and-return-chord alt-alt-name)))
;; Check if main is empty - if so, only output alt in parens
(if (string-null? main)
(string-append "[(" alt ")]") ; Only alt chord: [(D7)]
;; Format as: [B][(Gm)] (complete with all brackets)
(string-append "[" main "][(" alt ")]")))
;; Normal chord - extract from markup text
(let* ((chord-text (ly:grob-property grob 'text))
(chord-names-str (extract-chord-names-from-markup chord-text))
;; Check if it contains "][(": multiple chords (shouldn't happen anymore)
(has-bracket (string-index chord-names-str #\])))
(if has-bracket
;; Multiple chords from old logic: manually split and process
(let* ((bracket-pos (string-index chord-names-str #\]))
(first-part (substring chord-names-str 0 bracket-pos))
(rest (substring chord-names-str bracket-pos))
(open-pos (string-index rest #\())
(close-pos (string-index rest #\)))
(second-part (if (and open-pos close-pos)
(substring rest (+ open-pos 1) close-pos)
""))
(first-converted (track-and-return-chord first-part))
(second-converted (track-and-return-chord second-part)))
(string-append first-converted "][(" second-converted ")"))
;; Single chord: just track and return original
(track-and-return-chord chord-names-str))))))
;; Store grob reference along with chord data (unless empty)
;; Format: (moment chord-name verse-index grob)
;; Filter out completely empty chords, but convert ][(X) to [(X)]
(let ((processed-chord-name
(cond
;; Empty chord
((or (string-null? chord-name-final)
(string=? chord-name-final "")
(string=? chord-name-final "]["))
#f) ; Filter out
;; Pattern ][(X) - empty main, only alt in parens: convert to [(X)]
((string-prefix? "][(" chord-name-final)
;; ][(D7) → [(D7)]
(let* ((inner (substring chord-name-final 3 (- (string-length chord-name-final) 1))))
(string-append "[(" inner ")]")))
;; Normal chord
(else chord-name-final))))
(when processed-chord-name
(set! chordpro-chords-collected
(cons (list moment processed-chord-name this-verse-index grob) chordpro-chords-collected))))))
;; LyricText grobs to get stanza number
((lyric-syllable-interface engraver grob source-engraver)
(let* ((stanza-grob (ly:grob-property grob 'stanza #f))
;; Get the Lyrics context from the source engraver
(lyrics-context (ly:translator-context source-engraver))
(stanza-context (if lyrics-context
(ly:context-property lyrics-context 'stanza #f)
#f))
(stanza-value (or stanza-grob stanza-context)))
(when stanza-value
;; Only update existing stanza entries (don't create new ones)
;; New entries should only be created by stanza-number-interface
(let* ((existing (assoc this-verse-index chordpro-stanza-numbers))
(existing-text (if existing (cadr existing) #f))
(stanza-text (if (markup? stanza-value)
(markup->string stanza-value)
(format #f "~a" stanza-value))))
;; Only update if entry exists and existing text is empty/false and new text is non-empty
(when (and existing
(not (and (string? existing-text) (not (string-null? existing-text))))
(string? stanza-text)
(not (string-null? stanza-text)))
;; Update existing entry with text (keep type and realstanza flag)
(set! chordpro-stanza-numbers
(map (lambda (entry)
(if (= (car entry) this-verse-index)
(list (car entry)
(or existing-text stanza-text) ; Keep existing text if present
(caddr entry) ; Keep stanza-type
(if (> (length entry) 3) (cadddr entry) #f)) ; Keep realstanza-flag if exists
entry))
chordpro-stanza-numbers))))))) ; schließt lyric-syllable-interface
) ; schließt acknowledgers
;; End of timestep
((stop-translation-timestep engraver)
(when pending-syllable
(set! chordpro-syllables-collected
(cons (list (car pending-syllable) (cadr pending-syllable) #f (caddr pending-syllable))
chordpro-syllables-collected))
(set! pending-syllable #f)))
;; Finalize - just write debug, don't filter chords yet
;; (Filtering happens in chordpro-write-from-engraver-data where grob properties are final)
((finalize engraver)
;; Save any remaining pending syllable
(when pending-syllable
(set! chordpro-syllables-collected
(cons (list (car pending-syllable) (cadr pending-syllable) #f (caddr pending-syllable))
chordpro-syllables-collected))
(set! pending-syllable #f))
)))))
%% Helper functions to format and write ChordPro
#(define (chordpro-write-from-engraver-data num-verses)
"Write ChordPro file from collected engraver data"
(let* ((filename (if (defined? 'chordpro-current-filename)
chordpro-current-filename
"output"))
(output-file (string-append filename ".cho"))
;; Reverse all lists (they were collected in reverse order)
(syllables (reverse chordpro-syllables-collected))
(chords (reverse chordpro-chords-collected))
(breaks (reverse chordpro-breaks-collected)))
(with-output-to-file output-file
(lambda ()
;; Write metadata
(display (format #f "{title: ~a}\n"
(if (defined? 'chordpro-header-title)
chordpro-header-title
"Untitled")))
(when (and (defined? 'chordpro-header-authors) chordpro-header-authors)
(display (format #f "{artist: ~a}\n"
(format-chordpro-authors chordpro-header-authors))))
;; Write {define:} directives for all used minor chords
(unless (null? chordpro-minor-chords-used)
(newline)
(for-each
(lambda (minor-chord)
;; Convert minor chord to major form for the definition
(let ((major-form (german-minor-to-major-form minor-chord)))
(display (format #f "{define: ~a copy ~a}\n" minor-chord major-form))))
(reverse chordpro-minor-chords-used)))
;; Write {define:} directives for all used B chords (German B = English Bb)
(unless (null? chordpro-b-chords-used)
(for-each
(lambda (b-chord)
;; Convert B/b to Bb/Bbm form for the definition
(let ((bb-form (german-b-to-bb-form b-chord)))
(display (format #f "{define: ~a copy ~a}\n" b-chord bb-form))))
(reverse chordpro-b-chords-used)))
;; Write {define:} directives for all used H chords (German H = English B)
(unless (null? chordpro-h-chords-used)
(for-each
(lambda (h-chord)
;; Convert H/h to B/Bm form for the definition
(let ((b-form (german-h-to-b-form h-chord)))
(display (format #f "{define: ~a copy ~a}\n" h-chord b-form))))
(reverse chordpro-h-chords-used)))
;; Write {define:} directives for chords with accidentals (is/es -> #/b)
(unless (null? chordpro-accidental-chords-used)
(for-each
(lambda (accidental-chord)
;; Convert German accidentals to international format
(let ((intl-form (german-accidentals-to-international accidental-chord)))
(display (format #f "{define: ~a copy ~a}\n" accidental-chord intl-form))))
(reverse chordpro-accidental-chords-used)))
(newline)
;; Write each verse in reverse order (they were collected backwards)
(let loop ((verse-idx (- num-verses 1)))
(when (>= verse-idx 0)
;; Get syllables, chords and breaks for this verse
(let* ((verse-syllables (filter (lambda (s) (= (cadddr s) verse-idx)) syllables))
(verse-chords-raw (filter (lambda (c)
(and (list? c)
(>= (length c) 3)
(= (caddr c) verse-idx)))
chords))
;; Simple filtering: remove repeated consecutive chords
(verse-chords (let filter-repeats ((chords-left verse-chords-raw)
(last-chord #f)
(result '()))
(if (null? chords-left)
(reverse result)
(let* ((chord (car chords-left))
(chord-name (cadr chord)))
(if (equal? chord-name last-chord)
;; Skip repeated chord
(filter-repeats (cdr chords-left) last-chord result)
;; Include new chord
(filter-repeats (cdr chords-left) chord-name
(cons (list (car chord) chord-name (caddr chord)) result)))))))
(verse-breaks (filter (lambda (b) (= (cdr b) verse-idx)) breaks))
(verse-inline-texts (filter (lambda (r) (= (cadr r) verse-idx))
(reverse chordpro-inline-texts-collected)))
;; Get stanza info (number, type, and realstanza flag) for this verse
(stanza-entry (find (lambda (s) (= (car s) verse-idx)) chordpro-stanza-numbers))
(stanza-num (if stanza-entry (cadr stanza-entry) #f))
(stanza-type (if stanza-entry (caddr stanza-entry) 'verse))
(realstanza (if stanza-entry (cadddr stanza-entry) #f))
;; Determine ChordPro directive based on type
(start-directive (cond
((eq? stanza-type 'ref) "start_of_chorus")
((eq? stanza-type 'bridge) "start_of_bridge")
(else "start_of_verse")))
(end-directive (cond
((eq? stanza-type 'ref) "end_of_chorus")
((eq? stanza-type 'bridge) "end_of_bridge")
(else "end_of_verse"))))
(when (not (null? verse-syllables))
;; If realstanza is ##t, output with ChordPro directives
;; Otherwise, just output the text (e.g., for repStartWithTag/repStopWithTag)
(if realstanza
(begin
(if (and stanza-num (not (string-null? stanza-num)))
(display (format #f "{~a: label=\"~a\"}\n" start-directive stanza-num))
(display (format #f "{~a}\n" start-directive)))
(display (format-verse-as-chordpro verse-syllables verse-chords verse-breaks verse-inline-texts))
(display (format #f "\n{~a}\n\n" end-directive)))
(begin
;; For non-real stanzas, just output stanza marker as comment if present
(when (and stanza-num (not (string-null? stanza-num)))
(display (format #f "# ~a\n" stanza-num)))
(display (format-verse-as-chordpro verse-syllables verse-chords verse-breaks verse-inline-texts))
(display "\n\n"))))
(loop (- verse-idx 1)))))))
))
#(define (format-verse-as-chordpro syllables chords breaks inline-texts)
"Format one verse as ChordPro text with line breaks.
Chords are placed at syllable boundaries, not word boundaries.
Inline texts (𝄆 𝄇 etc.) are inserted based on their direction property."
(let* (;; Get break moments
(break-moments (sort (map (lambda (b) (ly:moment-main (car b))) breaks) <))
;; Map each chord to the nearest following syllable
(chord-to-syllable-map (map-chords-to-syllables chords syllables))
;; Sort inline texts by moment
(sorted-inline-texts (sort inline-texts (lambda (a b) (ly:moment<? (car a) (car b)))))
;; Build formatted output
(lines '())
(current-line '())
(current-word-parts '())
(pending-word-suffix-chords '()) ; Collect suffix chords during word building
(word-start-moment #f))
;; Process each syllable
(let process-syllables ((syls-left syllables) (syl-idx 0) (breaks-left break-moments) (inlines-left sorted-inline-texts) (pending-line-chords '()))
(if (null? syls-left)
;; Finish last word and line
(begin
(unless (null? current-word-parts)
;; Append pending suffix chords to the last word part
(when (not (null? pending-word-suffix-chords))
(let ((last-part (car current-word-parts))
(suffix-str (string-concatenate (reverse pending-word-suffix-chords))))
(set! current-word-parts (cons (string-append last-part suffix-str) (cdr current-word-parts)))
(set! pending-word-suffix-chords '())))
(set! current-line (cons (string-concatenate (reverse current-word-parts)) current-line)))
(unless (null? current-line)
(set! lines (cons (reverse current-line) lines))))
;; Process next syllable
(let* ((syl-entry (car syls-left))
(syl-moment (ly:moment-main (car syl-entry)))
(syl-text-raw (cadr syl-entry))
;; Normalize: treat whitespace-only strings as empty (lyric extenders come as spaces)
(syl-text (if (and (string? syl-text-raw)
(not (string-null? syl-text-raw))
(string-every char-set:whitespace syl-text-raw))
""
syl-text-raw))
(has-hyphen (caddr syl-entry))
(rest-syls (cdr syls-left))
;; Find chords for this syllable position (including extenders!)
(syl-chords (filter (lambda (cm) (= (caddr cm) syl-idx)) chord-to-syllable-map))
;; Separate chords into prefix (before/on syllable) and suffix (after syllable)
;; Separate chords into prefix (before/on syllable) and suffix (after syllable)
(prefix-chords (filter (lambda (c) (<= (ly:moment-main (car c)) syl-moment)) syl-chords))
(suffix-chords-all (filter (lambda (c) (> (ly:moment-main (car c)) syl-moment)) syl-chords))
;; Filter suffix chords: only keep those where NO line break exists between syllable and chord
;; If a break is between the syllable and chord, the chord belongs to the next line
(suffix-chords (filter (lambda (c)
(let ((chord-moment (ly:moment-main (car c))))
;; Keep chord if no break exists, or if break is not between syl and chord
(or (null? breaks-left)
(let ((next-break (car breaks-left)))
;; Only keep if break is AFTER the chord (or before/at syllable)
;; Reject if: syl-moment < next-break <= chord-moment
(not (and (> next-break syl-moment)
(<= next-break chord-moment)))))))
suffix-chords-all))
;; Collect chords that were filtered out - they belong to the next line
(next-line-chords (filter (lambda (c)
(let ((chord-moment (ly:moment-main (car c))))
(and (not (null? breaks-left))
(let ((next-break (car breaks-left)))
(and (> next-break syl-moment)
(<= next-break chord-moment))))))
suffix-chords-all))
;; Create chord prefix: add space after chord if it plays on a rest (before syllable)
(chord-prefix (if (null? prefix-chords)
""
(string-join
(map (lambda (c)
(let* ((chord-moment (ly:moment-main (car c)))
(chord-name (cadr c))
;; Check if chord plays before syllable (on a rest)
(on-rest? (< chord-moment syl-moment))
;; Check if chord already has brackets
(has-brackets (string-prefix? "[" chord-name)))
(if has-brackets
;; Already has brackets - just add space if needed
(if on-rest?
(string-append chord-name " ")
chord-name)
;; Add brackets
(if on-rest?
(string-append "[" chord-name "] ")
(string-append "[" chord-name "]")))))
prefix-chords)
"")))
;; Create chord suffix for chords that play after the syllable (on rests)
(chord-suffix (if (null? suffix-chords)
""
(string-join
(map (lambda (c)
(let ((chord-name (cadr c)))
;; Check if chord already has brackets (e.g., "[(D7)]")
(if (string-prefix? "[" chord-name)
chord-name ; Already has brackets
(string-append "[" chord-name "]"))))
suffix-chords)
"")))
;; Check for line break
(next-syl-moment (if (null? rest-syls) 999999 (ly:moment-main (car (car rest-syls)))))
(break-here (and (not (null? breaks-left))
(let ((next-break (car breaks-left)))
(and (> next-break syl-moment)
(<= next-break next-syl-moment))))))
;; Check for inline texts at this syllable position
(let* ((inline-result
(let collect-inlines ((inls inlines-left) (collected '()))
(if (or (null? inls)
(let ((inl-entry (car inls)))
(> (ly:moment-main (car inl-entry)) syl-moment)))
(list (reverse collected) inls)
(collect-inlines (cdr inls) (cons (car inls) collected)))))
(inlines-to-insert (car inline-result))
(new-inlines-left (cadr inline-result))
;; Separate by direction: LEFT texts go before, RIGHT texts go after
(before-texts (filter (lambda (i) (eqv? (cadddr i) LEFT)) inlines-to-insert))
(after-texts (filter (lambda (i) (eqv? (cadddr i) RIGHT)) inlines-to-insert)))
;; If this is the start of a new line and we have pending chords from the previous line
(when (and (null? current-line) (not (null? pending-line-chords)))
;; If we're continuing a word (current-word-parts not empty), add chords as infix
;; Otherwise add them as a separate word-like element
(if (not (null? current-word-parts))
;; Add pending chords as infix to the last word part
(let* ((last-part (car current-word-parts))
(rest-parts (cdr current-word-parts))
(pending-chord-str (string-join
(map (lambda (c)
(let ((chord-name (cadr c)))
(if (string-prefix? "[" chord-name)
chord-name ; Already has brackets
(string-append "[" chord-name "]"))))
pending-line-chords)
"")))
(set! current-word-parts (cons (string-append last-part pending-chord-str) rest-parts)))
;; No word continuation - add as separate element
(let ((pending-chord-str (string-join
(map (lambda (c)
(let ((chord-name (cadr c)))
(if (string-prefix? "[" chord-name)
chord-name ; Already has brackets
(string-append "[" chord-name "]"))))
pending-line-chords)
"")))
(set! current-line (cons pending-chord-str current-line)))))
;; Insert texts that should appear BEFORE the syllable (direction = LEFT)
(for-each
(lambda (inline-text)
(set! current-line (cons (caddr inline-text) current-line)))
before-texts)
;; Track word start
(when (null? current-word-parts)
(set! word-start-moment syl-moment))
;; Add text to current word only if syllable is not empty (not a lyric extender _)
;; Handle chords: if we're continuing a word (current-word-parts not empty),
;; prefix chords should be inserted between syllables as infixes (without trailing space)
(unless (string-null? syl-text)
(if (null? current-word-parts)
;; First syllable of word: use prefix as normal
(set! current-word-parts (cons (string-append chord-prefix syl-text) current-word-parts))
;; Continuation of word: insert prefix chord between previous syllable and this one
(begin
;; Append prefix chord to the LAST syllable (strip trailing space from chord-prefix for infix use)
(unless (string-null? chord-prefix)
(let* ((last-part (car current-word-parts))
(rest-parts (cdr current-word-parts))
;; Remove trailing space from chord-prefix if present
(chord-infix (if (string-suffix? " " chord-prefix)
(substring chord-prefix 0 (- (string-length chord-prefix) 1))
chord-prefix)))
(set! current-word-parts (cons (string-append last-part chord-infix) rest-parts))))
;; Add current syllable
(set! current-word-parts (cons syl-text current-word-parts)))))
;; Always collect suffix chords (even from extenders), they'll be output at word end
(unless (string-null? chord-suffix)
(set! pending-word-suffix-chords (cons chord-suffix pending-word-suffix-chords)))
;; Complete word only if: no hyphen AND syllable has text (not an extender)
(when (and (not has-hyphen) (not (string-null? syl-text)))
(if (null? current-word-parts)
;; No word parts (shouldn't happen) - just output suffix chords if any
(unless (null? pending-word-suffix-chords)
(set! current-line (cons (string-concatenate (reverse pending-word-suffix-chords)) current-line))
(set! pending-word-suffix-chords '()))
;; Normal word completion with all collected suffix chords
(let ((word-with-suffix
(if (null? pending-word-suffix-chords)
(string-concatenate (reverse current-word-parts))
(string-append
(string-concatenate (reverse current-word-parts))
(string-concatenate (reverse pending-word-suffix-chords))))))
(set! current-line (cons word-with-suffix current-line))
(set! current-word-parts '())
(set! pending-word-suffix-chords '()))))
(for-each
(lambda (inline-text)
(set! current-line (cons (caddr inline-text) current-line)))
after-texts)
;; If break here, complete line (word parts continue on next line)
(if break-here
(begin
(set! lines (cons (reverse current-line) lines))
(set! current-line '())
(process-syllables rest-syls (+ syl-idx 1) (cdr breaks-left) new-inlines-left next-line-chords))
(process-syllables rest-syls (+ syl-idx 1) breaks-left new-inlines-left '())))))
;; Format all lines and normalize multiple spaces
(string-join
(map (lambda (line-words)
(let ((line (string-join line-words " ")))
(normalize-spaces line)))
(reverse lines))
"\n"))))
#(define (map-chords-to-syllables chords syllables)
"For each chord, find the nearest following syllable.
If no following syllable within tolerance, use the last preceding syllable.
Returns list of (chord-moment chord-name syllable-index)"
(let ((tolerance (ly:make-moment 1/4)))
(filter-map
(lambda (chord-entry)
(let* ((chord-moment (car chord-entry))
(chord-name (cadr chord-entry))
;; Find syllables that start AT or AFTER this chord (within tolerance)
(candidate-syllables-forward
(filter-map
(lambda (syl-entry syl-idx)
(let* ((syl-moment (car syl-entry))
(diff (ly:moment-sub syl-moment chord-moment)))
;; Syllable must start at or after chord, within tolerance
(if (and (not (ly:moment<? diff (ly:make-moment 0))) ; diff >= 0
(ly:moment<=? diff tolerance))
(list diff syl-idx)
#f)))
syllables
(iota (length syllables))))) ; syllable indices
;; If no forward match, try to find the last syllable BEFORE the chord
(if (not (null? candidate-syllables-forward))
;; Pick the closest following syllable (smallest diff)
(let* ((sorted (sort candidate-syllables-forward (lambda (a b) (ly:moment<? (car a) (car b)))))
(best (car sorted))
(best-syl-idx (cadr best)))
(list chord-moment chord-name best-syl-idx))
;; No following syllable - find last preceding syllable
(let ((preceding-syllables
(filter-map
(lambda (syl-entry syl-idx)
(let* ((syl-moment (car syl-entry))
(diff (ly:moment-sub chord-moment syl-moment)))
;; Chord must come after syllable (diff > 0)
(if (ly:moment<? (ly:make-moment 0) diff)
(list diff syl-idx syl-moment)
#f)))
syllables
(iota (length syllables)))))
(if (null? preceding-syllables)
#f ; No syllables at all - skip this chord
;; Pick the latest preceding syllable (smallest diff = closest before chord)
(let* ((sorted (sort preceding-syllables (lambda (a b) (ly:moment<? (car a) (car b)))))
(best (car sorted))
(best-syl-idx (cadr best)))
(list chord-moment chord-name best-syl-idx)))))))
chords)))
#(define (join-syllables-into-words syllables)
"Join syllables into words based on hyphen flags"
;; syllables structure: (moment text has-hyphen verse-idx)
(let ((result '())
(current-word-parts '())
(word-start-moment #f))
(for-each
(lambda (syl-entry)
(let* ((moment (car syl-entry))
(text (cadr syl-entry))
(has-hyphen (caddr syl-entry)))
;; Track the moment of the first syllable of each word
(when (null? current-word-parts)
(set! word-start-moment moment))
;; Add syllable part to current word
(set! current-word-parts (cons text current-word-parts))
;; If no hyphen after this syllable, the word is complete
(unless has-hyphen
(let ((complete-word (string-concatenate (reverse current-word-parts))))
(set! result (cons (cons word-start-moment complete-word) result)))
(set! current-word-parts '()))))
syllables)
;; Return words in correct order
(reverse result)))
#(define (find-chord-at-moment chords moment)
"Find chord at or close to the given syllable moment"
;; chords structure: (moment name verse-idx)
;; Strategy: Find the CLOSEST chord that comes AT or AFTER the word start
;; This way each chord is only matched to the nearest preceding word
(let ((tolerance (ly:make-moment 1/4))) ; Allow chord up to 1/4 after word start
(let loop ((remaining chords) (best-match #f) (best-diff #f))
(cond
((null? remaining) best-match)
(else
(let* ((chord-entry (car remaining))
(chord-moment (car chord-entry))
(chord-name (cadr chord-entry))
(diff (ly:moment-sub chord-moment moment))) ; positive if chord is after word
;; Only consider chords that are AT or AFTER the word start (diff >= 0)
;; and within tolerance
(let ((valid (and (not (ly:moment<? diff (ly:make-moment 0))) ; diff >= 0
(ly:moment<=? diff tolerance))))
(if (and valid
(or (not best-diff)
(ly:moment<? diff best-diff))) ; prefer closest (smallest diff)
(loop (cdr remaining) chord-name diff)
(loop (cdr remaining) best-match best-diff)))))))))
#(define (ly:moment=? a b)
"Check if two moments are equal"
(and (not (ly:moment<? a b))
(not (ly:moment<? b a))))
#(define (ly:moment-abs m)
"Get absolute value of moment"
(if (ly:moment<? m (ly:make-moment 0))
(ly:moment-sub (ly:make-moment 0) m)
m))
#(define (ly:moment<=? m1 m2)
"Check if m1 <= m2"
(or (ly:moment<? m1 m2)
(ly:moment=? m1 m2)))
#(define (ly:moment-add m1 m2)
"Add two moments"
(ly:moment-sub m1 (ly:moment-sub (ly:make-moment 0) m2)))
#(define (format-chordpro-authors authors)
"Format authors list for ChordPro"
(cond
((list? authors)
(string-join
(filter (lambda (s) (not (string-null? s)))
(map (lambda (author-info)
(cond
((pair? author-info) (car author-info))
((string? author-info) author-info)
(else "")))
authors))
", "))
(else "")))
%% Define markup command for delayed ChordPro write BEFORE modifying TEXT_PAGES
%% Uses delay-stencil-evaluation to write after all engraver data is collected
#(define-markup-command (chordpro-delayed-write layout props)
()
#:category other
"Invisible markup that writes ChordPro file during stencil evaluation (after all engraver data is collected)"
;; We use a delayed stencil to ensure all engraver data is available
(ly:make-stencil
`(delay-stencil-evaluation
,(delay (begin
(when (and (defined? 'chordpro-export-enabled)
chordpro-export-enabled
(not chordpro-file-written)
(> chordpro-current-verse-index 0))
(chordpro-write-from-engraver-data chordpro-current-verse-index)
(set! chordpro-file-written #t))
empty-stencil)))))

View File

@@ -2,8 +2,8 @@
poetPrefix = "Worte:" poetPrefix = "Worte:"
composerPrefix = "Weise:" composerPrefix = "Weise:"
compositionPrefix = "Satz:" compositionPrefix = "Satz:"
adaptionTextPrefix = "Bearbeitung Text:" adaptionTextPrefix = "Bearbeitung:"
adaptionMusicPrefix = "Bearbeitung Musik:" adaptionMusicPrefix = "Bearbeitung:"
poetAndComposerEqualPrefix = "Worte und Weise:" poetAndComposerEqualPrefix = "Worte und Weise:"
voicePrefix = "Stimme:" voicePrefix = "Stimme:"
versePrefix = "Strophe:" versePrefix = "Strophe:"
@@ -12,6 +12,7 @@
pronunciationPrefix = "Aussprache:" pronunciationPrefix = "Aussprache:"
interludePrefix = "Zwischenspiel:" interludePrefix = "Zwischenspiel:"
bridgePrefix = "Bridge:" bridgePrefix = "Bridge:"
author-joiner = #(lambda (author-list) (string-join author-list ", "))
authorFormat = authorFormat =
#(lambda (noDetails name trail_name birth_year death_year organization) #(lambda (noDetails name trail_name birth_year death_year organization)
@@ -31,6 +32,105 @@
"" ""
))) )))
authorContributionFormat =
#(lambda* (render-contribution-group render-partial-contribution-group #:key
(poetIds '())
(translatorIds '())
(versePoetData '())
(composerIds '())
(verseComposerData '())
(voiceComposerData '())
(compositionIds '())
(adaptionTextIds '())
(adaptionMusicIds '())
(bridgeIds '())
(interludeIds '())
(year_text #f)
(year_translation #f)
(year_melody #f)
(year_composition #f)
(year_adaption_text #f)
(year_adaption_music #f)
(poetAndComposerEqualPrefix "")
(poetPrefix "")
(composerPrefix "")
(translationAuthorPrefix "")
(pronunciationPrefix "")
(compositionPrefix "")
(adaptionTextPrefix "")
(adaptionMusicPrefix "")
(bridgePrefix "")
(interludePrefix ""))
(if (and
(equal? poetIds composerIds)
(null? translatorIds)
(null? versePoetData)
(null? verseComposerData)
(null? voiceComposerData)
(null? compositionIds)
(null? adaptionTextIds)
(null? adaptionMusicIds)
(null? bridgeIds)
(null? interludeIds))
(list
(join-present (list
(render-contribution-group poetAndComposerEqualPrefix poetIds)
(if (equal? year_text year_melody) year_text (join-present (list year_text year_melody) "/"))
) ", ")
#f)
(list
(if (and (null? poetIds) (null? versePoetData) (null? translatorIds)) #f
(string-append
poetPrefix
" "
(join-present (list
(join-present (list
(render-contribution-group "" poetIds)
year_text
) ", ")
(render-partial-contribution-group 'versePrefix versePoetData)
(join-present (list
(render-contribution-group adaptionTextPrefix adaptionTextIds)
year_adaption_text
) ", ")
(join-present (list
(render-contribution-group translationAuthorPrefix translatorIds)
year_translation
) ", ")
) "; ")
))
(if (and
(null? composerIds)
(null? compositionIds)
(null? adaptionMusicIds)
(null? verseComposerData)
(null? voiceComposerData)
(null? bridgeIds)
(null? interludeIds)) #f
(string-append
composerPrefix
" "
(join-present (list
(join-present (list
(render-contribution-group "" composerIds)
year_melody
) ", ")
(render-partial-contribution-group 'versePrefix verseComposerData)
(render-partial-contribution-group 'voicePrefix voiceComposerData)
(join-present (list
(render-contribution-group compositionPrefix compositionIds)
year_composition
) ", ")
(join-present (list
(render-contribution-group adaptionMusicPrefix adaptionMusicIds)
year_adaption_music
) ", ")
(render-contribution-group bridgePrefix bridgeIds)
(render-contribution-group interludePrefix interludeIds)
) "; ")
)))))
songinfoMarkup = songinfoMarkup =
#(make-on-the-fly-markup #(make-on-the-fly-markup
(lambda (layout props m) (lambda (layout props m)
@@ -45,13 +145,15 @@
(year_melody (chain-assoc-get 'songinfo:year_melody props #f)) (year_melody (chain-assoc-get 'songinfo:year_melody props #f))
(poet-with-year (if (and poet-maybe-with-composer year_text) (string-append poet-maybe-with-composer ", " year_text) poet-maybe-with-composer)) (poet-with-year (if (and poet-maybe-with-composer year_text) (string-append poet-maybe-with-composer ", " year_text) poet-maybe-with-composer))
(composer-with-year (if (and composer year_melody) (string-append composer ", " year_melody) composer)) (composer-with-year (if (and composer year_melody) (string-append composer ", " year_melody) composer))
(concat-markupped-strings (lambda (text)
(ly:regex-replace (ly:make-regex "(\\S+)(\\\\\\w+(?:\\s+\\[^\\{\\s]*|\\s*\\{[^\\}]*\\}))(\\S*)") text "\\concat {" 1 "\\line {" 2 "}" 3 "}")))
(string-with-paragraphs->markuplist (lambda (prefix text) (string-with-paragraphs->markuplist (lambda (prefix text)
(if text (if text
(apply append (apply append
(map (map
(lambda (paragraph) (lambda (paragraph)
(make-wordwrap-internal-markup-list #t (make-wordwrap-internal-markup-list #t
#{ \markuplist { $(ly:parser-include-string paragraph) } #})) #{ \markuplist { $(ly:parser-include-string (concat-markupped-strings paragraph)) } #}))
(ly:regex-split (ly:make-regex "\r?\n[ \t\r\n]*\n[ \t\r\n]*") (string-append prefix text)))) (ly:regex-split (ly:make-regex "\r?\n[ \t\r\n]*\n[ \t\r\n]*") (string-append prefix text))))
'()))) '())))
(poet-and-composer-markup-list (poet-and-composer-markup-list
@@ -75,4 +177,4 @@
))))) )))))
(make-null-markup) (make-null-markup)
) )
} }

View File

@@ -16,9 +16,10 @@ songTocColumns = 3
globalSize = 15 globalSize = 15
lyricSize = 1.6 lyricSize = 1.6
stanzaFormat = "~a." stanzaFormat = "~a."
romanStanzaFormat = "~@r."
refString = "Ref.:" refString = "Ref.:"
refStringWithNumbers = "Ref. ~a:" refStringWithNumbers = "Ref. ~a:"
bridgeString = "Bridge:"
bridgeStringWithNumbers = "Bridge ~a:"
% hübsche Wiederholungszeichen für den Liedtext % hübsche Wiederholungszeichen für den Liedtext
repStart = "𝄆" repStart = "𝄆"
repStop = "𝄇" repStop = "𝄇"

View File

@@ -30,6 +30,9 @@
(lambda (a b) (< (cadr a) (cadr b)))) (lambda (a b) (< (cadr a) (cadr b))))
(list))) (list)))
#(define (join-present items joiner)
(string-join (filter (lambda (item) (and (string? item) (not (string-null? (string-trim-both item))))) items) joiner))
#(define-markup-command (print-songinfo layout props) () #(define-markup-command (print-songinfo layout props) ()
(define (songinfo-from songId key) (define (songinfo-from songId key)
(let ((song (if (defined? 'SONG_DATA) (assoc-ref SONG_DATA songId) #f))) (let ((song (if (defined? 'SONG_DATA) (assoc-ref SONG_DATA songId) #f)))
@@ -74,11 +77,7 @@
(define (render-contribution-group contributionPrefix authorIds) (define (render-contribution-group contributionPrefix authorIds)
(if (null? authorIds) (if (null? authorIds)
"" ""
(string-append contributionPrefix " " (string-join (format-authors authorIds) ", "))) (string-append contributionPrefix " " ((ly:output-def-lookup layout 'author-joiner) (format-authors authorIds))))
)
(define (join-present items joiner)
(string-join (filter (lambda (item) (and (string? item) (not (string-null? (string-trim-both item))))) items) joiner)
) )
(define (render-partial-contribution-group prefixLookup authorData) (define (render-partial-contribution-group prefixLookup authorData)
@@ -94,93 +93,37 @@
(define (poet-and-composer-from-authors authors) (define (poet-and-composer-from-authors authors)
(if authors (if authors
(let ( ((ly:output-def-lookup layout 'authorContributionFormat)
(poetIds (find-author-ids-by 'text authors)) render-contribution-group
(translatorIds (find-author-ids-by 'translation authors)) render-partial-contribution-group
(versePoetData (find-author-id-with-part-numbers 'verse authors)) #:poetIds (find-author-ids-by 'text authors)
(composerIds (find-author-ids-by 'melody authors)) #:translatorIds (find-author-ids-by 'translation authors)
(verseComposerData (find-author-id-with-part-numbers 'meloverse authors)) #:versePoetData (find-author-id-with-part-numbers 'verse authors)
(voiceComposerData (find-author-id-with-part-numbers 'voice authors)) #:composerIds (find-author-ids-by 'melody authors)
(compositionIds (find-author-ids-by 'composition authors)) #:verseComposerData (find-author-id-with-part-numbers 'meloverse authors)
(adaptionTextIds (find-author-ids-by 'adaption_text authors)) #:voiceComposerData (find-author-id-with-part-numbers 'voice authors)
(adaptionMusicIds (find-author-ids-by 'adaption_music authors)) #:compositionIds (find-author-ids-by 'composition authors)
(bridgeIds (find-author-ids-by 'bridge authors)) #:adaptionTextIds (find-author-ids-by 'adaption_text authors)
(interludeIds (find-author-ids-by 'interlude authors)) #:adaptionMusicIds (find-author-ids-by 'adaption_music authors)
(year_text (chain-assoc-get 'header:year_text props #f)) #:bridgeIds (find-author-ids-by 'bridge authors)
(year_translation (chain-assoc-get 'header:year_translation props #f)) #:interludeIds (find-author-ids-by 'interlude authors)
(year_melody (chain-assoc-get 'header:year_melody props #f)) #:year_text (chain-assoc-get 'header:year_text props #f)
(year_composition (chain-assoc-get 'header:year_composition props #f)) #:year_translation (chain-assoc-get 'header:year_translation props #f)
(year_adaption_text (chain-assoc-get 'header:year_adaption_text props #f)) #:year_melody (chain-assoc-get 'header:year_melody props #f)
(year_adaption_music (chain-assoc-get 'header:year_adaption_music props #f)) #:year_composition (chain-assoc-get 'header:year_composition props #f)
) #:year_adaption_text (chain-assoc-get 'header:year_adaption_text props #f)
(if (and #:year_adaption_music (chain-assoc-get 'header:year_adaption_music props #f)
(equal? poetIds composerIds) #:poetAndComposerEqualPrefix (ly:output-def-lookup layout 'poetAndComposerEqualPrefix)
(null? translatorIds) #:poetPrefix (ly:output-def-lookup layout 'poetPrefix)
(null? versePoetData) #:composerPrefix (ly:output-def-lookup layout 'composerPrefix)
(null? verseComposerData) #:translationAuthorPrefix (ly:output-def-lookup layout 'translationAuthorPrefix)
(null? voiceComposerData) #:pronunciationPrefix (ly:output-def-lookup layout 'pronunciationPrefix)
(null? compositionIds) #:compositionPrefix (ly:output-def-lookup layout 'compositionPrefix)
(null? adaptionTextIds) #:adaptionTextPrefix (ly:output-def-lookup layout 'adaptionTextPrefix)
(null? adaptionMusicIds) #:adaptionMusicPrefix (ly:output-def-lookup layout 'adaptionMusicPrefix)
(null? bridgeIds) #:bridgePrefix (ly:output-def-lookup layout 'bridgePrefix)
(null? interludeIds)) #:interludePrefix (ly:output-def-lookup layout 'interludePrefix)
(list )
(join-present (list
(render-contribution-group (ly:output-def-lookup layout 'poetAndComposerEqualPrefix) poetIds)
(if (equal? year_text year_melody) year_text (join-present (list year_text year_melody) "/"))
) ", ")
#f)
(list
(if (and (null? poetIds) (null? versePoetData) (null? translatorIds)) #f
(string-append
(ly:output-def-lookup layout 'poetPrefix)
" "
(join-present (list
(join-present (list
(render-contribution-group "" poetIds)
year_text
) ", ")
(render-partial-contribution-group 'versePrefix versePoetData)
(join-present (list
(render-contribution-group (ly:output-def-lookup layout 'translationAuthorPrefix) translatorIds)
year_translation
) ", ")
(join-present (list
(render-contribution-group (ly:output-def-lookup layout 'adaptionTextPrefix) adaptionTextIds)
year_adaption_text
) ", ")
) "; ")
))
(if (and
(null? composerIds)
(null? compositionIds)
(null? adaptionMusicIds)
(null? verseComposerData)
(null? voiceComposerData)
(null? bridgeIds)
(null? interludeIds)) #f
(string-append
(ly:output-def-lookup layout 'composerPrefix)
" "
(join-present (list
(join-present (list
(render-contribution-group "" composerIds)
year_melody
) ", ")
(render-partial-contribution-group 'versePrefix verseComposerData)
(render-partial-contribution-group 'voicePrefix voiceComposerData)
(join-present (list
(render-contribution-group (ly:output-def-lookup layout 'compositionPrefix) compositionIds)
year_composition
) ", ")
(join-present (list
(render-contribution-group (ly:output-def-lookup layout 'adaptionMusicPrefix) adaptionMusicIds)
year_adaption_music
) ", ")
(render-contribution-group (ly:output-def-lookup layout 'bridgePrefix) bridgeIds)
(render-contribution-group (ly:output-def-lookup layout 'interludePrefix) interludeIds)
) "; ")
)))))
(list #f #f) (list #f #f)
) )
) )
@@ -270,4 +213,4 @@
\line { \page-number-to-pdf-label \null } \line { \page-number-to-pdf-label \null }
} }
} }
} }

View File

@@ -0,0 +1,13 @@
% We have to record the tag groups for markup, so we use the right tag groups during markup interpretiton.
recordedTagGroups = #'()
tagGroup =
#(define-void-function (tags) (symbol-list?)
(let ((err (define-tag-group tags)))
(if err (ly:parser-error err (*location*))
(set! recordedTagGroups (cons tags recordedTagGroups)))))
#(define-markup-command (handle-tag-groups layout props recorded-groups m) (list? markup?)
(resetTagGroups)
(every (lambda (group) (define-tag-group group)) recorded-groups)
(interpret-markup layout props m))

View File

@@ -1,4 +1,4 @@
swing = \mark \markup { swing = \textMark \markup {
\line \general-align #Y #DOWN { \line \general-align #Y #DOWN {
\score { \score {
\new Staff \with { \new Staff \with {
@@ -47,7 +47,7 @@ swing = \mark \markup {
} }
} }
swingOff = \mark \markup { swingOff = \textMark \markup {
\line \general-align #Y #DOWN { \line \general-align #Y #DOWN {
\score { \score {
\new Staff \with { \new Staff \with {
@@ -99,7 +99,7 @@ swingOff = \mark \markup {
\include "swing.ly" \include "swing.ly"
swingMusic = swingMusic =
#(define-music-function (parser location music) (ly:music?) #(define-music-function (music) (ly:music?)
(define (partial-duration-length m) (define (partial-duration-length m)
(let ((name (ly:music-property m 'name)) (let ((name (ly:music-property m 'name))
(es (ly:music-property m 'elements)) (es (ly:music-property m 'elements))
@@ -118,4 +118,4 @@ swingMusic =
#{ #{
\swing \swing
\applySwingWithOffset 8 #'(2 1) #(partial-duration-length music) #music \applySwingWithOffset 8 #'(2 1) #(partial-duration-length music) #music
#}) #})

View File

@@ -1,6 +1,5 @@
#(define-markup-command (bookTitleMarkupCustom layout props)() #(define-markup-command (bookTitleMarkupCustom layout props)()
(interpret-markup layout (interpret-markup layout props
(prepend-alist-chain 'songfilename (chain-assoc-get 'header:songfilename props "") props)
(make-column-markup (make-column-markup
(list (list
(make-vspace-markup (chain-assoc-get 'header:titletopspace props 0)) (make-vspace-markup (chain-assoc-get 'header:titletopspace props 0))
@@ -38,23 +37,24 @@
;'(0 . 0) '(0 . 0) ;'(0 . 0) '(0 . 0)
))) )))
#(define-markup-command (title-with-category-images layout props right)(boolean?) #(define-markup-command (build-full-title layout props right)(boolean?)
(interpret-markup layout props (interpret-markup layout (prepend-alist-chain 'songfilename (chain-assoc-get 'header:songfilename props "") props)
(let* ((title (chain-assoc-get 'header:title props "")) (let* ((title (chain-assoc-get 'header:title props ""))
(starttext (chain-assoc-get 'header:starttext props #f)) (starttext (chain-assoc-get 'header:starttext props #f))
(pdfbookmark (if starttext (string-append starttext " | " title) title))) (pdfbookmark (if starttext (string-append starttext " | " title) title))
(title-markup (ly:output-def-lookup layout (if right 'oddTitleLineMarkup 'evenTitleLineMarkup))))
(if title (if title
(if right (markup #:title-to-pdf-toc pdfbookmark title-markup)
#{\markup { \title-to-pdf-toc #pdfbookmark \fill-line \general-align #Y #UP { \null \bookTitleMarkupCustom \category-images } } #} make-null-markup)
#{\markup { \title-to-pdf-toc #pdfbookmark \fill-line \general-align #Y #UP { \category-images \bookTitleMarkupCustom \null } } #})
#{ \markup { " " } #})
))) )))
\paper { \paper {
bookTitleMarkup = \markup \null bookTitleMarkup = \markup \null
scoreTitleMarkup = \markup \null scoreTitleMarkup = \markup \null
oddHeaderMarkup = \markup { \if \on-first-page-of-part \title-with-category-images ##t } oddHeaderMarkup = \markup { \if \on-first-page-of-part \build-full-title ##t }
evenHeaderMarkup = \markup { \if \on-first-page-of-part \title-with-category-images ##f } evenHeaderMarkup = \markup { \if \on-first-page-of-part \build-full-title ##f }
oddTitleLineMarkup = \markup { \fill-line \general-align #Y #UP { \null \bookTitleMarkupCustom \category-images } }
evenTitleLineMarkup = \markup { \fill-line \general-align #Y #UP { \category-images \bookTitleMarkupCustom \null } }
defaultTitleMarkup = \markup { defaultTitleMarkup = \markup {
\override #'(baseline-skip . 3.5) \override #'(baseline-skip . 3.5)
\center-column { \center-column {
@@ -63,4 +63,4 @@
\smaller \bold \fromproperty #'header:subsubtitle \smaller \bold \fromproperty #'header:subsubtitle
} }
} }
} }

View File

@@ -60,19 +60,20 @@
% Text über Text mittig darstellen % Text über Text mittig darstellen
#(define-markup-command (textup layout props text uptext) (markup? markup?) #(define-markup-command (textup layout props text uptext) (markup? markup?)
#:properties ((verselayout generalLayout)
(verse-text-chord-distance songTextChordDistance))
"Markup über Text mittig darstellen." "Markup über Text mittig darstellen."
(let ((verselayout (chain-assoc-get 'verselayout props generalLayout)))
(interpret-markup layout props (interpret-markup layout props
#{\markup { #{\markup {
\size-box-to-box-style-dependent ##t ##f \size-box-to-box-style-dependent ##t ##f
\general-align #X #LEFT \override #`(direction . ,UP) \override #'(baseline-skip . 1.0) \dir-column \chord-alignment-style-dependent { \general-align #X #LEFT \override #`(direction . ,UP) \override #'(baseline-skip . 1) \dir-column \chord-alignment-style-dependent {
\pad-to-box #'(0 . 0) #'(0 . 2.0) { #text } \pad-to-box #'(0 . 0) #`(0 . ,(- verse-text-chord-distance 0.8)) { #text }
\size-box-to-box ##f ##t #uptext \score { \chords { g4:m a } \layout { \verselayout } } \size-box-to-box ##f ##t #uptext \score { \chords { g4:m a } \layout { $verselayout #(customized-layout verselayout) } }
} }
#text #text
} }
#} #}
))) ))
#(define-markup-command (anchor-x-between layout props arga argb) #(define-markup-command (anchor-x-between layout props arga argb)
(markup? markup?) (markup? markup?)
@@ -82,16 +83,15 @@
(ly:stencil-aligned-to m X (- (/ (* la 2) l) 1)) (ly:stencil-aligned-to m X (- (/ (* la 2) l) 1))
)) ))
#(define-markup-command (stanza-raw layout props arg) #(define-markup-command (stanza-raw layout props arg) (string-or-music?)
(string-or-music?) #:properties ((verselayout generalLayout))
(let ((verselayout (chain-assoc-get 'verselayout props generalLayout)))
(interpret-markup layout props (interpret-markup layout props
(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 } } \score { \new Lyrics { \lyricmode { #(if (ly:music? arg) arg #{ \set stanza = #arg #}) "" } } \layout { $verselayout #(customized-layout verselayout) } }
#} #}
)))) )))
#(define-markup-command (stanza layout props arg) #(define-markup-command (stanza layout props arg)
(string-or-music?) (string-or-music?)
@@ -141,7 +141,7 @@
(make-wrap-newline-markup (make-wrap-newline-markup
(ly:regex-replace (ly:make-regex "\\(( *)([^,()]*)( *),([^)]*)\\)") (ly:regex-replace (ly:make-regex "\\(( *)([^,()]*)( *),([^)]*)\\)")
(ly:regex-replace (ly:make-regex "(([^ \n]*\\([^()]*,[^()]+\\)[^ \n(]*)+)") (handle-custom-newlines custom-verse-breaks verse) " \\concat { " 1 " } ") (ly:regex-replace (ly:make-regex "(([^ \n]*\\([^()]*,[^()]+\\)[^ \n(]*)+)") (handle-custom-newlines custom-verse-breaks verse) " \\concat { " 1 " } ")
"\\textup \\line { \"" 1 "\" " 2 " \"" 3 "\" } \\score { " transp " \\chords { s4 " 4 " } \\layout { \\verselayout } }") "\\textup \\line { \"" 1 "\" " 2 " \"" 3 "\" } \\score { " transp " \\chords { s4 " 4 " } \\layout { $verselayout #(customized-layout verselayout) } }")
) )
)))) ))))
@@ -203,23 +203,9 @@
#(define-markup-command (pad-left layout props amount arg) #(define-markup-command (pad-left layout props amount arg)
(number? markup?) (number? markup?)
(let* ((m (interpret-markup layout props arg))
(x (ly:stencil-extent m X))
(y (ly:stencil-extent m Y)))
(ly:stencil-translate (ly:stencil-translate
(ly:make-stencil (ly:stencil-expr m) (interpret-markup layout props (make-pad-x-left-markup amount arg))
(cons (- (car x) amount) (cdr x)) `(,amount . 0)))
y)
`(,amount . 0))))
#(define-markup-command (pad-right layout props amount arg)
(number? markup?)
(let* ((m (interpret-markup layout props arg))
(x (ly:stencil-extent m X))
(y (ly:stencil-extent m Y)))
(ly:make-stencil (ly:stencil-expr m)
(cons (car x) (+ (cdr x) amount))
y)))
#(define-markup-command (score-equal-height-with-indents layout props lines) #(define-markup-command (score-equal-height-with-indents layout props lines)
(markup-list?) (markup-list?)
@@ -250,115 +236,102 @@
(let ((text (ly:grob-property grob 'text))) (let ((text (ly:grob-property grob 'text)))
(grob-interpret-markup grob (if (string? text) (grob-interpret-markup grob (if (string? text)
(make-pad-right-markup -0.1 (make-tied-lyric-markup text)) (make-pad-x-right-markup -0.1 (make-tied-lyric-markup text))
text)))) text))))
Chord_lyrics_spacing_engraver = Chord_lyrics_spacing_engraver =
#(lambda (ctx) #(lambda (ctx)
(let ((last-note-head #f) (let ((last-lyric-syllable #f)
(note-head-extended #f)
(last-lyric-syllable-width 0)
(lyric-width-since-last-chord 0) (lyric-width-since-last-chord 0)
(notes-on-syllable-count 0) (music-columns-for-last-syllable 0)
(last-chord-name #f) (last-printed-chord #f)
(remaining-chord-width 0) (chord-width-since-last-lyric 0)
(last-rest #f) (lyrics-seen-since-break #f)
(rest-count 0) (have-a-rest #f)
(multi-measure-rest-count 0) (stanza #f)
(stanza-shift 0)) (place-at-right-edge
(lambda (grob anchor padding)
(let ((anchor-width (interval-length (ly:grob-extent anchor anchor X))))
(ly:grob-set-parent! grob X anchor)
(ly:grob-set-property! grob 'X-offset (+ padding anchor-width))
))))
(make-engraver (make-engraver
(listeners (listeners
((multi-measure-rest-event engraver event) ((multi-measure-rest-event engraver event)
(set! multi-measure-rest-count (+ multi-measure-rest-count 1)) (set! have-a-rest #t)
)
((rest-event engraver event)
(set! have-a-rest #t)
)
((lyric-event engraver event)
(set! have-a-rest #f)
(set! music-columns-for-last-syllable 0)
) )
((break-event engraver event) ((break-event engraver event)
(set! last-note-head #f) (set! last-lyric-syllable #f)
(set! note-head-extended #f)
(set! last-lyric-syllable-width 0)
(set! lyric-width-since-last-chord 0) (set! lyric-width-since-last-chord 0)
(set! notes-on-syllable-count 0) (set! music-columns-for-last-syllable 0)
(set! last-chord-name #f) (set! last-printed-chord #f)
(set! remaining-chord-width 0) (set! chord-width-since-last-lyric 0)
(set! last-rest #f) (set! lyrics-seen-since-break #f)
(set! rest-count 0)
(set! multi-measure-rest-count 0)
(set! stanza-shift 0)
)) ))
(acknowledgers (acknowledgers
((note-head-interface this-engraver grob source-engraver) ((musical-paper-column-interface this-engraver grob source-engraver)
(if (and (> rest-count 0) (not last-note-head)) (set! music-columns-for-last-syllable (+ 1 music-columns-for-last-syllable))
(let ((rest-spacing-on-line-start 1.2))
(ly:grob-set-property! grob 'minimum-X-extent (cons (- rest-spacing-on-line-start) 0))
(set! stanza-shift rest-spacing-on-line-start)
))
(set! notes-on-syllable-count (+ 1 notes-on-syllable-count))
(set! last-note-head grob)
(set! note-head-extended #f)
(set! last-rest #f)
(set! rest-count 0)
(set! multi-measure-rest-count 0)
) )
((lyric-syllable-interface this-engraver grob source-engraver) ((lyric-syllable-interface this-engraver grob source-engraver)
(set! remaining-chord-width (max 0 (- remaining-chord-width lyric-width-since-last-chord))) (let ((syllable-width (interval-length (ly:grob-extent grob grob X))))
(set! last-lyric-syllable-width (- (cdr (ly:grob-extent grob grob X)) 0.2)) (set! lyric-width-since-last-chord (+ lyric-width-since-last-chord syllable-width))
(set! lyric-width-since-last-chord (+ lyric-width-since-last-chord last-lyric-syllable-width)) )
(if last-note-head (set! notes-on-syllable-count 1)) (if (> chord-width-since-last-lyric 0)
(if lyrics-seen-since-break
(ly:grob-set-property! grob 'extra-spacing-width
(cons (- chord-width-since-last-lyric) (cdr (ly:grob-property grob 'extra-spacing-width '(0 . 0)))))
(if last-printed-chord
(let ((gap-for-starting-rest 2.0))
(if stanza (ly:grob-set-property! stanza 'padding (+ 1 gap-for-starting-rest)))
(ly:grob-set-parent! grob X last-printed-chord)
(ly:grob-set-property! grob 'X-offset gap-for-starting-rest)
)))
)
(set! last-lyric-syllable grob)
(set! chord-width-since-last-lyric 0)
(set! lyrics-seen-since-break #t)
) )
((chord-name-interface this-engraver grob source-engraver) ((chord-name-interface this-engraver grob source-engraver)
(if (not (and (if (not (and
(boolean? (ly:grob-property grob 'begin-of-line-visible)) (boolean? (ly:grob-property grob 'begin-of-line-visible))
(ly:grob-property grob 'begin-of-line-visible))) (ly:grob-property grob 'begin-of-line-visible)
(let ((on-a-rest (> rest-count 0))) lyrics-seen-since-break))
(if (not on-a-rest) (let* ((last-printed-chord-width (if last-printed-chord (interval-length (ly:grob-extent last-printed-chord last-printed-chord X)) 0))
(set! notes-on-syllable-count (- notes-on-syllable-count 1))) (chord-overwidth (- last-printed-chord-width lyric-width-since-last-chord))
(if (and last-chord-name (= multi-measure-rest-count 1) (> lyric-width-since-last-chord remaining-chord-width)) (chord-gap 0.5))
(ly:grob-set-property! last-chord-name 'extra-spacing-width (cons -0.1 (+ 0.1 (- lyric-width-since-last-chord remaining-chord-width))))) (if have-a-rest
(if last-note-head (let ((chord-width (interval-length (ly:grob-extent grob grob X))))
(let* ((last-note-min-x-extent (ly:grob-property last-note-head 'minimum-X-extent)) (if last-lyric-syllable
(last-note-min-x-lower (if (pair? last-note-min-x-extent) (car last-note-min-x-extent) 0)) (if (and last-printed-chord (> chord-overwidth 0))
(last-note-min-x-upper (if (pair? last-note-min-x-extent) (cdr last-note-min-x-extent) 0))) (place-at-right-edge grob last-printed-chord chord-gap)
(if on-a-rest (place-at-right-edge grob last-lyric-syllable 0))
(begin (if last-printed-chord
(if (not note-head-extended) (place-at-right-edge grob last-printed-chord chord-gap)))
(begin (set! chord-width-since-last-lyric (+ chord-width-since-last-lyric chord-width chord-gap))
(ly:grob-set-property! last-note-head 'minimum-X-extent ))
(cons last-note-min-x-lower (- last-lyric-syllable-width -2 (* 2.2 rest-count)))) (if (and last-lyric-syllable last-printed-chord (> chord-overwidth 0))
(set! note-head-extended #t) (ly:grob-set-property! last-lyric-syllable 'extra-spacing-width
)) (cons (car (ly:grob-property last-lyric-syllable 'extra-spacing-width '(0 . 0))) (+ chord-gap chord-overwidth)))
(ly:grob-set-property! last-rest 'minimum-X-extent (cons 0 2)) )
) (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))))
(if (and (> lyric-width-since-last-chord 0) (set! last-printed-chord grob)
(> remaining-chord-width lyric-width-since-last-chord)) (set! last-lyric-syllable #f)
(ly:grob-set-property! last-note-head 'minimum-X-extent )
(cons (- -1.2 (- remaining-chord-width lyric-width-since-last-chord)) last-note-min-x-upper)) (ly:grob-set-property! grob 'X-extent '(+inf.0 . -inf.0))
(let* ((width-per-note-head 0.5) )
(note-width-since-last-chord (* width-per-note-head notes-on-syllable-count)))
(if (> remaining-chord-width note-width-since-last-chord)
(ly:grob-set-property! last-note-head 'minimum-X-extent
(cons (- note-width-since-last-chord remaining-chord-width) last-note-min-x-upper))
)
)
)
)))
(set! last-chord-name grob)
(set! remaining-chord-width
(if (and on-a-rest (equal? (ly:prob-property (ly:grob-property grob 'cause) 'duration) (ly:prob-property (ly:grob-property last-rest 'cause) 'duration)))
0
(cdr (ly:grob-extent grob grob X))))
(set! lyric-width-since-last-chord 0)
(set! notes-on-syllable-count (if on-a-rest 0 1))
))
) )
((rest-interface this-engraver grob source-engraver) ((stanza-number-interface this-engraver grob source-engraver)
(set! rest-count (+ 1 rest-count)) (set! stanza grob)
(set! last-rest grob) )
(set! multi-measure-rest-count 0) )
) )))
((stanza-number-interface this-engraver grob source-engraver)
(ly:grob-set-property! grob 'padding (+ 1 stanza-shift)))
))))
%#(ly:set-option 'debug-skylines #t)
#(define-markup-command (chordlyrics layout props lyrics) (ly:music?) #(define-markup-command (chordlyrics layout props lyrics) (ly:music?)
#:properties ((verse-chords #{#}) #:properties ((verse-chords #{#})
@@ -379,10 +352,8 @@ Chord_lyrics_spacing_engraver =
\new Lyrics \lyricsto "dummyvoice" { #lyrics } \new Lyrics \lyricsto "dummyvoice" { #lyrics }
>> >>
\layout { \layout {
\verselayout $verselayout
#(let #(customized-layout verselayout)
((custom-size (ly:output-def-lookup verselayout 'size #f)))
(if custom-size (layout-set-staff-size custom-size)))
ragged-right = ##t ragged-right = ##t
\context { \context {
\Lyrics \Lyrics
@@ -403,17 +374,20 @@ Chord_lyrics_spacing_engraver =
\context { \context {
\Score \Score
\override PaperColumn.keep-inside-line = ##f \override PaperColumn.keep-inside-line = ##f
% \override SpacingSpanner.strict-note-spacing = ##t % \override SpacingSpanner.strict-note-spacing = ##t
\override SpacingSpanner.uniform-stretching = ##t \override SpacingSpanner.uniform-stretching = ##t
\override SpacingSpanner.spacing-increment = 0 \override SpacingSpanner.spacing-increment = 0
%\override SpacingSpanner.packed-spacing = ##t % \override SpacingSpanner.packed-spacing = ##t
\consists \Chord_lyrics_spacing_engraver \consists \Chord_lyrics_spacing_engraver
% ChordPro engraver in Score context to collect all data
\consists \ChordPro_score_collector
\remove Bar_number_engraver \remove Bar_number_engraver
\remove Mark_engraver \remove Mark_engraver
\remove Jump_engraver \remove Jump_engraver
\remove Volta_engraver \remove Volta_engraver
\remove Parenthesis_engraver \remove Parenthesis_engraver
\remove Metronome_mark_engraver \remove Metronome_mark_engraver
\remove Text_mark_engraver
} }
\context { \context {
\Staff \Staff
@@ -437,15 +411,6 @@ Chord_lyrics_spacing_engraver =
\remove Note_heads_engraver \remove Note_heads_engraver
\remove Script_engraver \remove Script_engraver
} }
\context {
\NullVoice
\consists Rest_engraver
\omit Rest
\override Rest.X-extent = #'(0 . 0)
\undo \omit NoteHead
\hide NoteHead
\override NoteHead.X-extent = #'(0 . 0.5)
}
} }
} }
} }

View File

@@ -90,7 +90,7 @@
(for-each (lambda (category) (for-each (lambda (category)
(let* ((catsym (string->symbol category)) (let* ((catsym (string->symbol category))
(catlist (hashq-ref category-index-hash catsym (catlist (hashq-ref category-index-hash catsym
(list (list label 'indexCategoryMarkup `(((rawtext . ,category)))))))) (list (list label 'indexCategoryMarkup `(((combine-with-next . #t) (rawtext . ,category))))))))
(if (assq catsym category-names) (if (assq catsym category-names)
(hashq-set! category-index-hash catsym (hashq-set! category-index-hash catsym
(cons (list label markup-symbol textoptions) catlist)) (cons (list label markup-symbol textoptions) catlist))
@@ -114,7 +114,7 @@
(for-each (lambda (authorID) (for-each (lambda (authorID)
(let* ((authorsym (string->symbol authorID)) (let* ((authorsym (string->symbol authorID))
(authorlist (hashq-ref author-index-hash authorsym (authorlist (hashq-ref author-index-hash authorsym
(list (list label 'indexAuthorMarkup `(((rawtext . ,authorID)))))))) (list (list label 'indexAuthorMarkup `(((combine-with-next . #t) (rawtext . ,authorID))))))))
(hashq-set! author-index-hash authorsym (hashq-set! author-index-hash authorsym
(cons (list label markup-symbol textoptions) authorlist)) (cons (list label markup-symbol textoptions) authorlist))
)) ))
@@ -218,20 +218,29 @@
} }
#(define (prepare-item-markup items layout) #(define (prepare-item-markup items layout)
(map (lambda (index-item) (define (single-item-markup index-item)
(let* ((label (car index-item)) (let* ((label (car index-item))
(index-markup (cadr index-item)) (index-markup (cadr index-item))
(textoptions (caddr index-item)) (textoptions (caddr index-item))
(text (chain-assoc-get 'rawtext textoptions)) (text (chain-assoc-get 'rawtext textoptions))
(alternative (chain-assoc-get 'alternative textoptions)) (alternative (chain-assoc-get 'alternative textoptions))
(songnumber (chain-assoc-get 'songnumber textoptions))) (songnumber (chain-assoc-get 'songnumber textoptions)))
(markup #:override (cons 'index:label label) (markup #:override (cons 'index:label label)
#:override (cons 'index:page (markup #:custom-page-number label -1)) #:override (cons 'index:page (markup #:custom-page-number label -1))
#:override (cons 'index:text text) #:override (cons 'index:text text)
#:override (cons 'index:alternative alternative) #:override (cons 'index:alternative alternative)
#:override (cons 'index:songnumber songnumber) #:override (cons 'index:songnumber songnumber)
(ly:output-def-lookup layout index-markup)))) (ly:output-def-lookup layout index-markup))))
(items))) (if (null? items)
items
(let* ((index-item (car items))
(combine-with-next (chain-assoc-get 'combine-with-next (caddr index-item) #f))
(restitems (cdr items))
(item-markup (single-item-markup index-item)))
(if (and combine-with-next (not (null? restitems)))
(cons (make-column-markup (list item-markup (single-item-markup (car restitems)))) (prepare-item-markup (cdr restitems) layout))
(cons item-markup (prepare-item-markup restitems layout))))
))
#(define-markup-list-command (index-in-columns-with-title layout props index-type title-markup) (symbol? markup?) #(define-markup-list-command (index-in-columns-with-title layout props index-type title-markup) (symbol? markup?)
( _i "Outputs index alphabetical sorted or in categories" ) ( _i "Outputs index alphabetical sorted or in categories" )
@@ -245,7 +254,7 @@
(make-columnlayout-markup-list songTocColumns 2 (make-columnlayout-markup-list songTocColumns 2
(let ((h (- (ly:output-def-lookup layout 'paper-height) 12))) (let ((h (- (ly:output-def-lookup layout 'paper-height) 12)))
(cons (- h (interval-length (ly:stencil-extent title Y))) h)) (cons (- h (interval-length (ly:stencil-extent title Y))) h))
(prepare-item-markup items layout)))))) (prepare-item-markup (items) layout))))))
indexItem = indexItem =
#(define-music-function (parser location sorttext text) (string? markup?) #(define-music-function (parser location sorttext text) (string? markup?)
@@ -255,7 +264,7 @@ indexItem =
indexSection = indexSection =
#(define-music-function (parser location sorttext text) (string? markup?) #(define-music-function (parser location sorttext text) (string? markup?)
"Add a section line to the alphabetical index, using @code{indexSectionMarkup} paper variable markup. This can be used to divide the alphabetical index into different sections, for example one section for each first letter." "Add a section line to the alphabetical index, using @code{indexSectionMarkup} paper variable markup. This can be used to divide the alphabetical index into different sections, for example one section for each first letter."
(add-index-item! 'indexSectionMarkup (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))) (let* ((headervars (hash-map->list cons (struct-ref (ly:book-header bookheader) 0)))
@@ -432,6 +441,6 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
; we use a delayed stencil to have all the page references available ; we use a delayed stencil to have all the page references available
(ly:make-stencil (ly:make-stencil
`(delay-stencil-evaluation `(delay-stencil-evaluation
,(delay (let* ((table (ly:output-def-lookup layout 'label-page-table))) ,(delay (let* ((table (ly:output-def-lookup layout 'label-absolute-page-table)))
(generate-toc-csv (if (list? table) table '())) (generate-toc-csv (if (list? table) table '()))
empty-stencil))))) empty-stencil)))))

View File

@@ -1,8 +1,10 @@
% set the speed of the midi music
#(define midiQuarterNoteSpeed (if (defined? 'midiQuarterNoteSpeed) midiQuarterNoteSpeed 90))
MUSIC = { \transposable #TRANSPOSITION \MUSIC } MUSIC = { \transposable #TRANSPOSITION \MUSIC }
LAYOUT = \layout {
\LAYOUT
#(customized-layout LAYOUT)
}
verselayout = \layout { verselayout = \layout {
\LAYOUT \LAYOUT
\context { \context {
@@ -11,18 +13,12 @@ verselayout = \layout {
} }
} }
LAYOUT = \layout {
\LAYOUT
#(let
((custom-size (ly:output-def-lookup LAYOUT 'size #f)))
(if custom-size (layout-set-staff-size custom-size)))
}
TEXT = \markuplist { TEXT = \markuplist {
\override #`(transposition . ,TRANSPOSITION) \override #`(transposition . ,TRANSPOSITION)
\override #`(verselayout . ,verselayout) \override #`(verselayout . ,verselayout)
\override #`(verse-chords . ,#{ \chords { \verseChords } #}) \override #`(verse-chords . ,#{ \chords { \verseChords } #})
\override #`(verse-reference-voice . ,#{ \global \firstVoice #}) \override #`(verse-reference-voice . ,#{ \global \firstVoice #})
\handle-tag-groups \recordedTagGroups
\TEXT \TEXT
} }
@@ -34,6 +30,7 @@ TEXT = \markuplist {
\override #`(verselayout . ,verselayout) \override #`(verselayout . ,verselayout)
\override #`(verse-chords . ,#{ \chords { \verseChords } #}) \override #`(verse-chords . ,#{ \chords { \verseChords } #})
\override #`(verse-reference-voice . ,#{ \global \firstVoice #}) \override #`(verse-reference-voice . ,#{ \global \firstVoice #})
\handle-tag-groups \recordedTagGroups
#text #text
} }
#}) #})
@@ -44,6 +41,20 @@ TEXT = \markuplist {
TEXT_PAGES TEXT_PAGES
(list TEXT)))) (list TEXT))))
%% Add invisible ChordPro write trigger to last TEXT_PAGES markuplist
#(when (and (defined? 'chordpro-export-enabled) chordpro-export-enabled (pair? TEXT_PAGES))
(let* ((last-index (- (length TEXT_PAGES) 1))
(last-page (list-ref TEXT_PAGES last-index))
(modified-last-page #{
\markuplist {
#last-page
\chordpro-delayed-write
}
#}))
(set! TEXT_PAGES
(append (list-head TEXT_PAGES last-index)
(list modified-last-page)))))
#(define (add-text-pages text-pages) #(define (add-text-pages text-pages)
(if (pair? text-pages) (if (pair? text-pages)
(begin (begin
@@ -60,21 +71,38 @@ TEXT = \markuplist {
(if header (set! $defaultheader header)) (if header (set! $defaultheader header))
(if paper (set! $defaultpaper paper)) (if paper (set! $defaultpaper paper))
) )
;; ChordPro export: Store filename and extract metadata from basicSongInfo FIRST
(when (and (defined? 'chordpro-export-enabled) chordpro-export-enabled)
;; Use ly:parser-output-name which returns the output basename
;; This will write relative to current working directory (same as PDF)
(let ((output-name (ly:parser-output-name)))
(set! chordpro-current-filename output-name))
;; Try to extract metadata from basicSongInfo \header block
(when (defined? 'basicSongInfo)
(let* ((header-alist (ly:module->alist basicSongInfo))
(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)))))
(add-score #{ (add-score #{
\score { \score {
\MUSIC \MUSIC
\layout { \LAYOUT } \layout { \LAYOUT }
}#}) }#})
(add-text-pages TEXT_PAGES) (add-text-pages TEXT_PAGES)
(add-score #{ (add-score #{
\score { \score {
\unfoldRepeats { \MUSIC \INLINESCOREMUSIC } \unfoldRepeats { \MUSIC \INLINESCOREMUSIC }
\midi { \midi {
\context {
\Score
% Tempo des midi files
tempoWholesPerMinute = #(/ midiQuarterNoteSpeed 4)
}
\context { \context {
\Staff \Staff
\remove "Staff_performer" \remove "Staff_performer"
@@ -85,4 +113,4 @@ TEXT = \markuplist {
} }
} }
}#}) }#})
)) ))

View File

@@ -4,4 +4,4 @@ HEADER = \bookpart {
\basicSongInfo \basicSongInfo
} }
} }
\include #(if noDefaultOutput "../private_includes/void.ily" "layout_bottom.ily") \include #(if noDefaultOutput "../private_includes/void.ily" "layout_bottom.ily")