66 Commits
Author SHA1 Message Date
tux 39d9e8c0d5 use lilypond 2.27 and be compatibel to 2.26 2026-10-22 12:54:22 +02:00
tux dfd72cd64d layout size for inline-scores 2026-10-22 11:59:27 +02:00
tux d0db6fae69 finetuning chord lyrics engraver 2026-10-22 11:47:48 +02:00
tux 2359a7c5ae Mehrere Lieder auf eine Seite 2026-10-11 23:20:40 +02:00
zuk 809100b2f3 define rehearsalMarkFormatter 2026-08-28 13:11:47 +02:00
tux 7de31cf0dd chapter toc 2026-07-07 12:16:13 +02:00
tux ae72640b1a chapters for every pagetype 2026-07-07 11:05:47 +02:00
tux 7076b16b63 Use chapters for digital toc
* introduce \songsChapter and \markuppage
* have nested chapters in PDF toc
2026-07-05 14:09:44 +02:00
tux 50e08220c4 make customEps path resolution more robust 2026-07-01 17:58:10 +02:00
tux 40f483bc67 default to numeric time signatures 2026-06-21 16:44:49 +02:00
tux 9b1297f675 fix tag group usage in markups 2026-06-04 00:05:42 +02:00
zuk aed11a70a7 Add meloref to author system 2026-05-12 10:42:14 +02:00
zuk 92a129f346 Fix double melody year in songinfo 2026-05-03 22:22:59 +02:00
zuk bb940b2a3b Fix transposeGlobal: Make additional transpositions possible 2026-04-22 11:45:57 +02:00
tux 997f757cd6 Chordpro export 2026-04-18 16:47:22 +02:00
tux 6e528a5328 fix markup tag group trouble accross songs 2026-04-10 14:29:20 +02:00
zuk 71c8c0385c switch swingStyle to textMark 2026-03-31 18:55:12 +02:00
tux f075946777 use right translationAuthorPrefix in authorContributionFormat 2026-03-12 22:25:50 +01:00
tux a0de02126c no "add" as additionalPitchPrefix 2026-03-10 19:17:40 +01:00
tux 7ece3b9c10 underline for LyricText 2026-03-09 17:01:21 +01:00
tux 7fc99e8883 use new chords and page references of LilyPond 2.25.35 2026-03-08 13:37:31 +01:00
tux b3feb3aa6d padding for stop tags and refactoring 2026-02-22 20:33:18 +01:00
tux 7b166f6fc3 pad left for stanzas to have a minimum distance to SystemStartBar 2026-02-22 13:22:45 +01:00
tux 9c437d0f06 reset tag groups for each song 2026-02-10 17:18:52 +01:00
tux a52f993678 more flexible titeling 2026-02-01 01:45:10 +01:00
tux bbd6d44455 Autorensystem flexibilisiert 2026-01-11 20:03:31 +01:00
zuk f68e2f10ae implement default bridge style 2025-12-29 18:06:00 +01:00
tux 463d61fbd9 fix customize layout sizing 2025-12-22 11:29:32 +01:00
tux 2d14a5b632 new engraver for spacing in chordlyrics 2025-12-15 21:41:45 +01:00
tux 368a1b96aa rework stanza handler 2025-12-15 11:49:30 +01:00
tux f57b1c4ec3 customize text chord distance in old system, too 2025-12-15 01:47:05 +01:00
tux e530bdf090 make verselayout really work 2025-12-15 01:26:19 +01:00
zuk c97c856b05 Use \tempo command for midi speed
* Remove Metronome mark engraver
* Remove midiQuarterNoteSpeed
2025-12-13 12:50:01 +01:00
tux 76b81a9968 no breaks in toc after section title 2025-11-24 20:45:00 +01:00
tux 3ff5a36106 better load song include data in windows 2025-11-24 16:47:13 +01:00
tux 7c92c65c82 bessere Transliteration für europäische Sonderzeichen 2025-11-01 10:29:29 +01:00
tux b2f1a7dc86 override-stanza with multiple numbers 2025-10-31 15:15:21 +01:00
tux 893010c4a9 fix paragraph splitting regex for windows 2025-10-30 12:31:28 +01:00
zuk 8aa0e3fdc3 Fix black Ties and Slurs for secondVoiceStyle 2025-10-29 13:14:52 +01:00
tux 5364f93db4 fix pdf page numbering 2025-10-26 22:16:25 +01:00
zuk aa0e3816d0 Fix black rests in secondVoiceStyle 2025-10-26 18:03:55 +01:00
tux 3b0c320839 better chord lyric distance handling 2025-09-21 02:00:08 +02:00
tux 12abf0a5f7 native scheme yaml parser 2025-09-20 13:40:15 +02:00
tux a01e95f31d fix categories and authors index 2025-09-19 18:47:26 +02:00
tux 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
tux f824b23311 fix updown syllable hyphens 2025-08-13 21:25:39 +02:00
tux 5ef4ee78ae Zwischenrufe als stanzas 2025-08-12 00:14:52 +02:00
tux 45e751fa24 fix updown to only modify first character 2025-08-10 18:46:25 +02:00
tux 9fb2d96765 multiple stanza numbers for one verse 2025-08-09 13:27:38 +02:00
zuk 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
zuk 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
zuk 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
43 changed files with 2986 additions and 1333 deletions

No files matched your search

+1 -1
View File
@@ -1,8 +1,8 @@
# ---> Lilypond
*.pdf
*.cho
*.ps
*.midi
*.mid
*.log
*~
-41
View File
@@ -1,41 +0,0 @@
#(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 "json_parser.scm")
(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.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"
\include "custom_indentation.ily"
% reset important variables
LAYOUT = \layout { \generalLayout }
HEADER = {}
MUSIC = {}
TEXT = \markuplist {""}
verseChords = {}
firstVoice = {}
global = {}
-233
View File
@@ -1,233 +0,0 @@
\language "deutsch"
\include "default_style.ly"
\include "default_songinfo_style.ly"
\include "footer_with_songinfo.ly"
\include #(if (defined? 'customStyleOverridesFile) customStyleOverridesFile "void.ly")
#(set-default-paper-size songFormatAndSize)
#(set-global-staff-size globalSize)
\paper {
property-defaults.fonts.serif = \songChordFont
property-defaults.fonts.sans = \songLyricFont
%annotate-spacing = ##t
% spacing stuff
two-sided = ##t
inner-margin = 1.5\cm
outer-margin = \songMargin
binding-offset = 0\cm
top-margin = \songMargin
bottom-margin = \songMargin
system-system-spacing = #'((basic-distance . 10) (padding . 1.5))
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 {
indent = #0
\context {
\Lyrics
\override LyricText.font-size = #lyricSize
\override StanzaNumber.font-size = #lyricSize
\override StanzaNumber.font-family = #'sans
\override LyricText.font-family = #'sans
\override LyricExtender.minimum-length = 0
}
\context {
\Staff
\accidentalStyle modern-voice-cautionary
\consists Merge_rests_engraver
}
\context {
\Score
\remove "Bar_number_engraver"
\RemoveEmptyStaves
\override VerticalAxisGroup.remove-first = ##t
\overrideTimeSignatureSettings
4/4 % timeSignatureFraction
1/4 % baseMomentFraction
#'(1 1 1 1) % beatStructure
#'() % beamExceptions
\overrideTimeSignatureSettings
3/4 % timeSignatureFraction
1/4 % baseMomentFraction
#'(1 1 1 1) % beatStructure
#'() % beamExceptions
}
\context {
\Voice
% ich will lines breaken wie ich will!
\remove "Forbid_line_break_engraver"
\override NoteHead.layer = 2
\override Dots.layer = 2
\override Stem.layer = 2
\override Flag.layer = 2
\override Beam.layer = 2
\override Accidental.layer = 2
}
}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% kleine Helferlein:
textp = \lyricmode { \markup { \raise #1 \musicglyph #"rests.3" } }
% zweite Stimme alles grau
secondVoiceStyle = {
\override NoteHead.color = #grey
\override Dots.color = #grey
\override Stem.color = #grey
\override Flag.color = #grey
\override Beam.color = #grey
\override Accidental.color = #grey
\override NoteHead.layer = 1
\override Dots.layer = 1
\override Stem.layer = 1
\override Flag.layer = 1
\override Beam.layer = 1
\override Accidental.layer = 1
}
firstVoiceStyle = {
\override NoteHead.color = #black
\override Dots.color = #black
\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
schwarzkopf =
#(define-music-function (parser location noten) (ly:music?)
(begin (ly:warning "\\schwarzkopf brauchts nicht mehr, das kann ersatzlos weg!") noten))
romanStanza =
#(define-music-function (parser location) ()
#{ \override StanzaNumber.style = #'roman #})
override-stanza =
#(define-music-function (parser location stanzanumber) (number?)
#{
\once \override StanzaNumber.forced-spacing = #stanzanumber % misuse property "forced-spacing" to override the stanzanumber
#}
)
stanza =
#(define-music-function (parser location stanzanumber) (number?)
#{
\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)))
#}
)
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.
repStartWithTag = \lyricmode {
\tag #'repeats {
\applyContext
#(lambda (context)
(let ((lastStanza (ly:context-property context 'stanza))
(printLastStanza (= (ly:assoc-get 'layer (ly:context-grob-definition context 'StanzaNumber) 0) 23))
(stanzaFontSeries (ly:assoc-get 'font-series (ly:context-grob-definition context 'StanzaNumber) 'normal)))
(ly:context-set-property! context 'stanza
(make-concat-markup
(if printLastStanza
(list (make-override-markup `(font-series . ,stanzaFontSeries) lastStanza) (make-hspace-markup 1) repStart)
(list repStart)
)))))
\once \override StanzaNumber.font-series = #'normal
}
}
repStopWithTag = \lyricmode {
\tag #'repeats {
\once \override StanzaNumber.font-series = #'normal
\once \override StanzaNumber.direction = 1
\set stanza = \markup { \repStop }
}
}
rightHyphen = \lyricmode {
\once \override StanzaNumber.font-series = #'normal
\once \override StanzaNumber.direction = 1
\set stanza = "-"
}
leftHyphen = \lyricmode {
\once \override StanzaNumber.font-series = #'normal
\set stanza = "-"
}
multiVerseSkips =
#(define-music-function (parser location skips) (number?)
#{ \tag #'multiVerse { \repeat unfold #skips { \skip4 } } #})
alt =
#(define-music-function (parser location a b) (ly:music? ly:music?)
#{ \tag #'firstVerse { #a } \tag #'multiVerse { #b } #})
updown =
#(define-music-function (parser location word) (string?)
#{
\lyricmode {
\tag #'up { \markup { #(string-capitalize word) } }
\tag #'down { \markup { #(string-downcase word) } }
}
#})
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))
}
#})
-72
View File
@@ -1,72 +0,0 @@
\paper {
poetPrefix = "Worte:"
composerPrefix = "Weise:"
compositionPrefix = "Satz:"
poetAndComposerEqualPrefix = "Worte und Weise:"
voicePrefix = "Stimme:"
versePrefix = "Strophe:"
translationPrefix = "Übersetzung:"
interludePrefix = "Zwischenspiel:"
bridgePrefix = "Bridge:"
authorFormat =
#(lambda (noDetails name trail_name birth_year death_year organization)
(let ((string-present (lambda (str) (and str (not (and (string? str) (string-null? str))))))
(render_informations (lambda (infolist) (string-append (car infolist) (if (or noDetails (null? (cdr infolist))) "" (string-append " (" (string-join (cdr infolist) ", ") ")"))))))
(if (or (string-present trail_name) (string-present name))
(render_informations (filter string-present (list
trail_name
name
(if (and (string-present birth_year) (string-present death_year))
(ly:format "~a‒~a" birth_year death_year)
(if (string-present birth_year)
(ly:format "*~a" birth_year)
(if (string-present death_year) (ly:format "†~a" death_year) "")))
organization
)))
""
)))
songinfoMarkup =
#(make-on-the-fly-markup
(lambda (layout props m)
(let* ((between-poet-and-composer-markup (chain-assoc-get 'header:between-poet-and-composer-markup props (make-hspace-markup 3)))
(poet-maybe-with-composer (chain-assoc-get 'songinfo:poet-maybe-with-composer props #f))
(composer (chain-assoc-get 'songinfo:composer props #f))
(copyright (chain-assoc-get 'songinfo:copyright props #f))
(infotext (chain-assoc-get 'songinfo:infotext props #f))
(translation (chain-assoc-get 'songinfo:translation props #f))
(pronunciation (chain-assoc-get 'songinfo:pronunciation props #f))
(year_text (chain-assoc-get 'songinfo:year_text props #f))
(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))
(current-line-width (chain-assoc-get 'line-width props (ly:output-def-lookup layout 'line-width)))
(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]*") text)))
'()))))
(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) "")))
(string-with-paragraphs->markuplist "" infotext)
(string-with-paragraphs->markuplist "Übersetzung: " translation)
(string-with-paragraphs->markuplist "Aussprache: " pronunciation)
)))))
(make-null-markup)
)
}
-18
View File
@@ -1,18 +0,0 @@
% songfilename auch im Markup verfügbar machen
#(define-markup-list-command (setsongfilename layout props songfilename markuplist)
(string? markup-list?)
(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))
(interpret-markup layout props
(let ((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
(ly:format "file does not exist ~a" filepath))
))))
+65
View File
@@ -0,0 +1,65 @@
#(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 (song-includes-data-path filename)
(string-join
(list
(dirname (dirname (dirname (dirname (current-filename)))))
"lilypond-song-includes"
"data"
filename)
file-name-separator-string))
#(define AUTHOR_DATA (if (defined? 'AUTHOR_DATA) AUTHOR_DATA (parse-yml-file (song-includes-data-path "authors.yml"))))
#(define SONG_DATA (if (defined? 'SONG_DATA) SONG_DATA (parse-yml-file (song-includes-data-path "songs.yml"))))
\include #(if (ly:version? < '(2 27 0)) "compat_lilypond_2_26.ily" "../void.ily")
\include "merge_rests_engraver_override.ily"
\include "basic_format_and_style_settings.ily"
\include "eps_file_from_song_dir.ily"
\include "embedded_songs.ily"
\include "title_with_category_images.ily"
\include "chord_settings.ily"
\include "chordpro.ily"
\include "transposition.ily"
\include "markup_tag_groups_hack.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
EMBEDDED_SONGS = #'()
verseChords = {}
firstVoice = {}
global = {}
\resetTagGroups
File renamed without changes.
@@ -0,0 +1,365 @@
\language "deutsch"
\include "default_style.ily"
\include "default_songinfo_style.ily"
\include "footer_with_songinfo.ily"
\include #(if (defined? 'customStyleOverridesFile) customStyleOverridesFile "../void.ily")
#(set-default-paper-size songFormatAndSize)
#(set-global-staff-size globalSize)
\paper {
property-defaults.fonts.serif = \songChordFont
property-defaults.fonts.sans = \songLyricFont
%annotate-spacing = ##t
% spacing stuff
two-sided = ##t
inner-margin = 1.5\cm
outer-margin = \songMargin
binding-offset = 0\cm
top-margin = \songMargin
bottom-margin = \songMargin
system-system-spacing = #'((basic-distance . 10) (padding . 1.5))
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) ", ")))))
bridgeMarkupFormatter = #(lambda (layout props stanzanumbers)
(interpret-markup layout props
(if (null? stanzanumbers)
bridgeString
(ly:format bridgeStringWithNumbers (string-join (map (lambda (stanzanumber) (ly:format "~a" stanzanumber)) stanzanumbers) ", ")))))
}
generalLayout = \layout {
indent = #0
\context {
\Lyrics
\override LyricText.font-size = #lyricSize
\override StanzaNumber.font-size = #lyricSize
\override StanzaNumber.font-family = #'sans
\override LyricText.font-family = #'sans
\override LyricExtender.minimum-length = 0
}
\context {
\Staff
\accidentalStyle modern-voice-cautionary
\consists \Better_Merge_rests_engraver
}
\context {
\Score
\remove "Bar_number_engraver"
\remove "Metronome_mark_engraver"
\RemoveEmptyStaves
\override VerticalAxisGroup.remove-first = ##t
\numericTimeSignature
rehearsalMarkFormatter = #format-mark-box-alphabet
\overrideTimeSignatureSettings
4/4 % timeSignatureFraction
1/4 % baseMomentFraction
#'(1 1 1 1) % beatStructure
#'() % beamExceptions
\overrideTimeSignatureSettings
3/4 % timeSignatureFraction
1/4 % baseMomentFraction
#'(1 1 1 1) % beatStructure
#'() % beamExceptions
}
\context {
\Voice
% ich will lines breaken wie ich will!
\remove "Forbid_line_break_engraver"
\override NoteHead.layer = 2
\override Rest.layer = 2
\override Dots.layer = 2
\override Stem.layer = 2
\override Flag.layer = 2
\override Beam.layer = 2
\override Slur.layer = 2
\override Tie.layer = 2
\override Accidental.layer = 2
}
}
#(define (customized-layout base-layout)
(let
((custom-size (ly:output-def-lookup base-layout 'size #f)))
(if custom-size (layout-set-staff-size custom-size))))
% Scores in Markups (z.B. inline-score) kopieren ihr \layout schon beim Parsen,
% also bevor customized-layout greift. Deshalb nachträglich anpassen.
#(define (customize-embedded-score-layouts! obj)
(cond
((ly:score? obj)
(for-each
(lambda (def)
(let ((custom-size (ly:output-def-lookup def 'size #f))
(scope (ly:output-def-scope def)))
(if custom-size
(layout-set-absolute-staff-size-in-module scope (* custom-size (eval 'pt scope))))))
(ly:score-output-defs obj)))
((pair? obj)
(customize-embedded-score-layouts! (car obj))
(customize-embedded-score-layouts! (cdr obj)))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% kleine Helferlein:
textp = \lyricmode { \markup { \raise #1 \musicglyph #"rests.3" } }
% zweite Stimme alles grau
secondVoiceStyle = {
\override NoteHead.color = #grey
\override Rest.color = #grey
\override Dots.color = #grey
\override Stem.color = #grey
\override Flag.color = #grey
\override Beam.color = #grey
\override Slur.color = #grey
\override Tie.color = #grey
\override Accidental.color = #grey
\override NoteHead.layer = 1
\override Rest.layer = 1
\override Dots.layer = 1
\override Stem.layer = 1
\override Flag.layer = 1
\override Beam.layer = 1
\override Slur.layer = 1
\override Tie.layer = 1
\override Accidental.layer = 1
}
firstVoiceStyle = {
\override NoteHead.color = #black
\override Rest.color = #black
\override Dots.color = #black
\override Stem.color = #black
\override Flag.color = #black
\override Beam.color = #black
\override Slur.color = #black
\override Tie.color = #black
\override Accidental.color = #black
}
% Deprecated: einzelne Noten innerhalb von \secondVoiceStyle mit schwarzem statt grauem Kopf
schwarzkopf =
#(define-music-function (parser location noten) (ly:music?)
(begin (ly:warning "\\schwarzkopf brauchts nicht mehr, das kann ersatzlos weg!") noten))
romanStanza =
#(define-music-function (parser location) ()
#{ \override StanzaNumber.style = #'roman #})
#(define (number-or-number-list? x) (or (number? x) (number-list? x)))
% "1,4" -> (1 4); Einträge, die keine Zahl sind, bleiben Strings ("1b,2b" -> ("1b" "2b"))
#(define (stanza-numbers-from-string str)
(map (lambda (s) (or (string->number s) s))
(remove string-null? (map string-trim-both (string-split str #\,)))))
% Kein number? hier, sonst kann der Parser 1,4 nicht mehr als Liste lesen
#(define (stanza-numbers? x) (or (number-list? x) (string? x)))
override-stanza =
#(define-music-function (stanzanumbers) (number-or-number-list?)
#{
\once \override StanzaNumber.details.custom-stanzanumber-override = #(if (number? stanzanumbers) (list stanzanumbers) stanzanumbers)
#}
)
#(define (romanize-stanza-numbers numbers style)
(if (eq? style 'roman)
(map (lambda (n) (if (number? n) (format #f "~@r" n) n)) numbers)
numbers))
#(define (format-stanza-numbers numbers style)
(string-join
(map (lambda (n) (format #f stanzaFormat n)) (romanize-stanza-numbers numbers style))
", "))
% Strophennummer, die erst beim Setzen aus den Eigenschaften des StanzaNumber-Grobs gebaut wird
% (details.custom-stanza-type, details.custom-stanza-numbers, style, details.custom-inline-text).
% So können \fstanza, \ref, \bridge und \repStartWithTag im selben Zeitschritt kombiniert werden.
#(define-markup-command (formatted-stanza layout props) ()
#:properties ((details '()) (style #f))
(let* ((realstanza (ly:assoc-get 'custom-realstanza details #f))
(type (ly:assoc-get 'custom-stanza-type details 'verse))
(numbers (ly:assoc-get 'custom-stanzanumber-override details
(ly:assoc-get 'custom-stanza-numbers details '())))
(inline-text (ly:assoc-get 'custom-inline-text details #f))
(inline-direction (ly:assoc-get 'custom-inline-direction details CENTER))
(rep-start (and inline-text (eqv? inline-direction LEFT)))
(roman-numbers (romanize-stanza-numbers numbers style))
(stanza-stencil
(and realstanza
(case type
((ref) ((ly:output-def-lookup layout 'refMarkupFormatter) layout props roman-numbers))
((bridge) ((ly:output-def-lookup layout 'bridgeMarkupFormatter) layout props roman-numbers))
(else (interpret-markup layout props (format-stanza-numbers numbers style))))))
(padded-stanza-stencil
(and stanza-stencil
(interpret-markup layout props (make-pad-left-markup 1 (make-stencil-markup stanza-stencil))))))
(if rep-start
(interpret-markup layout props
(make-concat-markup
(append
(if padded-stanza-stencil (list (make-stencil-markup padded-stanza-stencil) (make-hspace-markup 1)) '())
(list (make-override-markup '(font-series . normal) inline-text)))))
(or padded-stanza-stencil empty-stencil))))
#(define (formatted-stanza-music type stanzanumbers)
#{
\once \override StanzaNumber.details.custom-realstanza = ##t % set this to signal that there is a real stanza and no repeat signs
\once \override StanzaNumber.details.custom-stanza-type = #type
\once \override StanzaNumber.details.custom-stanza-numbers = #stanzanumbers
\stanza \markup \formatted-stanza
#})
% \fstanza 1 -> "1."
% \fstanza 1,4 -> "1., 4." (nur im Notenmodus, z.B. \chordverse { \fstanza 1,4 } ...)
% \fstanza "1,4" -> "1., 4." (auch im \lyricmode, dort versteht LilyPond 1,4 nicht als Liste)
fstanza =
#(define-music-function (stanzanumbers) (stanza-numbers?)
(formatted-stanza-music 'verse
(if (string? stanzanumbers) (stanza-numbers-from-string stanzanumbers) stanzanumbers)))
ref =
#(define-music-function (stanzanumbers lyrics) ((number-list? (list)) ly:music?)
#{ \lyricmode {
#(formatted-stanza-music 'ref stanzanumbers)
#lyrics
}
#}
)
bridge =
#(define-music-function (stanzanumbers lyrics) ((number-list? (list)) ly:music?)
#{ \lyricmode {
#(formatted-stanza-music 'bridge stanzanumbers)
#lyrics
}
#}
)
% prints a repStart Sign as stanza if the tag 'repeats is kept.
% if there is a stanza set by \fstanza in the same moment, \formatted-stanza prints both.
% Sets custom-inline-text for ChordPro export so it can collect the repeat sign separately
repStartWithTag =
#(define-music-function () ()
#{ \lyricmode {
\tag #'repeats {
\once \override StanzaNumber.details.custom-inline-text = \repStart
\once \override StanzaNumber.details.custom-inline-direction = #LEFT
\stanza \markup \formatted-stanza
}
} #})
repStopWithTag = \lyricmode {
\tag #'repeats {
\once \override StanzaNumber.details.custom-inline-text = \repStop
\once \override StanzaNumber.details.custom-inline-direction = #RIGHT
\once \override StanzaNumber.font-series = #'normal
\once \override StanzaNumber.direction = 1
\stanza \markup { \pad-x-right #1 \repStop }
}
}
rightHyphen = \lyricmode {
\once \override StanzaNumber.font-series = #'normal
\once \override StanzaNumber.direction = 1
\stanza "-"
}
leftHyphen = \lyricmode {
\once \override StanzaNumber.font-series = #'normal
\stanza "-"
}
multiVerseSkips =
#(define-music-function (parser location skips) (number?)
#{ \tag #'multiVerse { \repeat unfold #skips { \skip4 } } #})
alt =
#(define-music-function (parser location a b) (ly:music? ly:music?)
#{ \tag #'firstVerse { #a } \tag #'multiVerse { #b } #})
updown =
#(define-music-function (parser location word) (string?)
(let ((first-char (string-take word 1))
(rest (substring word 1 (string-length word))))
#{
\lyricmode {
\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
\stanza #text
}
#})
ruf =
#(define-music-function (text) (string?)
(rufWithMarkup (make-ruf-style-markup text)))
underlineOn =
#(define-music-function () ()
#{
\override LyricText.stencil =
#(lambda (grob)
(grob-interpret-markup grob (make-underline-markup (ly:grob-property grob 'text))))
#})
underlineOff =
#(define-music-function () ()
#{
\revert LyricText.stencil
#})
@@ -40,69 +40,33 @@ shiftChords = #(define-music-function (parser location xshift chords) (number? l
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
}
}
}
}#})))
(let* ((chord-name (lambda (in-pitches bass inversion context)
(make-line-markup (list
(ignatzek-chord-names in-pitches bass inversion context)
(make-hspace-markup 0.3)
(parenthesis-ignatzek-chord-names (music-pitches (transposable (cons (car (music-pitches mainchord)) (car in-pitches)) (music-clone altchord))) '() '() context)
))
)))
#{
\once \set chordNameFunction = #chord-name
#mainchord
#}))
% kleine Mollakkorde und Alteration ausgeschrieben
#(define (note-name->german-markup-nosym pitch lowercase?)
(define (pitch-alteration-semitones pitch) (inexact->exact (round (* (ly:pitch-alteration pitch) 2))))
(define (accidental->markup alteration name)
(if (= alteration 0)
(make-line-markup (list empty-markup))
(if (= alteration FLAT)
(if (equal? name "B")
""
; (make-line-markup (list (make-hspace-markup 0.2)
; (make-tiny-markup (make-raise-markup 1.2
; (make-musicglyph-markup (assoc-get alteration standard-alteration-glyph-name-alist ""))))
; ))
(if (or (equal? name "E") (equal? name "A")) "s" "es"))
"is")
))
(define (conditional-string-downcase str condition)
(if condition (string-downcase str) str))
(let* ((name (ly:pitch-notename pitch))
(alt-semitones (pitch-alteration-semitones pitch))
(n-a (if (member (cons name alt-semitones) `((6 . -1) (6 . -2)))
(cons 7 (+ 0 alt-semitones))
(cons name alt-semitones))))
(make-line-markup
(list
(make-simple-markup
(conditional-string-downcase
(vector-ref #("C" "D" "E" "F" "G" "A" "H" "B") (car n-a))
lowercase?))
(accidental->markup (/ (cdr n-a) 2) (vector-ref #("C" "D" "E" "F" "G" "A" "H" "B") (car n-a)) ))))
)
% 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))
% additional bass notes should get uppercased
#(define (bassnote-name->german-markup-nosym pitch lowercase?)(note-name->german-markup-nosym pitch #f))
#(define (bassnote-name->german-markup-nosym pitch lowercase?)((chord-name:name-markup 'deutsch) pitch #f))
defaultChordPrintings = {
<c g>-\markup { \super "5" }
@@ -145,15 +109,15 @@ generalLayout = \layout {
\generalLayout
\context {
\ChordNames
\semiGermanChords
\override ChordName.font-size = \songScoreChordFontSize
\override ChordName.font-series = \songChordFontSeries
\override ChordName.font-family = #'serif
chordNameLowercaseMinor = ##t
chordChanges = ##t
% eigenen chordRootNamer damit F# = Fis und Gb = Ges (also alteration ausgeschrieben)
chordRootNamer = #note-name->german-markup-nosym
chordRootNamer = #(chord-name:name-markup 'deutsch)
chordNoteNamer = #bassnote-name->german-markup-nosym
additionalPitchPrefix = ""
majorSevenSymbol = "maj7"
chordNameExceptions = \chordNameExceptions
}
@@ -191,7 +155,7 @@ Ensure_first_chord_after_line_break_printed_engraver =
; the current chord handling implementation in lilypond uses 'begin-of-line-visible to mark repeated chords
(ly:grob-set-property! grob 'begin-of-line-visible #f))
(set! last-system-column-rank current-system-column-rank)
(ly:chord-name::after-line-breaking grob)
(item::enforce-musical-break-visibility grob)
)))))))
% If you add this engraver to ChordNames Context chords get only printed on chordchanges and not at newline.
@@ -202,4 +166,4 @@ Ignoring_newline_chord_changes_engraver =
((chord-name-interface this-engraver grob source-engraver)
(when (and (ly:context-property ctx 'chordChanges #f) (ly:grob-property grob 'begin-of-line-visible #f))
(ly:grob-suicide! grob)
)))))
)))))
File diff suppressed because it is too large. Load diff
@@ -0,0 +1,11 @@
% Abwärtskompatibilität zu LilyPond 2.26.
% Wird von all.ily nur eingebunden, wenn die laufende LilyPond-Version älter als 2.27 ist.
% Alles andere ist für die aktuelle 2.27 geschrieben.
% Ab 2.27 gibt es \stanza als Musikfunktion (StanzaEvent), in 2.26 nur die Kontext-Property stanza.
stanza =
#(define-music-function (text) (markup?)
(context-spec-music (make-property-set 'stanza text) 'Bottom))
% Ab 2.27 heißt ly:chord-name::after-line-breaking item::enforce-musical-break-visibility.
#(define item::enforce-musical-break-visibility ly:chord-name::after-line-breaking)
File renamed without changes.
@@ -0,0 +1,190 @@
\paper {
poetPrefix = "Worte:"
composerPrefix = "Weise:"
compositionPrefix = "Satz:"
adaptionTextPrefix = "Bearbeitung:"
adaptionMusicPrefix = "Bearbeitung:"
poetAndComposerEqualPrefix = "Worte und Weise:"
voicePrefix = "Stimme:"
versePrefix = "Strophe:"
refPrefix = "Refrain:"
translationAuthorPrefix = "Übersetzung:"
translationPrefix = "Übersetzung:"
pronunciationPrefix = "Aussprache:"
interludePrefix = "Zwischenspiel:"
bridgePrefix = "Bridge:"
author-joiner = #(lambda (author-list) (string-join author-list ", "))
authorFormat =
#(lambda (noDetails name trail_name birth_year death_year organization)
(let ((string-present (lambda (str) (and str (not (and (string? str) (string-null? str))))))
(render_informations (lambda (infolist) (string-append (car infolist) (if (or noDetails (null? (cdr infolist))) "" (string-append " (" (string-join (cdr infolist) ", ") ")"))))))
(if (or (string-present trail_name) (string-present name))
(render_informations (filter string-present (list
trail_name
name
(if (and (string-present birth_year) (string-present death_year))
(ly:format "~a‒~a" birth_year death_year)
(if (string-present birth_year)
(ly:format "*~a" birth_year)
(if (string-present death_year) (ly:format "†~a" death_year) "")))
organization
)))
""
)))
authorContributionFormat =
#(lambda* (render-contribution-group render-partial-contribution-group #:key
(poetIds '())
(translatorIds '())
(versePoetData '())
(composerIds '())
(verseComposerData '())
(refComposerIds '())
(voiceComposerData '())
(compositionIds '())
(adaptionTextIds '())
(adaptionMusicIds '())
(bridgeIds '())
(interludeIds '())
(year_text #f)
(year_translation #f)
(year_melody #f)
(year_melody_meloref #f)
(year_composition #f)
(year_adaption_text #f)
(year_adaption_music #f)
(poetAndComposerEqualPrefix "")
(poetPrefix "")
(composerPrefix "")
(translationAuthorPrefix "")
(pronunciationPrefix "")
(compositionPrefix "")
(adaptionTextPrefix "")
(adaptionMusicPrefix "")
(bridgePrefix "")
(interludePrefix "")
(refPrefix ""))
(if (and
(equal? poetIds composerIds)
(null? translatorIds)
(null? versePoetData)
(null? verseComposerData)
(null? refComposerIds)
(null? voiceComposerData)
(null? compositionIds)
(null? adaptionTextIds)
(null? adaptionMusicIds)
(null? bridgeIds)
(null? interludeIds))
(list
(join-present (list
(render-contribution-group poetAndComposerEqualPrefix poetIds)
(if (equal? year_text year_melody) year_text (join-present (list year_text year_melody) "/"))
) ", ")
#f)
(list
(if (and (null? poetIds) (null? versePoetData) (null? translatorIds)) #f
(string-append
poetPrefix
" "
(join-present (list
(join-present (list
(render-contribution-group "" poetIds)
year_text
) ", ")
(render-partial-contribution-group 'versePrefix versePoetData)
(join-present (list
(render-contribution-group adaptionTextPrefix adaptionTextIds)
year_adaption_text
) ", ")
(join-present (list
(render-contribution-group translationAuthorPrefix translatorIds)
year_translation
) ", ")
) "; ")
))
(if (and
(null? composerIds)
(null? compositionIds)
(null? adaptionMusicIds)
(null? verseComposerData)
(null? refComposerIds)
(null? voiceComposerData)
(null? bridgeIds)
(null? interludeIds)) #f
(string-append
composerPrefix
" "
(join-present (list
(join-present (list
(render-contribution-group "" composerIds)
year_melody
) ", ")
(render-partial-contribution-group 'versePrefix verseComposerData)
(join-present (list
(render-contribution-group refPrefix refComposerIds)
year_melody_meloref
) ", ")
(render-partial-contribution-group 'voicePrefix voiceComposerData)
(join-present (list
(render-contribution-group compositionPrefix compositionIds)
year_composition
) ", ")
(join-present (list
(render-contribution-group adaptionMusicPrefix adaptionMusicIds)
year_adaption_music
) ", ")
(render-contribution-group bridgePrefix bridgeIds)
(render-contribution-group interludePrefix interludeIds)
) "; ")
)))))
songinfoMarkup =
#(make-on-the-fly-markup
(lambda (layout props m)
(let* ((between-poet-and-composer-markup (chain-assoc-get 'header:between-poet-and-composer-markup props (make-hspace-markup 3)))
(poet-maybe-with-composer (chain-assoc-get 'songinfo:poet-maybe-with-composer props #f))
(composer (chain-assoc-get 'songinfo:composer props #f))
(copyright (chain-assoc-get 'songinfo:copyright props #f))
(infotext (chain-assoc-get 'songinfo:infotext props #f))
(translation (chain-assoc-get 'songinfo:translation props #f))
(pronunciation (chain-assoc-get 'songinfo:pronunciation props #f))
(year_text (chain-assoc-get 'songinfo:year_text props #f))
(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))
(concat-markupped-strings (lambda (text)
(ly:regex-replace (ly:make-regex "(\\S+)(\\\\\\w+(?:\\s+\\[^\\{\\s]*|\\s*\\{[^\\}]*\\}))(\\S*)") text "\\concat {" 1 "\\line {" 2 "}" 3 "}")))
(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 (concat-markupped-strings paragraph)) } #}))
(ly:regex-split (ly:make-regex "\r?\n[ \t\r\n]*\n[ \t\r\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)
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)
)
}
@@ -16,9 +16,10 @@ songTocColumns = 3
globalSize = 15
lyricSize = 1.6
stanzaFormat = "~a."
romanStanzaFormat = "~@r."
refString = "Ref.:"
refStringWithNumbers = "Ref. ~a:"
bridgeString = "Bridge:"
bridgeStringWithNumbers = "Bridge ~a:"
% hübsche Wiederholungszeichen für den Liedtext
repStart = "𝄆"
repStop = "𝄇"
+157
View File
@@ -0,0 +1,157 @@
%% Mehrere Lieder in einer Liederdatei (z.B. zwei Lieder auf einer Seite)
%%
%% Das erste Lied ist das Hauptlied (HEADER), alle weiteren werden als
%% eingebettete Lieder angemeldet. Eingebettete Lieder bekommen eigene
%% Eintraege im Inhaltsverzeichnis, in den Kategorie-, Autoren- und
%% Kapitelverzeichnissen, im PDF-Inhaltsverzeichnis, in der toc.csv und
%% eine eigene Liednummer. Im Footer steht die Songinfo des letzten
%% eingebetteten Lieds (abschaltbar mit footersong = ##f im HEADER bzw. mit
%% footersong = \andereslied umstellbar), die Songinfo des Hauptlieds wird
%% mit \songinfo-of selbst platziert.
%%
%% Beispiel:
%%
%% \include "../../lilypond-song-includes/liedbausteine/lied_a.ly"
%% liedA = \captureSong
%% \include "../../lilypond-song-includes/liedbausteine/lied_b.ly"
%% liedB = \captureSong
%%
%% TEXT = \markuplist {
%% \songinfo-of \liedA
%% \vspace #2
%% \embedded-song-title \liedB
%% \vspace #.5
%% \score { \songMusic \liedB \layout { \LAYOUT } }
%% \with-song \liedB {
%% \chordlyrics \secondVerse
%% }
%% }
%%
%% \restoreSong \liedA
%% \embedSong \liedB
%% \include "public_includes/layout_bottom.ily"
%%
%% \captureSong sichert den Header (basicSongInfo) und die Variablen aus
%% captured-song-variable-names, damit das naechste \include sie nicht
%% ueberschreibt. Das Ergebnis ist ein normales Header-Modul, es kann also
%% auch in \header { \liedA } verwendet werden.
%%
%% \restoreSong setzt basicSongInfo, HEADER und diese Variablen zurueck,
%% TEXT aber nicht. TEXT also vor \restoreSong schreiben, solange darin noch
%% Variablen des zuletzt eingebundenen Lieds (\secondVerse usw.) stehen.
%%
%% Ohne \with-song beziehen sich Strophen mit Akkorden auf das Hauptlied.
%%
%% Alle Verzeichniseintraege zeigen auf die erste Seite des Hauptlieds.
#(define captured-song-variable-names '(MUSIC global firstVoice verseChords))
#(define (song-variable song name)
(assq-ref (module-ref song 'captured-song-variables '()) name))
#(define (extract-and-check-vars-from-module headermodule varlist)
(let* ((headervars (if (module? headermodule) (hash-map->list cons (struct-ref headermodule 0)) '()))
(extract-var-and-check (lambda (headervar)
(let* ((variableref (assoc-ref headervars headervar))
(extracted (if variableref (variable-ref variableref) #f)))
(if (and extracted (not (and (string? extracted) (string-null? extracted)))) extracted #f)))))
(map (lambda (varsymbol)
(cons varsymbol (extract-var-and-check varsymbol))
) varlist)))
% Text des PDF-Lesezeichens eines Lieds, #f wenn es keins bekommt.
% Gleiche Regel wie in build-full-title.
#(define (song-pdf-bookmark-title headermodule)
(let* ((vars (extract-and-check-vars-from-module headermodule '(title starttext)))
(title (assq-ref vars 'title))
(starttext (assq-ref vars 'starttext))
(as-string (lambda (m) (if (markup? m) (markup->string m) ""))))
(cond ((and title starttext) (string-append (as-string starttext) " | " (as-string title)))
(title (as-string title))
(starttext (string-append (as-string starttext) " | "))
(else #f))))
#(define (embedded-song-list songs)
(if (list? songs) (filter module? songs) '()))
#(define (embedded-songs-of-header headermodule)
(if (module? headermodule)
(embedded-song-list (module-ref headermodule 'embeddedsongs '()))
'()))
% Ersetzt alle header:*-Properties durch die Felder aus headermodule, damit
% keine Felder des Hauptlieds in das andere Lied durchsickern.
#(define (header-module->props headermodule props)
(let ((header-key? (lambda (entry)
(and (pair? entry) (symbol? (car entry))
(string-prefix? "header:" (symbol->string (car entry)))))))
(cons
(map (lambda (kv) (cons (symbol-append 'header: (car kv)) (cdr kv)))
(ly:module->alist headermodule))
(map (lambda (alist) (remove header-key? alist)) props))))
captureSong =
#(define-scheme-function () ()
(let ((song (make-module)))
(ly:module-copy song basicSongInfo)
(module-define! song 'captured-song-variables
(filter-map
(lambda (name)
(let ((value (ly:parser-lookup name)))
(and (not (null? value)) (cons name value))))
captured-song-variable-names))
song))
% Stellt basicSongInfo, HEADER und die gesicherten Variablen eines Lieds
% wieder her, als waere es das zuletzt eingebundene.
restoreSong =
#(define-void-function (song) (module?)
(for-each
(lambda (kv) (ly:parser-define! (car kv) (cdr kv)))
(module-ref song 'captured-song-variables '()))
(ly:parser-define! 'basicSongInfo song)
(ly:parser-define! 'HEADER #{ \bookpart { \header { $song } } #}))
embedSong =
#(define-void-function (song) (module?)
(set! EMBEDDED_SONGS (append EMBEDDED_SONGS (list song))))
songMusic =
#(define-music-function (song) (module?)
(let ((music (song-variable song 'MUSIC)))
(if (ly:music? music) music (make-music 'SequentialMusic))))
% Strophen, \fromproperty #'header:... usw. beziehen sich innerhalb auf das
% angegebene Lied. Die Transposition des Hauptlieds wird nicht uebernommen.
#(define-markup-list-command (with-song layout props song args) (module? markup-list?)
(let* ((music-or-empty (lambda (name)
(let ((music (song-variable song name)))
(if (ly:music? music) music (make-music 'SequentialMusic)))))
(verseChords (music-or-empty 'verseChords))
(global (music-or-empty 'global))
(firstVoice (music-or-empty 'firstVoice)))
(interpret-markup-list layout
(prepend-alist-chain 'verse-chords #{ \chords { $verseChords } #}
(prepend-alist-chain 'verse-reference-voice #{ $global $firstVoice #}
(prepend-alist-chain 'transposition (cons #f #f)
(header-module->props song props))))
args)))
#(define-markup-command (songinfo-of layout props song) (module?)
(interpret-markup layout (header-module->props song props)
(make-fractional-line-width-markup (make-songinfo-content-markup))))
#(define-markup-command (embedded-song-title layout props song) (module?)
(interpret-markup layout (header-module->props song props)
(make-fill-line-markup (list (ly:output-def-lookup layout 'defaultTitleMarkup)))))
% PDF-Lesezeichen der eingebetteten Lieder, wird von build-full-title direkt
% nach dem Lesezeichen des Hauptlieds ausgegeben.
#(define-markup-command (embedded-songs-to-pdf-toc layout props) ()
(apply ly:stencil-add
(cons empty-stencil
(filter-map
(lambda (song)
(let ((bookmark (song-pdf-bookmark-title song)))
(and bookmark (make-pdf-toc-stencil bookmark 0))))
(embedded-song-list (chain-assoc-get 'header:embeddedsongs props '()))))))
@@ -0,0 +1,28 @@
% songfilename auch im Markup verfügbar machen
#(define-markup-list-command (setsongfilename layout props songfilename markuplist)
(string? markup-list?)
(interpret-markup-list layout (prepend-alist-chain 'songfilename songfilename props) markuplist))
#(define-markup-command (customEps layout props ysize filename)(number? string?)
#:properties ((songfilename ""))
(interpret-markup layout props
(let* ((defaulttitlemarkup (ly:output-def-lookup layout 'defaultTitleMarkup))
;; Determine the song directory to resolve the EPS relative to.
;; In TEXT the name arrives via the markup props (\setsongfilename),
;; but inside MUSIC (e.g. \mark) the props do not carry it, so we
;; fall back to the value stored in the score's \layout block.
(layout-songfilename (ly:output-def-lookup layout 'songfilename #f))
(songdir (cond ((not (string-null? songfilename)) songfilename)
((and (string? layout-songfilename)
(not (string-null? layout-songfilename)))
layout-songfilename)
(else #f)))
(filepath (if songdir
(ly:format "~a/~a/~a" songPath songdir filename)
filename)))
(if (file-exists? filepath)
(make-epsfile-markup Y ysize filepath)
(if defaulttitlemarkup
defaulttitlemarkup
(ly:format "file does not exist ~a" filepath))
))))
@@ -30,7 +30,11 @@
(lambda (a b) (< (cadr a) (cadr b))))
(list)))
#(define-markup-command (print-songinfo layout props) ()
#(define (join-present items joiner)
(string-join (filter (lambda (item) (and (string? item) (not (string-null? (string-trim-both item))))) items) joiner))
% Songinfo aus den header:*-Properties, ohne Pruefung auf die letzte Seite.
#(define-markup-command (songinfo-content layout props) ()
(define (songinfo-from songId key)
(let ((song (if (defined? 'SONG_DATA) (assoc-ref SONG_DATA songId) #f)))
(if song
@@ -74,11 +78,7 @@
(define (render-contribution-group contributionPrefix authorIds)
(if (null? authorIds)
""
(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)
(string-append contributionPrefix " " ((ly:output-def-lookup layout 'author-joiner) (format-authors authorIds))))
)
(define (render-partial-contribution-group prefixLookup authorData)
@@ -94,70 +94,44 @@
(define (poet-and-composer-from-authors authors)
(if authors
(let (
(poetIds (find-author-ids-by 'text authors))
(translatorIds (find-author-ids-by 'translation authors))
(versePoetData (find-author-id-with-part-numbers 'verse authors))
(composerIds (find-author-ids-by 'melody authors))
(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))
(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))
)
(if (and (equal? poetIds composerIds) (null? translatorIds) (null? versePoetData) (null? verseComposerData) (null? voiceComposerData) (null? compositionIds) (null? bridgeIds) (null? interludeIds))
(list
(join-present (list
(render-contribution-group (ly:output-def-lookup layout 'poetAndComposerEqualPrefix) poetIds)
(if (equal? year_text year_melody) year_text (join-present (list year_text year_melody) "/"))
) ", ")
#f)
(list
(if (and (null? poetIds) (null? versePoetData) (null? translatorIds)) #f
(string-append
(ly:output-def-lookup layout 'poetPrefix)
" "
(join-present (list
(join-present (list
(render-contribution-group "" poetIds)
year_text
) ", ")
(render-partial-contribution-group 'versePrefix versePoetData)
(join-present (list
(render-contribution-group (ly:output-def-lookup layout 'translationPrefix) translatorIds)
year_translation
) ", ")
) "; ")
))
(if (and (null? composerIds) (null? compositionIds) (null? verseComposerData) (null? voiceComposerData) (null? bridgeIds) (null? interludeIds)) #f
(string-append
(ly:output-def-lookup layout 'composerPrefix)
" "
(join-present (list
(join-present (list
(render-contribution-group "" composerIds)
year_melody
) ", ")
(render-partial-contribution-group 'versePrefix verseComposerData)
(render-partial-contribution-group 'voicePrefix voiceComposerData)
(join-present (list
(render-contribution-group (ly:output-def-lookup layout 'compositionPrefix) compositionIds)
year_composition
) ", ")
(render-contribution-group (ly:output-def-lookup layout 'bridgePrefix) bridgeIds)
(render-contribution-group (ly:output-def-lookup layout 'interludePrefix) interludeIds)
) "; ")
)))))
((ly:output-def-lookup layout 'authorContributionFormat)
render-contribution-group
render-partial-contribution-group
#:poetIds (find-author-ids-by 'text authors)
#:translatorIds (find-author-ids-by 'translation authors)
#:versePoetData (find-author-id-with-part-numbers 'verse authors)
#:composerIds (find-author-ids-by 'melody authors)
#:verseComposerData (find-author-id-with-part-numbers 'meloverse authors)
#:refComposerIds (find-author-ids-by 'meloref 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_melody_meloref (chain-assoc-get 'header:year_melody_meloref 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)
#:poetAndComposerEqualPrefix (ly:output-def-lookup layout 'poetAndComposerEqualPrefix)
#:poetPrefix (ly:output-def-lookup layout 'poetPrefix)
#:composerPrefix (ly:output-def-lookup layout 'composerPrefix)
#:translationAuthorPrefix (ly:output-def-lookup layout 'translationAuthorPrefix)
#:pronunciationPrefix (ly:output-def-lookup layout 'pronunciationPrefix)
#:compositionPrefix (ly:output-def-lookup layout 'compositionPrefix)
#:adaptionTextPrefix (ly:output-def-lookup layout 'adaptionTextPrefix)
#:adaptionMusicPrefix (ly:output-def-lookup layout 'adaptionMusicPrefix)
#:bridgePrefix (ly:output-def-lookup layout 'bridgePrefix)
#:interludePrefix (ly:output-def-lookup layout 'interludePrefix)
#:refPrefix (ly:output-def-lookup layout 'refPrefix))
(list #f #f)
)
)
(interpret-markup layout props
(if (chain-assoc-get 'page:is-bookpart-last-page props #f)
(let* ((authors (chain-assoc-get 'header:authors props #f))
(poet-and-composers (poet-and-composer-from-authors authors))
(songId (chain-assoc-get 'header:songId props #f))
@@ -171,7 +145,7 @@
(translation (chain-assoc-get 'header:translation props #f))
(pronunciation (chain-assoc-get 'header:pronunciation props #f))
(year_text (if (string? (car poet-and-composers)) #f (chain-assoc-get 'header:year_text props #f)))
(year_melody (if (string? (car poet-and-composers)) #f (chain-assoc-get 'header:year_melody props #f))))
(year_melody (if (string? (cadr poet-and-composers)) #f (chain-assoc-get 'header:year_melody props #f))))
(markup
#:override (cons 'songinfo:poet-maybe-with-composer
(if (and poet-maybe-with-composer (not (and (string? poet-maybe-with-composer) (string-null? poet-maybe-with-composer)))) poet-maybe-with-composer #f))
@@ -193,10 +167,25 @@
#:fontsize songInfoFontSize
#:sans
(ly:output-def-lookup layout 'songinfoMarkup)
)))
(make-null-markup)))
))))
)
% Songinfo im Footer, nur auf der letzten Seite des Bookparts. Gibt es
% eingebettete Lieder (siehe embedded_songs.ily), steht hier die Songinfo des
% letzten eingebetteten Lieds, ausser im Header ist footersong gesetzt
% (##f = Hauptlied, oder ein mit \captureSong gesichertes Lied).
#(define-markup-command (print-songinfo layout props) ()
(if (chain-assoc-get 'page:is-bookpart-last-page props #f)
(let* ((footersong (chain-assoc-get 'header:footersong props 'auto))
(embedded (embedded-song-list (chain-assoc-get 'header:embeddedsongs props '())))
(song (if (eq? footersong 'auto)
(and (pair? embedded) (last embedded))
footersong)))
(interpret-markup layout
(if (module? song) (header-module->props song props) props)
(make-songinfo-content-markup)))
(interpret-markup layout props (make-null-markup))))
#(define-markup-command (print-pagenumber layout props)()
(let ((label (chain-assoc-get 'header:myindexlabel props #f)))
(interpret-markup layout props
@@ -213,13 +202,23 @@
`(line-width . ,(* (chain-assoc-get 'header:songinfo-size-factor props songInfoLineWidthFraction) (ly:output-def-lookup layout 'line-width)))
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 {
print-first-page-number = ##t
first-page-number = #0
oddFooterMarkup = \markup {
\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 \should-print-page-number \print-pagenumber }
}
@@ -228,7 +227,7 @@
\fill-line {
\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 { \null }
\line { \page-number-to-pdf-label \null }
}
}
}
}
@@ -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)))
File renamed without changes.
@@ -0,0 +1,16 @@
% We have to record the tag groups for markup, so we use the right tag groups during markup interpretiton.
recordedTagGroups = #'()
tagGroup =
#(define-void-function (tags) (symbol-list?)
(let ((err (define-tag-group tags)))
(if err (ly:parser-error err (*location*))
(set! recordedTagGroups (cons tags recordedTagGroups)))))
#(define-markup-command (handle-tag-groups layout props recorded-groups m) (list? markup?)
(resetTagGroups)
(for-each
(lambda (group)
(define-tag-group group))
recorded-groups)
(interpret-markup layout props m))
@@ -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)))))))
File renamed without changes.
+154
View File
@@ -0,0 +1,154 @@
(use-modules (ice-9 rdelim) (ice-9 regex) (ice-9 pretty-print) (srfi srfi-1))
;; Hauptparsingfunktion
(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)))
(parse-lines lines 0)))
(define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename)))
@@ -1,4 +1,4 @@
swing = \mark \markup {
swing = \textMark \markup {
\line \general-align #Y #DOWN {
\score {
\new Staff \with {
@@ -47,7 +47,7 @@ swing = \mark \markup {
}
}
swingOff = \mark \markup {
swingOff = \textMark \markup {
\line \general-align #Y #DOWN {
\score {
\new Staff \with {
@@ -99,7 +99,7 @@ swingOff = \mark \markup {
\include "swing.ly"
swingMusic =
#(define-music-function (parser location music) (ly:music?)
#(define-music-function (music) (ly:music?)
(define (partial-duration-length m)
(let ((name (ly:music-property m 'name))
(es (ly:music-property m 'elements))
@@ -118,4 +118,4 @@ swingMusic =
#{
\swing
\applySwingWithOffset 8 #'(2 1) #(partial-duration-length music) #music
#})
#})
@@ -0,0 +1,91 @@
#(define-markup-command (bookTitleMarkupCustom layout props)()
(interpret-markup layout props
(make-column-markup
(list
(make-vspace-markup (chain-assoc-get 'header:titletopspace props 0))
(make-customEps-markup (chain-assoc-get 'header:titlesize props 3.5) "titel.eps")
))
))
#(define-markup-command (category-image layout props size category)(number? string?)
(interpret-markup layout props
(if noStandaloneOutput
(make-epsfileref-markup Y size
(category-image-path category))
(make-epsfile-markup Y size
(category-image-path category)))))
#(define showCategoryImages (if (defined? 'showCategoryImages) showCategoryImages #t))
#(define-markup-command (category-images layout props)()
(interpret-markup layout props
(if showCategoryImages
(make-line-markup (map (lambda (category) (make-category-image-markup 5 category))
(string-tokenize (chain-assoc-get 'header:categories props ""))))
(make-null-markup))))
#(define pdf-encode (@@ (lily framework-ps) pdf-encode))
% PDF tags
% Erzeugt ein PDF-Lesezeichen (Outline-Eintrag) auf der aktuellen Seite.
% count = Anzahl der direkten Unterpunkte, die (in Seitenreihenfolge) direkt
% nachfolgen. 0 = Blatt-Eintrag (kein /Count), >0 = aufgeklappt,
% <0 = zugeklappt (Betrag = Anzahl direkter Kinder).
#(define (make-pdf-toc-stencil title count)
(if (string-null? title)
empty-stencil
(ly:make-stencil
(list 'embedded-ps
(ly:format
"[~a/Action /GoTo /View [/XYZ -4 currentpagedevice /PageSize get 1 get 4 add null] /Title (~a) /OUT pdfmark"
(if (= count 0) "" (ly:format "/Count ~a " count))
(pdf-encode title)))
empty-interval empty-interval
;'(0 . 0) '(0 . 0)
)))
% Einzelner (Blatt-)Eintrag im PDF-Inhaltsverzeichnis.
#(define-markup-command (title-to-pdf-toc layout props title) (string?)
(make-pdf-toc-stencil title 0))
% Kapitel-Eintrag mit verschachtelten Unterpunkten.
% count = Anzahl der direkt nachfolgenden Einträge, die diesem Kapitel
% untergeordnet werden sollen (positiv = aufgeklappt, negativ = zugeklappt).
#(define-markup-command (chapter-to-pdf-toc layout props count title) (integer? string?)
(make-pdf-toc-stencil title count))
#(define-markup-command (build-full-title layout props right)(boolean?)
(interpret-markup layout (prepend-alist-chain 'songfilename (chain-assoc-get 'header:songfilename props "") props)
(let* ((title (chain-assoc-get 'header:title props ""))
(starttext (chain-assoc-get 'header:starttext props #f))
(pdfbookmark (if starttext (string-append starttext " | " title) title))
(chaptertitle (chain-assoc-get 'header:chaptertitle props #f))
(chaptercount (chain-assoc-get 'header:chaptercount props 0))
(title-markup (ly:output-def-lookup layout (if right 'oddTitleLineMarkup 'evenTitleLineMarkup))))
(if title
;; Ist dieses Lied das erste eines Kapitels, wird der Kapitel-Eintrag
;; unmittelbar vor dem Lied-Eintrag ausgegeben, damit die pdfmark-/OUT-
;; Reihenfolge (Elternteil vor Kindern) im PDF-Stream garantiert stimmt.
;; Eingebettete Lieder (embedded_songs.ily) folgen direkt nach dem Lied.
(if (and (string? chaptertitle) (not (string-null? chaptertitle)))
(markup #:chapter-to-pdf-toc chaptercount chaptertitle
#:title-to-pdf-toc pdfbookmark #:embedded-songs-to-pdf-toc title-markup)
(markup #:title-to-pdf-toc pdfbookmark #:embedded-songs-to-pdf-toc title-markup))
make-null-markup)
)))
\paper {
bookTitleMarkup = \markup \null
scoreTitleMarkup = \markup \null
oddHeaderMarkup = \markup { \if \on-first-page-of-part \build-full-title ##t }
evenHeaderMarkup = \markup { \if \on-first-page-of-part \build-full-title ##f }
oddTitleLineMarkup = \markup { \fill-line \general-align #Y #UP { \null \bookTitleMarkupCustom \category-images } }
evenTitleLineMarkup = \markup { \fill-line \general-align #Y #UP { \category-images \bookTitleMarkupCustom \null } }
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
}
}
}
@@ -2,7 +2,12 @@ TRANSPOSITION = #(cons #f #f)
transposeGlobal =
#(define-void-function (from to) (ly:pitch? ly:pitch?)
(set! TRANSPOSITION (cons from to)))
(if (not (car TRANSPOSITION))
(set! TRANSPOSITION (cons from to))
(let ((current_to (cdr TRANSPOSITION))
(interval (ly:pitch-diff to from)))
(set! TRANSPOSITION (cons (car TRANSPOSITION)
(ly:pitch-transpose current_to interval))))))
transposable =
#(define-music-function (fromto music) (pair? ly:music?)
@@ -60,19 +60,20 @@
% Text über Text mittig darstellen
#(define-markup-command (textup layout props text uptext) (markup? markup?)
#:properties ((verselayout generalLayout)
(verse-text-chord-distance songTextChordDistance))
"Markup über Text mittig darstellen."
(let ((verselayout (chain-assoc-get 'verselayout props generalLayout)))
(interpret-markup layout props
#{\markup {
\size-box-to-box-style-dependent ##t ##f
\general-align #X #LEFT \override #`(direction . ,UP) \override #'(baseline-skip . 1.0) \dir-column \chord-alignment-style-dependent {
\pad-to-box #'(0 . 0) #'(0 . 2.0) { #text }
\size-box-to-box ##f ##t #uptext \score { \chords { g4:m a } \layout { \verselayout } }
\general-align #X #LEFT \override #`(direction . ,UP) \override #'(baseline-skip . 1) \dir-column \chord-alignment-style-dependent {
\pad-to-box #'(0 . 0) #`(0 . ,(- verse-text-chord-distance 0.8)) { #text }
\size-box-to-box ##f ##t #uptext \score { \chords { g4:m a } \layout { $verselayout #(customized-layout verselayout) } }
}
#text
}
#}
)))
))
#(define-markup-command (anchor-x-between layout props arga argb)
(markup? markup?)
@@ -82,16 +83,15 @@
(ly:stencil-aligned-to m X (- (/ (* la 2) l) 1))
))
#(define-markup-command (stanza-raw layout props arg)
(string-or-music?)
(let ((verselayout (chain-assoc-get 'verselayout props generalLayout)))
#(define-markup-command (stanza-raw layout props arg) (string-or-music?)
#:properties ((verselayout generalLayout))
(interpret-markup layout props
(if (and (string? arg) (string-null? arg))
" "
#{\markup
\score { \new Lyrics { \lyricmode { #(if (ly:music? arg) arg #{ \set stanza = #arg #}) "" } } \layout { \verselayout } }
\score { \new Lyrics { \lyricmode { #(if (ly:music? arg) arg #{ \stanza #arg #}) "" } } \layout { $verselayout #(customized-layout verselayout) } }
#}
))))
)))
#(define-markup-command (stanza layout props arg)
(string-or-music?)
@@ -141,7 +141,7 @@
(make-wrap-newline-markup
(ly:regex-replace (ly:make-regex "\\(( *)([^,()]*)( *),([^)]*)\\)")
(ly:regex-replace (ly:make-regex "(([^ \n]*\\([^()]*,[^()]+\\)[^ \n(]*)+)") (handle-custom-newlines custom-verse-breaks verse) " \\concat { " 1 " } ")
"\\textup \\line { \"" 1 "\" " 2 " \"" 3 "\" } \\score { " transp " \\chords { s4 " 4 " } \\layout { \\verselayout } }")
"\\textup \\line { \"" 1 "\" " 2 " \"" 3 "\" } \\score { " transp " \\chords { s4 " 4 " } \\layout { $verselayout #(customized-layout verselayout) } }")
)
))))
@@ -203,32 +203,32 @@
#(define-markup-command (pad-left layout props amount arg)
(number? markup?)
(let* ((m (interpret-markup layout props arg))
(x (ly:stencil-extent m X))
(y (ly:stencil-extent m Y)))
(ly:stencil-translate
(ly:make-stencil (ly:stencil-expr m)
(cons (- (car x) amount) (cdr x))
y)
`(,amount . 0))))
(interpret-markup layout props (make-pad-x-left-markup amount arg))
`(,amount . 0)))
#(define-markup-command (pad-right layout props amount arg)
(number? markup?)
(let* ((m (interpret-markup layout props arg))
(x (ly:stencil-extent m X))
(y (ly:stencil-extent m Y)))
(ly:make-stencil (ly:stencil-expr m)
(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."
@@ -236,39 +236,171 @@
(let ((text (ly:grob-property grob 'text)))
(grob-interpret-markup grob (if (string? text)
(make-pad-right-markup -0.1 (make-tied-lyric-markup text))
(make-pad-x-right-markup -0.1 (make-tied-lyric-markup text))
text))))
Chord_lyrics_spacing_engraver =
#(lambda (ctx)
(let ((last-lyric-syllable #f)
(lyric-width-since-last-chord 0)
(music-columns-for-last-syllable 0)
(last-printed-chord #f)
(chord-width-since-last-lyric 0)
(lyrics-seen-since-break #f)
(have-a-rest #f)
(stanza #f)
; Akkord auf einer Skip-Silbe "_" nach Wortende soll über die folgende Silbe
(word-continues #f)
(continuation-this-step #f)
(lyric-skip-this-step #f)
(syllable-this-step #f)
(chord-this-step #f)
(chord-on-lyric-skip #f)
(place-at-right-edge
(lambda (grob anchor padding)
(let ((anchor-width (interval-length (ly:grob-extent anchor anchor X))))
(ly:grob-set-parent! grob X anchor)
(ly:grob-set-property! grob 'X-offset (+ padding anchor-width))
))))
(make-engraver
((start-translation-timestep engraver)
(set! continuation-this-step #f)
(set! lyric-skip-this-step #f)
(set! syllable-this-step #f)
(set! chord-this-step #f)
)
((stop-translation-timestep engraver)
(if (and chord-on-lyric-skip (not (eq? chord-on-lyric-skip chord-this-step)))
(begin
(if (and syllable-this-step (not chord-this-step))
(begin
(ly:grob-set-parent! chord-on-lyric-skip X syllable-this-step)
(ly:grob-set-property! chord-on-lyric-skip 'X-offset 0)
(ly:grob-set-property! chord-on-lyric-skip 'extra-spacing-width '(+inf.0 . -inf.0))
(set! lyric-width-since-last-chord (interval-length (ly:grob-extent syllable-this-step syllable-this-step X)))))
(set! chord-on-lyric-skip #f)))
(if syllable-this-step
(set! word-continues continuation-this-step))
)
(listeners
((multi-measure-rest-event engraver event)
(set! have-a-rest #t)
)
((rest-event engraver event)
(set! have-a-rest #t)
)
((hyphen-event engraver event)
(set! continuation-this-step #t)
)
((extender-event engraver event)
(set! continuation-this-step #t)
)
((lyric-event engraver event)
(set! have-a-rest #f)
; "_" wird zu " " und erzeugt keine LyricText
(if (equal? (ly:event-property event 'text) " ")
(begin
(set! lyric-skip-this-step #t)
(set! chord-on-lyric-skip #f)))
(set! music-columns-for-last-syllable 0)
)
((break-event engraver event)
(set! last-lyric-syllable #f)
(set! lyric-width-since-last-chord 0)
(set! music-columns-for-last-syllable 0)
(set! last-printed-chord #f)
(set! chord-width-since-last-lyric 0)
(set! lyrics-seen-since-break #f)
(set! chord-on-lyric-skip #f)
))
(acknowledgers
((musical-paper-column-interface this-engraver grob source-engraver)
(set! music-columns-for-last-syllable (+ 1 music-columns-for-last-syllable))
)
((lyric-syllable-interface this-engraver grob source-engraver)
(let ((syllable-width (interval-length (ly:grob-extent grob grob X))))
(set! lyric-width-since-last-chord (+ lyric-width-since-last-chord syllable-width))
)
(if (> chord-width-since-last-lyric 0)
(if lyrics-seen-since-break
(ly:grob-set-property! grob 'extra-spacing-width
(cons (- chord-width-since-last-lyric) (cdr (ly:grob-property grob 'extra-spacing-width '(0 . 0)))))
(if last-printed-chord
(let ((gap-for-starting-rest 2.0))
(if stanza (ly:grob-set-property! stanza 'padding (+ 1 gap-for-starting-rest)))
(ly:grob-set-parent! grob X last-printed-chord)
(ly:grob-set-property! grob 'X-offset gap-for-starting-rest)
)))
)
(set! syllable-this-step grob)
(set! last-lyric-syllable grob)
(set! chord-width-since-last-lyric 0)
(set! lyrics-seen-since-break #t)
)
((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)
lyrics-seen-since-break))
(let* ((last-printed-chord-width (if last-printed-chord (interval-length (ly:grob-extent last-printed-chord last-printed-chord X)) 0))
(chord-overwidth (- last-printed-chord-width lyric-width-since-last-chord))
(chord-gap 0.5))
(if have-a-rest
(let ((chord-width (interval-length (ly:grob-extent grob grob X))))
(if last-lyric-syllable
(if (and last-printed-chord (> chord-overwidth 0))
(place-at-right-edge grob last-printed-chord chord-gap)
(place-at-right-edge grob last-lyric-syllable 0))
(if last-printed-chord
(place-at-right-edge grob last-printed-chord chord-gap)))
(set! chord-width-since-last-lyric (+ chord-width-since-last-lyric chord-width chord-gap))
))
(if (and last-lyric-syllable last-printed-chord (> chord-overwidth 0))
(ly:grob-set-property! last-lyric-syllable 'extra-spacing-width
(cons (car (ly:grob-property last-lyric-syllable 'extra-spacing-width '(0 . 0))) (+ chord-gap chord-overwidth)))
)
(set! lyric-width-since-last-chord (* (if last-lyric-syllable (interval-length (ly:grob-extent last-lyric-syllable last-lyric-syllable X)) 0) (- 1 (/ 1.0 music-columns-for-last-syllable))))
(set! chord-this-step grob)
(if (and lyric-skip-this-step (not have-a-rest) (not word-continues))
(set! chord-on-lyric-skip grob))
(set! last-printed-chord grob)
(set! last-lyric-syllable #f)
)
(ly:grob-set-property! grob 'X-extent '(+inf.0 . -inf.0))
)
)
((stanza-number-interface this-engraver grob source-engraver)
(set! stanza grob)
)
)
)))
#(define-markup-command (chordlyrics layout props lyrics) (ly:music?)
#: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 {
\score-equal-height-with-indents \score-lines {
<<
\new Devnull { #verse-break-voice }
\new NullVoice = "dummyvoice" { #verse-reference-voice }
\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)))
$verselayout
#(customized-layout verselayout)
ragged-right = ##t
\context {
\Lyrics
\override VerticalAxisGroup.nonstaff-relatedstaff-spacing.basic-distance = #verse-text-chord-distance
\override VerticalAxisGroup.nonstaff-relatedstaff-spacing.padding = #(- verse-text-chord-distance songTextChordDistance)
\override LyricText.parent-alignment-X = #LEFT
\override LyricText.self-alignment-X = #LEFT
\override LyricText.word-space = 0.8
@@ -284,14 +416,20 @@
\context {
\Score
\override PaperColumn.keep-inside-line = ##f
% \override SpacingSpanner.strict-note-spacing = ##t
% \override SpacingSpanner.strict-note-spacing = ##t
\override SpacingSpanner.uniform-stretching = ##t
\override SpacingSpanner.spacing-increment = 0
% \override SpacingSpanner.packed-spacing = ##t
\consists \Chord_lyrics_spacing_engraver
% ChordPro engraver in Score context to collect all data
\consists \ChordPro_score_collector
\remove Bar_number_engraver
\remove Mark_engraver
\remove Jump_engraver
\remove Volta_engraver
\remove Parenthesis_engraver
\remove Metronome_mark_engraver
\remove Text_mark_engraver
}
\context {
\Staff
@@ -313,13 +451,7 @@
\remove Tie_engraver
\remove Dynamic_engraver
\remove Note_heads_engraver
}
\context {
\NullVoice
\consists Rest_engraver
\omit Rest
% \undo \omit NoteHead
% \hide NoteHead
\remove Script_engraver
}
}
}
File renamed without changes.
@@ -1,4 +1,5 @@
#(define song-list '())
#(define song-number 0)
#(define (files-in-directory dirname)
;;; Generate list containing filenames
@@ -64,7 +65,10 @@ additionalPageNumbers =
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)
(symbol? number?)
#:category other
@@ -88,9 +92,10 @@ width may require additional tweaking.)"
,(delay (ly:stencil-expr
(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))
(number-type (ly:output-def-lookup layout 'page-number-type))
(page-markup
(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
(let find-earliest-additional-label
((rest-additional-page-switch-label-list (member (cons label #t) additional-page-switch-label-list)))
@@ -98,7 +103,7 @@ width may require additional tweaking.)"
(find-earliest-additional-label (cdr 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))
(gap (- (interval-length x-ext)
@@ -114,7 +119,7 @@ width may require additional tweaking.)"
includeSong =
#(define-void-function (parser location textproc filename) ((procedure?) string?)
#(define-void-function (filename) (string?)
#{
\bookOutputName #filename
#}
@@ -125,24 +130,47 @@ 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) #} '())))))
`(
(label . ,label)
(header . ,HEADER)
(music . ,MUSIC)
(layout . ,LAYOUT)
(text-pages . ,(map (lambda (text)
#{ \markuplist \setsongfilename $filename $text #})
TEXT_PAGES))
)
song-list))
))
blankpage =
#(define-void-function (parser location) ()
#(define-void-function () ()
(set! song-list
(acons 'emptyPage
'()
song-list)))
imagepage =
#(define-void-function (parser location xsize filename) (number? string?)
#(define-void-function (xsize filename) (number? string?)
(set! song-list
(acons 'imagePage
(acons 'xsize xsize (acons 'filename filename '()))
`((xsize . ,xsize)
(filename . ,filename))
song-list)))
markuppage =
#(define-void-function (mkup) (markup?)
(set! song-list
(acons 'markupPage
`((markup . ,mkup))
song-list)))
#(define chapters '())
songsChapter =
#(define-void-function (title) (string?)
(set! chapters
(cons (cons title (length song-list)) chapters)))
#(define-markup-command (pagecenter layout props stuff)(markup?)
(interpret-markup layout props
(let ((halfpaperheight (/ (ly:output-def-lookup layout 'paper-height) 2))
@@ -151,51 +179,154 @@ imagepage =
)))
songs =
#(define-void-function (parser location) ()
#(define-void-function () ()
(let* ((ordered (reverse song-list))
(total (length ordered))
;; Ein Lied erzeugt nur dann einen PDF-Outline-Eintrag (/OUT), wenn
;; title oder starttext gesetzt sind (siehe build-full-title). Nur solche
;; Lieder duerfen als Kapitel-Kinder gezaehlt werden -- sonst wird die
;; /Count zu hoch und der erste Folgeeintrag (z.B. ein spaeteres Kapitel)
;; rutscht faelschlich als Kind mit hinein.
;; Eingebettete Lieder (embedded_songs.ily) haben jeweils ein eigenes
;; Lesezeichen, daher die Anzahl statt eines Booleans.
(bookmark-count
(lambda (e)
(if (or (eq? (car e) 'emptyPage)
(eq? (car e) 'imagePage)
(eq? (car e) 'markupPage))
0
(let* ((headermodule (ly:book-header (assq-ref (cdr e) 'header)))
(vars (extract-and-check-vars-from-module headermodule '(title starttext))))
(+ (if (or (assq-ref vars 'title) (assq-ref vars 'starttext)) 1 0)
(count song-pdf-bookmark-title (embedded-songs-of-header headermodule)))))))
(count-bookmark-songs
(lambda (start end)
(let loop ((i 0) (l ordered) (c 0))
(cond ((or (null? l) (>= i end)) c)
((< i start) (loop (+ i 1) (cdr l) c))
(else (loop (+ i 1) (cdr l) (+ c (bookmark-count (car l)))))))))
;; chapters: (title . start-index). start-index = Anzahl der song-list-
;; Eintraege beim Aufruf von songsChapter = Index in `ordered`, ab dem
;; das Kapitel beginnt.
(chapters-asc (sort chapters (lambda (a b) (< (cdr a) (cdr b)))))
;; pending: aufsteigende Liste von (start title count); count = Anzahl
;; der Lesezeichen-Lieder von diesem Kapitel bis zum Beginn des naechsten.
(pending
(let loop ((chs chapters-asc) (acc '()))
(if (null? chs)
(reverse acc)
(let* ((title (caar chs))
(start (cdar chs))
(end (if (null? (cdr chs)) total (cdadr chs)))
(cnt (count-bookmark-songs start end)))
(loop (cdr chs) (cons (list start title cnt) acc))))))
;; Aktuell aktives Kapitel (Titel-String) waehrend des Durchlaufs. Wird
;; gesetzt, sobald ein Kapitel aktiviert (aus `pending` entfernt) wird --
;; egal ob auf einer Seite (chapter-prefixed-markup) oder auf dem ersten
;; Song. Jeder danach folgende Song erhaelt dieses Kapitel als
;; chapterref-Header-Feld, woraus toc_include.ily den Kapitel-Index baut.
(current-chapter #f)
;; Stellt einer beliebigen Seite (markup-/image-/emptyPage) den Kapitel-
;; Eintrag (chapter-to-pdf-toc) bei, falls an Position `this-index` ein
;; Kapitel faellig ist, und entfernt es aus `pending`. So fuehrt die
;; Kapitel-Referenz zur ersten Seite nach dem \songsChapter -- egal
;; welcher Seitentyp das ist. Der Eintrag wird als unsichtbares Overlay
;; (\combine) beigelegt, damit er das Seitenlayout nicht veraendert;
;; \with-dimensions gibt dem sonst extent-losen pdfmark einen minimalen
;; Extent, damit er auch auf leeren Seiten nicht verworfen wird.
(chapter-prefixed-markup
(lambda (this-index base-markup)
(if (and (pair? pending) (<= (car (car pending)) this-index))
(let ((cnt (caddr (car pending)))
(title (cadr (car pending))))
(set! pending (cdr pending))
(set! current-chapter title)
(make-combine-markup
base-markup
(make-with-dimensions-markup '(0 . 0) '(0 . 0.1)
(make-chapter-to-pdf-toc-markup cnt title))))
base-markup)))
(index 0))
(for-each (lambda (songitems)
(ly:book-add-bookpart! (ly:parser-lookup '$current-book)
(let ((filename (car songitems))
(songvars (cdr songitems)))
(if (eq? filename 'emptyPage)
#{ \bookpart { \markup { \null } } #}
(if (eq? filename 'imagePage)
(let ((xsize (assq-ref songvars 'xsize))
(filename (ly:format "~a/~a" imagePagePath (assq-ref songvars 'filename))))
#{ \bookpart {
\paper {
%{
inner-margin = 0
outer-margin = 0
binding-offset = 0
top-margin = 0
bottom-margin = 0
%}
print-page-number = ##f
last-bottom-spacing = #'((basic-distance . 0) (minimum-distance . 0) (padding . 0))
page-count = 1
}
\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 ((this-index index))
(set! index (+ index 1))
(ly:book-add-bookpart! (ly:parser-lookup '$current-book)
(let ((filename (car songitems))
(songvars (cdr songitems)))
(if (eq? filename 'emptyPage)
#{ \bookpart { \markup { $(chapter-prefixed-markup this-index (make-null-markup)) } } #}
(if (eq? filename 'markupPage)
;; Kapitelanfang auf einer markuppage: Kapitel-Eintrag wird dieser
;; Seite beigelegt (siehe chapter-prefixed-markup).
#{ \bookpart { \markup { $(chapter-prefixed-markup this-index (assq-ref songvars 'markup)) } } #}
(if (eq? filename 'imagePage)
(let* ((xsize (assq-ref songvars 'xsize))
(filename (ly:format "~a/~a" imagePagePath (assq-ref songvars 'filename)))
(img-markup #{ \markup { \pagecenter { \epsfile #X #xsize #filename } } #}))
#{ \bookpart {
\paper {
%{
inner-margin = 0
outer-margin = 0
binding-offset = 0
top-margin = 0
bottom-margin = 0
%}
print-page-number = ##f
last-bottom-spacing = #'((basic-distance . 0) (minimum-distance . 0) (padding . 0))
page-count = 1
}
\markup { $(chapter-prefixed-markup this-index img-markup) }
} #}
)
;; Ist ein Kapitel faellig (Start <= aktuelle Position) und dies ein
;; echtes Lied, wird die Kapitelinfo an dieses Lied gehaengt und aus
;; `pending` entfernt.
(let* ((newnumber (+ 1 song-number))
(chaptertitle (if (and (pair? pending) (<= (car (car pending)) this-index))
(cadr (car pending)) #f))
(chaptercount (if chaptertitle (caddr (car pending)) 0))
;; Startet das Kapitel erst auf diesem Song (nicht schon auf
;; einer vorangehenden Seite), wird current-chapter jetzt
;; gesetzt und pending entfernt -- vor dem Bau des Headers,
;; damit chapterref bereits das neue Kapitel enthaelt.
(_ (if chaptertitle
(begin (set! current-chapter chaptertitle)
(set! pending (cdr pending)))))
(header #{ \bookpart { $(assq-ref songvars 'header) \header {
songfilename = $(symbol->string filename)
myindexlabel = #(assq-ref songvars 'label)
songnumber = #(number->string newnumber)
chaptertitle = #chaptertitle
chaptercount = #chaptercount
chapterref = #current-chapter
} } #})
(music (assq-ref songvars 'music))
(layout (assq-ref songvars 'layout))
(text-pages (assq-ref songvars 'text-pages))
(label (assq-ref songvars 'label))
(toc-music (header-module-to-toc! (ly:book-header header) label)))
(set! song-number newnumber)
;; Eingebettete Lieder: eigene Liednummer, gleiche Seite (label)
(for-each
(lambda (song)
(let ((tocheader (make-module)))
(set! song-number (+ 1 song-number))
(ly:module-copy tocheader song)
(module-define! tocheader 'songnumber (number->string song-number))
(module-define! tocheader 'chapterref current-chapter)
(header-module-to-toc! tocheader label)))
(embedded-songs-of-header (ly:book-header header)))
#{
\bookpart {
$header
\headerToTOC #header #label
\score { $music \layout { $layout } }
$text
$toc-music
\score { $music \layout { $layout songfilename = $(symbol->string filename) } }
$(add-text-pages text-pages)
}
#}))))))
(reverse song-list)
))
#}))))))))
ordered
)))
#(define (boernel-stats)
(let (
@@ -56,24 +56,14 @@
#(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
;; this crazy hack is necessary because lilypond depends on guile 1.8 atm
;; and so the cool unicode conversion functions cannot be used
(insert-alphabetical-sorted! (list label markup-symbol textoptions
(ly:string-substitute " " ""
(ly:string-substitute "…" ""
(ly:string-substitute "Č" "C"
(ly:string-substitute "Đ" "D"
(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 "." ""
(transliterate-de sorttext))))
index-item-list))
(make-music 'EventChord
'page-marker #t
@@ -91,20 +81,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 `(((combine-with-next . #t) (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 +110,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 `(((combine-with-next . #t) (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
@@ -142,6 +132,37 @@
author-index-hash)
(lambda (a b) (string-ci<? (car a) (car b))))))))
% code for chapter index
% Anders als bei Kategorien/Autoren ergibt sich die Kapitelzugehoerigkeit nicht
% aus dem Song-Header, sondern aus dem \songsChapter, das dem Song vorangeht
% (in book_include.ily als Header-Feld chapterref an jeden Song gehaengt).
% Die Kapitel behalten hier ihre Auftritts-Reihenfolge (nicht alphabetisch),
% ebenso die Songs innerhalb eines Kapitels ihre Song-Reihenfolge.
#(define*-public (add-chapter-index-item! chapter markup-symbol textoptions #:optional label) #f)
#(define-public (chapter-index-items) #f)
#(let ((chapter-index-hash (make-hash-table))
(chapter-order '()))
(set! add-chapter-index-item!
(lambda* (chapter markup-symbol textoptions #:optional (label (gensym "index")))
(let* ((chaptersym (string->symbol chapter))
(existing (hashq-ref chapter-index-hash chaptersym #f))
(chapterlist (or existing
(begin
(set! chapter-order (cons chaptersym chapter-order))
(list (list label 'indexChapterMarkup `(((combine-with-next . #t) (rawtext . ,chapter))))))))
)
(hashq-set! chapter-index-hash chaptersym
(cons (list label markup-symbol textoptions) chapterlist)))
(make-music 'EventChord
'page-marker #t
'page-label label
'elements (list (make-music 'LabelEvent
'page-label label)))))
(set! chapter-index-items (lambda ()
(append-map (lambda (chaptersym) (reverse (hashq-ref chapter-index-hash chaptersym (list))))
(reverse chapter-order)))))
#(define-markup-command (with-link-symbol-ref layout props symbol arg)
(symbol? markup?)
@@ -166,22 +187,24 @@
(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)()
#:properties ((index:text "")
(index:alternative #f)
(index:page #f)
(line-width))
(let* (
(text (chain-assoc-get 'index:text props))
(page (chain-assoc-get 'index:page props))
(width (-
(chain-assoc-get 'line-width props)
line-width
(interval-length (ly:stencil-extent (interpret-markup layout props "XXXX") X))))
(lines-reversed
(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))))))
(last-line-with-dots (make-fill-with-pattern-markup 1 RIGHT "." (car lines-reversed) page))
(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
@@ -203,7 +226,7 @@
\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
@@ -223,91 +246,113 @@
(make-null-markup))
\vspace #.4
}
indexChapterMarkup = \markup \override #'(baseline-skip . 1.5) \left-column {
\vspace #1
\sans \bold \fontsize #3 \fromproperty #'index:text
\vspace #.4
}
}
#(define (prepare-item-markup items layout)
(map (lambda (index-item)
(let ((label (car index-item))
(index-markup (cadr index-item))
(text (caddr index-item)))
(markup #:override (cons 'index:label label)
#:override (cons 'index:page (markup #:custom-page-number label -1))
#:override (cons 'index:text text)
(ly:output-def-lookup layout index-markup))))
(items)))
(define (single-item-markup 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))))
(if (null? items)
items
(let* ((index-item (car items))
(combine-with-next (chain-assoc-get 'combine-with-next (caddr index-item) #f))
(restitems (cdr items))
(item-markup (single-item-markup index-item)))
(if (and combine-with-next (not (null? restitems)))
(cons (make-column-markup (list item-markup (single-item-markup (car restitems)))) (prepare-item-markup (cdr restitems) layout))
(cons item-markup (prepare-item-markup restitems layout))))
))
#(define-markup-list-command (index-in-columns-with-title layout props index-type title-markup) (symbol? markup?)
( _i "Outputs index alphabetical sorted or in categories" )
(let ((items (case index-type
((alphabetical) index-items)
((categories) category-index-items)
((authors) author-index-items)))
((authors) author-index-items)
((chapters) chapter-index-items)))
(title (interpret-markup layout props title-markup)))
(cons title
(interpret-markup-list layout props
(make-columnlayout-markup-list songTocColumns 2
(let ((h (- (ly:output-def-lookup layout 'paper-height) 12)))
(cons (- h (interval-length (ly:stencil-extent title Y))) h))
(prepare-item-markup items layout))))))
(prepare-item-markup (items) layout))))))
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 'combine-with-next #t (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)))
(extract-var-and-check (lambda (headervar)
(let* ((variableref (assoc-ref headervars headervar))
(extracted (if variableref (variable-ref variableref) #f)))
(if (and extracted (not (and (string? extracted) (string-null? extracted)))) extracted #f)))))
(map (lambda (varsymbol)
(cons varsymbol (extract-var-and-check varsymbol))
) varlist)))
(extract-and-check-vars-from-module (ly:book-header bookheader) varlist))
headerToTOC = #(define-music-function (parser location header label) (ly:book? symbol?)
#(define (header-module-to-toc! headermodule label)
(define (all-author-ids authors)
(let ((poetIds (find-author-ids-by 'text authors))
(translatorIds (find-author-ids-by 'translation authors))
(versePoetData (find-author-id-with-part-numbers 'verse authors))
(composerIds (find-author-ids-by 'melody authors))
(verseComposerData (find-author-id-with-part-numbers 'meloverse authors))
(refComposerIds (find-author-ids-by 'meloref 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) refComposerIds (map car voiceComposerData) compositionIds adaptionIds bridgeIds interludeIds))
))
(let*
(
(extractedheadervars (extract-and-check-vars-from-header header '(title starttext alttitle categorytitle categories authors)))
(extractedheadervars (extract-and-check-vars-from-module headermodule '(title starttext alttitle categorytitle categories authors songnumber chapterref)))
(title (assq-ref extractedheadervars 'title))
(starttext (assq-ref extractedheadervars 'starttext))
(alttitle (assq-ref extractedheadervars 'alttitle))
(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))
(chapterref (assq-ref extractedheadervars 'chapterref))
(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 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 chapterref (add-chapter-index-item! chapterref '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 (cons (list (cons 'rawtext alt) (cons 'alternative #t)) '())))
(add-to-toc! alt #t))
alttitle)
(add-to-toc! alttitle (cons (list (cons 'rawtext alttitle) (cons 'alternative #t)) '()))))
(if title (add-to-toc! title (cons (list (cons 'rawtext title)) '())) #{ #})
(add-to-toc! alttitle #t)))
(if title (add-to-toc! title #f) #{ #})
))
headerToTOC = #(define-music-function (parser location header label) (ly:book? symbol?)
(header-module-to-toc! (ly:book-header header) label))
%% https://github.com/NalaGinrut/guile-csv/blob/master/csv/csv.scm
@@ -353,12 +398,9 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
(para-lines (map cleanup-whitespaces para-strings)))
(string-join para-lines "\n")))
(define (generate-toc-csv labelPageTable)
(let ((song-lines (map (lambda (song)
(let* ((filename (symbol->string (car song)))
(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 categorytitle categories authors year_text year_melody year_translation year_composition infotext translation pronunciation copyright source)))
(define (song-line filename page-number headermodule)
(let* ((extractedheadervars (extract-and-check-vars-from-module headermodule
'(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 ""))))
@@ -368,8 +410,11 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
(versePoetData (find-author-id-with-part-numbers 'verse authors))
(composerIds (find-author-ids-by 'melody authors))
(verseComposerData (find-author-id-with-part-numbers 'meloverse authors))
(refComposerIds (find-author-ids-by 'meloref 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
@@ -385,20 +430,31 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
(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) refComposerIds))
(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))
(format-info-paragraphs (headervar-or-empty 'translation))
(format-info-paragraphs (headervar-or-empty 'pronunciation))
))))
(alist-delete 'imagePage (alist-delete 'emptyPage song-list)))))
;; Eingebettete Lieder (embedded_songs.ily) bekommen eigene Zeilen mit
;; Dateiname und Seite des Hauptlieds.
(let ((song-lines (append-map (lambda (song)
(let* ((filename (symbol->string (car song)))
(songvars (cdr song))
(page-number (assoc-get (assq-ref songvars 'label) labelPageTable))
(headermodule (ly:book-header (assq-ref songvars 'header))))
(map (lambda (module) (song-line filename page-number module))
(cons headermodule (embedded-songs-of-header headermodule)))))
(alist-delete 'markupPage (alist-delete 'imagePage (alist-delete 'emptyPage song-list))))))
(call-with-output-file "toc.csv"
(lambda (port)
(csv-write (cons '(
@@ -416,6 +472,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"
@@ -426,6 +484,6 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
; we use a delayed stencil to have all the page references available
(ly:make-stencil
`(delay-stencil-evaluation
,(delay (let* ((table (ly:output-def-lookup layout 'label-page-table)))
,(delay (let* ((table (ly:output-def-lookup layout 'label-page-string-table)))
(generate-toc-csv (if (list? table) table '()))
empty-stencil)))))
+65
View File
@@ -0,0 +1,65 @@
#(define (transliterate-de str)
"Gesamte Transliteration: entfernt Diakritika, ersetzt Sonderzeichen, ergibt ASCII-String."
(define (remove-diacritics s)
(string-join
(map (lambda (ch)
(let ((code (char->integer ch)))
;; Unicode-Bereich 0300–036F = Combining Diacritical Marks
(if (and (>= code #x0300) (<= code #x036F))
""
(string ch))))
(string->list (string-normalize-nfkd s)))
""))
(define transliteration-table
'(
;; Deutsche Umlaute & ß
("ä" . "ae") ("ö" . "oe") ("ü" . "ue")
("Ä" . "Ae") ("Ö" . "Oe") ("Ü" . "Ue")
("ß" . "ss")
;; Balkan & mitteleuropäische Sonderzeichen
("Č" . "C") ("č" . "c")
("Š" . "S") ("š" . "s")
("Ž" . "Z") ("ž" . "z")
("Đ" . "D") ("đ" . "d")
("Ł" . "L") ("ł" . "l")
("Ø" . "O") ("ø" . "o")
("Æ" . "Ae") ("æ" . "ae")
("Œ" . "Oe") ("œ" . "oe")
;; Kyrillische Buchstaben mit lateinischen Pendants
("А" . "A") ("а" . "a")
("Б" . "B") ("б" . "b")
("В" . "V") ("в" . "v")
("Г" . "G") ("г" . "g")
("Д" . "D") ("д" . "d")
("Е" . "E") ("е" . "e")
("З" . "Z") ("з" . "z")
("И" . "I") ("и" . "i")
("К" . "K") ("к" . "k")
("Л" . "L") ("л" . "l")
("М" . "M") ("м" . "m")
("Н" . "N") ("н" . "n")
("О" . "O") ("о" . "o")
("П" . "P") ("п" . "p")
("Р" . "R") ("р" . "r")
("С" . "S") ("с" . "s")
("Т" . "T") ("т" . "t")
("У" . "U") ("у" . "u")
("Ф" . "F") ("ф" . "f")
("Х" . "Kh") ("х" . "kh")
("Ц" . "Ts") ("ц" . "ts")
("Ч" . "Ch") ("ч" . "ch")
("Ш" . "Sh") ("ш" . "sh")
("Щ" . "Sch") ("щ" . "sch")
("Я" . "Ja") ("я" . "ja")
("Ю" . "Ju") ("ю" . "ju")
("Й" . "J") ("й" . "j")
))
(remove-diacritics
(fold (lambda (pair acc)
(ly:string-substitute (car pair) (cdr pair) acc))
str transliteration-table)))
File renamed without changes.
+4
View File
@@ -0,0 +1,4 @@
\include "../private_includes/book/book_include.ily"
\include "../private_includes/book/transliteration.ily"
\include "../private_includes/book/toc_include.ily"
\include "../private_includes/book/appendix.ily"
File renamed without changes.
+126
View File
@@ -0,0 +1,126 @@
MUSIC = { \transposable #TRANSPOSITION \MUSIC }
%% Eingebettete Lieder (siehe embedded_songs.ily) im Header des Hauptlieds
%% vermerken, daraus bauen Footer, PDF-Lesezeichen und Verzeichnisse.
#(if (and (pair? EMBEDDED_SONGS) (ly:book? HEADER) (ly:book-header HEADER))
(module-define! (ly:book-header HEADER) 'embeddedsongs EMBEDDED_SONGS))
LAYOUT = \layout {
\LAYOUT
#(customized-layout LAYOUT)
}
#(customize-embedded-score-layouts! (list TEXT TEXT_PAGES))
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 #})
\handle-tag-groups \recordedTagGroups
\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 #})
\handle-tag-groups \recordedTagGroups
#text
}
#})
(if
(and
(defined? 'TEXT_PAGES)
(pair? TEXT_PAGES))
TEXT_PAGES
(list TEXT))))
%% Add invisible ChordPro write trigger to last TEXT_PAGES markuplist
#(when (and (defined? 'chordpro-export-enabled) chordpro-export-enabled (pair? TEXT_PAGES))
(let* ((last-index (- (length TEXT_PAGES) 1))
(last-page (list-ref TEXT_PAGES last-index))
(modified-last-page #{
\markuplist {
#last-page
\chordpro-delayed-write
}
#}))
(set! TEXT_PAGES
(append (list-head TEXT_PAGES last-index)
(list modified-last-page)))))
#(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))
)
;; ChordPro export: Store filename and extract metadata from basicSongInfo FIRST
(when (and (defined? 'chordpro-export-enabled) chordpro-export-enabled)
;; Use ly:parser-output-name which returns the output basename
;; This will write relative to current working directory (same as PDF)
(let ((output-name (ly:parser-output-name)))
(set! chordpro-current-filename output-name))
;; Try to extract metadata from the HEADER (falls back to basicSongInfo)
(let ((header-module (if (and (ly:book? HEADER) (ly:book-header HEADER))
(ly:book-header HEADER)
(and (defined? 'basicSongInfo) basicSongInfo))))
(when header-module
(let* ((header-alist (ly:module->alist header-module))
(title (assoc-ref header-alist 'title))
(authors (assoc-ref header-alist 'authors)))
(when title
(set! chordpro-header-title
(if (markup? title)
(markup->string title)
(if (string? title) title "Untitled"))))
(when authors
(set! chordpro-header-authors authors))))))
(add-score #{
\score {
\MUSIC
\layout { \LAYOUT }
}#})
(add-text-pages TEXT_PAGES)
(add-score #{
\score {
\unfoldRepeats { \MUSIC \INLINESCOREMUSIC }
\midi {
\context {
\Staff
\remove "Staff_performer"
}
\context {
\Voice
\consists "Staff_performer"
}
}
}#})
))
@@ -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"
@@ -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")
@@ -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")
-482
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
-25
View File
@@ -1,25 +0,0 @@
(if (not windows?) (use-modules (ice-9 popen)))
(use-modules (ice-9 textual-ports) (json parser))
; We use Python to convert the data yamls like the authors.yml to json, that we can parse in scheme.
; Windows does not like Pipes, so we use a tmpfile instead.
; Be sure you have PyYAML installed. On Windows that could be done for example like "py -m pip install PyYAML"
(define (yml-file->scm filename)
(if windows?
(let* ((port (make-tmpfile #f))
(tmpfilepath (port-filename port))
(ignore (close-port port))
(python_code (string-append "import sys, yaml, json; f = open(r'" tmpfilepath "', 'w'); f.write(json.dumps(yaml.safe_load(open(r'" filename "')))); f.close()"))
(status (system (string-append (search-executable '("python3" "python" "py")) " -X utf8 -c \"" python_code "\"")))
(readport (open-file tmpfilepath "r" #:encoding "UTF-8"))
(json (get-string-all readport)))
(close-port readport)
(delete-file tmpfilepath)
(json-string->scm (if (status:exit-val status) json "{}")))
(let* ((python_code (string-append "import sys, yaml, json; print(json.dumps(yaml.safe_load(open(r'" filename "'))))"))
(pipe (open-pipe (string-append "PYTHONHOME='' " (search-executable '("python3" "python" "py")) " -X utf8 -c \"" python_code "\"") OPEN_READ))
(json (get-string-all pipe)))
(close-pipe pipe)
(json-string->scm json))))
(define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename)))
-60
View File
@@ -1,60 +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
}
}
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
}
#(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 = #(/ midiQuarterNoteSpeed 4)
}
\context {
\Staff
\remove "Staff_performer"
}
\context {
\Voice
\consists "Staff_performer"
}
}
}#})
))
-16
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))
-66
View File
@@ -1,66 +0,0 @@
#(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))
(make-column-markup
(list
(make-vspace-markup (chain-assoc-get 'header:titletopspace props 0))
(make-customEps-markup (chain-assoc-get 'header:titlesize props 3.5) "titel.eps")
))
))
#(define-markup-command (category-image layout props size category)(number? string?)
(interpret-markup layout props
(if noStandaloneOutput
(make-epsfileref-markup Y size
(category-image-path category))
(make-epsfile-markup Y size
(category-image-path category)))))
#(define showCategoryImages (if (defined? 'showCategoryImages) showCategoryImages #t))
#(define-markup-command (category-images layout props)()
(interpret-markup layout props
(if showCategoryImages
(make-line-markup (map (lambda (category) (make-category-image-markup 5 category))
(string-tokenize (chain-assoc-get 'header:categories props ""))))
(make-null-markup))))
#(define pdf-encode (@@ (lily framework-ps) pdf-encode))
% PDF tags
#(define-markup-command (title-to-pdf-toc layout props title) (string?)
(ly:make-stencil
(list 'embedded-ps
(ly:format
"[/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)
))
#(define-markup-command (title-with-category-images layout props right)(boolean?)
(interpret-markup layout props
(let* ((title (chain-assoc-get 'header:title props ""))
(starttext (chain-assoc-get 'header:starttext props #f))
(pdfbookmark (if starttext (string-append starttext " | " title) title)))
(if title
(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 { " " } #})
)))
\paper {
bookTitleMarkup = \markup \null
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 }
}