10 Commits

12 changed files with 384 additions and 193 deletions

View File

@@ -21,9 +21,19 @@
))))) )))))
(scm-load "resolve_inherits.scm") (scm-load "resolve_inherits.scm")
(scm-load "yaml_parser.scm"))) (scm-load "yaml_parser.scm")))
#(define AUTHOR_DATA (if (defined? 'AUTHOR_DATA) AUTHOR_DATA (parse-yml-file "../../lilypond-song-includes/data/authors.yml")))
#(define SONG_DATA (if (defined? 'SONG_DATA) SONG_DATA (parse-yml-file "../../lilypond-song-includes/data/songs.yml")))
#(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 "basic_format_and_style_settings.ily"
\include "eps_file_from_song_dir.ily" \include "eps_file_from_song_dir.ily"
\include "title_with_category_images.ily" \include "title_with_category_images.ily"

View File

@@ -44,7 +44,7 @@ generalLayout = \layout {
\context { \context {
\Staff \Staff
\accidentalStyle modern-voice-cautionary \accidentalStyle modern-voice-cautionary
\consists Merge_rests_engraver \consists \Better_Merge_rests_engraver
} }
\context { \context {
\Score \Score
@@ -67,10 +67,13 @@ generalLayout = \layout {
% ich will lines breaken wie ich will! % ich will lines breaken wie ich will!
\remove "Forbid_line_break_engraver" \remove "Forbid_line_break_engraver"
\override NoteHead.layer = 2 \override NoteHead.layer = 2
\override Rest.layer = 2
\override Dots.layer = 2 \override Dots.layer = 2
\override Stem.layer = 2 \override Stem.layer = 2
\override Flag.layer = 2 \override Flag.layer = 2
\override Beam.layer = 2 \override Beam.layer = 2
\override Slur.layer = 2
\override Tie.layer = 2
\override Accidental.layer = 2 \override Accidental.layer = 2
} }
} }
@@ -83,25 +86,34 @@ textp = \lyricmode { \markup { \raise #1 \musicglyph #"rests.3" } }
% zweite Stimme alles grau % zweite Stimme alles grau
secondVoiceStyle = { secondVoiceStyle = {
\override NoteHead.color = #grey \override NoteHead.color = #grey
\override Rest.color = #grey
\override Dots.color = #grey \override Dots.color = #grey
\override Stem.color = #grey \override Stem.color = #grey
\override Flag.color = #grey \override Flag.color = #grey
\override Beam.color = #grey \override Beam.color = #grey
\override Slur.color = #grey
\override Tie.color = #grey
\override Accidental.color = #grey \override Accidental.color = #grey
\override NoteHead.layer = 1 \override NoteHead.layer = 1
\override Rest.layer = 1
\override Dots.layer = 1 \override Dots.layer = 1
\override Stem.layer = 1 \override Stem.layer = 1
\override Flag.layer = 1 \override Flag.layer = 1
\override Beam.layer = 1 \override Beam.layer = 1
\override Slur.layer = 1
\override Tie.layer = 1
\override Accidental.layer = 1 \override Accidental.layer = 1
} }
firstVoiceStyle = { firstVoiceStyle = {
\override NoteHead.color = #black \override NoteHead.color = #black
\override Rest.color = #black
\override Dots.color = #black \override Dots.color = #black
\override Stem.color = #black \override Stem.color = #black
\override Flag.color = #black \override Flag.color = #black
\override Beam.color = #black \override Beam.color = #black
\override Slur.color = #black
\override Tie.color = #black
\override Accidental.color = #black \override Accidental.color = #black
} }
@@ -115,23 +127,23 @@ romanStanza =
#{ \override StanzaNumber.style = #'roman #}) #{ \override StanzaNumber.style = #'roman #})
override-stanza = override-stanza =
#(define-music-function (parser location stanzanumber) (number?) #(define-music-function (parser location stanzanumbers) (number-list?)
#{ #{
\once \override StanzaNumber.forced-spacing = #stanzanumber % misuse property "forced-spacing" to override the stanzanumber \once \override StanzaNumber.details.custom-stanzanumber-override = #stanzanumbers
#} #}
) )
#(define (stanza . stanzanumbers) #(define (stanza . stanzanumbers)
#{ #{
\once \override StanzaNumber.layer = 23 % set this to signal that there is a real stanza and no repeat signs \once \override StanzaNumber.details.custom-realstanza = ##t % set this to signal that there is a real stanza and no repeat signs
\applyContext \applyContext
#(lambda (context) #(lambda (context)
(let* ((stanzanumber-override (ly:assoc-get 'forced-spacing (ly:context-grob-definition context 'StanzaNumber) #f)) (let* ((stanzanumbers-override (ly:assoc-get 'custom-stanzanumber-override (ly:assoc-get 'details (ly:context-grob-definition context 'StanzaNumber) '()) #f))
(stanza-style (ly:assoc-get 'style (ly:context-grob-definition context 'StanzaNumber))) (stanza-style (ly:assoc-get 'style (ly:context-grob-definition context 'StanzaNumber)))
(stanza-format (lambda (stanzanumber) (format #f (if (eq? stanza-style 'roman) romanStanzaFormat stanzaFormat) stanzanumber)))) (stanza-format (lambda (stanzanumber) (format #f (if (eq? stanza-style 'roman) romanStanzaFormat stanzaFormat) stanzanumber))))
(ly:context-set-property! context 'stanza (ly:context-set-property! context 'stanza
(string-join (map stanza-format (string-join (map stanza-format
(if stanzanumber-override (list stanzanumber-override) stanzanumbers)) (if stanzanumbers-override stanzanumbers-override stanzanumbers))
", ")))) ", "))))
#} #}
) )
@@ -139,7 +151,7 @@ override-stanza =
ref = ref =
#(define-music-function (stanzanumbers lyrics) ((number-list? (list)) ly:music?) #(define-music-function (stanzanumbers lyrics) ((number-list? (list)) ly:music?)
#{ \lyricmode { #{ \lyricmode {
\once \override StanzaNumber.layer = 23 % set this to signal that there is a real stanza and no repeat signs \once \override StanzaNumber.details.custom-realstanza = ##t % set this to signal that there is a real stanza and no repeat signs
\set stanza = #(make-on-the-fly-markup (lambda (layout props m) ((ly:output-def-lookup layout 'refMarkupFormatter) layout props stanzanumbers)) (make-null-markup)) \set stanza = #(make-on-the-fly-markup (lambda (layout props m) ((ly:output-def-lookup layout 'refMarkupFormatter) layout props stanzanumbers)) (make-null-markup))
#lyrics #lyrics
} }
@@ -147,13 +159,13 @@ ref =
) )
% prints a repStart Sign as stanza if the tag 'repeats is kept. % 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.layer = 23 we set that also as stanza. % if there was a stanza already set by the stanza function with StanzaNumber.details.custom-realstanza = ##t we set that also as stanza.
repStartWithTag = \lyricmode { repStartWithTag = \lyricmode {
\tag #'repeats { \tag #'repeats {
\applyContext \applyContext
#(lambda (context) #(lambda (context)
(let ((lastStanza (ly:context-property context 'stanza)) (let ((lastStanza (ly:context-property context 'stanza))
(printLastStanza (= (ly:assoc-get 'layer (ly:context-grob-definition context 'StanzaNumber) 0) 23)) (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))) (stanzaFontSeries (ly:assoc-get 'font-series (ly:context-grob-definition context 'StanzaNumber) 'normal)))
(ly:context-set-property! context 'stanza (ly:context-set-property! context 'stanza
(make-concat-markup (make-concat-markup

View File

@@ -52,7 +52,7 @@
(lambda (paragraph) (lambda (paragraph)
(make-wordwrap-internal-markup-list #t (make-wordwrap-internal-markup-list #t
#{ \markuplist { $(ly:parser-include-string paragraph) } #})) #{ \markuplist { $(ly:parser-include-string paragraph) } #}))
(ly:regex-split (ly:make-regex "\n[ \t\n]*\n[ \t\n]*") (string-append prefix text)))) (ly:regex-split (ly:make-regex "\r?\n[ \t\r\n]*\n[ \t\r\n]*") (string-append prefix text))))
'()))) '())))
(poet-and-composer-markup-list (poet-and-composer-markup-list
(string-with-paragraphs->markuplist "" (string-append (string-with-paragraphs->markuplist "" (string-append

View File

@@ -242,13 +242,23 @@
`(line-width . ,(* (chain-assoc-get 'header:songinfo-size-factor props songInfoLineWidthFraction) (ly:output-def-lookup layout 'line-width))) `(line-width . ,(* (chain-assoc-get 'header:songinfo-size-factor props songInfoLineWidthFraction) (ly:output-def-lookup layout 'line-width)))
arg))) 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 { \paper {
print-first-page-number = ##t print-first-page-number = ##t
first-page-number = #0 first-page-number = #0
oddFooterMarkup = \markup { oddFooterMarkup = \markup {
\fill-line { \fill-line {
\line { \null } \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 \on-last-page-of-part \general-align #Y #DOWN \fractional-line-width \print-songinfo }
\line { \if \should-print-page-number \print-pagenumber } \line { \if \should-print-page-number \print-pagenumber }
} }
@@ -257,7 +267,7 @@
\fill-line { \fill-line {
\line { \if \should-print-page-number \print-pagenumber } \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 { \if \on-last-page-of-part \general-align #Y #DOWN \fractional-line-width \print-songinfo }
\line { \null } \line { \page-number-to-pdf-label \null }
} }
} }
} }

View File

@@ -0,0 +1,86 @@
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)))))))

View File

@@ -1,7 +1,10 @@
(use-modules (ice-9 rdelim) (ice-9 regex) (ice-9 pretty-print) (srfi srfi-1)) (use-modules (ice-9 rdelim) (ice-9 regex) (ice-9 pretty-print) (srfi srfi-1))
;; Utility: Zeile einlesen ;; Hauptparsingfunktion
(define (read-lines filename) (define (yml-file->scm filename)
;; Utility: Zeile einlesen
(define (read-lines filename)
(call-with-input-file filename (call-with-input-file filename
(lambda (port) (lambda (port)
(let loop ((lines '())) (let loop ((lines '()))
@@ -13,30 +16,30 @@
(loop lines) ;; Ignoriere "---" oder leere Zeile (loop lines) ;; Ignoriere "---" oder leere Zeile
(loop (cons line lines)))))))))) (loop (cons line lines))))))))))
;; Einrückung bestimmen (Anzahl Leerzeichen am Anfang) ;; Einrückung bestimmen (Anzahl Leerzeichen am Anfang)
(define (line-indent line) (define (line-indent line)
(let ((match (string-match "^ *" line))) (let ((match (string-match "^ *" line)))
(if match (if match
(match:end match) ; Anzahl der Leerzeichen = Position nach Leerzeichen (match:end match) ; Anzahl der Leerzeichen = Position nach Leerzeichen
0))) ; Falls kein Match → 0 0))) ; Falls kein Match → 0
;; Kommentar entfernen ;; Kommentar entfernen
(define (strip-comment line) (define (strip-comment line)
(let ((m (string-match "#.*" line))) (let ((m (string-match "#.*" line)))
(if m (if m
(string-trim-right (string-take line (match:start m))) (string-trim-right (string-take line (match:start m)))
line))) line)))
;; Hilfsfunktion: Whitespace entfernen ;; Hilfsfunktion: Whitespace entfernen
(define (clean-line line) (define (clean-line line)
(string-trim (strip-comment line))) (string-trim (strip-comment line)))
;; Ist Zeile leer (nach Entfernen von Kommentar & Whitespace)? ;; Ist Zeile leer (nach Entfernen von Kommentar & Whitespace)?
(define (blank-or-comment? line) (define (blank-or-comment? line)
(string-null? (clean-line line))) (string-null? (clean-line line)))
;; Skalare Werte interpretieren ;; Skalare Werte interpretieren
(define (parse-scalar str) (define (parse-scalar str)
(define (strip-quotes s) (define (strip-quotes s)
(cond (cond
((and (string-prefix? "\"" s) (string-suffix? "\"" s)) ((and (string-prefix? "\"" s) (string-suffix? "\"" s))
@@ -54,13 +57,9 @@
((string=? s "null") '()) ((string=? s "null") '())
(else s)))) (else s))))
;; Hauptparsingfunktion
(define (yml-file->scm filename)
(let ((lines (read-lines filename)))
(parse-lines lines 0)))
;; Hilfsfunktion: Zeilen mit gleicher oder höherer Einrückung sammeln ;; Hilfsfunktion: Zeilen mit gleicher oder höherer Einrückung sammeln
(define (take-indented lines min-indent) (define (take-indented lines min-indent)
(let loop ((ls lines) (acc '())) (let loop ((ls lines) (acc '()))
(if (null? ls) (if (null? ls)
(reverse acc) (reverse acc)
@@ -70,15 +69,15 @@
(loop (cdr ls) (cons line acc)) (loop (cdr ls) (cons line acc))
(reverse acc)))))) (reverse acc))))))
;; Hilfsfunktion: N Zeilen überspringen ;; Hilfsfunktion: N Zeilen überspringen
(define (drop lst n) (define (drop lst n)
(let loop ((l lst) (i n)) (let loop ((l lst) (i n))
(if (or (zero? i) (null? l)) (if (or (zero? i) (null? l))
l l
(loop (cdr l) (- i 1))))) (loop (cdr l) (- i 1)))))
;; Listenparsing: Liest Zeilen mit `-` als Listeneinträge ;; Listenparsing: Liest Zeilen mit `-` als Listeneinträge
(define (parse-list lines current-indent) (define (parse-list lines current-indent)
(let loop ((ls lines) (result '())) (let loop ((ls lines) (result '()))
(if (null? ls) (if (null? ls)
(reverse result) (reverse result)
@@ -101,8 +100,8 @@
;; Nicht mehr Teil der Liste ;; Nicht mehr Teil der Liste
(reverse result)))))) (reverse result))))))
;; Hauptparser für Key-Value oder Listen ;; Hauptparser für Key-Value oder Listen
(define (parse-lines lines current-indent) (define (parse-lines lines current-indent)
(let loop ((ls lines) (result '())) (let loop ((ls lines) (result '()))
(if (null? ls) (if (null? ls)
(reverse result) (reverse result)
@@ -149,4 +148,7 @@
(loop (cdr ls) result)))) (loop (cdr ls) result))))
))))) )))))
(let ((lines (read-lines filename)))
(parse-lines lines 0)))
(define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename))) (define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename)))

View File

@@ -28,13 +28,15 @@
#(define pdf-encode (@@ (lily framework-ps) pdf-encode)) #(define pdf-encode (@@ (lily framework-ps) pdf-encode))
% PDF tags % PDF tags
#(define-markup-command (title-to-pdf-toc layout props title) (string?) #(define-markup-command (title-to-pdf-toc layout props title) (string?)
(if (string-null? title)
empty-stencil
(ly:make-stencil (ly:make-stencil
(list 'embedded-ps (list 'embedded-ps
(ly:format (ly:format
"[/Action /GoTo /View [/XYZ -4 currentpagedevice /PageSize get 1 get 4 add null] /Title (~a) /OUT pdfmark" (pdf-encode title))) "[/Action /GoTo /View [/XYZ -4 currentpagedevice /PageSize get 1 get 4 add null] /Title (~a) /OUT pdfmark" (pdf-encode title)))
empty-interval empty-interval empty-interval empty-interval
;'(0 . 0) '(0 . 0) ;'(0 . 0) '(0 . 0)
)) )))
#(define-markup-command (title-with-category-images layout props right)(boolean?) #(define-markup-command (title-with-category-images layout props right)(boolean?)
(interpret-markup layout props (interpret-markup layout props

View File

@@ -280,6 +280,7 @@
\context { \context {
\Lyrics \Lyrics
\override VerticalAxisGroup.nonstaff-relatedstaff-spacing.basic-distance = #verse-text-chord-distance \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.parent-alignment-X = #LEFT
\override LyricText.self-alignment-X = #LEFT \override LyricText.self-alignment-X = #LEFT
\override LyricText.word-space = 0.8 \override LyricText.word-space = 0.8

View File

@@ -65,7 +65,10 @@ additionalPageNumbers =
display-pages-list display-pages-list
) )
% 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) #(define-markup-command (custom-page-number layout props label real-current-page-number)
(symbol? number?) (symbol? number?)
#:category other #:category other
@@ -89,9 +92,10 @@ width may require additional tweaking.)"
,(delay (ly:stencil-expr ,(delay (ly:stencil-expr
(let* ((display-page (assq-ref (build-display-pages-list layout) label)) (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)) (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 (page-markup
(if (assq-ref additional-page-switch-label-list label) (if (assq-ref additional-page-switch-label-list label)
(make-concat-markup (list (number-format 'arabic display-page) (make-concat-markup (list (number-format number-type display-page)
(make-char-markup (+ 97 (- real-current-page (real-page-number layout (make-char-markup (+ 97 (- real-current-page (real-page-number layout
(let find-earliest-additional-label (let find-earliest-additional-label
((rest-additional-page-switch-label-list (member (cons label #t) additional-page-switch-label-list))) ((rest-additional-page-switch-label-list (member (cons label #t) additional-page-switch-label-list)))
@@ -99,7 +103,7 @@ width may require additional tweaking.)"
(find-earliest-additional-label (cdr rest-additional-page-switch-label-list)) (find-earliest-additional-label (cdr rest-additional-page-switch-label-list))
(caar 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)))) (number-format number-type (+ display-page (- real-current-page (real-page-number layout label))))
)) ))
(page-stencil (interpret-markup layout props page-markup)) (page-stencil (interpret-markup layout props page-markup))
(gap (- (interval-length x-ext) (gap (- (interval-length x-ext)

View File

@@ -61,20 +61,9 @@
;; We insert index items sorted from the beginning on and do ;; We insert index items sorted from the beginning on and do
;; not sort them later - this saves pretty much computing time ;; not sort them later - this saves pretty much computing time
(insert-alphabetical-sorted! (list label markup-symbol textoptions (insert-alphabetical-sorted! (list label markup-symbol textoptions
;; 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 "" "" (ly:string-substitute "." ""
(ly:string-substitute "Č" "C" (transliterate-de sorttext))))
(ly:string-substitute "Đ" "D"
(ly:string-substitute "Š" "S"
(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)) index-item-list))
(make-music 'EventChord (make-music 'EventChord
'page-marker #t 'page-marker #t
@@ -101,7 +90,7 @@
(for-each (lambda (category) (for-each (lambda (category)
(let* ((catsym (string->symbol category)) (let* ((catsym (string->symbol category))
(catlist (hashq-ref category-index-hash catsym (catlist (hashq-ref category-index-hash catsym
(list (list label 'indexCategoryMarkup `(((rawtext . ,category)))))))) (list (list label 'indexCategoryMarkup `(((combine-with-next . #t) (rawtext . ,category))))))))
(if (assq catsym category-names) (if (assq catsym category-names)
(hashq-set! category-index-hash catsym (hashq-set! category-index-hash catsym
(cons (list label markup-symbol textoptions) catlist)) (cons (list label markup-symbol textoptions) catlist))
@@ -125,7 +114,7 @@
(for-each (lambda (authorID) (for-each (lambda (authorID)
(let* ((authorsym (string->symbol authorID)) (let* ((authorsym (string->symbol authorID))
(authorlist (hashq-ref author-index-hash authorsym (authorlist (hashq-ref author-index-hash authorsym
(list (list label 'indexAuthorMarkup `(((rawtext . ,authorID)))))))) (list (list label 'indexAuthorMarkup `(((combine-with-next . #t) (rawtext . ,authorID))))))))
(hashq-set! author-index-hash authorsym (hashq-set! author-index-hash authorsym
(cons (list label markup-symbol textoptions) authorlist)) (cons (list label markup-symbol textoptions) authorlist))
)) ))
@@ -229,7 +218,7 @@
} }
#(define (prepare-item-markup items layout) #(define (prepare-item-markup items layout)
(map (lambda (index-item) (define (single-item-markup index-item)
(let* ((label (car index-item)) (let* ((label (car index-item))
(index-markup (cadr index-item)) (index-markup (cadr index-item))
(textoptions (caddr index-item)) (textoptions (caddr index-item))
@@ -242,7 +231,16 @@
#:override (cons 'index:alternative alternative) #:override (cons 'index:alternative alternative)
#:override (cons 'index:songnumber songnumber) #:override (cons 'index:songnumber songnumber)
(ly:output-def-lookup layout index-markup)))) (ly:output-def-lookup layout index-markup))))
(items))) (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?) #(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" ) ( _i "Outputs index alphabetical sorted or in categories" )
@@ -256,7 +254,7 @@
(make-columnlayout-markup-list songTocColumns 2 (make-columnlayout-markup-list songTocColumns 2
(let ((h (- (ly:output-def-lookup layout 'paper-height) 12))) (let ((h (- (ly:output-def-lookup layout 'paper-height) 12)))
(cons (- h (interval-length (ly:stencil-extent title Y))) h)) (cons (- h (interval-length (ly:stencil-extent title Y))) h))
(prepare-item-markup items layout)))))) (prepare-item-markup (items) layout))))))
indexItem = indexItem =
#(define-music-function (parser location sorttext text) (string? markup?) #(define-music-function (parser location sorttext text) (string? markup?)
@@ -266,7 +264,7 @@ indexItem =
indexSection = indexSection =
#(define-music-function (parser location sorttext text) (string? markup?) #(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 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 'rawtext text '()) sorttext)) (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) #(define (extract-and-check-vars-from-header bookheader varlist)
(let* ((headervars (hash-map->list cons (struct-ref (ly:book-header bookheader) 0))) (let* ((headervars (hash-map->list cons (struct-ref (ly:book-header bookheader) 0)))

View File

@@ -0,0 +1,65 @@
#(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 0300036F = 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)))

View File

@@ -1,3 +1,4 @@
\include "../private_includes/book/book_include.ily" \include "../private_includes/book/book_include.ily"
\include "../private_includes/book/transliteration.ily"
\include "../private_includes/book/toc_include.ily" \include "../private_includes/book/toc_include.ily"
\include "../private_includes/book/appendix.ily" \include "../private_includes/book/appendix.ily"