scm/titling.scm

   1 ;;;; titling.scm -- titling functions
   2 ;;;;
   3 ;;;;  source file of the GNU LilyPond music typesetter
   4 ;;;;
   5 ;;;; (c) 2004 Jan Nieuwenhuizen <janneke@gnu.org>
   6 ;;;;          Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7
   8 (define-public (page-properties layout)
   9   (list (append `((linewidth . ,(ly:paper-get-number
  10                                  layout 'linewidth)))
  11                 (ly:output-def-lookup layout 'text-font-defaults))))
  12
  13 ;;;;;;;;;;;;;;;;;;
  14
  15
  16 (define-public ((marked-up-title what) layout scopes)
  17   "Read variables WHAT from SCOPES, and interpret it as markup. The
  18 PROPS argument will include variables set in SCOPES (prefixed with
  19 `header:'
  20 "
  21
  22   (define (get sym)
  23     (let ((x (ly:modules-lookup scopes sym)))
  24       (if (markup? x) x #f)))
  25
  26   (let*
  27       ((alists  (map ly:module->alist scopes))
  28        (prefixed-alist
  29         (map (lambda (alist)
  30                (map (lambda (entry)
  31                       (cons
  32                        (string->symbol
  33                         (string-append
  34                          "header:"
  35                          (symbol->string (car entry))))
  36                        (cdr entry)
  37                       ))
  38                     alist))
  39              alists))
  40        (props (append prefixed-alist
  41                       (page-properties layout)))
  42
  43        (markup (get what))
  44        )
  45
  46     (if (markup? markup)
  47         (interpret-markup layout props markup)
  48         (ly:make-stencil '() '(1 . -1) '(1 . -1)))
  49   ))
  50
  51
  52 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  53 ;; old
  54                                         ; titling.
  55 (define-public (default-book-title layout scopes)
  56   "Generate book title from header strings."
  57
  58
  59   (define (get sym)
  60     (let ((x (ly:modules-lookup scopes sym)))
  61       (if (markup? x) x "")))
  62   (define (has sym)
  63     (markup?  (ly:modules-lookup scopes sym)))
  64
  65   (let ((props (page-properties layout)))
  66
  67     (interpret-markup
  68      layout props
  69      (make-override-markup
  70       '(baseline-skip . 4)
  71       (make-column-markup
  72        (append
  73         (if (has 'dedication)
  74             (list (markup #:fill-line
  75                           (#:normalsize (get 'dedication))))
  76             '())
  77         (if (has 'title)
  78             (list
  79              (markup (#:fill-line
  80                       (#:huge #:bigger #:bigger #:bigger #:bigger #:bold
  81                               (get 'title)))))
  82             '())
  83         (if (or (has 'subtitle) (has 'subsubtitle))
  84             (list
  85              (make-override-markup
  86               '(baseline-skip . 3)
  87               (make-column-markup
  88                (list
  89                 (markup #:fill-line
  90                         (#:large #:bigger #:bigger #:bold (get 'subtitle)))
  91                 (markup #:fill-line (#:bigger #:bigger #:bold
  92                                               (get 'subsubtitle)))
  93                 (markup #:override '(baseline-skip . 5)
  94                         #:column ("")))
  95
  96                ))
  97              )
  98             '())
  99
 100         (list
 101          (make-override-markup
 102           '(baseline-skip . 2.5)
 103           (make-column-markup
 104            (append
 105             (if (or (has 'poet) (has 'composer))
 106                 (list (markup #:fill-line
 107                               (#:bigger (get 'poet)
 108                                         #:large #:bigger #:caps
 109                                         (get 'composer))))
 110                 '())
 111             (if (or (has 'texttranslator) (has 'opus))
 112                 (list
 113                  (markup
 114                   #:fill-line
 115                   (#:bigger (get 'texttranslator) #:bigger (get 'opus))))
 116                 '())
 117             (if (or (has 'meter) (has 'arranger))
 118                 (list
 119                  (markup #:fill-line
 120                          (#:bigger (get 'meter) #:bigger (get 'arranger))))
 121                 '())
 122             (if (has 'instrument)
 123                 (list
 124                  ""
 125                  (markup #:fill-line (#:large #:bigger (get 'instrument))))
 126                 '())
 127 ;;; piece is done in the score-title
 128 ;;;          (if (has 'piece)
 129 ;;;              (list ""
 130 ;;;                    (markup #:fill-line (#:large #:bigger #:caps (get 'piece) "")))
 131 ;;;              '())
 132             ))))))))))
 133
 134
 135 (define-public (default-user-title layout markup)
 136   "Generate book title from header markup."
 137   (if (markup? markup)
 138       (let ((props (page-properties layout))
 139             (baseline-skip (chain-assoc-get 'baseline-skip props 2)) )
 140         (stack-lines DOWN 0 BASELINE-SKIP
 141                      (list (interpret-markup layout props markup))))))
 142
 143 (define-public (default-score-title layout scopes)
 144   "Generate score title from header strings."
 145
 146   (define (get sym)
 147     (let ((x (ly:modules-lookup scopes sym)))
 148       (if (markup? x) x "")))
 149
 150   (define (has sym)
 151     (markup? (ly:modules-lookup scopes sym)))
 152
 153   (let ((props (page-properties layout)))
 154     (interpret-markup
 155      layout props
 156      (make-override-markup
 157       '(baseline-skip . 4)
 158       (make-column-markup
 159        (append
 160         (if (has 'opus)
 161             ;; opus, again?
 162             '()
 163
 164             ;; todo: figure out if and what should be here?
 165             ;;(list (markup #:fill-line ("" (get 'opus))))
 166             '())
 167         (if (has 'piece)
 168             (list
 169              (markup #:fill-line (#:large #:bigger (get 'piece) "")))
 170             '())))))))
 171
 172 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;