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                                         ; titling.
  15 (define-public (default-book-title layout scopes)
  16   "Generate book title from header strings."
  17
  18
  19   (define (get sym)
  20     (let ((x (ly:modules-lookup scopes sym)))
  21       (if (markup? x) x "")))
  22   (define (has sym)
  23     (markup?  (ly:modules-lookup scopes sym)))
  24
  25   (let ((props (page-properties layout)))
  26
  27     (interpret-markup
  28      layout props
  29      (make-override-markup
  30       '(baseline-skip . 4)
  31       (make-column-markup
  32        (append
  33         (if (has 'dedication)
  34             (list (markup #:fill-line
  35                           (#:normalsize (get 'dedication))))
  36             '())
  37         (if (has 'title)
  38             (list
  39              (markup (#:fill-line
  40                       (#:huge #:bigger #:bigger #:bigger #:bigger #:bold
  41                               (get 'title)))))
  42             '())
  43         (if (or (has 'subtitle) (has 'subsubtitle))
  44             (list
  45              (make-override-markup
  46               '(baseline-skip . 3)
  47               (make-column-markup
  48                (list
  49                 (markup #:fill-line
  50                         (#:large #:bigger #:bigger #:bold (get 'subtitle)))
  51                 (markup #:fill-line (#:bigger #:bigger #:bold
  52                                               (get 'subsubtitle)))
  53                 (markup #:override '(baseline-skip . 5)
  54                         #:column ("")))
  55
  56                ))
  57              )
  58             '())
  59
  60         (list
  61          (make-override-markup
  62           '(baseline-skip . 2.5)
  63           (make-column-markup
  64            (append
  65             (if (or (has 'poet) (has 'composer))
  66                 (list (markup #:fill-line
  67                               (#:bigger (get 'poet)
  68                                         #:large #:bigger #:caps
  69                                         (get 'composer))))
  70                 '())
  71             (if (or (has 'texttranslator) (has 'opus))
  72                 (list
  73                  (markup
  74                   #:fill-line
  75                   (#:bigger (get 'texttranslator) #:bigger (get 'opus))))
  76                 '())
  77             (if (or (has 'meter) (has 'arranger))
  78                 (list
  79                  (markup #:fill-line
  80                          (#:bigger (get 'meter) #:bigger (get 'arranger))))
  81                 '())
  82             (if (has 'instrument)
  83                 (list
  84                  ""
  85                  (markup #:fill-line (#:large #:bigger (get 'instrument))))
  86                 '())
  87 ;;; piece is done in the score-title
  88 ;;;          (if (has 'piece)
  89 ;;;              (list ""
  90 ;;;                    (markup #:fill-line (#:large #:bigger #:caps (get 'piece) "")))
  91 ;;;              '())
  92             ))))))))))
  93
  94
  95 (define-public (default-user-title layout markup)
  96   "Generate book title from header markup."
  97   (if (markup? markup)
  98       (let ((props (page-properties layout))
  99             (baseline-skip (chain-assoc-get 'baseline-skip props 2)) )
 100         (stack-lines DOWN 0 BASELINE-SKIP
 101                      (list (interpret-markup layout props markup))))))
 102
 103 (define-public (default-score-title layout scopes)
 104   "Generate score title from header strings."
 105
 106   (define (get sym)
 107     (let ((x (ly:modules-lookup scopes sym)))
 108       (if (markup? x) x "")))
 109
 110   (define (has sym)
 111     (markup? (ly:modules-lookup scopes sym)))
 112
 113   (let ((props (page-properties layout)))
 114     (interpret-markup
 115      layout props
 116      (make-override-markup
 117       '(baseline-skip . 4)
 118       (make-column-markup
 119        (append
 120         (if (has 'opus)
 121             ;; opus, again?
 122             '()
 123
 124             ;; todo: figure out if and what should be here?
 125             ;;(list (markup #:fill-line ("" (get 'opus))))
 126             '())
 127         (if (has 'piece)
 128             (list
 129              (markup #:fill-line (#:large #:bigger (get 'piece) "")))
 130             '())))))))
 131
 132 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;