Les Horaces : suggestion nuances 2-1
[nenuvar.git] / common / columns.ily
blob60f5b1c3b89d0023911d034b73d298868420b008
1 %%% columns.ily
2 %%% Author: Nicolas Sceaux <nicolas.sceaux@free.fr>
3 %%%
4 %%% Arrange text on several columns, spreading over several pages.
5 %%% Two commands:
6 %%%
7 %%%   \markuplist\page-columns {
8 %%%     ...lines of text...
9 %%%   }
10 %%%
11 %%%   \markuplist\page-columns-title <title-markup> {
12 %%%     ...lines of text...
13 %%%   }
14 %%%
15 %%% Some "special" markup command may be used inside
16 %%% \page-columns-title and \page-columns:
17 %%%
18 %%%   \column-break  forces a column break
19 %%%   \page-break    forces a page break
20 %%%
21 %%%
22 %%% The following properties may be overriden:
23 %%%   column-number
24 %%%      the number of column on each page
25 %%%   column-padding
26 %%%      the padding between columns
27 %%%   extra-top-padding
28 %%%   extra-bottom-padding
29 %%%      padding (in mm) added on above and below the columns
30 %%%   estimated page
31 %%%      it is used to compute the header and footer heights,
32 %%%      in order to estimate the usable paper height
33 %%%      Depending on the page, header and footer may be different.
34 %%%
35 %%% These commands *must* be used on an empty page.
36 %%% They won't work with footnotes.
38 #(define-public (paper-usable-height layout estimated-page-number)
39    (define (head-foot-height proc-name)
40      (interval-length (ly:stencil-extent
41                        ((ly:output-def-lookup layout proc-name)
42                         layout '() estimated-page-number #f #f)
43                        Y)))
44    (define (markup-padding sym)
45      (assoc-ref (ly:output-def-lookup layout sym) 'padding))
46    (let ((paper-height (ly:output-def-lookup layout 'paper-height))
47          (top-margin (ly:output-def-lookup layout 'top-margin))
48          (bottom-margin (ly:output-def-lookup layout 'top-margin))
49          (header-height (head-foot-height 'make-header))
50          (footer-height (head-foot-height 'make-footer))
51          (top-padding (markup-padding 'top-markup-spacing))
52          (bottom-padding (markup-padding 'last-bottom-spacing)))
53      (- paper-height
54         top-margin bottom-margin
55         header-height footer-height
56         top-padding bottom-padding)))
58 #(define-markup-list-command
59      (page-columns-helper layout props use-title title lines)
60    (boolean? markup? markup-list?)
61    #:properties ((column-number 2)
62                  (line-width #f)
63                  (baseline-skip 0.3)
64                  (column-padding 3)
65                  (estimated-page-number 2)
66                  ;; extra margins in mm:
67                  (extra-top-padding 2)
68                  (extra-bottom-padding 3))
69    (let* ((title-stencil (interpret-markup layout props title))
70           (line-width (or line-width (ly:output-def-lookup layout 'line-width)))
71           (top-padding (/ extra-top-padding
72                           (ly:output-def-lookup layout 'output-scale)))
73           (bottom-padding (/ extra-bottom-padding
74                              (ly:output-def-lookup layout 'output-scale)))
75           (column-width (/ (- line-width
76                               (* (- column-number 1) column-padding))
77                            column-number))
78           (column-max-height (- (paper-usable-height layout
79                                                      estimated-page-number)
80                                 bottom-padding))
81           (first-page-column-max-height
82            (- column-max-height
83               (interval-length (ly:stencil-extent title-stencil Y))
84               top-padding))
85           (line-stencils (space-lines
86                           baseline-skip
87                           (map (lambda (line)
88                                  (interpret-markup
89                                   layout
90                                   (cons `((line-width . ,column-width)) props)
91                                   line))
92                                lines))))
93      (let ((pages '())
94            (current-page-columns '())
95            (current-column #f))
96        (define (current-column-full? next-line)
97          "The current columnn is full when we cannot add the next line"
98          (and current-column
99               (> (+ (interval-length (ly:stencil-extent current-column Y))
100                     (interval-length (ly:stencil-extent next-line Y)))
101                  (if (and use-title (null? pages))
102                      first-page-column-max-height
103                      column-max-height))))
105        (define (add-line line)
106          "Add a line at the bottom of the current column (which is
107 supposed not to be full)"
108          (set! current-column
109                (if (not current-column)
110                    (stack-lines DOWN 0 0
111                                 (list (ly:make-stencil "" 
112                                                        (cons 0 0)
113                                                        (cons 0 top-padding))
114                                       line))
115                    (stack-lines DOWN 0 0
116                                 (list current-column line)))))
118        (define (current-page-full?)
119          (= (length current-page-columns) column-number))
121        (define (finish-column force-finish-page)
122          "To be called when the current column is full, or all the
123           lines are added"
124          (if current-column
125              (begin
126                (set! current-page-columns
127                      (cons current-column current-page-columns))
128                (set! current-column #f)))
129          (if (or force-finish-page (current-page-full?))
130              (finish-page)))
132        (define (add-column column)
133          "Add the column stencil to the current page"
134          (set! current-page-columns
135                (cons column current-page-columns)))
137        (define (finish-page)
138          "To be called when a page is full"
139          (let* ((columns (reverse! current-page-columns))
140                 (page (car columns)))
141            (for-each (lambda (column)
142                        (set! page
143                              (ly:stencil-add
144                               page
145                               (ly:stencil-translate-axis
146                                column
147                                (+ column-width column-padding)
148                                X))))
149                      (cdr columns))
150            (if (and use-title (null? pages))
151                (set! page
152                      (stack-lines DOWN 0 0
153                                   (list title-stencil
154                                         (ly:make-stencil "" 
155                                                          (cons 0 0)
156                                                          (cons 0 top-padding))
157                                         page))))
158            (set! current-page-columns '())
159            (set! pages (cons page pages))))
160        ;; main loop starts here
161        (for-each (lambda (line)
162                    (let* ((expr (ly:stencil-expr line))
163                           (break-command
164                            (and (symbol? expr)
165                                 (memq expr (list column-break-command
166                                                  page-break-command))
167                                 expr)))
168                      (cond (break-command
169                             ;; a column or page break
170                             (finish-column
171                              (eqv? break-command page-break-command)))
172                            ((current-column-full? line)
173                             (finish-column #f)
174                             (add-line line))
175                            (else
176                             (add-line line)))))
177                  line-stencils)
178        (finish-column #t)
179        (reverse! pages))))
181 #(define-markup-list-command (page-columns layout props lines) (markup-list?)
182    (interpret-markup-list
183     layout props
184     (make-page-columns-helper-markup-list #f (make-null-markup) lines)))
186 #(define-markup-list-command (page-columns-title layout props title lines)
187    (markup? markup-list?)
188    (interpret-markup-list
189     layout props
190     (make-page-columns-helper-markup-list #t title lines)))
192 #(define-public column-break-command 'column-break)
193 #(define-public page-break-command 'page-break)
195 #(define-markup-command (column-break layout props) ()
196    (ly:make-stencil column-break-command (cons 0 0) (cons 0 0)))
198 #(define-markup-command (page-break layout props) ()
199    (ly:make-stencil page-break-command (cons 0 0) (cons 0 0)))