scm/paper.scm

   1 ;;;; paper.scm -- manipulate the paper block.
   2 ;;;;
   3 ;;;;  source file of the GNU LilyPond music typesetter
   4 ;;;;
   5 ;;;; (c)  2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   6
   7
   8 (define-public (paper-set-staff-size sz)
   9   "Function to be called inside a \\paper{} block to set the staff size."
  10   (let* ((m (current-module))
  11          (ss (/ sz 4))
  12          (pt (eval 'pt m))
  13          (mm (eval 'mm m)))
  14
  15     (module-define! m 'fonts (scale-font-list (/  sz (* 20 pt))))
  16     (module-define! m 'staffheight sz)
  17     (module-define! m 'staff-space ss)
  18     (module-define! m 'staffspace ss)
  19
  20
  21     ;; !! synchronize with feta-params.mf
  22     (module-define! m 'linethickness (+ (* 0.3 pt) (* 0.04 ss)))
  23     (module-define! m 'outputscale ss)
  24     (module-define! m 'ledgerlinethickness (+ (* 0.5 pt) (/ ss 10)))
  25     (module-define! m 'blotdiameter (* 0.35 pt))
  26     (module-define! m 'interscoreline (* 4 mm))))
  27
  28 (define-public (set-global-staff-size sz)
  29   "Set the default staff size, where SZ is thought to be in PT."
  30   (let* ((old-mod (current-module))
  31          (pap (eval '$defaultpaper old-mod))
  32          (new-paper (ly:output-def-clone pap))
  33          (new-scope (ly:output-def-scope new-paper)))
  34     (set-current-module new-scope)
  35     (paper-set-staff-size (* sz (eval 'pt new-scope)))
  36     (set-current-module old-mod)
  37     (module-define! old-mod '$defaultpaper new-paper)))
  38
  39 (define paper-alist
  40   '(("a4" . (cons (* 210 mm) (* 297.9 mm)))
  41     ("a3" . (cons (* 297.9 mm) (* 420 mm)))
  42     ("legal" . (cons (* 8.5 in) (* 14.0 in)))
  43     ("letter" . (cons (* 8.5 in) (* 11.0 in)))
  44     ("tabloid" . (cons (* 11.0 in) (* 17.0 in)))))
  45
  46 ;; todo: take dimension arguments.
  47
  48 (define (set-paper-dimensions m w h)
  49   "M is a module (ie. paper->scope_ )"
  50   (let* ((mm (eval 'mm m)))
  51     (module-define! m 'hsize w)
  52     (module-define! m 'vsize h)
  53     (module-define! m 'linewidth (- w (* 20 mm)))
  54     (module-define! m 'raggedright #f)
  55     (module-define! m 'packed #f)
  56     (module-define! m 'indent (/ w 14))
  57
  58     ;; page layout
  59     (module-define! m 'top-margin (* 3 mm))
  60     (module-define! m 'bottom-margin (* 3 mm))
  61     (module-define! m 'head-sep (* 4 mm))
  62     (module-define! m 'foot-sep (* 4 mm))))
  63
  64 (define-public (set-paper-size name)
  65   (let* ((entry (assoc name paper-alist))
  66          (pap (eval '$defaultpaper (current-module)))
  67          (new-paper (ly:output-def-clone pap))
  68          (m (ly:output-def-scope new-paper))
  69          (mm (eval 'mm m)))
  70
  71     (if (pair? entry)
  72         (begin
  73           (set! entry (eval  (cdr entry) m))
  74           (set-paper-dimensions m (car entry) (cdr entry))
  75           (module-define! m 'papersize name)
  76           (module-define! m 'papersizename name)
  77           (set-paper-dimensions m (car entry) (cdr entry))
  78           (module-define! (current-module) '$defaultpaper new-paper))
  79         (ly:warning (string-append "Unknown papersize: " name)))))