scm/page-layout.scm

   1 ;;;; page-layout.scm -- page layout 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 paper)
   9   (list (append `((linewidth . ,(ly:paper-get-number
  10                                  paper 'linewidth)))
  11                 (ly:output-def-lookup paper 'text-font-defaults))))
  12
  13 (define-public (plain-header paper page-number)
  14   (let ((props (page-properties paper) ))
  15     (interpret-markup paper props
  16                       (markup #:fill-line
  17                               ("" #:bold (number->string page-number))))))
  18
  19 (define-public (plain-footer paper page-number)
  20   (let ((props (page-properties paper)))
  21
  22     (interpret-markup paper props
  23                       (markup #:fill-line ("" (number->string page-number))))))
  24
  25
  26 (define TAGLINE
  27   (string-append "Engraved by LilyPond (version " (lilypond-version) ")"))
  28
  29 (define-public (TAGLINE-or-tagline-from-header paper scopes)
  30   (let* ((props (page-properties paper))
  31          (tagline-var (ly:modules-lookup scopes 'tagline))
  32          (tagline (if (markup? tagline-var) tagline-var TAGLINE)))
  33
  34     (cond ((string? tagline)
  35            (if (not (equal? tagline ""))
  36                (interpret-markup paper props
  37                                  (markup #:fill-line (tagline "")))))
  38           ((markup? tagline) (interpret-markup paper props tagline)))))
  39
  40 (define-public (copyright-from-header paper scopes)
  41   (let ((props (page-properties paper))
  42         (copyright (ly:modules-lookup scopes 'copyright)))
  43
  44     (cond ((string? copyright)
  45            (if (not (equal? copyright ""))
  46                (interpret-markup paper props
  47                                  (markup #:fill-line (copyright "")))))
  48           ((markup? copyright) (interpret-markup paper props copyright)))))
  49
  50
  51 ;;;;;;;;;;;;;;;;;;
  52                                         ; titling.
  53 (define-public (default-book-title paper scopes)
  54   "Generate book title from header strings."
  55
  56
  57   (define (get sym)
  58     (let ((x (ly:modules-lookup scopes sym)))
  59       (if (markup? x) x "")))
  60   (define (has sym)
  61     (markup?  (ly:modules-lookup scopes sym)))
  62
  63   (let ((props (page-properties paper)))
  64
  65     (interpret-markup
  66      paper props
  67      (make-override-markup
  68       '(baseline-skip . 4)
  69       (make-column-markup
  70        (append
  71         (if (has 'dedication)
  72             (list (markup #:fill-line
  73                           (#:normalsize (get 'dedication))))
  74             '())
  75         (if (has 'title)
  76             (list
  77              (markup (#:fill-line
  78                       (#:huge #:bigger #:bigger #:bigger #:bigger #:bold
  79                               (get 'title)))))
  80             '())
  81         (if (or (has 'subtitle) (has 'subsubtitle))
  82             (list
  83              (make-override-markup
  84               '(baseline-skip . 3)
  85               (make-column-markup
  86                (list
  87                 (markup #:fill-line
  88                         (#:large #:bigger #:bigger #:bold (get 'subtitle)))
  89                 (markup #:fill-line (#:bigger #:bigger #:bold (get 'subsubtitle)))
  90                 (markup #:override '(baseline-skip . 5)
  91                         #:column ("")))
  92
  93                ))
  94              )
  95             '())
  96
  97         (list
  98          (make-override-markup
  99           '(baseline-skip . 2.5)
 100           (make-column-markup
 101            (append
 102             (if (or (has 'poet) (has 'composer))
 103                 (list (markup #:fill-line
 104                               (#:bigger (get 'poet) #:large #:bigger #:caps (get 'composer))))
 105                 '())
 106             (if (or (has 'texttranslator) (has 'opus))
 107                 (list
 108                  (markup
 109                   #:fill-line
 110                   (#:bigger (get 'texttranslator) #:bigger (get 'opus))))
 111                 '())
 112             (if (or (has 'meter) (has 'arranger))
 113                 (list
 114                  (markup #:fill-line
 115                          (#:bigger (get 'meter) #:bigger (get 'arranger))))
 116                 '())
 117             (if (has 'instrument)
 118                 (list
 119                  ""
 120                  (markup #:fill-line (#:large #:bigger (get 'instrument))))
 121                 '())
 122 ;;; piece is done in the score-title
 123 ;;;          (if (has 'piece)
 124 ;;;              (list ""
 125 ;;;                    (markup #:fill-line (#:large #:bigger #:caps (get 'piece) "")))
 126 ;;;              '())
 127             ))))))))))
 128
 129
 130 (define-public (default-user-title paper markup)
 131   "Generate book title from header markup."
 132   (if (markup? markup)
 133       (let ((props (page-properties paper))
 134             (baseline-skip (chain-assoc-get 'baseline-skip props 2)) )
 135         (stack-lines DOWN 0 BASELINE-SKIP
 136                      (list (interpret-markup paper props markup))))))
 137
 138 (define-public (default-score-title paper scopes)
 139   "Generate score title from header strings."
 140
 141   (define (get sym)
 142     (let ((x (ly:modules-lookup scopes sym)))
 143       (if (markup? x) x "")))
 144
 145   (define (has sym)
 146     (markup? (ly:modules-lookup scopes sym)))
 147
 148   (let ((props (page-properties paper)))
 149     (interpret-markup
 150      paper props
 151      (make-override-markup
 152       '(baseline-skip . 4)
 153       (make-column-markup
 154        (append
 155         (if (has 'opus)
 156             (list (markup #:fill-line ("" (get 'opus))))
 157             '())
 158         (if (has 'piece)
 159             (list
 160              (markup #:fill-line (#:large #:bigger #:caps (get 'piece) "")))
 161             '())))))))