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                                (font-family . roman))
  25                              (ly:paper-lookup paper 'font-defaults)))))
  26     (interpret-markup
  27      paper props
  28      (markup
  29       #:column
  30       (#:override '(baseline-skip . 4)
  31       #:column
  32       (#:fill-line
  33        (#:latin-i (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
  94   (interpret-markup paper props
  95                     (markup #:fill-line ("" (number->string page-number))))))
  96
  97
  98 (define-public (make-footer paper page-number)
  99   (let ((props (list (append `((linewidth . ,(ly:paper-get-number
 100                                               paper 'linewidth))
 101                                (font-family . roman))
 102                              (ly:paper-lookup paper 'font-defaults)))))
 103
 104   (interpret-markup paper props
 105                     (markup #:fill-line ("" (number->string page-number))))))
 106