2023-07-22 22:07:57 +02:00
% 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 "Т
(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
2023-07-23 12:18:14 +02:00
(make-columnlayout-markup-list songTocColumns 2
2023-07-22 22:07:57 +02:00
(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
2023-07-23 12:18:14 +02:00
(make-columnlayout-markup-list songTocColumns 2
2023-07-22 22:07:57 +02:00
(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)) '())) #{ #})
))
