Skripte aus dem Bock repo

This commit is contained in:
tux 2023-07-22 22:07:57 +02:00
parent 70311e5bb5
commit 7e44642855
5 changed files with 1460 additions and 0 deletions

369
book_include.ly Normal file
View File

@ -0,0 +1,369 @@
\version "2.18"
#(define song-list '())
#(define (files-in-directory dirname)
;;; Generate list containing filenames
(let ((dir (opendir dirname)))
(let next ((f (readdir dir))
(files '()))
(cond ((eof-object? f)
(closedir dir)
files)
(else
(next (readdir dir) (if (string-match "^(0|\\.)" f) files (cons f files))))))))
#(define (file-to-stats filename)
(set! song-list (cons filename song-list)))
#(define additional-page-switch-label-list '())
#(define additional-page-numbers #f)
normalPageNumbers =
#(define-void-function (parser location) ()
(set! additional-page-numbers #f)
)
additionalPageNumbers =
#(define-void-function (parser location) ()
(set! additional-page-numbers #t)
)
#(define (real-page-number layout label)
(let ((table (ly:output-def-lookup layout 'label-page-table)))
(if (list? table)
(assoc-get label table)
#f))
)
#(define display-pages-list '())
#(define (build-display-pages-list layout)
(if (null? display-pages-list)
(let calculate-display-page ((switch-label-list additional-page-switch-label-list))
(let* ((label (caar switch-label-list))
(is-additional (cdar switch-label-list))
(real-page (real-page-number layout label))
(rest-switch-label-list (cdr switch-label-list))
(display-page (if (null? rest-switch-label-list)
(if is-additional (- real-page 1) real-page)
(let* ((previous-label (caar rest-switch-label-list))
(previous-is-additional (cdar rest-switch-label-list))
(previous-display-page (calculate-display-page rest-switch-label-list)))
(+ previous-display-page
(if previous-is-additional
(if is-additional 0 1)
(if is-additional
(- (- real-page (real-page-number layout previous-label)) 1)
(- real-page (real-page-number layout previous-label)))
)
)
)
))
)
(set! display-pages-list (acons label display-page display-pages-list))
display-page
)))
display-pages-list
)
#(define-markup-command (custom-page-number layout props label real-current-page-number)
(symbol? number?)
#:category other
"
@cindex referencing page number, in text
Reference to a page number. @var{label} is the label set on the referenced
page (using the @code{\\label} command), @var{gauge} a markup used to estimate
the maximum width of the page number, and @var{default} the value to display
when @var{label} is not found.
(If the current book or bookpart is set to use roman numerals for page numbers,
the reference will be formatted accordingly -- in which case the @var{gauge}'s
width may require additional tweaking.)"
(let* ((gauge-stencil (interpret-markup layout props "XXX"))
(x-ext (ly:stencil-extent gauge-stencil X))
(y-ext (ly:stencil-extent gauge-stencil Y)))
(ly:stencil-outline
(ly:make-stencil
`(delay-stencil-evaluation
,(delay (ly:stencil-expr
(let* ((display-page (assq-ref (build-display-pages-list layout) label))
(real-current-page (if (negative? real-current-page-number) (real-page-number layout label) real-current-page-number))
(page-markup
(if (assq-ref additional-page-switch-label-list label)
(make-concat-markup (list (number-format 'arabic display-page)
(make-char-markup (+ 97 (- real-current-page (real-page-number layout
(let find-earliest-additional-label
((rest-additional-page-switch-label-list (member (cons label #t) additional-page-switch-label-list)))
(if (cdadr rest-additional-page-switch-label-list)
(find-earliest-additional-label (cdr rest-additional-page-switch-label-list))
(caar rest-additional-page-switch-label-list)))
))))))
(number-format 'arabic (+ display-page (- real-current-page (real-page-number layout label))))
))
(page-stencil (interpret-markup layout props page-markup))
(gap (- (interval-length x-ext)
(interval-length (ly:stencil-extent page-stencil X)))))
(interpret-markup layout props
(make-line-markup
(list
(make-hspace-markup gap)
page-markup)))))))
x-ext
y-ext)
(make-filled-box-stencil x-ext y-ext))))
includeSong =
#(define-void-function (parser location textproc filename) ((procedure?) string?)
#{
\bookOutputName #filename
#}
(ly:parser-parse-string (if (< (list-ref (ly:version) 1) 19) (ly:parser-clone parser) (ly:parser-clone))
(string-concatenate
(list
"HEADER = {} \nMUSIC = {}\nTEXT = \\markuplist {""}\nlyricSize = #1.6\n"
;"\\header { songfilename = \"" filename "\" }\n"
"\\include \"" "../../lieder/" filename "/" filename ".ly" "\"")))
(let ((label (gensym "index")))
(set! additional-page-switch-label-list
(acons label additional-page-numbers additional-page-switch-label-list))
(set! song-list
(acons (string->symbol filename)
(acons 'label label (acons 'header HEADER (acons 'music MUSIC (acons 'layout LAYOUT (acons 'text #{ \markuplist \setsongfilename $filename $(if textproc (textproc TEXT) TEXT) #} '())))))
song-list))
))
blankpage =
#(define-void-function (parser location) ()
(set! song-list
(acons 'emptyPage
'()
song-list)))
imagepage =
#(define-void-function (parser location xsize filename) (number? string?)
(set! song-list
(acons 'imagePage
(acons 'xsize xsize (acons 'filename filename '()))
song-list)))
songs =
#(define-void-function (parser location) ()
(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))
(let ((filename (car songitems))
(songvars (cdr songitems)))
(if (eq? filename 'emptyPage)
#{ \bookpart { \markup { \null } } #}
(if (eq? filename 'imagePage)
(let ((xsize (assq-ref songvars 'xsize))
(filename (ly:format "boernel_images/~a" (assq-ref songvars 'filename))))
#{ \bookpart {
\paper {
%{
inner-margin = 0
outer-margin = 0
binding-offset = 0
top-margin = 0
bottom-margin = 0
%}
print-page-number = ##f
last-bottom-spacing = #'((basic-distance . 0) (minimum-distance . 0) (padding . 0))
page-count = 1
}
\markup { \pagecenter { \epsfile #X #xsize #filename } }
} #}
)
(let ((header #{ \bookpart { $(assq-ref songvars 'header) \header {
songfilename = $(symbol->string filename)
myindexlabel = #(assq-ref songvars 'label)
} } #})
;(header (assq-ref songvars 'header))
(music (assq-ref songvars 'music))
(layout (assq-ref songvars 'layout))
(text (assq-ref songvars 'text))
(label (assq-ref songvars 'label)))
#{
\bookpart {
$header
\headerToTOC #header #label
\score { $music \layout { $layout } }
$text
}
#}))))))
(reverse song-list)
))
includeOnce =
#(define-void-function (parser location filename) (string?)
(if
(not (defined? (string->symbol filename)))
(begin
(ly:parser-include-string parser
(string-concatenate
(list "\\include \"" filename "\"")))
(primitive-eval (list 'define (string->symbol filename) #t)))))
#(define (boernel-stats)
(let (
(songs (map (lambda (song) (symbol->string (car song))) (alist-delete 'emptyPage song-list)))
(opticalline "---------------------------------------------------------"))
(ly:warning (string-join (list
opticalline
(string-concatenate (list "Inkludiert: " (number->string (length songs)) " Lieder\n"))
;(string-join songs "\n")
"Nicht inkludiert:"
opticalline
(string-join (sort-list (lset-difference string=? (files-in-directory "../../lieder") songs) string<?) "\n")
opticalline
) "\n" )
)))
%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Include Images once and reference them:
#(define bbox-regexp
(make-regexp "%%BoundingBox:[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)"))
#(define (get-postscript-bbox string)
"Extract the bbox from STRING, or return #f if not present."
(let*
((match (regexp-exec bbox-regexp string)))
(if match
(map (lambda (x)
(string->number (match:substring match x)))
(cdr (iota 5)))
#f)))
#(define eps-references '())
#(define-public (eps-file-ref->stencil axis size just-embed file-name)
(let*
((already-embedded (assq (string->symbol file-name) eps-references))
(counter (if already-embedded (cadr already-embedded) (if (null-list? eps-references) 1 (+ 1 (cadar eps-references)))))
(form-name (ly:format "IDForm~a" counter))
(data-name (ly:format "ImageData~a" counter))
(eps-content (ly:gulp-file file-name))
(contents (ly:format "~a execform" form-name))
(bbox (if already-embedded (cddr already-embedded) (get-postscript-bbox (car (string-split eps-content #\nul)))))
(bbox-size (if (= axis X)
(- (list-ref bbox 2) (list-ref bbox 0))
(- (list-ref bbox 3) (list-ref bbox 1))
))
(factor (if (< 0 bbox-size)
(exact->inexact (/ size bbox-size))
0))
(scaled-bbox
(map (lambda (x) (* factor x)) bbox))
;; We need to shift the whole eps to (0,0), otherwise it will appear
;; displaced in lilypond (displacement will depend on the scaling!)
(translate-string (ly:format "~a ~a translate" (- (list-ref bbox 0)) (- (list-ref bbox 1))))
(clip-rect-string (ly:format
"~a ~a ~a ~a rectclip"
(list-ref bbox 0)
(list-ref bbox 1)
(- (list-ref bbox 2) (list-ref bbox 0))
(- (list-ref bbox 3) (list-ref bbox 1)))))
(if (not already-embedded) (set! eps-references
(acons (string->symbol file-name) (cons counter bbox) eps-references)))
(if bbox
(ly:make-stencil
(list
'embedded-ps
(string-append
(if (and already-embedded (not just-embed)) "" (ly:format
"
/~a
currentfile
<< /Filter /SubFileDecode
/DecodeParms << /EODCount 0 /EODString (*EOD*) >>
>> /ReusableStreamDecode filter
~a
*EOD*
def
/~a
<< /FormType 1
/BBox [~a ~a ~a ~a]
/Matrix [ 1 0 0 1 0 0]
/PaintProc
{ pop
/ostate save def
/showpage {} def
/setpagedevice /pop load def
~a 0 setfileposition ~a cvx exec
ostate restore
} bind
>> def
" data-name eps-content form-name (list-ref bbox 0) (list-ref bbox 1) (list-ref bbox 2) (list-ref bbox 3) data-name data-name))
(if just-embed "" (ly:format
"
gsave
currentpoint translate
BeginEPSF
~a dup scale
~a
~a
%%BeginDocument: ~a
~a
%%EndDocument
EndEPSF
grestore
" factor translate-string clip-rect-string file-name contents
))))
;; Stencil starts at (0,0), since we have shifted the eps, and its
;; size is exactly the size of the scaled bounding box
(if just-embed '(0 . 0) (cons 0 (- (list-ref scaled-bbox 2) (list-ref scaled-bbox 0))))
(if just-embed '(0 . 0) (cons 0 (- (list-ref scaled-bbox 3) (list-ref scaled-bbox 1)))))
(ly:make-stencil "" '(0 . 0) '(0 . 0)))
))
#(define-markup-command (epsfileref layout props axis size file-name)
(number? number? string?)
#:category graphic
"
@cindex inlining an Encapsulated PostScript image
Inline an EPS image. The image is scaled along @var{axis} to
@var{size}.
@lilypond[verbatim,quote]
\\markup {
\\general-align #Y #DOWN {
\\epsfile #X #20 #\"context-example.eps\"
\\epsfile #Y #20 #\"context-example.eps\"
}
}
@end lilypond"
(if (ly:get-option 'safe)
(interpret-markup layout props "not allowed in safe")
(eps-file-ref->stencil axis size #f file-name)
))
#(define-markup-command (epsfileembed layout props file-name)
(string?)
#:category graphic
"
@cindex inlining an Encapsulated PostScript image
Inline an EPS image. The image is scaled along @var{axis} to
@var{size}.
@lilypond[verbatim,quote]
\\markup {
\\general-align #Y #DOWN {
\\epsfile #X #20 #\"context-example.eps\"
\\epsfile #Y #20 #\"context-example.eps\"
}
}
@end lilypond"
(if (ly:get-option 'safe)
(interpret-markup layout props "not allowed in safe")
(eps-file-ref->stencil X 30 #t file-name)
))

744
general_include.ly Normal file
View File

@ -0,0 +1,744 @@
\version "2.18"
\language "deutsch"
#(ly:set-option 'relative-includes #t)
\include "../lilypond-custom-includes/categories.ly"
compatibilityMode =
#(define-void-function (parser location) ()
(if (< (list-ref (ly:version) 1) 24)
(ly:parser-parse-string (if (< (list-ref (ly:version) 1) 19) (ly:parser-clone parser) (ly:parser-clone))
(string-concatenate
(list "\\include \"" "./legacy-lilypond-compatibility.ly" "\"")))))
\compatibilityMode
\include "./styles.ly"
#(define (lookup-var varsym default)
(let ((value (assoc-ref (hash-map->list cons (struct-ref (current-module) 0)) varsym)))
(if value (variable-ref value) default)))
globalSize = #(lookup-var 'globalSize 15)
lyricSize = #(lookup-var 'lyricSize 1.6)
showCategoryImages = #(lookup-var 'showCategoryImages #t)
% check if we have a StandAlone compile or if variable noStandaloneOutput is set
#(define isStandAlone (not (lookup-var 'noStandaloneOutput #f)))
#(if (< (list-ref (ly:version) 1) 19)
(case song-style
((börnel) (set-default-paper-size "b6" 'landscape))
((bock) (set-default-paper-size "a6" 'landscape)))
(case song-style
((börnel) (set-default-paper-size "b6landscape"))
((bock) (set-default-paper-size "a6landscape")))
)
#(set-global-staff-size globalSize)
#(define-markup-command (print-songinfo layout props) ()
(interpret-markup layout props
(let (
(blockwidth (* (chain-assoc-get 'header:songinfo-size-factor props 0.9) (ly:output-def-lookup layout 'line-width)))
(infotext (chain-assoc-get 'header:songinfo props #f))
(poet (chain-assoc-get 'header:poet props #f))
(composer (chain-assoc-get 'header:composer props #f))
(poet-and-composer-stacked (chain-assoc-get 'header:poet-and-composer-stacked props #f))
(between-poet-and-composer-markup (chain-assoc-get 'header:between-poet-and-composer-markup props (make-hspace-markup 3)))
(copyright (chain-assoc-get 'header:copyright props #f)))
(if (chain-assoc-get 'page:is-bookpart-last-page props #f)
(markup #:override '(baseline-skip . 3.0) (
make-fontsize-markup (case song-style ((börnel) -3.5) ((bock) -1.5))
;(symbol->keyword (case song-style ((börnel) 'roman) ((bock) 'sans)))
((lambda (m) (case song-style ((börnel) (make-roman-markup m)) ((bock) (make-sans-markup m))))
;%\override #'(line-width . 92) \wordwrap-field #symbol
(make-column-markup (list
(make-line-markup
(list
(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 ""))
)
(if (and composer poet-and-composer-stacked) (make-line-markup (list composer)) "")
(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) "")
(if infotext infotext "")
)))
)))
)
)
(make-null-markup))))
)
% songfilename verfügbar machen
#(define-markup-list-command (setsongfilename layout props songfilename markuplist)
(string? markup-list?)
(interpret-markup-list layout (prepend-alist-chain 'songfilename songfilename props) markuplist))
#(define-markup-command (customEps layout props ysize filename)(number? string?)
#:properties ((songfilename "")
(defaultmarkup #f))
(interpret-markup layout props
(let ((filepath (if (string-null? songfilename)
filename
(ly:format "../../lieder/~a/~a" songfilename filename))))
(if (file-exists? filepath)
(make-epsfile-markup Y ysize filepath)
(if defaultmarkup
defaultmarkup
(ly:format "file does not exist ~a" filepath))
))))
#(define-markup-command (bookTitleMarkupCustom layout props)()
(interpret-markup layout
(prepend-alist-chain 'defaultmarkup #{
\markup {
\override #'(baseline-skip . 3.5)
\center-column {
\override #`(font-name . ,(case song-style ((börnel) "Oregano") ((bock) "Britannic T. custom"))) { \fontsize #6 \fromproperty #'header:title }
\large \bold \fromproperty #'header:subtitle
\smaller \bold \fromproperty #'header:subsubtitle
}
}
#}
(prepend-alist-chain 'songfilename (chain-assoc-get 'header:songfilename props "") props))
(make-column-markup
(list
(make-vspace-markup (chain-assoc-get 'header:titletopspace props 0))
(make-customEps-markup (chain-assoc-get 'header:titlesize props 3.5) "titel.eps")
))
))
#(define-markup-command (category-image layout props size category)(number? string?)
(interpret-markup layout props
(if isStandAlone
(make-epsfile-markup Y size
(category-image-path category))
(make-epsfileref-markup Y size
(category-image-path category)))))
#(define-markup-command (category-images layout props)()
(interpret-markup layout props
(if showCategoryImages
(make-line-markup (map (lambda (category) (make-category-image-markup 5 category))
(string-tokenize (chain-assoc-get 'header:categories props ""))))
(make-null-markup))))
#(define-markup-command (pagecenter layout props stuff)(markup?)
(interpret-markup layout props
(let ((halfpaperheight (/ (ly:output-def-lookup layout 'paper-height) 2))
(halfstuffheight (/ (interval-length (ly:stencil-extent (interpret-markup layout props stuff) Y)) 2)))
(make-fill-line-markup (list (make-pad-to-box-markup '(0 . 0) (cons (- (- halfpaperheight halfstuffheight)) (+ halfpaperheight halfstuffheight)) stuff)))
)))
#(define-markup-command (print-pagenumber layout props)()
(let ((label (chain-assoc-get 'header:myindexlabel props #f)))
(interpret-markup layout props
(markup #:large #:bold
(if label
(make-custom-page-number-markup label (chain-assoc-get 'page:page-number props 0))
(make-fromproperty-markup 'page:page-number-string)
)
))))
#(define pdf-encode
(if (< (list-ref (ly:version) 1) 24)
ly:encode-string-for-pdf
(@@ (lily framework-ps) pdf-encode)))
% PDF tags
#(define-markup-command (title-to-pdf-toc layout props title) (string?)
(ly:make-stencil
(list 'embedded-ps
(ly:format
"[/Action /GoTo /View [/Fit] /Title <~a> /OUT pdfmark"
(fold
(lambda (ch hexout)
(string-append hexout
(format #f "~2,'0x" (char->integer ch))))
""
(string->list
(pdf-encode title)))))
empty-interval empty-interval
;'(0 . 0) '(0 . 0)
))
#(define-markup-command (title-with-category-images layout props right)(boolean?)
(interpret-markup layout props
(let* ((title (chain-assoc-get 'header:title props #f))
(pdfbookmark (chain-assoc-get 'header:songfilename props title)))
(if title
;(if (chain-assoc-get 'header:categories props #f)
(if right
#{\markup { \title-to-pdf-toc #pdfbookmark \fill-line \general-align #Y #UP { \null \bookTitleMarkupCustom \category-images } } #}
#{\markup { \title-to-pdf-toc #pdfbookmark \fill-line \general-align #Y #UP { \category-images \bookTitleMarkupCustom \null } } #})
;#{\markup \fill-line \general-align #Y #UP { \null \bookTitleMarkupCustom \null } #})
;(make-null-markup))
#{ \markup { " " } #})
)))
#(define (default-pango size)
(case song-style
((börnel)
(make-pango-font-tree ;"FreeSans"
;"Spectral"
"Liberation Sans"
"TeX Gyre Heros"
"Luxi Mono"
(/ size 20)))
((bock)
(make-pango-font-tree ;"FreeSans"
;"Spectral"
"TimesNewRomanPS"
"Arial"
"Luxi Mono"
(/ size 20)))))
\paper {
#(define fonts (default-pango globalSize))
%annotate-spacing = ##t
% spacing stuff
lyric-size = #lyricSize
two-sided = ##t
inner-margin = 1.5\cm
outer-margin = #(case song-style ((börnel) 5) ((bock) 8))
binding-offset = 0\cm
top-margin = #(case song-style ((börnel) 5) ((bock) 8))
bottom-margin = #(case song-style ((börnel) 5) ((bock) 8))
system-system-spacing = #'((basic-distance . 10) (padding . 1.5))
markup-system-spacing = #'((basic-distance . 1))
score-markup-spacing = #'((padding . 2))
top-markup-spacing = #'((basic-distance . 0) (minimum-distance . 0) (padding . 0))
% top-system-spacing = #'((basic-distance . 0) (minimum-distance . 0) (padding . -3))
%top-system-spacing #'stretchability = #30
% last-bottom-spacing #'stretchability = #0
print-first-page-number = ##t
first-page-number = #0
bookTitleMarkup = \markup \null
scoreTitleMarkup = \markup \null
oddHeaderMarkup = \markup { \if \on-first-page-of-part \title-with-category-images ##t }
evenHeaderMarkup = \markup { \if \on-first-page-of-part \title-with-category-images ##f }
oddFooterMarkup = \markup {
\fill-line {
\line { \null }
\line { \general-align #Y #DOWN \print-songinfo }
\line { \if \should-print-page-number \print-pagenumber }
}
}
evenFooterMarkup = \markup {
\fill-line {
\line { \if \should-print-page-number \print-pagenumber }
\line { \general-align #Y #DOWN \print-songinfo }
\line { \null }
}
}
}
% Akkorde können auch geklammert sein
#(define (parenthesis-ignatzek-chord-names in-pitches bass inversion context)
(markup #:line ( "(" (ignatzek-chord-names in-pitches bass inversion context) ")" )))
klamm = #(define-music-function (parser location chords) (ly:music?)
#{
\set chordNameFunction = #parenthesis-ignatzek-chord-names
$chords
\set chordNameFunction = #ignatzek-chord-names
#})
bchord =
#(define-music-function (parser location chords) (ly:music?)
#{
\override ChordName.font-series = #'bold
$chords
\revert ChordName.font-series
#})
% kleine Mollakkorde und Alteration ausgeschrieben
#(define (note-name->german-markup-nosym pitch lowercase?)
(define (pitch-alteration-semitones pitch) (inexact->exact (round (* (ly:pitch-alteration pitch) 2))))
(define (accidental->markup alteration name)
(if (= alteration 0)
(make-line-markup (list empty-markup))
(if (= alteration FLAT)
(if (equal? name "B")
""
; (make-line-markup (list (make-hspace-markup 0.2)
; (make-tiny-markup (make-raise-markup 1.2
; (make-musicglyph-markup (assoc-get alteration standard-alteration-glyph-name-alist ""))))
; ))
(if (or (equal? name "E") (equal? name "A")) "s" "es"))
"is")
))
(define (conditional-string-downcase str condition)
(if condition (string-downcase str) str))
(let* ((name (ly:pitch-notename pitch))
(alt-semitones (pitch-alteration-semitones pitch))
(n-a (if (member (cons name alt-semitones) `((6 . -1) (6 . -2)))
(cons 7 (+ 0 alt-semitones))
(cons name alt-semitones))))
(make-line-markup
(list
(make-simple-markup
(conditional-string-downcase
(vector-ref #("C" "D" "E" "F" "G" "A" "H" "B") (car n-a))
lowercase?))
(accidental->markup (/ (cdr n-a) 2) (vector-ref #("C" "D" "E" "F" "G" "A" "H" "B") (car n-a)) ))))
)
% additional bass notes should get uppercased
#(define (bassnote-name->german-markup-nosym pitch lowercase?)(note-name->german-markup-nosym pitch #f))
%% 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 {
indent = #0
% Akkordeinstellungen
\context {
\ChordNames
\semiGermanChords
\override ChordName.font-size = #(case song-style ((börnel) 0) ((bock) 3))
\override ChordName.font-series = #(case song-style ((börnel) 'bold) ((bock) 'normal))
\override ChordName.font-family = #(case song-style ((börnel) 'sans) ((bock) 'roman))
chordNameLowercaseMinor = ##t
chordChanges = ##t
% eigenen chordRootNamer damit F# = Fis und Gb = Ges (also alteration ausgeschrieben)
chordRootNamer = #note-name->german-markup-nosym
chordNoteNamer = #bassnote-name->german-markup-nosym
majorSevenSymbol = "maj7"
% der baseline-skip der Akkorde beeinflusst, wie hoch die Hochstellung ist
\override ChordName.baseline-skip = #1.0
}
\context {
\Lyrics
\override LyricText.font-size = #lyricSize
\override StanzaNumber.font-size = #lyricSize
\override StanzaNumber.font-family = #(case song-style ((börnel) 'roman) ((bock) 'sans))
\override LyricText.font-family = #(case song-style ((börnel) 'roman) ((bock) 'sans))
\override LyricExtender.minimum-length = 0
}
\context {
\Staff
\override RestCollision.positioning-done = #merge-rests-on-positioning
\accidentalStyle modern
}
\context {
\Score
\remove "Bar_number_engraver"
\RemoveEmptyStaves
\override VerticalAxisGroup.remove-first = ##t
\overrideTimeSignatureSettings
4/4 % timeSignatureFraction
1/4 % baseMomentFraction
#'(1 1 1 1) % beatStructure
#'() % beamExceptions
\overrideTimeSignatureSettings
3/4 % timeSignatureFraction
1/4 % baseMomentFraction
#'(1 1 1 1) % beatStructure
#'() % beamExceptions
}
\context {
\Voice
% ich will lines breaken wie ich will!
\remove "Forbid_line_break_engraver"
}
}
verseChordLayout = \layout {
\generalLayout
\context {
\ChordNames
\override ChordName.font-size = #(case song-style ((börnel) 0) ((bock) 2))
}
}
LAYOUT = \layout { \generalLayout }
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% kleine Helferlein:
textp = \lyricmode { \markup { \raise #1 \musicglyph #"rests.3" } }
% zweite Stimme alles grau
secondVoiceStyle = {
\override NoteHead.color = #grey
\override Stem.color = #grey
\override Flag.color = #grey
\override Beam.color = #grey
}
firstVoiceStyle = {
\override NoteHead.color = #black
\override Stem.color = #black
\override Flag.color = #black
\override Beam.color = #black
}
% einzelne Noten innerhalb von \secondVoiceStyle mit schwarzem statt grauem Kopf
schwarzkopf =
#(define-music-function (parser location noten) (ly:music?)
#{
\revert NoteHead.color
$noten
\override NoteHead.color = #grey
#})
% guile regular expressions aktivieren:
#(use-modules (ice-9 regex))
%{
% parsing line by line
#(define-markup-command (wrap-newline layout props text) (string?)
"Text Zeile für Zeile parsen"
(interpret-markup layout props
(ly:parse-string-expression (if (< (list-ref (ly:version) 1) 19) (ly:parser-clone parser) (ly:parser-clone)) (string-append "\\markup { \\column { \\line {"
(regexp-substitute/global #f "\n"
text
'pre "} \\line {" 'post )
"} } }" ))
)
)
%}
% parsing line by line
#(define-markup-command (wrap-newline layout props text) (string?)
"Text Zeile für Zeile parsen"
(interpret-markup layout props
#{ \markup { \column {
$(let ((verse-markup-string (string-append "\\line { "
(regexp-substitute/global #f "\n"
text
'pre " } \\line { " 'post )
" \\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))
(if (< (list-ref (ly:version) 1) 19) (ly:parser-include-string parser verse-markup-string) (ly:parser-include-string verse-markup-string)))
}}#}
)
)
#(define-markup-command (size-box-to-box layout props use-x use-y abox bbox)
(boolean? boolean? markup? markup?)
(let* ((ma (interpret-markup layout props abox))
(mb (interpret-markup layout props bbox))
(ax (ly:stencil-extent ma X))
(ay (ly:stencil-extent ma Y))
(bx (ly:stencil-extent mb X))
(by (ly:stencil-extent mb Y))
(halfdiffabx (* (- (interval-length bx) (interval-length ax)) 0.5)))
(ly:stencil-translate (ly:make-stencil (ly:stencil-expr ma)
(if use-x
(if (< halfdiffabx 0)
(cons
(- (interval-bound ax DOWN) halfdiffabx)
(+ (interval-bound ax UP) halfdiffabx))
bx)
ax)
(if use-y by ay))
(cons (if (and use-x (< halfdiffabx 0)) halfdiffabx 0) 0) )))
#(define-markup-command (size-box-to-box-left-aligned layout props use-x use-y abox bbox)
(boolean? boolean? markup? markup?)
(let* ((ma (interpret-markup layout props abox))
(mb (interpret-markup layout props bbox))
(ax (ly:stencil-extent ma X))
(ay (ly:stencil-extent ma Y))
(bx (ly:stencil-extent mb X))
(by (ly:stencil-extent mb Y)))
(ly:make-stencil (ly:stencil-expr ma)
(if use-x bx ax)
(if use-y by ay))
))
#(define-markup-command (size-box-to-box-style-dependent layout props use-x use-y abox bbox)
(boolean? boolean? markup? markup?)
(interpret-markup layout props
(case song-style
((börnel) (make-size-box-to-box-markup use-x use-y abox bbox))
((bock) (make-size-box-to-box-left-aligned-markup use-x use-y abox bbox)))))
% Akkord mit Bunddiagramm anzeigen
#(define-markup-command (fret-chord layout props fret chord) (string? string?)
(interpret-markup layout props
#{ \markup { \override #'(baseline-skip . 2)
\center-column {
\score { \new ChordNames { #(if (< (list-ref (ly:version) 1) 19)
(ly:parser-include-string parser (string-append "\\chordmode { s4 " chord " }"))
(ly:parser-include-string (string-append "\\chordmode { s4 " chord " }"))
) } \layout { \generalLayout } }
\override #'(fret-diagram-details . (
(barre-type . straight))) {
\fret-diagram-terse #fret
}
}
}
#}))
% 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?)
(interpret-markup layout props
(case song-style
((börnel) (make-center-align-markup chord-with-text))
((bock) (make-left-align-markup chord-with-text)))))
% Text über Text mittig darstellen
#(define-markup-command (textup layout props text uptext) (markup? markup?)
"Markup über Text mittig darstellen."
(interpret-markup layout props
#{\markup {
\size-box-to-box-style-dependent ##t ##f
\general-align #X #LEFT \override #`(direction . ,UP) \override #'(baseline-skip . 1.0) \dir-column \chord-alignment-style-dependent {
\pad-to-box #'(0 . 0) #'(0 . 2.0) { #text }
\size-box-to-box ##f ##t #uptext \score { \chords { g4:m a } \layout { \generalLayout } }
}
#text
}
#}
))
#(define-markup-command (anchor-x-between layout props arga argb)
(markup? markup?)
(let* ((la (interval-length (ly:stencil-extent (interpret-markup layout props arga) X)))
(m (interpret-markup layout props (markup #:general-align Y DOWN arga argb (make-size-box-to-box-markup #t #t (markup #:null) arga))))
(l (interval-length (ly:stencil-extent m X))))
(ly:stencil-aligned-to m X (- (/ (* la 2) l) 1))
))
#(define-markup-command (stanza-raw layout props arg)
(markup?)
(interpret-markup layout props
(if (and (string? arg) (string-null? arg))
" "
#{\markup
\score { \new Lyrics { \lyricmode { \set stanza = #arg "" } } \layout { \generalLayout } }
#}
)))
#(define-markup-command (stanza layout props arg)
(markup?)
(interpret-markup layout props
(make-size-box-to-box-markup #f #t (make-stanza-raw-markup arg) (make-stanza-raw-markup "x"))))
% Kompletten Vers mit Akkorden
#(define-markup-command (chordverse layout props stanza verse) (markup? string?)
"Vers mit Akkorden"
(let* ((fromto (chain-assoc-get 'transposition props #f))
(transp (if fromto
(string-append "\\transpose " (car fromto) " " (cdr fromto))
"")))
(interpret-markup layout props
(markup #:override `(baseline-skip . ,(case song-style ((börnel) 5.0) ((bock) 5.5))) #:anchor-x-between #:stanza stanza
(make-wrap-newline-markup
(regexp-substitute/global #f "\\(( *)([^,()]*)( *),([^)]*)\\)"
(regexp-substitute/global #f "(([^ \n]*\\([^()]*\\)[^ \n]*)+)" verse
'pre " \\concat { " 1 " } " 'post)
'pre "\\textup \\line { \"" 1 "\" " 2 " \"" 3 "\" } \\score { " transp " \\chords { s4 " 4 " } \\layout { \\verseChordLayout } }" 'post))
))))
% Kompletter Vers aus dem Akkorde entfernt werden
#(define-markup-command (nochordverse layout props stanza verse) (markup? string?)
"Vers ohne Akkorde"
(interpret-markup layout props
(markup #:override '(baseline-skip . 3.0) #:anchor-x-between #:stanza stanza
#:wrap-newline (regexp-substitute/global #f "\\(([^,]*),([^)]*)\\)" verse 'pre 1 'post )
)
)
)
% hübsche Wiederholungszeichen für den Liedtext
repStart = "𝄆"
repStop = "𝄇"
%{
repStart = \markup { \raise #0.75 \override #'(word-space . 0.2) {
\wordwrap { \vcenter { \override #'(word-space . 0.2) { \wordwrap {
\filled-box #'(0 . 0.3) #'(0 . 2.5) #0 \filled-box #'(0 . 0.15) #'(0 . 2.5) #0 } }
%\override #'(baseline-skip . 1.3) \fontsize #-5 \column { "•" "•" }
\override #'(baseline-skip . 1.0) \column { \draw-circle #0.2 #0 ##t \draw-circle #0.2 #0 ##t }
} } } }
repStop = \markup { \rotate #180 \repStart }
%}
#(define-markup-command (verseformat layout props verse) (markup?)
"Textformatierung für Strophen"
(interpret-markup layout props
((lambda (m) (case song-style ((börnel) (make-roman-markup m)) ((bock) (make-sans-markup m)))) (make-fontsize-markup (ly:output-def-lookup layout 'lyric-size) verse))
)
)
#(define-markup-command (group-verses layout props versegroup) (markup-list?)
#:properties ((verse-cols 1)
(verse-vspace 1)
(verse-hspace 1)
(verse-ordering-horizontal #f))
"Gruppiere Strophen in einem Markup auf Wunsch spaltenweise"
(let ((h (make-hash-table verse-cols))
(index 0)
(column-item-count (ceiling (/ (length versegroup) verse-cols))))
(for-each (lambda (el)
(let ((i (if verse-ordering-horizontal
(modulo index verse-cols)
(floor (/ index column-item-count)))))
(hashv-set! h i (cons el (hashv-ref h i (list)))) (set! index (+ index 1))))
versegroup)
(interpret-markup layout props
(make-fill-line-markup (cons (make-verseformat-markup (make-line-markup
(reverse (hash-fold (lambda (key value l)
(cons (make-column-markup
(fold (lambda (v verses)
(cons v (if (null? verses)
verses
(cons (make-vspace-markup verse-vspace) verses))))
(list) value))
(if (null-list? l)
l
(cons (make-hspace-markup verse-hspace) l))))
(list) h))))
(list))))))
%%%%%%%%%%%%%%%%% Pfeilezeugs
% http://lilypond.org/doc/v2.19/Documentation/snippets/vocal-music
#(define-markup-command (arrow-at-angle layout props angle-deg length fill)
(number? number? boolean?)
(let* (
(PI-OVER-180 (/ (atan 1 1) 34))
(degrees->radians (lambda (degrees) (* degrees PI-OVER-180)))
(angle-rad (degrees->radians angle-deg))
(target-x (* length (cos angle-rad)))
(target-y (* length (sin angle-rad))))
(interpret-markup layout props
(markup
#:translate (cons (/ target-x 2) (/ target-y 2))
#:rotate angle-deg
#:translate (cons (/ length -2) 0)
#:concat (#:draw-line (cons length 0)
#:arrow-head X RIGHT fill)))))
splitStaffBarLineMarkup = \markup \with-dimensions #'(0 . 0) #'(0 . 0) {
\combine
\arrow-at-angle #45 #(sqrt 8) ##t
\arrow-at-angle #-45 #(sqrt 8) ##t
}
splitStaffBarLine = {
\once \override Staff.BarLine.stencil =
#(lambda (grob)
(ly:stencil-combine-at-edge
(ly:bar-line::print grob)
X RIGHT
(grob-interpret-markup grob splitStaffBarLineMarkup)
0))
\break
}
convDownStaffBarLine = {
\once \override Staff.BarLine.stencil =
#(lambda (grob)
(ly:stencil-combine-at-edge
(ly:bar-line::print grob)
X RIGHT
(grob-interpret-markup grob #{
\markup\with-dimensions #'(0 . 0) #'(0 . 0) {
\translate #'(0 . -.13)\arrow-at-angle #-45 #(sqrt 8) ##t
}#})
0))
\break
}
convUpStaffBarLine = {
\once \override Staff.BarLine.stencil =
#(lambda (grob)
(ly:stencil-combine-at-edge
(ly:bar-line::print grob)
X RIGHT
(grob-interpret-markup grob #{
\markup\with-dimensions #'(0 . 0) #'(0 . 0) {
\translate #'(0 . .14)\arrow-at-angle #45 #(sqrt 8) ##t
}#})
0))
\break
}

View File

@ -0,0 +1,27 @@
% 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)))))

16
styles.ly Normal file
View File

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

304
toc_include.ly Normal file
View File

@ -0,0 +1,304 @@
% embed all category images in postscript once
#(define-markup-list-command (embed-category-images layout props)()
(map (lambda (category)
(interpret-markup layout props
(markup #:epsfileembed (category-image-path (symbol->string (car category))))))
category-names))
% print a markup-list in columns
#(define-markup-list-command (columnlayout layout props cols margin heightpair lines) (integer? number? pair? markup-list?)
(let create-col-page ((line-width (- (/ (chain-assoc-get 'line-width props
(ly:output-def-lookup layout 'line-width))
cols) margin ))
(cols cols)
(height (car heightpair))
(restlines lines))
(cons
(interpret-markup layout props
(make-fill-line-markup
(map (lambda (foo)
(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* ((finished (null? 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)))))
(calc-height (- height-left (if finished 0 (interval-length (ly:stencil-extent linestencil Y))))))
(set! restlines lines)
(if (or (< calc-height 0) (null? lines))
(list)
(cons (markup #:stencil linestencil) (add-to-col (cdr lines) calc-height)))))))))
(make-list cols))))
(if (null? restlines)
(list)
(create-col-page line-width cols (cdr heightpair) restlines)))))
%%%%%%%%%%%%%%%%%%%%%%%
%%%Funktionen für Inhaltsverzeichnis
% geklaut von da:
% http://lsr.dsi.unimi.it/LSR/Snippet?id=763
% Usage:
% - define and index item with \indexItem $sortstring $markup
% - use \indexSection $sortstring $markup to divide the index into several sections
% - display the alphabetical index with \markuplines \index
% code ist mostly taken from ./ly/toc-init.ly and just renamed and slightly modfied
%% defined later, in a closure
#(define*-public (add-index-item! markup-symbol text sorttext #:optional label) #f)
#(define-public (index-items) #f)
#(let ((index-item-list (list)))
(set! add-index-item!
(lambda* (markup-symbol text sorttext #:optional (label (gensym "index")))
(set! index-item-list
;; We insert index items sorted from the beginning on and do
;; not sort them later - this saves pretty much computing time
(insert-alphabetical-sorted! (list label markup-symbol text
;; this crazy hack is necessary because lilypond depends on guile 1.8 atm
;; and so the cool unicode conversion functions cannot be used
(ly:string-substitute " " ""
(ly:string-substitute "…" ""
(ly:string-substitute "Č" "C"
(ly:string-substitute "Đ" "D"
(ly:string-substitute "Т" "T"
(ly:string-substitute "Ä" "Ae"
(ly:string-substitute "ä" "ae"
(ly:string-substitute "Ö" "O"
(ly:string-substitute "ö" "oe"
(ly:string-substitute "Ü" "U"
(ly:string-substitute "ü" "ue" sorttext))))))))))))
index-item-list))
(make-music 'EventChord
'page-marker #t
'page-label label
'elements (list (make-music 'LabelEvent
'page-label label)))))
(set! index-items (lambda ()
index-item-list)))
#(define (insert-alphabetical-sorted! iitem ilist)
(if (null? ilist)
(list iitem)
(if (string-ci<? (cadddr iitem) (cadddr (car ilist)))
(cons iitem ilist)
(cons (car ilist) (insert-alphabetical-sorted! iitem (cdr ilist))))))
% code for category index
#(define*-public (add-category-index-item! categories markup-symbol text #:optional label) #f)
#(define-public (category-index-items) #f)
#(let ((category-index-hash (make-hash-table)))
(set! add-category-index-item!
(lambda* (categories markup-symbol text #:optional (label (gensym "index")))
(for-each (lambda (category)
(let* ((catsym (string->symbol category))
(catlist (hashq-ref category-index-hash catsym
(list (list label 'indexCategoryMarkup category)))))
(if (assq catsym category-names)
(hashq-set! category-index-hash catsym
(cons (list label markup-symbol text) catlist))
(ly:error "song: <~a> category ~a is not defined!" (markup->string text) category))))
categories)
(make-music 'EventChord
'page-marker #t
'page-label label
'elements (list (make-music 'LabelEvent
'page-label label)))))
(set! category-index-items (lambda ()
(append-map (lambda (kv) (reverse (hashq-ref category-index-hash (car kv) (list)))) category-names))))
#(define-markup-command (with-link-symbol-ref layout props symbol arg)
(symbol? markup?)
"call with-link with the label referenced by symbol"
(let ((label (chain-assoc-get symbol props)))
(interpret-markup layout props
(markup #:with-link label arg))))
#(define-markup-command (category-image-symbol-ref layout props size symbol)
(number? symbol?)
"call category-image with the category referenced by symbol"
(let ((category (chain-assoc-get symbol props)))
(interpret-markup layout props
(markup #:category-image size category))))
#(define-markup-command (category-name-symbol-ref layout props symbol)
(symbol?)
"get the name of a category referenced by symbol"
(let* ((category (chain-assoc-get symbol props))
(catname (assq (string->symbol category) category-names)))
(interpret-markup layout props
(markup #:override (cons 'baseline-skip 3.5) (if catname (make-left-column-markup (string-split (cadr catname) #\newline)) category)))))
#(define-markup-command (index-item-with-pattern layout props)()
(let (
(text (chain-assoc-get 'index:text props))
(page (chain-assoc-get 'index:page props))
(width (-
(chain-assoc-get 'line-width props)
(interval-length (ly:stencil-extent (interpret-markup layout props "XXXX") X))))
)
(interpret-markup layout props
(make-column-markup
(let ((revlist
(if (markup? text)
(list text)
(reverse (map (lambda (stil) (markup #:stencil stil))
(wordwrap-string-internal-markup-list layout
(cons (if (chain-assoc-get 'alternative text)
(list (cons 'line-width width) (cons 'font-shape 'italic))
(list (cons 'line-width width))) props) #f
(chain-assoc-get 'rawtext text))))))
(target-size-markup
(make-column-markup
(list
(make-simple-markup "Agj")
(make-vspace-markup 0.2))))
)
(reverse (map (lambda (m)
(make-size-box-to-box-markup #f #t m target-size-markup))
(cons
(make-fill-with-pattern-markup 1 RIGHT "." (car revlist) page)
(cdr revlist)))))))))
\paper {
indexTitleMarkup = \markup \column {
\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
}
indexSectionMarkup = \markup \override #'(baseline-skip . 1.5) \column {
\fill-line { \sans \bold \fontsize #3 \fromproperty #'index:text \null }
\null
}
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 }
\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)
(map (lambda (index-item)
(let ((label (car index-item))
(index-markup (cadr index-item))
(text (caddr index-item)))
(markup #:override (cons 'index:label label)
#:override (cons 'index:page (markup #:custom-page-number label -1))
#:override (cons 'index:text text)
(ly:output-def-lookup layout index-markup))))
(items)))
#(define-markup-list-command (colindex 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}" )
(let ((title (interpret-markup layout (cons (list (cons 'index:text "Inhaltsverzeichnis")) props)
(ly:output-def-lookup layout 'indexTitleMarkup))))
(cons title
(interpret-markup-list layout props
(make-columnlayout-markup-list 3 2
(let ((h (- (ly:output-def-lookup layout 'paper-height) 12)))
(cons (- h (interval-length (ly:stencil-extent title Y))) h))
(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 3 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 =
#(define-music-function (parser location sorttext text) (string? markup?)
"Add a line to the alphabetical index, using the @code{indexItemMarkup} paper variable markup."
(add-index-item! 'indexItemMarkup text sorttext))
indexSection =
#(define-music-function (parser location sorttext text) (string? markup?)
"Add a section line to the alphabetical index, using @code{indexSectionMarkup} paper variable markup. This can be used to divide the alphabetical index into different sections, for example one section for each first letter."
(add-index-item! 'indexSectionMarkup text sorttext))
%{
addTitleToTOC = #(define-music-function (parser location title) (string?)
#{
\indexItem #title \markup { #title }
#})
addAltTitleToTOC = #(define-music-function (parser location title) (string?)
#{
\indexItem #title \markup { \italic #title }
#})
%}
#(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?)
(let*
(
(headervars (hash-map->list cons (struct-ref (ly:book-header header) 0)))
(extract-var-and-check (lambda (headervar) (let
((extracted (extract-var-from-module headervars headervar)))
(if (and extracted (not (string-null? extracted))) extracted #f)
)))
(title (extract-var-and-check 'title))
(alttitle (extract-var-and-check 'alttitle))
(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-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 alttitle (add-to-toc! alttitle (cons (list (cons 'rawtext alttitle) (cons 'alternative #t)) '())))
(if altalttitle (add-to-toc! altalttitle (cons (list (cons 'rawtext altalttitle) (cons 'alternative #t)) '())))
(if title (add-to-toc! title (cons (list (cons 'rawtext title)) '())) #{ #})
))