1 Commits

Author SHA1 Message Date
tux 603b25831a Chordpro export 2026-04-07 08:31:02 +02:00
8 changed files with 60 additions and 55 deletions
-1
View File
@@ -40,7 +40,6 @@
\include "chord_settings.ily" \include "chord_settings.ily"
\include "chordpro.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"
+54 -11
View File
@@ -115,7 +115,7 @@
((char=? first-char #\h) ((char=? first-char #\h)
(unless (member chord-str chordpro-h-chords-used) (unless (member chord-str chordpro-h-chords-used)
(set! chordpro-h-chords-used (cons 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) ;; B/b chords (German B = English Bb)
((char=? first-char #\B) ((char=? first-char #\B)
(unless (member chord-str chordpro-b-chords-used) (unless (member chord-str chordpro-b-chords-used)
@@ -123,17 +123,17 @@
((char=? first-char #\b) ((char=? first-char #\b)
(unless (member chord-str chordpro-b-chords-used) (unless (member chord-str chordpro-b-chords-used)
(set! chordpro-b-chords-used (cons chord-str chordpro-b-chords-used)))) (set! chordpro-b-chords-used (cons chord-str chordpro-b-chords-used))))
;; Chords with accidentals (is/es) ;; Chords with accidentals (is/es)
(has-accidental (has-accidental
(unless (member chord-str chordpro-accidental-chords-used) (unless (member chord-str chordpro-accidental-chords-used)
(set! chordpro-accidental-chords-used (cons 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) ;; Other lowercase chords (minor without B/H/accidentals)
((char-lower-case? first-char) ((char-lower-case? first-char)
(unless (member chord-str chordpro-minor-chords-used) (unless (member chord-str chordpro-minor-chords-used)
(set! chordpro-minor-chords-used (cons chord-str chordpro-minor-chords-used))))) (set! chordpro-minor-chords-used (cons chord-str chordpro-minor-chords-used)))))
;; Always return original ;; Always return original
chord-str))) chord-str)))
@@ -218,7 +218,7 @@
#(define chordpro-accidental-chords-used '()) #(define chordpro-accidental-chords-used '())
%% Configuration and metadata (set by layout_bottom.ily or song file) %% Configuration and metadata (set by layout_bottom.ily or song file)
#(define chordpro-export-enabled #f) #(define chordpro-export-enabled #t)
#(define chordpro-current-filename "output") #(define chordpro-current-filename "output")
#(define chordpro-header-title "Untitled") #(define chordpro-header-title "Untitled")
#(define chordpro-header-authors #f) #(define chordpro-header-authors #f)
@@ -486,7 +486,50 @@
(cons (list (car pending-syllable) (cadr pending-syllable) #f (caddr pending-syllable)) (cons (list (car pending-syllable) (cadr pending-syllable) #f (caddr pending-syllable))
chordpro-syllables-collected)) chordpro-syllables-collected))
(set! pending-syllable #f)) (set! pending-syllable #f))
)))))
;; Write debug output (overwrite each time, final version will be complete)
(with-output-to-file "/tmp/chordpro_debug.txt"
(lambda ()
(display (format #f "ChordPro: Collected ~a syllables, ~a chords (unfiltered), ~a breaks, ~a verses\n"
(length chordpro-syllables-collected)
(length chordpro-chords-collected)
(length chordpro-breaks-collected)
chordpro-current-verse-index))
(display "All syllables:\n")
(for-each
(lambda (syl)
(display (format #f " V~a: '~a' hyphen=~a at ~a\n"
(cadddr syl) (cadr syl) (if (caddr syl) "YES" "NO") (car syl))))
(reverse chordpro-syllables-collected))
(newline)
(display "Breaks:\n")
(for-each
(lambda (brk)
(display (format #f " V~a at ~a\n" (cdr brk) (car brk))))
(reverse chordpro-breaks-collected))
(newline)
(display "All chords (after visibility filtering):\n")
(for-each
(lambda (chord)
(display (format #f " V~a: ~a at ~a\n"
(caddr chord) (cadr chord) (car chord))))
(reverse chordpro-chords-collected))
(newline)
(display "Stanza numbers:\n")
(for-each
(lambda (stanza-entry)
(display (format #f " V~a: '~a' (type: ~a, real: ~a)\n"
(car stanza-entry) (cadr stanza-entry) (caddr stanza-entry) (cadddr stanza-entry))))
(reverse chordpro-stanza-numbers))
(newline)
(display "Inline texts (repStart/repStop etc.):\n")
(for-each
(lambda (inline-entry)
(display (format #f " V~a: '~a' at ~a (dir: ~a)\n"
(cadr inline-entry) (caddr inline-entry) (car inline-entry) (cadddr inline-entry))))
(reverse chordpro-inline-texts-collected)))))
))))
%% Helper functions to format and write ChordPro %% Helper functions to format and write ChordPro
#(define (chordpro-write-from-engraver-data num-verses) #(define (chordpro-write-from-engraver-data num-verses)
@@ -510,7 +553,7 @@
(when (and (defined? 'chordpro-header-authors) chordpro-header-authors) (when (and (defined? 'chordpro-header-authors) chordpro-header-authors)
(display (format #f "{artist: ~a}\n" (display (format #f "{artist: ~a}\n"
(format-chordpro-authors chordpro-header-authors)))) (format-chordpro-authors chordpro-header-authors))))
;; Write {define:} directives for all used minor chords ;; Write {define:} directives for all used minor chords
(unless (null? chordpro-minor-chords-used) (unless (null? chordpro-minor-chords-used)
(newline) (newline)
@@ -520,7 +563,7 @@
(let ((major-form (german-minor-to-major-form minor-chord))) (let ((major-form (german-minor-to-major-form minor-chord)))
(display (format #f "{define: ~a copy ~a}\n" minor-chord major-form)))) (display (format #f "{define: ~a copy ~a}\n" minor-chord major-form))))
(reverse chordpro-minor-chords-used))) (reverse chordpro-minor-chords-used)))
;; Write {define:} directives for all used B chords (German B = English Bb) ;; Write {define:} directives for all used B chords (German B = English Bb)
(unless (null? chordpro-b-chords-used) (unless (null? chordpro-b-chords-used)
(for-each (for-each
@@ -529,7 +572,7 @@
(let ((bb-form (german-b-to-bb-form b-chord))) (let ((bb-form (german-b-to-bb-form b-chord)))
(display (format #f "{define: ~a copy ~a}\n" b-chord bb-form)))) (display (format #f "{define: ~a copy ~a}\n" b-chord bb-form))))
(reverse chordpro-b-chords-used))) (reverse chordpro-b-chords-used)))
;; Write {define:} directives for all used H chords (German H = English B) ;; Write {define:} directives for all used H chords (German H = English B)
(unless (null? chordpro-h-chords-used) (unless (null? chordpro-h-chords-used)
(for-each (for-each
@@ -538,7 +581,7 @@
(let ((b-form (german-h-to-b-form h-chord))) (let ((b-form (german-h-to-b-form h-chord)))
(display (format #f "{define: ~a copy ~a}\n" h-chord b-form)))) (display (format #f "{define: ~a copy ~a}\n" h-chord b-form))))
(reverse chordpro-h-chords-used))) (reverse chordpro-h-chords-used)))
;; Write {define:} directives for chords with accidentals (is/es -> #/b) ;; Write {define:} directives for chords with accidentals (is/es -> #/b)
(unless (null? chordpro-accidental-chords-used) (unless (null? chordpro-accidental-chords-used)
(for-each (for-each
@@ -547,7 +590,7 @@
(let ((intl-form (german-accidentals-to-international accidental-chord))) (let ((intl-form (german-accidentals-to-international accidental-chord)))
(display (format #f "{define: ~a copy ~a}\n" accidental-chord intl-form)))) (display (format #f "{define: ~a copy ~a}\n" accidental-chord intl-form))))
(reverse chordpro-accidental-chords-used))) (reverse chordpro-accidental-chords-used)))
(newline) (newline)
;; Write each verse in reverse order (they were collected backwards) ;; Write each verse in reverse order (they were collected backwards)
@@ -7,7 +7,6 @@
poetAndComposerEqualPrefix = "Worte und Weise:" poetAndComposerEqualPrefix = "Worte und Weise:"
voicePrefix = "Stimme:" voicePrefix = "Stimme:"
versePrefix = "Strophe:" versePrefix = "Strophe:"
refPrefix = "Refrain:"
translationAuthorPrefix = "Übersetzung:" translationAuthorPrefix = "Übersetzung:"
translationPrefix = "Übersetzung:" translationPrefix = "Übersetzung:"
pronunciationPrefix = "Aussprache:" pronunciationPrefix = "Aussprache:"
@@ -40,7 +39,6 @@
(versePoetData '()) (versePoetData '())
(composerIds '()) (composerIds '())
(verseComposerData '()) (verseComposerData '())
(refComposerIds '())
(voiceComposerData '()) (voiceComposerData '())
(compositionIds '()) (compositionIds '())
(adaptionTextIds '()) (adaptionTextIds '())
@@ -50,7 +48,6 @@
(year_text #f) (year_text #f)
(year_translation #f) (year_translation #f)
(year_melody #f) (year_melody #f)
(year_melody_meloref #f)
(year_composition #f) (year_composition #f)
(year_adaption_text #f) (year_adaption_text #f)
(year_adaption_music #f) (year_adaption_music #f)
@@ -63,14 +60,12 @@
(adaptionTextPrefix "") (adaptionTextPrefix "")
(adaptionMusicPrefix "") (adaptionMusicPrefix "")
(bridgePrefix "") (bridgePrefix "")
(interludePrefix "") (interludePrefix ""))
(refPrefix ""))
(if (and (if (and
(equal? poetIds composerIds) (equal? poetIds composerIds)
(null? translatorIds) (null? translatorIds)
(null? versePoetData) (null? versePoetData)
(null? verseComposerData) (null? verseComposerData)
(null? refComposerIds)
(null? voiceComposerData) (null? voiceComposerData)
(null? compositionIds) (null? compositionIds)
(null? adaptionTextIds) (null? adaptionTextIds)
@@ -109,7 +104,6 @@
(null? compositionIds) (null? compositionIds)
(null? adaptionMusicIds) (null? adaptionMusicIds)
(null? verseComposerData) (null? verseComposerData)
(null? refComposerIds)
(null? voiceComposerData) (null? voiceComposerData)
(null? bridgeIds) (null? bridgeIds)
(null? interludeIds)) #f (null? interludeIds)) #f
@@ -122,10 +116,6 @@
year_melody year_melody
) ", ") ) ", ")
(render-partial-contribution-group 'versePrefix verseComposerData) (render-partial-contribution-group 'versePrefix verseComposerData)
(join-present (list
(render-contribution-group refPrefix refComposerIds)
year_melody_meloref
) ", ")
(render-partial-contribution-group 'voicePrefix voiceComposerData) (render-partial-contribution-group 'voicePrefix voiceComposerData)
(join-present (list (join-present (list
(render-contribution-group compositionPrefix compositionIds) (render-contribution-group compositionPrefix compositionIds)
@@ -101,7 +101,6 @@
#:versePoetData (find-author-id-with-part-numbers 'verse authors) #:versePoetData (find-author-id-with-part-numbers 'verse authors)
#:composerIds (find-author-ids-by 'melody authors) #:composerIds (find-author-ids-by 'melody authors)
#:verseComposerData (find-author-id-with-part-numbers 'meloverse authors) #:verseComposerData (find-author-id-with-part-numbers 'meloverse authors)
#:refComposerIds (find-author-ids-by 'meloref authors)
#:voiceComposerData (find-author-id-with-part-numbers 'voice authors) #:voiceComposerData (find-author-id-with-part-numbers 'voice authors)
#:compositionIds (find-author-ids-by 'composition authors) #:compositionIds (find-author-ids-by 'composition authors)
#:adaptionTextIds (find-author-ids-by 'adaption_text authors) #:adaptionTextIds (find-author-ids-by 'adaption_text authors)
@@ -111,7 +110,6 @@
#:year_text (chain-assoc-get 'header:year_text props #f) #:year_text (chain-assoc-get 'header:year_text props #f)
#:year_translation (chain-assoc-get 'header:year_translation props #f) #:year_translation (chain-assoc-get 'header:year_translation props #f)
#:year_melody (chain-assoc-get 'header:year_melody props #f) #:year_melody (chain-assoc-get 'header:year_melody props #f)
#:year_melody_meloref (chain-assoc-get 'header:year_melody_meloref props #f)
#:year_composition (chain-assoc-get 'header:year_composition props #f) #:year_composition (chain-assoc-get 'header:year_composition props #f)
#:year_adaption_text (chain-assoc-get 'header:year_adaption_text props #f) #:year_adaption_text (chain-assoc-get 'header:year_adaption_text props #f)
#:year_adaption_music (chain-assoc-get 'header:year_adaption_music props #f) #:year_adaption_music (chain-assoc-get 'header:year_adaption_music props #f)
@@ -125,7 +123,7 @@
#:adaptionMusicPrefix (ly:output-def-lookup layout 'adaptionMusicPrefix) #:adaptionMusicPrefix (ly:output-def-lookup layout 'adaptionMusicPrefix)
#:bridgePrefix (ly:output-def-lookup layout 'bridgePrefix) #:bridgePrefix (ly:output-def-lookup layout 'bridgePrefix)
#:interludePrefix (ly:output-def-lookup layout 'interludePrefix) #:interludePrefix (ly:output-def-lookup layout 'interludePrefix)
#:refPrefix (ly:output-def-lookup layout 'refPrefix)) )
(list #f #f) (list #f #f)
) )
) )
@@ -145,7 +143,7 @@
(translation (chain-assoc-get 'header:translation props #f)) (translation (chain-assoc-get 'header:translation props #f))
(pronunciation (chain-assoc-get 'header:pronunciation props #f)) (pronunciation (chain-assoc-get 'header:pronunciation props #f))
(year_text (if (string? (car poet-and-composers)) #f (chain-assoc-get 'header:year_text props #f))) (year_text (if (string? (car poet-and-composers)) #f (chain-assoc-get 'header:year_text props #f)))
(year_melody (if (string? (cadr poet-and-composers)) #f (chain-assoc-get 'header:year_melody props #f)))) (year_melody (if (string? (car poet-and-composers)) #f (chain-assoc-get 'header:year_melody props #f))))
(markup (markup
#:override (cons 'songinfo:poet-maybe-with-composer #:override (cons 'songinfo:poet-maybe-with-composer
(if (and poet-maybe-with-composer (not (and (string? poet-maybe-with-composer) (string-null? poet-maybe-with-composer)))) poet-maybe-with-composer #f)) (if (and poet-maybe-with-composer (not (and (string? poet-maybe-with-composer) (string-null? poet-maybe-with-composer)))) poet-maybe-with-composer #f))
@@ -1,16 +0,0 @@
% We have to record the tag groups for markup, so we use the right tag groups during markup interpretiton.
recordedTagGroups = #'()
tagGroup =
#(define-void-function (tags) (symbol-list?)
(let ((err (define-tag-group tags)))
(if err (ly:parser-error err (*location*))
(set! recordedTagGroups (cons tags recordedTagGroups)))))
#(define-markup-command (handle-tag-groups layout props recorded-groups m) (list? markup?)
(resetTagGroups)
(for-each
(lambda (group)
(define-tag-group group))
recorded-groups)
(interpret-markup layout props m))
+1 -6
View File
@@ -2,12 +2,7 @@ TRANSPOSITION = #(cons #f #f)
transposeGlobal = transposeGlobal =
#(define-void-function (from to) (ly:pitch? ly:pitch?) #(define-void-function (from to) (ly:pitch? ly:pitch?)
(if (not (car TRANSPOSITION)) (set! TRANSPOSITION (cons from to)))
(set! TRANSPOSITION (cons from to))
(let ((current_to (cdr TRANSPOSITION))
(interval (ly:pitch-diff to from)))
(set! TRANSPOSITION (cons (car TRANSPOSITION)
(ly:pitch-transpose current_to interval))))))
transposable = transposable =
#(define-music-function (fromto music) (pair? ly:music?) #(define-music-function (fromto music) (pair? ly:music?)
+2 -4
View File
@@ -283,14 +283,13 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
(versePoetData (find-author-id-with-part-numbers 'verse authors)) (versePoetData (find-author-id-with-part-numbers 'verse authors))
(composerIds (find-author-ids-by 'melody authors)) (composerIds (find-author-ids-by 'melody authors))
(verseComposerData (find-author-id-with-part-numbers 'meloverse authors)) (verseComposerData (find-author-id-with-part-numbers 'meloverse authors))
(refComposerIds (find-author-ids-by 'meloref authors))
(voiceComposerData (find-author-id-with-part-numbers 'voice authors)) (voiceComposerData (find-author-id-with-part-numbers 'voice authors))
(compositionIds (find-author-ids-by 'composition authors)) (compositionIds (find-author-ids-by 'composition authors))
(adaptionIds (find-author-ids-by 'adaption authors)) (adaptionIds (find-author-ids-by 'adaption authors))
(bridgeIds (find-author-ids-by 'bridge authors)) (bridgeIds (find-author-ids-by 'bridge authors))
(interludeIds (find-author-ids-by 'interlude authors))) (interludeIds (find-author-ids-by 'interlude authors)))
(delete-duplicates (delete-duplicates
(append poetIds translatorIds (map car versePoetData) composerIds (map car verseComposerData) refComposerIds (map car voiceComposerData) compositionIds adaptionIds bridgeIds interludeIds)) (append poetIds translatorIds (map car versePoetData) composerIds (map car verseComposerData) (map car voiceComposerData) compositionIds adaptionIds bridgeIds interludeIds))
)) ))
(let* (let*
( (
@@ -378,7 +377,6 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
(versePoetData (find-author-id-with-part-numbers 'verse authors)) (versePoetData (find-author-id-with-part-numbers 'verse authors))
(composerIds (find-author-ids-by 'melody authors)) (composerIds (find-author-ids-by 'melody authors))
(verseComposerData (find-author-id-with-part-numbers 'meloverse authors)) (verseComposerData (find-author-id-with-part-numbers 'meloverse authors))
(refComposerIds (find-author-ids-by 'meloref authors))
(voiceComposerData (find-author-id-with-part-numbers 'voice authors)) (voiceComposerData (find-author-id-with-part-numbers 'voice authors))
(compositionIds (find-author-ids-by 'composition authors)) (compositionIds (find-author-ids-by 'composition authors))
(adaptionTextIds (find-author-ids-by 'adaption_text authors)) (adaptionTextIds (find-author-ids-by 'adaption_text authors))
@@ -400,7 +398,7 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
(headervar-or-empty 'categories) (headervar-or-empty 'categories)
(format-authors (append poetIds adaptionTextIds (map car versePoetData))) (format-authors (append poetIds adaptionTextIds (map car versePoetData)))
(format-authors translatorIds) (format-authors translatorIds)
(format-authors (append composerIds compositionIds adaptionMusicIds bridgeIds interludeIds (map car voiceComposerData) (map car verseComposerData) refComposerIds)) (format-authors (append composerIds compositionIds adaptionMusicIds bridgeIds interludeIds (map car voiceComposerData) (map car verseComposerData)))
(headervar-or-empty 'year_text) (headervar-or-empty 'year_text)
(headervar-or-empty 'year_melody) (headervar-or-empty 'year_melody)
(headervar-or-empty 'year_translation) (headervar-or-empty 'year_translation)
-2
View File
@@ -18,7 +18,6 @@ TEXT = \markuplist {
\override #`(verselayout . ,verselayout) \override #`(verselayout . ,verselayout)
\override #`(verse-chords . ,#{ \chords { \verseChords } #}) \override #`(verse-chords . ,#{ \chords { \verseChords } #})
\override #`(verse-reference-voice . ,#{ \global \firstVoice #}) \override #`(verse-reference-voice . ,#{ \global \firstVoice #})
\handle-tag-groups \recordedTagGroups
\TEXT \TEXT
} }
@@ -30,7 +29,6 @@ TEXT = \markuplist {
\override #`(verselayout . ,verselayout) \override #`(verselayout . ,verselayout)
\override #`(verse-chords . ,#{ \chords { \verseChords } #}) \override #`(verse-chords . ,#{ \chords { \verseChords } #})
\override #`(verse-reference-voice . ,#{ \global \firstVoice #}) \override #`(verse-reference-voice . ,#{ \global \firstVoice #})
\handle-tag-groups \recordedTagGroups
#text #text
} }
#}) #})