% 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 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-with-link-symbol-ref-markup 'index:label (make-fill-with-pattern-markup 1 RIGHT "." (car revlist) page)) (cdr revlist))))))))) \paper { indexItemMarkup = \markup { \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 } } #(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 (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))) (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 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)) #(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)) '())) #{ #}) ))