Compare commits
	
		
			5 Commits
		
	
	
		
			yaml_parse
			...
			050eec1da8
		
	
	| Author | SHA1 | Date | |
|---|---|---|---|
| 050eec1da8 | |||
| 5364f93db4 | |||
| aa0e3816d0 | |||
| 3b0c320839 | |||
| 12abf0a5f7 | 
| @@ -24,6 +24,7 @@ | |||||||
| #(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 Merge_rests_engraver |     \consists \Better_Merge_rests_engraver | ||||||
|   } |   } | ||||||
|   \context { |   \context { | ||||||
|     \Score |     \Score | ||||||
| @@ -67,6 +67,7 @@ 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 | ||||||
| @@ -83,12 +84,14 @@ 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 | ||||||
| @@ -98,6 +101,7 @@ 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,13 +242,23 @@ | |||||||
|       `(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 { \null } |       \line { \page-number-to-pdf-label \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 } | ||||||
|     } |     } | ||||||
| @@ -257,7 +267,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 { \null } |       \line { \page-number-to-pdf-label \null } | ||||||
|     } |     } | ||||||
|   } |   } | ||||||
| } | } | ||||||
							
								
								
									
										86
									
								
								private_includes/base/merge_rests_engraver_override.ily
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										86
									
								
								private_includes/base/merge_rests_engraver_override.ily
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,86 @@ | |||||||
|  | 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,152 +1,154 @@ | |||||||
| (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,13 +28,15 @@ | |||||||
| #(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,6 +253,113 @@ | |||||||
|                                     (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 #{#}) | ||||||
| @@ -280,6 +387,7 @@ | |||||||
|             \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 | ||||||
| @@ -298,6 +406,8 @@ | |||||||
|              % \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 | ||||||
| @@ -331,9 +441,10 @@ | |||||||
|               \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) |               \override NoteHead.X-extent = #'(0 . 0.5) | ||||||
|             } |             } | ||||||
|           } |           } | ||||||
|         } |         } | ||||||
|   | |||||||
| @@ -65,7 +65,10 @@ 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 | ||||||
| @@ -89,9 +92,10 @@ 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 'arabic display-page) |                               (make-concat-markup (list (number-format number-type 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))) | ||||||
| @@ -99,7 +103,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 'arabic (+ display-page (- real-current-page (real-page-number layout label)))) |                               (number-format number-type (+ 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