boernel/lilypond-common-includes
14
0
Fork 0
Code Issues 22 Pull Requests 1 Packages Projects Releases Wiki Activity

Compare commits

base: boernel:c8026d6ae2905944a5d16ee7417fa704715cc432
Branches Tags
boernel:main boernel:chord-spacing-experimental boernel:secondVoiceStyle_for_rests boernel:yaml_parser boernel:include_refactoring boernel:chordExceptions boernel:set-spacing-for-rests-in-chordlyrics boernel:tocSubtitleText-Variable
..
compare: boernel:yaml_parser
Branches Tags
boernel:chord-spacing-experimental boernel:main boernel:secondVoiceStyle_for_rests boernel:yaml_parser boernel:include_refactoring boernel:chordExceptions boernel:set-spacing-for-rests-in-chordlyrics boernel:tocSubtitleText-Variable

1 Commits
c8026d6ae2 ... yaml_parse

Author SHA1 Message Date
Christoph Wagner
4ded2286d8 native scheme yaml parser 2025-09-19 23:26:18 +02:00
2 changed files with 145 additions and 257 deletions
Expand all files Collapse all files

50
private_includes/base/scm/yaml_parser.scm
View File

@@ -1,10 +1,7 @@
(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))
;; 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 (call-with-input-file filename
(lambda (port) (lambda (port)
(let loop ((lines '())) (let loop ((lines '()))
@@ -16,30 +13,30 @@
(loop lines) ;; Ignoriere "---" oder leere Zeile (loop lines) ;; Ignoriere "---" oder leere Zeile
(loop (cons line lines)))))))))) (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))) (let ((match (string-match "^ *" line)))
(if match (if match
(match:end match) ; Anzahl der Leerzeichen = Position nach Leerzeichen (match:end match) ; Anzahl der Leerzeichen = Position nach Leerzeichen
0))) ; Falls kein Match → 0 0))) ; Falls kein Match → 0
;; Kommentar entfernen ;; Kommentar entfernen
(define (strip-comment line) (define (strip-comment line)
(let ((m (string-match "#.*" line))) (let ((m (string-match "#.*" line)))
(if m (if m
(string-trim-right (string-take line (match:start m))) (string-trim-right (string-take line (match:start m)))
line))) line)))
;; Hilfsfunktion: Whitespace entfernen ;; Hilfsfunktion: Whitespace entfernen
(define (clean-line line) (define (clean-line line)
(string-trim (strip-comment 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))) (string-null? (clean-line line)))
;; Skalare Werte interpretieren ;; Skalare Werte interpretieren
(define (parse-scalar str) (define (parse-scalar str)
(define (strip-quotes s) (define (strip-quotes s)
(cond (cond
((and (string-prefix? "\"" s) (string-suffix? "\"" s)) ((and (string-prefix? "\"" s) (string-suffix? "\"" s))
@@ -57,9 +54,13 @@
((string=? s "null") '()) ((string=? s "null") '())
(else s)))) (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 '())) (let loop ((ls lines) (acc '()))
(if (null? ls) (if (null? ls)
(reverse acc) (reverse acc)
@@ -69,15 +70,15 @@
(loop (cdr ls) (cons line acc)) (loop (cdr ls) (cons line acc))
(reverse 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)) (let loop ((l lst) (i n))
(if (or (zero? i) (null? l)) (if (or (zero? i) (null? l))
l l
(loop (cdr l) (- i 1))))) (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 '())) (let loop ((ls lines) (result '()))
(if (null? ls) (if (null? ls)
(reverse result) (reverse result)
@@ -100,8 +101,8 @@
;; Nicht mehr Teil der Liste ;; Nicht mehr Teil der Liste
(reverse result)))))) (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 '())) (let loop ((ls lines) (result '()))
(if (null? ls) (if (null? ls)
(reverse result) (reverse result)
@@ -148,7 +149,4 @@
(loop (cdr ls) result)))) (loop (cdr ls) result))))
))))) )))))
(let ((lines (read-lines filename)))
(parse-lines lines 0)))
(define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename))) (define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename)))

112
private_includes/base/verses_with_chords.ily
View File

@@ -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 #{#})
@@ -405,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
@@ -440,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)
} }
} }
} }