common/livret-columns.ily

   1 %%%
   2 %%% TODO: merge with livret.ily
   3 %%% (adding customization properties for sizes)
   4 %%%
   5
   6 #(define-markup-command (n-columns layout props lines) (markup-list?)
   7    #:properties ((column-number 2)
   8                  (line-width #f)
   9                  (baseline-skip 0.3)
  10                  (inter-column-padding 6))
  11    (let* ((line-width (or line-width (ly:output-def-lookup layout 'line-width)))
  12           (column-width (/ (- line-width
  13                               (* (- column-number 1) inter-column-padding))
  14                            column-number)))
  15      (let* ((line-stencils
  16              (space-lines
  17               baseline-skip
  18               (map (lambda (line)
  19                      (interpret-markup
  20                       layout
  21                       (cons `((line-width . ,column-width)) props)
  22                       line))
  23                    lines)))
  24             (total-height
  25              (reduce + 0 (map (lambda (stencil)
  26                                 (interval-length (ly:stencil-extent stencil Y)))
  27                               line-stencils)))
  28             (average-height (/ total-height column-number)))
  29        (let fill-columns ((lines line-stencils)
  30                           (current-column-index 1)
  31                           (current-column-height 0)
  32                           (current-column-lines '())
  33                           (previous-columns '()))
  34          (if (null? lines)
  35              ;; the end result: a single markup with all columns
  36              (stack-stencil-line
  37               0
  38               (reverse! (if current-column-lines
  39                             (cons (stack-lines
  40                                    DOWN 0 0
  41                                    (reverse! current-column-lines))
  42                                   previous-columns)
  43                             previous-columns)))
  44              ;; go on collecting lines into columns
  45              (let* ((line (car lines))
  46                     (height (interval-length (ly:stencil-extent line Y))))
  47                (if (and (> current-column-height 0)
  48                         (< current-column-index column-number)
  49                         (>= (+ current-column-height height) average-height))
  50                    ;; this line ends filling this column
  51                    ;; => start a new column after it
  52                    (fill-columns (cdr lines)
  53                                  (1+ current-column-index)
  54                                  0
  55                                  '()
  56                                  (cons (ly:make-stencil
  57                                         "" (cons 0 inter-column-padding) '(0 . 0))
  58                                        (cons (stack-lines
  59                                               DOWN 0 0
  60                                               (reverse! (cons line current-column-lines)))
  61                                              previous-columns)))
  62                    ;; there is still room in the current column
  63                    ;; => go on filling it
  64                    (fill-columns (cdr lines)
  65                                  current-column-index
  66                                  (+ current-column-height height)
  67                                  (cons line current-column-lines)
  68                                  previous-columns))))))))
  69
  70 #(define-markup-command (livretAct layout props text next) (markup? markup?)
  71    (interpret-markup
  72     layout props
  73     (markup #:column (#:fill-line (#:fontsize 4 #:pad-around 3 text)
  74                       next))))
  75
  76 #(define-markup-command (livretScene layout props text next)
  77      (markup? markup?)
  78    (stack-lines DOWN 0 0
  79                 (list (ly:make-stencil "" '(0 . 0) '(0 . 1))
  80                       (interpret-markup
  81                        layout props
  82                        (markup #:column (#:fill-line (#:fontsize 2 #:pad-around 2 text)
  83                                          next))))))
  84
  85 #(define-markup-command (livretDesc layout props text) (markup?)
  86    (interpret-markup
  87     layout props
  88     (markup #:force-line-width-ratio 1/20 #:null
  89             #:fontsize 1 #:line-width-ratio 9/10 #:pad-around 2 text)))
  90
  91 #(define-markup-command (livretDescPage layout props text) (markup?)
  92    #:properties ((line-width)
  93                  (gap 12)
  94                  (word-space 0))
  95    (interpret-markup
  96     layout props
  97     (markup #:hspace gap
  98             #:override `(line-width . ,(- line-width gap word-space 2))
  99             #:fontsize 1 #:pad-around 2 text)))
 100
 101 #(define-markup-command (livretDescAtt layout props text next)
 102      (markup? markup?)
 103    (interpret-markup
 104     layout props
 105     (markup #:column
 106             (#:line (#:force-line-width-ratio 1/20 #:null
 107                      #:fontsize 1 #:line-width-ratio 9/10 #:pad-around 2 text)
 108              next))))
 109
 110 #(define-markup-command (livretDidasP layout props text) (markup?)
 111    (interpret-markup
 112     layout props
 113     (markup #:force-line-width-ratio 1/20 #:null
 114             #:fontsize 0 #:force-line-width-ratio 9/10
 115             #:fill-line (#:null #:italic text))))
 116
 117 #(define-markup-command (livretPers layout props text next) (markup? markup?)
 118    (interpret-markup
 119     layout props
 120     (markup #:column
 121             (#:fill-line (#:fontsize 1 #:line-width-ratio 7/10
 122                                      #:pad-around 2 text)
 123              next))))
 124
 125 #(define livret-verse-aux
 126    (let ((gauge-string "Qu entends-je ? il va périr ! quelle fureur m")
 127          (gap #f))
 128      (define (make-verse verse)
 129        (markup #:hspace gap #:fontsize 1 verse))
 130      (lambda (layout props verse is-short)
 131        (if (not gap)
 132            (let ((line-width (chain-assoc-get 'line-width props 0))
 133                  (gauge (interpret-markup
 134                          layout props
 135                          (markup #:fontsize 1 gauge-string))))
 136              (set! gap (/ (- line-width
 137                              (interval-length (ly:stencil-extent gauge X)))
 138                           2.0))))
 139        (interpret-markup
 140         layout props
 141         (markup #:hspace (+ gap (if is-short 4 0))
 142                 #:fontsize 0 verse)))))
 143
 144 #(define-markup-command (livretVer layout props args) (markup-list?)
 145    (livret-verse-aux layout props (make-line-markup args) #f))
 146
 147 #(define-markup-command (livretVerC layout props args) (markup-list?)
 148    (livret-verse-aux layout props (make-line-markup args) #t))
 149
 150 #(define-markup-command (livretRef layout props ref next)
 151      (symbol? markup?)
 152    (interpret-markup
 153     layout props
 154     (markup #:combine
 155             #:with-link ref #:line ("[Page" #:page-refIII ref "]")
 156             next)))
 157
 158 #(define-markup-command (invisible layout props arg) (markup?)
 159   (interpret-markup layout props (make-with-color-markup white arg)))
 160
 161 #(define-markup-command (sep layout props) ()
 162    (interpret-markup layout props
 163                      (markup #:pad-around 1 #:fill-line (#:draw-line '(50 . 0)))))