%% ChordPro Export Engraver %% ========================= %% Single engraver in Score context that collects all data #(use-modules (ice-9 format)) #(use-modules (srfi srfi-1)) %% Per-Song-Store %% ============== %% Der gesamte Sammel-Zustand liegt in einer Struktur pro Lied, gekeyt ueber %% den Liednamen (Buch: songfilename aus \setsongfilename bzw. includeSong; %% Einzellied: ly:parser-output-name). So koennen mehrere Lieder in einem %% Durchlauf (Liederbuch) getrennt gesammelt und geschrieben werden. %% %% Bewusst KEIN srfi-9-Record: Im Buch wird diese Datei pro Lied erneut %% evaluiert (jedes Lied inkludiert base_config -> all.ily), und srfi-9- %% Typen sind generativ -- alte Instanzen wuerden mit neu definierten %% Accessoren kollidieren. Hashtabelle + Prozedur-Accessoren sind gegen %% Re-Evaluation robust; der Store selbst ueberlebt sie per defined?-Idiom. #(define chordpro-song-store (if (defined? 'chordpro-song-store) chordpro-song-store (make-hash-table))) %% Score-Context-Objekt (eq?) -> Song-Key. Vom Buch per \applyContext DIREKT %% IN DER MUSIK befuellt (siehe book_include.ily), damit ChordPro_music_collector %% den richtigen Song-Key hat, auch wenn LilyPond die \score-Bloecke mehrerer %% Lieder gesammelt/verzoegert interpretiert (dann waere ein globales %% chordpro-active-song-key zum Interpretationszeitpunkt schon auf ein %% ANDERES Lied gesetzt). Bewusst eine eigene Hashtabelle statt einer %% LilyPond-Context-Property (\applyContext -> ly:context-set-property!): %% LilyPond verwirft Werte fuer nicht deklarierte Properties stillschweigend %% ("the property ... does not exist"), eine hashq-Tabelle keyed auf das %% Kontext-Objekt selbst umgeht das. #(define chordpro-context-song-keys (if (defined? 'chordpro-context-song-keys) chordpro-context-song-keys (make-hash-table))) %% Handverlesene Griffbilder fuer Akkorde, die zwar korrekt (international) %% benannt sind, aber in ChordPros Standard-Config keinen Fingersatz haben %% (seltene Umkehrungen/Bassnoten oder komplexe Akzidenzien-Akkorde -- %% "Unknown chord to copy", Diagramm fehlt sonst). Key = internationaler %% Name (die rechte Seite von {define: ... copy ...}), Value = (base-fret . %% (fret fret fret fret fret fret)) tief nach hoch, 'x fuer stumme Saite. %% Von Nutzer bestaetigt, siehe [[chordpro-music-collector-context-bug]]. #(define chordpro-custom-chord-diagrams '(("Em/B" . (1 . (x 2 2 0 0 0))) ("Gm/D" . (1 . (x x 0 3 3 3))) ("G/G#" . (1 . (4 2 0 0 0 3))) ("Amb7b5" . (1 . (x 0 1 2 1 2))) ("Bmb13" . (1 . (x 2 4 4 3 3))) ("Bbb5" . (1 . (x 1 2 3 2 0))))) #(define (chordpro-make-song key) (let ((song (make-hash-table))) (hashq-set! song 'key key) ;; Alle Sammel-Listen werden in umgekehrter Reihenfolge aufgebaut (cons) (hashq-set! song 'syllables '()) (hashq-set! song 'chords '()) (hashq-set! song 'breaks '()) (hashq-set! song 'stanza-numbers '()) ;; Format: (moment verse-idx text direction) fuer Inline-Marker wie repStart/repStop (hashq-set! song 'inline-texts '()) ;; Zaehlt mit jedem \chordlyrics-Score des Lieds hoch (hashq-set! song 'verse-index 0) ;; Dokumentreihenfolge pro Vers: (idx seq pos sub). Die Interpretation ;; der Textseiten laeuft in umgekehrter Dokumentreihenfolge, bei ;; mehrspaltigen \group-verses zusaetzlich verschraenkt -- seq/pos ;; stellen die Quellreihenfolge wieder her (siehe ;; chordpro-song-ordered-verse-indices), sub ordnet Sub-Verse aus ;; Marker-Splits hinter ihren Elternvers. (hashq-set! song 'verse-order '()) ;; Akkorde, die {define:}-Direktiven brauchen: Liste von (original . ;; international) -- ein Eintrag deckt Akkord-Teil UND/ODER /Basston ab, ;; je nachdem was von beiden von der deutschen Notation abweicht. (hashq-set! song 'chord-defines '()) (hashq-set! song 'title #f) (hashq-set! song 'authors #f) ;; Weitere ChordPro-Metadaten-Direktiven, aus dem Header/der Musik des ;; Liedes befuellt (siehe chordpro-register-song-metadata) -- alle #f, ;; wenn nicht ermittelbar, dann wird die jeweilige Direktive weggelassen. (hashq-set! song 'copyright #f) (hashq-set! song 'year #f) (hashq-set! song 'key-signature #f) (hashq-set! song 'time #f) (hashq-set! song 'tempo #f) ;; Schreibschutz: jedes Lied wird nur einmal geschrieben (hashq-set! song 'written #f) ;; Aus der Musik (unter den Noten) nachgeholte Strophen, siehe ;; ChordPro_music_collector -- unabhaengig von den \chordlyrics- ;; Textseiten gesammelt, fuellt beim Schreiben nur deren Luecken. ;; music-candidates: Liste von ((syllables . (moment text hyphen?)*) ;; (stanza . label) (type . 'verse/'ref/'bridge)) ;; je ein Eintrag pro Lyrics-Kontext-Instanz mit echtem Strophenmarker. ;; music-chords/-breaks: fuers ganze Lied gemeinsam (alle Strophen ;; unter den Noten teilen sich dieselbe Melodie/Zeitachse). (hashq-set! song 'music-candidates '()) (hashq-set! song 'music-chords '()) (hashq-set! song 'music-breaks '()) song)) #(define (chordpro-song-key s) (hashq-ref s 'key)) #(define (chordpro-song-syllables s) (hashq-ref s 'syllables)) #(define (set-chordpro-song-syllables! s v) (hashq-set! s 'syllables v)) #(define (chordpro-song-chords s) (hashq-ref s 'chords)) #(define (set-chordpro-song-chords! s v) (hashq-set! s 'chords v)) #(define (chordpro-song-breaks s) (hashq-ref s 'breaks)) #(define (set-chordpro-song-breaks! s v) (hashq-set! s 'breaks v)) #(define (chordpro-song-stanza-numbers s) (hashq-ref s 'stanza-numbers)) #(define (set-chordpro-song-stanza-numbers! s v) (hashq-set! s 'stanza-numbers v)) #(define (chordpro-song-inline-texts s) (hashq-ref s 'inline-texts)) #(define (set-chordpro-song-inline-texts! s v) (hashq-set! s 'inline-texts v)) #(define (chordpro-song-verse-index s) (hashq-ref s 'verse-index)) #(define (set-chordpro-song-verse-index! s v) (hashq-set! s 'verse-index v)) #(define (chordpro-song-verse-order s) (hashq-ref s 'verse-order)) #(define (set-chordpro-song-verse-order! s v) (hashq-set! s 'verse-order v)) #(define (chordpro-song-chord-defines s) (hashq-ref s 'chord-defines)) #(define (set-chordpro-song-chord-defines! s v) (hashq-set! s 'chord-defines v)) #(define (chordpro-song-title s) (hashq-ref s 'title)) #(define (set-chordpro-song-title! s v) (hashq-set! s 'title v)) #(define (chordpro-song-authors s) (hashq-ref s 'authors)) #(define (set-chordpro-song-authors! s v) (hashq-set! s 'authors v)) #(define (chordpro-song-copyright s) (hashq-ref s 'copyright)) #(define (set-chordpro-song-copyright! s v) (hashq-set! s 'copyright v)) #(define (chordpro-song-year s) (hashq-ref s 'year)) #(define (set-chordpro-song-year! s v) (hashq-set! s 'year v)) #(define (chordpro-song-key-signature s) (hashq-ref s 'key-signature)) #(define (set-chordpro-song-key-signature! s v) (hashq-set! s 'key-signature v)) #(define (chordpro-song-time s) (hashq-ref s 'time)) #(define (set-chordpro-song-time! s v) (hashq-set! s 'time v)) #(define (chordpro-song-tempo s) (hashq-ref s 'tempo)) #(define (set-chordpro-song-tempo! s v) (hashq-set! s 'tempo v)) #(define (chordpro-song-written s) (hashq-ref s 'written)) #(define (set-chordpro-song-written! s v) (hashq-set! s 'written v)) #(define (chordpro-song-music-candidates s) (hashq-ref s 'music-candidates)) #(define (set-chordpro-song-music-candidates! s v) (hashq-set! s 'music-candidates v)) #(define (chordpro-song-music-chords s) (hashq-ref s 'music-chords)) #(define (set-chordpro-song-music-chords! s v) (hashq-set! s 'music-chords v)) #(define (chordpro-song-music-breaks s) (hashq-ref s 'music-breaks)) #(define (set-chordpro-song-music-breaks! s v) (hashq-set! s 'music-breaks v)) #(define (chordpro-get-song key) "Store-Eintrag zu key holen, bei Bedarf frisch anlegen." (or (hash-ref chordpro-song-store key) (let ((song (chordpro-make-song key))) (hash-set! chordpro-song-store key song) song))) %% Einzellied-Fallback fuer den Song-Key; layout_bottom setzt ihn auf %% (ly:parser-output-name). Im Buch kommt der Key stattdessen aus den %% Markup-Props (\setsongfilename), weil der geklonte Parser nur den %% Buchnamen kennt. #(define chordpro-default-song-key #f) #(define (chordpro-resolve-song-key props) "Song-Key aus Markup-Props (Buch) oder dem Einzellied-Fallback." (let ((from-props (and props (chain-assoc-get 'songfilename props #f)))) (cond ((and (string? from-props) (not (string-null? from-props))) from-props) (chordpro-default-song-key) (else "output")))) %% Lied, in dessen Store der Collector-Engraver gerade schreibt. Wird von %% \chordlyrics vor der (synchronen) Score-Interpretation gesetzt. #(define chordpro-active-song-key #f) %% Props des laufenden \chordlyrics-Aufrufs -- der Collector loest damit %% Markup-Silben (\updown u.ae.) auf, deren \tag-Sichtbarkeit an %% tags-to-keep/tags-to-remove aus umgebenden \keep-with-tag haengt. #(define chordpro-active-props #f) %% Dokumentreihenfolge: \group-verses nimmt sich pro Aufruf eine %% Sequenznummer und stempelt seine Verse mit (seq . pos) in die Props; %% \chordlyrics ausserhalb einer Gruppe nimmt sich selbst eine Nummer. %% Da die Interpretation in umgekehrter Dokumentreihenfolge laeuft, %% ergibt seq absteigend + pos aufsteigend die Quellreihenfolge. #(define chordpro-doc-seq-counter (if (defined? 'chordpro-doc-seq-counter) chordpro-doc-seq-counter 0)) #(define chordpro-active-doc-order #f) %% Verse-Indizes eines Lieds in Dokumentreihenfolge (fuer Writer/Export). #(define (chordpro-song-ordered-verse-indices song) (let* ((order-alist (chordpro-song-verse-order song)) (order-of (lambda (idx) (or (assv idx order-alist) (list idx 0 0 0))))) (sort (iota (chordpro-song-verse-index song)) (lambda (a b) (let ((oa (order-of a)) (ob (order-of b))) ;; seq absteigend, pos aufsteigend, sub aufsteigend, ;; Fallback: idx absteigend (cond ((not (= (cadr oa) (cadr ob))) (> (cadr oa) (cadr ob))) ((not (= (caddr oa) (caddr ob))) (< (caddr oa) (caddr ob))) ((not (= (cadddr oa) (cadddr ob))) (< (cadddr oa) (cadddr ob))) (else (> a b)))))))) %% Liest Variablen aus einem Lied-Header (\bookpart{\header{...}}) aus -- %% dieselbe Logik wie extract-and-check-vars-from-header (toc_include.ily), %% hier separat definiert, weil toc_include.ily nur im Buchkontext %% (book_top.ily) geladen wird, chordpro.ily aber auch im Einzellied-Pfad. #(define (chordpro-extract-header-vars header varlist) (let* ((headervars (hash-map->list cons (struct-ref (ly:book-header header) 0))) (extract-var (lambda (varname) (let* ((varref (assoc-ref headervars varname)) (value (if varref (variable-ref varref) #f))) (if (and value (not (and (string? value) (string-null? value)))) value #f))))) (map (lambda (varname) (cons varname (extract-var varname))) varlist))) %% Titel/Autoren aus dem Lied-Header (dem \bookpart{\header{...}} dieses %% konkreten Lieds, NICHT der globalen basicSongInfo-Variable) in den Store %% uebernehmen. Einzellied: layout_bottom nach dem Parsen; Buch: includeSong %% direkt nach dem Parsen des Lieds. Bewusst NICHT ueber die Variable %% basicSongInfo: die definieren viele Lieder (die aeltere, direkte %% HEADER = \bookpart{\header{...}}-Konvention ohne eigenes %% basicSongInfo) gar nicht selbst, wuerden im Buch dann aber (Buch = %% eine Parser-Sitzung fuer alle Lieder) die basicSongInfo-Werte des %% ZULETZT verarbeiteten Lieds erben, das eine definiert hat -- %% Titel/Autoren eines FREMDEN Lieds im eigenen ChordPro-Eintrag. %% (Bug real beobachtet: "Aennchen von Tharau" bekam Titel/Autoren von %% "Die Taube" zugewiesen, weil Ade_mein_Lieb_(Die_Taube) davor basic- %% SongInfo definiert hatte und Aennchen_von_Tharau.ly es nicht tut.) %% Musikalische Metadaten (Takt/Tonart/Tempo) kommen aus music->data-alist %% (data_extractor.ily) -- dieselbe Extraktion wie fuer den YAML-Export, %% nur zusaetzlich fuer ChordPro in dessen Notation umgewandelt; MUSIC ist %% (anders als basicSongInfo) IMMER frisch pro Lied gesetzt, kein Risiko. #(define (chordpro-register-song-metadata key header) (let* ((header-vars (chordpro-extract-header-vars header '(title authors copyright year_text year_melody))) (title (assoc-ref header-vars 'title)) (authors (assoc-ref header-vars 'authors)) (copyright (assoc-ref header-vars 'copyright)) (year (or (assoc-ref header-vars 'year_text) (assoc-ref header-vars 'year_melody))) (music-alist (and (defined? 'MUSIC) (ly:music? MUSIC) (music->data-alist MUSIC))) (song (chordpro-get-song key))) (when title (set-chordpro-song-title! song (cond ((markup? title) (markup->string title)) ((string? title) title) (else #f)))) (when authors (set-chordpro-song-authors! song authors)) (when (and (string? copyright) (not (string-null? copyright))) (set-chordpro-song-copyright! song copyright)) (when (and (string? year) (not (string-null? year))) (set-chordpro-song-year! song year)) (when music-alist (let ((key-str (assoc-ref music-alist 'key)) (time-str (assoc-ref music-alist 'time)) (tempo-str (assoc-ref music-alist 'tempo))) (when key-str (set-chordpro-song-key-signature! song (lilypond-key->chordpro-key key-str))) (when time-str (set-chordpro-song-time! song time-str)) (when tempo-str (let ((bpm (chordpro-tempo-number tempo-str))) (when bpm (set-chordpro-song-tempo! song bpm)))))))) %% Configuration (set by layout_bottom.ily or song file) %% Aktivierbar wie yaml-export-enabled durch Definieren der Variable vor %% dem Laden der Includes. #(define chordpro-export-enabled (if (defined? 'chordpro-export-enabled) chordpro-export-enabled #f)) %% Zusaetzlich zu den \chordlyrics-Textseiten auch die Strophen unter den %% Noten (MUSIC-Teil) einsammeln -- fuellt Luecken wie eine nur dort %% stehende erste Strophe oder einen nur dort stehenden Refrain (siehe %% ChordPro_music_collector). Eigene Flag, unabhaengig von %% chordpro-export-enabled: wer nur die \chordlyrics-Strophen will (z.B. %% bewusst nur "Zusatzstrophen"), laesst sie einfach aus. #(define chordpro-include-music-lyrics (if (defined? 'chordpro-include-music-lyrics) chordpro-include-music-lyrics #f)) %% 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))))) %% Konvertiert EINEN Akkord-Teil (Wurzel + Akkordform, OHNE /Basston) von %% deutscher zu internationaler Notation -- Dispatch je nach Wurzelton. %% german-accidentals-to-international deckt uebrigens auch Moll-Akkorde %% und akzidenzien-freie Akkorde ab (deckt alles außer H/B), daher reicht %% hier ein 3-Wege-Dispatch statt vier getrennter Funktionen. #(define (chordpro-convert-chord-root chord-part) (if (or (not (string? chord-part)) (string-null? chord-part)) chord-part (let ((first-char (string-ref chord-part 0))) (cond ((or (char=? first-char #\H) (char=? first-char #\h)) (german-h-to-b-form chord-part)) ((or (char=? first-char #\B) (char=? first-char #\b)) (german-b-to-bb-form chord-part)) (else (german-accidentals-to-international chord-part)))))) %% Wie chordpro-convert-chord-root, aber slash-chord-faehig: ein evtl. %% vorhandener /Basston (z.B. "H/Dis" -> Akkord "H", Basston "Dis") ist %% IMMER eine blanke Note (keine Akkordform, kein Moll) -- wird trotzdem %% ueber denselben Dispatch konvertiert, der behandelt eine blanke %% Note wie einen Akkord ohne Erweiterung korrekt (z.B. "Dis" -> "D#", %% "H" -> "B"). Ohne diese Slash-Behandlung blieb der Basston bisher %% unkonvertiert deutsch stehen (chordpro kennt "Dis"/"H" als Note nicht -- %% "Unknown chord to copy"/"Unknown chord", Akkord-Diagramm fehlte). #(define (chordpro-convert-chord-string chord-str) (if (or (not (string? chord-str)) (string-null? chord-str)) chord-str (let ((slash-pos (string-index chord-str #\/))) (if slash-pos (string-append (chordpro-convert-chord-root (substring chord-str 0 slash-pos)) "/" (chordpro-convert-chord-root (substring chord-str (+ slash-pos 1)))) (chordpro-convert-chord-root chord-str))))) %% Merkt sich (original . international) fuer eine {define:}-Direktive, %% falls die internationale Form vom Original abweicht (Akkord-Teil %% und/oder /Basston) -- liefert IMMER das Original zurueck, das bleibt %% als kompakte deutsche Inline-Notation im ChordPro-Text stehen. #(define (track-and-return-chord song chord-str) (if (or (not (string? chord-str)) (string-null? chord-str)) chord-str (let ((converted (chordpro-convert-chord-string chord-str))) (unless (or (string=? chord-str converted) (assoc chord-str (chordpro-song-chord-defines song))) (set-chordpro-song-chord-defines! song (cons (cons chord-str converted) (chordpro-song-chord-defines song)))) chord-str))) %% Wandelt eine ChordName-Markup in reinen Text um -- wie markup->string, %% behandelt aber zusaetzlich \accidental-Glyphen (fuer veraenderte %% Akkord-Stufen wie die verminderte Quinte/Septime in z.B. \chordmode %% "a:1.3-.5-.7-") als #/b-Text. LilyPonds eigenes markup->string kennt nur %% Text-Markups und laesst grafische Glyphen (auch fuer Akzidenzien %% verwendet) klanglos weg -- ohne diese Sonderbehandlung geht die %% Erniedrigt/Erhoeht-Information einer veraenderten Stufe verloren, z.B. %% wird aus "7-5-" (verm. Septakkord) einfach "75" (siehe %% [[chordpro-music-collector-context-bug]]). #(define (chordpro-markup->plain-string m) (cond ((string? m) m) ((not (pair? m)) "") (else (let ((cmd (car m)) (args (cdr m))) (cond ((eq? cmd accidental-markup) (let ((alteration (car args))) (cond ((> alteration 0) "#") ((< alteration 0) "b") (else "")))) ((or (eq? cmd line-markup) (eq? cmd concat-markup)) (string-concatenate (map chordpro-markup->plain-string (car args)))) ((or (eq? cmd smaller-markup) (eq? cmd translate-scaled-markup) (eq? cmd super-markup) (eq? cmd sub-markup) (eq? cmd bold-markup)) (chordpro-markup->plain-string (car (last-pair args)))) ((eq? cmd hspace-markup) "") (else "")))))) %% 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) (chordpro-markup->plain-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))) %% 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)))) %% Verarbeitet einen ChordName-Grob zu einem ChordPro-Akkordnamen (inkl. %% Klammer-Notation fuer altChord und Umwandlung deutscher Akkordnamen); %% trackt dabei nebenbei ins song's chordpro-song-*-chords (fuer die %% {define:}-Direktiven). Liefert #f fuer leere Akkorde (nichts zu tun). %% Gemeinsam genutzt von ChordPro_score_collector (chordlyrics) und %% ChordPro_music_collector (Noten). #(define (chordpro-extract-chord-name song grob) (let* ((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)) (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 song alt-main-name)) (alt (track-and-return-chord song alt-alt-name))) (if (string-null? main) (string-append "[(" alt ")]") ; Only alt chord: [(D7)] (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)) (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 song first-part)) (second-converted (track-and-return-chord song second-part))) (string-append first-converted "][(" second-converted ")")) ;; Single chord: just track and return original (track-and-return-chord song chord-names-str)))))) ;; Filter out completely empty chords, but convert ][(X) to [(X)] (cond ((or (string-null? chord-name-final) (string=? chord-name-final "") (string=? chord-name-final "][")) #f) ; Filter out ((string-prefix? "][(" chord-name-final) ;; ][(D7) → [(D7)] (let* ((inner (substring chord-name-final 3 (- (string-length chord-name-final) 1)))) (string-append "[(" inner ")]"))) (else chord-name-final)))) %% Single engraver in Score context #(define ChordPro_score_collector (lambda (context) (let ((song #f) (pending-syllable #f) (this-verse-index #f) (doc-seq 0) (doc-pos 0) (sub-counter 0)) ;; pending-syllable: (moment text verse-idx) (define (save-pending! has-hyphen) (when pending-syllable (set-chordpro-song-syllables! song (cons (list (car pending-syllable) (cadr pending-syllable) has-hyphen (caddr pending-syllable)) (chordpro-song-syllables song))) (set! pending-syllable #f))) (define (record-verse-order! idx) (set-chordpro-song-verse-order! song (cons (list idx doc-seq doc-pos sub-counter) (chordpro-song-verse-order song)))) (make-engraver ;; Initialize - called when engraver is created (once per \chordlyrics) ((initialize engraver) ;; \chordlyrics hat den aktiven Song-Key vor der Interpretation gesetzt; ;; jeder \chordlyrics-Score ist ein Vers dieses Lieds. (set! song (chordpro-get-song (or chordpro-active-song-key "output"))) (set! this-verse-index (chordpro-song-verse-index song)) (set-chordpro-song-verse-index! song (+ this-verse-index 1)) (let ((order (or chordpro-active-doc-order (cons 0 0)))) (set! doc-seq (car order)) (set! doc-pos (cdr order))) (record-verse-order! this-verse-index)) ;; Event listeners (listeners ;; LyricEvent from Lyrics context ((lyric-event engraver event) (let* ((raw-text (ly:event-property event 'text)) ;; Markup-Silben (z.B. \updown) mit den Props des ;; chordlyrics-Aufrufs zu Strings aufloesen -- erst dabei ;; entscheidet sich die \tag-Sichtbarkeit. (text (cond ((string? raw-text) raw-text) ((markup? raw-text) (markup->string raw-text #:props (or chordpro-active-props '()))) (else #f))) (moment (ly:context-current-moment context))) (when (string? text) ;; Save previous syllable if any (it had no hyphen) (save-pending! #f) ;; 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) (save-pending! #t)) ;; 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-song-breaks! song (cons (cons moment this-verse-index) (chordpro-song-breaks song)))))) ;; 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)) ;; \override-stanza ueberschreibt die GEDRUCKTEN Nummern ;; (z.B. "Ref. 4:" statt "Ref. 1, 4:") -- die zaehlen. (stanza-numbers (or (ly:assoc-get 'custom-stanzanumber-override details #f) (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-song-stanza-numbers song))) (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-song-inline-texts! song (cons (list moment this-verse-index custom-inline-text custom-inline-direction) (chordpro-song-inline-texts song)))) ;; 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)) (if (and (string? stanza-markup) (not existing)) ;; Ein direktes \set stanza = "..." (String, kein Markup) ;; am Versanfang ist ein echtes Label (z.B. "2.b"), keine ;; Dekoration -- als weiches Stanza-Label uebernehmen ;; (realstanza #f), nicht in den Verskoerper. (set-chordpro-song-stanza-numbers! song (cons (list this-verse-index stanza-markup 'verse #f) (chordpro-song-stanza-numbers song))) (when stanza-text ; Only if there's text to display (set-chordpro-song-inline-texts! song (cons (list moment this-verse-index stanza-text direction) (chordpro-song-inline-texts song)))))) ;; 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 numbers) (when custom-realstanza (let* ((existing-text (and existing (cadr existing))) (existing-type (and existing (caddr existing))) (existing-realstanza (and existing (> (length existing) 3) (cadddr existing))) (existing-numbers (or (and existing (> (length existing) 4) (list-ref existing 4)) '())) ;; Reprint desselben Markers (Strophennummer am Zeilen- ;; umbruch erneut gedruckt, ggf. als Nummern-Obermenge ;; wie #(stanza 2 3) nach Strophe 2) setzt den Vers ;; fort; vgl. merge-reprinted im data_extractor. (same-marker? (and existing-realstanza (or (and (string? existing-text) (string? stanza-text) (string=? existing-text stanza-text)) (and (eq? existing-type stanza-type) (pair? existing-numbers) (every (lambda (n) (member n stanza-numbers)) existing-numbers)))))) (cond ;; Kein Eintrag: neu anlegen ((not existing) (set-chordpro-song-stanza-numbers! song (cons (list this-verse-index stanza-text stanza-type custom-realstanza stanza-numbers) (chordpro-song-stanza-numbers song)))) ;; Weicher Eintrag (\set stanza) oder Reprint: aktualisieren, ;; Text echter Marker nicht ueberschreiben ((or (not existing-realstanza) same-marker?) (set-chordpro-song-stanza-numbers! song (map (lambda (entry) (if (= (car entry) this-verse-index) (list (car entry) (if existing-realstanza existing-text (or stanza-text existing-text)) stanza-type #t (if existing-realstanza existing-numbers stanza-numbers)) entry)) (chordpro-song-stanza-numbers song)))) ;; ANDERER echter Marker im selben \chordlyrics (z.B. ;; Refrain nach der Strophe): neuen logischen Vers beginnen. ;; Alles ab hier (inkl. einer im selben Timestep schon ;; angefallenen Silbe) gehoert zum neuen Vers. (else (let ((old-idx this-verse-index) (split-idx (chordpro-song-verse-index song))) (set-chordpro-song-verse-index! song (+ split-idx 1)) (set! sub-counter (+ sub-counter 1)) (set! this-verse-index split-idx) (record-verse-order! split-idx) ;; Die erste Silbe des neuen Abschnitts faellt in ;; denselben Timestep wie der Marker und wurde ggf. ;; schon gesammelt (pending oder -- bei Trennstrich -- ;; bereits gespeichert): dem neuen Vers zuschlagen. (when (and pending-syllable (ly:moment=? (car pending-syllable) moment)) (set! pending-syllable (list moment (cadr pending-syllable) split-idx))) (let retag ((rest (chordpro-song-syllables song)) (acc '())) (if (and (pair? rest) (= (cadddr (car rest)) old-idx) (ly:moment=? (car (car rest)) moment)) (retag (cdr rest) (cons (list (car (car rest)) (cadr (car rest)) (caddr (car rest)) split-idx) acc)) (set-chordpro-song-syllables! song (append (reverse acc) rest)))) (let retag ((rest (chordpro-song-chords song)) (acc '())) (if (and (pair? rest) (= (caddr (car rest)) old-idx) (ly:moment=? (car (car rest)) moment)) (retag (cdr rest) (cons (list (car (car rest)) (cadr (car rest)) split-idx (cadddr (car rest))) acc)) (set-chordpro-song-chords! song (append (reverse acc) rest)))) (set-chordpro-song-stanza-numbers! song (cons (list split-idx stanza-text stanza-type custom-realstanza stanza-numbers) (chordpro-song-stanza-numbers song)))))))))) ; closes 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)) (processed-chord-name (chordpro-extract-chord-name song grob))) ;; Store grob reference along with chord data (unless empty) ;; Format: (moment chord-name verse-index grob) (when processed-chord-name (set-chordpro-song-chords! song (cons (list moment processed-chord-name this-verse-index grob) (chordpro-song-chords song)))))) ;; 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-song-stanza-numbers song))) (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-song-stanza-numbers! song (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-song-stanza-numbers song)))))))) ; schließt lyric-syllable-interface ) ; schließt acknowledgers ;; End of timestep ((stop-translation-timestep engraver) (save-pending! #f)) ;; Finalize - just save leftovers, don't filter chords yet ;; (Filtering happens in chordpro-write-song where grob properties are final) ((finalize engraver) ;; Save any remaining pending syllable (save-pending! #f)))))) %% Zweiter Collector-Engraver: sammelt Strophen UNTER DEN NOTEN (im %% MUSIC-Teil), nicht nur aus \chordlyrics -- fuellt damit Luecken wie %% eine nur dort stehende erste Strophe oder einen nur dort stehenden %% Refrain (siehe chordpro-include-music-lyrics). Sitzt auf Score-Ebene %% wie ChordPro_score_collector, sieht daher sowohl die parallele %% ChordNames-Stimme (Akkorde -- global fuers ganze Lied, alle Strophen %% unter den Noten teilen sich dieselbe Melodie/Zeitachse) als auch ALLE %% Lyrics-Kontexte (\addlyrics/\lyricsto). Mehrere Strophen/Stimmen %% koennen dabei in EINEM Score zusammenlaufen -- Silben werden deshalb %% ueber source-engraver -> Kontext in getrennte "Buckets" sortiert %% (nicht wie bei chordlyrics ueber mehrere Engraver-Instanzen: dort hat %% jeder \chordlyrics-Aufruf seinen eigenen Mini-Score). Buckets ohne %% echten Strophenmarker (reine Dekoration/Lautmalerei ohne %% #(stanza n)/\ref/\bridge) werden beim Schreiben verworfen. #(define ChordPro_music_collector (lambda (context) (let ((song #f) ;; Immer \consists't (wie chordpro-delayed-write); schaltet ;; sich ueber die Flag selbst ab statt bedingt eingebunden zu ;; werden -- einmal pro Engraver-Instanz gelesen, aendert sich ;; waehrend eines Durchlaufs nicht. (enabled? (and (defined? 'chordpro-include-music-lyrics) chordpro-include-music-lyrics)) ;; Lyrics-Kontext (eq?) -> Bucket (Hashtabelle mit den Feldern ;; syllables/stanza/type/marked) (buckets (make-hash-table)) ;; Reihenfolge, in der Buckets zuerst angelegt wurden -- ;; hash-table-Reihenfolge ist unspezifiziert, das hier ist es ;; nicht (fuer eine nachvollziehbare Kandidaten-Reihenfolge). (bucket-order '())) (define (bucket-for lyr-context) (or (hashq-ref buckets lyr-context #f) (let ((b (make-hash-table))) (hashq-set! b 'syllables '()) (hashq-set! b 'stanza #f) (hashq-set! b 'type 'verse) (hashq-set! b 'marked #f) (hashq-set! buckets lyr-context b) (set! bucket-order (cons lyr-context bucket-order)) b))) ;; Song-Key bevorzugt aus der Score-Context-Property (siehe ;; book_include.ily), die per \applyContext DIREKT IN DER MUSIK ;; gesetzt wird und deshalb korrekt bleibt, auch wenn LilyPond die ;; \score-Bloecke mehrerer Lieder gesammelt/verzoegert interpretiert ;; (Buch) -- ein globales chordpro-active-song-key waere zu diesem ;; Zeitpunkt schon auf ein ANDERES Lied gesetzt. WICHTIG: (initialize ;; engraver) laeuft bei Context-Erzeugung, VOR jeder Musik-Interpretation ;; -- \applyContext (ein Musik-Ereignis) hat die Property zu diesem ;; Zeitpunkt noch nicht gesetzt. Deshalb wird der Song erst BEIM ERSTEN ;; TATSAECHLICHEN GEBRAUCH (Listener/Acknowledger-Aufruf, Timestep >= 0, ;; also nach \applyContext) aufgeloest, nicht in initialize. ;; chordpro-active-song-key bleibt Fallback (Einzellied-Standalone-Pfad, ;; dort synchron genug). (define (resolve-song!) (unless song (let ((global-ctx (ly:context-parent context))) (set! song (chordpro-get-song (or (and global-ctx (hashq-ref chordpro-context-song-keys global-ctx #f)) chordpro-active-song-key "output")))))) (make-engraver (listeners ;; Umbrueche sind Score-weit (betreffen alle Stimmen gleich) -- ;; global sammeln, nicht pro Bucket. ((break-event engraver event) (when enabled? (resolve-song!) ;; format-verse-as-chordpro erwartet (moment . irgendwas)-Paare ;; (liest nur (car b)); #f als Fuellwert, da kein Vers-Index ;; noetig ist -- diese Breaks sind global fuers ganze Lied. (set-chordpro-song-music-breaks! song (cons (cons (ly:context-current-moment context) #f) (chordpro-song-music-breaks song)))))) (acknowledgers ;; Akkorde: global fuers ganze Lied, wie bei ChordPro_score_collector. ((chord-name-interface engraver grob source-engraver) (when enabled? (resolve-song!) (let ((moment (ly:context-current-moment context)) (processed-chord-name (chordpro-extract-chord-name song grob))) (when processed-chord-name (set-chordpro-song-music-chords! song (cons (list moment processed-chord-name) (chordpro-song-music-chords song))))))) ;; Silben: pro Lyrics-Kontext-Instanz (via source-engraver) in ;; getrennte Buckets, damit mehrere \addlyrics/\lyricsto nicht ;; ineinanderlaufen. Trennstrich-Info kommt aus der cause-Kette ;; des Grobs zurueck zum urspruenglichen LyricEvent -- dieselbe ;; Konvention wie in der Statik (data_extractor.ily): eine Silbe ;; ist "getrennt" (verbindet sich mit der naechsten), wenn SIE ;; SELBST eine HyphenEvent-Artikulation hat. ((lyric-syllable-interface engraver grob source-engraver) (when enabled? (let* ((lyr-context (ly:translator-context source-engraver)) (text (ly:grob-property grob 'text)) (cause (ly:grob-property grob 'cause)) (mcause (and cause (ly:event-property cause 'music-cause))) (has-hyphen (and (ly:music? mcause) (any (lambda (a) (eq? (ly:music-property a 'name) 'HyphenEvent)) (ly:music-property mcause 'articulations '()))))) ;; "_"-Skips (Melisma-Platzhalter) kommen als Leerzeichen an ;; und werden ignoriert, wie in der Statik. (when (and (string? text) (not (string-null? (string-trim-both text)))) (let ((bucket (bucket-for lyr-context))) (hashq-set! bucket 'syllables (cons (list (ly:context-current-moment lyr-context) text has-hyphen) (hashq-ref bucket 'syllables)))))))) ;; Strophenmarker: pro Kontext, nur der ERSTE echte Marker zaehlt ;; (ein \addlyrics-Block unter den Noten hat ueblicherweise genau ;; einen #(stanza n)/\ref/\bridge am Anfang). ((stanza-number-interface engraver grob source-engraver) (when enabled? (let* ((lyr-context (ly:translator-context source-engraver)) (bucket (bucket-for lyr-context)) (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 (or (ly:assoc-get 'custom-stanzanumber-override details #f) (ly:assoc-get 'custom-stanza-numbers details '()))) (stanza-text-from-grob (ly:grob-property grob 'text #f)) (stanza-text-from-context (ly:context-property lyr-context 'stanza #f)) (stanza-markup (or stanza-text-from-context stanza-text-from-grob)) (label (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))))) (when (and custom-realstanza (not (hashq-ref bucket 'marked))) (hashq-set! bucket 'marked #t) (hashq-set! bucket 'stanza (or label "")) (hashq-set! bucket 'type stanza-type)))))) ((finalize engraver) ;; Markierte Buckets in der Reihenfolge ihres ersten Auftretens ;; als Kandidaten in den Store uebernehmen; unmarkierte ;; (dekorative Stimmen ohne echten Strophenmarker) verwerfen. (when enabled? (resolve-song!) (for-each (lambda (lyr-context) (let ((bucket (hashq-ref buckets lyr-context))) (when (hashq-ref bucket 'marked) (set-chordpro-song-music-candidates! song (cons (list (cons 'syllables (reverse (hashq-ref bucket 'syllables))) (cons 'stanza (hashq-ref bucket 'stanza)) (cons 'type (hashq-ref bucket 'type))) (chordpro-song-music-candidates song)))))) (reverse bucket-order)))))))) %% Entfernt aufeinanderfolgende Wiederholungen desselben Akkordnamens -- %% nur bei einem tatsaechlichen Akkordwechsel soll ein neuer Akkord in der %% ChordPro-Ausgabe erscheinen, nicht bei jedem erneuten Anschlag desselben %% Akkords. chords-list: Liste von (moment chord-name . irgendwas), Reihen- %% folge chronologisch. Von chordpro-format-song fuer sowohl \chordlyrics- %% Strophen als auch aus der Musik nachgeholte Kandidaten genutzt (dort %% fehlte dieser Schritt urspruenglich, siehe [[chordpro-music-collector-context-bug]]). #(define (chordpro-filter-repeated-chords chords-list) (let filter-repeats ((chords-left chords-list) (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) (filter-repeats (cdr chords-left) last-chord result) (filter-repeats (cdr chords-left) chord-name (cons chord result))))))) %% Formatiert einen einzelnen Strophen-/Refrain-/Bridge-Block als %% ChordPro-String (mit den passenden Direktiven bzw. als Kommentar bei %% Nicht-Realstanza-Fragmenten). Von chordpro-format-song fuer sowohl %% \chordlyrics-Strophen als auch aus der Musik nachgeholte Kandidaten %% genutzt. #(define (chordpro-format-verse-block realstanza stanza-type label body-text) (let ((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"))) (has-label (and label (string? label) (not (string-null? label))))) (with-output-to-string (lambda () (if realstanza (begin (if has-label (display (format #f "{~a: label=\"~a\"}\n" start-directive label)) (display (format #f "{~a}\n" start-directive))) (display body-text) (display (format #f "\n{~a}\n\n" end-directive))) (begin (when has-label (display (format #f "# ~a\n" label))) (display body-text) (display "\n\n"))))))) %% Helper functions to format and write ChordPro #(define (chordpro-format-song song) "Format one song's collected engraver data as a ChordPro string." (let* ((num-verses (chordpro-song-verse-index song)) ;; Reverse all lists (they were collected in reverse order) (syllables (reverse (chordpro-song-syllables song))) (chords (reverse (chordpro-song-chords song))) (breaks (reverse (chordpro-song-breaks song))) (stanza-numbers (chordpro-song-stanza-numbers song)) (inline-texts (chordpro-song-inline-texts song)) (chord-defines (reverse (chordpro-song-chord-defines song)))) (with-output-to-string (lambda () ;; Write metadata (display (format #f "{title: ~a}\n" (or (chordpro-song-title song) "Untitled"))) (when (chordpro-song-authors song) (for-each (lambda (name) (display (format #f "{artist: ~a}\n" name))) (chordpro-all-author-names (chordpro-song-authors song))) (for-each (lambda (name) (display (format #f "{composer: ~a}\n" name))) (chordpro-authors-by-role 'melody (chordpro-song-authors song))) (for-each (lambda (name) (display (format #f "{lyricist: ~a}\n" name))) (chordpro-authors-by-role 'text (chordpro-song-authors song)))) (when (chordpro-song-copyright song) (display (format #f "{copyright: ~a}\n" (chordpro-song-copyright song)))) (when (chordpro-song-year song) (display (format #f "{year: ~a}\n" (chordpro-song-year song)))) (when (chordpro-song-key-signature song) (display (format #f "{key: ~a}\n" (chordpro-song-key-signature song)))) (when (chordpro-song-time song) (display (format #f "{time: ~a}\n" (chordpro-song-time song)))) (when (chordpro-song-tempo song) (display (format #f "{tempo: ~a}\n" (chordpro-song-tempo song)))) ;; {define:} directives: B/b (German B = English Bb), H/h (German H = ;; English B), Akzidenzien (is/es -> #/b), jeweils inkl. /Basston. (unless (null? chord-defines) (newline)) (for-each (lambda (pair) (let* ((original (car pair)) (converted (cdr pair)) (diagram (assoc-ref chordpro-custom-chord-diagrams converted))) (if diagram (display (format #f "{define: ~a base-fret ~a frets ~a}\n" original (car diagram) (string-join (map (lambda (f) (format #f "~a" f)) (cdr diagram)) " "))) (display (format #f "{define: ~a copy ~a}\n" original converted))))) chord-defines) (newline) ;; \chordlyrics-Strophen zu (label realstanza block-string) auswerten, ;; statt sie sofort zu schreiben -- die aus der Musik nachgeholten ;; Kandidaten (falls chordpro-include-music-lyrics) muessen erst ;; wissen, welche Label schon abgedeckt sind (chordlyrics gewinnt ;; bei Konflikt, da dort Akkorde UND die gedruckte Textseite ;; dahinterstehen). (let* ((chordlyrics-blocks (filter-map (lambda (verse-idx) (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)) ;; Nur Akkordwechsel ausgeben, keine Wiederholungen (verse-chords (chordpro-filter-repeated-chords verse-chords-raw)) (verse-breaks (filter (lambda (b) (= (cdr b) verse-idx)) breaks)) (verse-inline-texts (filter (lambda (r) (= (cadr r) verse-idx)) (reverse inline-texts))) (stanza-entry (find (lambda (s) (= (car s) verse-idx)) 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))) (and (not (null? verse-syllables)) (list stanza-num (chordpro-format-verse-block realstanza stanza-type stanza-num (format-verse-as-chordpro verse-syllables verse-chords verse-breaks verse-inline-texts)))))) (chordpro-song-ordered-verse-indices song))) (chordlyrics-labels (filter-map (lambda (b) (and (string? (car b)) (not (string-null? (car b))) (car b))) chordlyrics-blocks)) ;; Aus der Musik nachgeholte Kandidaten: nur wenn gewuenscht, ;; und nur die, deren Label NICHT schon von \chordlyrics ;; abgedeckt ist (auch nicht von einem VORHERIGEN Kandidaten ;; -- z.B. mehrere Stimmen, die alle denselben Refrain ;; markiert haben). (music-chords (chordpro-filter-repeated-chords (reverse (chordpro-song-music-chords song)))) (music-breaks (reverse (chordpro-song-music-breaks song))) (music-blocks (if (and (defined? 'chordpro-include-music-lyrics) chordpro-include-music-lyrics) (let loop ((candidates (reverse (chordpro-song-music-candidates song))) (covered chordlyrics-labels) (acc '())) (if (null? candidates) (reverse acc) (let* ((candidate (car candidates)) (label (assq-ref candidate 'stanza)) (type (assq-ref candidate 'type)) (candidate-syllables (assq-ref candidate 'syllables)) (has-label (and (string? label) (not (string-null? label))))) (if (and has-label (member label covered)) (loop (cdr candidates) covered acc) (loop (cdr candidates) (if has-label (cons label covered) covered) (cons (chordpro-format-verse-block #t type label (format-verse-as-chordpro candidate-syllables music-chords music-breaks '())) acc)))))) '()))) ;; Nachgeholte Strophen (typischerweise Strophe 1 und/oder Refrain) ;; kommen vor den \chordlyrics-Strophen -- das deckt den weit ;; ueberwiegenden Praxisfall (fehlende erste Strophe/Refrain ;; gehoert an den Anfang); eine perfekte Einsortierung nach ;; Strophennummer bei exotischeren Luecken waere deutlich ;; aufwendiger und lohnt den Mehraufwand fuer diesen Randfall nicht. (for-each display music-blocks) (for-each (lambda (b) (display (cadr b))) chordlyrics-blocks)))))) %% Schreibt ein Lied als eigene .cho-Datei (Einzellied-/Pro-Song-Modus). #(define (chordpro-write-song song) "Write one song's ChordPro file from its collected engraver data" (let ((output-file (string-append (chordpro-song-key song) ".cho"))) (with-output-to-file output-file (lambda () (display (chordpro-format-song song)))))) #(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 (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= 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 0) (if (ly:moment= 0) ;; and within tolerance (let ((valid (and (not (ly:moment= 0 (ly:moment<=? diff tolerance)))) (if (and valid (or (not best-diff) (ly:momentstring in data_extractor.ily) in ChordPro-Tonart-Notation um %% (z.B. "Dm", "Eb"). Nutzt dieselbe internationale Notenlogik wie die %% {define:}-Direktiven, aber auf die BARE Note angewendet statt auf einen %% vollen Akkordnamen -- Dur/Moll steht hier als eigenes Wort, nicht als %% Gross-/Kleinschreibung wie bei Akkorden aus \chordmode. #(define (lilypond-key->chordpro-key key-string) (let* ((parts (string-split key-string #\space)) (note (car parts)) (minor? (string=? (cadr parts) "minor")) (first-char (string-ref note 0)) (rest (if (> (string-length note) 1) (substring note 1) ""))) (string-append (cond ((char=? first-char #\h) "B") ; deutsches H = engl. B ((and (char=? first-char #\b) (string-null? rest)) "Bb") ; deutsches b = engl. Bb (else (string (char-upcase first-char)))) (cond ((string=? rest "is") "#") ; fis/cis/... = Kreuz ((member note '("es" "as")) "b") ; unregelmaessig: es=Eb, as=Ab ((string=? rest "es") "b") ; des/ges/ces = regulaeres -es (else "")) (if minor? "m" "")))) %% Extrahiert die BPM-Zahl aus einem tempo-music->string-Ergebnis wie %% "4 = 130" oder "Allegro (4 = 130)"; #f bei reinem Text-Tempo ("Allegro", %% kein Metronomwert) oder wenn tempo-string selbst #f ist. Bei Bereichen %% ("4. = 60-70") wird die erste Zahl genommen. #(define (chordpro-tempo-number tempo-string) (and tempo-string (let ((match (ly:regex-exec (ly:make-regex "=\\s*([0-9]+)") tempo-string))) (and match (ly:regex-match-substring match 1))))) %% 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 one song's ChordPro file during stencil evaluation (after all engraver data is collected). The song is identified at interpretation time: in books via the songfilename markup prop (\\setsongfilename), standalone via the chordpro-default-song-key fallback." (let ((key (chordpro-resolve-song-key props))) (ly:make-stencil `(delay-stencil-evaluation ,(delay (begin (when (and (defined? 'chordpro-export-enabled) chordpro-export-enabled) (let ((song (hash-ref chordpro-song-store key))) (when (and song (not (chordpro-song-written song)) ;; \chordlyrics-Strophen ODER (bei ;; chordpro-include-music-lyrics) aus der Musik ;; nachgeholte Kandidaten -- ein Lied kann auch ;; ganz ohne \chordlyrics nur ueber Letztere ;; etwas zu schreiben haben (z.B. Krabats ;; Muehlenlied). (or (> (chordpro-song-verse-index song) 0) (pair? (chordpro-song-music-candidates song)))) (chordpro-write-song song) (set-chordpro-song-written! song #t)))) empty-stencil))))))