305 lines
14 KiB
Plaintext
305 lines
14 KiB
Plaintext
|
% 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)) '())) #{ #})
|
|||
|
|
))
|