Compare commits
2
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
5ee095b4e9 | ||
|
|
036ddd2ef7 |
+1
-1
@@ -1,8 +1,8 @@
|
|||||||
# ---> Lilypond
|
# ---> Lilypond
|
||||||
*.pdf
|
*.pdf
|
||||||
*.cho
|
|
||||||
*.ps
|
*.ps
|
||||||
*.midi
|
*.midi
|
||||||
*.mid
|
*.mid
|
||||||
*.log
|
*.log
|
||||||
*~
|
*~
|
||||||
|
|
||||||
|
|||||||
@@ -1,3 +1,3 @@
|
|||||||
# lilypond-common-includes
|
# lilypond-common-includes
|
||||||
|
|
||||||
Lilypondskripte zur Erstellung eines Liederbuches
|
Lilypondskripte zur Erstellung eines Liederbuches
|
||||||
+369
@@ -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)
|
||||||
|
))
|
||||||
@@ -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
|
||||||
|
}
|
||||||
@@ -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)))))
|
||||||
@@ -1,64 +0,0 @@
|
|||||||
#(define include_dir_not_added? (if (defined? 'include_dir_not_added?) include_dir_not_added? #t))
|
|
||||||
#(if include_dir_not_added?
|
|
||||||
(let* ((common-include-dir (dirname (dirname (dirname (current-filename))))))
|
|
||||||
(ly:parser-append-to-include-path common-include-dir)
|
|
||||||
(set! include_dir_not_added? #f)))
|
|
||||||
|
|
||||||
#(define noStandaloneOutput (if (defined? 'noStandaloneOutput) noStandaloneOutput #f))
|
|
||||||
|
|
||||||
#(define windows? (string-prefix-ci? "windows" (utsname:sysname (uname))))
|
|
||||||
|
|
||||||
#(if (defined? 'LAYOUT) #f
|
|
||||||
(let ((scm-load (lambda (filename) (load (
|
|
||||||
string-append
|
|
||||||
; on windows the detection of absolute pathes is broken (cause they start with a drive letter and not with a /)
|
|
||||||
; so we have to use relative pathes for load. That works in frescobaldi, but not if you call lilypond from command line,
|
|
||||||
; with a relative path to the .ly file, so we use absolute pathes on posix systems, where it works.
|
|
||||||
(if windows?
|
|
||||||
""
|
|
||||||
(string-append (dirname (current-filename)) file-name-separator-string))
|
|
||||||
"scm" file-name-separator-string filename
|
|
||||||
)))))
|
|
||||||
(scm-load "resolve_inherits.scm")
|
|
||||||
(scm-load "yaml_parser.scm")
|
|
||||||
(scm-load "yaml_writer.scm")))
|
|
||||||
|
|
||||||
#(define (song-includes-data-path filename)
|
|
||||||
(string-join
|
|
||||||
(list
|
|
||||||
(dirname (dirname (dirname (dirname (current-filename)))))
|
|
||||||
"lilypond-song-includes"
|
|
||||||
"data"
|
|
||||||
filename)
|
|
||||||
file-name-separator-string))
|
|
||||||
#(define AUTHOR_DATA (if (defined? 'AUTHOR_DATA) AUTHOR_DATA (parse-yml-file (song-includes-data-path "authors.yml"))))
|
|
||||||
#(define SONG_DATA (if (defined? 'SONG_DATA) SONG_DATA (parse-yml-file (song-includes-data-path "songs.yml"))))
|
|
||||||
|
|
||||||
\include "merge_rests_engraver_override.ily"
|
|
||||||
\include "basic_format_and_style_settings.ily"
|
|
||||||
\include "eps_file_from_song_dir.ily"
|
|
||||||
\include "title_with_category_images.ily"
|
|
||||||
\include "chord_settings.ily"
|
|
||||||
\include "chordpro.ily"
|
|
||||||
\include "data_extractor.ily"
|
|
||||||
\include "transposition.ily"
|
|
||||||
\include "markup_tag_groups_hack.ily"
|
|
||||||
\include "verses_with_chords.ily"
|
|
||||||
\include "arrows_in_scores.ily"
|
|
||||||
\include "swing_style.ily"
|
|
||||||
\include "inline_score.ily"
|
|
||||||
\include "custom_indentation.ily"
|
|
||||||
\include "include_from_song.ily"
|
|
||||||
|
|
||||||
% reset important variables
|
|
||||||
LAYOUT = \layout { \generalLayout }
|
|
||||||
HEADER = {}
|
|
||||||
MUSIC = {}
|
|
||||||
TEXT = \markuplist {}
|
|
||||||
TEXT_PAGES = #f
|
|
||||||
|
|
||||||
verseChords = {}
|
|
||||||
firstVoice = {}
|
|
||||||
global = {}
|
|
||||||
|
|
||||||
\resetTagGroups
|
|
||||||
@@ -1,63 +0,0 @@
|
|||||||
%%%%%%%%%%%%%%%%% 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
|
|
||||||
}
|
|
||||||
@@ -1,334 +0,0 @@
|
|||||||
\language "deutsch"
|
|
||||||
|
|
||||||
\include "default_style.ily"
|
|
||||||
\include "default_songinfo_style.ily"
|
|
||||||
\include "footer_with_songinfo.ily"
|
|
||||||
|
|
||||||
\include #(if (defined? 'customStyleOverridesFile) customStyleOverridesFile "../void.ily")
|
|
||||||
|
|
||||||
#(set-default-paper-size songFormatAndSize)
|
|
||||||
#(set-global-staff-size globalSize)
|
|
||||||
|
|
||||||
\paper {
|
|
||||||
property-defaults.fonts.serif = \songChordFont
|
|
||||||
property-defaults.fonts.sans = \songLyricFont
|
|
||||||
%annotate-spacing = ##t
|
|
||||||
% spacing stuff
|
|
||||||
two-sided = ##t
|
|
||||||
inner-margin = 1.5\cm
|
|
||||||
outer-margin = \songMargin
|
|
||||||
binding-offset = 0\cm
|
|
||||||
top-margin = \songMargin
|
|
||||||
bottom-margin = \songMargin
|
|
||||||
system-system-spacing = #'((basic-distance . 10) (padding . 1.5))
|
|
||||||
markup-system-spacing = #'((basic-distance . 1))
|
|
||||||
score-markup-spacing = #'((padding . 2))
|
|
||||||
top-markup-spacing = #'((basic-distance . 0) (minimum-distance . 0) (padding . 0))
|
|
||||||
refMarkupFormatter = #(lambda (layout props stanzanumbers)
|
|
||||||
(interpret-markup layout props
|
|
||||||
(if (null? stanzanumbers)
|
|
||||||
refString
|
|
||||||
(ly:format refStringWithNumbers (string-join (map (lambda (stanzanumber) (ly:format "~a" stanzanumber)) stanzanumbers) ", ")))))
|
|
||||||
bridgeMarkupFormatter = #(lambda (layout props stanzanumbers)
|
|
||||||
(interpret-markup layout props
|
|
||||||
(if (null? stanzanumbers)
|
|
||||||
bridgeString
|
|
||||||
(ly:format bridgeStringWithNumbers (string-join (map (lambda (stanzanumber) (ly:format "~a" stanzanumber)) stanzanumbers) ", ")))))
|
|
||||||
}
|
|
||||||
|
|
||||||
generalLayout = \layout {
|
|
||||||
indent = #0
|
|
||||||
\context {
|
|
||||||
\Lyrics
|
|
||||||
\override LyricText.font-size = #lyricSize
|
|
||||||
\override StanzaNumber.font-size = #lyricSize
|
|
||||||
\override StanzaNumber.font-family = #'sans
|
|
||||||
\override LyricText.font-family = #'sans
|
|
||||||
\override LyricExtender.minimum-length = 0
|
|
||||||
}
|
|
||||||
\context {
|
|
||||||
\Staff
|
|
||||||
\accidentalStyle modern-voice-cautionary
|
|
||||||
\consists \Better_Merge_rests_engraver
|
|
||||||
}
|
|
||||||
\context {
|
|
||||||
\Score
|
|
||||||
\remove "Bar_number_engraver"
|
|
||||||
\remove "Metronome_mark_engraver"
|
|
||||||
\RemoveEmptyStaves
|
|
||||||
\override VerticalAxisGroup.remove-first = ##t
|
|
||||||
\numericTimeSignature
|
|
||||||
\overrideTimeSignatureSettings
|
|
||||||
4/4 % timeSignatureFraction
|
|
||||||
1/4 % baseMomentFraction
|
|
||||||
#'(1 1 1 1) % beatStructure
|
|
||||||
#'() % beamExceptions
|
|
||||||
\overrideTimeSignatureSettings
|
|
||||||
3/4 % timeSignatureFraction
|
|
||||||
1/4 % baseMomentFraction
|
|
||||||
#'(1 1 1 1) % beatStructure
|
|
||||||
#'() % beamExceptions
|
|
||||||
}
|
|
||||||
\context {
|
|
||||||
\Voice
|
|
||||||
% ich will lines breaken wie ich will!
|
|
||||||
\remove "Forbid_line_break_engraver"
|
|
||||||
\override NoteHead.layer = 2
|
|
||||||
\override Rest.layer = 2
|
|
||||||
\override Dots.layer = 2
|
|
||||||
\override Stem.layer = 2
|
|
||||||
\override Flag.layer = 2
|
|
||||||
\override Beam.layer = 2
|
|
||||||
\override Slur.layer = 2
|
|
||||||
\override Tie.layer = 2
|
|
||||||
\override Accidental.layer = 2
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
#(define (customized-layout base-layout)
|
|
||||||
(let
|
|
||||||
((custom-size (ly:output-def-lookup base-layout 'size #f)))
|
|
||||||
(if custom-size (layout-set-staff-size custom-size))))
|
|
||||||
|
|
||||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
||||||
%%% kleine Helferlein:
|
|
||||||
|
|
||||||
textp = \lyricmode { \markup { \raise #1 \musicglyph #"rests.3" } }
|
|
||||||
|
|
||||||
% zweite Stimme alles grau
|
|
||||||
secondVoiceStyle = {
|
|
||||||
\override NoteHead.color = #grey
|
|
||||||
\override Rest.color = #grey
|
|
||||||
\override Dots.color = #grey
|
|
||||||
\override Stem.color = #grey
|
|
||||||
\override Flag.color = #grey
|
|
||||||
\override Beam.color = #grey
|
|
||||||
\override Slur.color = #grey
|
|
||||||
\override Tie.color = #grey
|
|
||||||
\override Accidental.color = #grey
|
|
||||||
\override NoteHead.layer = 1
|
|
||||||
\override Rest.layer = 1
|
|
||||||
\override Dots.layer = 1
|
|
||||||
\override Stem.layer = 1
|
|
||||||
\override Flag.layer = 1
|
|
||||||
\override Beam.layer = 1
|
|
||||||
\override Slur.layer = 1
|
|
||||||
\override Tie.layer = 1
|
|
||||||
\override Accidental.layer = 1
|
|
||||||
}
|
|
||||||
|
|
||||||
firstVoiceStyle = {
|
|
||||||
\override NoteHead.color = #black
|
|
||||||
\override Rest.color = #black
|
|
||||||
\override Dots.color = #black
|
|
||||||
\override Stem.color = #black
|
|
||||||
\override Flag.color = #black
|
|
||||||
\override Beam.color = #black
|
|
||||||
\override Slur.color = #black
|
|
||||||
\override Tie.color = #black
|
|
||||||
\override Accidental.color = #black
|
|
||||||
}
|
|
||||||
|
|
||||||
% Deprecated: einzelne Noten innerhalb von \secondVoiceStyle mit schwarzem statt grauem Kopf
|
|
||||||
schwarzkopf =
|
|
||||||
#(define-music-function (parser location noten) (ly:music?)
|
|
||||||
(begin (ly:warning "\\schwarzkopf brauchts nicht mehr, das kann ersatzlos weg!") noten))
|
|
||||||
|
|
||||||
romanStanza =
|
|
||||||
#(define-music-function (parser location) ()
|
|
||||||
#{ \override StanzaNumber.style = #'roman #})
|
|
||||||
|
|
||||||
override-stanza =
|
|
||||||
#(define-music-function (parser location stanzanumbers) (number-list?)
|
|
||||||
#{
|
|
||||||
\once \override StanzaNumber.details.custom-stanzanumber-override = #stanzanumbers
|
|
||||||
#}
|
|
||||||
)
|
|
||||||
|
|
||||||
#(define (handle-stanza-numbers context numbers number-formater)
|
|
||||||
(let* ((stanzanumbers (ly:assoc-get 'custom-stanzanumber-override (ly:assoc-get 'details (ly:context-grob-definition context 'StanzaNumber) '()) numbers))
|
|
||||||
(stanza-style (ly:assoc-get 'style (ly:context-grob-definition context 'StanzaNumber)))
|
|
||||||
(roman-format (lambda (stanzanumber) (format #f "~@r" stanzanumber))))
|
|
||||||
(ly:context-set-property! context 'stanza
|
|
||||||
(make-pad-left-markup 1
|
|
||||||
(number-formater
|
|
||||||
(if (eq? stanza-style 'roman)
|
|
||||||
(map roman-format stanzanumbers)
|
|
||||||
stanzanumbers))))))
|
|
||||||
|
|
||||||
#(define (stanza . stanzanumbers)
|
|
||||||
#{
|
|
||||||
\once \override StanzaNumber.details.custom-realstanza = ##t % set this to signal that there is a real stanza and no repeat signs
|
|
||||||
\once \override StanzaNumber.details.custom-stanza-type = #'verse
|
|
||||||
\once \override StanzaNumber.details.custom-stanza-numbers = #stanzanumbers
|
|
||||||
\applyContext
|
|
||||||
#(lambda (context)
|
|
||||||
(handle-stanza-numbers context stanzanumbers
|
|
||||||
(lambda (numbers) (string-join (map (lambda (n) (format #f stanzaFormat n)) numbers) ", "))))
|
|
||||||
#}
|
|
||||||
)
|
|
||||||
|
|
||||||
ref =
|
|
||||||
#(define-music-function (stanzanumbers lyrics) ((number-list? (list)) ly:music?)
|
|
||||||
#{ \lyricmode {
|
|
||||||
\once \override StanzaNumber.details.custom-realstanza = ##t % set this to signal that there is a real stanza and no repeat signs
|
|
||||||
\once \override StanzaNumber.details.custom-stanza-type = #'ref
|
|
||||||
\once \override StanzaNumber.details.custom-stanza-numbers = #stanzanumbers
|
|
||||||
\applyContext
|
|
||||||
#(lambda (context)
|
|
||||||
(handle-stanza-numbers context stanzanumbers
|
|
||||||
(lambda (numbers)
|
|
||||||
(make-on-the-fly-markup
|
|
||||||
(lambda (layout props m)
|
|
||||||
((ly:output-def-lookup layout 'refMarkupFormatter) layout props numbers))
|
|
||||||
(make-null-markup)))))
|
|
||||||
#lyrics
|
|
||||||
}
|
|
||||||
#}
|
|
||||||
)
|
|
||||||
|
|
||||||
bridge =
|
|
||||||
#(define-music-function (stanzanumbers lyrics) ((number-list? (list)) ly:music?)
|
|
||||||
#{ \lyricmode {
|
|
||||||
\once \override StanzaNumber.details.custom-realstanza = ##t % set this to signal that there is a real stanza and no repeat signs
|
|
||||||
\once \override StanzaNumber.details.custom-stanza-type = #'bridge
|
|
||||||
\once \override StanzaNumber.details.custom-stanza-numbers = #stanzanumbers
|
|
||||||
\applyContext
|
|
||||||
#(lambda (context)
|
|
||||||
(handle-stanza-numbers context stanzanumbers
|
|
||||||
(lambda (numbers)
|
|
||||||
(make-on-the-fly-markup
|
|
||||||
(lambda (layout props m)
|
|
||||||
((ly:output-def-lookup layout 'bridgeMarkupFormatter) layout props numbers))
|
|
||||||
(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.details.custom-realstanza = ##t we set that also as stanza.
|
|
||||||
% Sets custom-inline-text for ChordPro export so it can collect the repeat sign separately
|
|
||||||
repStartWithTag = \lyricmode {
|
|
||||||
\tag #'repeats {
|
|
||||||
\once \override StanzaNumber.details.custom-inline-text = \repStart
|
|
||||||
\once \override StanzaNumber.details.custom-inline-direction = #LEFT
|
|
||||||
\applyContext
|
|
||||||
#(lambda (context)
|
|
||||||
(let ((lastStanza (ly:context-property context 'stanza))
|
|
||||||
(printLastStanza (ly:assoc-get 'custom-realstanza (ly:assoc-get 'details (ly:context-grob-definition context 'StanzaNumber) '()) #f))
|
|
||||||
(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.details.custom-inline-text = \repStop
|
|
||||||
\once \override StanzaNumber.details.custom-inline-direction = #RIGHT
|
|
||||||
\once \override StanzaNumber.font-series = #'normal
|
|
||||||
\once \override StanzaNumber.direction = 1
|
|
||||||
\set stanza = \markup { \pad-x-right #1 \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?)
|
|
||||||
(let ((first-char (string-take word 1))
|
|
||||||
(rest (substring word 1 (string-length word))))
|
|
||||||
#{
|
|
||||||
\lyricmode {
|
|
||||||
\markup {
|
|
||||||
\tag #'up #(string-append (string-capitalize first-char) rest)
|
|
||||||
\tag #'down #(string-append (string-downcase first-char) rest)
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#}))
|
|
||||||
|
|
||||||
dottedExtender = {
|
|
||||||
\override LyricExtender.style = #'dotted-line
|
|
||||||
\override LyricExtender.thickness = 2
|
|
||||||
\override LyricExtender.Y-offset = 0.1
|
|
||||||
\override LyricExtender.stencil =
|
|
||||||
#(lambda (grob)
|
|
||||||
(let* ((stil (ly:lyric-extender::print grob))
|
|
||||||
(nostil (null? stil))
|
|
||||||
(x-ext (if nostil 0 (ly:stencil-extent stil X))))
|
|
||||||
(if nostil
|
|
||||||
stil
|
|
||||||
(make-connected-line
|
|
||||||
(list
|
|
||||||
(cons (car x-ext) 0)
|
|
||||||
(cons (cdr x-ext) 0))
|
|
||||||
grob))))
|
|
||||||
}
|
|
||||||
|
|
||||||
melisOff = \set ignoreMelismata = ##t
|
|
||||||
melisOn = \unset ignoreMelismata
|
|
||||||
|
|
||||||
cue =
|
|
||||||
#(define-music-function (zahlen) (number-list?)
|
|
||||||
#{
|
|
||||||
\tag #'cues {
|
|
||||||
\tweak self-alignment-X #LEFT
|
|
||||||
\mark
|
|
||||||
#(make-on-the-fly-markup
|
|
||||||
(lambda (layout props m) (interpret-markup layout (prepend-alist-chain 'cues zahlen props) (ly:output-def-lookup layout 'cueMarkup)))
|
|
||||||
(make-null-markup))
|
|
||||||
}
|
|
||||||
#})
|
|
||||||
|
|
||||||
#(define-markup-command (ruf-style layout props text) (string?)
|
|
||||||
(interpret-markup layout props
|
|
||||||
(markup #:italic (string-append "(" text ")"))))
|
|
||||||
rufWithMarkup =
|
|
||||||
#(define-music-function (text) (markup?)
|
|
||||||
#{
|
|
||||||
\lyricmode {
|
|
||||||
\once \override StanzaNumber.font-series = #'normal
|
|
||||||
\once \override StanzaNumber.direction = 1
|
|
||||||
\set stanza = #text
|
|
||||||
}
|
|
||||||
#})
|
|
||||||
ruf =
|
|
||||||
#(define-music-function (text) (string?)
|
|
||||||
(rufWithMarkup (make-ruf-style-markup text)))
|
|
||||||
|
|
||||||
underlineOn =
|
|
||||||
#(define-music-function () ()
|
|
||||||
#{
|
|
||||||
\override LyricText.stencil =
|
|
||||||
#(lambda (grob)
|
|
||||||
(grob-interpret-markup grob (make-underline-markup (ly:grob-property grob 'text))))
|
|
||||||
#})
|
|
||||||
|
|
||||||
underlineOff =
|
|
||||||
#(define-music-function () ()
|
|
||||||
#{
|
|
||||||
\revert LyricText.stencil
|
|
||||||
#})
|
|
||||||
@@ -1,169 +0,0 @@
|
|||||||
% 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
|
|
||||||
#})
|
|
||||||
|
|
||||||
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 =
|
|
||||||
#(define-music-function (parser location chords) (ly:music?)
|
|
||||||
#{
|
|
||||||
\override ChordName.font-series = #'bold
|
|
||||||
$chords
|
|
||||||
\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* ((chord-name (lambda (in-pitches bass inversion context)
|
|
||||||
(make-line-markup (list
|
|
||||||
(ignatzek-chord-names in-pitches bass inversion context)
|
|
||||||
(make-hspace-markup 0.3)
|
|
||||||
(parenthesis-ignatzek-chord-names (music-pitches (transposable (cons (car (music-pitches mainchord)) (car in-pitches)) (music-clone altchord))) '() '() context)
|
|
||||||
))
|
|
||||||
)))
|
|
||||||
#{
|
|
||||||
\once \set chordNameFunction = #chord-name
|
|
||||||
#mainchord
|
|
||||||
#}))
|
|
||||||
|
|
||||||
|
|
||||||
% Akkorde werden so transponiert, dass sie passen, wenn man mit Kapo im angegebenen Bund spielt
|
|
||||||
capoTranspose =
|
|
||||||
#(define-music-function (fret chords) (number? ly:music?)
|
|
||||||
(define semi->pitch
|
|
||||||
(make-semitone->pitch
|
|
||||||
(music-pitches
|
|
||||||
#{ h b a gis g fis f e es d cis c #})))
|
|
||||||
(transpose
|
|
||||||
(ly:pitch-transpose (semi->pitch fret) (ly:make-pitch 0 0))
|
|
||||||
(ly:make-pitch 0 0)
|
|
||||||
chords))
|
|
||||||
|
|
||||||
% additional bass notes should get uppercased
|
|
||||||
#(define (bassnote-name->german-markup-nosym pitch lowercase?)((chord-name:name-markup 'deutsch) 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
|
|
||||||
(append
|
|
||||||
(if (defined? 'customChordPrintings)
|
|
||||||
(sequential-music-to-chord-exceptions customChordPrintings #t)
|
|
||||||
'())
|
|
||||||
(sequential-music-to-chord-exceptions defaultChordPrintings #t)))
|
|
||||||
|
|
||||||
generalLayout = \layout {
|
|
||||||
\generalLayout
|
|
||||||
\context {
|
|
||||||
\ChordNames
|
|
||||||
\override ChordName.font-size = \songScoreChordFontSize
|
|
||||||
\override ChordName.font-series = \songChordFontSeries
|
|
||||||
\override ChordName.font-family = #'serif
|
|
||||||
chordNameLowercaseMinor = ##t
|
|
||||||
chordChanges = ##t
|
|
||||||
chordRootNamer = #(chord-name:name-markup 'deutsch)
|
|
||||||
chordNoteNamer = #bassnote-name->german-markup-nosym
|
|
||||||
additionalPitchPrefix = ""
|
|
||||||
|
|
||||||
majorSevenSymbol = "maj7"
|
|
||||||
chordNameExceptions = \chordNameExceptions
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
% 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 {
|
|
||||||
#(ly:parser-include-string (string-append "\\chordmode { s4 " chord " }"))
|
|
||||||
} \layout { \generalLayout } }
|
|
||||||
\override #'(fret-diagram-details . ((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)
|
|
||||||
)))))
|
|
||||||
File diff suppressed because it is too large
Load Diff
@@ -1,135 +0,0 @@
|
|||||||
% 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 ?
|
|
||||||
@@ -1,550 +0,0 @@
|
|||||||
%%% Extrahiert Informationen aus einem ly:music-Objekt und liefert eine alist
|
|
||||||
%%% mit String-Werten zurueck (z.B. ((time . "4/4") (key . "d minor"))).
|
|
||||||
%%% Benoetigt LilyPond >= 2.26.
|
|
||||||
|
|
||||||
%% note-name->lily-string liegt im Modul (lily display-lily).
|
|
||||||
#(use-modules (lily display-lily))
|
|
||||||
|
|
||||||
#(begin
|
|
||||||
|
|
||||||
;; --- Taktangabe --------------------------------------------------------
|
|
||||||
|
|
||||||
;; Numerator einer Taktangabe kann eine Zahl oder eine Liste sein.
|
|
||||||
(define (numerator->string num)
|
|
||||||
(if (list? num)
|
|
||||||
(string-join (map number->string num) "+")
|
|
||||||
(number->string num)))
|
|
||||||
|
|
||||||
;; Ein einzelner Bruch ist ein Paar (numerator . denominator), der
|
|
||||||
;; Numerator eine Zahl oder eine Liste (z.B. 3+3/8).
|
|
||||||
(define (fraction->string frac)
|
|
||||||
(string-append (numerator->string (car frac)) "/"
|
|
||||||
(number->string (cdr frac))))
|
|
||||||
|
|
||||||
;; Liefert die Taktangabe als String (z.B. "4/4", "3+3/8" oder
|
|
||||||
;; "3+3/8 + 2/8") oder #f. time-signature ist ein Bruch oder bei
|
|
||||||
;; zusammengesetzten Taktarten (\timeAbbrev, \compoundMeter) eine
|
|
||||||
;; Liste von Bruechen.
|
|
||||||
(define (time-music->string m)
|
|
||||||
(let ((ts (ly:music-property m 'time-signature)))
|
|
||||||
(and (pair? ts)
|
|
||||||
(if (number? (cdr ts))
|
|
||||||
(fraction->string ts)
|
|
||||||
(string-join (map fraction->string ts) " + ")))))
|
|
||||||
|
|
||||||
;; --- Tempo ---------------------------------------------------------------
|
|
||||||
|
|
||||||
;; Liefert die Tempoangabe als String (z.B. "4 = 130", "4. = 60-70",
|
|
||||||
;; "Allegro" oder "Allegro (4 = 130)") oder #f.
|
|
||||||
(define (tempo-music->string m)
|
|
||||||
(let* ((unit (ly:music-property m 'tempo-unit))
|
|
||||||
(count (ly:music-property m 'metronome-count))
|
|
||||||
(text (ly:music-property m 'text))
|
|
||||||
(unit-s (and (ly:duration? unit)
|
|
||||||
(string-append
|
|
||||||
(number->string (expt 2 (ly:duration-log unit)))
|
|
||||||
(make-string (ly:duration-dot-count unit) #\.))))
|
|
||||||
(count-s (cond ((number? count) (number->string count))
|
|
||||||
((pair? count) (ly:format "~a-~a" (car count) (cdr count)))
|
|
||||||
(else #f)))
|
|
||||||
(metronome-s (and unit-s count-s (string-append unit-s " = " count-s)))
|
|
||||||
(text-s (and (markup? text) (markup->string text))))
|
|
||||||
(cond
|
|
||||||
((and text-s metronome-s) (string-append text-s " (" metronome-s ")"))
|
|
||||||
(metronome-s metronome-s)
|
|
||||||
(text-s text-s)
|
|
||||||
(else #f))))
|
|
||||||
|
|
||||||
;; --- Tonart ------------------------------------------------------------
|
|
||||||
|
|
||||||
;; Liefert die Tonart als String (z.B. "d minor" oder "c major") oder #f.
|
|
||||||
;; Vorgehen wie in LilyPonds eigenem \displayMusic (define-music-display-
|
|
||||||
;; methods.scm): pitch-alist nach c zuruecktransponieren und mit den
|
|
||||||
;; bekannten Modus-Definitionen vergleichen. note-name->lily-string liefert
|
|
||||||
;; den Grundton in der aktuell eingestellten Notensprache.
|
|
||||||
(define (key-music->string m)
|
|
||||||
(let ((tonic (ly:music-property m 'tonic))
|
|
||||||
(alist (ly:music-property m 'pitch-alist)))
|
|
||||||
(and (ly:pitch? tonic) (pair? alist)
|
|
||||||
(let* ((c-alist (ly:transpose-key-alist alist (- tonic)))
|
|
||||||
(mode (any (lambda (mode)
|
|
||||||
(and (equal? (ly:parser-lookup mode) c-alist)
|
|
||||||
(symbol->string mode)))
|
|
||||||
'(major minor))))
|
|
||||||
(and mode
|
|
||||||
(string-append (symbol->string (note-name->lily-string tonic))
|
|
||||||
" " mode))))))
|
|
||||||
|
|
||||||
;; --- Header-Metadaten ----------------------------------------------------
|
|
||||||
|
|
||||||
;; Header-Felder, die eigentlich Layoutsachen sind (gehoerten nach paper)
|
|
||||||
;; und deshalb nicht mit exportiert werden.
|
|
||||||
(define ignored-header-fields
|
|
||||||
'(titlesize titletopspace tagline between-poet-and-composer-markup))
|
|
||||||
|
|
||||||
;; categories ist im Header ein String mit Leerzeichen ("trist satz")
|
|
||||||
;; und wird als Liste von Woertern exportiert.
|
|
||||||
(define (header-value key value)
|
|
||||||
(if (and (eq? key 'categories) (string? value))
|
|
||||||
(string-tokenize value)
|
|
||||||
value))
|
|
||||||
|
|
||||||
;; Nimmt einen Bookpart entgegen (wie HEADER aus pool_bottom.ily) und
|
|
||||||
;; liefert dessen Header-Felder als alist, z.B.
|
|
||||||
;; ((title . "Ako umram") (authors . (("..." text melody))) ...).
|
|
||||||
;; Die Werte bleiben unveraendert, wie sie im \header definiert wurden
|
|
||||||
;; (Strings, Listen, Markups ...).
|
|
||||||
(define (bookpart->header-alist bookpart)
|
|
||||||
(let ((header (ly:book-header bookpart)))
|
|
||||||
(if (module? header)
|
|
||||||
(sort
|
|
||||||
(filter-map (lambda (entry)
|
|
||||||
(and (variable-bound? (cdr entry))
|
|
||||||
(not (memq (car entry) ignored-header-fields))
|
|
||||||
(cons (car entry)
|
|
||||||
(header-value (car entry)
|
|
||||||
(variable-ref (cdr entry))))))
|
|
||||||
(module-map cons header))
|
|
||||||
(lambda (a b)
|
|
||||||
(string<? (symbol->string (car a))
|
|
||||||
(symbol->string (car b)))))
|
|
||||||
'())))
|
|
||||||
|
|
||||||
;; --- Lyrics --------------------------------------------------------------
|
|
||||||
|
|
||||||
;; Silbentext (String oder Markup) als String. Eine Tilde verbindet als
|
|
||||||
;; Lyric-Bindebogen zwei Woerter auf einer Note und wird zum Leerzeichen.
|
|
||||||
(define (syllable->string text)
|
|
||||||
(let ((s (cond ((string? text) text)
|
|
||||||
((markup? text) (markup->string text))
|
|
||||||
(else ""))))
|
|
||||||
(string-map (lambda (c) (if (char=? c #\~) #\space c)) s)))
|
|
||||||
|
|
||||||
;; Stanza-Beschriftung, wie sie gedruckt wuerde; vgl. handle-stanza-numbers
|
|
||||||
;; bzw. refMarkupFormatter/bridgeMarkupFormatter in
|
|
||||||
;; basic_format_and_style_settings.ily. text ist ein direkt per
|
|
||||||
;; \set stanza = "..." gesetzter Wert und gewinnt. Mit roman? werden die
|
|
||||||
;; Nummern roemisch formatiert (\romanStanza, z.B. fremdsprachige
|
|
||||||
;; Originalstrophen).
|
|
||||||
(define (stanza-label type numbers text roman?)
|
|
||||||
(define (number->label n)
|
|
||||||
(if roman? (format #f "~@r" n) n))
|
|
||||||
(define (joined-numbers)
|
|
||||||
(string-join (map (lambda (n) (ly:format "~a" (number->label n))) numbers)
|
|
||||||
", "))
|
|
||||||
(define (formatted plain with-numbers)
|
|
||||||
(if (null? numbers)
|
|
||||||
(ly:parser-lookup plain)
|
|
||||||
(ly:format (ly:parser-lookup with-numbers) (joined-numbers))))
|
|
||||||
(cond
|
|
||||||
(text text)
|
|
||||||
((eq? type 'ref) (formatted 'refString 'refStringWithNumbers))
|
|
||||||
((eq? type 'bridge) (formatted 'bridgeString 'bridgeStringWithNumbers))
|
|
||||||
((pair? numbers)
|
|
||||||
(string-join
|
|
||||||
(map (lambda (n)
|
|
||||||
(format #f (ly:parser-lookup 'stanzaFormat) (number->label n)))
|
|
||||||
numbers)
|
|
||||||
", "))
|
|
||||||
(else "")))
|
|
||||||
|
|
||||||
;; Wandelt ein Lyrics-Music-Objekt (eine Zeile aus \addlyrics bzw. das
|
|
||||||
;; Argument von \chordlyrics) in eine Liste von Eintraegen der Form
|
|
||||||
;; (marked? nummern . ((stanza . "1.") (type . verse) (text . "Auf die ...")))
|
|
||||||
;; Silben werden an HyphenEvents wieder zu Woertern zusammengesetzt.
|
|
||||||
;; Strophengrenzen ergeben sich aus den StanzaNumber-Overrides von
|
|
||||||
;; #(stanza n), \ref und \bridge sowie aus \set stanza = "...".
|
|
||||||
;; marked? ist #f fuer Fortsetzungsfragmente: Abschnitte ohne Marker oder
|
|
||||||
;; mit dem Zeilenumbruch-Marker \set stanza = "-" (right-/leftHyphen).
|
|
||||||
;; \set stanza mit Markup-Wert (Wiederholungszeichen, "D.S." usw.) ist
|
|
||||||
;; reine Dekoration mitten im Vers und beginnt keine neue Strophe.
|
|
||||||
(define (lyric-line->stanzas lyrics)
|
|
||||||
(let ((stanzas '()) ; fertige Eintraege, rueckwaerts
|
|
||||||
(words '()) ; fertige Woerter der aktuellen Strophe, rueckwaerts
|
|
||||||
(word "") ; offene Silbenkette
|
|
||||||
(type #f) ; 'verse / 'ref / 'bridge
|
|
||||||
(numbers '()) ; Strophennummern
|
|
||||||
(set-label #f) ; direkt gesetztes \set stanza = "..."
|
|
||||||
(roman #f) ; \romanStanza: Nummern roemisch formatieren
|
|
||||||
(pending-override #f) ; \override-stanza vor dem naechsten Marker
|
|
||||||
(override-numbers #f)) ; gedruckte Nummern der aktuellen Strophe
|
|
||||||
(define (flush-word!)
|
|
||||||
(unless (string-null? word)
|
|
||||||
(set! words (cons word words))
|
|
||||||
(set! word "")))
|
|
||||||
(define (flush-stanza!)
|
|
||||||
(flush-word!)
|
|
||||||
(when (or type set-label (pair? words))
|
|
||||||
(let ((display-numbers (or override-numbers numbers)))
|
|
||||||
(set! stanzas
|
|
||||||
(cons (cons* (if (or type (and set-label (not (string=? set-label "-")))) #t #f)
|
|
||||||
display-numbers
|
|
||||||
(list (cons 'stanza (stanza-label type display-numbers set-label roman))
|
|
||||||
(cons 'type (or type 'verse))
|
|
||||||
(cons 'text (string-join (reverse words) " "))))
|
|
||||||
stanzas)))
|
|
||||||
(set! words '())
|
|
||||||
(set! type #f)
|
|
||||||
(set! numbers '())
|
|
||||||
(set! set-label #f)
|
|
||||||
(set! override-numbers #f)))
|
|
||||||
;; Ein neuer Marker beendet die laufende Strophe, sobald schon Text da ist.
|
|
||||||
(define (marker!)
|
|
||||||
(when (or (pair? words) (not (string-null? word)))
|
|
||||||
(flush-stanza!)))
|
|
||||||
(define (handle-lyric-event m)
|
|
||||||
(let ((s (syllable->string (ly:music-property m 'text)))
|
|
||||||
(hyphen? (any (lambda (a)
|
|
||||||
(eq? (ly:music-property a 'name) 'HyphenEvent))
|
|
||||||
(ly:music-property m 'articulations '()))))
|
|
||||||
;; "_"-Skips (Melisma-Platzhalter) kommen als " " an und werden
|
|
||||||
;; ignoriert; ein an einem Trennstrich offenes Wort ("ru -- _ hig")
|
|
||||||
;; laeuft darueber weiter.
|
|
||||||
(unless (string-null? (string-trim-both s))
|
|
||||||
(set! word (string-append word s))
|
|
||||||
(unless hyphen? (flush-word!)))))
|
|
||||||
(define (handle-override m)
|
|
||||||
(when (eq? (ly:music-property m 'symbol) 'StanzaNumber)
|
|
||||||
(let ((path (ly:music-property m 'grob-property-path))
|
|
||||||
(value (ly:music-property m 'grob-value)))
|
|
||||||
(cond
|
|
||||||
((equal? path '(details custom-stanza-type))
|
|
||||||
(marker!)
|
|
||||||
(set! type value)
|
|
||||||
;; \override-stanza wirkt (\once) auf den naechsten Marker
|
|
||||||
(set! override-numbers pending-override)
|
|
||||||
(set! pending-override #f))
|
|
||||||
((equal? path '(details custom-stanza-numbers))
|
|
||||||
(marker!)
|
|
||||||
(set! numbers (if (list? value) value (list value))))
|
|
||||||
((equal? path '(details custom-stanzanumber-override))
|
|
||||||
(set! pending-override (if (list? value) value (list value))))
|
|
||||||
((equal? path '(style))
|
|
||||||
(set! roman (eq? value 'roman)))))))
|
|
||||||
(define (handle-set m)
|
|
||||||
(let ((value (ly:music-property m 'value)))
|
|
||||||
;; Nur String-Werte; Markups (Wiederholungszeichen etc.) sind
|
|
||||||
;; Dekoration mitten im Vers und keine Strophengrenze.
|
|
||||||
(when (and (eq? (ly:music-property m 'symbol) 'stanza)
|
|
||||||
(string? value))
|
|
||||||
(marker!)
|
|
||||||
(set! set-label value))))
|
|
||||||
(define (walk m)
|
|
||||||
(case (ly:music-property m 'name)
|
|
||||||
((LyricEvent) (handle-lyric-event m))
|
|
||||||
((OverrideProperty) (handle-override m))
|
|
||||||
((PropertySet) (handle-set m))
|
|
||||||
(else
|
|
||||||
(let ((element (ly:music-property m 'element)))
|
|
||||||
(if (ly:music? element) (walk element))
|
|
||||||
(for-each (lambda (e) (if (ly:music? e) (walk e)))
|
|
||||||
(ly:music-property m 'elements))))))
|
|
||||||
(walk lyrics)
|
|
||||||
(flush-stanza!)
|
|
||||||
(merge-reprinted (reverse stanzas))))
|
|
||||||
|
|
||||||
;; Beim Zeilenumbruch im Notenbild wird die Strophennummer manchmal erneut
|
|
||||||
;; gedruckt (z.B. \firstVerseB #(stanza 1) \firstVerseC). Ein Marker
|
|
||||||
;; direkt nach einer Strophe mit gleicher Kennung oder deren
|
|
||||||
;; Nummern-Obermenge (#(stanza 2 3) nach Strophe 2) setzt diese fort,
|
|
||||||
;; statt eine neue Strophe zu beginnen.
|
|
||||||
(define (merge-reprinted entries)
|
|
||||||
(let loop ((remaining entries) (acc '()))
|
|
||||||
(if (null? remaining)
|
|
||||||
(reverse acc)
|
|
||||||
(let ((entry (car remaining)))
|
|
||||||
(if (and (pair? acc)
|
|
||||||
(car entry) ; aktueller Eintrag markiert
|
|
||||||
(car (car acc)) ; vorheriger Eintrag markiert
|
|
||||||
(let* ((prev (car acc))
|
|
||||||
(prev-alist (cddr prev))
|
|
||||||
(alist (cddr entry))
|
|
||||||
(prev-numbers (cadr prev))
|
|
||||||
(prev-label (assq-ref prev-alist 'stanza)))
|
|
||||||
(or (and (not (string-null? prev-label))
|
|
||||||
(string=? prev-label (assq-ref alist 'stanza)))
|
|
||||||
(and (eq? (assq-ref prev-alist 'type)
|
|
||||||
(assq-ref alist 'type))
|
|
||||||
(pair? prev-numbers)
|
|
||||||
(every (lambda (n) (member n (cadr entry)))
|
|
||||||
prev-numbers)))))
|
|
||||||
(begin
|
|
||||||
(append-fragment-text! (cddr (car acc)) (cddr entry))
|
|
||||||
(loop (cdr remaining) acc))
|
|
||||||
(loop (cdr remaining) (cons entry acc)))))))
|
|
||||||
|
|
||||||
;; Haengt den Text eines Fortsetzungsfragments an eine Strophe an.
|
|
||||||
(define (append-fragment-text! target fragment)
|
|
||||||
(let ((target-cell (assq 'text target))
|
|
||||||
(fragment-text (assq-ref fragment 'text)))
|
|
||||||
(unless (string-null? fragment-text)
|
|
||||||
(set-cdr! target-cell
|
|
||||||
(if (string-null? (cdr target-cell))
|
|
||||||
fragment-text
|
|
||||||
(string-append (cdr target-cell) " " fragment-text))))))
|
|
||||||
|
|
||||||
;; Fuegt die Strophen-Eintraege mehrerer Lyric-Zeilen (Ergebnisse von
|
|
||||||
;; lyric-line->stanzas) zu einer flachen Strophenliste zusammen. Manche
|
|
||||||
;; Lieder verteilen eine Strophe auf mehrere Zeilen unter den Noten
|
|
||||||
;; (Fragmente mit \set stanza = "-" bzw. ohne Marker): Fortsetzungen
|
|
||||||
;; werden innerhalb einer Zeile an die vorhergehende markierte Strophe
|
|
||||||
;; angehaengt; Zeilen ganz ohne markierte Strophen positionsweise an die
|
|
||||||
;; markierten Strophen der letzten Zeile, die welche hatte.
|
|
||||||
(define (merge-lyric-lines lines)
|
|
||||||
(let ((result '()) ; fertige Strophen-alists, rueckwaerts
|
|
||||||
(last-marked '())) ; markierte alists der letzten markierten Zeile
|
|
||||||
(for-each
|
|
||||||
(lambda (line)
|
|
||||||
(let ((line-marked (filter-map (lambda (e) (and (car e) (cddr e))) line)))
|
|
||||||
(if (and (null? line-marked) (pair? last-marked))
|
|
||||||
;; Zeile nur aus Fortsetzungen: k-tes Fragment an k-te
|
|
||||||
;; markierte Strophe der Vorzeile, Ueberzaehlige an deren letzte.
|
|
||||||
(let loop ((entries line) (targets last-marked))
|
|
||||||
(when (pair? entries)
|
|
||||||
(append-fragment-text! (car targets) (cddar entries))
|
|
||||||
(loop (cdr entries)
|
|
||||||
(if (null? (cdr targets)) targets (cdr targets)))))
|
|
||||||
;; Zeile mit markierten Strophen (oder erste Zeile ueberhaupt):
|
|
||||||
;; Fortsetzungen an die vorhergehende Strophe der Zeile.
|
|
||||||
(begin
|
|
||||||
(let loop ((entries line)
|
|
||||||
(prev (if (pair? last-marked) (last last-marked) #f)))
|
|
||||||
(when (pair? entries)
|
|
||||||
(let ((marked? (caar entries))
|
|
||||||
(stanza-alist (cddar entries)))
|
|
||||||
(if (or marked? (not prev))
|
|
||||||
(begin
|
|
||||||
(set! result (cons stanza-alist result))
|
|
||||||
(loop (cdr entries) stanza-alist))
|
|
||||||
(begin
|
|
||||||
(append-fragment-text! prev stanza-alist)
|
|
||||||
(loop (cdr entries) prev))))))
|
|
||||||
(when (pair? line-marked)
|
|
||||||
(set! last-marked line-marked))))))
|
|
||||||
lines)
|
|
||||||
(reverse result)))
|
|
||||||
|
|
||||||
;; Gruppiert alle LyricCombineMusic-Objekte im music-Baum nach ihrer
|
|
||||||
;; Stimme (associated-context, das \addlyrics/\lyricsto zuweisen).
|
|
||||||
;; Liefert eine Liste von Gruppen (je eine Liste von Lyrics-Music-
|
|
||||||
;; Objekten) in der Reihenfolge, in der die Stimmen zuerst auftauchen.
|
|
||||||
(define (voice-groups music)
|
|
||||||
(let* ((combines (extract-named-music music 'LyricCombineMusic))
|
|
||||||
(contexts (delete-duplicates
|
|
||||||
(map (lambda (c) (ly:music-property c 'associated-context))
|
|
||||||
combines))))
|
|
||||||
(map (lambda (ctx)
|
|
||||||
(map (lambda (c) (ly:music-property c 'element))
|
|
||||||
(filter (lambda (c)
|
|
||||||
(equal? (ly:music-property c 'associated-context) ctx))
|
|
||||||
combines)))
|
|
||||||
contexts)))
|
|
||||||
|
|
||||||
;; Liefert die Strophen aller Stimmen unter den Noten, die selbst echte
|
|
||||||
;; Strophen/Refrains/Bridges tragen (mindestens einen markierten
|
|
||||||
;; Abschnitt haben, vgl. lyric-line->stanzas) -- filtert damit rein
|
|
||||||
;; dekorative Gegen- oder Echostimmen heraus (z.B. wiederholte
|
|
||||||
;; Lautmalerei ohne eigene Strophennummer). "Die erste Stimme im
|
|
||||||
;; Dokument" ist dafuer kein verlaessliches Kriterium: welche Stimme
|
|
||||||
;; die Hauptmelodie mit dem vollstaendigen Strophentext singt, wechselt
|
|
||||||
;; von Lied zu Lied (mal Stimme 1, mal 2, je nach Satz).
|
|
||||||
;; Qualifizierende Stimmen werden zusammengefuehrt (verschiedene
|
|
||||||
;; Sprachfassungen tragen z.B. beide eigene Strophen); dabei bildet die
|
|
||||||
;; Stimme mit den meisten eigenen Strophen ('verse, nicht Ref/Bridge)
|
|
||||||
;; das Rueckgrat, in das die anderen einsortiert werden -- sonst wuerde
|
|
||||||
;; ein von mehreren Stimmen gemeinsam gesungener Refrain, der im
|
|
||||||
;; Dokument vor der eigentlichen Strophe auftaucht, deren Platz vor der
|
|
||||||
;; Strophe 1 belegen.
|
|
||||||
(define (main-voice-lyrics music)
|
|
||||||
(define (verse-count stanzas)
|
|
||||||
(count (lambda (e) (eq? (assq-ref e 'type) 'verse)) stanzas))
|
|
||||||
(define (any-marked? lines) (any (lambda (line) (any car line)) lines))
|
|
||||||
(let* ((groups (map (lambda (group) (map lyric-line->stanzas group))
|
|
||||||
(voice-groups music)))
|
|
||||||
(with-marks (filter any-marked? groups))
|
|
||||||
;; Der Ausschluss unmarkierter Stimmen lohnt nur, wenn es
|
|
||||||
;; ueberhaupt eine ALTERNATIVE gibt: hat KEINE Stimme einen
|
|
||||||
;; echten Strophenmarker, gibt es kein "Rueckgrat" zum
|
|
||||||
;; Einsortieren -- dann wie frueher nur die erste Stimme nehmen
|
|
||||||
;; (sonst wuerden z.B. mehrere Satzstimmen mit identischem,
|
|
||||||
;; unmarkiertem Text ihren Kehrreim mehrfach liefern, weil sich
|
|
||||||
;; unmarkierte Eintraege ohne Strophennummer nicht als Duplikat
|
|
||||||
;; erkennen lassen). Nur EINE Stimme insgesamt ist ein
|
|
||||||
;; Sonderfall davon (erste = einzige).
|
|
||||||
(qualifying (cond
|
|
||||||
((pair? with-marks) with-marks)
|
|
||||||
((pair? groups) (list (car groups)))
|
|
||||||
(else '())))
|
|
||||||
(merged-per-group (map merge-lyric-lines qualifying))
|
|
||||||
(ranked (sort (iota (length merged-per-group))
|
|
||||||
(lambda (a b) (> (verse-count (list-ref merged-per-group a))
|
|
||||||
(verse-count (list-ref merged-per-group b)))))))
|
|
||||||
(fold (lambda (i acc) (add-missing-stanzas acc (list-ref merged-per-group i)))
|
|
||||||
'() ranked)))
|
|
||||||
|
|
||||||
;; --- Textseiten-Strophen aus dem Render-Collector ------------------------
|
|
||||||
|
|
||||||
;; Liest die Strophen der Textseiten aus dem per-Song-Store (chordpro.ily),
|
|
||||||
;; den der ChordPro_score_collector beim Rendern der \chordlyrics-Scores
|
|
||||||
;; fuellt. Dort ist Tag-Filterung, \override-stanza usw. bereits von
|
|
||||||
;; LilyPond selbst entschieden -- unsichtbare Verse tauchen gar nicht
|
|
||||||
;; erst auf. Die Dokumentreihenfolge liefert
|
|
||||||
;; chordpro-song-ordered-verse-indices (die Interpretation laeuft
|
|
||||||
;; rueckwaerts und bei mehrspaltigen group-verses verschraenkt).
|
|
||||||
;; Liefert Eintraege wie lyric-line->stanzas:
|
|
||||||
;; ((stanza . "2.") (type . verse) (text . "Die Haeuser ..."))
|
|
||||||
(define (collector-song->stanzas song)
|
|
||||||
;; Silben eines Verses in Sammelreihenfolge; Eintrag: (moment text hyphen? idx)
|
|
||||||
(define (verse-syllables idx)
|
|
||||||
(reverse (filter (lambda (s) (= (cadddr s) idx))
|
|
||||||
(chordpro-song-syllables song))))
|
|
||||||
;; Gedruckte Labels koennen Wiederholungszeichen tragen ("2.𝄆") --
|
|
||||||
;; die gehoeren nicht ins Label.
|
|
||||||
(define (clean-label s)
|
|
||||||
(string-trim-both
|
|
||||||
(string-delete (lambda (c) (memv c '(#\𝄆 #\𝄇))) s)))
|
|
||||||
;; Silben zu Woertern: Trennstriche verbinden, "_"-Extender (kommen als
|
|
||||||
;; Whitespace an) werden ueberlaufen, ohne das offene Wort zu schliessen.
|
|
||||||
(define (syllables->text syls)
|
|
||||||
(let loop ((rest syls) (word "") (words '()))
|
|
||||||
(if (null? rest)
|
|
||||||
(string-join
|
|
||||||
(reverse (if (string-null? word) words (cons word words)))
|
|
||||||
" ")
|
|
||||||
(let* ((s (syllable->string (cadr (car rest))))
|
|
||||||
(hyphen? (caddr (car rest))))
|
|
||||||
(if (string-null? (string-trim-both s))
|
|
||||||
(loop (cdr rest) word words)
|
|
||||||
(if hyphen?
|
|
||||||
(loop (cdr rest) (string-append word s) words)
|
|
||||||
(loop (cdr rest) ""
|
|
||||||
(cons (string-append word s) words))))))))
|
|
||||||
(filter-map
|
|
||||||
(lambda (idx)
|
|
||||||
(let ((syls (verse-syllables idx))
|
|
||||||
(entry (assoc idx (chordpro-song-stanza-numbers song))))
|
|
||||||
(and (pair? syls)
|
|
||||||
(list (cons 'stanza (clean-label
|
|
||||||
(or (and entry (cadr entry)) "")))
|
|
||||||
(cons 'type (or (and entry (caddr entry)) 'verse))
|
|
||||||
(cons 'text (syllables->text syls))))))
|
|
||||||
(chordpro-song-ordered-verse-indices song)))
|
|
||||||
|
|
||||||
;; Dieselbe Strophe? Gleiche Kennung allein reicht nicht: zweisprachige
|
|
||||||
;; Lieder nutzen dieselben Nummern fuer Uebersetzung und Original. Die
|
|
||||||
;; Texte muessen sich auch aehneln (mindestens die Haelfte der Woerter
|
|
||||||
;; der kuerzeren Fassung kommt in der laengeren vor).
|
|
||||||
(define (same-stanza-text? a b)
|
|
||||||
(define (word-list s)
|
|
||||||
(map string-downcase (string-tokenize s char-set:letter)))
|
|
||||||
(let* ((wa (word-list a))
|
|
||||||
(wb (word-list b))
|
|
||||||
(shorter (if (<= (length wa) (length wb)) wa wb))
|
|
||||||
(longer (if (<= (length wa) (length wb)) wb wa)))
|
|
||||||
(or (null? shorter)
|
|
||||||
(>= (count (lambda (w) (member w longer)) shorter)
|
|
||||||
(/ (length shorter) 2)))))
|
|
||||||
|
|
||||||
;; Wie merge-stanza-lists, aber bei Konflikt gewinnt BASE statt der
|
|
||||||
;; einzumischenden Liste: fuer das Zusammenfuehren mehrerer Hauptstimmen-
|
|
||||||
;; Kandidaten (main-voice-lyrics), wo die 'reichste' Stimme (meiste
|
|
||||||
;; eigene Strophen) die kanonische Fassung liefert und andere Stimmen
|
|
||||||
;; nur FEHLENDE Strophen ergaenzen duerfen -- z.B. wenn Sopran und Alt
|
|
||||||
;; beide "1." tragen, der Alt aber eine gekuerzte Textvariante singt
|
|
||||||
;; (vgl. Sieh_des_Herbstes_Geisteshelle: infotext "Strophenteile in
|
|
||||||
;; Klammern sind die Textvarianten im Alt").
|
|
||||||
(define (add-missing-stanzas base additional)
|
|
||||||
(fold
|
|
||||||
(lambda (entry acc)
|
|
||||||
(let* ((key (assq-ref entry 'stanza))
|
|
||||||
(found (and (not (string-null? key))
|
|
||||||
(not (string=? key "-"))
|
|
||||||
(find (lambda (e) (and (equal? (assq-ref e 'stanza) key)
|
|
||||||
(same-stanza-text?
|
|
||||||
(assq-ref e 'text)
|
|
||||||
(assq-ref entry 'text))))
|
|
||||||
acc))))
|
|
||||||
(if found acc (append acc (list entry)))))
|
|
||||||
base
|
|
||||||
additional))
|
|
||||||
|
|
||||||
;; Fuegt Musik- und Textseiten-Strophen zusammen: gleiche Strophen nur
|
|
||||||
;; einmal, wobei die Fassung aus den Textseiten die unter den Noten
|
|
||||||
;; ersetzt (dort steht meist die vollstaendige Fassung).
|
|
||||||
(define (merge-stanza-lists music-stanzas text-stanzas)
|
|
||||||
(let loop ((merged music-stanzas) (remaining text-stanzas))
|
|
||||||
(if (null? remaining)
|
|
||||||
merged
|
|
||||||
(let* ((entry (car remaining))
|
|
||||||
(key (assq-ref entry 'stanza))
|
|
||||||
(found (and (not (string-null? key))
|
|
||||||
(not (string=? key "-"))
|
|
||||||
(find (lambda (e)
|
|
||||||
(and (equal? (assq-ref e 'stanza) key)
|
|
||||||
(same-stanza-text?
|
|
||||||
(assq-ref e 'text)
|
|
||||||
(assq-ref entry 'text))))
|
|
||||||
merged))))
|
|
||||||
(loop (if found
|
|
||||||
(map (lambda (e) (if (eq? e found) entry e)) merged)
|
|
||||||
(append merged (list entry)))
|
|
||||||
(cdr remaining))))))
|
|
||||||
|
|
||||||
;; Extrahiert alle Strophen/Refrain/Bridge-Texte eines Liedes: die Strophen
|
|
||||||
;; unter den Noten aus music (die Hauptstimme(n), siehe main-voice-lyrics),
|
|
||||||
;; die Textstrophen aus dem Render-Collector-Store des Liedes (song, darf
|
|
||||||
;; #f sein).
|
|
||||||
(define (extract-lyrics music song)
|
|
||||||
(merge-stanza-lists
|
|
||||||
(main-voice-lyrics music)
|
|
||||||
(if song (collector-song->stanzas song) '())))
|
|
||||||
|
|
||||||
;; --- Hauptfunktion -----------------------------------------------------
|
|
||||||
|
|
||||||
;; Liefert das erste Music-Objekt mit gegebenem Namen (oder #f).
|
|
||||||
(define (first-named-music music music-name)
|
|
||||||
(let ((matches (extract-named-music music music-name)))
|
|
||||||
(and (pair? matches) (car matches))))
|
|
||||||
|
|
||||||
;; Nimmt ly:music entgegen und liefert eine alist mit String-Werten.
|
|
||||||
(define (music->data-alist music)
|
|
||||||
(let* ((time-m (first-named-music
|
|
||||||
music '(TimeSignatureMusic ReferenceTimeSignatureMusic)))
|
|
||||||
(key-m (first-named-music music 'KeyChangeEvent))
|
|
||||||
(tempo-m (first-named-music music 'TempoChangeEvent))
|
|
||||||
(time-s (and time-m (time-music->string time-m)))
|
|
||||||
(key-s (and key-m (key-music->string key-m)))
|
|
||||||
(tempo-s (and tempo-m (tempo-music->string tempo-m))))
|
|
||||||
(append
|
|
||||||
(if time-s (list (cons 'time time-s)) '())
|
|
||||||
(if key-s (list (cons 'key key-s)) '())
|
|
||||||
(if tempo-s (list (cons 'tempo tempo-s)) '()))))
|
|
||||||
|
|
||||||
;; song ist der per-Song-Store-Eintrag aus chordpro.ily (oder #f, wenn
|
|
||||||
;; keine Textseiten gerendert wurden) -- er liefert die Textseiten-
|
|
||||||
;; Strophen. Darf erst NACH dem Rendern der Textseiten aufgerufen
|
|
||||||
;; werden (delayed stencil), vorher ist der Store leer. song-id ist
|
|
||||||
;; der Liedname (Einzellied: Ausgabename; Buch: der bei \includeSong
|
|
||||||
;; angegebene Dateiname) und landet unter dem Key song_id.
|
|
||||||
(define (extract-song-data header music song song-id)
|
|
||||||
(let ((header-alist (bookpart->header-alist header))
|
|
||||||
(music-alist (music->data-alist music))
|
|
||||||
(lyrics-list (extract-lyrics music song)))
|
|
||||||
(append header-alist
|
|
||||||
(list (cons 'song_id song-id)
|
|
||||||
(cons 'musical music-alist)
|
|
||||||
(cons 'lyrics lyrics-list)))))
|
|
||||||
|
|
||||||
;; Unsichtbarer Stencil fuer die Einzellied-YAML: schreibt <key>.yml
|
|
||||||
;; per delay-stencil-evaluation erst bei der Ausgabe, wenn der
|
|
||||||
;; Render-Collector alle Textseiten-Strophen gesammelt hat. header und
|
|
||||||
;; music werden beim Anhaengen (Parse-Zeit in layout_bottom) gebunden.
|
|
||||||
(define (yaml-delayed-song-write key header music)
|
|
||||||
(ly:make-stencil
|
|
||||||
`(delay-stencil-evaluation
|
|
||||||
,(delay (begin
|
|
||||||
(scm->yml-file (string-append key ".yml")
|
|
||||||
(extract-song-data header music
|
|
||||||
(hash-ref chordpro-song-store key)
|
|
||||||
key))
|
|
||||||
empty-stencil))))))
|
|
||||||
@@ -1,190 +0,0 @@
|
|||||||
\paper {
|
|
||||||
poetPrefix = "Worte:"
|
|
||||||
composerPrefix = "Weise:"
|
|
||||||
compositionPrefix = "Satz:"
|
|
||||||
adaptionTextPrefix = "Bearbeitung:"
|
|
||||||
adaptionMusicPrefix = "Bearbeitung:"
|
|
||||||
poetAndComposerEqualPrefix = "Worte und Weise:"
|
|
||||||
voicePrefix = "Stimme:"
|
|
||||||
versePrefix = "Strophe:"
|
|
||||||
refPrefix = "Refrain:"
|
|
||||||
translationAuthorPrefix = "Übersetzung:"
|
|
||||||
translationPrefix = "Übersetzung:"
|
|
||||||
pronunciationPrefix = "Aussprache:"
|
|
||||||
interludePrefix = "Zwischenspiel:"
|
|
||||||
bridgePrefix = "Bridge:"
|
|
||||||
author-joiner = #(lambda (author-list) (string-join author-list ", "))
|
|
||||||
|
|
||||||
authorFormat =
|
|
||||||
#(lambda (noDetails name trail_name birth_year death_year organization)
|
|
||||||
(let ((string-present (lambda (str) (and str (not (and (string? str) (string-null? str))))))
|
|
||||||
(render_informations (lambda (infolist) (string-append (car infolist) (if (or noDetails (null? (cdr infolist))) "" (string-append " (" (string-join (cdr infolist) ", ") ")"))))))
|
|
||||||
(if (or (string-present trail_name) (string-present name))
|
|
||||||
(render_informations (filter string-present (list
|
|
||||||
trail_name
|
|
||||||
name
|
|
||||||
(if (and (string-present birth_year) (string-present death_year))
|
|
||||||
(ly:format "~a‒~a" birth_year death_year)
|
|
||||||
(if (string-present birth_year)
|
|
||||||
(ly:format "*~a" birth_year)
|
|
||||||
(if (string-present death_year) (ly:format "†~a" death_year) "")))
|
|
||||||
organization
|
|
||||||
)))
|
|
||||||
""
|
|
||||||
)))
|
|
||||||
|
|
||||||
authorContributionFormat =
|
|
||||||
#(lambda* (render-contribution-group render-partial-contribution-group #:key
|
|
||||||
(poetIds '())
|
|
||||||
(translatorIds '())
|
|
||||||
(versePoetData '())
|
|
||||||
(composerIds '())
|
|
||||||
(verseComposerData '())
|
|
||||||
(refComposerIds '())
|
|
||||||
(voiceComposerData '())
|
|
||||||
(compositionIds '())
|
|
||||||
(adaptionTextIds '())
|
|
||||||
(adaptionMusicIds '())
|
|
||||||
(bridgeIds '())
|
|
||||||
(interludeIds '())
|
|
||||||
(year_text #f)
|
|
||||||
(year_translation #f)
|
|
||||||
(year_melody #f)
|
|
||||||
(year_melody_meloref #f)
|
|
||||||
(year_composition #f)
|
|
||||||
(year_adaption_text #f)
|
|
||||||
(year_adaption_music #f)
|
|
||||||
(poetAndComposerEqualPrefix "")
|
|
||||||
(poetPrefix "")
|
|
||||||
(composerPrefix "")
|
|
||||||
(translationAuthorPrefix "")
|
|
||||||
(pronunciationPrefix "")
|
|
||||||
(compositionPrefix "")
|
|
||||||
(adaptionTextPrefix "")
|
|
||||||
(adaptionMusicPrefix "")
|
|
||||||
(bridgePrefix "")
|
|
||||||
(interludePrefix "")
|
|
||||||
(refPrefix ""))
|
|
||||||
(if (and
|
|
||||||
(equal? poetIds composerIds)
|
|
||||||
(null? translatorIds)
|
|
||||||
(null? versePoetData)
|
|
||||||
(null? verseComposerData)
|
|
||||||
(null? refComposerIds)
|
|
||||||
(null? voiceComposerData)
|
|
||||||
(null? compositionIds)
|
|
||||||
(null? adaptionTextIds)
|
|
||||||
(null? adaptionMusicIds)
|
|
||||||
(null? bridgeIds)
|
|
||||||
(null? interludeIds))
|
|
||||||
(list
|
|
||||||
(join-present (list
|
|
||||||
(render-contribution-group poetAndComposerEqualPrefix poetIds)
|
|
||||||
(if (equal? year_text year_melody) year_text (join-present (list year_text year_melody) "/"))
|
|
||||||
) ", ")
|
|
||||||
#f)
|
|
||||||
(list
|
|
||||||
(if (and (null? poetIds) (null? versePoetData) (null? translatorIds)) #f
|
|
||||||
(string-append
|
|
||||||
poetPrefix
|
|
||||||
" "
|
|
||||||
(join-present (list
|
|
||||||
(join-present (list
|
|
||||||
(render-contribution-group "" poetIds)
|
|
||||||
year_text
|
|
||||||
) ", ")
|
|
||||||
(render-partial-contribution-group 'versePrefix versePoetData)
|
|
||||||
(join-present (list
|
|
||||||
(render-contribution-group adaptionTextPrefix adaptionTextIds)
|
|
||||||
year_adaption_text
|
|
||||||
) ", ")
|
|
||||||
(join-present (list
|
|
||||||
(render-contribution-group translationAuthorPrefix translatorIds)
|
|
||||||
year_translation
|
|
||||||
) ", ")
|
|
||||||
) "; ")
|
|
||||||
))
|
|
||||||
(if (and
|
|
||||||
(null? composerIds)
|
|
||||||
(null? compositionIds)
|
|
||||||
(null? adaptionMusicIds)
|
|
||||||
(null? verseComposerData)
|
|
||||||
(null? refComposerIds)
|
|
||||||
(null? voiceComposerData)
|
|
||||||
(null? bridgeIds)
|
|
||||||
(null? interludeIds)) #f
|
|
||||||
(string-append
|
|
||||||
composerPrefix
|
|
||||||
" "
|
|
||||||
(join-present (list
|
|
||||||
(join-present (list
|
|
||||||
(render-contribution-group "" composerIds)
|
|
||||||
year_melody
|
|
||||||
) ", ")
|
|
||||||
(render-partial-contribution-group 'versePrefix verseComposerData)
|
|
||||||
(join-present (list
|
|
||||||
(render-contribution-group refPrefix refComposerIds)
|
|
||||||
year_melody_meloref
|
|
||||||
) ", ")
|
|
||||||
(render-partial-contribution-group 'voicePrefix voiceComposerData)
|
|
||||||
(join-present (list
|
|
||||||
(render-contribution-group compositionPrefix compositionIds)
|
|
||||||
year_composition
|
|
||||||
) ", ")
|
|
||||||
(join-present (list
|
|
||||||
(render-contribution-group adaptionMusicPrefix adaptionMusicIds)
|
|
||||||
year_adaption_music
|
|
||||||
) ", ")
|
|
||||||
(render-contribution-group bridgePrefix bridgeIds)
|
|
||||||
(render-contribution-group interludePrefix interludeIds)
|
|
||||||
) "; ")
|
|
||||||
)))))
|
|
||||||
|
|
||||||
|
|
||||||
songinfoMarkup =
|
|
||||||
#(make-on-the-fly-markup
|
|
||||||
(lambda (layout props m)
|
|
||||||
(let* ((between-poet-and-composer-markup (chain-assoc-get 'header:between-poet-and-composer-markup props (make-hspace-markup 3)))
|
|
||||||
(poet-maybe-with-composer (chain-assoc-get 'songinfo:poet-maybe-with-composer props #f))
|
|
||||||
(composer (chain-assoc-get 'songinfo:composer props #f))
|
|
||||||
(copyright (chain-assoc-get 'songinfo:copyright props #f))
|
|
||||||
(infotext (chain-assoc-get 'songinfo:infotext props #f))
|
|
||||||
(translation (chain-assoc-get 'songinfo:translation props #f))
|
|
||||||
(pronunciation (chain-assoc-get 'songinfo:pronunciation props #f))
|
|
||||||
(year_text (chain-assoc-get 'songinfo:year_text props #f))
|
|
||||||
(year_melody (chain-assoc-get 'songinfo:year_melody props #f))
|
|
||||||
(poet-with-year (if (and poet-maybe-with-composer year_text) (string-append poet-maybe-with-composer ", " year_text) poet-maybe-with-composer))
|
|
||||||
(composer-with-year (if (and composer year_melody) (string-append composer ", " year_melody) composer))
|
|
||||||
(concat-markupped-strings (lambda (text)
|
|
||||||
(ly:regex-replace (ly:make-regex "(\\S+)(\\\\\\w+(?:\\s+\\[^\\{\\s]*|\\s*\\{[^\\}]*\\}))(\\S*)") text "\\concat {" 1 "\\line {" 2 "}" 3 "}")))
|
|
||||||
(string-with-paragraphs->markuplist (lambda (prefix text)
|
|
||||||
(if text
|
|
||||||
(apply append
|
|
||||||
(map
|
|
||||||
(lambda (paragraph)
|
|
||||||
(make-wordwrap-internal-markup-list #t
|
|
||||||
#{ \markuplist { $(ly:parser-include-string (concat-markupped-strings paragraph)) } #}))
|
|
||||||
(ly:regex-split (ly:make-regex "\r?\n[ \t\r\n]*\n[ \t\r\n]*") (string-append prefix text))))
|
|
||||||
'())))
|
|
||||||
(poet-and-composer-markup-list
|
|
||||||
(string-with-paragraphs->markuplist "" (string-append
|
|
||||||
(if poet-with-year (string-append "\n\n" poet-with-year) "")
|
|
||||||
(if composer-with-year (string-append "\n\n" composer-with-year) "")
|
|
||||||
)))
|
|
||||||
(poet-and-composer-oneliner (if (and poet-with-year composer-with-year) (make-line-markup (cons (cadr poet-and-composer-markup-list) (cons between-poet-and-composer-markup (cddr poet-and-composer-markup-list)))) #f))
|
|
||||||
(current-line-width (chain-assoc-get 'line-width props (ly:output-def-lookup layout 'line-width))))
|
|
||||||
(stack-lines DOWN 0.0 (chain-assoc-get 'baseline-skip props)
|
|
||||||
(interpret-markup-list layout props
|
|
||||||
(append
|
|
||||||
(if (and poet-and-composer-oneliner (< (interval-length (ly:stencil-extent (interpret-markup layout props poet-and-composer-oneliner) X)) current-line-width))
|
|
||||||
(list poet-and-composer-oneliner)
|
|
||||||
poet-and-composer-markup-list)
|
|
||||||
(string-with-paragraphs->markuplist "" (string-append
|
|
||||||
(if copyright (string-append "\n\n© " copyright) "")))
|
|
||||||
(string-with-paragraphs->markuplist "" infotext)
|
|
||||||
(string-with-paragraphs->markuplist (string-append (ly:output-def-lookup layout 'translationPrefix) " ") translation)
|
|
||||||
(string-with-paragraphs->markuplist (string-append (ly:output-def-lookup layout 'pronunciationPrefix) " ") pronunciation)
|
|
||||||
)))))
|
|
||||||
(make-null-markup)
|
|
||||||
)
|
|
||||||
}
|
|
||||||
@@ -1,36 +0,0 @@
|
|||||||
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."
|
|
||||||
refString = "Ref.:"
|
|
||||||
refStringWithNumbers = "Ref. ~a:"
|
|
||||||
bridgeString = "Bridge:"
|
|
||||||
bridgeStringWithNumbers = "Bridge ~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))
|
|
||||||
}
|
|
||||||
}
|
|
||||||
@@ -1,28 +0,0 @@
|
|||||||
% songfilename auch im Markup verfügbar machen
|
|
||||||
#(define-markup-list-command (setsongfilename layout props songfilename markuplist)
|
|
||||||
(string? markup-list?)
|
|
||||||
(interpret-markup-list layout (prepend-alist-chain 'songfilename songfilename props) markuplist))
|
|
||||||
|
|
||||||
#(define-markup-command (customEps layout props ysize filename)(number? string?)
|
|
||||||
#:properties ((songfilename ""))
|
|
||||||
(interpret-markup layout props
|
|
||||||
(let* ((defaulttitlemarkup (ly:output-def-lookup layout 'defaultTitleMarkup))
|
|
||||||
;; Determine the song directory to resolve the EPS relative to.
|
|
||||||
;; In TEXT the name arrives via the markup props (\setsongfilename),
|
|
||||||
;; but inside MUSIC (e.g. \mark) the props do not carry it, so we
|
|
||||||
;; fall back to the value stored in the score's \layout block.
|
|
||||||
(layout-songfilename (ly:output-def-lookup layout 'songfilename #f))
|
|
||||||
(songdir (cond ((not (string-null? songfilename)) songfilename)
|
|
||||||
((and (string? layout-songfilename)
|
|
||||||
(not (string-null? layout-songfilename)))
|
|
||||||
layout-songfilename)
|
|
||||||
(else #f)))
|
|
||||||
(filepath (if songdir
|
|
||||||
(ly:format "~a/~a/~a" songPath songdir filename)
|
|
||||||
filename)))
|
|
||||||
(if (file-exists? filepath)
|
|
||||||
(make-epsfile-markup Y ysize filepath)
|
|
||||||
(if defaulttitlemarkup
|
|
||||||
defaulttitlemarkup
|
|
||||||
(ly:format "file does not exist ~a" filepath))
|
|
||||||
))))
|
|
||||||
@@ -1,218 +0,0 @@
|
|||||||
#(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 (join-present items joiner)
|
|
||||||
(string-join (filter (lambda (item) (and (string? item) (not (string-null? (string-trim-both item))))) items) joiner))
|
|
||||||
|
|
||||||
#(define-markup-command (print-songinfo layout props) ()
|
|
||||||
(define (songinfo-from songId key)
|
|
||||||
(let ((song (if (defined? 'SONG_DATA) (assoc-ref SONG_DATA songId) #f)))
|
|
||||||
(if song
|
|
||||||
(assoc-ref song key)
|
|
||||||
(ly:warning (ly:format "song with id ~a not found" songId)))))
|
|
||||||
|
|
||||||
(define* (default-author-format authorId #:optional (noDetails #f))
|
|
||||||
(format-author (ly:output-def-lookup layout 'authorFormat) authorId noDetails))
|
|
||||||
|
|
||||||
(define (format-poet poetId)
|
|
||||||
(string-append (ly:output-def-lookup layout 'poetPrefix) " " (default-author-format poetId)))
|
|
||||||
|
|
||||||
(define (format-composer composerId)
|
|
||||||
(string-append (ly:output-def-lookup layout 'composerPrefix) " " (default-author-format composerId)))
|
|
||||||
|
|
||||||
(define (format-poet-and-composer authorId)
|
|
||||||
(string-append (ly:output-def-lookup layout 'poetAndComposerEqualPrefix) " " (default-author-format authorId)))
|
|
||||||
|
|
||||||
(define (numbered-contribution-prefix contributionNumbers prefixLookup)
|
|
||||||
(string-append
|
|
||||||
(string-join (map (lambda (contributionNumber) (ly:format "~a." contributionNumber)) contributionNumbers) ", ")
|
|
||||||
" "
|
|
||||||
(ly:output-def-lookup layout prefixLookup)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
|
|
||||||
(define referencedAuthors '())
|
|
||||||
|
|
||||||
(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 " " ((ly:output-def-lookup layout 'author-joiner) (format-authors authorIds))))
|
|
||||||
)
|
|
||||||
|
|
||||||
(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
|
|
||||||
((ly:output-def-lookup layout 'authorContributionFormat)
|
|
||||||
render-contribution-group
|
|
||||||
render-partial-contribution-group
|
|
||||||
#:poetIds (find-author-ids-by 'text authors)
|
|
||||||
#:translatorIds (find-author-ids-by 'translation authors)
|
|
||||||
#:versePoetData (find-author-id-with-part-numbers 'verse authors)
|
|
||||||
#:composerIds (find-author-ids-by 'melody authors)
|
|
||||||
#:verseComposerData (find-author-id-with-part-numbers 'meloverse authors)
|
|
||||||
#:refComposerIds (find-author-ids-by 'meloref authors)
|
|
||||||
#:voiceComposerData (find-author-id-with-part-numbers 'voice authors)
|
|
||||||
#:compositionIds (find-author-ids-by 'composition authors)
|
|
||||||
#:adaptionTextIds (find-author-ids-by 'adaption_text authors)
|
|
||||||
#:adaptionMusicIds (find-author-ids-by 'adaption_music authors)
|
|
||||||
#:bridgeIds (find-author-ids-by 'bridge authors)
|
|
||||||
#:interludeIds (find-author-ids-by 'interlude authors)
|
|
||||||
#:year_text (chain-assoc-get 'header:year_text props #f)
|
|
||||||
#:year_translation (chain-assoc-get 'header:year_translation props #f)
|
|
||||||
#:year_melody (chain-assoc-get 'header:year_melody props #f)
|
|
||||||
#:year_melody_meloref (chain-assoc-get 'header:year_melody_meloref props #f)
|
|
||||||
#:year_composition (chain-assoc-get 'header:year_composition props #f)
|
|
||||||
#:year_adaption_text (chain-assoc-get 'header:year_adaption_text props #f)
|
|
||||||
#:year_adaption_music (chain-assoc-get 'header:year_adaption_music props #f)
|
|
||||||
#:poetAndComposerEqualPrefix (ly:output-def-lookup layout 'poetAndComposerEqualPrefix)
|
|
||||||
#:poetPrefix (ly:output-def-lookup layout 'poetPrefix)
|
|
||||||
#:composerPrefix (ly:output-def-lookup layout 'composerPrefix)
|
|
||||||
#:translationAuthorPrefix (ly:output-def-lookup layout 'translationAuthorPrefix)
|
|
||||||
#:pronunciationPrefix (ly:output-def-lookup layout 'pronunciationPrefix)
|
|
||||||
#:compositionPrefix (ly:output-def-lookup layout 'compositionPrefix)
|
|
||||||
#:adaptionTextPrefix (ly:output-def-lookup layout 'adaptionTextPrefix)
|
|
||||||
#:adaptionMusicPrefix (ly:output-def-lookup layout 'adaptionMusicPrefix)
|
|
||||||
#:bridgePrefix (ly:output-def-lookup layout 'bridgePrefix)
|
|
||||||
#:interludePrefix (ly:output-def-lookup layout 'interludePrefix)
|
|
||||||
#:refPrefix (ly:output-def-lookup layout 'refPrefix))
|
|
||||||
(list #f #f)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
|
|
||||||
(interpret-markup layout props
|
|
||||||
(if (chain-assoc-get 'page:is-bookpart-last-page props #f)
|
|
||||||
(let* ((authors (chain-assoc-get 'header:authors props #f))
|
|
||||||
(poet-and-composers (poet-and-composer-from-authors authors))
|
|
||||||
(songId (chain-assoc-get 'header:songId props #f))
|
|
||||||
(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? (cadr poet-and-composers)) #f (chain-assoc-get 'header:year_melody props #f))))
|
|
||||||
(markup
|
|
||||||
#:override (cons 'songinfo:poet-maybe-with-composer
|
|
||||||
(if (and poet-maybe-with-composer (not (and (string? poet-maybe-with-composer) (string-null? poet-maybe-with-composer)))) poet-maybe-with-composer #f))
|
|
||||||
#: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)()
|
|
||||||
(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-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)))
|
|
||||||
|
|
||||||
#(define pdf-encode (@@ (lily framework-ps) pdf-encode))
|
|
||||||
% PDF tags
|
|
||||||
#(define-markup-command (page-number-to-pdf-label layout props) ()
|
|
||||||
(ly:make-stencil
|
|
||||||
(list 'embedded-ps
|
|
||||||
(ly:format
|
|
||||||
"[ /Label (~a) /PAGELABEL pdfmark\n" (pdf-encode (chain-assoc-get 'page:page-number-string props "?"))))
|
|
||||||
empty-interval empty-interval
|
|
||||||
))
|
|
||||||
|
|
||||||
\paper {
|
|
||||||
print-first-page-number = ##t
|
|
||||||
first-page-number = #0
|
|
||||||
|
|
||||||
oddFooterMarkup = \markup {
|
|
||||||
\fill-line {
|
|
||||||
\line { \page-number-to-pdf-label \null }
|
|
||||||
\line { \if \on-last-page-of-part \general-align #Y #DOWN \fractional-line-width \print-songinfo }
|
|
||||||
\line { \if \should-print-page-number \print-pagenumber }
|
|
||||||
}
|
|
||||||
}
|
|
||||||
evenFooterMarkup = \markup {
|
|
||||||
\fill-line {
|
|
||||||
\line { \if \should-print-page-number \print-pagenumber }
|
|
||||||
\line { \if \on-last-page-of-part \general-align #Y #DOWN \fractional-line-width \print-songinfo }
|
|
||||||
\line { \page-number-to-pdf-label \null }
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
@@ -1,15 +0,0 @@
|
|||||||
includeFromSong =
|
|
||||||
#(define-void-function (filename) (string?)
|
|
||||||
(let ((noDefaultOutputBackup noDefaultOutput))
|
|
||||||
(set! noDefaultOutput #t)
|
|
||||||
(ly:parser-parse-string (ly:parser-clone)
|
|
||||||
(ly:format "\\include \"~a\""
|
|
||||||
(string-append
|
|
||||||
(dirname (dirname (dirname (dirname (current-filename)))))
|
|
||||||
file-name-separator-string
|
|
||||||
"lilypond-song-includes"
|
|
||||||
file-name-separator-string
|
|
||||||
"liedbausteine"
|
|
||||||
file-name-separator-string
|
|
||||||
filename)))
|
|
||||||
(set! noDefaultOutput noDefaultOutputBackup)))
|
|
||||||
@@ -1,13 +0,0 @@
|
|||||||
INLINESCOREMUSIC = {}
|
|
||||||
|
|
||||||
inline-score =
|
|
||||||
#(define-music-function (music) (ly:music?)
|
|
||||||
(set! INLINESCOREMUSIC #{ \INLINESCOREMUSIC #music #})
|
|
||||||
#{
|
|
||||||
\transposable #TRANSPOSITION #music
|
|
||||||
#})
|
|
||||||
|
|
||||||
fill-midi =
|
|
||||||
#(define-void-function (music) (ly:music?)
|
|
||||||
(set! INLINESCOREMUSIC #{ \INLINESCOREMUSIC #music #})
|
|
||||||
)
|
|
||||||
@@ -1,16 +0,0 @@
|
|||||||
% We have to record the tag groups for markup, so we use the right tag groups during markup interpretiton.
|
|
||||||
recordedTagGroups = #'()
|
|
||||||
|
|
||||||
tagGroup =
|
|
||||||
#(define-void-function (tags) (symbol-list?)
|
|
||||||
(let ((err (define-tag-group tags)))
|
|
||||||
(if err (ly:parser-error err (*location*))
|
|
||||||
(set! recordedTagGroups (cons tags recordedTagGroups)))))
|
|
||||||
|
|
||||||
#(define-markup-command (handle-tag-groups layout props recorded-groups m) (list? markup?)
|
|
||||||
(resetTagGroups)
|
|
||||||
(for-each
|
|
||||||
(lambda (group)
|
|
||||||
(define-tag-group group))
|
|
||||||
recorded-groups)
|
|
||||||
(interpret-markup layout props m))
|
|
||||||
@@ -1,86 +0,0 @@
|
|||||||
Better_Merge_rests_engraver =
|
|
||||||
#(lambda (context)
|
|
||||||
(define (has-one-or-less? lst) (or (null? lst) (null? (cdr lst))))
|
|
||||||
(define (has-at-least-two? lst) (not (has-one-or-less? lst)))
|
|
||||||
(define (all-equal? lst pred)
|
|
||||||
(or (has-one-or-less? lst)
|
|
||||||
(and (pred (car lst) (cadr lst)) (all-equal? (cdr lst) pred))))
|
|
||||||
(define (measure-count-eqv? a b)
|
|
||||||
(eqv?
|
|
||||||
(ly:grob-property a 'measure-count)
|
|
||||||
(ly:grob-property b 'measure-count)))
|
|
||||||
|
|
||||||
(define (rests-all-unpitched? rests)
|
|
||||||
"Returns true when all rests do not override the staff-position grob
|
|
||||||
property. When a rest has a position set we do not want to merge rests at
|
|
||||||
that position."
|
|
||||||
(every (lambda (rest) (null? (ly:grob-property rest 'staff-position))) rests))
|
|
||||||
|
|
||||||
(define (less-by-layer a b)
|
|
||||||
(<
|
|
||||||
(ly:grob-property b 'layer 0)
|
|
||||||
(ly:grob-property a 'layer 0)))
|
|
||||||
|
|
||||||
(define (merge-mmrests mmrests)
|
|
||||||
"Move all multimeasure rests to the single voice location."
|
|
||||||
(if (all-equal? mmrests measure-count-eqv?)
|
|
||||||
(begin
|
|
||||||
(for-each
|
|
||||||
(lambda (rest) (ly:grob-set-property! rest 'direction CENTER))
|
|
||||||
mmrests)
|
|
||||||
(for-each
|
|
||||||
(lambda (rest) (ly:grob-set-property! rest 'transparent #t))
|
|
||||||
(cdr (sort mmrests less-by-layer))))))
|
|
||||||
|
|
||||||
(define (merge-rests rests)
|
|
||||||
(for-each
|
|
||||||
(lambda (rest) (ly:grob-set-property! rest 'staff-position 0))
|
|
||||||
rests)
|
|
||||||
(for-each
|
|
||||||
(lambda (rest) (ly:grob-set-property! rest 'transparent #t))
|
|
||||||
(cdr (sort rests less-by-layer))))
|
|
||||||
|
|
||||||
(let ((mmrests '())
|
|
||||||
(rests '())
|
|
||||||
(dots '()))
|
|
||||||
(make-engraver
|
|
||||||
((start-translation-timestep translator)
|
|
||||||
(set! rests '())
|
|
||||||
(set! mmrests '())
|
|
||||||
(set! dots '()))
|
|
||||||
(acknowledgers
|
|
||||||
((dot-column-interface engraver grob source-engraver)
|
|
||||||
(if (not (ly:context-property context 'suspendRestMerging #f))
|
|
||||||
(set!
|
|
||||||
dots
|
|
||||||
(append (ly:grob-array->list (ly:grob-object grob 'dots))
|
|
||||||
dots))))
|
|
||||||
((rest-interface engraver grob source-engraver)
|
|
||||||
(cond
|
|
||||||
((ly:context-property context 'suspendRestMerging #f)
|
|
||||||
#f)
|
|
||||||
((grob::has-interface grob 'multi-measure-rest-interface)
|
|
||||||
(set! mmrests (cons grob mmrests)))
|
|
||||||
(else
|
|
||||||
(set! rests (cons grob rests))))))
|
|
||||||
((stop-translation-timestep translator)
|
|
||||||
(let (;; get a list of the rests 'duration-lengths, 'duration-log does
|
|
||||||
;; not take dots into account
|
|
||||||
(durs
|
|
||||||
(map
|
|
||||||
(lambda (g)
|
|
||||||
(ly:duration->moment
|
|
||||||
(ly:prob-property
|
|
||||||
(ly:grob-property g 'cause)
|
|
||||||
'duration)))
|
|
||||||
rests)))
|
|
||||||
(if (and
|
|
||||||
(has-at-least-two? rests)
|
|
||||||
(all-equal? durs equal?)
|
|
||||||
(rests-all-unpitched? rests))
|
|
||||||
(begin
|
|
||||||
(merge-rests rests)
|
|
||||||
;; ly:grob-suicide! works nicely for dots, as opposed to rests.
|
|
||||||
(if (pair? dots) (for-each ly:grob-suicide! (cdr dots)))))
|
|
||||||
(if (has-at-least-two? mmrests)
|
|
||||||
(merge-mmrests mmrests)))))))
|
|
||||||
@@ -1,22 +0,0 @@
|
|||||||
(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)
|
|
||||||
)
|
|
||||||
@@ -1,259 +0,0 @@
|
|||||||
(use-modules (ice-9 rdelim) (ice-9 regex) (ice-9 receive) (srfi srfi-1))
|
|
||||||
|
|
||||||
;; YAML-Parser: liest eine Teilmenge von YAML (Block-Syntax, keine
|
|
||||||
;; Flow-Collections, keine Block-Skalare) in verschachtelte
|
|
||||||
;; alist/list-Strukturen. Gegenstück zu yaml_writer.scm.
|
|
||||||
;;
|
|
||||||
;; Ergebnisformat:
|
|
||||||
;; - Mapping -> alist mit String-Keys, Reihenfolge wie in der Datei
|
|
||||||
;; - Liste -> Liste (auch als "- key: value"-Inline-Mappings)
|
|
||||||
;; - Skalare -> String, Zahl, #t/#f, '() (null / {} / [])
|
|
||||||
;;
|
|
||||||
;; Skalar-Interpretation:
|
|
||||||
;; - unquoted und 'single-quoted' Werte werden interpretiert
|
|
||||||
;; (Zahl, true/false/null). Das Interpretieren von single-quoted
|
|
||||||
;; Werten ist Kompatibilitätsverhalten zum alten Parser:
|
|
||||||
;; authors.yml notiert Zahlen als '1898'.
|
|
||||||
;; - "double-quoted" Werte bleiben immer Strings; \\, \" und \n
|
|
||||||
;; werden entescaped (so schreibt sie der yaml_writer).
|
|
||||||
;; - Kommentare (#) werden nur außerhalb von Quotes entfernt und nur,
|
|
||||||
;; wenn ihnen ein Leerzeichen oder der Zeilenanfang vorausgeht.
|
|
||||||
|
|
||||||
(define (yml-file->scm filename)
|
|
||||||
|
|
||||||
;; --- Zeilen einlesen ------------------------------------------------
|
|
||||||
|
|
||||||
;; Anzahl führender Leerzeichen
|
|
||||||
(define (line-indent line)
|
|
||||||
(let loop ((i 0))
|
|
||||||
(if (and (< i (string-length line))
|
|
||||||
(char=? (string-ref line i) #\space))
|
|
||||||
(loop (+ i 1))
|
|
||||||
i)))
|
|
||||||
|
|
||||||
;; Liefert Items (indent . inhalt); Leerzeilen, reine Kommentarzeilen
|
|
||||||
;; und Dokumentmarker (--- / ...) werden übersprungen.
|
|
||||||
(define (read-items filename)
|
|
||||||
(call-with-input-file filename
|
|
||||||
(lambda (port)
|
|
||||||
(let loop ((items '()))
|
|
||||||
(let ((line (read-line port)))
|
|
||||||
(if (eof-object? line)
|
|
||||||
(reverse items)
|
|
||||||
(let* ((line (if (string-suffix? "\r" line)
|
|
||||||
(string-drop-right line 1)
|
|
||||||
line))
|
|
||||||
(content (string-trim-both line)))
|
|
||||||
(if (or (string-null? content)
|
|
||||||
(string-prefix? "#" content)
|
|
||||||
(string=? content "---")
|
|
||||||
(string=? content "..."))
|
|
||||||
(loop items)
|
|
||||||
(loop (cons (cons (line-indent line) content)
|
|
||||||
items))))))))))
|
|
||||||
|
|
||||||
(define (item-indent item) (car item))
|
|
||||||
(define (item-content item) (cdr item))
|
|
||||||
|
|
||||||
;; --- Skalare ----------------------------------------------------------
|
|
||||||
|
|
||||||
;; Position des schließenden Double-Quotes ab start (oder #f);
|
|
||||||
;; Backslash escaped das Folgezeichen.
|
|
||||||
(define (closing-double-quote s start)
|
|
||||||
(let loop ((i start))
|
|
||||||
(cond ((>= i (string-length s)) #f)
|
|
||||||
((char=? (string-ref s i) #\\) (loop (+ i 2)))
|
|
||||||
((char=? (string-ref s i) #\") i)
|
|
||||||
(else (loop (+ i 1))))))
|
|
||||||
|
|
||||||
;; Position des schließenden Single-Quotes ab start (oder #f);
|
|
||||||
;; '' ist ein escaptes Quote.
|
|
||||||
(define (closing-single-quote s start)
|
|
||||||
(let loop ((i start))
|
|
||||||
(cond ((>= i (string-length s)) #f)
|
|
||||||
((char=? (string-ref s i) #\')
|
|
||||||
(if (and (< (+ i 1) (string-length s))
|
|
||||||
(char=? (string-ref s (+ i 1)) #\'))
|
|
||||||
(loop (+ i 2))
|
|
||||||
i))
|
|
||||||
(else (loop (+ i 1))))))
|
|
||||||
|
|
||||||
;; \\ -> \, \" -> ", \n -> Zeilenumbruch
|
|
||||||
(define (unescape-double s)
|
|
||||||
(let loop ((chars (string->list s)) (acc '()))
|
|
||||||
(cond ((null? chars) (list->string (reverse acc)))
|
|
||||||
((and (char=? (car chars) #\\) (pair? (cdr chars)))
|
|
||||||
(loop (cddr chars)
|
|
||||||
(cons (if (char=? (cadr chars) #\n)
|
|
||||||
#\newline
|
|
||||||
(cadr chars))
|
|
||||||
acc)))
|
|
||||||
(else (loop (cdr chars) (cons (car chars) acc))))))
|
|
||||||
|
|
||||||
;; '' -> '
|
|
||||||
(define (unescape-single s)
|
|
||||||
(regexp-substitute/global #f "''" s 'pre "'" 'post))
|
|
||||||
|
|
||||||
;; Kommentar in einem unquoted Wert entfernen:
|
|
||||||
;; # zählt nur am Anfang oder nach Leerzeichen
|
|
||||||
(define (strip-plain-comment s)
|
|
||||||
(let loop ((i 0))
|
|
||||||
(cond ((>= i (string-length s)) s)
|
|
||||||
((and (char=? (string-ref s i) #\#)
|
|
||||||
(or (zero? i)
|
|
||||||
(char-whitespace? (string-ref s (- i 1)))))
|
|
||||||
(string-take s i))
|
|
||||||
(else (loop (+ i 1))))))
|
|
||||||
|
|
||||||
;; Unquoted/single-quoted Werte interpretieren
|
|
||||||
(define (interpret-plain s)
|
|
||||||
(cond
|
|
||||||
((member s '("{}" "[]" "null")) '())
|
|
||||||
((string=? s "true") #t)
|
|
||||||
((string=? s "false") #f)
|
|
||||||
((string-match "^-?[0-9]+(\\.[0-9]+)?$" s) (string->number s))
|
|
||||||
(else s)))
|
|
||||||
|
|
||||||
;; Skalar parsen; Rest hinter einem schließenden Quote wird ignoriert
|
|
||||||
;; (darf nur ein Kommentar sein)
|
|
||||||
(define (parse-scalar str)
|
|
||||||
(let ((s (string-trim-both str)))
|
|
||||||
(cond
|
|
||||||
((string-null? s) "")
|
|
||||||
((char=? (string-ref s 0) #\")
|
|
||||||
(let ((end (closing-double-quote s 1)))
|
|
||||||
(if end
|
|
||||||
(unescape-double (substring s 1 end))
|
|
||||||
(string-trim-right (strip-plain-comment s)))))
|
|
||||||
((char=? (string-ref s 0) #\')
|
|
||||||
(let ((end (closing-single-quote s 1)))
|
|
||||||
(if end
|
|
||||||
(interpret-plain (unescape-single (substring s 1 end)))
|
|
||||||
(string-trim-right (strip-plain-comment s)))))
|
|
||||||
(else
|
|
||||||
(interpret-plain (string-trim-right (strip-plain-comment s)))))))
|
|
||||||
|
|
||||||
;; --- Struktur ----------------------------------------------------------
|
|
||||||
|
|
||||||
;; Erste Key-Trennstelle: ":" am Zeilenende oder gefolgt von Leerzeichen.
|
|
||||||
;; Beginnt die Zeile mit einem gequoteten Key (oder Skalar), zaehlt ein
|
|
||||||
;; ":" innerhalb der Quotes nicht als Trennstelle.
|
|
||||||
(define (key-split-index s)
|
|
||||||
(let ((start (if (string-null? s)
|
|
||||||
0
|
|
||||||
(case (string-ref s 0)
|
|
||||||
((#\") (let ((end (closing-double-quote s 1)))
|
|
||||||
(if end (+ end 1) 0)))
|
|
||||||
((#\') (let ((end (closing-single-quote s 1)))
|
|
||||||
(if end (+ end 1) 0)))
|
|
||||||
(else 0)))))
|
|
||||||
(let loop ((i start))
|
|
||||||
(cond ((>= i (string-length s)) #f)
|
|
||||||
((and (char=? (string-ref s i) #\:)
|
|
||||||
(or (= i (- (string-length s) 1))
|
|
||||||
(char=? (string-ref s (+ i 1)) #\space)))
|
|
||||||
i)
|
|
||||||
(else (loop (+ i 1)))))))
|
|
||||||
|
|
||||||
;; Key interpretieren: gequotete Keys werden entquotet (Strings bleiben
|
|
||||||
;; Strings), unquoted Keys bleiben unveraendert
|
|
||||||
(define (parse-key s)
|
|
||||||
(let ((k (string-trim-both s)))
|
|
||||||
(cond
|
|
||||||
((string-null? k) k)
|
|
||||||
((char=? (string-ref k 0) #\")
|
|
||||||
(let ((end (closing-double-quote k 1)))
|
|
||||||
(if end (unescape-double (substring k 1 end)) k)))
|
|
||||||
((char=? (string-ref k 0) #\')
|
|
||||||
(let ((end (closing-single-quote k 1)))
|
|
||||||
(if end (unescape-single (substring k 1 end)) k)))
|
|
||||||
(else k))))
|
|
||||||
|
|
||||||
(define (dash-line? content)
|
|
||||||
(or (string=? content "-") (string-prefix? "- " content)))
|
|
||||||
|
|
||||||
;; Wert-String hinter "key:" bzw. "-": reiner Kommentar zählt als leer
|
|
||||||
(define (effective-value str)
|
|
||||||
(let ((s (string-trim-both str)))
|
|
||||||
(if (string-prefix? "#" s) "" s)))
|
|
||||||
|
|
||||||
;; Einen Block von Items parsen; das erste Item bestimmt die Blockart
|
|
||||||
(define (parse-block items)
|
|
||||||
(cond
|
|
||||||
((null? items) '())
|
|
||||||
((dash-line? (item-content (car items))) (parse-list items))
|
|
||||||
;; einzelne Zeile ohne Key: Skalar (z.B. eine Datei, die nur {} enthält)
|
|
||||||
((and (null? (cdr items))
|
|
||||||
(not (key-split-index (item-content (car items)))))
|
|
||||||
(parse-scalar (item-content (car items))))
|
|
||||||
(else (parse-map items))))
|
|
||||||
|
|
||||||
;; Mapping: alle Items auf map-indent sind Keys, tiefer eingerückte
|
|
||||||
;; Items gehören zum jeweils vorangehenden Key
|
|
||||||
(define (parse-map items)
|
|
||||||
(let ((map-indent (item-indent (car items))))
|
|
||||||
(let loop ((items items) (result '()))
|
|
||||||
(if (null? items)
|
|
||||||
(reverse result)
|
|
||||||
(let* ((content (item-content (car items)))
|
|
||||||
(split (key-split-index content)))
|
|
||||||
(if (not split)
|
|
||||||
(begin
|
|
||||||
(format (current-error-port)
|
|
||||||
"YAML-Syntaxfehler: Ungültige Zeile: ~a\n" content)
|
|
||||||
(loop (cdr items) result))
|
|
||||||
(let ((key (parse-key (string-take content split)))
|
|
||||||
(value-str (effective-value
|
|
||||||
(string-drop content (+ split 1)))))
|
|
||||||
(if (string-null? value-str)
|
|
||||||
;; Wert steht im eingerückten Block darunter
|
|
||||||
(receive (children rest)
|
|
||||||
(span (lambda (it) (> (item-indent it) map-indent))
|
|
||||||
(cdr items))
|
|
||||||
(loop rest
|
|
||||||
(cons (cons key (parse-block children))
|
|
||||||
result)))
|
|
||||||
(loop (cdr items)
|
|
||||||
(cons (cons key (parse-scalar value-str))
|
|
||||||
result))))))))))
|
|
||||||
|
|
||||||
;; Liste: "- wert", "- key: value" (Inline-Mapping) oder "-" mit
|
|
||||||
;; eingerücktem Block darunter
|
|
||||||
(define (parse-list items)
|
|
||||||
(let ((list-indent (item-indent (car items))))
|
|
||||||
(let loop ((items items) (result '()))
|
|
||||||
(if (null? items)
|
|
||||||
(reverse result)
|
|
||||||
(let ((content (item-content (car items))))
|
|
||||||
(if (not (dash-line? content))
|
|
||||||
(begin
|
|
||||||
(format (current-error-port)
|
|
||||||
"YAML-Syntaxfehler: Ungültiges Listenelement: ~a\n"
|
|
||||||
content)
|
|
||||||
(loop (cdr items) result))
|
|
||||||
(receive (children rest)
|
|
||||||
(span (lambda (it) (> (item-indent it) list-indent))
|
|
||||||
(cdr items))
|
|
||||||
(let* ((after-dash (string-drop content 1))
|
|
||||||
(inline (effective-value after-dash)))
|
|
||||||
(cond
|
|
||||||
((and (string-null? inline) (null? children))
|
|
||||||
(loop rest (cons '() result)))
|
|
||||||
((string-null? inline)
|
|
||||||
(loop rest (cons (parse-block children) result)))
|
|
||||||
(else
|
|
||||||
;; Inline-Inhalt: als synthetisches Item mit der
|
|
||||||
;; Spalte des Inhalts vor die Kinder stellen, so
|
|
||||||
;; funktioniert auch "- key: value" mit weiteren
|
|
||||||
;; Keys auf den Folgezeilen
|
|
||||||
(let* ((offset (- (string-length content)
|
|
||||||
(string-length
|
|
||||||
(string-trim after-dash))))
|
|
||||||
(synth (cons (+ list-indent offset) inline)))
|
|
||||||
(loop rest
|
|
||||||
(cons (parse-block (cons synth children))
|
|
||||||
result)))))))))))))
|
|
||||||
|
|
||||||
(parse-block (read-items filename)))
|
|
||||||
|
|
||||||
(define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename)))
|
|
||||||
@@ -1,162 +0,0 @@
|
|||||||
(use-modules (ice-9 regex) (srfi srfi-1))
|
|
||||||
|
|
||||||
;; YAML-Writer: Gegenstück zu yaml_parser.scm.
|
|
||||||
;; Schreibt verschachtelte alist/list-Strukturen als YAML, so dass
|
|
||||||
;; yml-file->scm sie wieder einlesen kann.
|
|
||||||
;;
|
|
||||||
;; Datenmodell (wie vom Parser erzeugt):
|
|
||||||
;; - Mapping: Liste von Paaren (key . value), key als String oder Symbol
|
|
||||||
;; - Liste: Liste von beliebigen Werten
|
|
||||||
;; - Skalare: String, Zahl, #t/#f, '() (leer/null, wird als [] geschrieben)
|
|
||||||
;;
|
|
||||||
;; Andere Werte werden vorab automatisch umgewandelt: Markups zu Strings,
|
|
||||||
;; alles Unbekannte über ~a formatiert (siehe yml-sanitize).
|
|
||||||
|
|
||||||
;; Steuert, ob layout_bottom.ily die Header-Daten des Liedes als
|
|
||||||
;; YAML-Datei exportiert; aktivierbar per (set! yaml-export-enabled #t)
|
|
||||||
;; oder durch Definieren der Variable vor dem Laden der Includes.
|
|
||||||
(define yaml-export-enabled
|
|
||||||
(if (defined? 'yaml-export-enabled) yaml-export-enabled #f))
|
|
||||||
|
|
||||||
;; Beliebige Werte in YAML-taugliche Daten umwandeln.
|
|
||||||
;; (Benötigt die LilyPond-Umgebung für markup? und markup->string.)
|
|
||||||
(define (yml-sanitize v)
|
|
||||||
(cond
|
|
||||||
((or (string? v) (number? v) (boolean? v) (symbol? v) (null? v)) v)
|
|
||||||
((markup? v) (markup->string v))
|
|
||||||
((list? v) (map yml-sanitize v))
|
|
||||||
((pair? v) (cons (yml-sanitize (car v)) (yml-sanitize (cdr v))))
|
|
||||||
(else (format #f "~a" v))))
|
|
||||||
|
|
||||||
(define (scm->yml-string data)
|
|
||||||
|
|
||||||
;; Ist data ein Mapping (alist)? Nicht-leere Liste, deren Elemente
|
|
||||||
;; alle Paare mit String- oder Symbol-Key sind.
|
|
||||||
;; Achtung: eine Liste von Listen, deren erste Elemente Strings sind,
|
|
||||||
;; ist davon nicht unterscheidbar und wird als Mapping interpretiert.
|
|
||||||
(define (mapping? data)
|
|
||||||
(and (pair? data)
|
|
||||||
(list? data)
|
|
||||||
(every (lambda (entry)
|
|
||||||
(and (pair? entry)
|
|
||||||
(or (string? (car entry))
|
|
||||||
(symbol? (car entry)))))
|
|
||||||
data)))
|
|
||||||
|
|
||||||
(define (scalar? v)
|
|
||||||
(or (string? v) (symbol? v) (number? v) (boolean? v) (null? v)))
|
|
||||||
|
|
||||||
(define (key->string k)
|
|
||||||
(if (symbol? k) (symbol->string k) k))
|
|
||||||
|
|
||||||
;; Muss der String gequotet werden, damit er beim Einlesen wieder
|
|
||||||
;; als derselbe String erkannt wird?
|
|
||||||
(define (needs-quotes? s)
|
|
||||||
(or (string-null? s)
|
|
||||||
(member s '("true" "false" "null" "{}" "[]"))
|
|
||||||
(string->number s) ;; zahlartig ("1981", "1.", "-5") würde zur Zahl
|
|
||||||
(string-index s #\#) ;; würde als Kommentar abgeschnitten
|
|
||||||
(string-index s #\:) ;; würde als Key: Value gelesen
|
|
||||||
(string-index s #\newline) ;; mehrzeilig
|
|
||||||
(string-index s #\")
|
|
||||||
(string-prefix? "-" s) ;; würde als Listenelement gelesen
|
|
||||||
(string-prefix? "'" s)
|
|
||||||
(not (string=? s (string-trim-both s))))) ;; führende/folgende Leerzeichen
|
|
||||||
|
|
||||||
;; Doppelt gequoteter YAML-String; Backslash, Anführungszeichen und
|
|
||||||
;; Zeilenumbrüche werden escaped, damit alles auf einer Zeile bleibt.
|
|
||||||
(define (quote-string s)
|
|
||||||
(string-append
|
|
||||||
"\""
|
|
||||||
(string-concatenate
|
|
||||||
(map (lambda (c)
|
|
||||||
(cond
|
|
||||||
((char=? c #\\) "\\\\")
|
|
||||||
((char=? c #\") "\\\"")
|
|
||||||
((char=? c #\newline) "\\n")
|
|
||||||
(else (string c))))
|
|
||||||
(string->list s)))
|
|
||||||
"\""))
|
|
||||||
|
|
||||||
(define (scalar->string v)
|
|
||||||
(cond
|
|
||||||
((eq? v #t) "true")
|
|
||||||
((eq? v #f) "false")
|
|
||||||
((null? v) "[]")
|
|
||||||
((number? v) (number->string v))
|
|
||||||
((symbol? v) (scalar->string (symbol->string v)))
|
|
||||||
((string? v) (if (needs-quotes? v) (quote-string v) v))
|
|
||||||
(else (error "scm->yml-string: nicht unterstützter Wert" v))))
|
|
||||||
|
|
||||||
(define (indent-string n) (make-string n #\space))
|
|
||||||
|
|
||||||
;; Key ggf. quoten (leere oder zahlartige Keys, Sonderzeichen)
|
|
||||||
(define (key->yml-string k)
|
|
||||||
(let ((s (key->string k)))
|
|
||||||
(if (needs-quotes? s) (quote-string s) s)))
|
|
||||||
|
|
||||||
;; Doppelte Keys sind in YAML nicht erlaubt: Werte gleicher Keys werden
|
|
||||||
;; zu einer Liste zusammengefasst, z.B. authors mit (voice 2) (voice 3)
|
|
||||||
;; -> voice: [2, 3].
|
|
||||||
(define (merge-duplicate-keys data)
|
|
||||||
(define (value->list v)
|
|
||||||
(if (and (list? v) (not (mapping? v))) v (list v)))
|
|
||||||
(let loop ((entries data) (result '()))
|
|
||||||
(if (null? entries)
|
|
||||||
(reverse result)
|
|
||||||
(let* ((entry (car entries))
|
|
||||||
(existing (find (lambda (e) (equal? (car e) (car entry)))
|
|
||||||
result)))
|
|
||||||
(if existing
|
|
||||||
(begin
|
|
||||||
(set-cdr! existing (append (value->list (cdr existing))
|
|
||||||
(value->list (cdr entry))))
|
|
||||||
(loop (cdr entries) result))
|
|
||||||
(loop (cdr entries)
|
|
||||||
(cons (cons (car entry) (cdr entry)) result)))))))
|
|
||||||
|
|
||||||
;; Mapping schreiben: "key: skalar" oder "key:" mit eingerücktem Inhalt
|
|
||||||
(define (write-mapping data indent port)
|
|
||||||
(for-each
|
|
||||||
(lambda (entry)
|
|
||||||
(let ((key (key->yml-string (car entry)))
|
|
||||||
(value (cdr entry)))
|
|
||||||
(if (scalar? value)
|
|
||||||
(format port "~a~a: ~a\n"
|
|
||||||
(indent-string indent) key (scalar->string value))
|
|
||||||
(begin
|
|
||||||
(format port "~a~a:\n" (indent-string indent) key)
|
|
||||||
(write-node value (+ indent 2) port)))))
|
|
||||||
(merge-duplicate-keys data)))
|
|
||||||
|
|
||||||
;; Liste schreiben: "- skalar" oder "-" mit eingerücktem Inhalt
|
|
||||||
;; (Verschachtelter Inhalt darf NICHT auf der "-"-Zeile beginnen,
|
|
||||||
;; weil parse-list den Inhalt der "-"-Zeile verwirft, sobald
|
|
||||||
;; eingerückte Folgezeilen existieren.)
|
|
||||||
(define (write-list data indent port)
|
|
||||||
(for-each
|
|
||||||
(lambda (item)
|
|
||||||
(if (scalar? item)
|
|
||||||
(format port "~a- ~a\n"
|
|
||||||
(indent-string indent) (scalar->string item))
|
|
||||||
(begin
|
|
||||||
(format port "~a-\n" (indent-string indent))
|
|
||||||
(write-node item (+ indent 2) port))))
|
|
||||||
data))
|
|
||||||
|
|
||||||
(define (write-node data indent port)
|
|
||||||
(cond
|
|
||||||
((mapping? data) (write-mapping data indent port))
|
|
||||||
((and (list? data) (not (null? data))) (write-list data indent port))
|
|
||||||
(else (format port "~a~a\n" (indent-string indent) (scalar->string data)))))
|
|
||||||
|
|
||||||
(call-with-output-string
|
|
||||||
(lambda (port) (write-node (yml-sanitize data) 0 port))))
|
|
||||||
|
|
||||||
;; Daten als YAML-Datei schreiben
|
|
||||||
(define (scm->yml-file filename data)
|
|
||||||
(call-with-output-file filename
|
|
||||||
(lambda (port)
|
|
||||||
(display "---\n" port)
|
|
||||||
(display (scm->yml-string data) port))))
|
|
||||||
|
|
||||||
@@ -1,121 +0,0 @@
|
|||||||
swing = \textMark \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 Stem.length = #4.5
|
|
||||||
\tuplet 3/2 { h'4 h8 }
|
|
||||||
}
|
|
||||||
\layout {
|
|
||||||
ragged-right= ##t
|
|
||||||
indent = 0
|
|
||||||
\context {
|
|
||||||
\Staff
|
|
||||||
\remove "Clef_engraver"
|
|
||||||
\remove "Time_signature_engraver"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
swingOff = \textMark \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 (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
|
|
||||||
#})
|
|
||||||
@@ -1,90 +0,0 @@
|
|||||||
#(define-markup-command (bookTitleMarkupCustom layout props)()
|
|
||||||
(interpret-markup layout props
|
|
||||||
(make-column-markup
|
|
||||||
(list
|
|
||||||
(make-vspace-markup (chain-assoc-get 'header:titletopspace props 0))
|
|
||||||
(make-customEps-markup (chain-assoc-get 'header:titlesize props 3.5) "titel.eps")
|
|
||||||
))
|
|
||||||
))
|
|
||||||
|
|
||||||
#(define-markup-command (category-image layout props size category)(number? string?)
|
|
||||||
(interpret-markup layout props
|
|
||||||
(if noStandaloneOutput
|
|
||||||
(make-epsfileref-markup Y size
|
|
||||||
(category-image-path category))
|
|
||||||
(make-epsfile-markup Y size
|
|
||||||
(category-image-path category)))))
|
|
||||||
|
|
||||||
#(define showCategoryImages (if (defined? 'showCategoryImages) showCategoryImages #t))
|
|
||||||
|
|
||||||
#(define-markup-command (category-images layout props)()
|
|
||||||
(interpret-markup layout props
|
|
||||||
(if showCategoryImages
|
|
||||||
(make-line-markup (map (lambda (category) (make-category-image-markup 5 category))
|
|
||||||
(string-tokenize (chain-assoc-get 'header:categories props ""))))
|
|
||||||
(make-null-markup))))
|
|
||||||
|
|
||||||
#(define pdf-encode (@@ (lily framework-ps) pdf-encode))
|
|
||||||
% PDF tags
|
|
||||||
% Erzeugt ein PDF-Lesezeichen (Outline-Eintrag) auf der aktuellen Seite.
|
|
||||||
% count = Anzahl der direkten Unterpunkte, die (in Seitenreihenfolge) direkt
|
|
||||||
% nachfolgen. 0 = Blatt-Eintrag (kein /Count), >0 = aufgeklappt,
|
|
||||||
% <0 = zugeklappt (Betrag = Anzahl direkter Kinder).
|
|
||||||
#(define (make-pdf-toc-stencil title count)
|
|
||||||
(if (string-null? title)
|
|
||||||
empty-stencil
|
|
||||||
(ly:make-stencil
|
|
||||||
(list 'embedded-ps
|
|
||||||
(ly:format
|
|
||||||
"[~a/Action /GoTo /View [/XYZ -4 currentpagedevice /PageSize get 1 get 4 add null] /Title (~a) /OUT pdfmark"
|
|
||||||
(if (= count 0) "" (ly:format "/Count ~a " count))
|
|
||||||
(pdf-encode title)))
|
|
||||||
empty-interval empty-interval
|
|
||||||
;'(0 . 0) '(0 . 0)
|
|
||||||
)))
|
|
||||||
|
|
||||||
% Einzelner (Blatt-)Eintrag im PDF-Inhaltsverzeichnis.
|
|
||||||
#(define-markup-command (title-to-pdf-toc layout props title) (string?)
|
|
||||||
(make-pdf-toc-stencil title 0))
|
|
||||||
|
|
||||||
% Kapitel-Eintrag mit verschachtelten Unterpunkten.
|
|
||||||
% count = Anzahl der direkt nachfolgenden Einträge, die diesem Kapitel
|
|
||||||
% untergeordnet werden sollen (positiv = aufgeklappt, negativ = zugeklappt).
|
|
||||||
#(define-markup-command (chapter-to-pdf-toc layout props count title) (integer? string?)
|
|
||||||
(make-pdf-toc-stencil title count))
|
|
||||||
|
|
||||||
#(define-markup-command (build-full-title layout props right)(boolean?)
|
|
||||||
(interpret-markup layout (prepend-alist-chain 'songfilename (chain-assoc-get 'header:songfilename props "") props)
|
|
||||||
(let* ((title (chain-assoc-get 'header:title props ""))
|
|
||||||
(starttext (chain-assoc-get 'header:starttext props #f))
|
|
||||||
(pdfbookmark (if starttext (string-append starttext " | " title) title))
|
|
||||||
(chaptertitle (chain-assoc-get 'header:chaptertitle props #f))
|
|
||||||
(chaptercount (chain-assoc-get 'header:chaptercount props 0))
|
|
||||||
(title-markup (ly:output-def-lookup layout (if right 'oddTitleLineMarkup 'evenTitleLineMarkup))))
|
|
||||||
(if title
|
|
||||||
;; Ist dieses Lied das erste eines Kapitels, wird der Kapitel-Eintrag
|
|
||||||
;; unmittelbar vor dem Lied-Eintrag ausgegeben, damit die pdfmark-/OUT-
|
|
||||||
;; Reihenfolge (Elternteil vor Kindern) im PDF-Stream garantiert stimmt.
|
|
||||||
(if (and (string? chaptertitle) (not (string-null? chaptertitle)))
|
|
||||||
(markup #:chapter-to-pdf-toc chaptercount chaptertitle
|
|
||||||
#:title-to-pdf-toc pdfbookmark title-markup)
|
|
||||||
(markup #:title-to-pdf-toc pdfbookmark title-markup))
|
|
||||||
make-null-markup)
|
|
||||||
)))
|
|
||||||
|
|
||||||
\paper {
|
|
||||||
bookTitleMarkup = \markup \null
|
|
||||||
scoreTitleMarkup = \markup \null
|
|
||||||
oddHeaderMarkup = \markup { \if \on-first-page-of-part \build-full-title ##t }
|
|
||||||
evenHeaderMarkup = \markup { \if \on-first-page-of-part \build-full-title ##f }
|
|
||||||
oddTitleLineMarkup = \markup { \fill-line \general-align #Y #UP { \null \bookTitleMarkupCustom \category-images } }
|
|
||||||
evenTitleLineMarkup = \markup { \fill-line \general-align #Y #UP { \category-images \bookTitleMarkupCustom \null } }
|
|
||||||
defaultTitleMarkup = \markup {
|
|
||||||
\override #'(baseline-skip . 3.5)
|
|
||||||
\center-column {
|
|
||||||
\override #`(font-name . ,songTitleFont) { \fontsize #songTitleSize \fromproperty #'header:title }
|
|
||||||
\large \bold \fromproperty #'header:subtitle
|
|
||||||
\smaller \bold \fromproperty #'header:subsubtitle
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
@@ -1,27 +0,0 @@
|
|||||||
TRANSPOSITION = #(cons #f #f)
|
|
||||||
|
|
||||||
transposeGlobal =
|
|
||||||
#(define-void-function (from to) (ly:pitch? ly:pitch?)
|
|
||||||
(if (not (car TRANSPOSITION))
|
|
||||||
(set! TRANSPOSITION (cons from to))
|
|
||||||
(let ((current_to (cdr TRANSPOSITION))
|
|
||||||
(interval (ly:pitch-diff to from)))
|
|
||||||
(set! TRANSPOSITION (cons (car TRANSPOSITION)
|
|
||||||
(ly:pitch-transpose current_to interval))))))
|
|
||||||
|
|
||||||
transposable =
|
|
||||||
#(define-music-function (fromto music) (pair? ly:music?)
|
|
||||||
(if (car fromto)
|
|
||||||
#{
|
|
||||||
\transpose #(car fromto) #(cdr fromto) #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))
|
|
||||||
@@ -1,454 +0,0 @@
|
|||||||
% 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 { "
|
|
||||||
(ly:regex-replace (ly:make-regex "\r?\n") text " } \\line { ")
|
|
||||||
" \\size-box-to-box ##f ##t \"\" \"Agj\" }" )))
|
|
||||||
(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 songTextChordAlignment
|
|
||||||
((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)))))
|
|
||||||
|
|
||||||
#(define-markup-command (chord-alignment-style-dependent layout props chord-with-text) (markup?)
|
|
||||||
(interpret-markup layout props
|
|
||||||
(case songTextChordAlignment
|
|
||||||
((center) (make-center-align-markup chord-with-text))
|
|
||||||
((left) (make-left-align-markup chord-with-text)))))
|
|
||||||
|
|
||||||
% Text über Text mittig darstellen
|
|
||||||
#(define-markup-command (textup layout props text uptext) (markup? markup?)
|
|
||||||
#:properties ((verselayout generalLayout)
|
|
||||||
(verse-text-chord-distance songTextChordDistance))
|
|
||||||
"Markup über Text mittig darstellen."
|
|
||||||
(interpret-markup layout props
|
|
||||||
#{\markup {
|
|
||||||
\size-box-to-box-style-dependent ##t ##f
|
|
||||||
\general-align #X #LEFT \override #`(direction . ,UP) \override #'(baseline-skip . 1) \dir-column \chord-alignment-style-dependent {
|
|
||||||
\pad-to-box #'(0 . 0) #`(0 . ,(- verse-text-chord-distance 0.8)) { #text }
|
|
||||||
\size-box-to-box ##f ##t #uptext \score { \chords { g4:m a } \layout { $verselayout #(customized-layout verselayout) } }
|
|
||||||
}
|
|
||||||
#text
|
|
||||||
}
|
|
||||||
#}
|
|
||||||
))
|
|
||||||
|
|
||||||
#(define-markup-command (anchor-x-between layout props arga argb)
|
|
||||||
(markup? markup?)
|
|
||||||
(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) (string-or-music?)
|
|
||||||
#:properties ((verselayout generalLayout))
|
|
||||||
(interpret-markup layout props
|
|
||||||
(if (and (string? arg) (string-null? arg))
|
|
||||||
" "
|
|
||||||
#{\markup
|
|
||||||
\score { \new Lyrics { \lyricmode { #(if (ly:music? arg) arg #{ \set stanza = #arg #}) "" } } \layout { $verselayout #(customized-layout verselayout) } }
|
|
||||||
#}
|
|
||||||
)))
|
|
||||||
|
|
||||||
#(define-markup-command (stanza layout props arg)
|
|
||||||
(string-or-music?)
|
|
||||||
(interpret-markup layout props
|
|
||||||
(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
|
|
||||||
#(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"
|
|
||||||
(let ((transp (if (car transposition)
|
|
||||||
(string-append "\\transpose " (symbol->string (note-name->lily-string (car transposition))) " " (symbol->string (note-name->lily-string (cdr transposition))))
|
|
||||||
"")))
|
|
||||||
(interpret-markup layout props
|
|
||||||
(markup #:override `(baseline-skip . ,(+ intraverse-vspace songTextLineHeigth)) #:anchor-x-between #:stanza stanza
|
|
||||||
(make-wrap-newline-markup
|
|
||||||
(ly:regex-replace (ly:make-regex "\\(( *)([^,()]*)( *),([^)]*)\\)")
|
|
||||||
(ly:regex-replace (ly:make-regex "(([^ \n]*\\([^()]*,[^()]+\\)[^ \n(]*)+)") (handle-custom-newlines custom-verse-breaks verse) " \\concat { " 1 " } ")
|
|
||||||
"\\textup \\line { \"" 1 "\" " 2 " \"" 3 "\" } \\score { " transp " \\chords { s4 " 4 " } \\layout { $verselayout #(customized-layout verselayout) } }")
|
|
||||||
)
|
|
||||||
))))
|
|
||||||
|
|
||||||
% Kompletter Vers aus dem Akkorde entfernt werden
|
|
||||||
#(define-markup-command (nochordverse layout props stanza verse) (string-or-music? string?)
|
|
||||||
#:properties ((intraverse-vspace 0)(custom-verse-breaks '()))
|
|
||||||
"Vers ohne Akkorde"
|
|
||||||
(interpret-markup layout props
|
|
||||||
(markup #:override `(baseline-skip . ,(+ intraverse-vspace 3.0)) #:anchor-x-between #:stanza stanza
|
|
||||||
#:wrap-newline (ly:regex-replace (ly:make-regex "\\(([^,]*),([^)]*)\\)") (handle-custom-newlines custom-verse-breaks verse) 1)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
|
|
||||||
#(define-markup-command (verseformat layout props verse) (markup?)
|
|
||||||
#:properties ((verselayout generalLayout))
|
|
||||||
"Textformatierung für Strophen"
|
|
||||||
(interpret-markup layout props
|
|
||||||
(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)))
|
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
|
|
||||||
#(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"
|
|
||||||
(define (add-markup-between-elements reverses markup-between elements)
|
|
||||||
((if reverses fold fold-right) (lambda (element filled-list)
|
|
||||||
(cons element (if (null? filled-list) '() (cons markup-between filled-list))))
|
|
||||||
'() elements))
|
|
||||||
;; Dokumentposition fuer den ChordPro-/Data-Collector: jede Gruppe nimmt
|
|
||||||
;; sich eine Sequenznummer, jeder Vers traegt seine Position innerhalb
|
|
||||||
;; der Gruppe in den Props -- die Spalten-Verteilung unten verschraenkt
|
|
||||||
;; sonst die Interpretationsreihenfolge.
|
|
||||||
(set! chordpro-doc-seq-counter (1+ chordpro-doc-seq-counter))
|
|
||||||
(let* ((doc-seq chordpro-doc-seq-counter)
|
|
||||||
(versegroup (index-map
|
|
||||||
(lambda (index item)
|
|
||||||
(make-override-markup
|
|
||||||
(cons 'chordpro-doc-order (cons doc-seq index))
|
|
||||||
item))
|
|
||||||
versegroup))
|
|
||||||
(column-item-count (ceiling (/ (length versegroup) verse-cols)))
|
|
||||||
(column-data (make-list verse-cols)))
|
|
||||||
(let columnize-list ((index 0) (items versegroup))
|
|
||||||
(if (not (null? items))
|
|
||||||
(let* ((column-index (if verse-ordering-horizontal
|
|
||||||
(modulo index verse-cols)
|
|
||||||
(floor (/ index column-item-count))))
|
|
||||||
(column-markups (list-ref column-data column-index)))
|
|
||||||
(list-set! column-data column-index (cons (car items) column-markups))
|
|
||||||
(columnize-list (+ index 1) (cdr items)))))
|
|
||||||
(interpret-markup layout props
|
|
||||||
(make-fill-line-markup (list (make-verseformat-markup (make-line-markup
|
|
||||||
(add-markup-between-elements #f
|
|
||||||
(make-hspace-markup verse-hspace)
|
|
||||||
(map (lambda (column-markups)
|
|
||||||
(make-column-markup
|
|
||||||
(add-markup-between-elements #t (make-vspace-markup verse-vspace) column-markups)))
|
|
||||||
column-data)))))))))
|
|
||||||
|
|
||||||
#(define-markup-command (pad-left layout props amount arg)
|
|
||||||
(number? markup?)
|
|
||||||
(ly:stencil-translate
|
|
||||||
(interpret-markup layout props (make-pad-x-left-markup amount arg))
|
|
||||||
`(,amount . 0)))
|
|
||||||
|
|
||||||
#(define-markup-command (score-equal-height-with-indents layout props lines)
|
|
||||||
(markup-list?)
|
|
||||||
#:category music
|
|
||||||
#:properties ((intraverse-vspace 0)
|
|
||||||
(verse-line-height songTextLineHeigth)
|
|
||||||
(line-indents '()))
|
|
||||||
(let ((indents-max-index (- (length line-indents) 1)))
|
|
||||||
(stack-stencils Y DOWN intraverse-vspace
|
|
||||||
(index-map
|
|
||||||
(lambda (index line)
|
|
||||||
(let ((stil
|
|
||||||
(ly:make-stencil
|
|
||||||
(ly:stencil-expr line)
|
|
||||||
(ly:stencil-extent line X)
|
|
||||||
`(,(/ verse-line-height -2.0) . ,(/ verse-line-height 2.0)))))
|
|
||||||
(if (<= index indents-max-index)
|
|
||||||
(ly:stencil-translate-axis
|
|
||||||
stil
|
|
||||||
(list-ref line-indents index)
|
|
||||||
X)
|
|
||||||
stil)))
|
|
||||||
(interpret-markup-list layout props lines)))))
|
|
||||||
|
|
||||||
#(define-public (custom-lyric-text::print grob)
|
|
||||||
"Allow interpretation of tildes as lyric tieing marks."
|
|
||||||
;; See also similar code in Lyric_performer.
|
|
||||||
(let ((text (ly:grob-property grob 'text)))
|
|
||||||
|
|
||||||
(grob-interpret-markup grob (if (string? text)
|
|
||||||
(make-pad-x-right-markup -0.1 (make-tied-lyric-markup text))
|
|
||||||
text))))
|
|
||||||
|
|
||||||
Chord_lyrics_spacing_engraver =
|
|
||||||
#(lambda (ctx)
|
|
||||||
(let ((last-lyric-syllable #f)
|
|
||||||
(lyric-width-since-last-chord 0)
|
|
||||||
(music-columns-for-last-syllable 0)
|
|
||||||
(last-printed-chord #f)
|
|
||||||
(chord-width-since-last-lyric 0)
|
|
||||||
(lyrics-seen-since-break #f)
|
|
||||||
(have-a-rest #f)
|
|
||||||
(stanza #f)
|
|
||||||
(place-at-right-edge
|
|
||||||
(lambda (grob anchor padding)
|
|
||||||
(let ((anchor-width (interval-length (ly:grob-extent anchor anchor X))))
|
|
||||||
(ly:grob-set-parent! grob X anchor)
|
|
||||||
(ly:grob-set-property! grob 'X-offset (+ padding anchor-width))
|
|
||||||
))))
|
|
||||||
(make-engraver
|
|
||||||
(listeners
|
|
||||||
((multi-measure-rest-event engraver event)
|
|
||||||
(set! have-a-rest #t)
|
|
||||||
)
|
|
||||||
((rest-event engraver event)
|
|
||||||
(set! have-a-rest #t)
|
|
||||||
)
|
|
||||||
((lyric-event engraver event)
|
|
||||||
(set! have-a-rest #f)
|
|
||||||
(set! music-columns-for-last-syllable 0)
|
|
||||||
)
|
|
||||||
((break-event engraver event)
|
|
||||||
(set! last-lyric-syllable #f)
|
|
||||||
(set! lyric-width-since-last-chord 0)
|
|
||||||
(set! music-columns-for-last-syllable 0)
|
|
||||||
(set! last-printed-chord #f)
|
|
||||||
(set! chord-width-since-last-lyric 0)
|
|
||||||
(set! lyrics-seen-since-break #f)
|
|
||||||
))
|
|
||||||
(acknowledgers
|
|
||||||
((musical-paper-column-interface this-engraver grob source-engraver)
|
|
||||||
(set! music-columns-for-last-syllable (+ 1 music-columns-for-last-syllable))
|
|
||||||
)
|
|
||||||
((lyric-syllable-interface this-engraver grob source-engraver)
|
|
||||||
(let ((syllable-width (interval-length (ly:grob-extent grob grob X))))
|
|
||||||
(set! lyric-width-since-last-chord (+ lyric-width-since-last-chord syllable-width))
|
|
||||||
)
|
|
||||||
(if (> chord-width-since-last-lyric 0)
|
|
||||||
(if lyrics-seen-since-break
|
|
||||||
(ly:grob-set-property! grob 'extra-spacing-width
|
|
||||||
(cons (- chord-width-since-last-lyric) (cdr (ly:grob-property grob 'extra-spacing-width '(0 . 0)))))
|
|
||||||
(if last-printed-chord
|
|
||||||
(let ((gap-for-starting-rest 2.0))
|
|
||||||
(if stanza (ly:grob-set-property! stanza 'padding (+ 1 gap-for-starting-rest)))
|
|
||||||
(ly:grob-set-parent! grob X last-printed-chord)
|
|
||||||
(ly:grob-set-property! grob 'X-offset gap-for-starting-rest)
|
|
||||||
)))
|
|
||||||
)
|
|
||||||
(set! last-lyric-syllable grob)
|
|
||||||
(set! chord-width-since-last-lyric 0)
|
|
||||||
(set! lyrics-seen-since-break #t)
|
|
||||||
)
|
|
||||||
((chord-name-interface this-engraver grob source-engraver)
|
|
||||||
(if (not (and
|
|
||||||
(boolean? (ly:grob-property grob 'begin-of-line-visible))
|
|
||||||
(ly:grob-property grob 'begin-of-line-visible)
|
|
||||||
lyrics-seen-since-break))
|
|
||||||
(let* ((last-printed-chord-width (if last-printed-chord (interval-length (ly:grob-extent last-printed-chord last-printed-chord X)) 0))
|
|
||||||
(chord-overwidth (- last-printed-chord-width lyric-width-since-last-chord))
|
|
||||||
(chord-gap 0.5))
|
|
||||||
(if have-a-rest
|
|
||||||
(let ((chord-width (interval-length (ly:grob-extent grob grob X))))
|
|
||||||
(if last-lyric-syllable
|
|
||||||
(if (and last-printed-chord (> chord-overwidth 0))
|
|
||||||
(place-at-right-edge grob last-printed-chord chord-gap)
|
|
||||||
(place-at-right-edge grob last-lyric-syllable 0))
|
|
||||||
(if last-printed-chord
|
|
||||||
(place-at-right-edge grob last-printed-chord chord-gap)))
|
|
||||||
(set! chord-width-since-last-lyric (+ chord-width-since-last-lyric chord-width chord-gap))
|
|
||||||
))
|
|
||||||
(if (and last-lyric-syllable last-printed-chord (> chord-overwidth 0))
|
|
||||||
(ly:grob-set-property! last-lyric-syllable 'extra-spacing-width
|
|
||||||
(cons (car (ly:grob-property last-lyric-syllable 'extra-spacing-width '(0 . 0))) (+ chord-gap chord-overwidth)))
|
|
||||||
)
|
|
||||||
(set! lyric-width-since-last-chord (* (if last-lyric-syllable (interval-length (ly:grob-extent last-lyric-syllable last-lyric-syllable X)) 0) (- 1 (/ 1.0 music-columns-for-last-syllable))))
|
|
||||||
(set! last-printed-chord grob)
|
|
||||||
(set! last-lyric-syllable #f)
|
|
||||||
)
|
|
||||||
(ly:grob-set-property! grob 'X-extent '(+inf.0 . -inf.0))
|
|
||||||
)
|
|
||||||
)
|
|
||||||
((stanza-number-interface this-engraver grob source-engraver)
|
|
||||||
(set! stanza grob)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
)))
|
|
||||||
|
|
||||||
#(define-markup-command (chordlyrics layout props lyrics) (ly:music?)
|
|
||||||
#:properties ((verse-chords #{#})
|
|
||||||
(verse-reference-voice #{#})
|
|
||||||
(verse-break-voice #{#})
|
|
||||||
(verse-text-chord-distance songTextChordDistance)
|
|
||||||
(transposition (cons #f #f))
|
|
||||||
(verselayout generalLayout))
|
|
||||||
"Vers mit Akkorden"
|
|
||||||
;; Dem ChordPro-Collector sagen, zu welchem Lied dieser Vers gehoert
|
|
||||||
;; (Buch: songfilename aus den Props via \setsongfilename; Einzellied:
|
|
||||||
;; Fallback-Key aus layout_bottom). Die Score-Interpretation darunter
|
|
||||||
;; laeuft synchron, der Engraver liest den Key in initialize. Die Props
|
|
||||||
;; braucht er zum Aufloesen von Markup-Silben (tags-to-keep).
|
|
||||||
(set! chordpro-active-song-key (chordpro-resolve-song-key props))
|
|
||||||
(set! chordpro-active-props props)
|
|
||||||
;; Dokumentposition: von \group-verses gestempelt; ausserhalb einer
|
|
||||||
;; Gruppe nimmt sich der Vers selbst eine Sequenznummer.
|
|
||||||
(set! chordpro-active-doc-order
|
|
||||||
(or (chain-assoc-get 'chordpro-doc-order props #f)
|
|
||||||
(begin
|
|
||||||
(set! chordpro-doc-seq-counter (1+ chordpro-doc-seq-counter))
|
|
||||||
(cons chordpro-doc-seq-counter 0))))
|
|
||||||
(interpret-markup layout props
|
|
||||||
#{
|
|
||||||
\markup {
|
|
||||||
\score-equal-height-with-indents \score-lines {
|
|
||||||
<<
|
|
||||||
\new Devnull { #(music-clone verse-break-voice) }
|
|
||||||
\new NullVoice = "dummyvoice" { #(music-clone verse-reference-voice) }
|
|
||||||
\transposable #transposition #(music-clone verse-chords)
|
|
||||||
\new Lyrics \lyricsto "dummyvoice" { #lyrics }
|
|
||||||
>>
|
|
||||||
\layout {
|
|
||||||
$verselayout
|
|
||||||
#(customized-layout verselayout)
|
|
||||||
ragged-right = ##t
|
|
||||||
\context {
|
|
||||||
\Lyrics
|
|
||||||
\override VerticalAxisGroup.nonstaff-relatedstaff-spacing.basic-distance = #verse-text-chord-distance
|
|
||||||
\override VerticalAxisGroup.nonstaff-relatedstaff-spacing.padding = #(- verse-text-chord-distance songTextChordDistance)
|
|
||||||
\override LyricText.parent-alignment-X = #LEFT
|
|
||||||
\override LyricText.self-alignment-X = #LEFT
|
|
||||||
\override LyricText.word-space = 0.8
|
|
||||||
\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
|
|
||||||
% \override SpacingSpanner.packed-spacing = ##t
|
|
||||||
\consists \Chord_lyrics_spacing_engraver
|
|
||||||
% ChordPro engraver in Score context to collect all data
|
|
||||||
\consists \ChordPro_score_collector
|
|
||||||
\remove Bar_number_engraver
|
|
||||||
\remove Mark_engraver
|
|
||||||
\remove Jump_engraver
|
|
||||||
\remove Volta_engraver
|
|
||||||
\remove Parenthesis_engraver
|
|
||||||
\remove Metronome_mark_engraver
|
|
||||||
\remove Text_mark_engraver
|
|
||||||
}
|
|
||||||
\context {
|
|
||||||
\Staff
|
|
||||||
\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
|
|
||||||
\remove Script_engraver
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#}
|
|
||||||
)
|
|
||||||
)
|
|
||||||
|
|
||||||
#(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))
|
|
||||||
)
|
|
||||||
@@ -1,44 +0,0 @@
|
|||||||
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
|
|
||||||
}
|
|
||||||
}
|
|
||||||
@@ -1,638 +0,0 @@
|
|||||||
#(define song-list '())
|
|
||||||
#(define song-number 0)
|
|
||||||
|
|
||||||
#(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 (ly:regex-match? (ly:regex-exec (ly:make-regex "^(0|\\.)") f)) files (cons f files))))))))
|
|
||||||
|
|
||||||
#(define (file-to-stats filename)
|
|
||||||
(set! song-list (cons filename song-list)))
|
|
||||||
|
|
||||||
|
|
||||||
#(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
|
|
||||||
)
|
|
||||||
|
|
||||||
% Fuer Zusatzseiten: Label der ersten Seite des zusammenhaengenden
|
|
||||||
% Zusatzseiten-Blocks, zu dem label gehoert (bestimmt den Buchstaben-Suffix a, b, ...).
|
|
||||||
#(define (earliest-additional-label label)
|
|
||||||
(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))))
|
|
||||||
|
|
||||||
% Sichtbare Seitenzahl der Seite mit diesem Label: normalerweise eine Zahl,
|
|
||||||
% auf Zusatzseiten ein String mit Buchstaben-Suffix (z.B. "12a"); gleiche
|
|
||||||
% Logik wie custom-page-number unten.
|
|
||||||
#(define (visible-page-value layout label)
|
|
||||||
(let ((display-page (assq-ref (build-display-pages-list layout) label)))
|
|
||||||
(if (assq-ref additional-page-switch-label-list label)
|
|
||||||
(ly:format "~a~a" display-page
|
|
||||||
(string (integer->char (+ 97 (- (real-page-number layout label)
|
|
||||||
(real-page-number layout (earliest-additional-label label)))))))
|
|
||||||
display-page)))
|
|
||||||
|
|
||||||
% TODO:
|
|
||||||
% Eigentlich können wir das direkt in oddFooderMarkup und evenFooterMarkup aufrufen
|
|
||||||
% vermutlich sogar ohne den delay kram. Wir sollten außerdem einfach nur die property
|
|
||||||
% page:page-number-string setzen dann klappts auch mit PDF Seiten
|
|
||||||
#(define-markup-command (custom-page-number layout props label real-current-page-number)
|
|
||||||
(symbol? number?)
|
|
||||||
#:category other
|
|
||||||
"
|
|
||||||
@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))
|
|
||||||
(number-type (ly:output-def-lookup layout 'page-number-type))
|
|
||||||
(page-markup
|
|
||||||
(if (assq-ref additional-page-switch-label-list label)
|
|
||||||
(make-concat-markup (list (number-format number-type display-page)
|
|
||||||
(make-char-markup (+ 97 (- real-current-page (real-page-number layout
|
|
||||||
(earliest-additional-label label)))))))
|
|
||||||
(number-format number-type (+ display-page (- real-current-page (real-page-number layout label))))
|
|
||||||
))
|
|
||||||
(page-stencil (interpret-markup layout props page-markup))
|
|
||||||
(gap (- (interval-length x-ext)
|
|
||||||
(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))))
|
|
||||||
|
|
||||||
|
|
||||||
%% Schreibt die Daten aller Lieder des Buchs (extract-song-data, siehe
|
|
||||||
%% data_extractor.ily) als YAML-Datei: oberster Key contents, darunter eine
|
|
||||||
%% Liste mit den Lied-Daten, jeweils angereichert um den Key page mit der
|
|
||||||
%% sichtbaren Seitenzahl des Liedanfangs. Einbinden wie \write-toc-csv in
|
|
||||||
%% einem Markup des Buchs; wie dort passiert das Schreiben ueber ein
|
|
||||||
%% delayed stencil, weil die Label->Seiten-Tabelle erst beim Ausgeben des
|
|
||||||
%% Buchs feststeht. Der Dateiname ist der Ausgabename des Buchs
|
|
||||||
%% (\bookOutputName, sonst der .ly-Basisname) mit angehaengtem .yml --
|
|
||||||
%% landet also wie das PDF relativ zum Arbeitsverzeichnis.
|
|
||||||
#(define-markup-command (write-book-yaml layout props) ()
|
|
||||||
(let ((filename (string-append (ly:parser-output-name) ".yml")))
|
|
||||||
(ly:make-stencil
|
|
||||||
`(delay-stencil-evaluation
|
|
||||||
,(delay
|
|
||||||
(begin
|
|
||||||
(scm->yml-file filename
|
|
||||||
(list (cons 'contents
|
|
||||||
(map (lambda (song)
|
|
||||||
(let ((songvars (cdr song)))
|
|
||||||
(cons (cons 'page (visible-page-value layout (assq-ref songvars 'label)))
|
|
||||||
(extract-song-data (assq-ref songvars 'header)
|
|
||||||
(assq-ref songvars 'music)
|
|
||||||
;; Textseiten-Strophen aus dem Render-
|
|
||||||
;; Collector-Store (Key = Liedname); beim
|
|
||||||
;; Ausgeben des Buchs sind alle Textseiten
|
|
||||||
;; bereits interpretiert.
|
|
||||||
(hash-ref chordpro-song-store
|
|
||||||
(symbol->string (car song)))
|
|
||||||
(symbol->string (car song))))))
|
|
||||||
(reverse (alist-delete 'markupPage
|
|
||||||
(alist-delete 'imagePage
|
|
||||||
(alist-delete 'emptyPage song-list))))))))
|
|
||||||
empty-stencil))))))
|
|
||||||
|
|
||||||
%% Schreibt den ChordPro-Export aller Lieder des Buchs (in Dokument-
|
|
||||||
%% reihenfolge) als EINE Datei statt als Einzeldateien pro Lied. Lieder
|
|
||||||
%% werden mit der ChordPro-Direktive {new_song} getrennt; vor dem ersten
|
|
||||||
%% Lied ist sie nicht noetig, sie gilt am Dateianfang implizit (siehe
|
|
||||||
%% https://www.chordpro.org/chordpro/directives-new_song/). Einbinden wie
|
|
||||||
%% \write-book-yaml an beliebiger Stelle im Buch -- unabhaengig von
|
|
||||||
%% chordpro-export-enabled (das steuert nur den Pro-Song-Export), beide
|
|
||||||
%% Befehle koennen auch gleichzeitig genutzt werden. Wie bei
|
|
||||||
%% \write-book-yaml passiert das Schreiben ueber ein delayed stencil,
|
|
||||||
%% weil der Render-Collector-Store erst beim Ausgeben des Buchs
|
|
||||||
%% vollstaendig gefuellt ist. Der Dateiname ist wie bei \write-book-yaml
|
|
||||||
%% der Ausgabename des Buchs mit angehaengtem .cho.
|
|
||||||
#(define-markup-command (write-book-chordpro layout props) ()
|
|
||||||
(let ((filename (string-append (ly:parser-output-name) ".cho")))
|
|
||||||
(ly:make-stencil
|
|
||||||
`(delay-stencil-evaluation
|
|
||||||
,(delay
|
|
||||||
(begin
|
|
||||||
(with-output-to-file filename
|
|
||||||
(lambda ()
|
|
||||||
(let loop ((songs (filter
|
|
||||||
;; \chordlyrics-Strophen ODER (bei
|
|
||||||
;; chordpro-include-music-lyrics) aus der
|
|
||||||
;; Musik nachgeholte Kandidaten.
|
|
||||||
(lambda (song) (or (> (chordpro-song-verse-index song) 0)
|
|
||||||
(pair? (chordpro-song-music-candidates song))))
|
|
||||||
(filter-map
|
|
||||||
(lambda (song) (hash-ref chordpro-song-store
|
|
||||||
(symbol->string (car song))))
|
|
||||||
(reverse (alist-delete 'markupPage
|
|
||||||
(alist-delete 'imagePage
|
|
||||||
(alist-delete 'emptyPage song-list)))))))
|
|
||||||
(first? #t))
|
|
||||||
(when (pair? songs)
|
|
||||||
(unless first? (display "{new_song}\n"))
|
|
||||||
(display (chordpro-format-song (car songs)))
|
|
||||||
(loop (cdr songs) #f)))))
|
|
||||||
empty-stencil))))))
|
|
||||||
|
|
||||||
includeSong =
|
|
||||||
#(define-void-function (filename) (string?)
|
|
||||||
#{
|
|
||||||
\bookOutputName #filename
|
|
||||||
#}
|
|
||||||
(ly:parser-parse-string (ly:parser-clone)
|
|
||||||
(ly:format "\\include \"~a/~a/~a.ly\"" songPath filename filename))
|
|
||||||
;; ChordPro: Titel/Autoren dieses Lieds im Render-Collector-Store
|
|
||||||
;; registrieren -- basicSongInfo haelt direkt nach dem Include genau
|
|
||||||
;; dieses Lied. Der Key ist der Liedname; die Collector-Daten (Verse,
|
|
||||||
;; Akkorde) kommen spaeter beim Rendern ueber \setsongfilename unter
|
|
||||||
;; demselben Key dazu. Unabhaengig von chordpro-export-enabled, damit
|
|
||||||
;; sowohl der Pro-Song-Export (der die Flag braucht) als auch
|
|
||||||
;; \write-book-chordpro (das nur explizit aufgerufen werden muss) auf
|
|
||||||
;; vollstaendige Metadaten zugreifen koennen.
|
|
||||||
(chordpro-register-song-metadata filename HEADER)
|
|
||||||
(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)
|
|
||||||
`(
|
|
||||||
(label . ,label)
|
|
||||||
(header . ,HEADER)
|
|
||||||
(music . ,MUSIC)
|
|
||||||
(layout . ,LAYOUT)
|
|
||||||
(text-pages . ,(map (lambda (text)
|
|
||||||
#{ \markuplist \setsongfilename $filename $text #})
|
|
||||||
TEXT_PAGES))
|
|
||||||
)
|
|
||||||
song-list))
|
|
||||||
))
|
|
||||||
|
|
||||||
blankpage =
|
|
||||||
#(define-void-function () ()
|
|
||||||
(set! song-list
|
|
||||||
(acons 'emptyPage
|
|
||||||
'()
|
|
||||||
song-list)))
|
|
||||||
|
|
||||||
imagepage =
|
|
||||||
#(define-void-function (xsize filename) (number? string?)
|
|
||||||
(set! song-list
|
|
||||||
(acons 'imagePage
|
|
||||||
`((xsize . ,xsize)
|
|
||||||
(filename . ,filename))
|
|
||||||
song-list)))
|
|
||||||
|
|
||||||
markuppage =
|
|
||||||
#(define-void-function (mkup) (markup?)
|
|
||||||
(set! song-list
|
|
||||||
(acons 'markupPage
|
|
||||||
`((markup . ,mkup))
|
|
||||||
song-list)))
|
|
||||||
|
|
||||||
#(define chapters '())
|
|
||||||
|
|
||||||
songsChapter =
|
|
||||||
#(define-void-function (title) (string?)
|
|
||||||
(set! chapters
|
|
||||||
(cons (cons title (length song-list)) chapters)))
|
|
||||||
|
|
||||||
#(define-markup-command (pagecenter layout props stuff)(markup?)
|
|
||||||
(interpret-markup layout props
|
|
||||||
(let ((halfpaperheight (/ (ly:output-def-lookup layout 'paper-height) 2))
|
|
||||||
(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)))
|
|
||||||
)))
|
|
||||||
|
|
||||||
songs =
|
|
||||||
#(define-void-function () ()
|
|
||||||
(let* ((ordered (reverse song-list))
|
|
||||||
(total (length ordered))
|
|
||||||
;; Ein Lied erzeugt nur dann einen PDF-Outline-Eintrag (/OUT), wenn
|
|
||||||
;; title oder starttext gesetzt sind (siehe build-full-title). Nur solche
|
|
||||||
;; Lieder duerfen als Kapitel-Kinder gezaehlt werden -- sonst wird die
|
|
||||||
;; /Count zu hoch und der erste Folgeeintrag (z.B. ein spaeteres Kapitel)
|
|
||||||
;; rutscht faelschlich als Kind mit hinein.
|
|
||||||
(emits-bookmark?
|
|
||||||
(lambda (e)
|
|
||||||
(and (not (eq? (car e) 'emptyPage))
|
|
||||||
(not (eq? (car e) 'imagePage))
|
|
||||||
(not (eq? (car e) 'markupPage))
|
|
||||||
(let ((vars (extract-and-check-vars-from-header
|
|
||||||
(assq-ref (cdr e) 'header) '(title starttext))))
|
|
||||||
(if (or (assq-ref vars 'title) (assq-ref vars 'starttext)) #t #f)))))
|
|
||||||
(count-bookmark-songs
|
|
||||||
(lambda (start end)
|
|
||||||
(let loop ((i 0) (l ordered) (c 0))
|
|
||||||
(cond ((or (null? l) (>= i end)) c)
|
|
||||||
((< i start) (loop (+ i 1) (cdr l) c))
|
|
||||||
(else (loop (+ i 1) (cdr l) (if (emits-bookmark? (car l)) (+ c 1) c)))))))
|
|
||||||
;; chapters: (title . start-index). start-index = Anzahl der song-list-
|
|
||||||
;; Eintraege beim Aufruf von songsChapter = Index in `ordered`, ab dem
|
|
||||||
;; das Kapitel beginnt.
|
|
||||||
(chapters-asc (sort chapters (lambda (a b) (< (cdr a) (cdr b)))))
|
|
||||||
;; pending: aufsteigende Liste von (start title count); count = Anzahl
|
|
||||||
;; der Lesezeichen-Lieder von diesem Kapitel bis zum Beginn des naechsten.
|
|
||||||
(pending
|
|
||||||
(let loop ((chs chapters-asc) (acc '()))
|
|
||||||
(if (null? chs)
|
|
||||||
(reverse acc)
|
|
||||||
(let* ((title (caar chs))
|
|
||||||
(start (cdar chs))
|
|
||||||
(end (if (null? (cdr chs)) total (cdadr chs)))
|
|
||||||
(cnt (count-bookmark-songs start end)))
|
|
||||||
(loop (cdr chs) (cons (list start title cnt) acc))))))
|
|
||||||
;; Aktuell aktives Kapitel (Titel-String) waehrend des Durchlaufs. Wird
|
|
||||||
;; gesetzt, sobald ein Kapitel aktiviert (aus `pending` entfernt) wird --
|
|
||||||
;; egal ob auf einer Seite (chapter-prefixed-markup) oder auf dem ersten
|
|
||||||
;; Song. Jeder danach folgende Song erhaelt dieses Kapitel als
|
|
||||||
;; chapterref-Header-Feld, woraus toc_include.ily den Kapitel-Index baut.
|
|
||||||
(current-chapter #f)
|
|
||||||
;; Stellt einer beliebigen Seite (markup-/image-/emptyPage) den Kapitel-
|
|
||||||
;; Eintrag (chapter-to-pdf-toc) bei, falls an Position `this-index` ein
|
|
||||||
;; Kapitel faellig ist, und entfernt es aus `pending`. So fuehrt die
|
|
||||||
;; Kapitel-Referenz zur ersten Seite nach dem \songsChapter -- egal
|
|
||||||
;; welcher Seitentyp das ist. Der Eintrag wird als unsichtbares Overlay
|
|
||||||
;; (\combine) beigelegt, damit er das Seitenlayout nicht veraendert;
|
|
||||||
;; \with-dimensions gibt dem sonst extent-losen pdfmark einen minimalen
|
|
||||||
;; Extent, damit er auch auf leeren Seiten nicht verworfen wird.
|
|
||||||
(chapter-prefixed-markup
|
|
||||||
(lambda (this-index base-markup)
|
|
||||||
(if (and (pair? pending) (<= (car (car pending)) this-index))
|
|
||||||
(let ((cnt (caddr (car pending)))
|
|
||||||
(title (cadr (car pending))))
|
|
||||||
(set! pending (cdr pending))
|
|
||||||
(set! current-chapter title)
|
|
||||||
(make-combine-markup
|
|
||||||
base-markup
|
|
||||||
(make-with-dimensions-markup '(0 . 0) '(0 . 0.1)
|
|
||||||
(make-chapter-to-pdf-toc-markup cnt title))))
|
|
||||||
base-markup)))
|
|
||||||
(index 0))
|
|
||||||
(for-each (lambda (songitems)
|
|
||||||
(let ((this-index index))
|
|
||||||
(set! index (+ index 1))
|
|
||||||
(ly:book-add-bookpart! (ly:parser-lookup '$current-book)
|
|
||||||
(let ((filename (car songitems))
|
|
||||||
(songvars (cdr songitems)))
|
|
||||||
(if (eq? filename 'emptyPage)
|
|
||||||
#{ \bookpart { \markup { $(chapter-prefixed-markup this-index (make-null-markup)) } } #}
|
|
||||||
(if (eq? filename 'markupPage)
|
|
||||||
;; Kapitelanfang auf einer markuppage: Kapitel-Eintrag wird dieser
|
|
||||||
;; Seite beigelegt (siehe chapter-prefixed-markup).
|
|
||||||
#{ \bookpart { \markup { $(chapter-prefixed-markup this-index (assq-ref songvars 'markup)) } } #}
|
|
||||||
(if (eq? filename 'imagePage)
|
|
||||||
(let* ((xsize (assq-ref songvars 'xsize))
|
|
||||||
(filename (ly:format "~a/~a" imagePagePath (assq-ref songvars 'filename)))
|
|
||||||
(img-markup #{ \markup { \pagecenter { \epsfile #X #xsize #filename } } #}))
|
|
||||||
#{ \bookpart {
|
|
||||||
\paper {
|
|
||||||
%{
|
|
||||||
inner-margin = 0
|
|
||||||
outer-margin = 0
|
|
||||||
binding-offset = 0
|
|
||||||
top-margin = 0
|
|
||||||
bottom-margin = 0
|
|
||||||
%}
|
|
||||||
print-page-number = ##f
|
|
||||||
last-bottom-spacing = #'((basic-distance . 0) (minimum-distance . 0) (padding . 0))
|
|
||||||
page-count = 1
|
|
||||||
}
|
|
||||||
\markup { $(chapter-prefixed-markup this-index img-markup) }
|
|
||||||
} #}
|
|
||||||
)
|
|
||||||
;; Ist ein Kapitel faellig (Start <= aktuelle Position) und dies ein
|
|
||||||
;; echtes Lied, wird die Kapitelinfo an dieses Lied gehaengt und aus
|
|
||||||
;; `pending` entfernt.
|
|
||||||
(let* ((newnumber (+ 1 song-number))
|
|
||||||
(chaptertitle (if (and (pair? pending) (<= (car (car pending)) this-index))
|
|
||||||
(cadr (car pending)) #f))
|
|
||||||
(chaptercount (if chaptertitle (caddr (car pending)) 0))
|
|
||||||
;; Startet das Kapitel erst auf diesem Song (nicht schon auf
|
|
||||||
;; einer vorangehenden Seite), wird current-chapter jetzt
|
|
||||||
;; gesetzt und pending entfernt -- vor dem Bau des Headers,
|
|
||||||
;; damit chapterref bereits das neue Kapitel enthaelt.
|
|
||||||
(_ (if chaptertitle
|
|
||||||
(begin (set! current-chapter chaptertitle)
|
|
||||||
(set! pending (cdr pending)))))
|
|
||||||
(header #{ \bookpart { $(assq-ref songvars 'header) \header {
|
|
||||||
songfilename = $(symbol->string filename)
|
|
||||||
myindexlabel = #(assq-ref songvars 'label)
|
|
||||||
songnumber = #(number->string newnumber)
|
|
||||||
chaptertitle = #chaptertitle
|
|
||||||
chaptercount = #chaptercount
|
|
||||||
chapterref = #current-chapter
|
|
||||||
} } #})
|
|
||||||
(music (assq-ref songvars 'music))
|
|
||||||
(layout (assq-ref songvars 'layout))
|
|
||||||
(text-pages (assq-ref songvars 'text-pages))
|
|
||||||
(label (assq-ref songvars 'label)))
|
|
||||||
(set! song-number newnumber)
|
|
||||||
;; ChordPro_music_collector (Strophen unter den Noten, siehe
|
|
||||||
;; chordpro.ily) braucht den Song-Key beim tatsaechlichen
|
|
||||||
;; Interpretieren dieses Songs' Hauptscore. Im Buch ist DAS
|
|
||||||
;; NICHT synchron zu dieser for-each-Schleife -- LilyPond
|
|
||||||
;; interpretiert die \score-Bloecke aller Lieder gesammelt fuer
|
|
||||||
;; das Seitenlayout, oft NACHDEM die Schleife schon beim
|
|
||||||
;; naechsten (oder letzten) Lied angelangt ist. Ein globaler
|
|
||||||
;; chordpro-active-song-key waere zu diesem Zeitpunkt also auf
|
|
||||||
;; ein ANDERES Lied gesetzt -- die gesammelten Strophen landen
|
|
||||||
;; dann fälschlich im Store-Eintrag des zuletzt verarbeiteten
|
|
||||||
;; Lieds (beobachtet: mehrere Lieder ohne eigene \chordlyrics
|
|
||||||
;; wurden alle in den letzten Song der Test-Bibliothek
|
|
||||||
;; geschrieben). Deshalb setzen wir den Key per \applyContext
|
|
||||||
;; DIREKT IN DER MUSIK in chordpro-context-song-keys (siehe
|
|
||||||
;; chordpro.ily) -- das laeuft synchron zur tatsaechlichen
|
|
||||||
;; Interpretation dieses Scores und ist deshalb robust gegen die
|
|
||||||
;; verzoegerte/gesammelte Verarbeitung (eine LilyPond-Context-
|
|
||||||
;; Property ueber den \layout-Block waere hier keine Alternative:
|
|
||||||
;; LilyPond verwirft \applyContext-\ly:context-set-property!-
|
|
||||||
;; Aufrufe fuer nicht deklarierte Properties stillschweigend).
|
|
||||||
;; Der Music_collector liest bevorzugt diese Tabelle,
|
|
||||||
;; chordpro-active-song-key bleibt nur als Fallback
|
|
||||||
;; (Einzellied-Standalone-Pfad, dort synchron genug).
|
|
||||||
;; \consists nur bei chordpro-include-music-lyrics -- sonst
|
|
||||||
;; keine Kosten (Grob-Acknowledger fuer JEDEN Akkord/jede
|
|
||||||
;; Silbe/Strophenmarker des Hauptscores) fuer Buecher, die das
|
|
||||||
;; Feature nicht nutzen. Bewusst NICHT zusaetzlich an
|
|
||||||
;; chordpro-export-enabled gekoppelt -- die steuert nur, ob
|
|
||||||
;; \write-book-chordpro/\chordpro-delayed-write am Ende etwas
|
|
||||||
;; schreiben, nicht ob hier gesammelt wird.
|
|
||||||
(set! chordpro-active-song-key (symbol->string filename))
|
|
||||||
(let* ((collect-music-lyrics? (and (defined? 'chordpro-include-music-lyrics) chordpro-include-music-lyrics))
|
|
||||||
(song-layout
|
|
||||||
(if collect-music-lyrics?
|
|
||||||
#{
|
|
||||||
\layout {
|
|
||||||
$layout
|
|
||||||
songfilename = $(symbol->string filename)
|
|
||||||
\context {
|
|
||||||
\Score
|
|
||||||
\consists \ChordPro_music_collector
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#}
|
|
||||||
#{
|
|
||||||
\layout {
|
|
||||||
$layout
|
|
||||||
songfilename = $(symbol->string filename)
|
|
||||||
}
|
|
||||||
#}))
|
|
||||||
(score-music
|
|
||||||
(if collect-music-lyrics?
|
|
||||||
#{
|
|
||||||
<<
|
|
||||||
\applyContext
|
|
||||||
#(let ((key (symbol->string filename)))
|
|
||||||
(lambda (ctx)
|
|
||||||
(hashq-set! chordpro-context-song-keys ctx key)))
|
|
||||||
$music
|
|
||||||
>>
|
|
||||||
#}
|
|
||||||
music)))
|
|
||||||
#{
|
|
||||||
\bookpart {
|
|
||||||
$header
|
|
||||||
\headerToTOC #header #label
|
|
||||||
\score {
|
|
||||||
$score-music
|
|
||||||
$song-layout
|
|
||||||
}
|
|
||||||
$(add-text-pages text-pages)
|
|
||||||
}
|
|
||||||
#})))))))))
|
|
||||||
ordered
|
|
||||||
)))
|
|
||||||
|
|
||||||
#(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 songPath) songs) string<?) "\n")
|
|
||||||
opticalline
|
|
||||||
) "\n" )
|
|
||||||
)))
|
|
||||||
|
|
||||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
||||||
%% Include Images once and reference them:
|
|
||||||
#(define bbox-regexp
|
|
||||||
(ly:make-regex "%%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 (ly:regex-exec bbox-regexp string)))
|
|
||||||
|
|
||||||
(if match
|
|
||||||
(map (lambda (x)
|
|
||||||
(string->number (ly:regex-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)
|
|
||||||
))
|
|
||||||
@@ -1,490 +0,0 @@
|
|||||||
% 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))
|
|
||||||
(set! restlines lines)
|
|
||||||
(if (null? lines)
|
|
||||||
'()
|
|
||||||
(let* ((line-to-stencil (lambda (line) (interpret-markup layout (cons (list (cons 'line-width line-width) (cons 'baseline-skip 1)) props) (markup line))))
|
|
||||||
(stencil-height (lambda (stencil) (interval-length (ly:stencil-extent stencil Y))))
|
|
||||||
(linestencil (line-to-stencil (car lines)))
|
|
||||||
(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))))
|
|
||||||
(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 textoptions sorttext #:optional (label (gensym "index")))
|
|
||||||
(set! index-item-list
|
|
||||||
;; We insert index items sorted from the beginning on and do
|
|
||||||
;; not sort them later - this saves pretty much computing time
|
|
||||||
(insert-alphabetical-sorted! (list label markup-symbol textoptions
|
|
||||||
(ly:string-substitute " " ""
|
|
||||||
(ly:string-substitute "." ""
|
|
||||||
(transliterate-de 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 textoptions #:optional label) #f)
|
|
||||||
#(define-public (category-index-items) #f)
|
|
||||||
|
|
||||||
#(let ((category-index-hash (make-hash-table)))
|
|
||||||
(set! add-category-index-item!
|
|
||||||
(lambda* (categories markup-symbol textoptions #:optional (label (gensym "index")))
|
|
||||||
(for-each (lambda (category)
|
|
||||||
(let* ((catsym (string->symbol category))
|
|
||||||
(catlist (hashq-ref category-index-hash catsym
|
|
||||||
(list (list label 'indexCategoryMarkup `(((combine-with-next . #t) (rawtext . ,category))))))))
|
|
||||||
(if (assq catsym category-names)
|
|
||||||
(hashq-set! category-index-hash catsym
|
|
||||||
(cons (list label markup-symbol textoptions) catlist))
|
|
||||||
(ly:error "song: <~a> category ~a is not defined!" (markup->string (chain-assoc-get 'rawtext textoptions)) category))))
|
|
||||||
categories)
|
|
||||||
(make-music 'EventChord
|
|
||||||
'page-marker #t
|
|
||||||
'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))))
|
|
||||||
|
|
||||||
% 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 textoptions #:optional (label (gensym "index")))
|
|
||||||
(for-each (lambda (authorID)
|
|
||||||
(let* ((authorsym (string->symbol authorID))
|
|
||||||
(authorlist (hashq-ref author-index-hash authorsym
|
|
||||||
(list (list label 'indexAuthorMarkup `(((combine-with-next . #t) (rawtext . ,authorID))))))))
|
|
||||||
(hashq-set! author-index-hash authorsym
|
|
||||||
(cons (list label markup-symbol textoptions) 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))))))))
|
|
||||||
|
|
||||||
% code for chapter index
|
|
||||||
% Anders als bei Kategorien/Autoren ergibt sich die Kapitelzugehoerigkeit nicht
|
|
||||||
% aus dem Song-Header, sondern aus dem \songsChapter, das dem Song vorangeht
|
|
||||||
% (in book_include.ily als Header-Feld chapterref an jeden Song gehaengt).
|
|
||||||
% Die Kapitel behalten hier ihre Auftritts-Reihenfolge (nicht alphabetisch),
|
|
||||||
% ebenso die Songs innerhalb eines Kapitels ihre Song-Reihenfolge.
|
|
||||||
#(define*-public (add-chapter-index-item! chapter markup-symbol textoptions #:optional label) #f)
|
|
||||||
#(define-public (chapter-index-items) #f)
|
|
||||||
|
|
||||||
#(let ((chapter-index-hash (make-hash-table))
|
|
||||||
(chapter-order '()))
|
|
||||||
(set! add-chapter-index-item!
|
|
||||||
(lambda* (chapter markup-symbol textoptions #:optional (label (gensym "index")))
|
|
||||||
(let* ((chaptersym (string->symbol chapter))
|
|
||||||
(existing (hashq-ref chapter-index-hash chaptersym #f))
|
|
||||||
(chapterlist (or existing
|
|
||||||
(begin
|
|
||||||
(set! chapter-order (cons chaptersym chapter-order))
|
|
||||||
(list (list label 'indexChapterMarkup `(((combine-with-next . #t) (rawtext . ,chapter))))))))
|
|
||||||
)
|
|
||||||
(hashq-set! chapter-index-hash chaptersym
|
|
||||||
(cons (list label markup-symbol textoptions) chapterlist)))
|
|
||||||
(make-music 'EventChord
|
|
||||||
'page-marker #t
|
|
||||||
'page-label label
|
|
||||||
'elements (list (make-music 'LabelEvent
|
|
||||||
'page-label label)))))
|
|
||||||
(set! chapter-index-items (lambda ()
|
|
||||||
(append-map (lambda (chaptersym) (reverse (hashq-ref chapter-index-hash chaptersym (list))))
|
|
||||||
(reverse chapter-order)))))
|
|
||||||
|
|
||||||
|
|
||||||
#(define-markup-command (with-link-symbol-ref layout props symbol arg)
|
|
||||||
(symbol? markup?)
|
|
||||||
"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)()
|
|
||||||
#:properties ((index:text "")
|
|
||||||
(index:alternative #f)
|
|
||||||
(index:page #f)
|
|
||||||
(line-width))
|
|
||||||
(let* (
|
|
||||||
(width (-
|
|
||||||
line-width
|
|
||||||
(interval-length (ly:stencil-extent (interpret-markup layout props "XXXX") X))))
|
|
||||||
(lines-reversed
|
|
||||||
(reverse (map (lambda (stil) (markup #:stencil stil))
|
|
||||||
(wordwrap-string-internal-markup-list layout
|
|
||||||
(prepend-alist-chain 'line-width width
|
|
||||||
(if index:alternative
|
|
||||||
(prepend-alist-chain 'font-shape 'italic props)
|
|
||||||
props))
|
|
||||||
#f
|
|
||||||
index:text))))
|
|
||||||
(last-line-with-dots (make-fill-with-pattern-markup 1 RIGHT "." (car lines-reversed) index:page))
|
|
||||||
(lines-without-dots (cdr lines-reversed))
|
|
||||||
(target-line-size-markup
|
|
||||||
(make-column-markup
|
|
||||||
(list
|
|
||||||
(make-simple-markup "Agj")
|
|
||||||
(make-vspace-markup 0.2))))
|
|
||||||
)
|
|
||||||
(interpret-markup layout props
|
|
||||||
(make-size-box-to-box-markup #f #t
|
|
||||||
(make-with-link-symbol-ref-markup 'index:label
|
|
||||||
(make-column-markup
|
|
||||||
(reverse (cons
|
|
||||||
last-line-with-dots
|
|
||||||
(map (lambda (m) (make-size-box-to-box-markup #f #t m target-line-size-markup)) lines-without-dots)))))
|
|
||||||
; this column is just to have a reference height for resizing
|
|
||||||
(make-column-markup
|
|
||||||
(reverse (map (lambda (m) (make-size-box-to-box-markup #f #t m target-line-size-markup)) (cons last-line-with-dots lines-without-dots))))
|
|
||||||
))))
|
|
||||||
|
|
||||||
\paper {
|
|
||||||
indexItemMarkup = \markup {
|
|
||||||
\sans \index-item-with-pattern
|
|
||||||
}
|
|
||||||
indexSectionMarkup = \markup \override #'(baseline-skip . 1.5) \left-column {
|
|
||||||
\sans \bold \fontsize #3 \fromproperty #'index:text
|
|
||||||
\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
|
|
||||||
}
|
|
||||||
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
|
|
||||||
}
|
|
||||||
indexChapterMarkup = \markup \override #'(baseline-skip . 1.5) \left-column {
|
|
||||||
\vspace #1
|
|
||||||
\sans \bold \fontsize #3 \fromproperty #'index:text
|
|
||||||
\vspace #.4
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
#(define (prepare-item-markup items layout)
|
|
||||||
(define (single-item-markup index-item)
|
|
||||||
(let* ((label (car index-item))
|
|
||||||
(index-markup (cadr index-item))
|
|
||||||
(textoptions (caddr index-item))
|
|
||||||
(text (chain-assoc-get 'rawtext textoptions))
|
|
||||||
(alternative (chain-assoc-get 'alternative textoptions))
|
|
||||||
(songnumber (chain-assoc-get 'songnumber textoptions)))
|
|
||||||
(markup #:override (cons 'index:label label)
|
|
||||||
#:override (cons 'index:page (markup #:custom-page-number label -1))
|
|
||||||
#:override (cons 'index:text text)
|
|
||||||
#:override (cons 'index:alternative alternative)
|
|
||||||
#:override (cons 'index:songnumber songnumber)
|
|
||||||
(ly:output-def-lookup layout index-markup))))
|
|
||||||
(if (null? items)
|
|
||||||
items
|
|
||||||
(let* ((index-item (car items))
|
|
||||||
(combine-with-next (chain-assoc-get 'combine-with-next (caddr index-item) #f))
|
|
||||||
(restitems (cdr items))
|
|
||||||
(item-markup (single-item-markup index-item)))
|
|
||||||
(if (and combine-with-next (not (null? restitems)))
|
|
||||||
(cons (make-column-markup (list item-markup (single-item-markup (car restitems)))) (prepare-item-markup (cdr restitems) layout))
|
|
||||||
(cons item-markup (prepare-item-markup restitems layout))))
|
|
||||||
))
|
|
||||||
|
|
||||||
#(define-markup-list-command (index-in-columns-with-title layout props index-type title-markup) (symbol? markup?)
|
|
||||||
( _i "Outputs index alphabetical sorted or in categories" )
|
|
||||||
(let ((items (case index-type
|
|
||||||
((alphabetical) index-items)
|
|
||||||
((categories) category-index-items)
|
|
||||||
((authors) author-index-items)
|
|
||||||
((chapters) chapter-index-items)))
|
|
||||||
(title (interpret-markup layout props title-markup)))
|
|
||||||
(cons title
|
|
||||||
(interpret-markup-list layout props
|
|
||||||
(make-columnlayout-markup-list songTocColumns 2
|
|
||||||
(let ((h (- (ly:output-def-lookup layout 'paper-height) 12)))
|
|
||||||
(cons (- h (interval-length (ly:stencil-extent title Y))) h))
|
|
||||||
(prepare-item-markup (items) layout))))))
|
|
||||||
|
|
||||||
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 (prepend-alist-chain 'rawtext text '()) sorttext))
|
|
||||||
|
|
||||||
indexSection =
|
|
||||||
#(define-music-function (parser location sorttext text) (string? markup?)
|
|
||||||
"Add a section line to the alphabetical index, using @code{indexSectionMarkup} paper variable markup. This can be used to divide the alphabetical index into different sections, for example one section for each first letter."
|
|
||||||
(add-index-item! 'indexSectionMarkup (prepend-alist-chain 'combine-with-next #t (prepend-alist-chain 'rawtext text '())) sorttext))
|
|
||||||
|
|
||||||
#(define (extract-and-check-vars-from-header bookheader varlist)
|
|
||||||
(let* ((headervars (hash-map->list cons (struct-ref (ly:book-header bookheader) 0)))
|
|
||||||
(extract-var-and-check (lambda (headervar)
|
|
||||||
(let* ((variableref (assoc-ref headervars headervar))
|
|
||||||
(extracted (if variableref (variable-ref variableref) #f)))
|
|
||||||
(if (and extracted (not (and (string? extracted) (string-null? extracted)))) extracted #f)))))
|
|
||||||
(map (lambda (varsymbol)
|
|
||||||
(cons varsymbol (extract-var-and-check varsymbol))
|
|
||||||
) varlist)))
|
|
||||||
|
|
||||||
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))
|
|
||||||
(refComposerIds (find-author-ids-by 'meloref authors))
|
|
||||||
(voiceComposerData (find-author-id-with-part-numbers 'voice authors))
|
|
||||||
(compositionIds (find-author-ids-by 'composition authors))
|
|
||||||
(adaptionIds (find-author-ids-by 'adaption authors))
|
|
||||||
(bridgeIds (find-author-ids-by 'bridge authors))
|
|
||||||
(interludeIds (find-author-ids-by 'interlude authors)))
|
|
||||||
(delete-duplicates
|
|
||||||
(append poetIds translatorIds (map car versePoetData) composerIds (map car verseComposerData) refComposerIds (map car voiceComposerData) compositionIds adaptionIds bridgeIds interludeIds))
|
|
||||||
))
|
|
||||||
(let*
|
|
||||||
(
|
|
||||||
(extractedheadervars (extract-and-check-vars-from-header header '(title starttext alttitle categorytitle categories authors songnumber chapterref)))
|
|
||||||
(title (assq-ref extractedheadervars 'title))
|
|
||||||
(starttext (assq-ref extractedheadervars 'starttext))
|
|
||||||
(alttitle (assq-ref extractedheadervars 'alttitle))
|
|
||||||
(categorytitle (assq-ref extractedheadervars 'categorytitle))
|
|
||||||
(categories (assq-ref extractedheadervars 'categories))
|
|
||||||
(authors (assq-ref extractedheadervars 'authors))
|
|
||||||
(songnumber (assq-ref extractedheadervars 'songnumber))
|
|
||||||
(chapterref (assq-ref extractedheadervars 'chapterref))
|
|
||||||
(textoptions (lambda (text alternative) `(((rawtext . ,text) (alternative . ,alternative) (songnumber . ,songnumber)))))
|
|
||||||
(add-to-toc! (lambda (toctitle alternative)
|
|
||||||
(add-index-item! 'indexItemMarkup (textoptions toctitle alternative) toctitle label)))
|
|
||||||
)
|
|
||||||
(if categories (add-category-index-item! (string-tokenize categories) 'indexItemMarkup (textoptions (if categorytitle categorytitle title) #f) label))
|
|
||||||
(if authors (add-author-index-item! (all-author-ids authors) 'indexItemMarkup (textoptions (if categorytitle categorytitle title) #f) label))
|
|
||||||
(if chapterref (add-chapter-index-item! chapterref 'indexItemMarkup (textoptions (if categorytitle categorytitle title) #f) label))
|
|
||||||
(if starttext (add-to-toc! starttext #t))
|
|
||||||
(if alttitle
|
|
||||||
(if (list? alttitle)
|
|
||||||
(for-each (lambda (alt)
|
|
||||||
(add-to-toc! alt #t))
|
|
||||||
alttitle)
|
|
||||||
(add-to-toc! alttitle #t)))
|
|
||||||
(if title (add-to-toc! title #f) #{ #})
|
|
||||||
))
|
|
||||||
|
|
||||||
|
|
||||||
%% 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) ()
|
|
||||||
;; Dateiname wie bei \write-book-yaml/\write-book-chordpro: der
|
|
||||||
;; Ausgabename des Buchs mit angehaengtem .csv statt fest "toc.csv".
|
|
||||||
(define csv-filename (string-append (ly:parser-output-name) ".csv"))
|
|
||||||
(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 (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 year_adaption 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))
|
|
||||||
(refComposerIds (find-author-ids-by 'meloref authors))
|
|
||||||
(voiceComposerData (find-author-id-with-part-numbers 'voice authors))
|
|
||||||
(compositionIds (find-author-ids-by 'composition authors))
|
|
||||||
(adaptionTextIds (find-author-ids-by 'adaption_text authors))
|
|
||||||
(adaptionMusicIds (find-author-ids-by 'adaption_music authors))
|
|
||||||
(bridgeIds (find-author-ids-by 'bridge authors))
|
|
||||||
(interludeIds (find-author-ids-by 'interlude authors)))
|
|
||||||
(map csv-escape
|
|
||||||
(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 adaptionTextIds (map car versePoetData)))
|
|
||||||
(format-authors translatorIds)
|
|
||||||
(format-authors (append composerIds compositionIds adaptionMusicIds bridgeIds interludeIds (map car voiceComposerData) (map car verseComposerData) refComposerIds))
|
|
||||||
(headervar-or-empty 'year_text)
|
|
||||||
(headervar-or-empty 'year_melody)
|
|
||||||
(headervar-or-empty 'year_translation)
|
|
||||||
(headervar-or-empty 'year_composition)
|
|
||||||
(headervar-or-empty 'year_adaption_text)
|
|
||||||
(headervar-or-empty 'year_adaption_music)
|
|
||||||
(headervar-or-empty 'copyright)
|
|
||||||
(headervar-or-empty 'source)
|
|
||||||
(format-info-paragraphs (headervar-or-empty 'infotext))
|
|
||||||
(format-info-paragraphs (headervar-or-empty 'translation))
|
|
||||||
(format-info-paragraphs (headervar-or-empty 'pronunciation))
|
|
||||||
))))
|
|
||||||
(alist-delete 'markupPage (alist-delete 'imagePage (alist-delete 'emptyPage song-list))))))
|
|
||||||
(call-with-output-file csv-filename
|
|
||||||
(lambda (port)
|
|
||||||
(csv-write (cons '(
|
|
||||||
"filename"
|
|
||||||
"page-number"
|
|
||||||
"title"
|
|
||||||
"starttext"
|
|
||||||
"alttitle"
|
|
||||||
"categorytitle"
|
|
||||||
"categories"
|
|
||||||
"poets"
|
|
||||||
"translators"
|
|
||||||
"composers"
|
|
||||||
"year_text"
|
|
||||||
"year_melody"
|
|
||||||
"year_translation"
|
|
||||||
"year_composition"
|
|
||||||
"year_adaption_text"
|
|
||||||
"year_adaption_music"
|
|
||||||
"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-string-table)))
|
|
||||||
(generate-toc-csv (if (list? table) table '()))
|
|
||||||
empty-stencil)))))
|
|
||||||
@@ -1,65 +0,0 @@
|
|||||||
#(define (transliterate-de str)
|
|
||||||
"Gesamte Transliteration: entfernt Diakritika, ersetzt Sonderzeichen, ergibt ASCII-String."
|
|
||||||
|
|
||||||
(define (remove-diacritics s)
|
|
||||||
(string-join
|
|
||||||
(map (lambda (ch)
|
|
||||||
(let ((code (char->integer ch)))
|
|
||||||
;; Unicode-Bereich 0300–036F = Combining Diacritical Marks
|
|
||||||
(if (and (>= code #x0300) (<= code #x036F))
|
|
||||||
""
|
|
||||||
(string ch))))
|
|
||||||
(string->list (string-normalize-nfkd s)))
|
|
||||||
""))
|
|
||||||
|
|
||||||
(define transliteration-table
|
|
||||||
'(
|
|
||||||
;; Deutsche Umlaute & ß
|
|
||||||
("ä" . "ae") ("ö" . "oe") ("ü" . "ue")
|
|
||||||
("Ä" . "Ae") ("Ö" . "Oe") ("Ü" . "Ue")
|
|
||||||
("ß" . "ss")
|
|
||||||
|
|
||||||
;; Balkan & mitteleuropäische Sonderzeichen
|
|
||||||
("Č" . "C") ("č" . "c")
|
|
||||||
("Š" . "S") ("š" . "s")
|
|
||||||
("Ž" . "Z") ("ž" . "z")
|
|
||||||
("Đ" . "D") ("đ" . "d")
|
|
||||||
("Ł" . "L") ("ł" . "l")
|
|
||||||
("Ø" . "O") ("ø" . "o")
|
|
||||||
("Æ" . "Ae") ("æ" . "ae")
|
|
||||||
("Œ" . "Oe") ("œ" . "oe")
|
|
||||||
|
|
||||||
;; Kyrillische Buchstaben mit lateinischen Pendants
|
|
||||||
("А" . "A") ("а" . "a")
|
|
||||||
("Б" . "B") ("б" . "b")
|
|
||||||
("В" . "V") ("в" . "v")
|
|
||||||
("Г" . "G") ("г" . "g")
|
|
||||||
("Д" . "D") ("д" . "d")
|
|
||||||
("Е" . "E") ("е" . "e")
|
|
||||||
("З" . "Z") ("з" . "z")
|
|
||||||
("И" . "I") ("и" . "i")
|
|
||||||
("К" . "K") ("к" . "k")
|
|
||||||
("Л" . "L") ("л" . "l")
|
|
||||||
("М" . "M") ("м" . "m")
|
|
||||||
("Н" . "N") ("н" . "n")
|
|
||||||
("О" . "O") ("о" . "o")
|
|
||||||
("П" . "P") ("п" . "p")
|
|
||||||
("Р" . "R") ("р" . "r")
|
|
||||||
("С" . "S") ("с" . "s")
|
|
||||||
("Т" . "T") ("т" . "t")
|
|
||||||
("У" . "U") ("у" . "u")
|
|
||||||
("Ф" . "F") ("ф" . "f")
|
|
||||||
("Х" . "Kh") ("х" . "kh")
|
|
||||||
("Ц" . "Ts") ("ц" . "ts")
|
|
||||||
("Ч" . "Ch") ("ч" . "ch")
|
|
||||||
("Ш" . "Sh") ("ш" . "sh")
|
|
||||||
("Щ" . "Sch") ("щ" . "sch")
|
|
||||||
("Я" . "Ja") ("я" . "ja")
|
|
||||||
("Ю" . "Ju") ("ю" . "ju")
|
|
||||||
("Й" . "J") ("й" . "j")
|
|
||||||
))
|
|
||||||
|
|
||||||
(remove-diacritics
|
|
||||||
(fold (lambda (pair acc)
|
|
||||||
(ly:string-substitute (car pair) (cdr pair) acc))
|
|
||||||
str transliteration-table)))
|
|
||||||
@@ -1,5 +0,0 @@
|
|||||||
% this is just an empty dummy file to make conditional includes work so that relative pathes could be used
|
|
||||||
% this is working if #(ly:set-option 'relative-includes #t) was set:
|
|
||||||
% \include #(if condition relative/path/to/file.ly void.ly)
|
|
||||||
% but this does not work:
|
|
||||||
% #(if condition (ly:parser-include-string "\\include \"relative/path/to/file.ly\""))
|
|
||||||
@@ -1,4 +0,0 @@
|
|||||||
\include "../private_includes/book/book_include.ily"
|
|
||||||
\include "../private_includes/book/transliteration.ily"
|
|
||||||
\include "../private_includes/book/toc_include.ily"
|
|
||||||
\include "../private_includes/book/appendix.ily"
|
|
||||||
@@ -1,2 +0,0 @@
|
|||||||
\include "lilypond-book-preamble.ly"
|
|
||||||
#(ly:set-option 'separate-page-formats "pdf")
|
|
||||||
@@ -1,153 +0,0 @@
|
|||||||
MUSIC = { \transposable #TRANSPOSITION \MUSIC }
|
|
||||||
|
|
||||||
LAYOUT = \layout {
|
|
||||||
\LAYOUT
|
|
||||||
#(customized-layout LAYOUT)
|
|
||||||
}
|
|
||||||
|
|
||||||
verselayout = \layout {
|
|
||||||
\LAYOUT
|
|
||||||
\context {
|
|
||||||
\ChordNames
|
|
||||||
\override ChordName.font-size = \songTextChordFontSize
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
TEXT = \markuplist {
|
|
||||||
\override #`(transposition . ,TRANSPOSITION)
|
|
||||||
\override #`(verselayout . ,verselayout)
|
|
||||||
\override #`(verse-chords . ,#{ \chords { \verseChords } #})
|
|
||||||
\override #`(verse-reference-voice . ,#{ \global \firstVoice #})
|
|
||||||
\handle-tag-groups \recordedTagGroups
|
|
||||||
\TEXT
|
|
||||||
}
|
|
||||||
|
|
||||||
#(define TEXT_PAGES
|
|
||||||
(map
|
|
||||||
(lambda (text) #{
|
|
||||||
\markuplist {
|
|
||||||
\override #`(transposition . ,TRANSPOSITION)
|
|
||||||
\override #`(verselayout . ,verselayout)
|
|
||||||
\override #`(verse-chords . ,#{ \chords { \verseChords } #})
|
|
||||||
\override #`(verse-reference-voice . ,#{ \global \firstVoice #})
|
|
||||||
\handle-tag-groups \recordedTagGroups
|
|
||||||
#text
|
|
||||||
}
|
|
||||||
#})
|
|
||||||
(if
|
|
||||||
(and
|
|
||||||
(defined? 'TEXT_PAGES)
|
|
||||||
(pair? TEXT_PAGES))
|
|
||||||
TEXT_PAGES
|
|
||||||
(list TEXT))))
|
|
||||||
|
|
||||||
%% Add invisible ChordPro write trigger to last TEXT_PAGES markuplist
|
|
||||||
#(when (and (defined? 'chordpro-export-enabled) chordpro-export-enabled (pair? TEXT_PAGES))
|
|
||||||
(let* ((last-index (- (length TEXT_PAGES) 1))
|
|
||||||
(last-page (list-ref TEXT_PAGES last-index))
|
|
||||||
(modified-last-page #{
|
|
||||||
\markuplist {
|
|
||||||
#last-page
|
|
||||||
\chordpro-delayed-write
|
|
||||||
}
|
|
||||||
#}))
|
|
||||||
(set! TEXT_PAGES
|
|
||||||
(append (list-head TEXT_PAGES last-index)
|
|
||||||
(list modified-last-page)))))
|
|
||||||
|
|
||||||
#(define (add-text-pages text-pages)
|
|
||||||
(if (pair? text-pages)
|
|
||||||
(begin
|
|
||||||
(add-score (car text-pages))
|
|
||||||
(for-each
|
|
||||||
(lambda (text)
|
|
||||||
(add-music (pageBreak))
|
|
||||||
(add-score text))
|
|
||||||
(cdr text-pages)))))
|
|
||||||
|
|
||||||
#(if (not noStandaloneOutput)
|
|
||||||
(begin
|
|
||||||
(let ((header (ly:book-header HEADER)) (paper (ly:book-paper HEADER)))
|
|
||||||
(if header (set! $defaultheader header))
|
|
||||||
(if paper (set! $defaultpaper paper))
|
|
||||||
)
|
|
||||||
|
|
||||||
;; Meta-Daten des Liedes als YAML neben die Ausgabedatei schreiben
|
|
||||||
;; (<ly:parser-output-name>.yml, landet wie das PDF relativ zum
|
|
||||||
;; Arbeitsverzeichnis). Die Textseiten-Strophen kommen aus dem
|
|
||||||
;; Render-Collector (chordpro.ily), deshalb wird erst bei der Ausgabe
|
|
||||||
;; geschrieben: unsichtbarer delayed Stencil an der letzten Textseite.
|
|
||||||
;; Ohne (nicht-leere) Textseiten gibt es keine Collector-Daten und die
|
|
||||||
;; yml wird sofort geschrieben.
|
|
||||||
(when (and (defined? 'yaml-export-enabled) yaml-export-enabled)
|
|
||||||
;; Collector-Daten auch ohne ChordPro-Flag unter dem Ausgabenamen sammeln
|
|
||||||
(set! chordpro-default-song-key (ly:parser-output-name))
|
|
||||||
(if (any pair? TEXT_PAGES)
|
|
||||||
(let* ((last-index (- (length TEXT_PAGES) 1))
|
|
||||||
(last-page (list-ref TEXT_PAGES last-index))
|
|
||||||
(trigger-stencil (yaml-delayed-song-write
|
|
||||||
(ly:parser-output-name) HEADER MUSIC))
|
|
||||||
(modified-last-page #{
|
|
||||||
\markuplist {
|
|
||||||
#last-page
|
|
||||||
\stencil #trigger-stencil
|
|
||||||
}
|
|
||||||
#}))
|
|
||||||
(set! TEXT_PAGES
|
|
||||||
(append (list-head TEXT_PAGES last-index)
|
|
||||||
(list modified-last-page))))
|
|
||||||
(scm->yml-file
|
|
||||||
(string-append (ly:parser-output-name) ".yml")
|
|
||||||
(extract-song-data HEADER MUSIC #f (ly:parser-output-name)))))
|
|
||||||
|
|
||||||
;; ChordPro export (Einzellied): Song-Key ist der Ausgabename (die .cho
|
|
||||||
;; landet wie das PDF relativ zum Arbeitsverzeichnis); Titel/Autoren
|
|
||||||
;; kommen aus HEADER in den per-Song-Store.
|
|
||||||
(when (and (defined? 'chordpro-export-enabled) chordpro-export-enabled)
|
|
||||||
(set! chordpro-default-song-key (ly:parser-output-name))
|
|
||||||
(chordpro-register-song-metadata chordpro-default-song-key HEADER))
|
|
||||||
|
|
||||||
;; ChordPro_music_collector (Strophen unter den Noten, siehe chordpro.ily)
|
|
||||||
;; braucht den aktiven Song-Key VOR der Interpretation des Hauptscores.
|
|
||||||
;; \consists nur bei chordpro-include-music-lyrics -- sonst keine Kosten
|
|
||||||
;; (Grob-Acknowledger fuer JEDEN Akkord/jede Silbe/Strophenmarker des
|
|
||||||
;; Hauptscores) fuer Lieder/Buecher, die das Feature nicht nutzen. Bewusst
|
|
||||||
;; NICHT zusaetzlich an chordpro-export-enabled gekoppelt: die Flag ist
|
|
||||||
;; eigenstaendig gedacht (steuert nur, ob \chordpro-delayed-write bzw.
|
|
||||||
;; \write-book-chordpro am Ende tatsaechlich etwas schreiben -- ob dafuer
|
|
||||||
;; Daten gesammelt wurden, ist eine davon unabhaengige Entscheidung).
|
|
||||||
(set! chordpro-active-song-key (ly:parser-output-name))
|
|
||||||
(if (and (defined? 'chordpro-include-music-lyrics) chordpro-include-music-lyrics)
|
|
||||||
(add-score #{
|
|
||||||
\score {
|
|
||||||
\MUSIC
|
|
||||||
\layout {
|
|
||||||
\LAYOUT
|
|
||||||
\context {
|
|
||||||
\Score
|
|
||||||
\consists \ChordPro_music_collector
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}#})
|
|
||||||
(add-score #{
|
|
||||||
\score {
|
|
||||||
\MUSIC
|
|
||||||
\layout { \LAYOUT }
|
|
||||||
}#}))
|
|
||||||
(add-text-pages TEXT_PAGES)
|
|
||||||
|
|
||||||
(add-score #{
|
|
||||||
\score {
|
|
||||||
\unfoldRepeats { \MUSIC \INLINESCOREMUSIC }
|
|
||||||
\midi {
|
|
||||||
\context {
|
|
||||||
\Staff
|
|
||||||
\remove "Staff_performer"
|
|
||||||
}
|
|
||||||
\context {
|
|
||||||
\Voice
|
|
||||||
\consists "Staff_performer"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}#})
|
|
||||||
))
|
|
||||||
@@ -1,5 +0,0 @@
|
|||||||
#(ly:set-option 'relative-includes #t)
|
|
||||||
|
|
||||||
#(define noDefaultOutput #t)
|
|
||||||
|
|
||||||
\include "../private_includes/base/all.ily"
|
|
||||||
@@ -1,7 +0,0 @@
|
|||||||
#(define noDefaultOutput (if (defined? 'noDefaultOutput) noDefaultOutput #f))
|
|
||||||
HEADER = \bookpart {
|
|
||||||
\header {
|
|
||||||
\basicSongInfo
|
|
||||||
}
|
|
||||||
}
|
|
||||||
\include #(if noDefaultOutput "../private_includes/void.ily" "layout_bottom.ily")
|
|
||||||
@@ -1,5 +0,0 @@
|
|||||||
#(ly:set-option 'relative-includes #t)
|
|
||||||
|
|
||||||
#(define noDefaultOutput (if (defined? 'noDefaultOutput) noDefaultOutput #f))
|
|
||||||
|
|
||||||
\include #(if noDefaultOutput "../private_includes/void.ily" "../private_includes/base/all.ily")
|
|
||||||
@@ -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
@@ -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)) '())) #{ #})
|
||||||
|
))
|
||||||
Reference in New Issue
Block a user