native scheme yaml parser

private_includes/base/all.ily

@@ -24,7 +24,6 @@
 #(define AUTHOR_DATA (if (defined? 'AUTHOR_DATA) AUTHOR_DATA (parse-yml-file "../../lilypond-song-includes/data/authors.yml")))
 #(define SONG_DATA (if (defined? 'SONG_DATA) SONG_DATA (parse-yml-file "../../lilypond-song-includes/data/songs.yml")))
 
-\include "merge_rests_engraver_override.ily"
 \include "basic_format_and_style_settings.ily"
 \include "eps_file_from_song_dir.ily"
 \include "title_with_category_images.ily"

private_includes/base/basic_format_and_style_settings.ily

@@ -44,7 +44,7 @@ generalLayout = \layout {
   \context {
     \Staff
     \accidentalStyle modern-voice-cautionary
-    \consists \Better_Merge_rests_engraver
+    \consists Merge_rests_engraver
   }
   \context {
     \Score
@@ -67,7 +67,6 @@ generalLayout = \layout {
     % ich will lines breaken wie ich will!
     \remove "Forbid_line_break_engraver"
     \override NoteHead.layer = 2
-    \override Rest.layer = 2
     \override Dots.layer = 2
     \override Stem.layer = 2
     \override Flag.layer = 2
@@ -84,14 +83,12 @@ textp = \lyricmode { \markup { \raise #1 \musicglyph #"rests.3" } }
 % zweite Stimme alles grau
 secondVoiceStyle = {
   \override NoteHead.color = #grey
-  \override Rest.color = #grey
   \override Dots.color = #grey
   \override Stem.color = #grey
   \override Flag.color = #grey
   \override Beam.color = #grey
   \override Accidental.color = #grey
   \override NoteHead.layer = 1
-  \override Rest.layer = 1
   \override Dots.layer = 1
   \override Stem.layer = 1
   \override Flag.layer = 1
@@ -101,7 +98,6 @@ secondVoiceStyle = {
 
 firstVoiceStyle = {
   \override NoteHead.color = #black
-  \override Rest.color = #black
   \override Dots.color = #black
   \override Stem.color = #black
   \override Flag.color = #black

private_includes/base/merge_rests_engraver_override.ily

@@ -1,86 +0,0 @@
-Better_Merge_rests_engraver =
-#(lambda (context)
-  (define (has-one-or-less? lst) (or (null? lst) (null? (cdr lst))))
-  (define (has-at-least-two? lst) (not (has-one-or-less? lst)))
-  (define (all-equal? lst pred)
-    (or (has-one-or-less? lst)
-        (and (pred (car lst) (cadr lst)) (all-equal? (cdr lst) pred))))
-  (define (measure-count-eqv? a b)
-    (eqv?
-     (ly:grob-property a 'measure-count)
-     (ly:grob-property b 'measure-count)))
-
-  (define (rests-all-unpitched? rests)
-    "Returns true when all rests do not override the staff-position grob
-    property. When a rest has a position set we do not want to merge rests at
-    that position."
-    (every (lambda (rest) (null? (ly:grob-property rest 'staff-position))) rests))
-
-  (define (less-by-layer a b)
-    (<
-      (ly:grob-property b 'layer)
-      (ly:grob-property a 'layer)))
-
-  (define (merge-mmrests mmrests)
-    "Move all multimeasure rests to the single voice location."
-    (if (all-equal? mmrests measure-count-eqv?)
-        (begin
-          (for-each
-           (lambda (rest) (ly:grob-set-property! rest 'direction CENTER))
-           mmrests)
-          (for-each
-           (lambda (rest) (ly:grob-set-property! rest 'transparent #t))
-           (cdr (sort mmrests less-by-layer))))))
-
-  (define (merge-rests rests)
-    (for-each
-     (lambda (rest) (ly:grob-set-property! rest 'staff-position 0))
-     rests)
-    (for-each
-     (lambda (rest) (ly:grob-set-property! rest 'transparent #t))
-     (cdr (sort rests less-by-layer))))
-
-  (let ((mmrests '())
-        (rests '())
-        (dots '()))
-    (make-engraver
-     ((start-translation-timestep translator)
-      (set! rests '())
-      (set! mmrests '())
-      (set! dots '()))
-     (acknowledgers
-      ((dot-column-interface engraver grob source-engraver)
-       (if (not (ly:context-property context 'suspendRestMerging #f))
-           (set!
-            dots
-            (append (ly:grob-array->list (ly:grob-object grob 'dots))
-                    dots))))
-      ((rest-interface engraver grob source-engraver)
-       (cond
-        ((ly:context-property context 'suspendRestMerging #f)
-         #f)
-        ((grob::has-interface grob 'multi-measure-rest-interface)
-         (set! mmrests (cons grob mmrests)))
-        (else
-         (set! rests (cons grob rests))))))
-     ((stop-translation-timestep translator)
-      (let (;; get a list of the rests 'duration-lengths, 'duration-log does
-            ;; not take dots into account
-            (durs
-             (map
-              (lambda (g)
-                (ly:duration->moment
-                 (ly:prob-property
-                  (ly:grob-property g 'cause)
-                  'duration)))
-              rests)))
-        (if (and
-             (has-at-least-two? rests)
-             (all-equal? durs equal?)
-             (rests-all-unpitched? rests))
-            (begin
-              (merge-rests rests)
-              ;; ly:grob-suicide! works nicely for dots, as opposed to rests.
-              (if (pair? dots) (for-each ly:grob-suicide! (cdr dots)))))
-        (if (has-at-least-two? mmrests)
-            (merge-mmrests mmrests)))))))

private_includes/base/scm/yaml_parser.scm

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

@@ -280,7 +280,6 @@
             \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