new engraver for spacing in chordlyrics

private_includes/base/scm/yaml_parser.scm

@@ -1,7 +1,10 @@
 (use-modules (ice-9 rdelim) (ice-9 regex) (ice-9 pretty-print) (srfi srfi-1))
 
-;; Utility: Zeile einlesen
-(define (read-lines filename)
+;; Hauptparsingfunktion
+(define (yml-file->scm filename)
+
+  ;; Utility: Zeile einlesen
+  (define (read-lines filename)
     (call-with-input-file filename
       (lambda (port)
         (let loop ((lines '()))
@@ -13,30 +16,30 @@
                       (loop lines) ;; Ignoriere "---" oder leere Zeile
                       (loop (cons line lines))))))))))
 
-;; Einrückung bestimmen (Anzahl Leerzeichen am Anfang)
-(define (line-indent line)
+  ;; 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
 
-;; Kommentar entfernen
-(define (strip-comment line)
+  ;; Kommentar entfernen
+  (define (strip-comment line)
     (let ((m (string-match "#.*" line)))
       (if m
           (string-trim-right (string-take line (match:start m)))
           line)))
 
-;; Hilfsfunktion: Whitespace entfernen
-(define (clean-line line)
+  ;; Hilfsfunktion: Whitespace entfernen
+  (define (clean-line line)
     (string-trim (strip-comment line)))
 
-;; Ist Zeile leer (nach Entfernen von Kommentar & Whitespace)?
-(define (blank-or-comment? line)
+  ;; Ist Zeile leer (nach Entfernen von Kommentar & Whitespace)?
+  (define (blank-or-comment? line)
     (string-null? (clean-line line)))
 
-;; Skalare Werte interpretieren
-(define (parse-scalar str)
+  ;; Skalare Werte interpretieren
+  (define (parse-scalar str)
     (define (strip-quotes s)
       (cond
        ((and (string-prefix? "\"" s) (string-suffix? "\"" s))
@@ -54,13 +57,9 @@
        ((string=? s "null") '())
        (else s))))
 
-;; Hauptparsingfunktion
-(define (yml-file->scm filename)
-  (let ((lines (read-lines filename)))
-    (parse-lines lines 0)))
 
-;; Hilfsfunktion: Zeilen mit gleicher oder höherer Einrückung sammeln
-(define (take-indented lines min-indent)
+  ;; 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)
@@ -70,15 +69,15 @@
                 (loop (cdr ls) (cons line acc))
                 (reverse acc))))))
 
-;; Hilfsfunktion: N Zeilen überspringen
-(define (drop lst n)
+  ;; 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)))))
 
-;; Listenparsing: Liest Zeilen mit `-` als Listeneinträge
-(define (parse-list lines current-indent)
+  ;; Listenparsing: Liest Zeilen mit `-` als Listeneinträge
+  (define (parse-list lines current-indent)
     (let loop ((ls lines) (result '()))
       (if (null? ls)
           (reverse result)
@@ -101,8 +100,8 @@
                 ;; Nicht mehr Teil der Liste
                 (reverse result))))))
 
-;; Hauptparser für Key-Value oder Listen
-(define (parse-lines lines current-indent)
+  ;; Hauptparser für Key-Value oder Listen
+  (define (parse-lines lines current-indent)
     (let loop ((ls lines) (result '()))
       (if (null? ls)
           (reverse result)
@@ -149,4 +148,7 @@
                      (loop (cdr ls) result))))
              )))))
 
+  (let ((lines (read-lines filename)))
+    (parse-lines lines 0)))
+
 (define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename)))

private_includes/base/verses_with_chords.ily

@@ -253,6 +253,113 @@
                                     (make-pad-right-markup -0.1 (make-tied-lyric-markup text))
                                     text))))
 
+Chord_lyrics_spacing_engraver =
+#(lambda (ctx)
+   (let ((last-note-head #f)
+         (note-head-extended #f)
+         (last-lyric-syllable-width 0)
+         (lyric-width-since-last-chord 0)
+         (notes-on-syllable-count 0)
+         (last-chord-name #f)
+         (remaining-chord-width 0)
+         (last-rest #f)
+         (rest-count 0)
+         (multi-measure-rest-count 0)
+         (stanza-shift 0))
+     (make-engraver
+      (listeners
+       ((multi-measure-rest-event engraver event)
+        (set! multi-measure-rest-count (+ multi-measure-rest-count 1))
+        )
+       ((break-event engraver event)
+        (set! last-note-head #f)
+        (set! note-head-extended #f)
+        (set! last-lyric-syllable-width 0)
+        (set! lyric-width-since-last-chord 0)
+        (set! notes-on-syllable-count 0)
+        (set! last-chord-name #f)
+        (set! remaining-chord-width 0)
+        (set! last-rest #f)
+        (set! rest-count 0)
+        (set! multi-measure-rest-count 0)
+        (set! stanza-shift 0)
+        ))
+      (acknowledgers
+       ((note-head-interface this-engraver grob source-engraver)
+        (if (and (> rest-count 0) (not last-note-head))
+            (let ((rest-spacing-on-line-start 1.2))
+              (ly:grob-set-property! grob 'minimum-X-extent (cons (- rest-spacing-on-line-start) 0))
+              (set! stanza-shift rest-spacing-on-line-start)
+              ))
+        (set! notes-on-syllable-count (+ 1 notes-on-syllable-count))
+        (set! last-note-head grob)
+        (set! note-head-extended #f)
+        (set! last-rest #f)
+        (set! rest-count 0)
+        (set! multi-measure-rest-count 0)
+        )
+       ((lyric-syllable-interface this-engraver grob source-engraver)
+        (set! remaining-chord-width (max 0 (- remaining-chord-width lyric-width-since-last-chord)))
+        (set! last-lyric-syllable-width (- (cdr (ly:grob-extent grob grob X)) 0.2))
+        (set! lyric-width-since-last-chord (+ lyric-width-since-last-chord last-lyric-syllable-width))
+        (if last-note-head (set! notes-on-syllable-count 1))
+        )
+       ((chord-name-interface this-engraver grob source-engraver)
+        (if (not (and
+                  (boolean? (ly:grob-property grob 'begin-of-line-visible))
+                  (ly:grob-property grob 'begin-of-line-visible)))
+            (let ((on-a-rest (> rest-count 0)))
+              (if (not on-a-rest)
+                  (set! notes-on-syllable-count (- notes-on-syllable-count 1)))
+              (if (and last-chord-name (= multi-measure-rest-count 1) (> lyric-width-since-last-chord remaining-chord-width))
+                  (ly:grob-set-property! last-chord-name 'extra-spacing-width (cons -0.1 (+ 0.1 (- lyric-width-since-last-chord remaining-chord-width)))))
+              (if last-note-head
+                  (let* ((last-note-min-x-extent (ly:grob-property last-note-head 'minimum-X-extent))
+                         (last-note-min-x-lower (if (pair? last-note-min-x-extent) (car last-note-min-x-extent) 0))
+                         (last-note-min-x-upper (if (pair? last-note-min-x-extent) (cdr last-note-min-x-extent) 0)))
+                    (if on-a-rest
+                        (begin
+                         (if (not note-head-extended)
+                             (begin
+                              (ly:grob-set-property! last-note-head 'minimum-X-extent
+                                                     (cons last-note-min-x-lower (- last-lyric-syllable-width -2 (* 2.2 rest-count))))
+                              (set! note-head-extended #t)
+                              ))
+                         (ly:grob-set-property! last-rest 'minimum-X-extent (cons 0 2))
+                         )
+                        (if (and (> lyric-width-since-last-chord 0)
+                                 (> remaining-chord-width lyric-width-since-last-chord))
+                            (ly:grob-set-property! last-note-head 'minimum-X-extent
+                                                   (cons (- -1.2 (- remaining-chord-width lyric-width-since-last-chord)) last-note-min-x-upper))
+                            (let* ((width-per-note-head 0.5)
+                                   (note-width-since-last-chord (* width-per-note-head notes-on-syllable-count)))
+                              (if (> remaining-chord-width note-width-since-last-chord)
+                                  (ly:grob-set-property! last-note-head 'minimum-X-extent
+                                                         (cons (- note-width-since-last-chord remaining-chord-width) last-note-min-x-upper))
+                                  )
+                              )
+                            )
+                        )))
+              (set! last-chord-name grob)
+              (set! remaining-chord-width
+                    (if (and on-a-rest (equal? (ly:prob-property (ly:grob-property grob 'cause) 'duration) (ly:prob-property (ly:grob-property last-rest 'cause) 'duration)))
+                        0
+                        (cdr (ly:grob-extent grob grob X))))
+              (set! lyric-width-since-last-chord 0)
+              (set! notes-on-syllable-count (if on-a-rest 0 1))
+              ))
+        )
+       ((rest-interface this-engraver grob source-engraver)
+        (set! rest-count (+ 1 rest-count))
+        (set! last-rest grob)
+        (set! multi-measure-rest-count 0)
+        )
+       ((stanza-number-interface this-engraver grob source-engraver)
+        (ly:grob-set-property! grob 'padding (+ 1 stanza-shift)))
+       ))))
+
+%#(ly:set-option 'debug-skylines #t)
+
 #(define-markup-command (chordlyrics layout props lyrics) (ly:music?)
    #:properties ((verse-chords #{#})
                  (verse-reference-voice #{#})
@@ -280,6 +387,7 @@
             \context {
               \Lyrics
               \override VerticalAxisGroup.nonstaff-relatedstaff-spacing.basic-distance = #verse-text-chord-distance
+              \override VerticalAxisGroup.nonstaff-relatedstaff-spacing.padding = #(- verse-text-chord-distance songTextChordDistance)
               \override LyricText.parent-alignment-X = #LEFT
               \override LyricText.self-alignment-X = #LEFT
               \override LyricText.word-space = 0.8
@@ -298,6 +406,8 @@
              % \override SpacingSpanner.strict-note-spacing = ##t
               \override SpacingSpanner.uniform-stretching = ##t
               \override SpacingSpanner.spacing-increment = 0
+              %\override SpacingSpanner.packed-spacing = ##t
+              \consists \Chord_lyrics_spacing_engraver
               \remove Bar_number_engraver
               \remove Mark_engraver
               \remove Jump_engraver
@@ -331,9 +441,10 @@
               \NullVoice
               \consists Rest_engraver
               \omit Rest
+              \override Rest.X-extent = #'(0 . 0)
               \undo \omit NoteHead
               \hide NoteHead
-              \override NoteHead.X-extent = #'(0 . 0)
+              \override NoteHead.X-extent = #'(0 . 0.5)
             }
           }
         }