370 lines
14 KiB
Plaintext
370 lines
14 KiB
Plaintext
|
\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) string<?) "\n")
|
||
|
|
opticalline
|
||
|
|
) "\n" )
|
||
|
|
)))
|
||
|
|
|
||
|
|
%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||
|
|
%% Include Images once and reference them:
|
||
|
|
#(define bbox-regexp
|
||
|
|
(make-regexp "%%BoundingBox:[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)"))
|
||
|
|
|
||
|
|
#(define (get-postscript-bbox string)
|
||
|
|
"Extract the bbox from STRING, or return #f if not present."
|
||
|
|
(let*
|
||
|
|
((match (regexp-exec bbox-regexp string)))
|
||
|
|
|
||
|
|
(if match
|
||
|
|
(map (lambda (x)
|
||
|
|
(string->number (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)
|
||
|
|
))
|