common/columns.ily

   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.
  37
  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)))
  57
  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))))
 104
 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)))))
 117
 118        (define (current-page-full?)
 119          (= (length current-page-columns) column-number))
 120
 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)))
 131
 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)))
 136
 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))))
 180
 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)))
 185
 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)))
 191
 192 #(define-public column-break-command 'column-break)
 193 #(define-public page-break-command 'page-break)
 194
 195 #(define-markup-command (column-break layout props) ()
 196    (ly:make-stencil column-break-command (cons 0 0) (cons 0 0)))
 197
 198 #(define-markup-command (page-break layout props) ()
 199    (ly:make-stencil page-break-command (cons 0 0) (cons 0 0)))