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