1 %%% toc-columns.ily -- Table of content on several columns
3 %%% Author: Nicolas Sceaux <nicolas.sceaux@free.fr>
6 %% Add optional arguments to `add-toc-item!'
7 #(let ((toc-item-list (list)))
9 (lambda (markup-symbol text . rest)
10 (let ((label (gensym "toc")))
12 (cons (append! (list label markup-symbol text) rest)
14 (make-music 'EventChord
17 'elements (list (make-music 'LabelEvent
18 'page-label label))))))
19 (set! toc-items (lambda ()
20 (reverse toc-item-list))))
22 %% Add dot-filling option to \line and \wordwrap
23 #(define-markup-command (fromproperty layout props sym) (symbol?)
24 (let ((m (chain-assoc-get sym props)))
26 (interpret-markup layout props (make-simple-markup m)))
28 (if (memq (car m) (list wordwrap-markup))
29 (interpret-markup layout props m)
30 (interpret-markup layout props (make-line-markup (list m)))))
34 #(define-markup-command (line layout props args) (markup-list?)
35 #:properties ((word-space)
37 (text-direction RIGHT)
39 "Like built-in @code{line}, but fill the line
40 with dots in property @code{fill-with-dots} is true."
41 (let* ((props (cons `((fill-with-dots . #f)) props))
42 (line (let ((stencils (interpret-markup-list layout props args)))
43 (if (= text-direction LEFT)
44 (set! stencils (reverse stencils)))
47 (remove ly:stencil-empty? stencils)))))
48 (if (not fill-with-dots)
50 (interpret-markup layout props
51 (markup #:fill-with-pattern 0.5 RIGHT "."
55 #(define-markup-command (simple layout props str) (string?)
56 #:properties ((fill-with-dots #f))
57 "Like built-in @code{simple}, but fill the line
58 with dots in property @code{fill-with-dots} is true."
60 (interpret-markup layout props (make-line-markup (list str)))
61 (interpret-markup layout props str)))
63 #(define-markup-command (wordwrap layout props args) (markup-list?)
64 #:properties ((baseline-skip 0.3)
66 wordwrap-internal-markup-list)
67 "Like built-in @code{wordwrap}, but fill the last line
68 with dots in property @code{fill-with-dots} is true."
69 (let* ((no-dots-props (cons `((fill-with-dots . #f)) props))
72 (wordwrap-internal-markup-list layout no-dots-props #f args))))
76 (if (or (null? lines) (not fill-with-dots))
78 (let* ((reversed-lines (reverse! lines)))
79 (reverse! (cons (interpret-markup
82 (list (make-stencil-markup (car reversed-lines)))))
83 (cdr reversed-lines)))))))))
86 #(define (combine-left stencil . rest)
89 ((ly:stencil-empty? (car rest))
90 (apply combine-left stencil (cdr rest)))
93 ; ly:stencil-combine-at-edge first axis direction second padding
94 (ly:stencil-combine-at-edge stencil X RIGHT (car rest) 0)
97 #(define (space-stencil width)
98 (ly:make-stencil "" (cons 0 width) (cons 0 0)))
100 #(define-markup-command (toc-filled-line layout props rehearsal-number text page)
101 (markup? markup? markup?)
102 #:properties ((line-width #f)
105 (fill-line-with-dots #t)
106 (use-rehearsal-numbers #f)
107 (rehearsal-number-gauge "8-88")
108 (rehearsal-number-align RIGHT)
109 (rehearsal-number-margin 1)
110 (page-number-gauge "000")
111 (page-number-margin 1))
112 (let* ((line-width (or line-width (ly:output-def-lookup layout 'line-width)))
115 (let* ((bare-page-number-stencil (interpret-markup layout props page))
119 (interpret-markup layout props page-number-gauge)
122 (ly:stencil-extent bare-page-number-stencil X))))))
123 (combine-left (space-stencil page-number-margin)
124 (space-stencil left-padding)
125 bare-page-number-stencil)))
126 (page-number-width (interval-length
127 (ly:stencil-extent page-number-stencil X)))
128 ;; rehearsal numbers: set later if actually used
130 (num-stencil empty-stencil))
131 ;; If rehearsal number is printed, compute its width and stencil
132 (if use-rehearsal-numbers
133 (let* ((bare-num-stencil (interpret-markup layout props rehearsal-number))
134 (bare-width (interval-length (ly:stencil-extent bare-num-stencil X)))
135 (num-gauge-stencil (interpret-markup layout props rehearsal-number-gauge))
136 (gauge-width (interval-length (ly:stencil-extent num-gauge-stencil X)))
137 (padding (max 0 (- gauge-width bare-width)))
138 (right-padding (* (/ (1+ (* -1 rehearsal-number-align)) 2.0) padding))
139 (left-padding (- padding right-padding)))
143 (space-stencil left-padding)
147 (space-stencil right-padding)
149 (space-stencil rehearsal-number-margin)))
150 (set! num-width (+ gauge-width rehearsal-number-margin))))
151 ;; compute text width and stencil
152 (let* ((text-max-width (- line-width page-number-width num-width))
153 (text-stencil (interpret-markup
155 (markup #:override `(fill-with-dots . ,fill-line-with-dots)
156 #:override `(line-width . ,text-max-width)
158 (y-offset (min 0 (+ (cdr (ly:stencil-extent page-number-stencil Y))
159 (- (interval-length (ly:stencil-extent page-number-stencil Y))
160 (interval-length (ly:stencil-extent text-stencil Y)))))))
161 (combine-left num-stencil
163 (ly:stencil-translate-axis page-number-stencil y-offset Y)))))
165 #(define-markup-command (paper-prop layout props name default)
167 "Get the value of a \\paper property, or defaults to some value"
168 (let ((val (ly:output-def-lookup layout name)))
169 (interpret-markup layout props (if (markup? val)
174 tocTitleMarkup = \markup \column {
176 \fontsize #6 \fill-line { \paper-prop #'tocTitle "TABLE OF CONTENTS" }
179 tocActMarkup = \markup \large \italic \column {
181 \fontsize #2 \fill-line { \fromproperty #'toc:text }
184 tocSceneMarkup = \markup {
185 \override #'(fill-line-with-dots . #f) \toc-filled-line
186 "" \larger\fromproperty #'toc:text ""
188 tocPieceMarkup = \markup {
190 \fromproperty #'toc:rehearsal-number
191 \fromproperty #'toc:text
192 \fromproperty #'toc:page
194 tocBoldPieceMarkup = \markup {
196 \fromproperty #'toc:rehearsal-number
197 \bold\fromproperty #'toc:text
198 \fromproperty #'toc:page
202 #(define-markup-command (toc-item layout props toc-item) (list?)
203 #:properties ((section-markup 'tocActMarkup)
205 (inter-column-padding 5)
208 (let ((label (car toc-item))
209 (toc-markup (cadr toc-item))
210 (text (caddr toc-item))
211 (num (if (null? (cdddr toc-item))
214 (line-width (or line-width (ly:output-def-lookup layout 'line-width)))
215 (column-width (/ (- line-width
216 (* (- column-number 1) inter-column-padding))
220 (list (interpret-markup
222 (cons `((line-width . ,(if (eqv? toc-markup section-markup)
225 (toc:page . ,(markup #:with-link label
226 #:page-ref label "XXX" "?"))
227 (toc:rehearsal-number . ,num)
230 (ly:output-def-lookup layout toc-markup)))))))
232 #(define-markup-command (toc-section layout props title-item items) (list? list?)
233 #:properties ((column-number 2)
234 (sub-section-markup 'tocSceneMarkup)
235 (sub-section-padding 1)
236 (inter-column-padding 6))
237 (let* ((item-stencils
242 #:override `(inter-column-padding . ,inter-column-padding)
245 (sub-sections (map (lambda (item)
246 (eqv? (cadr item) sub-section-markup))
248 (title-stencil (if (null? title-item)
250 (interpret-markup layout props
251 (markup #:toc-item title-item))))
253 (+ (reduce + 0 (map (lambda (stencil)
254 (interval-length (ly:stencil-extent stencil Y)))
256 (if (not (pair? sub-sections))
258 (reduce + 0 (map (lambda (val)
259 (if val sub-section-padding 0))
260 (cdr sub-sections))))))
261 (average-height (/ total-height column-number)))
262 (let fill-columns ((lines item-stencils)
263 (sub-sections sub-sections)
264 (current-column-index 1)
265 (current-column-height 0)
266 (current-column-lines '())
267 (previous-columns '()))
269 ;; the end result: the section title and the items on several columns
275 (reverse! (if current-column-lines
278 (reverse! current-column-lines))
280 previous-columns)))))
281 ;; go on collecting the item stencils into columns
282 (let* ((line (car lines))
283 (height (interval-length (ly:stencil-extent line Y))))
284 (cond ((car sub-sections)
285 ;; this is new subsection, and the current column is not
286 ;; yet full => go on filling this column
287 (fill-columns (cdr lines)
290 (+ current-column-height height sub-section-padding)
292 ;; if this is not the first line in the column,
293 ;; add padding before
294 (if (not (null? current-column-lines))
295 (cons (ly:make-stencil "" '(0 . 0)
296 (cons 0 sub-section-padding))
297 current-column-lines)
298 current-column-lines))
300 ((and (> current-column-height 0)
301 (< current-column-index column-number)
302 (>= (+ current-column-height height) average-height))
303 ;; this is a new line, which ends filling this column
304 ;; => start a new column after it
305 (fill-columns (cdr lines)
307 (1+ current-column-index)
310 (cons (ly:make-stencil
311 "" (cons 0 inter-column-padding) '(0 . 0))
314 (reverse! (cons line current-column-lines)))
317 ;; this is a new line, and there is still room is this
318 ;; column => go on filling it
319 (fill-columns (cdr lines)
322 (+ current-column-height height)
323 (cons line current-column-lines)
324 previous-columns))))))))
326 #(define-markup-list-command (table-of-contents layout props) ()
327 #:properties ((section-markup 'tocActMarkup)
329 (inter-column-padding 2)
332 (let collect-by-section ((toc-items (toc-items))
334 (current-section-title '())
335 (current-section-items '()))
336 (if (null? toc-items)
337 ;; finalize last section and return the markup list
338 (cons (interpret-markup layout props
339 (ly:output-def-lookup layout 'tocTitleMarkup))
341 (cons (interpret-markup
343 (markup #:toc-section current-section-title
344 (reverse! current-section-items)))
346 ;; go on collecting toc items
347 (let* ((toc-item (car toc-items))
348 (toc-markup (cadr toc-item)))
349 (if (eqv? toc-markup section-markup)
350 ;; a new section => end the previous one
353 (if (and (null? current-section-title)
354 (null? current-section-items))
356 (cons (interpret-markup
358 (markup #:toc-section current-section-title
359 (reverse! current-section-items)))
363 ;; a new item for current section
367 current-section-title
368 (cons toc-item current-section-items)))))))