← Back to branch summary

~ubuntu-branches/ubuntu/precise/lilypond/precise

« back to all changes in this revision

Viewing changes to scm/paper.scm

  • Committer: Bazaar Package Importer
  • Author(s): Thomas Bushnell, BSG
  • Date: 2006-12-19 10:18:12 UTC
  • mfrom: (3.1.4 feisty)
  • Revision ID: james.westby@ubuntu.com-20061219101812-7awtjkp0i393wxty
Tags: 2.8.7-3
http://bugs.debian.org/400550
scripts/midi2ly.py: When setting DATADIR, find Lilypond python files
in the @TOPLEVEL_VERSION@ directory, not 'current'.  Patch thanks to
Chris Lamb (chris@chris-lamb.co.uk).  (Closes: #400550)

Show diffs side-by-side

added added

removed removed

Lines of Context:
scm/paper.scm
1
 
;;;; paper.scm -- manipulate the paper block.
 
1
;;;; paper.scm -- manipulate the paper and layout block.
2
2
;;;;
3
3
;;;;  source file of the GNU LilyPond music typesetter
4
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."
 
5
;;;; (c) 2004--2006 Han-Wen Nienhuys <hanwen@cs.uu.nl>
 
6
 
 
7
(define-public (set-paper-dimension-variables mod)
 
8
  (module-define! mod 'dimension-variables
 
9
                  '(pt mm cm in staff-height staff-space
 
10
                       page-top-space
 
11
                       between-system-space between-system-padding
 
12
                       line-width indent paper-width paper-height horizontal-shift
 
13
                       staff-space line-thickness ledgerline-thickness
 
14
                       blot-diameter left-margin right-margin)))
 
15
 
 
16
(define-public (layout-set-staff-size sz)
 
17
  "Function to be called inside a \\layout{} block to set the staff size."
10
18
  (let* ((m (current-module))
11
19
         (ss (/ sz 4))
12
 
         (pt (eval 'pt m)) 
 
20
         (pt (eval 'pt m))
 
21
 
 
22
         
 
23
         ;; linear interpolation.
 
24
         (x1 (* 4.125 pt))
 
25
         (x0 (* 5 pt))
 
26
         (f1 (* 0.47 pt))
 
27
         (f0 (* 0.50 pt))
 
28
         (lt (/
 
29
              (+
 
30
               (* f1 (- ss x0))
 
31
               (* f0 (- x1 ss)))
 
32
              (- x1 x0)))
 
33
         
13
34
         (mm (eval 'mm m)))
14
 
   
15
 
    (module-define! m 'fonts (make-font-tree (/  sz (* 20 pt))))
 
35
 
 
36
    (module-define! m 'text-font-size (* 12 (/ sz (* 20 pt))))
16
37
    
17
 
    (module-define! m 'staffheight sz)
18
 
    (module-define! m 'staff-space ss)
19
 
    (module-define! m 'staffspace ss)
20
 
 
 
38
    (module-define! m 'output-scale ss)
 
39
    (module-define! m 'fonts
 
40
                    (if tex-backend?
 
41
                        (make-cmr-tree (/  sz (* 20 pt)))
 
42
                        (make-century-schoolbook-tree
 
43
                         (/ sz (* 20 pt)))))
 
44
    (module-define! m 'staff-height sz)
 
45
    (module-define! m 'staff-space ss)
 
46
    (module-define! m 'staff-space ss)
21
47
 
22
48
    ;; !! synchronize with feta-params.mf
23
 
    (module-define! m 'linethickness (+ (* 0.3 pt) (* 0.04 ss)))
24
 
    (module-define! m 'outputscale ss)
25
 
    (module-define! m 'ledgerlinethickness (+ (* 0.5 pt) (/ ss 10)))
26
 
    (module-define! m 'blotdiameter (* 0.35 pt))
27
 
    (module-define! m 'interscoreline (* 4 mm))))
 
49
    (module-define! m 'line-thickness lt)
 
50
    (module-define! m 'ledgerline-thickness (+ (* 0.5 pt) (/ ss 10)))
 
51
    (module-define! m 'blot-diameter (* 0.4 pt))
 
52
    ))
28
53
 
29
 
(define-public (set-global-staff-size sz)
 
54
(define-safe-public (set-global-staff-size sz)
30
55
  "Set the default staff size, where SZ is thought to be in PT."
31
56
  (let* ((old-mod (current-module))
32
57
         (pap (eval '$defaultpaper old-mod))
33
 
 
34
 
 
35
 
         ;; Huh? Why is it necessary to clone object? 
 
58
         (in-layout? (or (module-defined? old-mod 'is-paper)
 
59
                         (module-defined? old-mod 'is-layout)))
 
60
 
 
61
         ; maybe not necessary.
 
62
         ; but let's be paranoid. Maybe someone still refers to the
 
63
         ; old one. 
36
64
         (new-paper (ly:output-def-clone pap))
 
65
         
37
66
         (new-scope (ly:output-def-scope new-paper)))
38
67
    
 
68
    (if in-layout?
 
69
        (ly:warning (_ "Not in toplevel scope")))
39
70
    (set-current-module new-scope)
40
 
    (paper-set-staff-size (* sz (eval 'pt new-scope)))
 
71
    (layout-set-staff-size (* sz (eval 'pt new-scope)))
41
72
    (set-current-module old-mod)
42
73
    (module-define! old-mod '$defaultpaper new-paper)))
43
74
 
44
 
(define paper-alist
45
 
  '(("a6" . (cons (* 105 mm) (* 148.95 mm)))
46
 
    ("a5" . (cons (* 148.95 mm) (* 210 mm)))
47
 
    ("a4" . (cons (* 210 mm) (* 297.9 mm)))
48
 
    ("a3" . (cons (* 297.9 mm) (* 420 mm)))
 
75
(define-public paper-alist
 
76
 
 
77
  ;; don't use decimals.
 
78
  ;; ISO 216 has a tolerance of +- 2mm
 
79
  
 
80
  '(("a7" . (cons (* 74 mm) (* 105 mm)))
 
81
    ("a6" . (cons (* 105 mm) (* 149 mm)))
 
82
    ("a5" . (cons (* 149 mm) (* 210 mm)))
 
83
    ("a4" . (cons (* 210 mm) (* 298 mm)))
 
84
    ("a3" . (cons (* 298 mm) (* 420 mm)))
49
85
    ("legal" . (cons (* 8.5 in) (* 14.0 in)))
50
86
    ("letter" . (cons (* 8.5 in) (* 11.0 in)))
51
 
    ("tabloid" . (cons (* 11.0 in) (* 17.0 in)))))
 
87
    ("11x17" . (cons (* 11.0 in) (* 17.0 in)))
 
88
    ))
52
89
 
53
90
;; todo: take dimension arguments.
54
91
 
55
92
(define (set-paper-dimensions m w h)
56
 
  "M is a module (i.e. paper->scope_ )"
 
93
  "M is a module (i.e. layout->scope_ )"
57
94
  (let* ((mm (eval 'mm m)))
58
 
    (module-define! m 'hsize w)
59
 
    (module-define! m 'vsize h)
60
 
    (module-define! m 'linewidth (- w (* 20 mm)))
 
95
    (module-define! m 'paper-width w)
 
96
    (module-define! m 'paper-height h)
 
97
    (module-define! m 'line-width (- w (* 20 mm)))
61
98
    (module-define! m 'indent (/ w 14))
62
99
 
63
100
    ;; page layout - what to do with (printer specific!) margin settings?
64
 
    (module-define! m 'top-margin (* 5 mm))
65
 
    (module-define! m 'bottom-margin (* 6 mm))
66
 
    (module-define! m 'head-sep (* 4 mm))
67
 
    (module-define! m 'foot-sep (* 4 mm))))
68
 
 
69
 
 
70
 
 
71
 
(define (internal-set-paper-size module name)
 
101
 
 
102
    ))
 
103
 
 
104
(define (internal-set-paper-size module name landscape?)
 
105
  (define (swap x)
 
106
    (cons (cdr x) (car x)))
 
107
  
72
108
  (let* ((entry (assoc name paper-alist))
73
 
         (is-paper? (module-defined? module '$is-paper))
 
109
         (is-paper? (module-defined? module 'is-paper))
74
110
         (mm (eval 'mm module)))
75
111
    
76
112
    (cond
77
113
     ((not is-paper?)
78
 
      (ly:warning "This is not a \\paper {} object:")
79
 
      (display module))
 
114
      (ly:warning (_ "This is not a \\layout {} object, ~S" module)))
80
115
     ((pair? entry)
81
 
      (set! entry (eval  (cdr entry) module))
82
 
          (set-paper-dimensions module (car entry) (cdr entry))
83
 
          (module-define! module 'papersize name)
84
 
          (module-define! module 'papersizename name)
85
 
          (set-paper-dimensions module (car entry) (cdr entry)))
 
116
 
 
117
      (set! entry (eval (cdr entry) module))
 
118
      (if landscape?
 
119
          (set! entry (swap entry)))
 
120
      (set-paper-dimensions module (car entry) (cdr entry))
 
121
 
 
122
      (module-define! module 'papersizename name)
 
123
 
 
124
      (if landscape?
 
125
          (module-define! module 'landscape #t)))
86
126
     (else
87
 
      (ly:warn (string-append "Unknown papersize: " name))))
88
 
 
89
 
    ))
90
 
 
91
 
(define-public (set-default-paper-size name)
92
 
  (internal-set-paper-size (ly:output-def-scope (eval '$defaultpaper (current-module)))
93
 
                           name))
94
 
 
95
 
(define-public (set-paper-size name)
96
 
  (if (module-defined? (current-module) '$is-paper)
97
 
      (internal-set-paper-size (current-module) name)
 
127
      (ly:warning (_ ("Unknown papersize: ~a" name)))))))
 
128
 
 
129
(define-safe-public (set-default-paper-size name . rest)
 
130
  (internal-set-paper-size
 
131
   (ly:output-def-scope (eval '$defaultpaper (current-module)))
 
132
   name
 
133
   (memq 'landscape rest)))
 
134
 
 
135
(define-public (set-paper-size name . rest)
 
136
  (if (module-defined? (current-module) 'is-paper)
 
137
      (internal-set-paper-size (current-module) name
 
138
                               (memq 'landscape rest))
98
139
 
99
140
      ;;; TODO: should raise (generic) exception with throw, and catch
100
141
      ;;; that in parse-scm.cc
101
 
      (ly:warn "Must use #(set-paper-size .. ) within \\paper { ... }")))
 
142
      (ly:warning (_ "Must use #(set-paper-size .. ) within \\paper { ... }"))))
 
143
 
 
144
(define-public (scale-layout pap scale)
 
145
  (let* ((new-pap (ly:output-def-clone pap))
 
146
         (dim-vars (ly:output-def-lookup pap 'dimension-variables))
 
147
         (old-scope (ly:output-def-scope pap))
 
148
         (scope (ly:output-def-scope new-pap)))
 
149
 
 
150
    (for-each
 
151
     (lambda (v)
 
152
       (let* ((var (module-variable old-scope v))
 
153
              (val (if (variable? var) (variable-ref var) #f)))
 
154
 
 
155
         (if (number? val)
 
156
             (module-define! scope v
 
157
                             (/ val scale))
 
158
 
 
159
             ;; spurious warnings, eg. for paper-width, paper-height. 
 
160
             ;; (ly:warning (_ "not a number, ~S = ~S " v  val))
 
161
             )))
 
162
     
 
163
     dim-vars)
 
164
    
 
165
    new-pap))