107 Commits

Author SHA1 Message Date
57bcf94167 add default chordName exceptions 2025-04-27 14:37:07 +02:00
9a9ef8e8df fix transpositions for verses 2025-04-27 12:15:32 +04:00
tux
531e459af1 fix files-in-directory 2025-04-27 01:47:53 +02:00
tux
fc1bc74b10 fix altChord transposition again 2025-04-27 01:21:13 +02:00
tux
d47ae1a66d interpret songinfo with markups 2025-04-26 21:29:06 +02:00
37ee497f89 make cues configurable 2025-04-26 23:26:12 +04:00
41bd881014 remove Jump_engraver 2025-04-26 21:40:05 +04:00
tux
00a7b0ebc8 pseudoIndents for custom layouting 2025-04-21 19:48:30 +02:00
tux
760ca71ba7 melisOff and melisOn 2025-04-21 19:11:05 +02:00
tux
17074e2db6 secondVoiceStyle for Accidentals 2025-04-19 22:33:54 +02:00
tux
654f619fba sort contributions 2025-04-19 19:08:13 +02:00
tux
cc4fc9f297 fix altChord for SVG Output 2025-04-19 17:03:20 +02:00
d2dbf3448a change accidentalStyle to modern-voice-cautionary 2025-04-17 22:52:36 +04:00
tux
140bc611d1 fix altChord transposition 2025-04-17 20:22:21 +02:00
tux
eccd9b8730 fill-midi 2025-04-05 14:31:19 +02:00
900f4e1d06 workaround popen trouble on windows 2025-03-28 11:01:55 +01:00
7d01bd769c use authorId if not empty and not found 2025-03-27 17:00:05 +01:00
a0e70b4c4b add dottedExtender 2025-03-24 20:23:21 +01:00
04a01d3b3f Workaround für komische Python-Pfade 2025-03-13 20:14:43 +01:00
07b598db06 Fix handling of 'alttitle' variable to support both strings and lists in csv 2025-03-03 20:18:45 +04:00
a61becaf5e Support multiple alternative titles in headerToTOC function
This update allows the alttitle header field to accept a list of alternative titles instead of a single value. Each title in the list is processed and added to the table of contents as an alternative title, enhancing flexibility and usability.
2025-03-03 16:57:05 +04:00
f0f4b0c180 change default font 2025-02-25 08:21:31 +01:00
b6bead747d change midi settings 2025-02-25 08:19:07 +01:00
4dbdb72d30 fix layout size problem 2025-02-18 08:57:07 +01:00
aa8b9526fa implementing swingOff 2025-02-10 12:21:31 +04:00
tux
3cb0e00e8f updates for newest lilypond versions 2025-02-09 13:06:12 +01:00
152d56fe3f Autorenverzeichnis sortiert 2025-02-06 23:38:00 +01:00
883c32701c work if authors not specified 2025-02-02 16:12:04 +01:00
7b97e04fab optimize link area in toc 2025-01-28 00:26:18 +01:00
e4b65aafcb ref stanzas without dot 2025-01-27 22:16:34 +01:00
bf7e959100 appendix and footer improvements 2025-01-27 01:35:48 +01:00
tux
ddd4888041 \ref can take a list of stanza numbers now 2025-01-26 21:51:14 +01:00
tux
a368a3c589 Refactor author-format function 2025-01-23 23:08:15 +01:00
tux
e6725b84d4 scroll to left upper corner with pdf bookmarks 2025-01-23 22:12:09 +01:00
b41e2a62a4 windows includes angepasst 2024-12-31 16:13:21 +01:00
tux
15c27c271f toc for authors 2024-12-22 23:25:49 +01:00
tux
eca352b6d0 use \write-toc-csv in a markup to generate a toc.csv 2024-12-22 21:06:35 +01:00
ed30b34df2 swingMusic for midi that works with partials 2024-12-08 16:05:25 +01:00
a558a0b02f tagged case in lyricmode 2024-12-04 20:37:59 +01:00
tux
c4f3a3c196 use starttext and better PDF bookmarks 2024-12-01 15:48:25 +01:00
tux
db26306b5b use python3 for yml parsing 2024-11-28 09:19:52 +01:00
tux
487bf457fb load AUTHOR_DATA via path convention 2024-11-27 20:28:57 +01:00
tux
47bb7991b8 use yml files as default 2024-11-26 18:04:13 +01:00
tux
d94703547c allow break paged output
* compatibilty to Liederbuchgenerator
* apply standalone output directly to top level not wrapped in a book
2024-11-26 18:02:09 +01:00
tux
f0ffd3f630 use yml data structures with python parser 2024-11-24 15:23:32 +01:00
8dfbc5ef25 referencable appendix 2024-11-23 23:51:01 +01:00
tux
8800341e18 Make it possible to override a stanza number 2024-11-20 17:14:04 +01:00
tux
d56c11c5ff force printing first chord on newline 2024-11-16 23:21:37 +01:00
tux
754682afcf multiVerseSkips and alt functions 2024-11-03 17:35:45 +01:00
tux
88f0dc9f8f allow inherits in json file 2024-11-02 19:58:15 +01:00
tux
e9b904c32c more robust scm file include 2024-11-02 19:54:15 +01:00
tux
fd14138d0b no chord repeating by default in chordlyrics after linebreak 2024-11-02 19:51:10 +01:00
tux
a1bc48b824 right and left hyphen 2024-10-23 22:21:46 +02:00
tux
b4690f63bc Alternativchords mit Klammern 2024-09-04 09:39:57 +02:00
tux
958efca6aa set spacing for rests in chordlyrics 2024-09-03 12:13:23 +02:00
tux
81a5676965 more precise Links in PDF toc 2024-07-19 14:32:41 +02:00
tux
5ee1a7b6be show year also for same author on text and melody 2024-07-17 13:34:00 +02:00
tux
162d32c53d hide KeyCancellation in chordlyrics 2024-07-12 07:55:55 +02:00
tux
a3c3a67b33 make songTitleSize customizable 2024-07-10 22:29:58 +02:00
tux
09d3bb7fa1 improve spacing of chordlyrics 2024-06-30 19:02:12 +02:00
tux
bab581042a deprecate \schwarzkopf and solve the problem with layers 2024-06-30 15:27:53 +02:00
3b87476549 have repeat signs as stanzas in lyrics 2024-06-30 10:28:21 +02:00
c4bfc17b89 support für römische Zahlen in den Strophen 2024-06-29 19:18:05 +02:00
e388559f23 auch die Punktierung grau machen im secondVoiceStyle 2024-06-29 16:56:53 +02:00
tux
e17c544763 Anteil der songinfo Breite an Gesamtbreite konfigurierbar 2024-06-25 12:17:54 +02:00
tux
3c2f27b477 use upstream merge rest engraver 2024-06-02 19:46:43 +02:00
tux
b3d46ff607 fix tranpose 2024-05-27 14:56:44 +02:00
tux
0df95f6441 Textakkordabstands finetuning 2024-05-26 22:08:09 +02:00
tux
201a54f60a recognize verselayout and use lyrictext font size to render verse markup 2024-05-25 17:28:02 +02:00
tux
0199813a81 repair transposition for books 2024-05-25 13:14:14 +02:00
bce9ffe763 hide multi measure rests in chordlyrics 2024-05-22 22:55:41 +02:00
tux
86943b9316 fix default reference voice and chords for songbook output 2024-05-22 22:55:41 +02:00
tux
5884ab9d2c rework authorsystem
* add translation, interlude, bridge and meloverse
* fix rendering bugs
2024-05-12 18:31:39 +02:00
199f515be9 fix verse-chord multiple transpose problem 2024-05-12 16:13:56 +02:00
8c7386807b fix spacing in new chordlyrics system 2024-03-30 18:12:51 +01:00
tux
7f7cac99f4 add chordlyrics and nochordlyrics 2024-03-24 11:22:49 +01:00
395e959432 unknown author and shiftChords 2024-02-16 20:00:10 +01:00
tux
e72efbd156 custom line breaks more robust refs #21 2024-02-04 16:29:10 +01:00
tux
a0f60bc1c7 Autorensystem erweitert mit Angaben von Teilbeiträgen 2024-01-03 22:31:59 +01:00
tux
f5d5e1b020 neues System für Autorenangaben 2023-12-30 20:14:31 +01:00
4f43791541 Styleanpassungen Default style 2023-12-24 00:05:33 +01:00
2f906344de fix custom line break issue with comma 2023-11-23 10:24:06 +01:00
tux
b23ba5c0dc Aussprache ist natürlich pronunciation 2023-11-22 18:36:59 +01:00
tux
bc769f0831 gibt nur noch default style, alles andere in Liederbuchrepos 2023-11-22 17:33:02 +01:00
tux
6975cb1713 einheitliche ref und stanza Formatierung 2023-11-22 16:48:44 +01:00
tux
fbaf7a2c86 drop lilypond pre 2.25.8 compatibility, cause its not working anyway 2023-11-22 15:28:31 +01:00
tux
8b0fc2d7c9 snippets einzeln baubar und default layout 2023-11-02 23:13:11 +01:00
14e01900c2 songinfo Ausrichtung einfacher anpassbar gemacht 2023-11-01 09:48:52 +01:00
tux
bf596edb2c songinfogenerierung optimiert 2023-10-31 18:48:15 +01:00
tux
d6774670f3 Songinfogenerierung verbessert 2023-10-31 13:31:50 +01:00
tux
260664462d fix custom verse breaks for windows 2023-10-30 23:24:18 +01:00
tux
9de2869750 erlaube Umbrüche in Versen nach angegebenen Texten 2023-10-29 22:54:10 +01:00
tux
f0010c7746 Layoutmodifikationen auch für Strophen nutzen 2023-10-29 16:25:15 +01:00
tux
bedb2c0e22 fix chord name font 2023-10-28 09:34:26 +02:00
tux
33c3d47504 Strophensortierung gefixt 2023-09-25 01:39:55 +02:00
tux
15f37accaa repeats around chords 2023-09-18 18:08:33 +02:00
tux
c26fddd963 Inhaltsverzeichniserzeugung refactored 2023-09-17 18:08:52 +02:00
tux
55db0e0e31 Liederbuchvorlage wieder lauffähig gemacht 2023-09-16 18:38:53 +02:00
tux
7a0dd88067 add json parser for structured data like AUTHOR_DATA and SONG_DATA 2023-08-20 12:14:30 +02:00
tux
c20d0327e7 einheitliche Funktionalität zur Autorenanzeige #3 2023-08-11 16:25:06 +02:00
05ea776add Größerer intraverse space für Büdel-style 2023-08-10 15:18:12 +02:00
tux
7ddd597bed PDF Bookmarks gefixt 2023-08-10 13:20:16 +02:00
5c6fde06cc verbesserte Spaltenumbruchmethode #2 2023-08-10 10:14:01 +02:00
973d72301c shiftChord für manuelle Feinjustierung eingeführt #1 2023-08-10 09:39:07 +02:00
tux
fbf273dae9 smarter breaks in toc columns closes #2 2023-08-09 16:39:17 +02:00
tux
e2dc938c02 intraverse-vspace eingebaut, um Zeilenabstand zu beeinflussen 2023-08-09 13:36:46 +02:00
tux
301681fffb use new lilypond 2.25 regexes and font definitions 2023-08-09 11:17:58 +02:00
30 changed files with 1970 additions and 484 deletions

41
all_base_includes.ly Normal file
View File

@ -0,0 +1,41 @@
#(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 = {}

44
appendix.ly Normal file
View File

@ -0,0 +1,44 @@
appendix =
#(define-void-function (parser location title) (markup?)
(define (appendix-item->markup layout props appendix-item)
(interpret-markup layout props
(markup
#:override (cons 'appendixItem:heading (assoc-ref appendix-item "heading"))
#:override (cons 'appendixItem:text (assoc-ref appendix-item "text"))
(ly:output-def-lookup layout 'appendixItemMarkup))))
(ly:book-add-bookpart! (ly:parser-lookup '$current-book)
#{
\bookpart {
\markup { #title }
#(for-each
(lambda (item)
(add-score (ly:make-page-label-marker (string->symbol (car item))))
(add-text
(make-on-the-fly-markup
(lambda (layout props arg) (appendix-item->markup layout props (cdr item)))
(make-null-markup)))
)
(reverse APPENDIX_DATA))
}
#}))
#(define-markup-command (appendix-ref layout props label) (symbol?)
"call page-ref to appendix-item"
(interpret-markup layout props
(markup #:with-link label
#:override (cons 'appendixPage (make-page-ref-markup label "888" "?"))
(ly:output-def-lookup layout 'appendixReferenceMarkup))))
\paper {
appendixItemMarkup = \markup {
\left-column {
\line { \large \bold \fromproperty #'appendixItem:heading }
\vspace #0.2
\sans \wordwrap-field #'appendixItem:text
\vspace #0.7
}
}
appendixReferenceMarkup = \markup {
\fromproperty #'appendixPage
}
}

View File

@ -1,86 +0,0 @@
%% http://lsr.dsi.unimi.it/LSR/Item?id=336
%% see also http://code.google.com/p/lilypond/issues/detail?id=1228
%% Usage:
%% \new Staff \with {
%% \override RestCollision.positioning-done = #merge-rests-on-positioning
%% } << \somevoice \\ \othervoice >>
%% or (globally):
%% \layout {
%% \context {
%% \Staff
%% \override RestCollision.positioning-done = #merge-rests-on-positioning
%% }
%% }
%%
%% Limitations:
%% - only handles two voices
%% - does not handle multi-measure/whole-measure rests
#(define (rest-score r)
(let ((score 0)
(yoff (ly:grob-property-data r 'Y-offset))
(sp (ly:grob-property-data r 'staff-position)))
(if (number? yoff)
(set! score (+ score 2))
(if (eq? yoff 'calculation-in-progress)
(set! score (- score 3))))
(and (number? sp)
(<= 0 2 sp)
(set! score (+ score 2))
(set! score (- score (abs (- 1 sp)))))
score))
#(define (merge-rests-on-positioning grob)
(let* ((can-merge #f)
(elts (ly:grob-object grob 'elements))
(num-elts (and (ly:grob-array? elts)
(ly:grob-array-length elts)))
(two-voice? (= num-elts 2)))
(if two-voice?
(let* ((v1-grob (ly:grob-array-ref elts 0))
(v2-grob (ly:grob-array-ref elts 1))
(v1-rest (ly:grob-object v1-grob 'rest))
(v2-rest (ly:grob-object v2-grob 'rest)))
(and
(ly:grob? v1-rest)
(ly:grob? v2-rest)
(let* ((v1-duration-log (ly:grob-property v1-rest 'duration-log))
(v2-duration-log (ly:grob-property v2-rest 'duration-log))
(v1-dot (ly:grob-object v1-rest 'dot))
(v2-dot (ly:grob-object v2-rest 'dot))
(v1-dot-count (and (ly:grob? v1-dot)
(ly:grob-property v1-dot 'dot-count -1)))
(v2-dot-count (and (ly:grob? v2-dot)
(ly:grob-property v2-dot 'dot-count -1))))
(set! can-merge
(and
(number? v1-duration-log)
(number? v2-duration-log)
(= v1-duration-log v2-duration-log)
(eq? v1-dot-count v2-dot-count)))
(if can-merge
;; keep the rest that looks best:
(let* ((keep-v1? (>= (rest-score v1-rest)
(rest-score v2-rest)))
(rest-to-keep (if keep-v1? v1-rest v2-rest))
(dot-to-kill (if keep-v1? v2-dot v1-dot)))
;; uncomment if you're curious of which rest was chosen:
;;(ly:grob-set-property! v1-rest 'color green)
;;(ly:grob-set-property! v2-rest 'color blue)
(ly:grob-suicide! (if keep-v1? v2-rest v1-rest))
(if (ly:grob? dot-to-kill)
(ly:grob-suicide! dot-to-kill))
(ly:grob-set-property! rest-to-keep 'direction 0)
(ly:rest::y-offset-callback rest-to-keep)))))))
(if can-merge
#t
(ly:rest-collision::calc-positioning-done grob))))
generalLayout = \layout {
\generalLayout
\context {
\Staff
\override RestCollision.positioning-done = #merge-rests-on-positioning
}
}

View File

@ -1,25 +1,19 @@
\language "deutsch" \language "deutsch"
\include "styles.ly" \include "default_style.ly"
\include #(ly:format "styles/~a.ly" songStyle) \include "default_songinfo_style.ly"
\include "footer_with_songinfo.ly"
\include #(if (defined? 'customStyleOverridesFile) customStyleOverridesFile "void.ly") \include #(if (defined? 'customStyleOverridesFile) customStyleOverridesFile "void.ly")
#(set-default-paper-size songFormatAndSize) #(set-default-paper-size songFormatAndSize)
#(set-global-staff-size globalSize) #(set-global-staff-size globalSize)
#(define (default-pango size)
(make-pango-font-tree
songChordFont
songLyricFont
"Luxi Mono"
(/ size 20)))
\paper { \paper {
#(define fonts (default-pango globalSize)) property-defaults.fonts.serif = \songChordFont
property-defaults.fonts.sans = \songLyricFont
%annotate-spacing = ##t %annotate-spacing = ##t
% spacing stuff % spacing stuff
lyric-size = #lyricSize
two-sided = ##t two-sided = ##t
inner-margin = 1.5\cm inner-margin = 1.5\cm
outer-margin = \songMargin outer-margin = \songMargin
@ -30,6 +24,11 @@
markup-system-spacing = #'((basic-distance . 1)) markup-system-spacing = #'((basic-distance . 1))
score-markup-spacing = #'((padding . 2)) score-markup-spacing = #'((padding . 2))
top-markup-spacing = #'((basic-distance . 0) (minimum-distance . 0) (padding . 0)) 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 { generalLayout = \layout {
@ -44,7 +43,8 @@ generalLayout = \layout {
} }
\context { \context {
\Staff \Staff
\accidentalStyle modern \accidentalStyle modern-voice-cautionary
\consists Merge_rests_engraver
} }
\context { \context {
\Score \Score
@ -66,6 +66,12 @@ generalLayout = \layout {
\Voice \Voice
% ich will lines breaken wie ich will! % ich will lines breaken wie ich will!
\remove "Forbid_line_break_engraver" \remove "Forbid_line_break_engraver"
\override NoteHead.layer = 2
\override Dots.layer = 2
\override Stem.layer = 2
\override Flag.layer = 2
\override Beam.layer = 2
\override Accidental.layer = 2
} }
} }
@ -77,27 +83,151 @@ textp = \lyricmode { \markup { \raise #1 \musicglyph #"rests.3" } }
% zweite Stimme alles grau % zweite Stimme alles grau
secondVoiceStyle = { secondVoiceStyle = {
\override NoteHead.color = #grey \override NoteHead.color = #grey
\override Dots.color = #grey
\override Stem.color = #grey \override Stem.color = #grey
\override Flag.color = #grey \override Flag.color = #grey
\override Beam.color = #grey \override Beam.color = #grey
\override Accidental.color = #grey
\override NoteHead.layer = 1
\override Dots.layer = 1
\override Stem.layer = 1
\override Flag.layer = 1
\override Beam.layer = 1
\override Accidental.layer = 1
} }
firstVoiceStyle = { firstVoiceStyle = {
\override NoteHead.color = #black \override NoteHead.color = #black
\override Dots.color = #black
\override Stem.color = #black \override Stem.color = #black
\override Flag.color = #black \override Flag.color = #black
\override Beam.color = #black \override Beam.color = #black
\override Accidental.color = #black
} }
% einzelne Noten innerhalb von \secondVoiceStyle mit schwarzem statt grauem Kopf % Deprecated: einzelne Noten innerhalb von \secondVoiceStyle mit schwarzem statt grauem Kopf
schwarzkopf = schwarzkopf =
#(define-music-function (parser location noten) (ly:music?) #(define-music-function (parser location noten) (ly:music?)
#{ (begin (ly:warning "\\schwarzkopf brauchts nicht mehr, das kann ersatzlos weg!") noten))
\revert NoteHead.color
$noten
\override NoteHead.color = #grey
#})
% hübsche Wiederholungszeichen für den Liedtext romanStanza =
repStart = "𝄆" #(define-music-function (parser location) ()
repStop = "𝄇" #{ \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))
}
#})

View File

@ -1,5 +1,3 @@
\version "2.18"
#(define song-list '()) #(define song-list '())
#(define (files-in-directory dirname) #(define (files-in-directory dirname)
@ -11,7 +9,7 @@
(closedir dir) (closedir dir)
files) files)
(else (else
(next (readdir dir) (if (string-match "^(0|\\.)" f) files (cons f files)))))))) (next (readdir dir) (if (ly:regex-match? (ly:regex-exec (ly:make-regex "^(0|\\.)") f)) files (cons f files))))))))
#(define (file-to-stats filename) #(define (file-to-stats filename)
(set! song-list (cons filename song-list))) (set! song-list (cons filename song-list)))
@ -120,8 +118,8 @@ includeSong =
#{ #{
\bookOutputName #filename \bookOutputName #filename
#} #}
(ly:parser-parse-string (if (< (list-ref (ly:version) 1) 19) (ly:parser-clone parser) (ly:parser-clone)) (ly:parser-parse-string (ly:parser-clone)
(ly:format "\\include \"../../~a/~a/~a.ly\"" songPath filename filename)) (ly:format "\\include \"~a/~a/~a.ly\"" songPath filename filename))
(let ((label (gensym "index"))) (let ((label (gensym "index")))
(set! additional-page-switch-label-list (set! additional-page-switch-label-list
(acons label additional-page-numbers additional-page-switch-label-list)) (acons label additional-page-numbers additional-page-switch-label-list))
@ -155,7 +153,7 @@ imagepage =
songs = songs =
#(define-void-function (parser location) () #(define-void-function (parser location) ()
(for-each (lambda (songitems) (for-each (lambda (songitems)
(ly:book-add-bookpart! (if (< (list-ref (ly:version) 1) 19) (ly:parser-lookup parser '$current-book) (ly:parser-lookup '$current-book)) (ly:book-add-bookpart! (ly:parser-lookup '$current-book)
(let ((filename (car songitems)) (let ((filename (car songitems))
(songvars (cdr songitems))) (songvars (cdr songitems)))
(if (eq? filename 'emptyPage) (if (eq? filename 'emptyPage)
@ -209,7 +207,7 @@ songs =
;(string-join songs "\n") ;(string-join songs "\n")
"Nicht inkludiert:" "Nicht inkludiert:"
opticalline opticalline
(string-join (sort-list (lset-difference string=? (files-in-directory (ly:format "../../~a" songPath)) songs) string<?) "\n") (string-join (sort-list (lset-difference string=? (files-in-directory songPath) songs) string<?) "\n")
opticalline opticalline
) "\n" ) ) "\n" )
))) )))
@ -217,16 +215,16 @@ songs =
%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Include Images once and reference them: %% Include Images once and reference them:
#(define bbox-regexp #(define bbox-regexp
(make-regexp "%%BoundingBox:[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)")) (ly:make-regex "%%BoundingBox:[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)"))
#(define (get-postscript-bbox string) #(define (get-postscript-bbox string)
"Extract the bbox from STRING, or return #f if not present." "Extract the bbox from STRING, or return #f if not present."
(let* (let*
((match (regexp-exec bbox-regexp string))) ((match (ly:regex-exec bbox-regexp string)))
(if match (if match
(map (lambda (x) (map (lambda (x)
(string->number (match:substring match x))) (string->number (ly:regex-match-substring match x)))
(cdr (iota 5))) (cdr (iota 5)))
#f))) #f)))

2
break_paged_output.ily Normal file
View File

@ -0,0 +1,2 @@
\include "lilypond-book-preamble.ly"
#(ly:set-option 'separate-page-formats "pdf")

View File

@ -8,6 +8,16 @@ klamm = #(define-music-function (parser location chords) (ly:music?)
\set chordNameFunction = #ignatzek-chord-names \set chordNameFunction = #ignatzek-chord-names
#}) #})
repeats-around-chords =
#(define-music-function (parser location chords) (ly:music?)
#{
\once \set noChordSymbol = \markup { \normal-text \repStart }
r4
$chords
\once \set noChordSymbol = \markup { \normal-text \repStop }
r4
#})
bchord = bchord =
#(define-music-function (parser location chords) (ly:music?) #(define-music-function (parser location chords) (ly:music?)
#{ #{
@ -16,6 +26,48 @@ bchord =
\revert ChordName.font-series \revert ChordName.font-series
#}) #})
shiftChord = #(define-music-function (parser location xshift chord) (number? ly:music?)
#{
\once \override ChordName.extra-offset = #`(,xshift . 0)
$chord
#})
shiftChords = #(define-music-function (parser location xshift chords) (number? ly:music?)
#{
\override ChordName.extra-offset = #`(,xshift . 0)
$chords
#})
altChord =
#(define-music-function (parser location mainchord altchord) (ly:music? ly:music?)
(let* ((remove-point-and-click
(lambda (grob)
(ly:grob-set-property! grob 'cause #f)
(ly:text-interface::print grob)))
(chord-name (lambda (in-pitches bass inversion context) #{
\markup {
\translate #'(-0.5 . 0)
\score {
\chords { \transposable #(cons (car (music-pitches mainchord)) (car in-pitches)) { #(music-clone mainchord) \klamm #(music-clone altchord) } }
\layout {
\LAYOUT
\context {
\ChordNames
\override ChordName.extra-spacing-width = #'(0 . 0.3)
\override ChordName.stencil = #remove-point-and-click
}
\context {
\Score
\override SpacingSpanner.spacing-increment = 0
}
}
}
}#})))
#{
\once \set chordNameFunction = #chord-name
#mainchord
#}))
% kleine Mollakkorde und Alteration ausgeschrieben % kleine Mollakkorde und Alteration ausgeschrieben
#(define (note-name->german-markup-nosym pitch lowercase?) #(define (note-name->german-markup-nosym pitch lowercase?)
(define (pitch-alteration-semitones pitch) (inexact->exact (round (* (ly:pitch-alteration pitch) 2)))) (define (pitch-alteration-semitones pitch) (inexact->exact (round (* (ly:pitch-alteration pitch) 2))))
@ -52,11 +104,42 @@ bchord =
% additional bass notes should get uppercased % 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?)(note-name->german-markup-nosym pitch #f))
defaultChordPrintings = {
<c g>-\markup { \super "5" }
%% Dur
<c e g a>-\markup { \super "6" } %Standardverhalten
<c e a >-\markup { \super "6(no5)" }
<c e g a d'>-\markup { \super "6/9" }
<c e g b d'>-\markup { \super "9" } %Standardverhalten
<c e g b d' f'>-\markup { \super "11" } %Standardverhalten
<c e g b d' a'>-\markup { \super "13" }
%add chords
<c e g d'>-\markup { \super "add9" }
<c e g f'>-\markup { \super "add11" }
<c e g a'>-\markup { \super "add13" }
%major chords
<c e g h d'>-\markup { \super "maj9" }
%% Moll
<c es g a>-\markup { \super "6" } %Standardverhalten
<c es a >-\markup { \super "6(no5)" }
<c es g a d'>-\markup { \super "6/9" }
<c es g b d'>-\markup { \super "9" } %Standardverhalten
<c es g b d' f'>-\markup { \super "11" } %Standardverhalten
<c es g b d' a'>-\markup { \super "13" }
%add chords
<c es g d'>-\markup { \super "add9" }
<c es g f'>-\markup { \super "add11" }
<c es g a'>-\markup { \super "add13" }
%major chords
<c es g h d'>-\markup { \super "maj9" }
}
#(define chordNameExceptions #(define chordNameExceptions
(if (defined? 'customChordPrintings) (append
(sequential-music-to-chord-exceptions customChordPrintings #t) (if (defined? 'customChordPrintings)
'())) (sequential-music-to-chord-exceptions customChordPrintings #t)
'())
(sequential-music-to-chord-exceptions defaultChordPrintings #t)))
generalLayout = \layout { generalLayout = \layout {
\generalLayout \generalLayout
@ -65,7 +148,7 @@ generalLayout = \layout {
\semiGermanChords \semiGermanChords
\override ChordName.font-size = \songScoreChordFontSize \override ChordName.font-size = \songScoreChordFontSize
\override ChordName.font-series = \songChordFontSeries \override ChordName.font-series = \songChordFontSeries
\override ChordName.font-family = #'roman \override ChordName.font-family = #'serif
chordNameLowercaseMinor = ##t chordNameLowercaseMinor = ##t
chordChanges = ##t chordChanges = ##t
% eigenen chordRootNamer damit F# = Fis und Gb = Ges (also alteration ausgeschrieben) % eigenen chordRootNamer damit F# = Fis und Gb = Ges (also alteration ausgeschrieben)
@ -73,16 +156,6 @@ generalLayout = \layout {
chordNoteNamer = #bassnote-name->german-markup-nosym chordNoteNamer = #bassnote-name->german-markup-nosym
majorSevenSymbol = "maj7" majorSevenSymbol = "maj7"
chordNameExceptions = \chordNameExceptions chordNameExceptions = \chordNameExceptions
% der baseline-skip der Akkorde beeinflusst, wie hoch die Hochstellung ist
\override ChordName.baseline-skip = #1.0
}
}
verseChordLayout = \layout {
\generalLayout
\context {
\ChordNames
\override ChordName.font-size = \songTextChordFontSize
} }
} }
@ -91,14 +164,42 @@ verseChordLayout = \layout {
(interpret-markup layout props (interpret-markup layout props
#{ \markup { \override #'(baseline-skip . 2) #{ \markup { \override #'(baseline-skip . 2)
\center-column { \center-column {
\score { \new ChordNames { #(if (< (list-ref (ly:version) 1) 19) \score { \new ChordNames {
(ly:parser-include-string parser (string-append "\\chordmode { s4 " chord " }")) #(ly:parser-include-string (string-append "\\chordmode { s4 " chord " }"))
(ly:parser-include-string (string-append "\\chordmode { s4 " chord " }")) } \layout { \generalLayout } }
) } \layout { \generalLayout } } \override #'(fret-diagram-details . ((barre-type . straight))) {
\override #'(fret-diagram-details . ( \fret-diagram-terse #fret
(barre-type . straight))) {
\fret-diagram-terse #fret
} }
} }
} }
#})) #}))
% If you add this engraver to ChordNames Context chords get only printed on chordchanges and if its the first chord after line break.
Ensure_first_chord_after_line_break_printed_engraver =
#(lambda (ctx)
(define last-system-column-rank 0)
(make-engraver
(acknowledgers
((chord-name-interface this-engraver grob source-engraver)
(ly:grob-set-property! grob 'after-line-breaking
(lambda (grob)
(let ((current-system-column-rank (car (ly:grob-spanned-column-rank-interval (ly:grob-system grob)))))
(if (and
(ly:context-property ctx 'chordChanges #f)
(ly:grob-property grob 'begin-of-line-visible #f)
(not (= last-system-column-rank current-system-column-rank)))
; 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)
)))))))
% If you add this engraver to ChordNames Context chords get only printed on chordchanges and not at newline.
Ignoring_newline_chord_changes_engraver =
#(lambda (ctx)
(make-engraver
(acknowledgers
((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)
)))))

135
custom_indentation.ily Normal file
View File

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

7
default_output.ly Normal file
View File

@ -0,0 +1,7 @@
#(define noDefaultOutput (if (defined? 'noDefaultOutput) noDefaultOutput #f))
HEADER = \bookpart {
\header {
\basicSongInfo
}
}
\include #(if noDefaultOutput "void.ly" "standalone_output.ly")

72
default_songinfo_style.ly Normal file
View File

@ -0,0 +1,72 @@
\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)
)
}

35
default_style.ly Normal file
View File

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

View File

@ -9,7 +9,7 @@
(interpret-markup layout props (interpret-markup layout props
(let ((filepath (if (string-null? songfilename) (let ((filepath (if (string-null? songfilename)
filename filename
(ly:format "../../~a/~a/~a" songPath songfilename filename)))) (ly:format "~a/~a/~a" songPath songfilename filename))))
(if (file-exists? filepath) (if (file-exists? filepath)
(make-epsfile-markup Y ysize filepath) (make-epsfile-markup Y ysize filepath)
(if defaultmarkup (if defaultmarkup

View File

@ -1,33 +1,200 @@
#(use-modules (ice-9 receive))
#(define (format-author author-format-function authorId noDetails)
(let ((author (if (defined? 'AUTHOR_DATA) (assoc-ref AUTHOR_DATA authorId) #f)))
(if author
(author-format-function
noDetails
(assoc-ref author "name")
(assoc-ref author "trail_name")
(assoc-ref author "birth_year")
(assoc-ref author "death_year")
(assoc-ref author "organization")
)
(if (string-null? authorId)
"unbekannt"
authorId))))
#(define (find-author-ids-by contributionType authors)
(if authors
(filter-map (lambda (authordata) (if (member contributionType (cdr authordata)) (car authordata) #f)) authors)
(list)))
#(define (find-author-id-with-part-numbers contributionType authors)
(if authors
(sort-list
(filter-map (lambda (authordata)
(let ((contributionNumbers (filter-map (lambda (contribution) (if (and (list? contribution) (equal? contributionType (car contribution))) (cadr contribution) #f)) (cdr authordata)))
(authorId (car authordata)))
(if (null? contributionNumbers) #f (cons authorId (sort-list contributionNumbers <)))
)) authors)
(lambda (a b) (< (cadr a) (cadr b))))
(list)))
#(define-markup-command (print-songinfo layout props) () #(define-markup-command (print-songinfo layout props) ()
(interpret-markup layout props (define (songinfo-from songId key)
(let ( (let ((song (if (defined? 'SONG_DATA) (assoc-ref SONG_DATA songId) #f)))
(blockwidth (* (chain-assoc-get 'header:songinfo-size-factor props 0.9) (ly:output-def-lookup layout 'line-width))) (if song
(infotext (chain-assoc-get 'header:songinfo props #f)) (assoc-ref song key)
(poet (chain-assoc-get 'header:poet props #f)) (ly:warning (ly:format "song with id ~a not found" songId)))))
(composer (chain-assoc-get 'header:composer props #f))
(poet-and-composer-stacked (chain-assoc-get 'header:poet-and-composer-stacked props songInfoPoetAndComposerStacked)) (define* (default-author-format authorId #:optional (noDetails #f))
(between-poet-and-composer-markup (chain-assoc-get 'header:between-poet-and-composer-markup props (make-hspace-markup 3))) (format-author (ly:output-def-lookup layout 'authorFormat) authorId noDetails))
(copyright (chain-assoc-get 'header:copyright props #f)))
(if (chain-assoc-get 'page:is-bookpart-last-page props #f) (define (format-poet poetId)
(markup #:override '(baseline-skip . 3.0) ( (string-append (ly:output-def-lookup layout 'poetPrefix) " " (default-author-format poetId)))
make-fontsize-markup songInfoFontSize
(make-sans-markup (define (format-composer composerId)
;%\override #'(line-width . 92) \wordwrap-field #symbol (string-append (ly:output-def-lookup layout 'composerPrefix) " " (default-author-format composerId)))
(make-column-markup (list
(make-line-markup (define (format-poet-and-composer authorId)
(list (string-append (ly:output-def-lookup layout 'poetAndComposerEqualPrefix) " " (default-author-format authorId)))
(if (and poet (not (and (string? poet) (string-null? poet)))) (markup poet between-poet-and-composer-markup) "")
(if (and composer (not poet-and-composer-stacked)) composer "")) (define (numbered-contribution-prefix contributionNumbers prefixLookup)
) (string-append
(if (and composer poet-and-composer-stacked) (make-line-markup (list composer)) "") (string-join (map (lambda (contributionNumber) (ly:format "~a." contributionNumber)) contributionNumbers) ", ")
(make-override-markup `(line-width . ,blockwidth) (make-justify-string-markup (string-append " "
(if (and copyright (not (and (string? copyright) (string-null? copyright)))) (ly:format "© ~a\n\n" copyright) "") (ly:output-def-lookup layout prefixLookup)
(if infotext infotext "") )
))) )
)))
) (define referencedAuthors '())
)
(make-null-markup)))) (define (format-authors authorIds)
(map (lambda (authorId)
(default-author-format
authorId
(if (member authorId referencedAuthors)
#t
(begin
(set! referencedAuthors (cons authorId referencedAuthors))
#f)))
) authorIds)
)
(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)
)
(define (render-partial-contribution-group prefixLookup authorData)
(if (null? authorData)
""
(let ((firstAuthorContributions (cdar authorData)))
(receive (authorDataSame authorDataOther)
(partition (lambda (authorEntry) (equal? (cdr authorEntry) firstAuthorContributions)) authorData)
(join-present (list
(render-contribution-group (numbered-contribution-prefix firstAuthorContributions prefixLookup) (map car authorDataSame))
(render-partial-contribution-group prefixLookup authorDataOther)
) " ")))))
(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)
) "; ")
)))))
(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))
(poetId (chain-assoc-get 'header:poetId props (if songId (songinfo-from songId "poet") #f)))
(composerId (chain-assoc-get 'header:composerId props (if songId (songinfo-from songId "composer") #f)))
(poet-and-composer-same (equal? poetId composerId)))
(let ((infotext (chain-assoc-get 'header:infotext props (chain-assoc-get 'header:songinfo props #f)))
(poet-maybe-with-composer (chain-assoc-get 'header:poet props (if poetId (if poet-and-composer-same (format-poet-and-composer poetId) (format-poet poetId)) (car poet-and-composers))))
(composer (chain-assoc-get 'header:composer props (if (and composerId (not poet-and-composer-same)) (format-composer composerId) (cadr poet-and-composers))))
(copyright (chain-assoc-get 'header:copyright props #f))
(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))))
(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))
#:override (cons 'songinfo:composer
(if (and composer (not (and (string? composer) (string-null? composer)))) composer #f))
#:override (cons 'songinfo:copyright
(if (and copyright (not (and (string? copyright) (string-null? copyright)))) copyright #f))
#:override (cons 'songinfo:infotext
(if (and infotext (not (and (string? infotext) (string-null? infotext)))) infotext #f))
#:override (cons 'songinfo:translation
(if (and translation (not (and (string? translation) (string-null? translation)))) translation #f))
#:override (cons 'songinfo:pronunciation
(if (and pronunciation (not (and (string? pronunciation) (string-null? pronunciation)))) pronunciation #f))
#:override (cons 'songinfo:year_text
(if (and year_text (not (and (string? year_text) (string-null? year_text)))) year_text #f))
#:override (cons 'songinfo:year_melody
(if (and year_melody (not (and (string? year_melody) (string-null? year_melody)))) year_melody #f))
#:override '(baseline-skip . 3.0)
#:fontsize songInfoFontSize
#:sans
(ly:output-def-lookup layout 'songinfoMarkup)
)))
(make-null-markup)))
) )
#(define-markup-command (print-pagenumber layout props)() #(define-markup-command (print-pagenumber layout props)()
@ -40,6 +207,12 @@
) )
)))) ))))
#(define-markup-command (fractional-line-width layout props arg)(markup?)
(interpret-markup layout props
(make-override-markup
`(line-width . ,(* (chain-assoc-get 'header:songinfo-size-factor props songInfoLineWidthFraction) (ly:output-def-lookup layout 'line-width)))
arg)))
\paper { \paper {
print-first-page-number = ##t print-first-page-number = ##t
first-page-number = #0 first-page-number = #0
@ -47,14 +220,14 @@
oddFooterMarkup = \markup { oddFooterMarkup = \markup {
\fill-line { \fill-line {
\line { \null } \line { \null }
\line { \general-align #Y #DOWN \print-songinfo } \line { \if \on-last-page-of-part \general-align #Y #DOWN \fractional-line-width \print-songinfo }
\line { \if \should-print-page-number \print-pagenumber } \line { \if \should-print-page-number \print-pagenumber }
} }
} }
evenFooterMarkup = \markup { evenFooterMarkup = \markup {
\fill-line { \fill-line {
\line { \if \should-print-page-number \print-pagenumber } \line { \if \should-print-page-number \print-pagenumber }
\line { \general-align #Y #DOWN \print-songinfo } \line { \if \on-last-page-of-part \general-align #Y #DOWN \fractional-line-width \print-songinfo }
\line { \null } \line { \null }
} }
} }

View File

@ -1,25 +1,6 @@
\version "2.18" \version "2.25.8"
#(ly:set-option 'relative-includes #t) #(ly:set-option 'relative-includes #t)
\include #(if (< (list-ref (ly:version) 1) 24) "legacy-lilypond-compatibility.ly" "void.ly") #(define noDefaultOutput #t)
#(define noStandaloneOutput (if (defined? 'noStandaloneOutput) noStandaloneOutput #f)) \include "all_base_includes.ly"
\include "basic_format_and_style_settings.ly"
\include "eps_file_from_song_dir.ly"
\include "title_with_category_images.ly"
\include "footer_with_songinfo.ly"
\include "auto_rest_merging.ly"
\include "chord_settings.ly"
\include "transposition.ly"
\include "verses_with_chords.ly"
\include "arrows_in_scores.ly"
\include "swing_style.ly"
\include "inline_score.ly"
% reset important variables
LAYOUT = \layout { \generalLayout }
HEADER = {}
MUSIC = {}
TEXT = \markuplist {""}

View File

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

View File

@ -1,27 +0,0 @@
% this is to be compatible to older lilypond versions
\version "2.18.0"
#(define (on-first-page layout props)
"Whether the markup is printed on the first page of the book."
(= (chain-assoc-get 'page:page-number props -1)
(book-first-page layout props)))
#(define-markup-command (if layout props condition? argument)
(procedure? markup?)
#:category conditionals
(if (condition? layout props)
(interpret-markup layout props argument)
empty-stencil))
#(define (on-first-page-of-part layout props)
"Whether the markup is printed on the first page of the book part."
(= (chain-assoc-get 'page:page-number props -1)
(ly:output-def-lookup layout 'first-page-number)))
#(define (should-print-page-number layout props)
"Whether the page number should be printed on this page. This depends
on the settings @code{print-@/page-@/numbers} and
@code{print-@/first-@/page-@/number} of the @code{\\paper} block."
(and (eq? #t (ly:output-def-lookup layout 'print-page-number))
(or (not (on-first-page layout props))
(eq? #t (ly:output-def-lookup layout 'print-first-page-number)))))

482
scm/json_parser.scm Normal file
View File

@ -0,0 +1,482 @@
;;; (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

22
scm/resolve_inherits.scm Normal file
View File

@ -0,0 +1,22 @@
(define (resolve-inherit-entry-in-list alist entry)
(let* ((key (car entry))
(attributes (cdr entry))
(inherits (assoc-ref attributes "inherits")))
(if inherits
(let* ((alist-without-entry (alist-delete key alist))
(inherit-entry (assoc inherits alist-without-entry))
(inherits-attributes (if inherit-entry (alist-copy (cdr (resolve-inherit-entry-in-list alist-without-entry inherit-entry)))))
(override-attributes (alist-delete "inherits" attributes)))
(if inherit-entry
(begin
(for-each (lambda (attribute) (assoc-set! inherits-attributes (car attribute) (cdr attribute))) override-attributes)
(cons key inherits-attributes)
)
(ly:error "~a can not inherit from ~a" key inherits))
)
entry
)))
(define (resolve-inherits alist)
(map (lambda (entry) (resolve-inherit-entry-in-list alist entry)) alist)
)

25
scm/yaml_parser.scm Normal file
View File

@ -0,0 +1,25 @@
(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)))

5
snippet_include.ly Normal file
View File

@ -0,0 +1,5 @@
#(ly:set-option 'relative-includes #t)
#(define noDefaultOutput (if (defined? 'noDefaultOutput) noDefaultOutput #f))
\include #(if noDefaultOutput "void.ly" "all_base_includes.ly")

View File

@ -1,39 +1,60 @@
% set the speed of the midi music % set the speed of the midi music
#(define midiQuarterNoteSpeed (if (defined? 'midiQuarterNoteSpeed) midiQuarterNoteSpeed 90)) #(define midiQuarterNoteSpeed (if (defined? 'midiQuarterNoteSpeed) midiQuarterNoteSpeed 90))
MUSIC = { \transposable \MUSIC } MUSIC = { \transposable #TRANSPOSITION \MUSIC }
% nur Output wenn noStandaloneOutput auf false steht verselayout = \layout {
output = #(if (not noStandaloneOutput) \LAYOUT
#{ \context {
\bookpart { \ChordNames
\HEADER \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 { \score {
\MUSIC \MUSIC
\layout { \LAYOUT } \layout { \LAYOUT }
} }#})
(add-score TEXT)
\TEXT (add-score #{
\score { \score {
\unfoldRepeats { \MUSIC \INLINESCOREMUSIC } \unfoldRepeats { \MUSIC \INLINESCOREMUSIC }
\midi { \midi {
\context { \context {
\Score \Score
% Tempo des midi files % Tempo des midi files
tempoWholesPerMinute = #(ly:make-moment midiQuarterNoteSpeed 4) tempoWholesPerMinute = #(/ midiQuarterNoteSpeed 4)
}
\context {
\Staff
\remove "Staff_performer"
}
\context {
\Voice
\consists "Staff_performer"
} }
} }
} }#})
))
}
#}
)
% if we don't want a standalone output, cause we compile a book, we just have an empty output here,
% so lilypond does not generate output for this song
\book {
\bookpart { \output }
}

View File

@ -5,7 +5,7 @@
#(define songStyle #(define songStyle
(if (not (defined? 'songStyle)) (if (not (defined? 'songStyle))
(if (not (defined? 'defaultSongStyle)) 'börnel defaultSongStyle) (if (not (defined? 'defaultSongStyle)) 'default defaultSongStyle)
songStyle)) songStyle))
#(if (not (boolean? bookStyle)) #(if (not (boolean? bookStyle))

View File

@ -1,15 +0,0 @@
songFormatAndSize = "a6landscape"
songMargin = 8
songInfoFontSize = -1.5
songTitleFont = "Britannic T. custom"
songChordFont = "TimesNewRomanPS"
songLyricFont = "Arial"
songChordFontSeries = #'normal
songTextChordAlignment = #'left
songScoreChordFontSize = 3
songTextChordFontSize = 2
songTextLineHeigth = 5.5
songInfoPoetAndComposerStacked = ##f
songTocColumns = 3
globalSize = 15
lyricSize = 1.6

View File

@ -1,15 +0,0 @@
songFormatAndSize = "b6landscape"
songMargin = 5
songInfoFontSize = -3.5
songTitleFont = "Oregano"
songChordFont = "TeX Gyre Heros"
songLyricFont = "Liberation Sans"
songChordFontSeries = #'bold
songTextChordAlignment = #'center
songScoreChordFontSize = 0
songTextChordFontSize = \songScoreChordFontSize
songTextLineHeigth = 5
songInfoPoetAndComposerStacked = ##f
songTocColumns = 3
globalSize = 15
lyricSize = 1.6

View File

@ -1,15 +0,0 @@
songFormatAndSize = "a5"
songMargin = 5
songInfoFontSize = 0
songTitleFont = "Fontin Bold"
songChordFont = "Fontin"
songLyricFont = "FontinSans"
songChordFontSeries = #'bold
songTextChordAlignment = #'left
songScoreChordFontSize = 2
songTextChordFontSize = 2
songTextLineHeigth = 5
songInfoPoetAndComposerStacked = ##t
songTocColumns = 2
globalSize = 14
lyricSize = 1.6

View File

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

View File

@ -4,7 +4,7 @@
\markup { \markup {
\override #'(baseline-skip . 3.5) \override #'(baseline-skip . 3.5)
\center-column { \center-column {
\override #`(font-name . ,songTitleFont) { \fontsize #6 \fromproperty #'header:title } \override #`(font-name . ,songTitleFont) { \fontsize #songTitleSize \fromproperty #'header:title }
\large \bold \fromproperty #'header:subtitle \large \bold \fromproperty #'header:subtitle
\smaller \bold \fromproperty #'header:subsubtitle \smaller \bold \fromproperty #'header:subsubtitle
} }
@ -35,38 +35,26 @@
(string-tokenize (chain-assoc-get 'header:categories props "")))) (string-tokenize (chain-assoc-get 'header:categories props ""))))
(make-null-markup)))) (make-null-markup))))
#(define pdf-encode #(define pdf-encode (@@ (lily framework-ps) pdf-encode))
(if (< (list-ref (ly:version) 1) 24)
ly:encode-string-for-pdf
(@@ (lily framework-ps) pdf-encode)))
% PDF tags % PDF tags
#(define-markup-command (title-to-pdf-toc layout props title) (string?) #(define-markup-command (title-to-pdf-toc layout props title) (string?)
(ly:make-stencil (ly:make-stencil
(list 'embedded-ps (list 'embedded-ps
(ly:format (ly:format
"[/Action /GoTo /View [/Fit] /Title <~a> /OUT pdfmark" "[/Action /GoTo /View [/XYZ -4 currentpagedevice /PageSize get 1 get 4 add null] /Title (~a) /OUT pdfmark" (pdf-encode title)))
(fold
(lambda (ch hexout)
(string-append hexout
(format #f "~2,'0x" (char->integer ch))))
""
(string->list
(pdf-encode title)))))
empty-interval empty-interval empty-interval empty-interval
;'(0 . 0) '(0 . 0) ;'(0 . 0) '(0 . 0)
)) ))
#(define-markup-command (title-with-category-images layout props right)(boolean?) #(define-markup-command (title-with-category-images layout props right)(boolean?)
(interpret-markup layout props (interpret-markup layout props
(let* ((title (chain-assoc-get 'header:title props #f)) (let* ((title (chain-assoc-get 'header:title props ""))
(pdfbookmark (chain-assoc-get 'header:songfilename props title))) (starttext (chain-assoc-get 'header:starttext props #f))
(pdfbookmark (if starttext (string-append starttext " | " title) title)))
(if title (if title
;(if (chain-assoc-get 'header:categories props #f)
(if right (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 { \null \bookTitleMarkupCustom \category-images } } #}
#{\markup { \title-to-pdf-toc #pdfbookmark \fill-line \general-align #Y #UP { \category-images \bookTitleMarkupCustom \null } } #}) #{\markup { \title-to-pdf-toc #pdfbookmark \fill-line \general-align #Y #UP { \category-images \bookTitleMarkupCustom \null } } #})
;#{\markup \fill-line \general-align #Y #UP { \null \bookTitleMarkupCustom \null } #})
;(make-null-markup))
#{ \markup { " " } #}) #{ \markup { " " } #})
))) )))

View File

@ -19,13 +19,20 @@
(map (lambda (foo) (map (lambda (foo)
(make-general-align-markup Y UP (make-override-markup '(baseline-skip . 1) (make-column-markup (make-general-align-markup Y UP (make-override-markup '(baseline-skip . 1) (make-column-markup
(let add-to-col ((lines restlines) (height-left height)) (let add-to-col ((lines restlines) (height-left height))
(let* ((finished (null? lines)) (set! restlines lines)
(linestencil (if (not finished) (interpret-markup layout (cons (list (cons 'line-width line-width) (cons 'baseline-skip 1)) props) (markup #:center-align (car lines))))) (if (null? lines)
(calc-height (- height-left (if finished 0 (interval-length (ly:stencil-extent linestencil Y)))))) '()
(set! restlines lines) (let* ((line-to-stencil (lambda (line) (interpret-markup layout (cons (list (cons 'line-width line-width) (cons 'baseline-skip 1)) props) (markup line))))
(if (or (< calc-height 0) (null? lines)) (stencil-height (lambda (stencil) (interval-length (ly:stencil-extent stencil Y))))
(list) (linestencil (line-to-stencil (car lines)))
(cons (markup #:stencil linestencil) (add-to-col (cdr lines) calc-height))))))))) (current-line-height (stencil-height linestencil))
(new-height-left (- height-left current-line-height))
(next-line-height (if (null? (cdr lines)) current-line-height (stencil-height (line-to-stencil (cadr lines)))))
(no-space-for-next-line (and (< next-line-height current-line-height) (< new-height-left next-line-height)))
)
(if (or (< new-height-left 0) no-space-for-next-line)
'()
(cons (markup #:stencil linestencil) (add-to-col (cdr lines) new-height-left))))))))))
(make-list cols)))) (make-list cols))))
(if (null? restlines) (if (null? restlines)
(list) (list)
@ -107,7 +114,33 @@
(set! category-index-items (lambda () (set! category-index-items (lambda ()
(append-map (lambda (kv) (reverse (hashq-ref category-index-hash (car kv) (list)))) category-names)))) (append-map (lambda (kv) (reverse (hashq-ref category-index-hash (car kv) (list)))) category-names))))
% code for author index
#(define*-public (add-author-index-item! authorIDs markup-symbol text #:optional label) #f)
#(define-public (author-index-items) #f)
#(let ((author-index-hash (make-hash-table)))
(set! add-author-index-item!
(lambda* (authorIDs markup-symbol text #: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)))))
(hashq-set! author-index-hash authorsym
(cons (list label markup-symbol text) authorlist))
))
authorIDs)
(make-music 'EventChord
'page-marker #t
'page-label label
'elements (list (make-music 'LabelEvent
'page-label label)))))
(set! author-index-items (lambda ()
(append-map cdr
(sort-list
(hash-map->list
(lambda (authorsym authorlist) (cons (string-downcase (symbol->string authorsym)) (reverse authorlist)))
author-index-hash)
(lambda (a b) (string-ci<? (car a) (car b))))))))
#(define-markup-command (with-link-symbol-ref layout props symbol arg) #(define-markup-command (with-link-symbol-ref layout props symbol arg)
@ -133,16 +166,13 @@
(markup #:override (cons 'baseline-skip 3.5) (if catname (make-left-column-markup (string-split (cadr catname) #\newline)) category))))) (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)() #(define-markup-command (index-item-with-pattern layout props)()
(let ( (let* (
(text (chain-assoc-get 'index:text props)) (text (chain-assoc-get 'index:text props))
(page (chain-assoc-get 'index:page props)) (page (chain-assoc-get 'index:page props))
(width (- (width (-
(chain-assoc-get 'line-width props) (chain-assoc-get 'line-width props)
(interval-length (ly:stencil-extent (interpret-markup layout props "XXXX") X)))) (interval-length (ly:stencil-extent (interpret-markup layout props "XXXX") X))))
) (lines-reversed
(interpret-markup layout props
(make-column-markup
(let ((revlist
(if (markup? text) (if (markup? text)
(list text) (list text)
(reverse (map (lambda (stil) (markup #:stencil stil)) (reverse (map (lambda (stil) (markup #:stencil stil))
@ -151,70 +181,50 @@
(list (cons 'line-width width) (cons 'font-shape 'italic)) (list (cons 'line-width width) (cons 'font-shape 'italic))
(list (cons 'line-width width))) props) #f (list (cons 'line-width width))) props) #f
(chain-assoc-get 'rawtext text)))))) (chain-assoc-get 'rawtext text))))))
(target-size-markup (last-line-with-dots (make-fill-with-pattern-markup 1 RIGHT "." (car lines-reversed) page))
(lines-without-dots (cdr lines-reversed))
(target-line-size-markup
(make-column-markup (make-column-markup
(list (list
(make-simple-markup "Agj") (make-simple-markup "Agj")
(make-vspace-markup 0.2)))) (make-vspace-markup 0.2))))
) )
(reverse (map (lambda (m) (interpret-markup layout props
(make-size-box-to-box-markup #f #t m target-size-markup)) (make-size-box-to-box-markup #f #t
(cons (make-with-link-symbol-ref-markup 'index:label
(make-fill-with-pattern-markup 1 RIGHT "." (car revlist) page) (make-column-markup
(cdr revlist))))))))) (reverse (cons
last-line-with-dots
(map (lambda (m) (make-size-box-to-box-markup #f #t m target-line-size-markup)) lines-without-dots)))))
; this column is just to have a reference height for resizing
(make-column-markup
(reverse (map (lambda (m) (make-size-box-to-box-markup #f #t m target-line-size-markup)) (cons last-line-with-dots lines-without-dots))))
))))
\paper { \paper {
indexTitleMarkup = \markup \column { indexItemMarkup = \markup {
\fontsize #5 \sans \bold \fill-line { \null \fromproperty #'index:text \null }
\vspace #.5
\justify {
Da die allermeisten Lieder unter verschiedenen Namen bekannt sind,
wollen wir euch ein Inhaltsverzeichnis an die Hand geben, mit dem ihr hoffentlich auf verschiedene Arten fündig werdet.
Die Liedtitel, die auch die Überschriften sind, findet ihr normal gedruckt.
Alle weiteren Alternativtitel oder Liedanfänge sind zur Unterscheidung kursiv gedruckt.
}
\vspace #1
}
categoryTitleMarkup = \markup \column {
\fontsize #5 \sans \bold \fill-line { \null \fromproperty #'index:text \null }
\vspace #1
}
indexItemMarkup = \markup \with-link-symbol-ref #'index:label {
\index-item-with-pattern \index-item-with-pattern
} }
indexSectionMarkup = \markup \override #'(baseline-skip . 1.5) \column { indexSectionMarkup = \markup \override #'(baseline-skip . 1.5) \left-column {
\fill-line { \sans \bold \fontsize #3 \fromproperty #'index:text \null } \sans \bold \fontsize #3 \fromproperty #'index:text
\null \null
} }
indexCategoryMarkup = \markup \override #'(baseline-skip . 1.5) \column { indexCategoryMarkup = \markup \override #'(baseline-skip . 1.5) \column {
\fill-line { \line { \vcenter \category-image-symbol-ref #7 #'index:text \hspace #3 \vcenter \sans \bold \fontsize #3 \category-name-symbol-ref #'index:text } \null } \fill-line { \line { \vcenter \category-image-symbol-ref #7 #'index:text \hspace #3 \vcenter \sans \bold \fontsize #3 \category-name-symbol-ref #'index:text } \null }
\vspace #.4 \vspace #.4
} }
indexAuthorMarkup = \markup \override #'(baseline-skip . 1.5) \left-column {
\vspace #1
\sans \bold \fontsize #3
#(make-on-the-fly-markup
(lambda (layout props m)
(interpret-markup layout props
(make-justify-string-markup (format-author (ly:output-def-lookup layout 'authorFormat) (chain-assoc-get 'index:text props #f) #t))))
(make-null-markup))
\vspace #.4
}
} }
%{
#(define-markup-list-command (index layout props) ()
( _i "Outputs an alphabetical sorted index, using the paper
variable @code{indexTitleMarkup} for its title, then the list of
lines built using the @code{indexItem} music function
Usage: @code{\\markuplines \\index}" )
(cons (interpret-markup layout (cons (list (cons 'index:text "Inhaltsverzeichnis")) props)
(ly:output-def-lookup layout 'indexTitleMarkup))
(space-lines (chain-assoc-get 'baseline-skip props)
(map (lambda (index-item)
(let ((label (car index-item))
(index-markup (cadr index-item))
(text (caddr index-item)))
(interpret-markup
layout
(cons (list (cons 'index:page
(markup #:page-ref label "XXX" "?"))
(cons 'index:text text)
(cons 'index:label label))
props)
(ly:output-def-lookup layout index-markup))))
(index-items)))))
%}
#(define (prepare-item-markup items layout) #(define (prepare-item-markup items layout)
(map (lambda (index-item) (map (lambda (index-item)
(let ((label (car index-item)) (let ((label (car index-item))
@ -226,33 +236,19 @@
(ly:output-def-lookup layout index-markup)))) (ly:output-def-lookup layout index-markup))))
(items))) (items)))
#(define-markup-list-command (index-in-columns-with-title layout props index-type title-markup) (symbol? markup?)
#(define-markup-list-command (colindex layout props) () ( _i "Outputs index alphabetical sorted or in categories" )
( _i "Outputs an alphabetical sorted index, using the paper (let ((items (case index-type
variable @code{indexTitleMarkup} for its title, then the list of ((alphabetical) index-items)
lines built using the @code{indexItem} music function ((categories) category-index-items)
Usage: @code{\\markuplines \\index}" ) ((authors) author-index-items)))
(let ((title (interpret-markup layout (cons (list (cons 'index:text "Inhaltsverzeichnis")) props) (title (interpret-markup layout props title-markup)))
(ly:output-def-lookup layout 'indexTitleMarkup)))) (cons title
(cons title (interpret-markup-list layout props
(interpret-markup-list layout props (make-columnlayout-markup-list songTocColumns 2
(make-columnlayout-markup-list songTocColumns 2 (let ((h (- (ly:output-def-lookup layout 'paper-height) 12)))
(let ((h (- (ly:output-def-lookup layout 'paper-height) 12))) (cons (- h (interval-length (ly:stencil-extent title Y))) h))
(cons (- h (interval-length (ly:stencil-extent title Y))) h)) (prepare-item-markup items layout))))))
(prepare-item-markup index-items layout))))))
#(define-markup-list-command (categoryindex layout props) ()
( _i "Outputs categorized song titles" )
(if (null-list? (category-index-items))
(list)
(let ((title (interpret-markup layout (cons (list (cons 'index:text "Inhaltsverzeichnis nach Kategorien")) props)
(ly:output-def-lookup layout 'categoryTitleMarkup))))
(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 category-index-items layout)))))))
indexItem = indexItem =
#(define-music-function (parser location sorttext text) (string? markup?) #(define-music-function (parser location sorttext text) (string? markup?)
@ -264,41 +260,172 @@ indexSection =
"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 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 text sorttext))
%{ #(define (extract-and-check-vars-from-header bookheader varlist)
addTitleToTOC = #(define-music-function (parser location title) (string?) (let* ((headervars (hash-map->list cons (struct-ref (ly:book-header bookheader) 0)))
#{ (extract-var-and-check (lambda (headervar)
\indexItem #title \markup { #title } (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)))))
addAltTitleToTOC = #(define-music-function (parser location title) (string?) (map (lambda (varsymbol)
#{ (cons varsymbol (extract-var-and-check varsymbol))
\indexItem #title \markup { \italic #title } ) varlist)))
#})
%}
#(define (extract-var-from-module module sym)
(let ((variableref (assoc-ref module sym)))
(if variableref (variable-ref variableref) #f))
)
headerToTOC = #(define-music-function (parser location header label) (ly:book? symbol?) headerToTOC = #(define-music-function (parser location header label) (ly:book? symbol?)
(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))
(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)))
(delete-duplicates
(append poetIds translatorIds (map car versePoetData) composerIds (map car verseComposerData) (map car voiceComposerData) compositionIds bridgeIds interludeIds))
))
(let* (let*
( (
(headervars (hash-map->list cons (struct-ref (ly:book-header header) 0))) (extractedheadervars (extract-and-check-vars-from-header header '(title starttext alttitle categorytitle categories authors)))
(extract-var-and-check (lambda (headervar) (let (title (assq-ref extractedheadervars 'title))
((extracted (extract-var-from-module headervars headervar))) (starttext (assq-ref extractedheadervars 'starttext))
(if (and extracted (not (string-null? extracted))) extracted #f) (alttitle (assq-ref extractedheadervars 'alttitle))
))) (categorytitle (assq-ref extractedheadervars 'categorytitle))
(title (extract-var-and-check 'title)) (categories (assq-ref extractedheadervars 'categories))
(alttitle (extract-var-and-check 'alttitle)) (authors (assq-ref extractedheadervars 'authors))
(altalttitle (extract-var-and-check 'altalttitle))
(categorytitle (extract-var-and-check 'categorytitle))
(categories (extract-var-and-check 'categories))
(add-to-toc! (lambda (toctitle tocmarkup) (add-to-toc! (lambda (toctitle tocmarkup)
(add-index-item! 'indexItemMarkup tocmarkup toctitle label))) (add-index-item! 'indexItemMarkup tocmarkup toctitle label)))
) )
(if categories (add-category-index-item! (string-tokenize categories) 'indexItemMarkup (cons (list (cons 'rawtext (if categorytitle categorytitle title))) '()) label)) (if categories (add-category-index-item! (string-tokenize categories) 'indexItemMarkup (cons (list (cons 'rawtext (if categorytitle categorytitle title))) '()) label))
(if alttitle (add-to-toc! alttitle (cons (list (cons 'rawtext alttitle) (cons 'alternative #t)) '()))) (if authors (add-author-index-item! (all-author-ids authors) 'indexItemMarkup (cons (list (cons 'rawtext (if categorytitle categorytitle title))) '()) label))
(if altalttitle (add-to-toc! altalttitle (cons (list (cons 'rawtext altalttitle) (cons 'alternative #t)) '()))) (if starttext (add-to-toc! starttext (cons (list (cons 'rawtext starttext) (cons 'alternative #t)) '())))
(if alttitle
(if (list? alttitle)
(for-each (lambda (alt)
(add-to-toc! alt (cons (list (cons 'rawtext alt) (cons 'alternative #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)) '())) #{ #}) (if title (add-to-toc! title (cons (list (cons 'rawtext title)) '())) #{ #})
)) ))
%% https://github.com/NalaGinrut/guile-csv/blob/master/csv/csv.scm
#(define* (sxml->csv sxml port #:key (delimiter #\,))
(let* ((d (string delimiter))
(csv (map (lambda (l) (string-join l d)) sxml)))
(for-each (lambda (l)
(format port "~a~%" l))
csv)))
#(define csv-write sxml->csv)
#(define-markup-command (write-toc-csv layout props) ()
(define (csv-escape field)
(if (string-null? field)
field
(string-append
"\""
(ly:string-substitute "\n" "\\n"
(ly:string-substitute "\"" "\\\"" field))
"\"")))
(define (format-authors authorIds)
(string-join (map (lambda (authorId) (format-author (ly:output-def-lookup layout 'authorFormat) authorId #f)) authorIds) ", "))
(define cr-regex (ly:make-regex "\r"))
(define crlf-regex (ly:make-regex "\r\n"))
(define para-sep-regex (ly:make-regex "\n[ \t\n]*\n[ \t\n]*"))
(define whitespace-regex (ly:make-regex "[ \t\n]+"))
(define leading-whitespace-regex (ly:make-regex "^[ \t\n]+"))
(define trailing-whitespace-regex (ly:make-regex "[ \t\n]+$"))
(define (cleanup-whitespaces str)
(ly:regex-replace leading-whitespace-regex
(ly:regex-replace trailing-whitespace-regex
(ly:regex-replace whitespace-regex str " ")
"")
""))
(define (format-info-paragraphs text)
(let* ((para-strings (ly:regex-split
para-sep-regex
(ly:regex-replace
cr-regex
(ly:regex-replace crlf-regex text "\n")
"\n")))
(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)))
(headervar-or-empty (lambda (varsym)
(let ((extracted (assq-ref extractedheadervars varsym)))
(if extracted extracted ""))))
(authors (assq-ref extractedheadervars 'authors))
(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)))
(map csv-escape
(list
filename
page-number
(headervar-or-empty 'title)
(headervar-or-empty 'starttext)
(let ((alttitle-value (headervar-or-empty 'alttitle)))
(if (list? alttitle-value)
(string-join alttitle-value ", ") ; Wenn eine Liste, dann zusammenfügen
alttitle-value)) ; Wenn kein Liste, den originalen Wert verwenden
(headervar-or-empty 'categorytitle)
(headervar-or-empty 'categories)
(format-authors (append poetIds (map car versePoetData)))
(format-authors translatorIds)
(format-authors (append composerIds compositionIds bridgeIds interludeIds (map car voiceComposerData) (map car verseComposerData)))
(headervar-or-empty 'year_text)
(headervar-or-empty 'year_melody)
(headervar-or-empty 'year_translation)
(headervar-or-empty 'year_composition)
(headervar-or-empty '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)))))
(call-with-output-file "toc.csv"
(lambda (port)
(csv-write (cons '(
"filename"
"page-number"
"title"
"starttext"
"alttitle"
"categorytitle"
"categories"
"poets"
"translators"
"composers"
"year_text"
"year_melody"
"year_translation"
"year_composition"
"copyright"
"source"
"infotext"
"translation"
"pronunciation"
) song-lines) port))
)))
; 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)))
(generate-toc-csv (if (list? table) table '()))
empty-stencil)))))

View File

@ -1,13 +1,22 @@
TRANSPOSITION = ##f TRANSPOSITION = #(cons #f #f)
transposeGlobal = transposeGlobal =
#(define-void-function (from to) (ly:pitch? ly:pitch?) #(define-void-function (from to) (ly:pitch? ly:pitch?)
(set! TRANSPOSITION (cons from to))) (set! TRANSPOSITION (cons from to)))
transposable = transposable =
#(define-music-function (music) (ly:music?) #(define-music-function (fromto music) (pair? ly:music?)
(if TRANSPOSITION (if (car fromto)
#{ #{
\transpose #(car TRANSPOSITION) #(cdr TRANSPOSITION) #music \transpose #(car fromto) #(cdr fromto) #music
#} #}
music)) music))
% Akkorde in Strophen transponieren
#(define-markup-list-command (transpose layout props from to markuplist)
(markup? markup? markup-list?)
(define (markup->pitch m)
(ly:assoc-get (string->symbol (markup->string m)) pitchnames))
(interpret-markup-list layout (prepend-alist-chain 'transposition (cons (markup->pitch from) (markup->pitch to)) props) markuplist))

View File

@ -1,18 +1,13 @@
% guile regular expressions aktivieren:
#(use-modules (ice-9 regex))
% parsing line by line % parsing line by line
#(define-markup-command (wrap-newline layout props text) (string?) #(define-markup-command (wrap-newline layout props text) (string?)
"Text Zeile für Zeile parsen" "Text Zeile für Zeile parsen"
(interpret-markup layout props (interpret-markup layout props
#{ \markup { \column { #{ \markup { \column {
$(let ((verse-markup-string (string-append "\\line { " $(let ((verse-markup-string (
(regexp-substitute/global #f "\n" string-append "\\line { "
text (ly:regex-replace (ly:make-regex "\r?\n") text " } \\line { ")
'pre " } \\line { " 'post )
" \\size-box-to-box ##f ##t \"\" \"Agj\" }" ))) " \\size-box-to-box ##f ##t \"\" \"Agj\" }" )))
;(ly:parse-string-expression (if (< (list-ref (ly:version) 1) 19) (ly:parser-clone parser) (ly:parser-clone)) verse-markup-string)) (ly:parser-include-string verse-markup-string))
(if (< (list-ref (ly:version) 1) 19) (ly:parser-include-string parser verse-markup-string) (ly:parser-include-string verse-markup-string)))
}}#} }}#}
) )
) )
@ -57,11 +52,6 @@
((center) (make-size-box-to-box-markup use-x use-y abox bbox)) ((center) (make-size-box-to-box-markup use-x use-y abox bbox))
((left) (make-size-box-to-box-left-aligned-markup use-x use-y abox bbox))))) ((left) (make-size-box-to-box-left-aligned-markup use-x use-y abox bbox)))))
% Akkorde in Strophen transponieren
#(define-markup-list-command (transpose layout props from to markuplist)
(markup? markup? markup-list?)
(interpret-markup-list layout (prepend-alist-chain 'transposition (cons from to) props) markuplist))
#(define-markup-command (chord-alignment-style-dependent layout props chord-with-text) (markup?) #(define-markup-command (chord-alignment-style-dependent layout props chord-with-text) (markup?)
(interpret-markup layout props (interpret-markup layout props
(case songTextChordAlignment (case songTextChordAlignment
@ -71,17 +61,18 @@
% Text über Text mittig darstellen % Text über Text mittig darstellen
#(define-markup-command (textup layout props text uptext) (markup? markup?) #(define-markup-command (textup layout props text uptext) (markup? markup?)
"Markup über Text mittig darstellen." "Markup über Text mittig darstellen."
(let ((verselayout (chain-assoc-get 'verselayout props generalLayout)))
(interpret-markup layout props (interpret-markup layout props
#{\markup { #{\markup {
\size-box-to-box-style-dependent ##t ##f \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 { \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 } \pad-to-box #'(0 . 0) #'(0 . 2.0) { #text }
\size-box-to-box ##f ##t #uptext \score { \chords { g4:m a } \layout { \generalLayout } } \size-box-to-box ##f ##t #uptext \score { \chords { g4:m a } \layout { \verselayout } }
} }
#text #text
} }
#} #}
)) )))
#(define-markup-command (anchor-x-between layout props arga argb) #(define-markup-command (anchor-x-between layout props arga argb)
(markup? markup?) (markup? markup?)
@ -92,50 +83,92 @@
)) ))
#(define-markup-command (stanza-raw layout props arg) #(define-markup-command (stanza-raw layout props arg)
(markup?) (string-or-music?)
(let ((verselayout (chain-assoc-get 'verselayout props generalLayout)))
(interpret-markup layout props (interpret-markup layout props
(if (and (string? arg) (string-null? arg)) (if (and (string? arg) (string-null? arg))
" " " "
#{\markup #{\markup
\score { \new Lyrics { \lyricmode { \set stanza = #arg "" } } \layout { \generalLayout } } \score { \new Lyrics { \lyricmode { #(if (ly:music? arg) arg #{ \set stanza = #arg #}) "" } } \layout { \verselayout } }
#} #}
))) ))))
#(define-markup-command (stanza layout props arg) #(define-markup-command (stanza layout props arg)
(markup?) (string-or-music?)
(interpret-markup layout props (interpret-markup layout props
(make-size-box-to-box-markup #f #t (make-stanza-raw-markup arg) (make-stanza-raw-markup "x")))) (make-size-box-to-box-markup #f #t (make-stanza-raw-markup arg) (make-stanza-raw-markup "x"))))
#(define (handle-custom-newlines custom-verse-breaks text)
(if (null? custom-verse-breaks)
text
(let make-custom-linebreaks
((break-words custom-verse-breaks)
(newtext (ly:regex-replace (ly:make-regex "\r?\n") text " ")))
(if (null? break-words)
newtext
(make-custom-linebreaks
(cdr break-words)
(ly:regex-replace
(ly:make-regex
(string-append
"("
(string-concatenate
(map
(lambda (character)
(let ((escaped_char (ly:regex-quote (string character))))
(string-append "(?: *,[^,)]+\\)" escaped_char "|\\(?" escaped_char ")")))
(string->list (car break-words))))
"(?: *,[^,)]+\\))?)(.*)$"))
newtext
1 "\n" 2))))))
#(use-modules (lily display-lily))
% Kompletten Vers mit Akkorden % Kompletten Vers mit Akkorden
#(define-markup-command (chordverse layout props stanza verse) (markup? string?) #(define-markup-command (chordverse layout props stanza verse) (string-or-music? string?)
#:properties (
(intraverse-vspace 0)
(custom-verse-breaks '())
(transposition (cons #f #f))
(verselayout generalLayout)
)
"Vers mit Akkorden" "Vers mit Akkorden"
(let* ((fromto (chain-assoc-get 'transposition props #f)) (let ((transp (if (car transposition)
(transp (if fromto (string-append "\\transpose " (symbol->string (note-name->lily-string (car transposition))) " " (symbol->string (note-name->lily-string (cdr transposition))))
(string-append "\\transpose " (car fromto) " " (cdr fromto))
""))) "")))
(interpret-markup layout props (interpret-markup layout props
(markup #:override `(baseline-skip . ,songTextLineHeigth) #:anchor-x-between #:stanza stanza (markup #:override `(baseline-skip . ,(+ intraverse-vspace songTextLineHeigth)) #:anchor-x-between #:stanza stanza
(make-wrap-newline-markup (make-wrap-newline-markup
(regexp-substitute/global #f "\\(( *)([^,()]*)( *),([^)]*)\\)" (ly:regex-replace (ly:make-regex "\\(( *)([^,()]*)( *),([^)]*)\\)")
(regexp-substitute/global #f "(([^ \n]*\\([^()]*\\)[^ \n]*)+)" verse (ly:regex-replace (ly:make-regex "(([^ \n]*\\([^()]*,[^()]+\\)[^ \n(]*)+)") (handle-custom-newlines custom-verse-breaks verse) " \\concat { " 1 " } ")
'pre " \\concat { " 1 " } " 'post) "\\textup \\line { \"" 1 "\" " 2 " \"" 3 "\" } \\score { " transp " \\chords { s4 " 4 " } \\layout { \\verselayout } }")
'pre "\\textup \\line { \"" 1 "\" " 2 " \"" 3 "\" } \\score { \\transposable " transp " \\chords { s4 " 4 " } \\layout { \\verseChordLayout } }" 'post)) )
)))) ))))
% Kompletter Vers aus dem Akkorde entfernt werden % Kompletter Vers aus dem Akkorde entfernt werden
#(define-markup-command (nochordverse layout props stanza verse) (markup? string?) #(define-markup-command (nochordverse layout props stanza verse) (string-or-music? string?)
#:properties ((intraverse-vspace 0)(custom-verse-breaks '()))
"Vers ohne Akkorde" "Vers ohne Akkorde"
(interpret-markup layout props (interpret-markup layout props
(markup #:override '(baseline-skip . 3.0) #:anchor-x-between #:stanza stanza (markup #:override `(baseline-skip . ,(+ intraverse-vspace 3.0)) #:anchor-x-between #:stanza stanza
#:wrap-newline (regexp-substitute/global #f "\\(([^,]*),([^)]*)\\)" verse 'pre 1 'post ) #:wrap-newline (ly:regex-replace (ly:make-regex "\\(([^,]*),([^)]*)\\)") (handle-custom-newlines custom-verse-breaks verse) 1)
) )
) )
) )
#(define-markup-command (verseformat layout props verse) (markup?) #(define-markup-command (verseformat layout props verse) (markup?)
#:properties ((verselayout generalLayout))
"Textformatierung für Strophen" "Textformatierung für Strophen"
(interpret-markup layout props (interpret-markup layout props
(make-sans-markup (make-fontsize-markup (ly:output-def-lookup layout 'lyric-size) verse)) (let* (
(layout-scale (ly:output-def-lookup layout 'output-scale 1.0))
(verselayout-scale (ly:output-def-lookup verselayout 'output-scale layout-scale))
(mag-scale (/ verselayout-scale layout-scale))
(lyric-context-props (ly:context-def-lookup (ly:assoc-get 'Lyrics (ly:output-find-context-def verselayout 'Lyrics)) 'property-ops))
(lyric-size (caddr (find (lambda (prop) (and (equal? 'push (car prop)) (equal? 'LyricText (cadr prop)) (equal? 'font-size (cadddr prop)))) lyric-context-props)))
)
(make-magnify-markup mag-scale (make-sans-markup (make-fontsize-markup lyric-size verse)))
)
) )
) )
@ -145,26 +178,161 @@
(verse-hspace 1) (verse-hspace 1)
(verse-ordering-horizontal #f)) (verse-ordering-horizontal #f))
"Gruppiere Strophen in einem Markup auf Wunsch spaltenweise" "Gruppiere Strophen in einem Markup auf Wunsch spaltenweise"
(let ((h (make-hash-table verse-cols)) (define (add-markup-between-elements reverses markup-between elements)
(index 0) ((if reverses fold fold-right) (lambda (element filled-list)
(column-item-count (ceiling (/ (length versegroup) verse-cols)))) (cons element (if (null? filled-list) '() (cons markup-between filled-list))))
(for-each (lambda (el) '() elements))
(let ((i (if verse-ordering-horizontal (let* ((column-item-count (ceiling (/ (length versegroup) verse-cols)))
(modulo index verse-cols) (column-data (make-list verse-cols)))
(floor (/ index column-item-count))))) (let columnize-list ((index 0) (items versegroup))
(hashv-set! h i (cons el (hashv-ref h i (list)))) (set! index (+ index 1)))) (if (not (null? items))
versegroup) (let* ((column-index (if verse-ordering-horizontal
(interpret-markup layout props (modulo index verse-cols)
(make-fill-line-markup (cons (make-verseformat-markup (make-line-markup (floor (/ index column-item-count))))
(reverse (hash-fold (lambda (key value l) (column-markups (list-ref column-data column-index)))
(cons (make-column-markup (list-set! column-data column-index (cons (car items) column-markups))
(fold (lambda (v verses) (columnize-list (+ index 1) (cdr items)))))
(cons v (if (null? verses) (interpret-markup layout props
verses (make-fill-line-markup (list (make-verseformat-markup (make-line-markup
(cons (make-vspace-markup verse-vspace) verses)))) (add-markup-between-elements #f
(list) value)) (make-hspace-markup verse-hspace)
(if (null-list? l) (map (lambda (column-markups)
l (make-column-markup
(cons (make-hspace-markup verse-hspace) l)))) (add-markup-between-elements #t (make-vspace-markup verse-vspace) column-markups)))
(list) h)))) column-data)))))))))
(list))))))
#(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))))
#(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?)
#: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))))
#(define-public (custom-lyric-text::print grob)
"Allow interpretation of tildes as lyric tieing marks."
;; See also similar code in Lyric_performer.
(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))
text))))
#(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 {
<<
\new Devnull { #verse-break-voice }
\new NullVoice = "dummyvoice" { #verse-reference-voice }
\transposable #transposition #(music-clone verse-chords)
\new Lyrics \lyricsto "dummyvoice" { #lyrics }
>>
\layout {
\verselayout
#(let
((custom-size (ly:output-def-lookup verselayout 'size #f)))
(if custom-size (layout-set-staff-size custom-size)))
ragged-right = ##t
\context {
\Lyrics
\override VerticalAxisGroup.nonstaff-relatedstaff-spacing.basic-distance = #verse-text-chord-distance
\override LyricText.parent-alignment-X = #LEFT
\override LyricText.self-alignment-X = #LEFT
\override LyricText.word-space = 0.8
\override LyricSpace.minimum-distance = 0.8
\override LyricText.stencil = #custom-lyric-text::print
}
\context {
\ChordNames
\override VerticalAxisGroup.staff-affinity = ##f
\override ChordName.extra-spacing-width = #'(-0.1 . 0.1)
\consists \Ensure_first_chord_after_line_break_printed_engraver
}
\context {
\Score
\override PaperColumn.keep-inside-line = ##f
% \override SpacingSpanner.strict-note-spacing = ##t
\override SpacingSpanner.uniform-stretching = ##t
\override SpacingSpanner.spacing-increment = 0
\remove Bar_number_engraver
\remove Mark_engraver
\remove Jump_engraver
\remove Volta_engraver
\remove Parenthesis_engraver
}
\context {
\Staff
\remove Staff_symbol_engraver
\remove Clef_engraver
\remove Time_signature_engraver
\remove Bar_engraver
\remove Separating_line_group_engraver
\omit KeySignature
\omit KeyCancellation
}
\context {
\Voice
\remove Stem_engraver
\remove Rest_engraver
\remove Multi_measure_rest_engraver
\remove Phrasing_slur_engraver
\remove Slur_engraver
\remove Tie_engraver
\remove Dynamic_engraver
\remove Note_heads_engraver
}
\context {
\NullVoice
\consists Rest_engraver
\omit Rest
% \undo \omit NoteHead
% \hide NoteHead
}
}
}
}
#}
)
)
#(define-markup-command (nochordlyrics layout props lyrics) (ly:music?)
"Vers ohne Akkorde"
(interpret-markup layout props
(markup
#:override `(verse-chords . ,#{#})
#:override `(verse-line-height . ,(- songTextLineHeigth 2))
#:chordlyrics lyrics))
)