59 Commits

Author SHA1 Message Date
4ded2286d8 native scheme yaml parser 2025-09-19 23:26:18 +02:00
a01e95f31d fix categories and authors index 2025-09-19 18:47:26 +02:00
90feb6dfbb separate translation prefixes for authors and songinfo 2025-09-19 17:19:37 +02:00
tux
ede5568962 be able to format everything of the songinfo with markup 2025-09-17 13:02:41 +02:00
tux
66b5c37755 adaption_text adaption_music 2025-08-31 15:53:52 +02:00
tux
cd5e38aabc add prefixes in songinfo output 2025-08-30 15:05:04 +02:00
tux
ca129eec79 refactor include system 2025-08-18 10:02:21 +02:00
f824b23311 fix updown syllable hyphens 2025-08-13 21:25:39 +02:00
5ef4ee78ae Zwischenrufe als stanzas 2025-08-12 00:14:52 +02:00
45e751fa24 fix updown to only modify first character 2025-08-10 18:46:25 +02:00
9fb2d96765 multiple stanza numbers for one verse 2025-08-09 13:27:38 +02:00
8ce3af93c7 Remove Script_engraver from Voice Context 2025-08-08 19:44:57 +04:00
tux
19f6046333 fix includeFromSong 2025-06-17 09:01:24 +02:00
tux
a288248da3 Refactor toc code 2025-06-15 13:38:06 +02:00
tux
7a65d056d6 refactor title markup and allow songnumbers 2025-06-14 16:37:27 +02:00
tux
53c41bf5dc add transliteration to toc 2025-06-10 07:33:09 +02:00
c49dba89f7 include adaptions/editings in author system 2025-06-07 16:27:32 +02:00
tux
195110923a include another song without outputting anything 2025-06-06 18:13:22 +02:00
tux
8d0ddcee06 introduce TEXT_PAGES 2025-05-19 22:14:08 +02:00
tux
c47ceb443e fix some chord spacing 2025-05-11 17:59:56 +02:00
tux
377beeab57 refactor and fix tagging bug 2025-05-11 11:39:19 +02:00
tux
cb4b74d4f7 indents for verse lines 2025-05-10 15:13:47 +02:00
616034baca Remove Metronome_mark_engraver 2025-05-08 23:28:08 +04:00
tux
34c9c5a932 capoTranspose eingebaut 2025-04-30 17:31:01 +02:00
57bcf94167 add default chordName exceptions 2025-04-27 14:37:07 +02:00
9a9ef8e8df fix transpositions for verses 2025-04-27 12:15:32 +04:00
tux
531e459af1 fix files-in-directory 2025-04-27 01:47:53 +02:00
tux
fc1bc74b10 fix altChord transposition again 2025-04-27 01:21:13 +02:00
tux
d47ae1a66d interpret songinfo with markups 2025-04-26 21:29:06 +02:00
37ee497f89 make cues configurable 2025-04-26 23:26:12 +04:00
41bd881014 remove Jump_engraver 2025-04-26 21:40:05 +04:00
tux
00a7b0ebc8 pseudoIndents for custom layouting 2025-04-21 19:48:30 +02:00
tux
760ca71ba7 melisOff and melisOn 2025-04-21 19:11:05 +02:00
tux
17074e2db6 secondVoiceStyle for Accidentals 2025-04-19 22:33:54 +02:00
tux
654f619fba sort contributions 2025-04-19 19:08:13 +02:00
tux
cc4fc9f297 fix altChord for SVG Output 2025-04-19 17:03:20 +02:00
d2dbf3448a change accidentalStyle to modern-voice-cautionary 2025-04-17 22:52:36 +04:00
tux
140bc611d1 fix altChord transposition 2025-04-17 20:22:21 +02:00
tux
eccd9b8730 fill-midi 2025-04-05 14:31:19 +02:00
900f4e1d06 workaround popen trouble on windows 2025-03-28 11:01:55 +01:00
7d01bd769c use authorId if not empty and not found 2025-03-27 17:00:05 +01:00
a0e70b4c4b add dottedExtender 2025-03-24 20:23:21 +01:00
04a01d3b3f Workaround für komische Python-Pfade 2025-03-13 20:14:43 +01:00
07b598db06 Fix handling of 'alttitle' variable to support both strings and lists in csv 2025-03-03 20:18:45 +04:00
a61becaf5e Support multiple alternative titles in headerToTOC function
This update allows the alttitle header field to accept a list of alternative titles instead of a single value. Each title in the list is processed and added to the table of contents as an alternative title, enhancing flexibility and usability.
2025-03-03 16:57:05 +04:00
f0f4b0c180 change default font 2025-02-25 08:21:31 +01:00
b6bead747d change midi settings 2025-02-25 08:19:07 +01:00
4dbdb72d30 fix layout size problem 2025-02-18 08:57:07 +01:00
aa8b9526fa implementing swingOff 2025-02-10 12:21:31 +04:00
tux
3cb0e00e8f updates for newest lilypond versions 2025-02-09 13:06:12 +01:00
152d56fe3f Autorenverzeichnis sortiert 2025-02-06 23:38:00 +01:00
883c32701c work if authors not specified 2025-02-02 16:12:04 +01:00
7b97e04fab optimize link area in toc 2025-01-28 00:26:18 +01:00
e4b65aafcb ref stanzas without dot 2025-01-27 22:16:34 +01:00
bf7e959100 appendix and footer improvements 2025-01-27 01:35:48 +01:00
tux
ddd4888041 \ref can take a list of stanza numbers now 2025-01-26 21:51:14 +01:00
tux
a368a3c589 Refactor author-format function 2025-01-23 23:08:15 +01:00
tux
e6725b84d4 scroll to left upper corner with pdf bookmarks 2025-01-23 22:12:09 +01:00
Arlett Grygar
b41e2a62a4 windows includes angepasst 2024-12-31 16:13:21 +01:00
32 changed files with 932 additions and 783 deletions

View File

@@ -1,29 +0,0 @@
#(define noStandaloneOutput (if (defined? 'noStandaloneOutput) noStandaloneOutput #f))
#(if (defined? 'LAYOUT) #f
(let ((scmdir (string-append (dirname (current-filename)) file-name-separator-string "scm" file-name-separator-string)))
(load (string-append scmdir "json_parser.scm"))
(load (string-append scmdir "resolve_inherits.scm"))
(load (string-append scmdir "yaml_parser.scm"))))
#(define AUTHOR_DATA (if (defined? 'AUTHOR_DATA) AUTHOR_DATA (parse-yml-file "../../lilypond-song-includes/data/authors.yml")))
#(define SONG_DATA (if (defined? 'SONG_DATA) SONG_DATA (parse-yml-file "../../lilypond-song-includes/data/songs.yml")))
\include "basic_format_and_style_settings.ly"
\include "eps_file_from_song_dir.ly"
\include "title_with_category_images.ly"
\include "chord_settings.ly"
\include "transposition.ly"
\include "verses_with_chords.ly"
\include "arrows_in_scores.ly"
\include "swing_style.ly"
\include "inline_score.ly"
% reset important variables
LAYOUT = \layout { \generalLayout }
HEADER = {}
MUSIC = {}
TEXT = \markuplist {""}
verseChords = {}
firstVoice = {}
global = {}

View File

@@ -0,0 +1,48 @@
#(define include_dir_not_added? (if (defined? 'include_dir_not_added?) include_dir_not_added? #t))
#(if include_dir_not_added?
(let* ((common-include-dir (dirname (dirname (dirname (current-filename))))))
(ly:parser-append-to-include-path common-include-dir)
(set! include_dir_not_added? #f)))
#(define noStandaloneOutput (if (defined? 'noStandaloneOutput) noStandaloneOutput #f))
#(define windows? (string-prefix-ci? "windows" (utsname:sysname (uname))))
#(if (defined? 'LAYOUT) #f
(let ((scm-load (lambda (filename) (load (
string-append
; on windows the detection of absolute pathes is broken (cause they start with a drive letter and not with a /)
; so we have to use relative pathes for load. That works in frescobaldi, but not if you call lilypond from command line,
; with a relative path to the .ly file, so we use absolute pathes on posix systems, where it works.
(if windows?
""
(string-append (dirname (current-filename)) file-name-separator-string))
"scm" file-name-separator-string filename
)))))
(scm-load "resolve_inherits.scm")
(scm-load "yaml_parser.scm")))
#(define AUTHOR_DATA (if (defined? 'AUTHOR_DATA) AUTHOR_DATA (parse-yml-file "../../lilypond-song-includes/data/authors.yml")))
#(define SONG_DATA (if (defined? 'SONG_DATA) SONG_DATA (parse-yml-file "../../lilypond-song-includes/data/songs.yml")))
\include "basic_format_and_style_settings.ily"
\include "eps_file_from_song_dir.ily"
\include "title_with_category_images.ily"
\include "chord_settings.ily"
\include "transposition.ily"
\include "verses_with_chords.ily"
\include "arrows_in_scores.ily"
\include "swing_style.ily"
\include "inline_score.ily"
\include "custom_indentation.ily"
\include "include_from_song.ily"
% reset important variables
LAYOUT = \layout { \generalLayout }
HEADER = {}
MUSIC = {}
TEXT = \markuplist {}
TEXT_PAGES = #f
verseChords = {}
firstVoice = {}
global = {}

View File

@@ -1,10 +1,10 @@
\language "deutsch"
\include "default_style.ly"
\include "default_songinfo_style.ly"
\include "footer_with_songinfo.ly"
\include "default_style.ily"
\include "default_songinfo_style.ily"
\include "footer_with_songinfo.ily"
\include #(if (defined? 'customStyleOverridesFile) customStyleOverridesFile "void.ly")
\include #(if (defined? 'customStyleOverridesFile) customStyleOverridesFile "../void.ily")
#(set-default-paper-size songFormatAndSize)
#(set-global-staff-size globalSize)
@@ -24,6 +24,11 @@
markup-system-spacing = #'((basic-distance . 1))
score-markup-spacing = #'((padding . 2))
top-markup-spacing = #'((basic-distance . 0) (minimum-distance . 0) (padding . 0))
refMarkupFormatter = #(lambda (layout props stanzanumbers)
(interpret-markup layout props
(if (null? stanzanumbers)
refString
(ly:format refStringWithNumbers (string-join (map (lambda (stanzanumber) (ly:format "~a" stanzanumber)) stanzanumbers) ", ")))))
}
generalLayout = \layout {
@@ -38,7 +43,7 @@ generalLayout = \layout {
}
\context {
\Staff
\accidentalStyle modern
\accidentalStyle modern-voice-cautionary
\consists Merge_rests_engraver
}
\context {
@@ -66,6 +71,7 @@ generalLayout = \layout {
\override Stem.layer = 2
\override Flag.layer = 2
\override Beam.layer = 2
\override Accidental.layer = 2
}
}
@@ -81,11 +87,13 @@ secondVoiceStyle = {
\override Stem.color = #grey
\override Flag.color = #grey
\override Beam.color = #grey
\override Accidental.color = #grey
\override NoteHead.layer = 1
\override Dots.layer = 1
\override Stem.layer = 1
\override Flag.layer = 1
\override Beam.layer = 1
\override Accidental.layer = 1
}
firstVoiceStyle = {
@@ -94,6 +102,7 @@ firstVoiceStyle = {
\override Stem.color = #black
\override Flag.color = #black
\override Beam.color = #black
\override Accidental.color = #black
}
% Deprecated: einzelne Noten innerhalb von \secondVoiceStyle mit schwarzem statt grauem Kopf
@@ -112,23 +121,30 @@ override-stanza =
#}
)
stanza =
#(define-music-function (parser location stanzanumber) (number?)
#(define (stanza . stanzanumbers)
#{
\once \override StanzaNumber.layer = 23 % set this to signal that there is a real stanza and no repeat signs
\applyContext
#(lambda (context)
(let* ((stanzanumber (ly:assoc-get 'forced-spacing (ly:context-grob-definition context 'StanzaNumber) stanzanumber))
(stanzastyle (ly:assoc-get 'style (ly:context-grob-definition context 'StanzaNumber)))
(formattedStanzaNumber (format #f (if (eq? stanzastyle 'roman) romanStanzaFormat stanzaFormat) stanzanumber)))
(ly:context-set-property! context 'stanza formattedStanzaNumber)))
(let* ((stanzanumber-override (ly:assoc-get 'forced-spacing (ly:context-grob-definition context 'StanzaNumber) #f))
(stanza-style (ly:assoc-get 'style (ly:context-grob-definition context 'StanzaNumber)))
(stanza-format (lambda (stanzanumber) (format #f (if (eq? stanza-style 'roman) romanStanzaFormat stanzaFormat) stanzanumber))))
(ly:context-set-property! context 'stanza
(string-join (map stanza-format
(if stanzanumber-override (list stanzanumber-override) stanzanumbers))
", "))))
#}
)
ref = {
\once \override StanzaNumber.layer = 23 % set this to signal that there is a real stanza and no repeat signs
\set stanza = \refString
}
ref =
#(define-music-function (stanzanumbers lyrics) ((number-list? (list)) ly:music?)
#{ \lyricmode {
\once \override StanzaNumber.layer = 23 % set this to signal that there is a real stanza and no repeat signs
\set stanza = #(make-on-the-fly-markup (lambda (layout props m) ((ly:output-def-lookup layout 'refMarkupFormatter) layout props stanzanumbers)) (make-null-markup))
#lyrics
}
#}
)
% prints a repStart Sign as stanza if the tag 'repeats is kept.
% if there was a stanza already set by the stanza function with StanzaNumber.layer = 23 we set that also as stanza.
@@ -178,9 +194,62 @@ alt =
updown =
#(define-music-function (parser location word) (string?)
(let ((first-char (string-take word 1))
(rest (substring word 1 (string-length word))))
#{
\lyricmode {
\tag #'up { \markup { #(string-capitalize word) } }
\tag #'down { \markup { #(string-downcase word) } }
\markup {
\tag #'up #(string-append (string-capitalize first-char) rest)
\tag #'down #(string-append (string-downcase first-char) rest)
}
}
#})
#}))
dottedExtender = {
\override LyricExtender.style = #'dotted-line
\override LyricExtender.thickness = 2
\override LyricExtender.Y-offset = 0.1
\override LyricExtender.stencil =
#(lambda (grob)
(let* ((stil (ly:lyric-extender::print grob))
(nostil (null? stil))
(x-ext (if nostil 0 (ly:stencil-extent stil X))))
(if nostil
stil
(make-connected-line
(list
(cons (car x-ext) 0)
(cons (cdr x-ext) 0))
grob))))
}
melisOff = \set ignoreMelismata = ##t
melisOn = \unset ignoreMelismata
cue =
#(define-music-function (zahlen) (number-list?)
#{
\tag #'cues {
\tweak self-alignment-X #LEFT
\mark
#(make-on-the-fly-markup
(lambda (layout props m) (interpret-markup layout (prepend-alist-chain 'cues zahlen props) (ly:output-def-lookup layout 'cueMarkup)))
(make-null-markup))
}
#})
#(define-markup-command (ruf-style layout props text) (string?)
(interpret-markup layout props
(markup #:italic (string-append "(" text ")"))))
rufWithMarkup =
#(define-music-function (text) (markup?)
#{
\lyricmode {
\once \override StanzaNumber.font-series = #'normal
\once \override StanzaNumber.direction = 1
\set stanza = #text
}
#})
ruf =
#(define-music-function (text) (string?)
(rufWithMarkup (make-ruf-style-markup text)))

View File

@@ -38,31 +38,47 @@ shiftChords = #(define-music-function (parser location xshift chords) (number? l
$chords
#})
altChord = #(define-music-function (parser location mainchord altchord) (ly:music? ly:music?)
(define (chord-namer in-pitches bass inversion context)
#{
\markup {
\translate #'(-0.5 . 0)
\score {
\chords { #mainchord \klamm #altchord }
\layout {
\LAYOUT
\context {
\ChordNames
\override ChordName.extra-spacing-width = #'(0 . 0.3)
}
\context {
\Score
\override SpacingSpanner.spacing-increment = 0
}
}
}
}
#})
#{
\once \set chordNameFunction = #chord-namer
#mainchord
#})
altChord =
#(define-music-function (parser location mainchord altchord) (ly:music? ly:music?)
(let* ((remove-point-and-click
(lambda (grob)
(ly:grob-set-property! grob 'cause #f)
(ly:text-interface::print grob)))
(chord-name (lambda (in-pitches bass inversion context) #{
\markup {
\translate #'(-0.5 . 0)
\score {
\chords { \transposable #(cons (car (music-pitches mainchord)) (car in-pitches)) { #(music-clone mainchord) \klamm #(music-clone altchord) } }
\layout {
\LAYOUT
\context {
\ChordNames
\override ChordName.extra-spacing-width = #'(0 . 0.3)
\override ChordName.stencil = #remove-point-and-click
}
\context {
\Score
\override SpacingSpanner.spacing-increment = 0
}
}
}
}#})))
#{
\once \set chordNameFunction = #chord-name
#mainchord
#}))
% Akkorde werden so transponiert, dass sie passen, wenn man mit Kapo im angegebenen Bund spielt
capoTranspose =
#(define-music-function (fret chords) (number? ly:music?)
(define semi->pitch
(make-semitone->pitch
(music-pitches
#{ h b a gis g fis f e es d cis c #})))
(transpose
(ly:pitch-transpose (semi->pitch fret) (ly:make-pitch 0 0))
(ly:make-pitch 0 0)
chords))
% kleine Mollakkorde und Alteration ausgeschrieben
#(define (note-name->german-markup-nosym pitch lowercase?)
@@ -100,11 +116,42 @@ altChord = #(define-music-function (parser location mainchord altchord) (ly:musi
% additional bass notes should get uppercased
#(define (bassnote-name->german-markup-nosym pitch lowercase?)(note-name->german-markup-nosym pitch #f))
defaultChordPrintings = {
<c g>-\markup { \super "5" }
%% Dur
<c e g a>-\markup { \super "6" } %Standardverhalten
<c e a >-\markup { \super "6(no5)" }
<c e g a d'>-\markup { \super "6/9" }
<c e g b d'>-\markup { \super "9" } %Standardverhalten
<c e g b d' f'>-\markup { \super "11" } %Standardverhalten
<c e g b d' a'>-\markup { \super "13" }
%add chords
<c e g d'>-\markup { \super "add9" }
<c e g f'>-\markup { \super "add11" }
<c e g a'>-\markup { \super "add13" }
%major chords
<c e g h d'>-\markup { \super "maj9" }
%% Moll
<c es g a>-\markup { \super "6" } %Standardverhalten
<c es a >-\markup { \super "6(no5)" }
<c es g a d'>-\markup { \super "6/9" }
<c es g b d'>-\markup { \super "9" } %Standardverhalten
<c es g b d' f'>-\markup { \super "11" } %Standardverhalten
<c es g b d' a'>-\markup { \super "13" }
%add chords
<c es g d'>-\markup { \super "add9" }
<c es g f'>-\markup { \super "add11" }
<c es g a'>-\markup { \super "add13" }
%major chords
<c es g h d'>-\markup { \super "maj9" }
}
#(define chordNameExceptions
(if (defined? 'customChordPrintings)
(sequential-music-to-chord-exceptions customChordPrintings #t)
'()))
(append
(if (defined? 'customChordPrintings)
(sequential-music-to-chord-exceptions customChordPrintings #t)
'())
(sequential-music-to-chord-exceptions defaultChordPrintings #t)))
generalLayout = \layout {
\generalLayout

View File

@@ -0,0 +1,135 @@
% https://lsr.di.unimi.it/LSR/Snippet?id=1098
%%%%%%%% HEADER %%%%%%%%
%
% this code was prompted by
% https://lists.gnu.org/archive/html/lilypond-user/2019-07/msg00139.html
% and offers a pseudoIndent hack suitable for general use
% keywords:
% indent short-indent indentation system line
% mid-score temporarily arbitrary individual single just only once
% coda margin
% mouse's tale acrostic mesostic spine
%%%%%%%% PSEUDOINDENT FUNCTIONS %%%%%%%%
% these two functions are for indenting individual systems
% - to left-indent a system, apply \pseudoIndent before the music continues
% - \pseudoIndents is similar, but lets you also indent on the right
% - both provide an option for changing that system's instrument names
% N.B. these functions
% - assume application to non-ragged lines (generally the default)
% - include a manual \break to ensure application at line start
% - misbehave if called more than once at the same line start
% the parameters of the (full) pseudoIndents function are:
% 1: name-tweaks
% usually omitted; accepts replacement \markup for instrument names
% as an ordered list; starred elements leave their i-names unchanged.
% 2: left-indent
% additional left-indentation, in staff-space units; can be negative,
% but avoid a total indentation which implies (unsupported) stretching.
% 3: right-indent
% amount of right-indentation, in staff-space units; can be negative.
% - not offered by the (reduced) pseudoIndent function
pseudoIndents = % inline alternative to a new \score, also with right-indent
#(define-music-function (name-tweaks left-indent right-indent)
((markup-list? '()) number? number?)
(define (warn-stretched p1 p2) (ly:input-warning (*location*) (G_
" pseudoIndents ~s ~s is stretching staff; expect distorted layout") p1 p2))
(let* (
(narrowing (+ left-indent right-indent)) ; of staff implied by args
(set-staffsymbol! (lambda (staffsymbol-grob) ; change staff to new width
(let* (
(left-bound (ly:spanner-bound staffsymbol-grob LEFT))
(left-moment (ly:grob-property left-bound 'when))
(capo? (moment<=? left-moment ZERO-MOMENT)) ; in first system of score
(layout (ly:grob-layout staffsymbol-grob))
(lw (ly:output-def-lookup layout 'line-width)) ; debugging info
(indent (ly:output-def-lookup layout (if capo? 'indent 'short-indent)))
(old-stil (ly:staff-symbol::print staffsymbol-grob))
(staffsymbol-x-ext (ly:stencil-extent old-stil X))
;; >=2.19.16's first system has old-stil already narrowed [2]
;; compensate for this (ie being not pristine) when calculating
;; - old leftmost-x (its value is needed when setting so-called 'width)
;; - the new width and position (via local variable narrowing_)
(ss-t (ly:staff-symbol-line-thickness staffsymbol-grob))
(pristine? (<= 0 (car staffsymbol-x-ext) ss-t)) ; would expect half
(leftmost-x (+ indent (if pristine? 0 narrowing)))
(narrowing_ (if pristine? narrowing 0)) ; uses 0 if already narrowed
(old-width (+ (interval-length staffsymbol-x-ext) ss-t))
(new-width (- old-width narrowing_))
(new-rightmost-x (+ leftmost-x new-width)) ; and set! this immediately
(junk (ly:grob-set-property! staffsymbol-grob 'width new-rightmost-x))
(in-situ-stil (ly:staff-symbol::print staffsymbol-grob))
(new-stil (ly:stencil-translate-axis in-situ-stil narrowing_ X))
;(new-stil (stencil-with-color new-stil red)) ; for when debugging
(new-x-ext (ly:stencil-extent new-stil X)))
(ly:grob-set-property! staffsymbol-grob 'stencil new-stil)
(ly:grob-set-property! staffsymbol-grob 'X-extent new-x-ext)
)))
(set-X-offset! (lambda (margin-grob) ; move grob across to line start
(let* (
(old (ly:grob-property-data margin-grob 'X-offset))
(new (lambda (grob) (+ (if (procedure? old) (old grob) old) narrowing))))
(ly:grob-set-property! margin-grob 'X-offset new))))
(tweak-text! (lambda (i-name-grob mkup) ; tweak both instrumentname texts
(if (and (markup? mkup) (not (string=? (markup->string mkup) "*")))
(begin
(ly:grob-set-property! i-name-grob 'long-text mkup)
(ly:grob-set-property! i-name-grob 'text mkup)
)))) ; else retain existing text
(install-narrowing (lambda (leftedge-grob) ; on staves, + adapt left margin
(let* (
(sys (ly:grob-system leftedge-grob))
(all-grobs (ly:grob-array->list (ly:grob-object sys 'all-elements)))
(grobs-named (lambda (name)
(filter (lambda (x) (eq? name (grob::name x))) all-grobs)))
(first-leftedge-grob (list-ref (grobs-named 'LeftEdge) 0))
(relsys-x-of (lambda (g) (ly:grob-relative-coordinate g sys X)))
(leftedge-x (relsys-x-of first-leftedge-grob))
(leftedged? (lambda (g) (= (relsys-x-of g) leftedge-x)))
(leftedged-ss (filter leftedged? (grobs-named 'StaffSymbol))))
(if (eq? leftedge-grob first-leftedge-grob) ; ignore other leftedges [1]
(begin
(for-each set-staffsymbol! leftedged-ss)
(for-each set-X-offset! (grobs-named 'SystemStartBar))
(for-each set-X-offset! (grobs-named 'InstrumentName))
(for-each tweak-text! (grobs-named 'InstrumentName) name-tweaks)
))))))
(if (negative? narrowing) (warn-stretched left-indent right-indent))
#{ % and continue anyway
% ensure that these overrides are applied only at begin-of-line
\break % (but this does not exclude unsupported multiple application)
% give the spacing engine notice regarding the loss of width for music
\once \override Score.LeftEdge.X-extent = #(cons narrowing narrowing)
% discard line start region of staff and reassemble left-margin elements
\once \override Score.LeftEdge.after-line-breaking = #install-narrowing
% shift the system to partition the narrowing between left and right
\overrideProperty Score.NonMusicalPaperColumn.line-break-system-details
.X-offset #(- right-indent)
% prevent a leftmost barnumber entering a stretched staff
\once \override Score.BarNumber.horizon-padding = #(max 1 (- 1 narrowing))
#}))
pseudoIndent = % for changing just left-indent
#(define-music-function (name-tweaks left-indent)
((markup-list? '()) number?)
#{
\pseudoIndents $name-tweaks $left-indent 0
#})
% [1] versions <2.19.1 can have end-of-line leftedges too
% - these were eliminated in issue 3761
% [2] versions >=2.19.16: the first system behaves differently from the rest
% - a side effect of issue 660 ?
% [3] versions >=2.23.0: LeftEdge's position may well differ in Y (but not in X)
% - a side effect of issue 6084 ?

View File

@@ -2,10 +2,14 @@
poetPrefix = "Worte:"
composerPrefix = "Weise:"
compositionPrefix = "Satz:"
adaptionTextPrefix = "Bearbeitung Text:"
adaptionMusicPrefix = "Bearbeitung Musik:"
poetAndComposerEqualPrefix = "Worte und Weise:"
voicePrefix = "Stimme:"
versePrefix = "Strophe:"
translationAuthorPrefix = "Übersetzung:"
translationPrefix = "Übersetzung:"
pronunciationPrefix = "Aussprache:"
interludePrefix = "Zwischenspiel:"
bridgePrefix = "Bridge:"
@@ -41,22 +45,34 @@
(year_melody (chain-assoc-get 'songinfo:year_melody props #f))
(poet-with-year (if (and poet-maybe-with-composer year_text) (string-append poet-maybe-with-composer ", " year_text) poet-maybe-with-composer))
(composer-with-year (if (and composer year_melody) (string-append composer ", " year_melody) composer))
(poet-and-composer-oneliner (if (and poet-with-year composer-with-year) (markup poet-with-year between-poet-and-composer-markup composer-with-year) #f))
(string-with-paragraphs->markuplist (lambda (prefix text)
(if text
(apply append
(map
(lambda (paragraph)
(make-wordwrap-internal-markup-list #t
#{ \markuplist { $(ly:parser-include-string paragraph) } #}))
(ly:regex-split (ly:make-regex "\n[ \t\n]*\n[ \t\n]*") (string-append prefix text))))
'())))
(poet-and-composer-markup-list
(string-with-paragraphs->markuplist "" (string-append
(if poet-with-year (string-append "\n\n" poet-with-year) "")
(if composer-with-year (string-append "\n\n" composer-with-year) "")
)))
(poet-and-composer-oneliner (if (and poet-with-year composer-with-year) (make-line-markup (cons (cadr poet-and-composer-markup-list) (cons between-poet-and-composer-markup (cddr poet-and-composer-markup-list)))) #f))
(current-line-width (chain-assoc-get 'line-width props (ly:output-def-lookup layout 'line-width))))
(stack-lines DOWN 0.0 (chain-assoc-get 'baseline-skip props)
(interpret-markup-list layout props
(append
(if (and poet-and-composer-oneliner (< (interval-length (ly:stencil-extent (interpret-markup layout props poet-and-composer-oneliner) X)) current-line-width))
(list poet-and-composer-oneliner)
(make-wordwrap-string-internal-markup-list #t (string-append
(if poet-with-year (string-append "\n\n" poet-with-year) "")
(if composer-with-year (string-append "\n\n" composer-with-year) "")
)))
(make-wordwrap-string-internal-markup-list #t (string-append
(if copyright (string-append "\n\n© " copyright) "")
(if infotext (string-append "\n\n" infotext) "")
(if translation (string-append "\n\nÜbersetzung: " translation) "")
(if pronunciation (string-append "\n\nAussprache: " pronunciation) ""))))))))
poet-and-composer-markup-list)
(string-with-paragraphs->markuplist "" (string-append
(if copyright (string-append "\n\n© " copyright) "")))
(string-with-paragraphs->markuplist "" infotext)
(string-with-paragraphs->markuplist (string-append (ly:output-def-lookup layout 'translationPrefix) " ") translation)
(string-with-paragraphs->markuplist (string-append (ly:output-def-lookup layout 'pronunciationPrefix) " ") pronunciation)
)))))
(make-null-markup)
)
}

View File

@@ -3,9 +3,9 @@ songMargin = 5
songInfoFontSize = 0
songInfoLineWidthFraction = 0.9
songTitleSize = 6
songTitleFont = "LilyPond Sans"
songChordFont = "LilyPond Sans"
songLyricFont = "LilyPond Sans"
songTitleFont = "Liberation Sans"
songChordFont = "Liberation Sans"
songLyricFont = "Liberation Sans"
songChordFontSeries = #'bold
songTextChordAlignment = #'left
songScoreChordFontSize = 2
@@ -18,6 +18,18 @@ lyricSize = 1.6
stanzaFormat = "~a."
romanStanzaFormat = "~@r."
refString = "Ref.:"
refStringWithNumbers = "Ref. ~a:"
% hübsche Wiederholungszeichen für den Liedtext
repStart = "𝄆"
repStop = "𝄇"
customChordPrintings = {}
\paper {
cueMarkup = \markup {
\italic
#(make-on-the-fly-markup (lambda (layout props m)
(interpret-markup layout props
(string-join (map (lambda (n) (format #f "~@r." n)) (chain-assoc-get 'cues props)) ", ")))
(make-null-markup))
}
}

View File

@@ -4,15 +4,15 @@
(interpret-markup-list layout (prepend-alist-chain 'songfilename songfilename props) markuplist))
#(define-markup-command (customEps layout props ysize filename)(number? string?)
#:properties ((songfilename "")
(defaultmarkup #f))
#:properties ((songfilename ""))
(interpret-markup layout props
(let ((filepath (if (string-null? songfilename)
(let ((defaulttitlemarkup (ly:output-def-lookup layout 'defaultTitleMarkup))
(filepath (if (string-null? songfilename)
filename
(ly:format "~a/~a/~a" songPath songfilename filename))))
(if (file-exists? filepath)
(make-epsfile-markup Y ysize filepath)
(if defaultmarkup
defaultmarkup
(if defaulttitlemarkup
defaulttitlemarkup
(ly:format "file does not exist ~a" filepath))
))))

View File

@@ -1,8 +1,8 @@
#(use-modules (ice-9 receive))
#(define (format-author layout authorId noDetails)
#(define (format-author author-format-function authorId noDetails)
(let ((author (if (defined? 'AUTHOR_DATA) (assoc-ref AUTHOR_DATA authorId) #f)))
(if author
((ly:output-def-lookup layout 'authorFormat)
(author-format-function
noDetails
(assoc-ref author "name")
(assoc-ref author "trail_name")
@@ -10,17 +10,25 @@
(assoc-ref author "death_year")
(assoc-ref author "organization")
)
"unbekannt")))
(if (string-null? authorId)
"unbekannt"
authorId))))
#(define (find-author-ids-by contributionType authors)
(filter-map (lambda (authordata) (if (member contributionType (cdr authordata)) (car authordata) #f)) authors))
(if authors
(filter-map (lambda (authordata) (if (member contributionType (cdr authordata)) (car authordata) #f)) authors)
(list)))
#(define (find-author-id-with-part-numbers contributionType authors)
(filter-map (lambda (authordata)
(let ((contributionNumbers (filter-map (lambda (contribution) (if (and (list? contribution) (equal? contributionType (car contribution))) (cadr contribution) #f)) (cdr authordata)))
(authorId (car authordata)))
(if (null? contributionNumbers) #f (cons authorId contributionNumbers))
)) authors))
(if authors
(sort-list
(filter-map (lambda (authordata)
(let ((contributionNumbers (filter-map (lambda (contribution) (if (and (list? contribution) (equal? contributionType (car contribution))) (cadr contribution) #f)) (cdr authordata)))
(authorId (car authordata)))
(if (null? contributionNumbers) #f (cons authorId (sort-list contributionNumbers <)))
)) authors)
(lambda (a b) (< (cadr a) (cadr b))))
(list)))
#(define-markup-command (print-songinfo layout props) ()
(define (songinfo-from songId key)
@@ -29,14 +37,17 @@
(assoc-ref song key)
(ly:warning (ly:format "song with id ~a not found" songId)))))
(define* (default-author-format authorId #:optional (noDetails #f))
(format-author (ly:output-def-lookup layout 'authorFormat) authorId noDetails))
(define (format-poet poetId)
(string-append (ly:output-def-lookup layout 'poetPrefix) " " (format-author layout poetId #f)))
(string-append (ly:output-def-lookup layout 'poetPrefix) " " (default-author-format poetId)))
(define (format-composer composerId)
(string-append (ly:output-def-lookup layout 'composerPrefix) " " (format-author layout composerId #f)))
(string-append (ly:output-def-lookup layout 'composerPrefix) " " (default-author-format composerId)))
(define (format-poet-and-composer authorId)
(string-append (ly:output-def-lookup layout 'poetAndComposerEqualPrefix) " " (format-author layout authorId #f)))
(string-append (ly:output-def-lookup layout 'poetAndComposerEqualPrefix) " " (default-author-format authorId)))
(define (numbered-contribution-prefix contributionNumbers prefixLookup)
(string-append
@@ -50,8 +61,7 @@
(define (format-authors authorIds)
(map (lambda (authorId)
(format-author
layout
(default-author-format
authorId
(if (member authorId referencedAuthors)
#t
@@ -67,22 +77,20 @@
(string-append contributionPrefix " " (string-join (format-authors authorIds) ", ")))
)
(define (join-present items joiner)
(string-join (filter (lambda (item) (and (string? item) (not (string-null? (string-trim-both item))))) items) joiner)
)
(define (render-partial-contribution-group prefixLookup authorData)
(if (null? authorData)
""
(let ((firstAuthorContributions (cdar authorData)))
(receive (authorDataSame authorDataOther)
(partition (lambda (authorEntry) (equal? (cdr authorEntry) firstAuthorContributions)) authorData)
(string-append
(join-present (list
(render-contribution-group (numbered-contribution-prefix firstAuthorContributions prefixLookup) (map car authorDataSame))
" "
(render-partial-contribution-group prefixLookup authorDataOther)
))))
)
(define (join-present items joiner)
(string-join (filter (lambda (item) (and (string? item) (not (string-null? (string-trim-both item))))) items) joiner)
)
) " ")))))
(define (poet-and-composer-from-authors authors)
(if authors
@@ -94,14 +102,28 @@
(verseComposerData (find-author-id-with-part-numbers 'meloverse authors))
(voiceComposerData (find-author-id-with-part-numbers 'voice authors))
(compositionIds (find-author-ids-by 'composition authors))
(adaptionTextIds (find-author-ids-by 'adaption_text authors))
(adaptionMusicIds (find-author-ids-by 'adaption_music authors))
(bridgeIds (find-author-ids-by 'bridge authors))
(interludeIds (find-author-ids-by 'interlude authors))
(year_text (chain-assoc-get 'header:year_text props #f))
(year_translation (chain-assoc-get 'header:year_translation props #f))
(year_melody (chain-assoc-get 'header:year_melody props #f))
(year_composition (chain-assoc-get 'header:year_composition props #f))
(year_adaption_text (chain-assoc-get 'header:year_adaption_text props #f))
(year_adaption_music (chain-assoc-get 'header:year_adaption_music props #f))
)
(if (and (equal? poetIds composerIds) (null? translatorIds) (null? versePoetData) (null? verseComposerData) (null? voiceComposerData) (null? compositionIds) (null? bridgeIds) (null? interludeIds))
(if (and
(equal? poetIds composerIds)
(null? translatorIds)
(null? versePoetData)
(null? verseComposerData)
(null? voiceComposerData)
(null? compositionIds)
(null? adaptionTextIds)
(null? adaptionMusicIds)
(null? bridgeIds)
(null? interludeIds))
(list
(join-present (list
(render-contribution-group (ly:output-def-lookup layout 'poetAndComposerEqualPrefix) poetIds)
@@ -120,12 +142,23 @@
) ", ")
(render-partial-contribution-group 'versePrefix versePoetData)
(join-present (list
(render-contribution-group (ly:output-def-lookup layout 'translationPrefix) translatorIds)
(render-contribution-group (ly:output-def-lookup layout 'translationAuthorPrefix) translatorIds)
year_translation
) ", ")
(join-present (list
(render-contribution-group (ly:output-def-lookup layout 'adaptionTextPrefix) adaptionTextIds)
year_adaption_text
) ", ")
) "; ")
))
(if (and (null? composerIds) (null? compositionIds) (null? verseComposerData) (null? voiceComposerData) (null? bridgeIds) (null? interludeIds)) #f
(if (and
(null? composerIds)
(null? compositionIds)
(null? adaptionMusicIds)
(null? verseComposerData)
(null? voiceComposerData)
(null? bridgeIds)
(null? interludeIds)) #f
(string-append
(ly:output-def-lookup layout 'composerPrefix)
" "
@@ -140,6 +173,10 @@
(render-contribution-group (ly:output-def-lookup layout 'compositionPrefix) compositionIds)
year_composition
) ", ")
(join-present (list
(render-contribution-group (ly:output-def-lookup layout 'adaptionMusicPrefix) adaptionMusicIds)
year_adaption_music
) ", ")
(render-contribution-group (ly:output-def-lookup layout 'bridgePrefix) bridgeIds)
(render-contribution-group (ly:output-def-lookup layout 'interludePrefix) interludeIds)
) "; ")
@@ -212,14 +249,14 @@
oddFooterMarkup = \markup {
\fill-line {
\line { \null }
\line { \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 }
}
}
evenFooterMarkup = \markup {
\fill-line {
\line { \if \should-print-page-number \print-pagenumber }
\line { \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 }
}
}

View File

@@ -0,0 +1,15 @@
includeFromSong =
#(define-void-function (filename) (string?)
(let ((noDefaultOutputBackup noDefaultOutput))
(set! noDefaultOutput #t)
(ly:parser-parse-string (ly:parser-clone)
(ly:format "\\include \"~a\""
(string-append
(dirname (dirname (dirname (dirname (current-filename)))))
file-name-separator-string
"lilypond-song-includes"
file-name-separator-string
"liedbausteine"
file-name-separator-string
filename)))
(set! noDefaultOutput noDefaultOutputBackup)))

View File

@@ -6,3 +6,8 @@ inline-score =
#{
\transposable #TRANSPOSITION #music
#})
fill-midi =
#(define-void-function (music) (ly:music?)
(set! INLINESCOREMUSIC #{ \INLINESCOREMUSIC #music #})
)

View File

@@ -0,0 +1,152 @@
(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
(define (yml-file->scm filename)
(let ((lines (read-lines filename)))
(parse-lines lines 0)))
;; Hilfsfunktion: Zeilen mit gleicher oder höherer Einrückung sammeln
(define (take-indented lines min-indent)
(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)))

View File

@@ -47,6 +47,55 @@ swing = \mark \markup {
}
}
swingOff = \mark \markup {
\line \general-align #Y #DOWN {
\score {
\new Staff \with {
fontSize = #-2
\override StaffSymbol.line-count = #0
% \override VerticalAxisGroup.Y-extent = #'(0 . 0)
}
\relative {
\stemUp
\override Score.SpacingSpanner.common-shortest-duration = #(ly:make-moment 3 16)
\override Beam.positions = #'(2 . 2)
h'8[ h8]
}
\layout {
ragged-right= ##t
indent = 0
\context {
\Staff \remove "Clef_engraver"
\remove "Time_signature_engraver"
}
}
}
" ="
\score {
\new Staff \with {
fontSize = #-2
\override StaffSymbol.line-count = #0
% \override VerticalAxisGroup.Y-extent = #'(0 . 0)
}
\relative {
\stemUp
\override Score.SpacingSpanner.common-shortest-duration = #(ly:make-moment 3 16)
\override Beam.positions = #'(2 . 2)
h'8 [h8]
}
\layout {
ragged-right= ##t
indent = 0
\context {
\Staff
\remove "Clef_engraver"
\remove "Time_signature_engraver"
}
}
}
}
}
\include "swing.ly"
swingMusic =
@@ -59,7 +108,7 @@ swingMusic =
(partial-duration-length (car es))
(if (ly:music? e)
(if (and (eq? name 'ContextSpeccedMusic) (eq? (ly:music-property e 'name) 'PartialSet))
(ly:duration-length (ly:music-property e 'duration))
(ly:duration->moment (ly:music-property e 'duration))
(if (eq? name 'NoteEvent)
ZERO-MOMENT
(partial-duration-length e)

View File

@@ -1,16 +1,6 @@
#(define-markup-command (bookTitleMarkupCustom layout props)()
(interpret-markup layout
(prepend-alist-chain 'defaultmarkup #{
\markup {
\override #'(baseline-skip . 3.5)
\center-column {
\override #`(font-name . ,songTitleFont) { \fontsize #songTitleSize \fromproperty #'header:title }
\large \bold \fromproperty #'header:subtitle
\smaller \bold \fromproperty #'header:subsubtitle
}
}
#}
(prepend-alist-chain 'songfilename (chain-assoc-get 'header:songfilename props "") props))
(prepend-alist-chain 'songfilename (chain-assoc-get 'header:songfilename props "") props)
(make-column-markup
(list
(make-vspace-markup (chain-assoc-get 'header:titletopspace props 0))
@@ -41,7 +31,7 @@
(ly:make-stencil
(list 'embedded-ps
(ly:format
"[/Action /GoTo /View [/Fit] /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
;'(0 . 0) '(0 . 0)
))
@@ -52,12 +42,9 @@
(starttext (chain-assoc-get 'header:starttext props #f))
(pdfbookmark (if starttext (string-append starttext " | " title) title)))
(if title
;(if (chain-assoc-get 'header:categories props #f)
(if right
#{\markup { \title-to-pdf-toc #pdfbookmark \fill-line \general-align #Y #UP { \null \bookTitleMarkupCustom \category-images } } #}
#{\markup { \title-to-pdf-toc #pdfbookmark \fill-line \general-align #Y #UP { \category-images \bookTitleMarkupCustom \null } } #})
;#{\markup \fill-line \general-align #Y #UP { \null \bookTitleMarkupCustom \null } #})
;(make-null-markup))
#{ \markup { " " } #})
)))
@@ -66,4 +53,12 @@
scoreTitleMarkup = \markup \null
oddHeaderMarkup = \markup { \if \on-first-page-of-part \title-with-category-images ##t }
evenHeaderMarkup = \markup { \if \on-first-page-of-part \title-with-category-images ##f }
defaultTitleMarkup = \markup {
\override #'(baseline-skip . 3.5)
\center-column {
\override #`(font-name . ,songTitleFont) { \fontsize #songTitleSize \fromproperty #'header:title }
\large \bold \fromproperty #'header:subtitle
\smaller \bold \fromproperty #'header:subsubtitle
}
}
}

View File

@@ -221,14 +221,28 @@
(cons (car x) (+ (cdr x) amount))
y)))
#(define-markup-command (score-equal-height layout props reference-height lines)
(number? markup-list?)
#(define-markup-command (score-equal-height-with-indents layout props lines)
(markup-list?)
#:category music
#:properties ((baseline-skip))
(stack-stencils Y DOWN baseline-skip
(map
(lambda (line) (ly:make-stencil (ly:stencil-expr line) (ly:stencil-extent line X) `(,(/ reference-height -2.0) . ,(/ reference-height 2.0))))
(interpret-markup-list layout props lines))))
#:properties ((intraverse-vspace 0)
(verse-line-height songTextLineHeigth)
(line-indents '()))
(let ((indents-max-index (- (length line-indents) 1)))
(stack-stencils Y DOWN intraverse-vspace
(index-map
(lambda (index line)
(let ((stil
(ly:make-stencil
(ly:stencil-expr line)
(ly:stencil-extent line X)
`(,(/ verse-line-height -2.0) . ,(/ verse-line-height 2.0)))))
(if (<= index indents-max-index)
(ly:stencil-translate-axis
stil
(list-ref line-indents index)
X)
stil)))
(interpret-markup-list layout props lines)))))
#(define-public (custom-lyric-text::print grob)
"Allow interpretation of tildes as lyric tieing marks."
@@ -243,26 +257,25 @@
#:properties ((verse-chords #{#})
(verse-reference-voice #{#})
(verse-break-voice #{#})
(verse-line-height songTextLineHeigth)
(verse-text-chord-distance songTextChordDistance)
(intraverse-vspace 0)
(transposition (cons #f #f))
(verselayout generalLayout))
"Vers mit Akkorden"
(interpret-markup layout props
#{
\markup {
\override #`(baseline-skip . ,intraverse-vspace)
\score-equal-height #verse-line-height \score-lines {
\transposable #transposition
\score-equal-height-with-indents \score-lines {
<<
\new Devnull { #verse-break-voice }
\new NullVoice = "dummyvoice" { #verse-reference-voice }
#(music-clone verse-chords)
\new Devnull { #(music-clone verse-break-voice) }
\new NullVoice = "dummyvoice" { #(music-clone verse-reference-voice) }
\transposable #transposition #(music-clone verse-chords)
\new Lyrics \lyricsto "dummyvoice" { #lyrics }
>>
\layout {
\verselayout
#(let
((custom-size (ly:output-def-lookup verselayout 'size #f)))
(if custom-size (layout-set-staff-size custom-size)))
ragged-right = ##t
\context {
\Lyrics
@@ -287,8 +300,10 @@
\override SpacingSpanner.spacing-increment = 0
\remove Bar_number_engraver
\remove Mark_engraver
\remove Jump_engraver
\remove Volta_engraver
\remove Parenthesis_engraver
\remove Metronome_mark_engraver
}
\context {
\Staff
@@ -310,13 +325,15 @@
\remove Tie_engraver
\remove Dynamic_engraver
\remove Note_heads_engraver
\remove Script_engraver
}
\context {
\NullVoice
\consists Rest_engraver
\omit Rest
% \undo \omit NoteHead
% \hide NoteHead
\undo \omit NoteHead
\hide NoteHead
\override NoteHead.X-extent = #'(0 . 0)
}
}
}

View File

@@ -26,7 +26,7 @@ appendix =
"call page-ref to appendix-item"
(interpret-markup layout props
(markup #:with-link label
#:override (cons 'appendixPage (make-page-ref-markup label "XXX" "?"))
#:override (cons 'appendixPage (make-page-ref-markup label "888" "?"))
(ly:output-def-lookup layout 'appendixReferenceMarkup))))
\paper {

View File

@@ -1,4 +1,5 @@
#(define song-list '())
#(define song-number 0)
#(define (files-in-directory dirname)
;;; Generate list containing filenames
@@ -9,7 +10,7 @@
(closedir dir)
files)
(else
(next (readdir dir) (if (string-match "^(0|\\.)" f) files (cons f files))))))))
(next (readdir dir) (if (ly:regex-match? (ly:regex-exec (ly:make-regex "^(0|\\.)") f)) files (cons f files))))))))
#(define (file-to-stats filename)
(set! song-list (cons filename song-list)))
@@ -114,7 +115,7 @@ width may require additional tweaking.)"
includeSong =
#(define-void-function (parser location textproc filename) ((procedure?) string?)
#(define-void-function (parser location filename) (string?)
#{
\bookOutputName #filename
#}
@@ -125,7 +126,15 @@ includeSong =
(acons label additional-page-numbers additional-page-switch-label-list))
(set! song-list
(acons (string->symbol filename)
(acons 'label label (acons 'header HEADER (acons 'music MUSIC (acons 'layout LAYOUT (acons 'text #{ \markuplist \setsongfilename $filename $(if textproc (textproc TEXT) TEXT) #} '())))))
(acons 'label label
(acons 'header HEADER
(acons 'music MUSIC
(acons 'layout LAYOUT
(acons 'text-pages
(map (lambda (text)
#{ \markuplist \setsongfilename $filename $text #})
TEXT_PAGES)
'())))))
song-list))
))
@@ -177,21 +186,23 @@ songs =
\markup { \pagecenter { \epsfile #X #xsize #filename } }
} #}
)
(let ((header #{ \bookpart { $(assq-ref songvars 'header) \header {
songfilename = $(symbol->string filename)
myindexlabel = #(assq-ref songvars 'label)
} } #})
;(header (assq-ref songvars 'header))
(music (assq-ref songvars 'music))
(layout (assq-ref songvars 'layout))
(text (assq-ref songvars 'text))
(label (assq-ref songvars 'label)))
(let* ((newnumber (+ 1 song-number))
(header #{ \bookpart { $(assq-ref songvars 'header) \header {
songfilename = $(symbol->string filename)
myindexlabel = #(assq-ref songvars 'label)
songnumber = #(number->string newnumber)
} } #})
(music (assq-ref songvars 'music))
(layout (assq-ref songvars 'layout))
(text-pages (assq-ref songvars 'text-pages))
(label (assq-ref songvars 'label)))
(set! song-number newnumber)
#{
\bookpart {
$header
\headerToTOC #header #label
\score { $music \layout { $layout } }
$text
$(add-text-pages text-pages)
}
#}))))))
(reverse song-list)

View File

@@ -56,24 +56,25 @@
#(let ((index-item-list (list)))
(set! add-index-item!
(lambda* (markup-symbol text sorttext #:optional (label (gensym "index")))
(lambda* (markup-symbol textoptions sorttext #:optional (label (gensym "index")))
(set! index-item-list
;; We insert index items sorted from the beginning on and do
;; not sort them later - this saves pretty much computing time
(insert-alphabetical-sorted! (list label markup-symbol text
(insert-alphabetical-sorted! (list label markup-symbol textoptions
;; this crazy hack is necessary because lilypond depends on guile 1.8 atm
;; and so the cool unicode conversion functions cannot be used
(ly:string-substitute " " ""
(ly:string-substitute "…" ""
(ly:string-substitute "Č" "C"
(ly:string-substitute "Đ" "D"
(ly:string-substitute "Š" "S"
(ly:string-substitute "Т" "T"
(ly:string-substitute "Ä" "Ae"
(ly:string-substitute "ä" "ae"
(ly:string-substitute "Ö" "O"
(ly:string-substitute "ö" "oe"
(ly:string-substitute "Ü" "U"
(ly:string-substitute "ü" "ue" sorttext))))))))))))
(ly:string-substitute "ü" "ue" sorttext)))))))))))))
index-item-list))
(make-music 'EventChord
'page-marker #t
@@ -91,20 +92,20 @@
(cons (car ilist) (insert-alphabetical-sorted! iitem (cdr ilist))))))
% code for category index
#(define*-public (add-category-index-item! categories markup-symbol text #:optional label) #f)
#(define*-public (add-category-index-item! categories markup-symbol textoptions #:optional label) #f)
#(define-public (category-index-items) #f)
#(let ((category-index-hash (make-hash-table)))
(set! add-category-index-item!
(lambda* (categories markup-symbol text #:optional (label (gensym "index")))
(lambda* (categories markup-symbol textoptions #:optional (label (gensym "index")))
(for-each (lambda (category)
(let* ((catsym (string->symbol category))
(catlist (hashq-ref category-index-hash catsym
(list (list label 'indexCategoryMarkup category)))))
(list (list label 'indexCategoryMarkup `(((rawtext . ,category))))))))
(if (assq catsym category-names)
(hashq-set! category-index-hash catsym
(cons (list label markup-symbol text) catlist))
(ly:error "song: <~a> category ~a is not defined!" (markup->string text) category))))
(cons (list label markup-symbol textoptions) catlist))
(ly:error "song: <~a> category ~a is not defined!" (markup->string (chain-assoc-get 'rawtext textoptions)) category))))
categories)
(make-music 'EventChord
'page-marker #t
@@ -120,13 +121,13 @@
#(let ((author-index-hash (make-hash-table)))
(set! add-author-index-item!
(lambda* (authorIDs markup-symbol text #:optional (label (gensym "index")))
(lambda* (authorIDs markup-symbol textoptions #:optional (label (gensym "index")))
(for-each (lambda (authorID)
(let* ((authorsym (string->symbol authorID))
(authorlist (hashq-ref author-index-hash authorsym
(list (list label 'indexAuthorMarkup authorID)))))
(list (list label 'indexAuthorMarkup `(((rawtext . ,authorID))))))))
(hashq-set! author-index-hash authorsym
(cons (list label markup-symbol text) authorlist))
(cons (list label markup-symbol textoptions) authorlist))
))
authorIDs)
(make-music 'EventChord
@@ -135,7 +136,12 @@
'elements (list (make-music 'LabelEvent
'page-label label)))))
(set! author-index-items (lambda ()
(hash-fold (lambda (authorsym authorlist previous-author-items) (append previous-author-items (reverse authorlist))) '() author-index-hash))))
(append-map cdr
(sort-list
(hash-map->list
(lambda (authorsym authorlist) (cons (string-downcase (symbol->string authorsym)) (reverse authorlist)))
author-index-hash)
(lambda (a b) (string-ci<? (car a) (car b))))))))
#(define-markup-command (with-link-symbol-ref layout props symbol arg)
@@ -161,39 +167,46 @@
(markup #:override (cons 'baseline-skip 3.5) (if catname (make-left-column-markup (string-split (cadr catname) #\newline)) category)))))
#(define-markup-command (index-item-with-pattern layout props)()
(let (
(text (chain-assoc-get 'index:text props))
(page (chain-assoc-get 'index:page props))
#:properties ((index:text "")
(index:alternative #f)
(index:page #f)
(line-width))
(let* (
(width (-
(chain-assoc-get 'line-width props)
line-width
(interval-length (ly:stencil-extent (interpret-markup layout props "XXXX") X))))
)
(interpret-markup layout props
(make-column-markup
(let ((revlist
(if (markup? text)
(list text)
(reverse (map (lambda (stil) (markup #:stencil stil))
(wordwrap-string-internal-markup-list layout
(cons (if (chain-assoc-get 'alternative text)
(list (cons 'line-width width) (cons 'font-shape 'italic))
(list (cons 'line-width width))) props) #f
(chain-assoc-get 'rawtext text))))))
(target-size-markup
(lines-reversed
(reverse (map (lambda (stil) (markup #:stencil stil))
(wordwrap-string-internal-markup-list layout
(prepend-alist-chain 'line-width width
(if index:alternative
(prepend-alist-chain 'font-shape 'italic props)
props))
#f
index:text))))
(last-line-with-dots (make-fill-with-pattern-markup 1 RIGHT "." (car lines-reversed) index:page))
(lines-without-dots (cdr lines-reversed))
(target-line-size-markup
(make-column-markup
(list
(make-simple-markup "Agj")
(make-vspace-markup 0.2))))
)
(reverse (map (lambda (m)
(make-size-box-to-box-markup #f #t m target-size-markup))
(cons
(make-with-link-symbol-ref-markup 'index:label (make-fill-with-pattern-markup 1 RIGHT "." (car revlist) page))
(cdr revlist)))))))))
)
(interpret-markup layout props
(make-size-box-to-box-markup #f #t
(make-with-link-symbol-ref-markup 'index:label
(make-column-markup
(reverse (cons
last-line-with-dots
(map (lambda (m) (make-size-box-to-box-markup #f #t m target-line-size-markup)) lines-without-dots)))))
; this column is just to have a reference height for resizing
(make-column-markup
(reverse (map (lambda (m) (make-size-box-to-box-markup #f #t m target-line-size-markup)) (cons last-line-with-dots lines-without-dots))))
))))
\paper {
indexItemMarkup = \markup {
\index-item-with-pattern
\sans \index-item-with-pattern
}
indexSectionMarkup = \markup \override #'(baseline-skip . 1.5) \left-column {
\sans \bold \fontsize #3 \fromproperty #'index:text
@@ -209,7 +222,7 @@
#(make-on-the-fly-markup
(lambda (layout props m)
(interpret-markup layout props
(make-justify-string-markup (format-author layout (chain-assoc-get 'index:text props #f) #f))))
(make-justify-string-markup (format-author (ly:output-def-lookup layout 'authorFormat) (chain-assoc-get 'index:text props #f) #t))))
(make-null-markup))
\vspace #.4
}
@@ -217,12 +230,17 @@
#(define (prepare-item-markup items layout)
(map (lambda (index-item)
(let ((label (car index-item))
(index-markup (cadr index-item))
(text (caddr index-item)))
(let* ((label (car index-item))
(index-markup (cadr index-item))
(textoptions (caddr index-item))
(text (chain-assoc-get 'rawtext textoptions))
(alternative (chain-assoc-get 'alternative textoptions))
(songnumber (chain-assoc-get 'songnumber textoptions)))
(markup #:override (cons 'index:label label)
#:override (cons 'index:page (markup #:custom-page-number label -1))
#:override (cons 'index:text text)
#:override (cons 'index:alternative alternative)
#:override (cons 'index:songnumber songnumber)
(ly:output-def-lookup layout index-markup))))
(items)))
@@ -243,12 +261,12 @@
indexItem =
#(define-music-function (parser location sorttext text) (string? markup?)
"Add a line to the alphabetical index, using the @code{indexItemMarkup} paper variable markup."
(add-index-item! 'indexItemMarkup text sorttext))
(add-index-item! 'indexItemMarkup (prepend-alist-chain 'rawtext text '()) sorttext))
indexSection =
#(define-music-function (parser location sorttext text) (string? markup?)
"Add a section line to the alphabetical index, using @code{indexSectionMarkup} paper variable markup. This can be used to divide the alphabetical index into different sections, for example one section for each first letter."
(add-index-item! 'indexSectionMarkup text sorttext))
(add-index-item! 'indexSectionMarkup (prepend-alist-chain 'rawtext text '()) sorttext))
#(define (extract-and-check-vars-from-header bookheader varlist)
(let* ((headervars (hash-map->list cons (struct-ref (ly:book-header bookheader) 0)))
@@ -269,30 +287,36 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
(verseComposerData (find-author-id-with-part-numbers 'meloverse authors))
(voiceComposerData (find-author-id-with-part-numbers 'voice authors))
(compositionIds (find-author-ids-by 'composition authors))
(adaptionIds (find-author-ids-by 'adaption authors))
(bridgeIds (find-author-ids-by 'bridge authors))
(interludeIds (find-author-ids-by 'interlude authors)))
(delete-duplicates
(append poetIds translatorIds (map car versePoetData) composerIds (map car verseComposerData) (map car voiceComposerData) compositionIds bridgeIds interludeIds))
(append poetIds translatorIds (map car versePoetData) composerIds (map car verseComposerData) (map car voiceComposerData) compositionIds adaptionIds bridgeIds interludeIds))
))
(let*
(
(extractedheadervars (extract-and-check-vars-from-header header '(title starttext alttitle altalttitle categorytitle categories authors)))
(extractedheadervars (extract-and-check-vars-from-header header '(title starttext alttitle categorytitle categories authors songnumber)))
(title (assq-ref extractedheadervars 'title))
(starttext (assq-ref extractedheadervars 'starttext))
(alttitle (assq-ref extractedheadervars 'alttitle))
(altalttitle (assq-ref extractedheadervars 'altalttitle))
(categorytitle (assq-ref extractedheadervars 'categorytitle))
(categories (assq-ref extractedheadervars 'categories))
(authors (assq-ref extractedheadervars 'authors))
(add-to-toc! (lambda (toctitle tocmarkup)
(add-index-item! 'indexItemMarkup tocmarkup toctitle label)))
(songnumber (assq-ref extractedheadervars 'songnumber))
(textoptions (lambda (text alternative) `(((rawtext . ,text) (alternative . ,alternative) (songnumber . ,songnumber)))))
(add-to-toc! (lambda (toctitle alternative)
(add-index-item! 'indexItemMarkup (textoptions toctitle alternative) toctitle label)))
)
(if categories (add-category-index-item! (string-tokenize categories) 'indexItemMarkup (cons (list (cons 'rawtext (if categorytitle categorytitle title))) '()) label))
(if authors (add-author-index-item! (all-author-ids authors) 'indexItemMarkup (cons (list (cons 'rawtext (if categorytitle categorytitle title))) '()) label))
(if starttext (add-to-toc! starttext (cons (list (cons 'rawtext starttext) (cons 'alternative #t)) '())))
(if alttitle (add-to-toc! alttitle (cons (list (cons 'rawtext alttitle) (cons 'alternative #t)) '())))
(if altalttitle (add-to-toc! altalttitle (cons (list (cons 'rawtext altalttitle) (cons 'alternative #t)) '())))
(if title (add-to-toc! title (cons (list (cons 'rawtext title)) '())) #{ #})
(if categories (add-category-index-item! (string-tokenize categories) 'indexItemMarkup (textoptions (if categorytitle categorytitle title) #f) label))
(if authors (add-author-index-item! (all-author-ids authors) 'indexItemMarkup (textoptions (if categorytitle categorytitle title) #f) label))
(if starttext (add-to-toc! starttext #t))
(if alttitle
(if (list? alttitle)
(for-each (lambda (alt)
(add-to-toc! alt #t))
alttitle)
(add-to-toc! alttitle #t)))
(if title (add-to-toc! title #f) #{ #})
))
@@ -317,7 +341,7 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
(ly:string-substitute "\"" "\\\"" field))
"\"")))
(define (format-authors authorIds)
(string-join (map (lambda (authorId) (format-author layout authorId #f)) authorIds) ", "))
(string-join (map (lambda (authorId) (format-author (ly:output-def-lookup layout 'authorFormat) authorId #f)) authorIds) ", "))
(define cr-regex (ly:make-regex "\r"))
(define crlf-regex (ly:make-regex "\r\n"))
(define para-sep-regex (ly:make-regex "\n[ \t\n]*\n[ \t\n]*"))
@@ -345,7 +369,7 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
(songvars (cdr song))
(page-number (number->string (assoc-get (assq-ref songvars 'label) labelPageTable)))
(extractedheadervars (extract-and-check-vars-from-header (assq-ref songvars 'header)
'(title starttext alttitle altalttitle categorytitle categories authors year_text year_melody year_translation year_composition infotext translation pronunciation copyright source)))
'(title starttext alttitle categorytitle categories authors year_text year_melody year_translation year_composition year_adaption infotext translation pronunciation copyright source)))
(headervar-or-empty (lambda (varsym)
(let ((extracted (assq-ref extractedheadervars varsym)))
(if extracted extracted ""))))
@@ -357,6 +381,8 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
(verseComposerData (find-author-id-with-part-numbers 'meloverse authors))
(voiceComposerData (find-author-id-with-part-numbers 'voice authors))
(compositionIds (find-author-ids-by 'composition authors))
(adaptionTextIds (find-author-ids-by 'adaption_text authors))
(adaptionMusicIds (find-author-ids-by 'adaption_music authors))
(bridgeIds (find-author-ids-by 'bridge authors))
(interludeIds (find-author-ids-by 'interlude authors)))
(map csv-escape
@@ -365,17 +391,22 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
page-number
(headervar-or-empty 'title)
(headervar-or-empty 'starttext)
(headervar-or-empty 'alttitle)
(headervar-or-empty 'altalttitle)
(let ((alttitle-value (headervar-or-empty 'alttitle)))
(if (list? alttitle-value)
(string-join alttitle-value ", ") ; Wenn eine Liste, dann zusammenfügen
alttitle-value)) ; Wenn kein Liste, den originalen Wert verwenden
(headervar-or-empty 'categorytitle)
(headervar-or-empty 'categories)
(format-authors (append poetIds (map car versePoetData)))
(format-authors (append poetIds adaptionTextIds (map car versePoetData)))
(format-authors translatorIds)
(format-authors (append composerIds compositionIds bridgeIds interludeIds (map car voiceComposerData) (map car verseComposerData)))
(format-authors (append composerIds compositionIds adaptionMusicIds bridgeIds interludeIds (map car voiceComposerData) (map car verseComposerData)))
(headervar-or-empty 'year_text)
(headervar-or-empty 'year_melody)
(headervar-or-empty 'year_translation)
(headervar-or-empty 'year_composition)
(headervar-or-empty 'year_adaption_text)
(headervar-or-empty 'year_adaption_music)
(headervar-or-empty 'copyright)
(headervar-or-empty 'source)
(format-info-paragraphs (headervar-or-empty 'infotext))
@@ -391,7 +422,6 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
"title"
"starttext"
"alttitle"
"altalttitle"
"categorytitle"
"categories"
"poets"
@@ -401,6 +431,8 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
"year_melody"
"year_translation"
"year_composition"
"year_adaption_text"
"year_adaption_music"
"copyright"
"source"
"infotext"

View File

@@ -0,0 +1,3 @@
\include "../private_includes/book/book_include.ily"
\include "../private_includes/book/toc_include.ily"
\include "../private_includes/book/appendix.ily"

View File

@@ -0,0 +1,88 @@
% set the speed of the midi music
#(define midiQuarterNoteSpeed (if (defined? 'midiQuarterNoteSpeed) midiQuarterNoteSpeed 90))
MUSIC = { \transposable #TRANSPOSITION \MUSIC }
verselayout = \layout {
\LAYOUT
\context {
\ChordNames
\override ChordName.font-size = \songTextChordFontSize
}
}
LAYOUT = \layout {
\LAYOUT
#(let
((custom-size (ly:output-def-lookup LAYOUT 'size #f)))
(if custom-size (layout-set-staff-size custom-size)))
}
TEXT = \markuplist {
\override #`(transposition . ,TRANSPOSITION)
\override #`(verselayout . ,verselayout)
\override #`(verse-chords . ,#{ \chords { \verseChords } #})
\override #`(verse-reference-voice . ,#{ \global \firstVoice #})
\TEXT
}
#(define TEXT_PAGES
(map
(lambda (text) #{
\markuplist {
\override #`(transposition . ,TRANSPOSITION)
\override #`(verselayout . ,verselayout)
\override #`(verse-chords . ,#{ \chords { \verseChords } #})
\override #`(verse-reference-voice . ,#{ \global \firstVoice #})
#text
}
#})
(if
(and
(defined? 'TEXT_PAGES)
(pair? TEXT_PAGES))
TEXT_PAGES
(list TEXT))))
#(define (add-text-pages text-pages)
(if (pair? text-pages)
(begin
(add-score (car text-pages))
(for-each
(lambda (text)
(add-music (pageBreak))
(add-score text))
(cdr text-pages)))))
#(if (not noStandaloneOutput)
(begin
(let ((header (ly:book-header HEADER)) (paper (ly:book-paper HEADER)))
(if header (set! $defaultheader header))
(if paper (set! $defaultpaper paper))
)
(add-score #{
\score {
\MUSIC
\layout { \LAYOUT }
}#})
(add-text-pages TEXT_PAGES)
(add-score #{
\score {
\unfoldRepeats { \MUSIC \INLINESCOREMUSIC }
\midi {
\context {
\Score
% Tempo des midi files
tempoWholesPerMinute = #(/ midiQuarterNoteSpeed 4)
}
\context {
\Staff
\remove "Staff_performer"
}
\context {
\Voice
\consists "Staff_performer"
}
}
}#})
))

View File

@@ -1,6 +1,5 @@
\version "2.25.8"
#(ly:set-option 'relative-includes #t)
#(define noDefaultOutput #t)
\include "all_base_includes.ly"
\include "../private_includes/base/all.ily"

View File

@@ -4,4 +4,4 @@ HEADER = \bookpart {
\basicSongInfo
}
}
\include #(if noDefaultOutput "void.ly" "standalone_output.ly")
\include #(if noDefaultOutput "../private_includes/void.ily" "layout_bottom.ily")

View File

@@ -2,4 +2,4 @@
#(define noDefaultOutput (if (defined? 'noDefaultOutput) noDefaultOutput #f))
\include #(if noDefaultOutput "void.ly" "all_base_includes.ly")
\include #(if noDefaultOutput "../private_includes/void.ily" "../private_includes/base/all.ily")

View File

@@ -1,482 +0,0 @@
;;; (json parser) --- Guile JSON implementation.
;; Copyright (C) 2013-2020 Aleix Conchillo Flaque <aconchillo@gmail.com>
;;
;; This file is part of guile-json.
;;
;; guile-json is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3 of the License, or
;; (at your option) any later version.
;;
;; guile-json is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with guile-json. If not, see https://www.gnu.org/licenses/.
;;; Commentary:
;; JSON module for Guile
;;; Code:
(define-module (json parser)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 streams)
#:use-module (rnrs io ports)
#:export (json->scm
json-string->scm
json-seq->scm
json-seq-string->scm))
;;
;; Miscellaneuos helpers
;;
(define (json-exception port)
(throw 'json-invalid port))
(define (digit? c)
(case c
((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) #t)
(else #f)))
(define (whitespace? c)
(case c
((#\sp #\ht #\lf #\cr) #t)
(else #f)))
(define (control-char? ch)
(<= (char->integer ch) #x1F))
(define (skip-whitespaces port)
(let ((ch (peek-char port)))
(cond
((whitespace? ch)
(read-char port)
(skip-whitespaces port))
(else *unspecified*))))
(define (expect-string port expected return)
(let loop ((n 0))
(cond
;; All characters match.
((= n (string-length expected)) return)
;; Go to next characters.
((eqv? (read-char port) (string-ref expected n))
(loop (+ n 1)))
;; Anything else is an error.
(else (json-exception port)))))
(define (expect-delimiter port delimiter)
(let ((ch (read-char port)))
(cond
((not (eqv? ch delimiter)) (json-exception port))
;; Unexpected EOF.
((eof-object? ch) (json-exception port)))))
(define (skip-record-separators port)
(when (eqv? #\rs (peek-char port))
(read-char port)
(skip-record-separators port)))
;;
;; Number parsing helpers
;;
(define (expect-digit port)
(let ((ch (peek-char port)))
(cond
((not (digit? ch)) (json-exception port))
;; Unexpected EOF.
((eof-object? ch) (json-exception port)))))
;; Read + or -, and return 1 or -1 respectively. If something different is
;; found, return 1.
(define (read-sign port)
(let ((ch (peek-char port)))
(cond
((eqv? ch #\+)
(read-char port)
1)
((eqv? ch #\-)
(read-char port)
-1)
(else 1))))
(define (read-digit-value port)
(let ((ch (read-char port)))
(cond
((eqv? ch #\0) 0)
((eqv? ch #\1) 1)
((eqv? ch #\2) 2)
((eqv? ch #\3) 3)
((eqv? ch #\4) 4)
((eqv? ch #\5) 5)
((eqv? ch #\6) 6)
((eqv? ch #\7) 7)
((eqv? ch #\8) 8)
((eqv? ch #\9) 9)
(else (json-exception port)))))
;; Read digits [0..9].
(define (read-digits port)
(expect-digit port)
(let loop ((ch (peek-char port)) (number 0))
(cond
((digit? ch)
(let ((value (read-digit-value port)))
(loop (peek-char port) (+ (* number 10) value))))
(else number))))
(define (read-digits-fraction port)
(expect-digit port)
(let loop ((ch (peek-char port)) (number 0) (length 0))
(cond
((digit? ch)
(let ((value (read-digit-value port)))
(loop (peek-char port) (+ (* number 10) value) (+ length 1))))
(else
(/ number (expt 10 length))))))
(define (read-exponent port)
(let ((ch (peek-char port)))
(cond
((or (eqv? ch #\e) (eqv? ch #\E))
(read-char port)
(let ((sign (read-sign port))
(digits (read-digits port)))
(if (<= digits 1000) ;; Some maximum exponent.
(expt 10 (* sign digits))
(json-exception port))))
(else 1))))
(define (read-fraction port)
(let ((ch (peek-char port)))
(cond
((eqv? ch #\.)
(read-char port)
(read-digits-fraction port))
(else 0))))
(define (read-positive-number port)
(let* ((number
(let ((ch (peek-char port)))
(cond
;; Numbers that start with 0 must be a fraction.
((eqv? ch #\0)
(read-char port)
0)
;; Otherwise read more digits.
(else (read-digits port)))))
(fraction (read-fraction port))
(exponent (read-exponent port))
(result (* (+ number fraction) exponent)))
(if (and (zero? fraction) (>= exponent 1))
result
(exact->inexact result))))
(define (json-read-number port)
(let ((ch (peek-char port)))
(cond
;; Negative numbers.
((eqv? ch #\-)
(read-char port)
(expect-digit port)
(* -1 (read-positive-number port)))
;; Positive numbers.
((digit? ch)
(read-positive-number port))
;; Anything else is an error.
(else (json-exception port)))))
;;
;; Object parsing helpers
;;
(define (read-pair port null ordered)
;; Read key.
(let ((key (json-read-string port)))
(skip-whitespaces port)
(let ((ch (peek-char port)))
(cond
;; Skip colon and read value.
((eqv? ch #\:)
(read-char port)
(cons key (json-read port null ordered)))
;; Anything other than colon is an error.
(else (json-exception port))))))
(define (json-read-object port null ordered)
(expect-delimiter port #\{)
(let loop ((pairs '()) (added #t))
(skip-whitespaces port)
(let ((ch (peek-char port)))
(cond
;; End of object.
((eqv? ch #\})
(read-char port)
(cond
(added (if ordered (reverse! pairs) pairs))
(else (json-exception port))))
;; Read one pair and continue.
((eqv? ch #\")
(let ((pair (read-pair port null ordered)))
(loop (cons pair pairs) #t)))
;; Skip comma and read more pairs.
((eqv? ch #\,)
(read-char port)
(cond
(added (loop pairs #f))
(else (json-exception port))))
;; Invalid object.
(else (json-exception port))))))
;;
;; Array parsing helpers
;;
(define (json-read-array port null ordered)
(expect-delimiter port #\[)
(skip-whitespaces port)
(cond
;; Special case when array is empty.
((eqv? (peek-char port) #\])
(read-char port)
#())
(else
;; Read first element in array.
(let loop ((values (list (json-read port null ordered))))
(skip-whitespaces port)
(let ((ch (peek-char port)))
(cond
;; Unexpected EOF.
((eof-object? ch) (json-exception port))
;; Handle comma (if there's a comma there should be another element).
((eqv? ch #\,)
(read-char port)
(loop (cons (json-read port null ordered) values)))
;; End of array.
((eqv? ch #\])
(read-char port)
(list->vector (reverse! values)))
;; Anything else other than comma and end of array is wrong.
(else (json-exception port))))))))
;;
;; String parsing helpers
;;
(define (read-hex-digit->integer port)
(let ((ch (read-char port)))
(cond
((eqv? ch #\0) 0)
((eqv? ch #\1) 1)
((eqv? ch #\2) 2)
((eqv? ch #\3) 3)
((eqv? ch #\4) 4)
((eqv? ch #\5) 5)
((eqv? ch #\6) 6)
((eqv? ch #\7) 7)
((eqv? ch #\8) 8)
((eqv? ch #\9) 9)
((or (eqv? ch #\A) (eqv? ch #\a)) 10)
((or (eqv? ch #\B) (eqv? ch #\b)) 11)
((or (eqv? ch #\C) (eqv? ch #\c)) 12)
((or (eqv? ch #\D) (eqv? ch #\d)) 13)
((or (eqv? ch #\E) (eqv? ch #\e)) 14)
((or (eqv? ch #\F) (eqv? ch #\f)) 15)
(else (json-exception port)))))
(define (read-unicode-value port)
(+ (* 4096 (read-hex-digit->integer port))
(* 256 (read-hex-digit->integer port))
(* 16 (read-hex-digit->integer port))
(read-hex-digit->integer port)))
;; Unicode codepoint with surrogates is:
;; 10000 + (high - D800) + (low - DC00)
;; which is equivalent to:
;; (high << 10) + low - 35FDC00
;; see
;; https://github.com/aconchillo/guile-json/issues/58#issuecomment-662744070
(define (json-surrogate-pair->unicode high low)
(+ (* high #x400) low #x-35FDC00))
(define (read-unicode-char port)
(let ((codepoint (read-unicode-value port)))
(cond
;; Surrogate pairs. `codepoint` already contains the higher surrogate
;; (between D800 and DC00) . At this point we are expecting another
;; \uXXXX that holds the lower surrogate (between DC00 and DFFF).
((and (>= codepoint #xD800) (< codepoint #xDC00))
(expect-string port "\\u" #f)
(let ((low-surrogate (read-unicode-value port)))
(if (and (>= low-surrogate #xDC00) (< low-surrogate #xE000))
(integer->char (json-surrogate-pair->unicode codepoint low-surrogate))
(json-exception port))))
;; Reserved for surrogates (we just need to check starting from the low
;; surrogates).
((and (>= codepoint #xDC00) (< codepoint #xE000))
(json-exception port))
(else (integer->char codepoint)))))
(define (read-control-char port)
(let ((ch (read-char port)))
(cond
((eqv? ch #\") #\")
((eqv? ch #\\) #\\)
((eqv? ch #\/) #\/)
((eqv? ch #\b) #\bs)
((eqv? ch #\f) #\ff)
((eqv? ch #\n) #\lf)
((eqv? ch #\r) #\cr)
((eqv? ch #\t) #\ht)
((eqv? ch #\u) (read-unicode-char port))
(else (json-exception port)))))
(define (json-read-string port)
(expect-delimiter port #\")
(let loop ((chars '()) (ch (read-char port)))
(cond
;; Unexpected EOF.
((eof-object? ch) (json-exception port))
;; Unescaped control characters are not allowed.
((control-char? ch) (json-exception port))
;; End of string.
((eqv? ch #\") (reverse-list->string chars))
;; Escaped characters.
((eqv? ch #\\)
(loop (cons (read-control-char port) chars) (read-char port)))
;; All other characters.
(else
(loop (cons ch chars) (read-char port))))))
;;
;; Booleans and null parsing helpers
;;
(define (json-read-true port)
(expect-string port "true" #t))
(define (json-read-false port)
(expect-string port "false" #f))
(define (json-read-null port null)
(expect-string port "null" null))
;;
;; Main parser functions
;;
(define (json-read port null ordered)
(skip-whitespaces port)
(let ((ch (peek-char port)))
(cond
;; Unexpected EOF.
((eof-object? ch) (json-exception port))
;; Read JSON values.
((eqv? ch #\t) (json-read-true port))
((eqv? ch #\f) (json-read-false port))
((eqv? ch #\n) (json-read-null port null))
((eqv? ch #\{) (json-read-object port null ordered))
((eqv? ch #\[) (json-read-array port null ordered))
((eqv? ch #\") (json-read-string port))
;; Anything else should be a number.
(else (json-read-number port)))))
;;
;; Public procedures
;;
(define* (json->scm #:optional (port (current-input-port))
#:key (null 'null) (ordered #f) (concatenated #f))
"Parse a JSON document into native. Takes one optional argument,
@var{port}, which defaults to the current input port from where the JSON
document is read. It also takes a few of keyword arguments: @{null}: value for
JSON's null, it defaults to the 'null symbol, @{ordered} to indicate whether
JSON objects order should be preserved or not (the default) and @{concatenated}
which can be used to tell the parser that more JSON documents might come after a
properly parsed document."
(let loop ((value (json-read port null ordered)))
;; Skip any trailing whitespaces.
(skip-whitespaces port)
(cond
;; If we reach the end the parsing succeeded.
((eof-object? (peek-char port)) value)
;; If there's anything else other than the end, check if user wants to keep
;; parsing concatenated valid JSON documents, otherwise parser fails.
(else
(cond (concatenated value)
(else (json-exception port)))))))
(define* (json-string->scm str #:key (null 'null) (ordered #f))
"Parse a JSON document into native. Takes a string argument,
@var{str}, that contains the JSON document. It also takes a couple of keyword
argument: @{null}: value for JSON's null, it defaults to the 'null symbol and
@{ordered} to indicate whether JSON objects order should be preserved or
not (the default)."
(call-with-input-string str (lambda (p) (json->scm p #:null null #:ordered ordered))))
(define* (json-seq->scm #:optional (port (current-input-port))
#:key (null 'null) (ordered #f)
(handle-truncate 'skip) (truncated-object 'truncated))
"Lazy parse a JSON text sequence from the port @var{port}.
This procedure returns a stream of parsed documents. The optional argument
@var{port} defines the port to read from and defaults to the current input
port. It also takes a few keyword arguments: @{null}: value for JSON's null
(defaults to the 'null symbol), @{ordered} to indicate whether JSON objects
order should be preserved or not (the default), @{handle-truncate}: defines how
to handle data loss, @{truncated-object}: used to replace unparsable
objects. Allowed values for @{handle-truncate} argument are 'throw (throw an
exception), 'stop (stop parsing and end the stream), 'skip (default, skip
corrupted fragment and return the next entry), 'replace (skip corrupted fragment
and return @{truncated-object} instead)."
(letrec ((handle-truncation
(case handle-truncate
((throw) json-exception)
((stop) (const (eof-object)))
((skip)
(lambda (port)
(read-delimited "\x1e" port 'peek)
(read-entry port)))
((replace)
(lambda (port)
(read-delimited "\x1e" port 'peek)
truncated-object))))
(read-entry
(lambda (port)
(let ((ch (read-char port)))
(cond
((eof-object? ch) ch)
((not (eqv? ch #\rs))
(handle-truncation port))
(else
(skip-record-separators port)
(catch 'json-invalid
(lambda ()
(let ((next (json-read port null ordered)))
(if (eqv? #\lf (peek-char port))
(begin
(read-char port)
next)
(handle-truncation port))))
(lambda (_ port)
(handle-truncation port)))))))))
(port->stream port read-entry)))
(define* (json-seq-string->scm str #:key (null 'null) (ordered #f)
(handle-truncate 'skip) (truncated-object 'truncated))
"Lazy parse a JSON text sequence from the string @var{str}.
This procedure returns a stream of parsed documents and also takes the same
keyword arguments as @code{json-seq->scm}."
(call-with-input-string str
(lambda (p)
(json-seq->scm p #:null null #:ordered ordered
#:handle-truncate handle-truncate
#:truncated-object truncated-object))))
;;; (json parser) ends here

View File

@@ -1,10 +0,0 @@
(use-modules (ice-9 popen) (ice-9 textual-ports) (json parser))
(define (yml-file->scm filename)
(let* ((python_cmd (string-append "import sys, yaml, json; print(json.dumps(yaml.safe_load(open('" filename "'))))"))
(pipe (open-pipe* OPEN_READ "python3" "-c" python_cmd))
(json (get-string-all pipe)))
(close-pipe pipe)
(json-string->scm json)))
(define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename)))

View File

@@ -1,44 +0,0 @@
% set the speed of the midi music
#(define midiQuarterNoteSpeed (if (defined? 'midiQuarterNoteSpeed) midiQuarterNoteSpeed 90))
MUSIC = { \transposable #TRANSPOSITION \MUSIC }
verselayout = \layout {
\LAYOUT
\context {
\ChordNames
\override ChordName.font-size = \songTextChordFontSize
}
}
TEXT = \markuplist {
\override #`(transposition . ,TRANSPOSITION)
\override #`(verselayout . ,verselayout)
\override #`(verse-chords . ,#{ \chords { \verseChords } #})
\override #`(verse-reference-voice . ,#{ \global \firstVoice #})
\TEXT
}
#(if (not noStandaloneOutput)
(begin
(let ((header (ly:book-header HEADER)) (paper (ly:book-paper HEADER)))
(if header (set! $defaultheader header))
(if paper (set! $defaultpaper paper))
)
(add-score #{
\score {
\MUSIC
\layout { \LAYOUT }
}#})
(add-score TEXT)
(add-score #{
\score {
\unfoldRepeats { \MUSIC \INLINESCOREMUSIC }
\midi {
\context {
\Score
% Tempo des midi files
tempoWholesPerMinute = #(ly:make-moment midiQuarterNoteSpeed 4)
}
}
}#})
))

View File

@@ -1,16 +0,0 @@
#(define bookStyle
(if (not (defined? 'bookStyle))
#f
bookStyle))
#(define songStyle
(if (not (defined? 'songStyle))
(if (not (defined? 'defaultSongStyle)) 'default defaultSongStyle)
songStyle))
#(if (not (boolean? bookStyle))
(set! songStyle bookStyle))
#(define (bock-style layout props)
"Whether we have bockstyle or not"
(eq? songStyle 'bock))