From 7e44642855e2ba50958b0c43927780f9b72efcb4 Mon Sep 17 00:00:00 2001 From: tux Date: Sat, 22 Jul 2023 22:07:57 +0200 Subject: [PATCH] Skripte aus dem Bock repo --- book_include.ly | 369 +++++++++++++++ general_include.ly | 744 +++++++++++++++++++++++++++++++ legacy-lilypond-compatibility.ly | 27 ++ styles.ly | 16 + toc_include.ly | 304 +++++++++++++ 5 files changed, 1460 insertions(+) create mode 100644 book_include.ly create mode 100644 general_include.ly create mode 100644 legacy-lilypond-compatibility.ly create mode 100644 styles.ly create mode 100644 toc_include.ly diff --git a/book_include.ly b/book_include.ly new file mode 100644 index 0000000..b405667 --- /dev/null +++ b/book_include.ly @@ -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) stringnumber (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) + )) diff --git a/general_include.ly b/general_include.ly new file mode 100644 index 0000000..09fe682 --- /dev/null +++ b/general_include.ly @@ -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 +} \ No newline at end of file diff --git a/legacy-lilypond-compatibility.ly b/legacy-lilypond-compatibility.ly new file mode 100644 index 0000000..ea6659e --- /dev/null +++ b/legacy-lilypond-compatibility.ly @@ -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))))) diff --git a/styles.ly b/styles.ly new file mode 100644 index 0000000..7cbe6ee --- /dev/null +++ b/styles.ly @@ -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)) \ No newline at end of file diff --git a/toc_include.ly b/toc_include.ly new file mode 100644 index 0000000..f6a990e --- /dev/null +++ b/toc_include.ly @@ -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-cisymbol 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)) '())) #{ #}) + ))