definitions/text_layout.ly

   1 %------------------------------------------------------------------%
   2 % Opéra Libre -- text_layout.ly                                    %
   3 %                                                                  %
   4 % (c) Valentin Villenave, 2008                                     %
   5 %                                                                  %
   6 %------------------------------------------------------------------%
   7
   8 %{
   9
  10 #(define-markup-command (perso layout props name) (string?)
  11    (interpret-markup layout props
  12    (markup #:column ( #:hspace 0 #:fill-line ( #:smallCaps name ) #:hspace 0 ))))
  13
  14 #(define (wordwrap-stencils stencils
  15          justify base-space line-width text-dir)
  16     (define space (if justify
  17         (* 0.7 base-space)
  18         base-space))
  19 (define (take-list width space stencils
  20          accumulator accumulated-width)
  21     (if (null? stencils)
  22   (cons accumulator stencils)
  23   (let*
  24       ((first (car stencils))
  25        (first-wid (cdr (ly:stencil-extent (car stencils) X)))
  26        (newwid (+ space first-wid accumulated-width))
  27        )
  28
  29     (if
  30      (or (null? accumulator)
  31          (< newwid width))
  32
  33      (take-list width space
  34           (cdr stencils)
  35           (cons first accumulator)
  36           newwid)
  37        (cons accumulator stencils))
  38      )))
  39
  40     (let loop
  41   ((lines '())
  42    (todo stencils))
  43
  44       (let*
  45     ((line-break (take-list line-width space todo
  46          '() 0.0))
  47      (line-stencils (car line-break))
  48      (space-left (- line-width (apply + (map (lambda (x) (cdr (ly:stencil-extent x X)))
  49                 line-stencils))))
  50
  51      (line-word-space (cond
  52            ((not justify) space)
  53            ((null? (cdr line-break))
  54             base-space)
  55            ((null? line-stencils) 0.0)
  56            ((null? (cdr line-stencils)) 0.0)
  57            (else (/ space-left (1- (length line-stencils))))))
  58
  59      (line (stack-stencil-line
  60       line-word-space
  61       (if (= text-dir RIGHT)
  62           (reverse line-stencils)
  63           line-stencils))))
  64
  65   (if (pair? (cdr line-break))
  66       (loop (cons line lines)
  67       (cdr line-break))
  68
  69       (begin
  70         (if (= text-dir LEFT)
  71       (set! line
  72       (ly:stencil-translate-axis line
  73                (- line-width (interval-end (ly:stencil-extent line X)))
  74                X)))
  75         (reverse (cons line lines))
  76
  77       )))
  78
  79       ))
  80
  81
  82 #(define (wordwrap-markups layout props args justify)
  83   (let*
  84       ((prop-line-width (chain-assoc-get 'line-width props #f))
  85        (line-width (if prop-line-width prop-line-width
  86            (ly:output-def-lookup layout 'line-width)))
  87        (word-space (chain-assoc-get 'word-space props))
  88        (text-dir (chain-assoc-get 'text-direction props RIGHT)))
  89     (wordwrap-stencils (remove ly:stencil-empty?
  90                                (interpret-markup-list layout props args))
  91                        justify word-space line-width
  92                        text-dir)))
  93
  94
  95 #(define-markup-command (roi layout props args) (markup-list?)
  96   (space-lines (chain-assoc-get 'baseline-skip props)
  97          (markup (wordwrap-markups layout props (cons
  98                (markup #:perso "Le Roi") args) #t))))
  99
 100 #(define-markup-list-command (roit layout props args) (markup-list?)
 101   (space-lines (chain-assoc-get 'baseline-skip props)
 102          (wordwrap-markups layout props (cons
 103                (markup #:perso "Le Roi") args) #t)))
 104
 105 #(define-markup-list-command (chef layout props args) (markup-list?)
 106   (space-lines (chain-assoc-get 'baseline-skip props)
 107          (wordwrap-markups layout props (cons
 108                (markup #:perso "Le Chef de la Garde") args) #t)))
 109
 110 %}
 111
 112 #(define-markup-list-command (roi layout props args) (markup-list?)
 113    (let ((didascalie (chain-assoc-get 'did props)))
 114      (interpret-markup-list layout props
 115        (make-justified-lines-markup-list (cons
 116           (markup #:column ( #:hspace 0 #:fill-line
 117             ( #:smallCaps "Le Roi" )
 118                                #:hspace 0 )) args)))))
 119
 120 #(define-markup-list-command (chef layout props args) (markup-list?)
 121    (let ((didascalie (chain-assoc-get 'did props)))
 122      (interpret-markup-list layout props
 123        (make-justified-lines-markup-list (cons
 124           (markup #:column ( #:hspace 0 #:fill-line
 125             ( #:smallCaps "Le Chef de la Garde" )
 126                                #:hspace 0 )) args)))))