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
   7
   8 (define (ly:modules-lookup modules sym)
   9   (let ((v (module-variable (car modules) sym)))
  10     (if (and v (variable-bound? v) (variable-ref v))
  11         (variable-ref v)
  12         (if (module? (cdr modules)) (ly:modules-lookup (cdr modules) sym)))))
  13
  14 (define (page-properties paper)
  15   (list (append `((linewidth . ,(ly:paper-get-number
  16                                  paper 'linewidth)))
  17                 (ly:paper-lookup paper 'text-font-defaults))))
  18
  19 (define-public (book-title paper scopes)
  20   "Generate book title from header strings."
  21
  22   (define (get sym)
  23     (let ((x (ly:modules-lookup scopes sym)))
  24       (if (and x (not (unspecified? x))) x "")))
  25
  26   (let ((props (page-properties paper)))
  27
  28     (interpret-markup
  29      paper props
  30      (markup
  31       #:column
  32       (#:override '(baseline-skip . 4)
  33       #:column
  34       (#:fill-line
  35        (#:normalsize (get 'dedication))
  36        #:fill-line
  37        (#:huge #:bigger #:bigger #:bigger #:bigger #:bold (get 'title))
  38        #:override '(baseline-skip . 3)
  39        #:column
  40        (#:fill-line
  41         (#:large #:bigger #:bigger #:bold (get 'subtitle))
  42         #:fill-line (#:bigger #:bigger #:bold (get 'subsubtitle)))
  43        #:override '(baseline-skip . 5)
  44        #:column ("")
  45        #:override '(baseline-skip . 2.5)
  46        #:column
  47        (#:fill-line
  48         (#:bigger (get 'poet) #:large #:bigger #:caps (get 'composer))
  49         #:fill-line (#:bigger (get 'texttranslator) #:bigger (get 'opus))
  50         #:fill-line
  51         (#:bigger (get 'meter) #:bigger (get 'arranger))
  52         ""
  53         #:fill-line (#:large #:bigger (get 'instrument))
  54         " "
  55         #:fill-line (#:large #:bigger #:caps (get 'piece) ""))))))))
  56
  57 (define-public (user-title paper markup)
  58   "Generate book title from header markup."
  59   (if (markup? markup)
  60       (let ((props (page-properties paper))
  61             (baseline-skip (chain-assoc-get 'baseline-skip props 2)) )
  62         (stack-lines DOWN 0 BASELINE-SKIP
  63                      (list (interpret-markup paper props markup))))))
  64
  65 (define-public (score-title paper scopes)
  66   "Generate score title from header strings."
  67
  68   (define (get sym)
  69     (let ((x (ly:modules-lookup scopes sym)))
  70       (if (and x (not (unspecified? x))) x "")))
  71
  72   (let ((props (page-properties paper)))
  73
  74     (interpret-markup
  75      paper props
  76      (markup
  77       #:column
  78       (#:override '(baseline-skip . 4)
  79       #:column
  80       (#:fill-line
  81        ("" (get 'opus))
  82        #:fill-line (#:large #:bigger #:caps (get 'piece) "")))))))
  83
  84 (define-public (make-header paper page-number)
  85   (let ((props (page-properties paper) ))
  86     (interpret-markup paper props
  87                       (markup #:fill-line
  88                               ;; FIXME: font not found
  89                               ;; ("" #:bold (number->string page-number))))))
  90                               ("" (number->string page-number))))))
  91
  92 (define-public (make-footer paper page-number)
  93   (let ((props (page-properties paper)))
  94
  95     (interpret-markup paper props
  96                     (markup #:fill-line ("" (number->string page-number))))))
  97
  98
  99 (define TAGLINE
 100   (string-append "Engraved by LilyPond (version " (lilypond-version) ")"))
 101
 102 (define-public (make-tagline paper scopes)
 103   (let* ((props (page-properties paper))
 104          (tagline-var (ly:modules-lookup scopes 'tagline))
 105          (tagline (if (markup? tagline-var) tagline-var TAGLINE)))
 106
 107     (cond ((string? tagline)
 108            (if (not (equal? tagline ""))
 109                (interpret-markup paper props
 110                                  (markup #:fill-line (tagline "")))))
 111           ((markup? tagline) (interpret-markup paper props tagline)))))
 112
 113 (define-public (make-copyright paper scopes)
 114   (let ((props (page-properties paper))
 115         (copyright (ly:modules-lookup scopes 'copyright)))
 116
 117     (cond ((string? copyright)
 118            (if (not (equal? copyright ""))
 119                (interpret-markup paper props
 120                                  (markup #:fill-line (copyright "")))))
 121           ((markup? copyright) (interpret-markup paper props copyright)))))
 122
 123