diff --git a/private_includes/base/all.ily b/private_includes/base/all.ily index 49cdc4e..30d7617 100644 --- a/private_includes/base/all.ily +++ b/private_includes/base/all.ily @@ -20,7 +20,8 @@ "scm" file-name-separator-string filename ))))) (scm-load "resolve_inherits.scm") - (scm-load "yaml_parser.scm"))) + (scm-load "yaml_parser.scm") + (scm-load "yaml_writer.scm"))) #(define (song-includes-data-path filename) (string-join @@ -39,6 +40,7 @@ \include "title_with_category_images.ily" \include "chord_settings.ily" \include "chordpro.ily" +\include "data_extractor.ily" \include "transposition.ily" \include "markup_tag_groups_hack.ily" \include "verses_with_chords.ily" diff --git a/private_includes/base/chordpro.ily b/private_includes/base/chordpro.ily index 880f570..cb7886f 100644 --- a/private_includes/base/chordpro.ily +++ b/private_includes/base/chordpro.ily @@ -5,28 +5,269 @@ #(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)))) +%% 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) @@ -95,48 +336,82 @@ (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." +%% 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* ((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)))) + (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))))) - ;; 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 +%% 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" @@ -178,7 +453,7 @@ "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)) + ((markup? markup) (chordpro-markup->plain-string markup)) ((pair? markup) (extract-chord-names-from-markup (car markup))) (else (format #f "~a" markup)))) ;; Remove all spaces @@ -197,35 +472,6 @@ ;; 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 #f) -#(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" @@ -244,58 +490,120 @@ (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 ((pending-syllable #f) - (this-verse-index #f)) + (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) - ;; 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))) + ;; \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 ((text (ly:event-property event 'text)) - (moment (ly:context-current-moment context))) + (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) - ;; 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))) + (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) - (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))) + (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-breaks-collected - (cons (cons moment this-verse-index) chordpro-breaks-collected))))) + (set-chordpro-song-breaks! song + (cons (cons moment this-verse-index) (chordpro-song-breaks song)))))) ;; Acknowledge grobs from child contexts (acknowledgers @@ -304,7 +612,10 @@ (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 '())) + ;; \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)) @@ -327,113 +638,126 @@ (if stanza-markup (format #f "~a" stanza-markup) #f)))) - (existing (assoc this-verse-index chordpro-stanza-numbers)) + (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-inline-texts-collected + (set-chordpro-song-inline-texts! song (cons (list moment this-verse-index custom-inline-text custom-inline-direction) - chordpro-inline-texts-collected))) + (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)) - (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)))) + (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) + ;; Entry format: (verse-idx stanza-text stanza-type realstanza-flag numbers) (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 + (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 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)) + stanza-type + #t + (if existing-realstanza existing-numbers stanza-numbers)) 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 + (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)) - ;; 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)))))) + (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) - ;; 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)))))) + (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) @@ -448,7 +772,7 @@ (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)) + (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) @@ -459,7 +783,7 @@ (string? stanza-text) (not (string-null? stanza-text))) ;; Update existing entry with text (keep type and realstanza flag) - (set! chordpro-stanza-numbers + (set-chordpro-song-stanza-numbers! song (map (lambda (entry) (if (= (car entry) this-verse-index) (list (car entry) @@ -467,151 +791,342 @@ (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 + (chordpro-song-stanza-numbers song)))))))) ; 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))) + (save-pending! #f)) - ;; Finalize - just write debug, don't filter chords yet - ;; (Filtering happens in chordpro-write-from-engraver-data where grob properties are final) + ;; 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 - (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)) - ))))) + (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-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")) +#(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-syllables-collected)) - (chords (reverse chordpro-chords-collected)) - (breaks (reverse chordpro-breaks-collected))) + (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-file output-file + (with-output-to-string (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)))) + (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)))) - ;; 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))) + ;; {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) - ;; 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")))) + ;; \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)))))) - (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))))))) - - )) +%% 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. @@ -963,35 +1478,103 @@ "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 ""))) +%% Lieferbarer Name eines Autors-Keys (z.B. "HansLeip") aus AUTHOR_DATA +%% (Feld "name", z.B. "Hans Leip"); ohne Eintrag der rohe Key als Fallback, +%% analog zu format-author in footer_with_songinfo.ily -- aber ohne dessen +%% Praefixe/Jahresangaben, die fuer ChordPro-Metadaten nicht passen. +#(define (chordpro-author-display-name author-id) + (let ((data (and (defined? 'AUTHOR_DATA) (assoc-ref AUTHOR_DATA author-id)))) + (or (and data (assoc-ref data "name")) author-id))) + +%% Formatierte Namen aller Autoren (unabhaengig von ihrer Rolle) als Liste +%% -- fuer je eine eigene {artist:}-Zeile. ChordPro will mehrere Werte +%% nicht kommagetrennt in einer Direktive, sondern als mehrfache Direktive +%% (https://www.chordpro.org/chordpro/directives-artist/: "Multiple +%% artists can be specified using multiple directives."). +#(define (chordpro-all-author-names authors) + (if (list? authors) + (filter (lambda (s) (not (string-null? s))) + (map (lambda (author-info) + (cond + ((pair? author-info) (chordpro-author-display-name (car author-info))) + ((string? author-info) (chordpro-author-display-name author-info)) + (else ""))) + authors)) + '())) + +%% Formatierte Namen aller Autoren mit dieser Rolle (z.B. 'melody fuer +%% {composer:}, 'text fuer {lyricist:}) als Liste, aus demselben Grund wie +%% chordpro-all-author-names eine Liste statt ein komma-getrennter String. +%% authors ist die rohe Liste aus dem Header, z.B. +%% (("HansLeip" text melody) ("alf" melody)). +#(define (chordpro-authors-by-role role authors) + (if (list? authors) + (filter-map (lambda (author-info) + (and (pair? author-info) + (member role (cdr author-info)) + (chordpro-author-display-name (car author-info)))) + authors) + '())) + +%% Wandelt eine LilyPond-Tonart wie "d minor"/"es major" (Ausgabe von +%% key-music->string 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 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))))) + "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)))))) diff --git a/private_includes/base/data_extractor.ily b/private_includes/base/data_extractor.ily new file mode 100644 index 0000000..ab6753b --- /dev/null +++ b/private_includes/base/data_extractor.ily @@ -0,0 +1,550 @@ +%%% Extrahiert Informationen aus einem ly:music-Objekt und liefert eine alist +%%% mit String-Werten zurueck (z.B. ((time . "4/4") (key . "d minor"))). +%%% Benoetigt LilyPond >= 2.26. + +%% note-name->lily-string liegt im Modul (lily display-lily). +#(use-modules (lily display-lily)) + +#(begin + + ;; --- Taktangabe -------------------------------------------------------- + + ;; Numerator einer Taktangabe kann eine Zahl oder eine Liste sein. + (define (numerator->string num) + (if (list? num) + (string-join (map number->string num) "+") + (number->string num))) + + ;; Ein einzelner Bruch ist ein Paar (numerator . denominator), der + ;; Numerator eine Zahl oder eine Liste (z.B. 3+3/8). + (define (fraction->string frac) + (string-append (numerator->string (car frac)) "/" + (number->string (cdr frac)))) + + ;; Liefert die Taktangabe als String (z.B. "4/4", "3+3/8" oder + ;; "3+3/8 + 2/8") oder #f. time-signature ist ein Bruch oder bei + ;; zusammengesetzten Taktarten (\timeAbbrev, \compoundMeter) eine + ;; Liste von Bruechen. + (define (time-music->string m) + (let ((ts (ly:music-property m 'time-signature))) + (and (pair? ts) + (if (number? (cdr ts)) + (fraction->string ts) + (string-join (map fraction->string ts) " + "))))) + + ;; --- Tempo --------------------------------------------------------------- + + ;; Liefert die Tempoangabe als String (z.B. "4 = 130", "4. = 60-70", + ;; "Allegro" oder "Allegro (4 = 130)") oder #f. + (define (tempo-music->string m) + (let* ((unit (ly:music-property m 'tempo-unit)) + (count (ly:music-property m 'metronome-count)) + (text (ly:music-property m 'text)) + (unit-s (and (ly:duration? unit) + (string-append + (number->string (expt 2 (ly:duration-log unit))) + (make-string (ly:duration-dot-count unit) #\.)))) + (count-s (cond ((number? count) (number->string count)) + ((pair? count) (ly:format "~a-~a" (car count) (cdr count))) + (else #f))) + (metronome-s (and unit-s count-s (string-append unit-s " = " count-s))) + (text-s (and (markup? text) (markup->string text)))) + (cond + ((and text-s metronome-s) (string-append text-s " (" metronome-s ")")) + (metronome-s metronome-s) + (text-s text-s) + (else #f)))) + + ;; --- Tonart ------------------------------------------------------------ + + ;; Liefert die Tonart als String (z.B. "d minor" oder "c major") oder #f. + ;; Vorgehen wie in LilyPonds eigenem \displayMusic (define-music-display- + ;; methods.scm): pitch-alist nach c zuruecktransponieren und mit den + ;; bekannten Modus-Definitionen vergleichen. note-name->lily-string liefert + ;; den Grundton in der aktuell eingestellten Notensprache. + (define (key-music->string m) + (let ((tonic (ly:music-property m 'tonic)) + (alist (ly:music-property m 'pitch-alist))) + (and (ly:pitch? tonic) (pair? alist) + (let* ((c-alist (ly:transpose-key-alist alist (- tonic))) + (mode (any (lambda (mode) + (and (equal? (ly:parser-lookup mode) c-alist) + (symbol->string mode))) + '(major minor)))) + (and mode + (string-append (symbol->string (note-name->lily-string tonic)) + " " mode)))))) + + ;; --- Header-Metadaten ---------------------------------------------------- + + ;; Header-Felder, die eigentlich Layoutsachen sind (gehoerten nach paper) + ;; und deshalb nicht mit exportiert werden. + (define ignored-header-fields + '(titlesize titletopspace tagline between-poet-and-composer-markup)) + + ;; categories ist im Header ein String mit Leerzeichen ("trist satz") + ;; und wird als Liste von Woertern exportiert. + (define (header-value key value) + (if (and (eq? key 'categories) (string? value)) + (string-tokenize value) + value)) + + ;; Nimmt einen Bookpart entgegen (wie HEADER aus pool_bottom.ily) und + ;; liefert dessen Header-Felder als alist, z.B. + ;; ((title . "Ako umram") (authors . (("..." text melody))) ...). + ;; Die Werte bleiben unveraendert, wie sie im \header definiert wurden + ;; (Strings, Listen, Markups ...). + (define (bookpart->header-alist bookpart) + (let ((header (ly:book-header bookpart))) + (if (module? header) + (sort + (filter-map (lambda (entry) + (and (variable-bound? (cdr entry)) + (not (memq (car entry) ignored-header-fields)) + (cons (car entry) + (header-value (car entry) + (variable-ref (cdr entry)))))) + (module-map cons header)) + (lambda (a b) + (stringstring (car a)) + (symbol->string (car b))))) + '()))) + + ;; --- Lyrics -------------------------------------------------------------- + + ;; Silbentext (String oder Markup) als String. Eine Tilde verbindet als + ;; Lyric-Bindebogen zwei Woerter auf einer Note und wird zum Leerzeichen. + (define (syllable->string text) + (let ((s (cond ((string? text) text) + ((markup? text) (markup->string text)) + (else "")))) + (string-map (lambda (c) (if (char=? c #\~) #\space c)) s))) + + ;; Stanza-Beschriftung, wie sie gedruckt wuerde; vgl. handle-stanza-numbers + ;; bzw. refMarkupFormatter/bridgeMarkupFormatter in + ;; basic_format_and_style_settings.ily. text ist ein direkt per + ;; \set stanza = "..." gesetzter Wert und gewinnt. Mit roman? werden die + ;; Nummern roemisch formatiert (\romanStanza, z.B. fremdsprachige + ;; Originalstrophen). + (define (stanza-label type numbers text roman?) + (define (number->label n) + (if roman? (format #f "~@r" n) n)) + (define (joined-numbers) + (string-join (map (lambda (n) (ly:format "~a" (number->label n))) numbers) + ", ")) + (define (formatted plain with-numbers) + (if (null? numbers) + (ly:parser-lookup plain) + (ly:format (ly:parser-lookup with-numbers) (joined-numbers)))) + (cond + (text text) + ((eq? type 'ref) (formatted 'refString 'refStringWithNumbers)) + ((eq? type 'bridge) (formatted 'bridgeString 'bridgeStringWithNumbers)) + ((pair? numbers) + (string-join + (map (lambda (n) + (format #f (ly:parser-lookup 'stanzaFormat) (number->label n))) + numbers) + ", ")) + (else ""))) + + ;; Wandelt ein Lyrics-Music-Objekt (eine Zeile aus \addlyrics bzw. das + ;; Argument von \chordlyrics) in eine Liste von Eintraegen der Form + ;; (marked? nummern . ((stanza . "1.") (type . verse) (text . "Auf die ..."))) + ;; Silben werden an HyphenEvents wieder zu Woertern zusammengesetzt. + ;; Strophengrenzen ergeben sich aus den StanzaNumber-Overrides von + ;; #(stanza n), \ref und \bridge sowie aus \set stanza = "...". + ;; marked? ist #f fuer Fortsetzungsfragmente: Abschnitte ohne Marker oder + ;; mit dem Zeilenumbruch-Marker \set stanza = "-" (right-/leftHyphen). + ;; \set stanza mit Markup-Wert (Wiederholungszeichen, "D.S." usw.) ist + ;; reine Dekoration mitten im Vers und beginnt keine neue Strophe. + (define (lyric-line->stanzas lyrics) + (let ((stanzas '()) ; fertige Eintraege, rueckwaerts + (words '()) ; fertige Woerter der aktuellen Strophe, rueckwaerts + (word "") ; offene Silbenkette + (type #f) ; 'verse / 'ref / 'bridge + (numbers '()) ; Strophennummern + (set-label #f) ; direkt gesetztes \set stanza = "..." + (roman #f) ; \romanStanza: Nummern roemisch formatieren + (pending-override #f) ; \override-stanza vor dem naechsten Marker + (override-numbers #f)) ; gedruckte Nummern der aktuellen Strophe + (define (flush-word!) + (unless (string-null? word) + (set! words (cons word words)) + (set! word ""))) + (define (flush-stanza!) + (flush-word!) + (when (or type set-label (pair? words)) + (let ((display-numbers (or override-numbers numbers))) + (set! stanzas + (cons (cons* (if (or type (and set-label (not (string=? set-label "-")))) #t #f) + display-numbers + (list (cons 'stanza (stanza-label type display-numbers set-label roman)) + (cons 'type (or type 'verse)) + (cons 'text (string-join (reverse words) " ")))) + stanzas))) + (set! words '()) + (set! type #f) + (set! numbers '()) + (set! set-label #f) + (set! override-numbers #f))) + ;; Ein neuer Marker beendet die laufende Strophe, sobald schon Text da ist. + (define (marker!) + (when (or (pair? words) (not (string-null? word))) + (flush-stanza!))) + (define (handle-lyric-event m) + (let ((s (syllable->string (ly:music-property m 'text))) + (hyphen? (any (lambda (a) + (eq? (ly:music-property a 'name) 'HyphenEvent)) + (ly:music-property m 'articulations '())))) + ;; "_"-Skips (Melisma-Platzhalter) kommen als " " an und werden + ;; ignoriert; ein an einem Trennstrich offenes Wort ("ru -- _ hig") + ;; laeuft darueber weiter. + (unless (string-null? (string-trim-both s)) + (set! word (string-append word s)) + (unless hyphen? (flush-word!))))) + (define (handle-override m) + (when (eq? (ly:music-property m 'symbol) 'StanzaNumber) + (let ((path (ly:music-property m 'grob-property-path)) + (value (ly:music-property m 'grob-value))) + (cond + ((equal? path '(details custom-stanza-type)) + (marker!) + (set! type value) + ;; \override-stanza wirkt (\once) auf den naechsten Marker + (set! override-numbers pending-override) + (set! pending-override #f)) + ((equal? path '(details custom-stanza-numbers)) + (marker!) + (set! numbers (if (list? value) value (list value)))) + ((equal? path '(details custom-stanzanumber-override)) + (set! pending-override (if (list? value) value (list value)))) + ((equal? path '(style)) + (set! roman (eq? value 'roman))))))) + (define (handle-set m) + (let ((value (ly:music-property m 'value))) + ;; Nur String-Werte; Markups (Wiederholungszeichen etc.) sind + ;; Dekoration mitten im Vers und keine Strophengrenze. + (when (and (eq? (ly:music-property m 'symbol) 'stanza) + (string? value)) + (marker!) + (set! set-label value)))) + (define (walk m) + (case (ly:music-property m 'name) + ((LyricEvent) (handle-lyric-event m)) + ((OverrideProperty) (handle-override m)) + ((PropertySet) (handle-set m)) + (else + (let ((element (ly:music-property m 'element))) + (if (ly:music? element) (walk element)) + (for-each (lambda (e) (if (ly:music? e) (walk e))) + (ly:music-property m 'elements)))))) + (walk lyrics) + (flush-stanza!) + (merge-reprinted (reverse stanzas)))) + + ;; Beim Zeilenumbruch im Notenbild wird die Strophennummer manchmal erneut + ;; gedruckt (z.B. \firstVerseB #(stanza 1) \firstVerseC). Ein Marker + ;; direkt nach einer Strophe mit gleicher Kennung oder deren + ;; Nummern-Obermenge (#(stanza 2 3) nach Strophe 2) setzt diese fort, + ;; statt eine neue Strophe zu beginnen. + (define (merge-reprinted entries) + (let loop ((remaining entries) (acc '())) + (if (null? remaining) + (reverse acc) + (let ((entry (car remaining))) + (if (and (pair? acc) + (car entry) ; aktueller Eintrag markiert + (car (car acc)) ; vorheriger Eintrag markiert + (let* ((prev (car acc)) + (prev-alist (cddr prev)) + (alist (cddr entry)) + (prev-numbers (cadr prev)) + (prev-label (assq-ref prev-alist 'stanza))) + (or (and (not (string-null? prev-label)) + (string=? prev-label (assq-ref alist 'stanza))) + (and (eq? (assq-ref prev-alist 'type) + (assq-ref alist 'type)) + (pair? prev-numbers) + (every (lambda (n) (member n (cadr entry))) + prev-numbers))))) + (begin + (append-fragment-text! (cddr (car acc)) (cddr entry)) + (loop (cdr remaining) acc)) + (loop (cdr remaining) (cons entry acc))))))) + + ;; Haengt den Text eines Fortsetzungsfragments an eine Strophe an. + (define (append-fragment-text! target fragment) + (let ((target-cell (assq 'text target)) + (fragment-text (assq-ref fragment 'text))) + (unless (string-null? fragment-text) + (set-cdr! target-cell + (if (string-null? (cdr target-cell)) + fragment-text + (string-append (cdr target-cell) " " fragment-text)))))) + + ;; Fuegt die Strophen-Eintraege mehrerer Lyric-Zeilen (Ergebnisse von + ;; lyric-line->stanzas) zu einer flachen Strophenliste zusammen. Manche + ;; Lieder verteilen eine Strophe auf mehrere Zeilen unter den Noten + ;; (Fragmente mit \set stanza = "-" bzw. ohne Marker): Fortsetzungen + ;; werden innerhalb einer Zeile an die vorhergehende markierte Strophe + ;; angehaengt; Zeilen ganz ohne markierte Strophen positionsweise an die + ;; markierten Strophen der letzten Zeile, die welche hatte. + (define (merge-lyric-lines lines) + (let ((result '()) ; fertige Strophen-alists, rueckwaerts + (last-marked '())) ; markierte alists der letzten markierten Zeile + (for-each + (lambda (line) + (let ((line-marked (filter-map (lambda (e) (and (car e) (cddr e))) line))) + (if (and (null? line-marked) (pair? last-marked)) + ;; Zeile nur aus Fortsetzungen: k-tes Fragment an k-te + ;; markierte Strophe der Vorzeile, Ueberzaehlige an deren letzte. + (let loop ((entries line) (targets last-marked)) + (when (pair? entries) + (append-fragment-text! (car targets) (cddar entries)) + (loop (cdr entries) + (if (null? (cdr targets)) targets (cdr targets))))) + ;; Zeile mit markierten Strophen (oder erste Zeile ueberhaupt): + ;; Fortsetzungen an die vorhergehende Strophe der Zeile. + (begin + (let loop ((entries line) + (prev (if (pair? last-marked) (last last-marked) #f))) + (when (pair? entries) + (let ((marked? (caar entries)) + (stanza-alist (cddar entries))) + (if (or marked? (not prev)) + (begin + (set! result (cons stanza-alist result)) + (loop (cdr entries) stanza-alist)) + (begin + (append-fragment-text! prev stanza-alist) + (loop (cdr entries) prev)))))) + (when (pair? line-marked) + (set! last-marked line-marked)))))) + lines) + (reverse result))) + + ;; Gruppiert alle LyricCombineMusic-Objekte im music-Baum nach ihrer + ;; Stimme (associated-context, das \addlyrics/\lyricsto zuweisen). + ;; Liefert eine Liste von Gruppen (je eine Liste von Lyrics-Music- + ;; Objekten) in der Reihenfolge, in der die Stimmen zuerst auftauchen. + (define (voice-groups music) + (let* ((combines (extract-named-music music 'LyricCombineMusic)) + (contexts (delete-duplicates + (map (lambda (c) (ly:music-property c 'associated-context)) + combines)))) + (map (lambda (ctx) + (map (lambda (c) (ly:music-property c 'element)) + (filter (lambda (c) + (equal? (ly:music-property c 'associated-context) ctx)) + combines))) + contexts))) + + ;; Liefert die Strophen aller Stimmen unter den Noten, die selbst echte + ;; Strophen/Refrains/Bridges tragen (mindestens einen markierten + ;; Abschnitt haben, vgl. lyric-line->stanzas) -- filtert damit rein + ;; dekorative Gegen- oder Echostimmen heraus (z.B. wiederholte + ;; Lautmalerei ohne eigene Strophennummer). "Die erste Stimme im + ;; Dokument" ist dafuer kein verlaessliches Kriterium: welche Stimme + ;; die Hauptmelodie mit dem vollstaendigen Strophentext singt, wechselt + ;; von Lied zu Lied (mal Stimme 1, mal 2, je nach Satz). + ;; Qualifizierende Stimmen werden zusammengefuehrt (verschiedene + ;; Sprachfassungen tragen z.B. beide eigene Strophen); dabei bildet die + ;; Stimme mit den meisten eigenen Strophen ('verse, nicht Ref/Bridge) + ;; das Rueckgrat, in das die anderen einsortiert werden -- sonst wuerde + ;; ein von mehreren Stimmen gemeinsam gesungener Refrain, der im + ;; Dokument vor der eigentlichen Strophe auftaucht, deren Platz vor der + ;; Strophe 1 belegen. + (define (main-voice-lyrics music) + (define (verse-count stanzas) + (count (lambda (e) (eq? (assq-ref e 'type) 'verse)) stanzas)) + (define (any-marked? lines) (any (lambda (line) (any car line)) lines)) + (let* ((groups (map (lambda (group) (map lyric-line->stanzas group)) + (voice-groups music))) + (with-marks (filter any-marked? groups)) + ;; Der Ausschluss unmarkierter Stimmen lohnt nur, wenn es + ;; ueberhaupt eine ALTERNATIVE gibt: hat KEINE Stimme einen + ;; echten Strophenmarker, gibt es kein "Rueckgrat" zum + ;; Einsortieren -- dann wie frueher nur die erste Stimme nehmen + ;; (sonst wuerden z.B. mehrere Satzstimmen mit identischem, + ;; unmarkiertem Text ihren Kehrreim mehrfach liefern, weil sich + ;; unmarkierte Eintraege ohne Strophennummer nicht als Duplikat + ;; erkennen lassen). Nur EINE Stimme insgesamt ist ein + ;; Sonderfall davon (erste = einzige). + (qualifying (cond + ((pair? with-marks) with-marks) + ((pair? groups) (list (car groups))) + (else '()))) + (merged-per-group (map merge-lyric-lines qualifying)) + (ranked (sort (iota (length merged-per-group)) + (lambda (a b) (> (verse-count (list-ref merged-per-group a)) + (verse-count (list-ref merged-per-group b))))))) + (fold (lambda (i acc) (add-missing-stanzas acc (list-ref merged-per-group i))) + '() ranked))) + + ;; --- Textseiten-Strophen aus dem Render-Collector ------------------------ + + ;; Liest die Strophen der Textseiten aus dem per-Song-Store (chordpro.ily), + ;; den der ChordPro_score_collector beim Rendern der \chordlyrics-Scores + ;; fuellt. Dort ist Tag-Filterung, \override-stanza usw. bereits von + ;; LilyPond selbst entschieden -- unsichtbare Verse tauchen gar nicht + ;; erst auf. Die Dokumentreihenfolge liefert + ;; chordpro-song-ordered-verse-indices (die Interpretation laeuft + ;; rueckwaerts und bei mehrspaltigen group-verses verschraenkt). + ;; Liefert Eintraege wie lyric-line->stanzas: + ;; ((stanza . "2.") (type . verse) (text . "Die Haeuser ...")) + (define (collector-song->stanzas song) + ;; Silben eines Verses in Sammelreihenfolge; Eintrag: (moment text hyphen? idx) + (define (verse-syllables idx) + (reverse (filter (lambda (s) (= (cadddr s) idx)) + (chordpro-song-syllables song)))) + ;; Gedruckte Labels koennen Wiederholungszeichen tragen ("2.𝄆") -- + ;; die gehoeren nicht ins Label. + (define (clean-label s) + (string-trim-both + (string-delete (lambda (c) (memv c '(#\𝄆 #\𝄇))) s))) + ;; Silben zu Woertern: Trennstriche verbinden, "_"-Extender (kommen als + ;; Whitespace an) werden ueberlaufen, ohne das offene Wort zu schliessen. + (define (syllables->text syls) + (let loop ((rest syls) (word "") (words '())) + (if (null? rest) + (string-join + (reverse (if (string-null? word) words (cons word words))) + " ") + (let* ((s (syllable->string (cadr (car rest)))) + (hyphen? (caddr (car rest)))) + (if (string-null? (string-trim-both s)) + (loop (cdr rest) word words) + (if hyphen? + (loop (cdr rest) (string-append word s) words) + (loop (cdr rest) "" + (cons (string-append word s) words)))))))) + (filter-map + (lambda (idx) + (let ((syls (verse-syllables idx)) + (entry (assoc idx (chordpro-song-stanza-numbers song)))) + (and (pair? syls) + (list (cons 'stanza (clean-label + (or (and entry (cadr entry)) ""))) + (cons 'type (or (and entry (caddr entry)) 'verse)) + (cons 'text (syllables->text syls)))))) + (chordpro-song-ordered-verse-indices song))) + + ;; Dieselbe Strophe? Gleiche Kennung allein reicht nicht: zweisprachige + ;; Lieder nutzen dieselben Nummern fuer Uebersetzung und Original. Die + ;; Texte muessen sich auch aehneln (mindestens die Haelfte der Woerter + ;; der kuerzeren Fassung kommt in der laengeren vor). + (define (same-stanza-text? a b) + (define (word-list s) + (map string-downcase (string-tokenize s char-set:letter))) + (let* ((wa (word-list a)) + (wb (word-list b)) + (shorter (if (<= (length wa) (length wb)) wa wb)) + (longer (if (<= (length wa) (length wb)) wb wa))) + (or (null? shorter) + (>= (count (lambda (w) (member w longer)) shorter) + (/ (length shorter) 2))))) + + ;; Wie merge-stanza-lists, aber bei Konflikt gewinnt BASE statt der + ;; einzumischenden Liste: fuer das Zusammenfuehren mehrerer Hauptstimmen- + ;; Kandidaten (main-voice-lyrics), wo die 'reichste' Stimme (meiste + ;; eigene Strophen) die kanonische Fassung liefert und andere Stimmen + ;; nur FEHLENDE Strophen ergaenzen duerfen -- z.B. wenn Sopran und Alt + ;; beide "1." tragen, der Alt aber eine gekuerzte Textvariante singt + ;; (vgl. Sieh_des_Herbstes_Geisteshelle: infotext "Strophenteile in + ;; Klammern sind die Textvarianten im Alt"). + (define (add-missing-stanzas base additional) + (fold + (lambda (entry acc) + (let* ((key (assq-ref entry 'stanza)) + (found (and (not (string-null? key)) + (not (string=? key "-")) + (find (lambda (e) (and (equal? (assq-ref e 'stanza) key) + (same-stanza-text? + (assq-ref e 'text) + (assq-ref entry 'text)))) + acc)))) + (if found acc (append acc (list entry))))) + base + additional)) + + ;; Fuegt Musik- und Textseiten-Strophen zusammen: gleiche Strophen nur + ;; einmal, wobei die Fassung aus den Textseiten die unter den Noten + ;; ersetzt (dort steht meist die vollstaendige Fassung). + (define (merge-stanza-lists music-stanzas text-stanzas) + (let loop ((merged music-stanzas) (remaining text-stanzas)) + (if (null? remaining) + merged + (let* ((entry (car remaining)) + (key (assq-ref entry 'stanza)) + (found (and (not (string-null? key)) + (not (string=? key "-")) + (find (lambda (e) + (and (equal? (assq-ref e 'stanza) key) + (same-stanza-text? + (assq-ref e 'text) + (assq-ref entry 'text)))) + merged)))) + (loop (if found + (map (lambda (e) (if (eq? e found) entry e)) merged) + (append merged (list entry))) + (cdr remaining)))))) + + ;; Extrahiert alle Strophen/Refrain/Bridge-Texte eines Liedes: die Strophen + ;; unter den Noten aus music (die Hauptstimme(n), siehe main-voice-lyrics), + ;; die Textstrophen aus dem Render-Collector-Store des Liedes (song, darf + ;; #f sein). + (define (extract-lyrics music song) + (merge-stanza-lists + (main-voice-lyrics music) + (if song (collector-song->stanzas song) '()))) + + ;; --- Hauptfunktion ----------------------------------------------------- + + ;; Liefert das erste Music-Objekt mit gegebenem Namen (oder #f). + (define (first-named-music music music-name) + (let ((matches (extract-named-music music music-name))) + (and (pair? matches) (car matches)))) + + ;; Nimmt ly:music entgegen und liefert eine alist mit String-Werten. + (define (music->data-alist music) + (let* ((time-m (first-named-music + music '(TimeSignatureMusic ReferenceTimeSignatureMusic))) + (key-m (first-named-music music 'KeyChangeEvent)) + (tempo-m (first-named-music music 'TempoChangeEvent)) + (time-s (and time-m (time-music->string time-m))) + (key-s (and key-m (key-music->string key-m))) + (tempo-s (and tempo-m (tempo-music->string tempo-m)))) + (append + (if time-s (list (cons 'time time-s)) '()) + (if key-s (list (cons 'key key-s)) '()) + (if tempo-s (list (cons 'tempo tempo-s)) '())))) + + ;; song ist der per-Song-Store-Eintrag aus chordpro.ily (oder #f, wenn + ;; keine Textseiten gerendert wurden) -- er liefert die Textseiten- + ;; Strophen. Darf erst NACH dem Rendern der Textseiten aufgerufen + ;; werden (delayed stencil), vorher ist der Store leer. song-id ist + ;; der Liedname (Einzellied: Ausgabename; Buch: der bei \includeSong + ;; angegebene Dateiname) und landet unter dem Key song_id. + (define (extract-song-data header music song song-id) + (let ((header-alist (bookpart->header-alist header)) + (music-alist (music->data-alist music)) + (lyrics-list (extract-lyrics music song))) + (append header-alist + (list (cons 'song_id song-id) + (cons 'musical music-alist) + (cons 'lyrics lyrics-list))))) + + ;; Unsichtbarer Stencil fuer die Einzellied-YAML: schreibt .yml + ;; per delay-stencil-evaluation erst bei der Ausgabe, wenn der + ;; Render-Collector alle Textseiten-Strophen gesammelt hat. header und + ;; music werden beim Anhaengen (Parse-Zeit in layout_bottom) gebunden. + (define (yaml-delayed-song-write key header music) + (ly:make-stencil + `(delay-stencil-evaluation + ,(delay (begin + (scm->yml-file (string-append key ".yml") + (extract-song-data header music + (hash-ref chordpro-song-store key) + key)) + empty-stencil)))))) diff --git a/private_includes/base/scm/yaml_parser.scm b/private_includes/base/scm/yaml_parser.scm index 420d447..4b159f8 100644 --- a/private_includes/base/scm/yaml_parser.scm +++ b/private_includes/base/scm/yaml_parser.scm @@ -1,154 +1,259 @@ -(use-modules (ice-9 rdelim) (ice-9 regex) (ice-9 pretty-print) (srfi srfi-1)) +(use-modules (ice-9 rdelim) (ice-9 regex) (ice-9 receive) (srfi srfi-1)) + +;; YAML-Parser: liest eine Teilmenge von YAML (Block-Syntax, keine +;; Flow-Collections, keine Block-Skalare) in verschachtelte +;; alist/list-Strukturen. Gegenstück zu yaml_writer.scm. +;; +;; Ergebnisformat: +;; - Mapping -> alist mit String-Keys, Reihenfolge wie in der Datei +;; - Liste -> Liste (auch als "- key: value"-Inline-Mappings) +;; - Skalare -> String, Zahl, #t/#f, '() (null / {} / []) +;; +;; Skalar-Interpretation: +;; - unquoted und 'single-quoted' Werte werden interpretiert +;; (Zahl, true/false/null). Das Interpretieren von single-quoted +;; Werten ist Kompatibilitätsverhalten zum alten Parser: +;; authors.yml notiert Zahlen als '1898'. +;; - "double-quoted" Werte bleiben immer Strings; \\, \" und \n +;; werden entescaped (so schreibt sie der yaml_writer). +;; - Kommentare (#) werden nur außerhalb von Quotes entfernt und nur, +;; wenn ihnen ein Leerzeichen oder der Zeilenanfang vorausgeht. -;; Hauptparsingfunktion (define (yml-file->scm filename) - ;; Utility: Zeile einlesen - (define (read-lines filename) + ;; --- Zeilen einlesen ------------------------------------------------ + + ;; Anzahl führender Leerzeichen + (define (line-indent line) + (let loop ((i 0)) + (if (and (< i (string-length line)) + (char=? (string-ref line i) #\space)) + (loop (+ i 1)) + i))) + + ;; Liefert Items (indent . inhalt); Leerzeilen, reine Kommentarzeilen + ;; und Dokumentmarker (--- / ...) werden übersprungen. + (define (read-items filename) (call-with-input-file filename (lambda (port) - (let loop ((lines '())) + (let loop ((items '())) (let ((line (read-line port))) (if (eof-object? line) - (reverse lines) - (let ((clean (string-trim line))) - (if (or (string=? clean "---") (string-null? clean)) - (loop lines) ;; Ignoriere "---" oder leere Zeile - (loop (cons line lines)))))))))) + (reverse items) + (let* ((line (if (string-suffix? "\r" line) + (string-drop-right line 1) + line)) + (content (string-trim-both line))) + (if (or (string-null? content) + (string-prefix? "#" content) + (string=? content "---") + (string=? content "...")) + (loop items) + (loop (cons (cons (line-indent line) content) + items)))))))))) - ;; Einrückung bestimmen (Anzahl Leerzeichen am Anfang) - (define (line-indent line) - (let ((match (string-match "^ *" line))) - (if match - (match:end match) ; Anzahl der Leerzeichen = Position nach Leerzeichen - 0))) ; Falls kein Match → 0 + (define (item-indent item) (car item)) + (define (item-content item) (cdr item)) - ;; Kommentar entfernen - (define (strip-comment line) - (let ((m (string-match "#.*" line))) - (if m - (string-trim-right (string-take line (match:start m))) - line))) + ;; --- Skalare ---------------------------------------------------------- - ;; Hilfsfunktion: Whitespace entfernen - (define (clean-line line) - (string-trim (strip-comment line))) + ;; Position des schließenden Double-Quotes ab start (oder #f); + ;; Backslash escaped das Folgezeichen. + (define (closing-double-quote s start) + (let loop ((i start)) + (cond ((>= i (string-length s)) #f) + ((char=? (string-ref s i) #\\) (loop (+ i 2))) + ((char=? (string-ref s i) #\") i) + (else (loop (+ i 1)))))) - ;; Ist Zeile leer (nach Entfernen von Kommentar & Whitespace)? - (define (blank-or-comment? line) - (string-null? (clean-line line))) + ;; Position des schließenden Single-Quotes ab start (oder #f); + ;; '' ist ein escaptes Quote. + (define (closing-single-quote s start) + (let loop ((i start)) + (cond ((>= i (string-length s)) #f) + ((char=? (string-ref s i) #\') + (if (and (< (+ i 1) (string-length s)) + (char=? (string-ref s (+ i 1)) #\')) + (loop (+ i 2)) + i)) + (else (loop (+ i 1)))))) - ;; Skalare Werte interpretieren + ;; \\ -> \, \" -> ", \n -> Zeilenumbruch + (define (unescape-double s) + (let loop ((chars (string->list s)) (acc '())) + (cond ((null? chars) (list->string (reverse acc))) + ((and (char=? (car chars) #\\) (pair? (cdr chars))) + (loop (cddr chars) + (cons (if (char=? (cadr chars) #\n) + #\newline + (cadr chars)) + acc))) + (else (loop (cdr chars) (cons (car chars) acc)))))) + + ;; '' -> ' + (define (unescape-single s) + (regexp-substitute/global #f "''" s 'pre "'" 'post)) + + ;; Kommentar in einem unquoted Wert entfernen: + ;; # zählt nur am Anfang oder nach Leerzeichen + (define (strip-plain-comment s) + (let loop ((i 0)) + (cond ((>= i (string-length s)) s) + ((and (char=? (string-ref s i) #\#) + (or (zero? i) + (char-whitespace? (string-ref s (- i 1))))) + (string-take s i)) + (else (loop (+ i 1)))))) + + ;; Unquoted/single-quoted Werte interpretieren + (define (interpret-plain s) + (cond + ((member s '("{}" "[]" "null")) '()) + ((string=? s "true") #t) + ((string=? s "false") #f) + ((string-match "^-?[0-9]+(\\.[0-9]+)?$" s) (string->number s)) + (else s))) + + ;; Skalar parsen; Rest hinter einem schließenden Quote wird ignoriert + ;; (darf nur ein Kommentar sein) (define (parse-scalar str) - (define (strip-quotes s) + (let ((s (string-trim-both str))) (cond - ((and (string-prefix? "\"" s) (string-suffix? "\"" s)) - (string-drop-right (string-drop s 1) 1)) - ((and (string-prefix? "'" s) (string-suffix? "'" s)) - (string-drop-right (string-drop s 1) 1)) - (else s))) - (let ((s (strip-quotes (string-trim str)))) + ((string-null? s) "") + ((char=? (string-ref s 0) #\") + (let ((end (closing-double-quote s 1))) + (if end + (unescape-double (substring s 1 end)) + (string-trim-right (strip-plain-comment s))))) + ((char=? (string-ref s 0) #\') + (let ((end (closing-single-quote s 1))) + (if end + (interpret-plain (unescape-single (substring s 1 end))) + (string-trim-right (strip-plain-comment s))))) + (else + (interpret-plain (string-trim-right (strip-plain-comment s))))))) + + ;; --- Struktur ---------------------------------------------------------- + + ;; Erste Key-Trennstelle: ":" am Zeilenende oder gefolgt von Leerzeichen. + ;; Beginnt die Zeile mit einem gequoteten Key (oder Skalar), zaehlt ein + ;; ":" innerhalb der Quotes nicht als Trennstelle. + (define (key-split-index s) + (let ((start (if (string-null? s) + 0 + (case (string-ref s 0) + ((#\") (let ((end (closing-double-quote s 1))) + (if end (+ end 1) 0))) + ((#\') (let ((end (closing-single-quote s 1))) + (if end (+ end 1) 0))) + (else 0))))) + (let loop ((i start)) + (cond ((>= i (string-length s)) #f) + ((and (char=? (string-ref s i) #\:) + (or (= i (- (string-length s) 1)) + (char=? (string-ref s (+ i 1)) #\space))) + i) + (else (loop (+ i 1))))))) + + ;; Key interpretieren: gequotete Keys werden entquotet (Strings bleiben + ;; Strings), unquoted Keys bleiben unveraendert + (define (parse-key s) + (let ((k (string-trim-both s))) (cond - ((string=? s "{}") '()) ;; leere Map - ((string=? s "[]") '()) ;; leere Liste - ((string-match "^[0-9]+$" s) (string->number s)) - ((string=? s "true") #t) - ((string=? s "false") #f) - ((string=? s "null") '()) - (else s)))) + ((string-null? k) k) + ((char=? (string-ref k 0) #\") + (let ((end (closing-double-quote k 1))) + (if end (unescape-double (substring k 1 end)) k))) + ((char=? (string-ref k 0) #\') + (let ((end (closing-single-quote k 1))) + (if end (unescape-single (substring k 1 end)) k))) + (else k)))) + (define (dash-line? content) + (or (string=? content "-") (string-prefix? "- " content))) - ;; Hilfsfunktion: Zeilen mit gleicher oder höherer Einrückung sammeln - (define (take-indented lines min-indent) - (let loop ((ls lines) (acc '())) - (if (null? ls) - (reverse acc) - (let ((line (car ls))) - (if (or (blank-or-comment? line) - (>= (line-indent line) min-indent)) - (loop (cdr ls) (cons line acc)) - (reverse acc)))))) + ;; Wert-String hinter "key:" bzw. "-": reiner Kommentar zählt als leer + (define (effective-value str) + (let ((s (string-trim-both str))) + (if (string-prefix? "#" s) "" s))) - ;; Hilfsfunktion: N Zeilen überspringen - (define (drop lst n) - (let loop ((l lst) (i n)) - (if (or (zero? i) (null? l)) - l - (loop (cdr l) (- i 1))))) + ;; Einen Block von Items parsen; das erste Item bestimmt die Blockart + (define (parse-block items) + (cond + ((null? items) '()) + ((dash-line? (item-content (car items))) (parse-list items)) + ;; einzelne Zeile ohne Key: Skalar (z.B. eine Datei, die nur {} enthält) + ((and (null? (cdr items)) + (not (key-split-index (item-content (car items))))) + (parse-scalar (item-content (car items)))) + (else (parse-map items)))) - ;; Listenparsing: Liest Zeilen mit `-` als Listeneinträge - (define (parse-list lines current-indent) - (let loop ((ls lines) (result '())) - (if (null? ls) - (reverse result) - (let* ((line (clean-line (car ls)))) - (if (string-match "^-" line) - (let* ((indent (line-indent (car ls))) - (item-str (string-trim (string-drop line 1))) - (next-lines (cdr ls))) - (if (or (null? next-lines) - (> (line-indent (car next-lines)) indent)) - ;; Verschachtelter Inhalt - (let* ((sub (take-indented next-lines (+ indent 2))) - (parsed (if (null? sub) - (parse-scalar item-str) - (parse-lines sub (+ indent 2)))) - (remaining (drop next-lines (length sub)))) - (loop remaining (cons parsed result))) - ;; Einfacher Skalar - (loop next-lines (cons (parse-scalar item-str) result)))) - ;; Nicht mehr Teil der Liste - (reverse result)))))) + ;; Mapping: alle Items auf map-indent sind Keys, tiefer eingerückte + ;; Items gehören zum jeweils vorangehenden Key + (define (parse-map items) + (let ((map-indent (item-indent (car items)))) + (let loop ((items items) (result '())) + (if (null? items) + (reverse result) + (let* ((content (item-content (car items))) + (split (key-split-index content))) + (if (not split) + (begin + (format (current-error-port) + "YAML-Syntaxfehler: Ungültige Zeile: ~a\n" content) + (loop (cdr items) result)) + (let ((key (parse-key (string-take content split))) + (value-str (effective-value + (string-drop content (+ split 1))))) + (if (string-null? value-str) + ;; Wert steht im eingerückten Block darunter + (receive (children rest) + (span (lambda (it) (> (item-indent it) map-indent)) + (cdr items)) + (loop rest + (cons (cons key (parse-block children)) + result))) + (loop (cdr items) + (cons (cons key (parse-scalar value-str)) + result)))))))))) - ;; Hauptparser für Key-Value oder Listen - (define (parse-lines lines current-indent) - (let loop ((ls lines) (result '())) - (if (null? ls) - (reverse result) - (let* ((raw-line (car ls)) - (line (clean-line raw-line))) - (cond - ;; Kommentar oder leere Zeile - ((blank-or-comment? raw-line) - (loop (cdr ls) result)) + ;; Liste: "- wert", "- key: value" (Inline-Mapping) oder "-" mit + ;; eingerücktem Block darunter + (define (parse-list items) + (let ((list-indent (item-indent (car items)))) + (let loop ((items items) (result '())) + (if (null? items) + (reverse result) + (let ((content (item-content (car items)))) + (if (not (dash-line? content)) + (begin + (format (current-error-port) + "YAML-Syntaxfehler: Ungültiges Listenelement: ~a\n" + content) + (loop (cdr items) result)) + (receive (children rest) + (span (lambda (it) (> (item-indent it) list-indent)) + (cdr items)) + (let* ((after-dash (string-drop content 1)) + (inline (effective-value after-dash))) + (cond + ((and (string-null? inline) (null? children)) + (loop rest (cons '() result))) + ((string-null? inline) + (loop rest (cons (parse-block children) result))) + (else + ;; Inline-Inhalt: als synthetisches Item mit der + ;; Spalte des Inhalts vor die Kinder stellen, so + ;; funktioniert auch "- key: value" mit weiteren + ;; Keys auf den Folgezeilen + (let* ((offset (- (string-length content) + (string-length + (string-trim after-dash)))) + (synth (cons (+ list-indent offset) inline))) + (loop rest + (cons (parse-block (cons synth children)) + result))))))))))))) - ;; Liste - ((string-match "^- " line) - (let ((list-lines (take-indented ls current-indent))) - (let ((parsed-list (parse-list list-lines current-indent))) - (loop (drop ls (length list-lines)) - (cons parsed-list result))))) - - ;; Key: Value - ((string-match "^[^:]+:" line) - (let* ((kv (string-split line #\:)) - (key (string-trim (car kv))) - (value-str (string-trim (string-join (cdr kv) ":"))) - (next-lines (cdr ls))) - (if (string-null? value-str) - ;; Wert auf nachfolgender Einrückungsebene - (let* ((sub (take-indented next-lines (+ current-indent 2))) - (parsed (parse-lines sub (+ current-indent 2))) - (remaining (drop next-lines (length sub)))) - (loop remaining - (cons (cons key parsed) result))) - ;; Einfacher Key:Value - (loop next-lines - (cons (cons key (parse-scalar value-str)) result))))) - - ;; Fehlerhafte Zeile - (else - ;; Vermeide Fehlermeldung für Leerzeilen oder leere Objekte - (if (or (string-null? (string-trim line)) - (member line '("{}" "[]"))) - (loop (cdr ls) result) - (begin - (format (current-error-port) - "Syntaxfehler: Ungültige Zeile: ~a\n" raw-line) - (loop (cdr ls) result)))) - ))))) - - (let ((lines (read-lines filename))) - (parse-lines lines 0))) + (parse-block (read-items filename))) (define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename))) diff --git a/private_includes/base/scm/yaml_writer.scm b/private_includes/base/scm/yaml_writer.scm new file mode 100644 index 0000000..eaf4a60 --- /dev/null +++ b/private_includes/base/scm/yaml_writer.scm @@ -0,0 +1,162 @@ +(use-modules (ice-9 regex) (srfi srfi-1)) + +;; YAML-Writer: Gegenstück zu yaml_parser.scm. +;; Schreibt verschachtelte alist/list-Strukturen als YAML, so dass +;; yml-file->scm sie wieder einlesen kann. +;; +;; Datenmodell (wie vom Parser erzeugt): +;; - Mapping: Liste von Paaren (key . value), key als String oder Symbol +;; - Liste: Liste von beliebigen Werten +;; - Skalare: String, Zahl, #t/#f, '() (leer/null, wird als [] geschrieben) +;; +;; Andere Werte werden vorab automatisch umgewandelt: Markups zu Strings, +;; alles Unbekannte über ~a formatiert (siehe yml-sanitize). + +;; Steuert, ob layout_bottom.ily die Header-Daten des Liedes als +;; YAML-Datei exportiert; aktivierbar per (set! yaml-export-enabled #t) +;; oder durch Definieren der Variable vor dem Laden der Includes. +(define yaml-export-enabled + (if (defined? 'yaml-export-enabled) yaml-export-enabled #f)) + +;; Beliebige Werte in YAML-taugliche Daten umwandeln. +;; (Benötigt die LilyPond-Umgebung für markup? und markup->string.) +(define (yml-sanitize v) + (cond + ((or (string? v) (number? v) (boolean? v) (symbol? v) (null? v)) v) + ((markup? v) (markup->string v)) + ((list? v) (map yml-sanitize v)) + ((pair? v) (cons (yml-sanitize (car v)) (yml-sanitize (cdr v)))) + (else (format #f "~a" v)))) + +(define (scm->yml-string data) + + ;; Ist data ein Mapping (alist)? Nicht-leere Liste, deren Elemente + ;; alle Paare mit String- oder Symbol-Key sind. + ;; Achtung: eine Liste von Listen, deren erste Elemente Strings sind, + ;; ist davon nicht unterscheidbar und wird als Mapping interpretiert. + (define (mapping? data) + (and (pair? data) + (list? data) + (every (lambda (entry) + (and (pair? entry) + (or (string? (car entry)) + (symbol? (car entry))))) + data))) + + (define (scalar? v) + (or (string? v) (symbol? v) (number? v) (boolean? v) (null? v))) + + (define (key->string k) + (if (symbol? k) (symbol->string k) k)) + + ;; Muss der String gequotet werden, damit er beim Einlesen wieder + ;; als derselbe String erkannt wird? + (define (needs-quotes? s) + (or (string-null? s) + (member s '("true" "false" "null" "{}" "[]")) + (string->number s) ;; zahlartig ("1981", "1.", "-5") würde zur Zahl + (string-index s #\#) ;; würde als Kommentar abgeschnitten + (string-index s #\:) ;; würde als Key: Value gelesen + (string-index s #\newline) ;; mehrzeilig + (string-index s #\") + (string-prefix? "-" s) ;; würde als Listenelement gelesen + (string-prefix? "'" s) + (not (string=? s (string-trim-both s))))) ;; führende/folgende Leerzeichen + + ;; Doppelt gequoteter YAML-String; Backslash, Anführungszeichen und + ;; Zeilenumbrüche werden escaped, damit alles auf einer Zeile bleibt. + (define (quote-string s) + (string-append + "\"" + (string-concatenate + (map (lambda (c) + (cond + ((char=? c #\\) "\\\\") + ((char=? c #\") "\\\"") + ((char=? c #\newline) "\\n") + (else (string c)))) + (string->list s))) + "\"")) + + (define (scalar->string v) + (cond + ((eq? v #t) "true") + ((eq? v #f) "false") + ((null? v) "[]") + ((number? v) (number->string v)) + ((symbol? v) (scalar->string (symbol->string v))) + ((string? v) (if (needs-quotes? v) (quote-string v) v)) + (else (error "scm->yml-string: nicht unterstützter Wert" v)))) + + (define (indent-string n) (make-string n #\space)) + + ;; Key ggf. quoten (leere oder zahlartige Keys, Sonderzeichen) + (define (key->yml-string k) + (let ((s (key->string k))) + (if (needs-quotes? s) (quote-string s) s))) + + ;; Doppelte Keys sind in YAML nicht erlaubt: Werte gleicher Keys werden + ;; zu einer Liste zusammengefasst, z.B. authors mit (voice 2) (voice 3) + ;; -> voice: [2, 3]. + (define (merge-duplicate-keys data) + (define (value->list v) + (if (and (list? v) (not (mapping? v))) v (list v))) + (let loop ((entries data) (result '())) + (if (null? entries) + (reverse result) + (let* ((entry (car entries)) + (existing (find (lambda (e) (equal? (car e) (car entry))) + result))) + (if existing + (begin + (set-cdr! existing (append (value->list (cdr existing)) + (value->list (cdr entry)))) + (loop (cdr entries) result)) + (loop (cdr entries) + (cons (cons (car entry) (cdr entry)) result))))))) + + ;; Mapping schreiben: "key: skalar" oder "key:" mit eingerücktem Inhalt + (define (write-mapping data indent port) + (for-each + (lambda (entry) + (let ((key (key->yml-string (car entry))) + (value (cdr entry))) + (if (scalar? value) + (format port "~a~a: ~a\n" + (indent-string indent) key (scalar->string value)) + (begin + (format port "~a~a:\n" (indent-string indent) key) + (write-node value (+ indent 2) port))))) + (merge-duplicate-keys data))) + + ;; Liste schreiben: "- skalar" oder "-" mit eingerücktem Inhalt + ;; (Verschachtelter Inhalt darf NICHT auf der "-"-Zeile beginnen, + ;; weil parse-list den Inhalt der "-"-Zeile verwirft, sobald + ;; eingerückte Folgezeilen existieren.) + (define (write-list data indent port) + (for-each + (lambda (item) + (if (scalar? item) + (format port "~a- ~a\n" + (indent-string indent) (scalar->string item)) + (begin + (format port "~a-\n" (indent-string indent)) + (write-node item (+ indent 2) port)))) + data)) + + (define (write-node data indent port) + (cond + ((mapping? data) (write-mapping data indent port)) + ((and (list? data) (not (null? data))) (write-list data indent port)) + (else (format port "~a~a\n" (indent-string indent) (scalar->string data))))) + + (call-with-output-string + (lambda (port) (write-node (yml-sanitize data) 0 port)))) + +;; Daten als YAML-Datei schreiben +(define (scm->yml-file filename data) + (call-with-output-file filename + (lambda (port) + (display "---\n" port) + (display (scm->yml-string data) port)))) + diff --git a/private_includes/base/verses_with_chords.ily b/private_includes/base/verses_with_chords.ily index 78b5919..0d5f3d1 100644 --- a/private_includes/base/verses_with_chords.ily +++ b/private_includes/base/verses_with_chords.ily @@ -182,7 +182,19 @@ ((if reverses fold fold-right) (lambda (element filled-list) (cons element (if (null? filled-list) '() (cons markup-between filled-list)))) '() elements)) - (let* ((column-item-count (ceiling (/ (length versegroup) verse-cols))) + ;; Dokumentposition fuer den ChordPro-/Data-Collector: jede Gruppe nimmt + ;; sich eine Sequenznummer, jeder Vers traegt seine Position innerhalb + ;; der Gruppe in den Props -- die Spalten-Verteilung unten verschraenkt + ;; sonst die Interpretationsreihenfolge. + (set! chordpro-doc-seq-counter (1+ chordpro-doc-seq-counter)) + (let* ((doc-seq chordpro-doc-seq-counter) + (versegroup (index-map + (lambda (index item) + (make-override-markup + (cons 'chordpro-doc-order (cons doc-seq index)) + item)) + versegroup)) + (column-item-count (ceiling (/ (length versegroup) verse-cols))) (column-data (make-list verse-cols))) (let columnize-list ((index 0) (items versegroup)) (if (not (null? items)) @@ -341,6 +353,20 @@ Chord_lyrics_spacing_engraver = (transposition (cons #f #f)) (verselayout generalLayout)) "Vers mit Akkorden" + ;; Dem ChordPro-Collector sagen, zu welchem Lied dieser Vers gehoert + ;; (Buch: songfilename aus den Props via \setsongfilename; Einzellied: + ;; Fallback-Key aus layout_bottom). Die Score-Interpretation darunter + ;; laeuft synchron, der Engraver liest den Key in initialize. Die Props + ;; braucht er zum Aufloesen von Markup-Silben (tags-to-keep). + (set! chordpro-active-song-key (chordpro-resolve-song-key props)) + (set! chordpro-active-props props) + ;; Dokumentposition: von \group-verses gestempelt; ausserhalb einer + ;; Gruppe nimmt sich der Vers selbst eine Sequenznummer. + (set! chordpro-active-doc-order + (or (chain-assoc-get 'chordpro-doc-order props #f) + (begin + (set! chordpro-doc-seq-counter (1+ chordpro-doc-seq-counter)) + (cons chordpro-doc-seq-counter 0)))) (interpret-markup layout props #{ \markup { diff --git a/private_includes/book/book_include.ily b/private_includes/book/book_include.ily index 43f80e2..c1aea52 100644 --- a/private_includes/book/book_include.ily +++ b/private_includes/book/book_include.ily @@ -65,6 +65,26 @@ additionalPageNumbers = display-pages-list ) +% Fuer Zusatzseiten: Label der ersten Seite des zusammenhaengenden +% Zusatzseiten-Blocks, zu dem label gehoert (bestimmt den Buchstaben-Suffix a, b, ...). +#(define (earliest-additional-label label) + (let find-earliest-additional-label + ((rest-additional-page-switch-label-list (member (cons label #t) additional-page-switch-label-list))) + (if (cdadr rest-additional-page-switch-label-list) + (find-earliest-additional-label (cdr rest-additional-page-switch-label-list)) + (caar rest-additional-page-switch-label-list)))) + +% Sichtbare Seitenzahl der Seite mit diesem Label: normalerweise eine Zahl, +% auf Zusatzseiten ein String mit Buchstaben-Suffix (z.B. "12a"); gleiche +% Logik wie custom-page-number unten. +#(define (visible-page-value layout label) + (let ((display-page (assq-ref (build-display-pages-list layout) label))) + (if (assq-ref additional-page-switch-label-list label) + (ly:format "~a~a" display-page + (string (integer->char (+ 97 (- (real-page-number layout label) + (real-page-number layout (earliest-additional-label label))))))) + display-page))) + % TODO: % Eigentlich können wir das direkt in oddFooderMarkup und evenFooterMarkup aufrufen % vermutlich sogar ohne den delay kram. Wir sollten außerdem einfach nur die property @@ -97,12 +117,7 @@ width may require additional tweaking.)" (if (assq-ref additional-page-switch-label-list label) (make-concat-markup (list (number-format number-type display-page) (make-char-markup (+ 97 (- real-current-page (real-page-number layout - (let find-earliest-additional-label - ((rest-additional-page-switch-label-list (member (cons label #t) additional-page-switch-label-list))) - (if (cdadr rest-additional-page-switch-label-list) - (find-earliest-additional-label (cdr rest-additional-page-switch-label-list)) - (caar rest-additional-page-switch-label-list))) - )))))) + (earliest-additional-label label))))))) (number-format number-type (+ display-page (- real-current-page (real-page-number layout label)))) )) (page-stencil (interpret-markup layout props page-markup)) @@ -118,6 +133,79 @@ width may require additional tweaking.)" (make-filled-box-stencil x-ext y-ext)))) +%% Schreibt die Daten aller Lieder des Buchs (extract-song-data, siehe +%% data_extractor.ily) als YAML-Datei: oberster Key contents, darunter eine +%% Liste mit den Lied-Daten, jeweils angereichert um den Key page mit der +%% sichtbaren Seitenzahl des Liedanfangs. Einbinden wie \write-toc-csv in +%% einem Markup des Buchs; wie dort passiert das Schreiben ueber ein +%% delayed stencil, weil die Label->Seiten-Tabelle erst beim Ausgeben des +%% Buchs feststeht. Der Dateiname ist der Ausgabename des Buchs +%% (\bookOutputName, sonst der .ly-Basisname) mit angehaengtem .yml -- +%% landet also wie das PDF relativ zum Arbeitsverzeichnis. +#(define-markup-command (write-book-yaml layout props) () + (let ((filename (string-append (ly:parser-output-name) ".yml"))) + (ly:make-stencil + `(delay-stencil-evaluation + ,(delay + (begin + (scm->yml-file filename + (list (cons 'contents + (map (lambda (song) + (let ((songvars (cdr song))) + (cons (cons 'page (visible-page-value layout (assq-ref songvars 'label))) + (extract-song-data (assq-ref songvars 'header) + (assq-ref songvars 'music) + ;; Textseiten-Strophen aus dem Render- + ;; Collector-Store (Key = Liedname); beim + ;; Ausgeben des Buchs sind alle Textseiten + ;; bereits interpretiert. + (hash-ref chordpro-song-store + (symbol->string (car song))) + (symbol->string (car song)))))) + (reverse (alist-delete 'markupPage + (alist-delete 'imagePage + (alist-delete 'emptyPage song-list)))))))) + empty-stencil)))))) + +%% Schreibt den ChordPro-Export aller Lieder des Buchs (in Dokument- +%% reihenfolge) als EINE Datei statt als Einzeldateien pro Lied. Lieder +%% werden mit der ChordPro-Direktive {new_song} getrennt; vor dem ersten +%% Lied ist sie nicht noetig, sie gilt am Dateianfang implizit (siehe +%% https://www.chordpro.org/chordpro/directives-new_song/). Einbinden wie +%% \write-book-yaml an beliebiger Stelle im Buch -- unabhaengig von +%% chordpro-export-enabled (das steuert nur den Pro-Song-Export), beide +%% Befehle koennen auch gleichzeitig genutzt werden. Wie bei +%% \write-book-yaml passiert das Schreiben ueber ein delayed stencil, +%% weil der Render-Collector-Store erst beim Ausgeben des Buchs +%% vollstaendig gefuellt ist. Der Dateiname ist wie bei \write-book-yaml +%% der Ausgabename des Buchs mit angehaengtem .cho. +#(define-markup-command (write-book-chordpro layout props) () + (let ((filename (string-append (ly:parser-output-name) ".cho"))) + (ly:make-stencil + `(delay-stencil-evaluation + ,(delay + (begin + (with-output-to-file filename + (lambda () + (let loop ((songs (filter + ;; \chordlyrics-Strophen ODER (bei + ;; chordpro-include-music-lyrics) aus der + ;; Musik nachgeholte Kandidaten. + (lambda (song) (or (> (chordpro-song-verse-index song) 0) + (pair? (chordpro-song-music-candidates song)))) + (filter-map + (lambda (song) (hash-ref chordpro-song-store + (symbol->string (car song)))) + (reverse (alist-delete 'markupPage + (alist-delete 'imagePage + (alist-delete 'emptyPage song-list))))))) + (first? #t)) + (when (pair? songs) + (unless first? (display "{new_song}\n")) + (display (chordpro-format-song (car songs))) + (loop (cdr songs) #f))))) + empty-stencil)))))) + includeSong = #(define-void-function (filename) (string?) #{ @@ -125,6 +213,15 @@ includeSong = #} (ly:parser-parse-string (ly:parser-clone) (ly:format "\\include \"~a/~a/~a.ly\"" songPath filename filename)) + ;; ChordPro: Titel/Autoren dieses Lieds im Render-Collector-Store + ;; registrieren -- basicSongInfo haelt direkt nach dem Include genau + ;; dieses Lied. Der Key ist der Liedname; die Collector-Daten (Verse, + ;; Akkorde) kommen spaeter beim Rendern ueber \setsongfilename unter + ;; demselben Key dazu. Unabhaengig von chordpro-export-enabled, damit + ;; sowohl der Pro-Song-Export (der die Flag braucht) als auch + ;; \write-book-chordpro (das nur explizit aufgerufen werden muss) auf + ;; vollstaendige Metadaten zugreifen koennen. + (chordpro-register-song-metadata filename HEADER) (let ((label (gensym "index"))) (set! additional-page-switch-label-list (acons label additional-page-numbers additional-page-switch-label-list)) @@ -302,14 +399,79 @@ songs = (text-pages (assq-ref songvars 'text-pages)) (label (assq-ref songvars 'label))) (set! song-number newnumber) - #{ - \bookpart { - $header - \headerToTOC #header #label - \score { $music \layout { $layout songfilename = $(symbol->string filename) } } - $(add-text-pages text-pages) - } - #})))))))) + ;; ChordPro_music_collector (Strophen unter den Noten, siehe + ;; chordpro.ily) braucht den Song-Key beim tatsaechlichen + ;; Interpretieren dieses Songs' Hauptscore. Im Buch ist DAS + ;; NICHT synchron zu dieser for-each-Schleife -- LilyPond + ;; interpretiert die \score-Bloecke aller Lieder gesammelt fuer + ;; das Seitenlayout, oft NACHDEM die Schleife schon beim + ;; naechsten (oder letzten) Lied angelangt ist. Ein globaler + ;; chordpro-active-song-key waere zu diesem Zeitpunkt also auf + ;; ein ANDERES Lied gesetzt -- die gesammelten Strophen landen + ;; dann fälschlich im Store-Eintrag des zuletzt verarbeiteten + ;; Lieds (beobachtet: mehrere Lieder ohne eigene \chordlyrics + ;; wurden alle in den letzten Song der Test-Bibliothek + ;; geschrieben). Deshalb setzen wir den Key per \applyContext + ;; DIREKT IN DER MUSIK in chordpro-context-song-keys (siehe + ;; chordpro.ily) -- das laeuft synchron zur tatsaechlichen + ;; Interpretation dieses Scores und ist deshalb robust gegen die + ;; verzoegerte/gesammelte Verarbeitung (eine LilyPond-Context- + ;; Property ueber den \layout-Block waere hier keine Alternative: + ;; LilyPond verwirft \applyContext-\ly:context-set-property!- + ;; Aufrufe fuer nicht deklarierte Properties stillschweigend). + ;; Der Music_collector liest bevorzugt diese Tabelle, + ;; chordpro-active-song-key bleibt nur als Fallback + ;; (Einzellied-Standalone-Pfad, dort synchron genug). + ;; \consists nur bei chordpro-include-music-lyrics -- sonst + ;; keine Kosten (Grob-Acknowledger fuer JEDEN Akkord/jede + ;; Silbe/Strophenmarker des Hauptscores) fuer Buecher, die das + ;; Feature nicht nutzen. Bewusst NICHT zusaetzlich an + ;; chordpro-export-enabled gekoppelt -- die steuert nur, ob + ;; \write-book-chordpro/\chordpro-delayed-write am Ende etwas + ;; schreiben, nicht ob hier gesammelt wird. + (set! chordpro-active-song-key (symbol->string filename)) + (let* ((collect-music-lyrics? (and (defined? 'chordpro-include-music-lyrics) chordpro-include-music-lyrics)) + (song-layout + (if collect-music-lyrics? + #{ + \layout { + $layout + songfilename = $(symbol->string filename) + \context { + \Score + \consists \ChordPro_music_collector + } + } + #} + #{ + \layout { + $layout + songfilename = $(symbol->string filename) + } + #})) + (score-music + (if collect-music-lyrics? + #{ + << + \applyContext + #(let ((key (symbol->string filename))) + (lambda (ctx) + (hashq-set! chordpro-context-song-keys ctx key))) + $music + >> + #} + music))) + #{ + \bookpart { + $header + \headerToTOC #header #label + \score { + $score-music + $song-layout + } + $(add-text-pages text-pages) + } + #}))))))))) ordered ))) diff --git a/private_includes/book/toc_include.ily b/private_includes/book/toc_include.ily index a79ae29..41ad3bb 100644 --- a/private_includes/book/toc_include.ily +++ b/private_includes/book/toc_include.ily @@ -370,6 +370,9 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s #(define csv-write sxml->csv) #(define-markup-command (write-toc-csv layout props) () + ;; Dateiname wie bei \write-book-yaml/\write-book-chordpro: der + ;; Ausgabename des Buchs mit angehaengtem .csv statt fest "toc.csv". + (define csv-filename (string-append (ly:parser-output-name) ".csv")) (define (csv-escape field) (if (string-null? field) field @@ -453,7 +456,7 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s (format-info-paragraphs (headervar-or-empty 'pronunciation)) )))) (alist-delete 'markupPage (alist-delete 'imagePage (alist-delete 'emptyPage song-list)))))) - (call-with-output-file "toc.csv" + (call-with-output-file csv-filename (lambda (port) (csv-write (cons '( "filename" diff --git a/public_includes/layout_bottom.ily b/public_includes/layout_bottom.ily index 3a4f03a..5ef1e97 100644 --- a/public_includes/layout_bottom.ily +++ b/public_includes/layout_bottom.ily @@ -72,31 +72,68 @@ TEXT = \markuplist { (if paper (set! $defaultpaper paper)) ) - ;; ChordPro export: Store filename and extract metadata from basicSongInfo FIRST + ;; Meta-Daten des Liedes als YAML neben die Ausgabedatei schreiben + ;; (.yml, landet wie das PDF relativ zum + ;; Arbeitsverzeichnis). Die Textseiten-Strophen kommen aus dem + ;; Render-Collector (chordpro.ily), deshalb wird erst bei der Ausgabe + ;; geschrieben: unsichtbarer delayed Stencil an der letzten Textseite. + ;; Ohne (nicht-leere) Textseiten gibt es keine Collector-Daten und die + ;; yml wird sofort geschrieben. + (when (and (defined? 'yaml-export-enabled) yaml-export-enabled) + ;; Collector-Daten auch ohne ChordPro-Flag unter dem Ausgabenamen sammeln + (set! chordpro-default-song-key (ly:parser-output-name)) + (if (any pair? TEXT_PAGES) + (let* ((last-index (- (length TEXT_PAGES) 1)) + (last-page (list-ref TEXT_PAGES last-index)) + (trigger-stencil (yaml-delayed-song-write + (ly:parser-output-name) HEADER MUSIC)) + (modified-last-page #{ + \markuplist { + #last-page + \stencil #trigger-stencil + } + #})) + (set! TEXT_PAGES + (append (list-head TEXT_PAGES last-index) + (list modified-last-page)))) + (scm->yml-file + (string-append (ly:parser-output-name) ".yml") + (extract-song-data HEADER MUSIC #f (ly:parser-output-name))))) + + ;; ChordPro export (Einzellied): Song-Key ist der Ausgabename (die .cho + ;; landet wie das PDF relativ zum Arbeitsverzeichnis); Titel/Autoren + ;; kommen aus HEADER in den per-Song-Store. (when (and (defined? 'chordpro-export-enabled) chordpro-export-enabled) - ;; 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)) + (set! chordpro-default-song-key (ly:parser-output-name)) + (chordpro-register-song-metadata chordpro-default-song-key HEADER)) - ;; 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 #{ - \score { - \MUSIC - \layout { \LAYOUT } - }#}) + ;; ChordPro_music_collector (Strophen unter den Noten, siehe chordpro.ily) + ;; braucht den aktiven Song-Key VOR der Interpretation des Hauptscores. + ;; \consists nur bei chordpro-include-music-lyrics -- sonst keine Kosten + ;; (Grob-Acknowledger fuer JEDEN Akkord/jede Silbe/Strophenmarker des + ;; Hauptscores) fuer Lieder/Buecher, die das Feature nicht nutzen. Bewusst + ;; NICHT zusaetzlich an chordpro-export-enabled gekoppelt: die Flag ist + ;; eigenstaendig gedacht (steuert nur, ob \chordpro-delayed-write bzw. + ;; \write-book-chordpro am Ende tatsaechlich etwas schreiben -- ob dafuer + ;; Daten gesammelt wurden, ist eine davon unabhaengige Entscheidung). + (set! chordpro-active-song-key (ly:parser-output-name)) + (if (and (defined? 'chordpro-include-music-lyrics) chordpro-include-music-lyrics) + (add-score #{ + \score { + \MUSIC + \layout { + \LAYOUT + \context { + \Score + \consists \ChordPro_music_collector + } + } + }#}) + (add-score #{ + \score { + \MUSIC + \layout { \LAYOUT } + }#})) (add-text-pages TEXT_PAGES) (add-score #{