| blob | f92094d8770e79bff84e65b478250354a4947a38 |
1 %%% fancy-headers.ily -- print fancy page headers
2 %%%
3 %%% Author: Nicolas Sceaux <nicolas.sceaux@free.fr>
4 %%%
5 %%% Services
6 %%% ========
7 %%% Define two scheme functions:
8 %%% (add-odd-page-header-text parser text display-first)
9 %%% (add-even-page-header-text parser text display-first)
10 %%% Set odd and even page header, respectively, to `text'.
11 %%% If `display-first' is false, then `text' will not be displayed
12 %%% on the first page it has been added, only on the following ones.
13 %%% `parser' is the lilypond parser object.
14 %%%
15 %%% Define two markup commands:
16 %%% \odd-header
17 %%% Interpret the odd page headers, based on header text that have
18 %%% been added using `add-odd-page-header-text'.
19 %%%
20 %%% \even-header
21 %%% Interpret the even page headers, based on header text that have
22 %%% been added using `add-even-page-header-text'.
23 %%%
24 %%% Set evenHeaderMarkup and oddHeaderMarkup \paper variables.
25 %%%
26 %%%
27 %%% Dependencies
28 %%% ============
29 %%% None
30 %%%
32 #(define-markup-command (page-header layout props text) (markup?)
33 (let* ((page-number (chain-assoc-get 'page:page-number props -1))
34 (page-number-markup (number->string page-number))
35 (text-markup (markup #:italic (or text ""))))
36 (if (or (= page-number 1) (not text))
37 empty-stencil
38 (interpret-markup layout props
39 (if (odd? page-number)
40 (markup #:fill-line (#:null text-markup page-number-markup))
41 (markup #:fill-line (page-number-markup text-markup #:null)))))))
43 #(define-public add-odd-page-header-text #f)
44 #(define-public add-even-page-header-text #f)
45 #(define-public in-music-add-odd-page-header-text #f)
46 #(define-public in-music-add-even-page-header-text #f)
47 #(define header-markup-aux #f)
48 #(let ((odd-label-header-table (list))
49 (odd-page-header-table (list))
50 (even-label-header-table (list))
51 (even-page-header-table (list)))
52 (set! header-markup-aux
53 (lambda (layout props odd)
54 (define (page-text page-number table)
55 (if (null? table)
56 ""
57 (let* ((elment (car table))
58 (p (car elment))
59 (text (cadr elment))
60 (display-1st (caddr elment)))
61 (cond ((and (= page-number p) (not display-1st)) #f)
62 ((>= page-number p) text)
63 (else (page-text page-number (cdr table)))))))
64 (ly:make-stencil
65 `(delay-stencil-evaluation
66 ,(delay (ly:stencil-expr
67 (begin
68 (if (or (and odd (null? odd-page-header-table))
69 (and (not odd) (null? even-page-header-table)))
70 (let ((page-header-table (list)))
71 (for-each (lambda (label-header)
72 (let* ((label (car label-header))
73 (text-disp (cdr label-header))
74 (table (ly:output-def-lookup layout 'label-page-table))
75 (label-page (and (list? table) (assoc label table)))
76 (page-number (and label-page (cdr label-page)))
77 (prev-value (and page-number (assoc page-number page-header-table))))
78 (if (not prev-value)
79 (set! page-header-table (cons (cons page-number text-disp)
80 page-header-table))
81 (set! page-header-table
82 (assoc-set! page-header-table
83 page-number
84 (list (car text-disp) (caddr prev-value)))))))
85 (reverse (if odd odd-label-header-table even-label-header-table)))
86 (if odd
87 (set! odd-page-header-table page-header-table)
88 (set! even-page-header-table page-header-table))))
89 (let ((page-number-markup (or (page-text (chain-assoc-get 'page:page-number props -1)
90 (if odd
91 odd-page-header-table
92 even-page-header-table))
93 "")))
94 (interpret-markup layout props
95 (markup #:page-header page-number-markup)))))))
96 (cons 0 0)
97 (cons -1.0 (cdr (ly:stencil-extent (interpret-markup layout props "XXX") Y))))))
98 (set! add-odd-page-header-text
99 (lambda (parser text display-1st)
100 (let ((label (gensym "header")))
101 (set! odd-label-header-table
102 (cons (list label text display-1st)
103 odd-label-header-table))
104 (add-music parser
105 (make-music 'Music
106 'page-marker #t
107 'page-label label)))))
108 (set! in-music-add-odd-page-header-text
109 (lambda (text display-1st)
110 (let ((label (gensym "header")))
111 (set! odd-label-header-table
112 (cons (list label text display-1st)
113 odd-label-header-table))
114 (make-music 'EventChord
115 'page-marker #t
116 'page-label label
117 'elements (list (make-music 'LabelEvent 'page-label label))))))
118 (set! add-even-page-header-text
119 (lambda (parser text display-1st)
120 (let ((label (gensym "header")))
121 (set! even-label-header-table
122 (cons (list label text display-1st)
123 even-label-header-table))
124 (add-music parser
125 (make-music 'Music
126 'page-marker #t
127 'page-label label)))))
128 (set! in-music-add-even-page-header-text
129 (lambda (text display-1st)
130 (let ((label (gensym "header")))
131 (set! even-label-header-table
132 (cons (list label text display-1st)
133 even-label-header-table))
134 (make-music 'EventChord
135 'page-marker #t
136 'page-label label
137 'elements (list (make-music 'LabelEvent 'page-label label)))))))
139 #(define-markup-command (odd-header layout props) ()
140 (header-markup-aux layout props #t))
142 #(define-markup-command (even-header layout props) ()
143 (header-markup-aux layout props #f))
145 \paper {
146 evenHeaderMarkup = \markup \even-header
147 oddHeaderMarkup = \markup \odd-header
148 }
150 resetHeaders =
151 #(define-music-function (parser location) ()
152 (add-even-page-header-text parser "" #f)
153 (add-odd-page-header-text parser "" #f)
154 (make-music 'Music 'void #t))