Compare commits
	
		
			1 Commits
		
	
	
		
			050eec1da8
			...
			yaml_parse
		
	
	| Author | SHA1 | Date | |
|---|---|---|---|
| 4ded2286d8 | 
| @@ -24,7 +24,6 @@ | |||||||
| #(define AUTHOR_DATA (if (defined? 'AUTHOR_DATA) AUTHOR_DATA (parse-yml-file "../../lilypond-song-includes/data/authors.yml"))) | #(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"))) | #(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 "basic_format_and_style_settings.ily" | ||||||
| \include "eps_file_from_song_dir.ily" | \include "eps_file_from_song_dir.ily" | ||||||
| \include "title_with_category_images.ily" | \include "title_with_category_images.ily" | ||||||
|   | |||||||
| @@ -44,7 +44,7 @@ generalLayout = \layout { | |||||||
|   \context { |   \context { | ||||||
|     \Staff |     \Staff | ||||||
|     \accidentalStyle modern-voice-cautionary |     \accidentalStyle modern-voice-cautionary | ||||||
|     \consists \Better_Merge_rests_engraver |     \consists Merge_rests_engraver | ||||||
|   } |   } | ||||||
|   \context { |   \context { | ||||||
|     \Score |     \Score | ||||||
| @@ -67,7 +67,6 @@ generalLayout = \layout { | |||||||
|     % ich will lines breaken wie ich will! |     % ich will lines breaken wie ich will! | ||||||
|     \remove "Forbid_line_break_engraver" |     \remove "Forbid_line_break_engraver" | ||||||
|     \override NoteHead.layer = 2 |     \override NoteHead.layer = 2 | ||||||
|     \override Rest.layer = 2 |  | ||||||
|     \override Dots.layer = 2 |     \override Dots.layer = 2 | ||||||
|     \override Stem.layer = 2 |     \override Stem.layer = 2 | ||||||
|     \override Flag.layer = 2 |     \override Flag.layer = 2 | ||||||
| @@ -84,14 +83,12 @@ textp = \lyricmode { \markup { \raise #1 \musicglyph #"rests.3" } } | |||||||
| % zweite Stimme alles grau | % zweite Stimme alles grau | ||||||
| secondVoiceStyle = { | secondVoiceStyle = { | ||||||
|   \override NoteHead.color = #grey |   \override NoteHead.color = #grey | ||||||
|   \override Rest.color = #grey |  | ||||||
|   \override Dots.color = #grey |   \override Dots.color = #grey | ||||||
|   \override Stem.color = #grey |   \override Stem.color = #grey | ||||||
|   \override Flag.color = #grey |   \override Flag.color = #grey | ||||||
|   \override Beam.color = #grey |   \override Beam.color = #grey | ||||||
|   \override Accidental.color = #grey |   \override Accidental.color = #grey | ||||||
|   \override NoteHead.layer = 1 |   \override NoteHead.layer = 1 | ||||||
|   \override Rest.layer = 1 |  | ||||||
|   \override Dots.layer = 1 |   \override Dots.layer = 1 | ||||||
|   \override Stem.layer = 1 |   \override Stem.layer = 1 | ||||||
|   \override Flag.layer = 1 |   \override Flag.layer = 1 | ||||||
| @@ -101,7 +98,6 @@ secondVoiceStyle = { | |||||||
|  |  | ||||||
| firstVoiceStyle = { | firstVoiceStyle = { | ||||||
|   \override NoteHead.color = #black |   \override NoteHead.color = #black | ||||||
|   \override Rest.color = #black |  | ||||||
|   \override Dots.color = #black |   \override Dots.color = #black | ||||||
|   \override Stem.color = #black |   \override Stem.color = #black | ||||||
|   \override Flag.color = #black |   \override Flag.color = #black | ||||||
|   | |||||||
| @@ -242,23 +242,13 @@ | |||||||
|       `(line-width . ,(* (chain-assoc-get 'header:songinfo-size-factor props songInfoLineWidthFraction) (ly:output-def-lookup layout 'line-width))) |       `(line-width . ,(* (chain-assoc-get 'header:songinfo-size-factor props songInfoLineWidthFraction) (ly:output-def-lookup layout 'line-width))) | ||||||
|       arg))) |       arg))) | ||||||
|  |  | ||||||
| #(define pdf-encode (@@ (lily framework-ps) pdf-encode)) |  | ||||||
| % PDF tags |  | ||||||
| #(define-markup-command (page-number-to-pdf-label layout props) () |  | ||||||
|      (ly:make-stencil |  | ||||||
|       (list 'embedded-ps |  | ||||||
|              (ly:format |  | ||||||
|               "[ /Label (~a) /PAGELABEL pdfmark\n" (pdf-encode (chain-assoc-get 'page:page-number-string props "?")))) |  | ||||||
|       empty-interval empty-interval |  | ||||||
|       )) |  | ||||||
|  |  | ||||||
| \paper { | \paper { | ||||||
|   print-first-page-number = ##t |   print-first-page-number = ##t | ||||||
|   first-page-number = #0 |   first-page-number = #0 | ||||||
|  |  | ||||||
|   oddFooterMarkup = \markup { |   oddFooterMarkup = \markup { | ||||||
|     \fill-line { |     \fill-line { | ||||||
|       \line { \page-number-to-pdf-label \null } |       \line { \null } | ||||||
|       \line { \if \on-last-page-of-part \general-align #Y #DOWN \fractional-line-width \print-songinfo } |       \line { \if \on-last-page-of-part \general-align #Y #DOWN \fractional-line-width \print-songinfo } | ||||||
|       \line { \if \should-print-page-number \print-pagenumber } |       \line { \if \should-print-page-number \print-pagenumber } | ||||||
|     } |     } | ||||||
| @@ -267,7 +257,7 @@ | |||||||
|     \fill-line { |     \fill-line { | ||||||
|       \line { \if \should-print-page-number \print-pagenumber } |       \line { \if \should-print-page-number \print-pagenumber } | ||||||
|       \line { \if \on-last-page-of-part \general-align #Y #DOWN \fractional-line-width \print-songinfo } |       \line { \if \on-last-page-of-part \general-align #Y #DOWN \fractional-line-width \print-songinfo } | ||||||
|       \line { \page-number-to-pdf-label \null } |       \line { \null } | ||||||
|     } |     } | ||||||
|   } |   } | ||||||
| } | } | ||||||
| @@ -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 0) |  | ||||||
|       (ly:grob-property a 'layer 0))) |  | ||||||
|  |  | ||||||
|   (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))))))) |  | ||||||
| @@ -1,154 +1,152 @@ | |||||||
| (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 pretty-print) (srfi srfi-1)) | ||||||
|  |  | ||||||
|  | ;; Utility: Zeile einlesen | ||||||
|  | (define (read-lines filename) | ||||||
|  |   (call-with-input-file filename | ||||||
|  |     (lambda (port) | ||||||
|  |       (let loop ((lines '())) | ||||||
|  |         (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)))))))))) | ||||||
|  |  | ||||||
|  | ;; 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) | ||||||
|  |   (let ((m (string-match "#.*" line))) | ||||||
|  |     (if m | ||||||
|  |         (string-trim-right (string-take line (match:start m))) | ||||||
|  |         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) | ||||||
|  |   (string-null? (clean-line line))) | ||||||
|  |  | ||||||
|  | ;; Skalare Werte interpretieren | ||||||
|  | (define (parse-scalar str) | ||||||
|  |   (define (strip-quotes s) | ||||||
|  |     (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)))) | ||||||
|  |     (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)))) | ||||||
|  |  | ||||||
| ;; Hauptparsingfunktion | ;; Hauptparsingfunktion | ||||||
| (define (yml-file->scm filename) | (define (yml-file->scm filename) | ||||||
|  |  | ||||||
|   ;; Utility: Zeile einlesen |  | ||||||
|   (define (read-lines filename) |  | ||||||
|     (call-with-input-file filename |  | ||||||
|       (lambda (port) |  | ||||||
|         (let loop ((lines '())) |  | ||||||
|           (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)))))))))) |  | ||||||
|  |  | ||||||
|   ;; 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) |  | ||||||
|     (let ((m (string-match "#.*" line))) |  | ||||||
|       (if m |  | ||||||
|           (string-trim-right (string-take line (match:start m))) |  | ||||||
|           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) |  | ||||||
|     (string-null? (clean-line line))) |  | ||||||
|  |  | ||||||
|   ;; Skalare Werte interpretieren |  | ||||||
|   (define (parse-scalar str) |  | ||||||
|     (define (strip-quotes s) |  | ||||||
|       (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)))) |  | ||||||
|       (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)))) |  | ||||||
|  |  | ||||||
|  |  | ||||||
|   ;; 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)))))) |  | ||||||
|  |  | ||||||
|   ;; 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) |  | ||||||
|     (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)))))) |  | ||||||
|  |  | ||||||
|   ;; 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 |  | ||||||
|              ((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))) |   (let ((lines (read-lines filename))) | ||||||
|     (parse-lines lines 0))) |     (parse-lines lines 0))) | ||||||
|  |  | ||||||
|  | ;; 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)))))) | ||||||
|  |  | ||||||
|  | ;; 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) | ||||||
|  |   (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)))))) | ||||||
|  |  | ||||||
|  | ;; 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 | ||||||
|  |            ((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)))) | ||||||
|  |            ))))) | ||||||
|  |  | ||||||
| (define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename))) | (define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename))) | ||||||
|   | |||||||
| @@ -28,15 +28,13 @@ | |||||||
| #(define pdf-encode (@@ (lily framework-ps) pdf-encode)) | #(define pdf-encode (@@ (lily framework-ps) pdf-encode)) | ||||||
| % PDF tags | % PDF tags | ||||||
| #(define-markup-command (title-to-pdf-toc layout props title) (string?) | #(define-markup-command (title-to-pdf-toc layout props title) (string?) | ||||||
|   (if (string-null? title) |  | ||||||
|      empty-stencil |  | ||||||
|      (ly:make-stencil |      (ly:make-stencil | ||||||
|       (list 'embedded-ps |       (list 'embedded-ps | ||||||
|              (ly:format |              (ly:format | ||||||
|               "[/Action /GoTo /View [/XYZ -4 currentpagedevice /PageSize get 1 get 4 add null] /Title (~a) /OUT pdfmark" (pdf-encode title))) |               "[/Action /GoTo /View [/XYZ -4 currentpagedevice /PageSize get 1 get 4 add null] /Title (~a) /OUT pdfmark" (pdf-encode title))) | ||||||
|       empty-interval empty-interval |       empty-interval empty-interval | ||||||
|       ;'(0 . 0) '(0 . 0) |       ;'(0 . 0) '(0 . 0) | ||||||
|       ))) |       )) | ||||||
|  |  | ||||||
| #(define-markup-command (title-with-category-images layout props right)(boolean?) | #(define-markup-command (title-with-category-images layout props right)(boolean?) | ||||||
|    (interpret-markup layout props |    (interpret-markup layout props | ||||||
|   | |||||||
| @@ -253,113 +253,6 @@ | |||||||
|                                     (make-pad-right-markup -0.1 (make-tied-lyric-markup text)) |                                     (make-pad-right-markup -0.1 (make-tied-lyric-markup text)) | ||||||
|                                     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?) | #(define-markup-command (chordlyrics layout props lyrics) (ly:music?) | ||||||
|    #:properties ((verse-chords #{#}) |    #:properties ((verse-chords #{#}) | ||||||
|                  (verse-reference-voice #{#}) |                  (verse-reference-voice #{#}) | ||||||
| @@ -387,7 +280,6 @@ Chord_lyrics_spacing_engraver = | |||||||
|             \context { |             \context { | ||||||
|               \Lyrics |               \Lyrics | ||||||
|               \override VerticalAxisGroup.nonstaff-relatedstaff-spacing.basic-distance = #verse-text-chord-distance |               \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.parent-alignment-X = #LEFT | ||||||
|               \override LyricText.self-alignment-X = #LEFT |               \override LyricText.self-alignment-X = #LEFT | ||||||
|               \override LyricText.word-space = 0.8 |               \override LyricText.word-space = 0.8 | ||||||
| @@ -406,8 +298,6 @@ Chord_lyrics_spacing_engraver = | |||||||
|              % \override SpacingSpanner.strict-note-spacing = ##t |              % \override SpacingSpanner.strict-note-spacing = ##t | ||||||
|               \override SpacingSpanner.uniform-stretching = ##t |               \override SpacingSpanner.uniform-stretching = ##t | ||||||
|               \override SpacingSpanner.spacing-increment = 0 |               \override SpacingSpanner.spacing-increment = 0 | ||||||
|               %\override SpacingSpanner.packed-spacing = ##t |  | ||||||
|               \consists \Chord_lyrics_spacing_engraver |  | ||||||
|               \remove Bar_number_engraver |               \remove Bar_number_engraver | ||||||
|               \remove Mark_engraver |               \remove Mark_engraver | ||||||
|               \remove Jump_engraver |               \remove Jump_engraver | ||||||
| @@ -441,10 +331,9 @@ Chord_lyrics_spacing_engraver = | |||||||
|               \NullVoice |               \NullVoice | ||||||
|               \consists Rest_engraver |               \consists Rest_engraver | ||||||
|               \omit Rest |               \omit Rest | ||||||
|               \override Rest.X-extent = #'(0 . 0) |  | ||||||
|               \undo \omit NoteHead |               \undo \omit NoteHead | ||||||
|               \hide NoteHead |               \hide NoteHead | ||||||
|               \override NoteHead.X-extent = #'(0 . 0.5) |               \override NoteHead.X-extent = #'(0 . 0) | ||||||
|             } |             } | ||||||
|           } |           } | ||||||
|         } |         } | ||||||
|   | |||||||
| @@ -65,10 +65,7 @@ additionalPageNumbers = | |||||||
|   display-pages-list |   display-pages-list | ||||||
| ) | ) | ||||||
|  |  | ||||||
| % 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 |  | ||||||
| % page:page-number-string setzen dann klappts auch mit PDF Seiten |  | ||||||
| #(define-markup-command (custom-page-number layout props label real-current-page-number) | #(define-markup-command (custom-page-number layout props label real-current-page-number) | ||||||
|   (symbol? number?) |   (symbol? number?) | ||||||
|   #:category other |   #:category other | ||||||
| @@ -92,10 +89,9 @@ width may require additional tweaking.)" | |||||||
|         ,(delay (ly:stencil-expr |         ,(delay (ly:stencil-expr | ||||||
|                  (let* ((display-page (assq-ref (build-display-pages-list layout) label)) |                  (let* ((display-page (assq-ref (build-display-pages-list layout) label)) | ||||||
|                         (real-current-page (if (negative? real-current-page-number) (real-page-number layout label) real-current-page-number)) |                         (real-current-page (if (negative? real-current-page-number) (real-page-number layout label) real-current-page-number)) | ||||||
|                         (number-type (ly:output-def-lookup layout 'page-number-type)) |  | ||||||
|                         (page-markup |                         (page-markup | ||||||
|                           (if (assq-ref additional-page-switch-label-list label) |                           (if (assq-ref additional-page-switch-label-list label) | ||||||
|                               (make-concat-markup (list (number-format number-type display-page) |                               (make-concat-markup (list (number-format 'arabic display-page) | ||||||
|                                 (make-char-markup (+ 97 (- real-current-page (real-page-number layout |                                 (make-char-markup (+ 97 (- real-current-page (real-page-number layout | ||||||
|                                   (let find-earliest-additional-label |                                   (let find-earliest-additional-label | ||||||
|                                        ((rest-additional-page-switch-label-list (member (cons label #t) additional-page-switch-label-list))) |                                        ((rest-additional-page-switch-label-list (member (cons label #t) additional-page-switch-label-list))) | ||||||
| @@ -103,7 +99,7 @@ width may require additional tweaking.)" | |||||||
|                                            (find-earliest-additional-label (cdr rest-additional-page-switch-label-list)) |                                            (find-earliest-additional-label (cdr rest-additional-page-switch-label-list)) | ||||||
|                                            (caar rest-additional-page-switch-label-list))) |                                            (caar rest-additional-page-switch-label-list))) | ||||||
|                                 )))))) |                                 )))))) | ||||||
|                               (number-format number-type (+ display-page (- real-current-page (real-page-number layout label)))) |                               (number-format 'arabic (+ display-page (- real-current-page (real-page-number layout label)))) | ||||||
|                           )) |                           )) | ||||||
|                         (page-stencil (interpret-markup layout props page-markup)) |                         (page-stencil (interpret-markup layout props page-markup)) | ||||||
|                         (gap (- (interval-length x-ext) |                         (gap (- (interval-length x-ext) | ||||||
|   | |||||||
		Reference in New Issue
	
	Block a user