X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fpaper.scm;h=23ec05a70f25715225123160ae71a352d41d6140;hb=HEAD;hp=d4a1f42f3f3949c6452cda7b1d0402fa2d9be124;hpb=c829306cde358aea95ce565af8417e7e16c01669;p=lilypond.git

diff --git a/scm/paper.scm b/scm/paper.scm
index d4a1f42f3f..23ec05a70f 100644
--- a/scm/paper.scm
+++ b/scm/paper.scm
@@ -1,53 +1,69 @@
-;;;; paper.scm -- manipulate the paper and layout block.
+;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;;  source file of the GNU LilyPond music typesetter
-;;;; 
-;;;; (c) 2004--2007 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; Copyright (C) 2004--2015 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;;
+;;;; LilyPond is free software: you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation, either version 3 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; LilyPond is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
+
+;; for define-safe-public when byte-compiling using Guile V2
+(use-modules (scm safe-utility-defs))
 
 (define-public (set-paper-dimension-variables mod)
   (module-define! mod 'dimension-variables
-		  '(after-title-space
-		    before-title-space
-		    between-system-padding
-		    between-system-space
-		    between-title-space
-		    blot-diameter
-		    bottom-margin
-		    cm
-		    foot-separation
-		    head-separation
-		    horizontal-shift
-		    in
-		    indent
-		    ledger-line-thickness
-		    left-margin
-		    line-thickness
-		    line-width
-		    mm
-		    page-top-space
-		    paper-height
-		    paper-width
-		    pt
-		    right-margin
-		    short-indent
-		    staff-height
-		    staff-space
-		    top-margin)))
+                  '(binding-offset
+                    blot-diameter
+                    bottom-margin
+                    cm
+                    footnote-footer-padding
+                    footnote-padding
+                    horizontal-shift
+                    in
+                    incipit-width
+                    indent
+                    inner-margin
+                    inner-margin-default-scaled
+                    ledger-line-thickness
+                    left-margin
+                    left-margin-default-scaled
+                    line-thickness
+                    line-width
+                    mm
+                    outer-margin
+                    outer-margin-default-scaled
+                    paper-height
+                    paper-width
+                    pt
+                    right-margin
+                    right-margin-default-scaled
+                    short-indent
+                    staff-height
+                    staff-space
+                    top-margin)))
 
 (define (calc-line-thickness staff-space pt)
   ;; linear interpolation.
 
   ;; !! synchronize with feta-params.mf
   (let*
-    ((x1 (* 4.125 pt))
-     (x0 (* 5 pt))
-     (f1 (* 0.47 pt))
-     (f0 (* 0.50 pt)))
+      ((x1 (* 4.125 pt))
+       (x0 (* 5 pt))
+       (f1 (* 0.47 pt))
+       (f0 (* 0.50 pt)))
 
     (/
      (+
       (* f1 (- staff-space x0))
-	   (* f0 (- x1 staff-space)))
+      (* f0 (- x1 staff-space)))
      (- x1 x0))))
 
 (define-public (layout-set-absolute-staff-size-in-module module staff-height)
@@ -56,58 +72,56 @@
        (ss (/ staff-height 4))
        (factor (/ staff-height (* 20 pt)))
        (setm! (lambda (sym val)
-		(module-define! module sym val))))
+                (module-define! module sym val))))
+
+    ;; Synchronized with the `text-font-size'
+    ;; binding in add-pango-fonts (see font.scm).
+    (setm! 'text-font-size (* 11 factor))
 
-    (setm! 'text-font-size (* 12 factor))
-    
     (setm! 'output-scale ss)
-    (setm! 'fonts
-		    (if tex-backend?
-			(make-cmr-tree factor)
-			(make-century-schoolbook-tree factor)))
+    (setm! 'fonts (make-default-fonts-tree factor))
     (setm! 'staff-height staff-height)
     (setm! 'staff-space ss)
 
     (setm! 'line-thickness (calc-line-thickness ss pt))
 
-    ;;  sync with feta  
+    ;;  sync with feta
     (setm! 'ledger-line-thickness (+ (* 0.5 pt) (/ ss 10)))
 
-    ;;  sync with feta  
+    ;;  sync with feta
     (setm! 'blot-diameter (* 0.4 pt))
     ))
 
 (define-public (layout-set-absolute-staff-size sz)
-  "Function to be called inside a \\layout{} block to set the staff
-size. SZ is in points"
+  "Set the absolute staff size inside of a @code{\\layout@{@}} block.
+@var{sz} is in points."
   (layout-set-absolute-staff-size-in-module (current-module) sz))
 
 (define-public (layout-set-staff-size sz)
-  "Function to be called inside a \\layout{} block to set the staff
-size. SZ is in points"
+  "Set the staff size inside of a @code{\\layout@{@}} block.
+@var{sz} is in points."
 
   (layout-set-absolute-staff-size (* (eval 'pt (current-module)) sz)))
 
 (define-safe-public (set-global-staff-size sz)
   "Set the default staff size, where SZ is thought to be in PT."
   (let* ((current-mod (current-module))
-	 (parser (eval 'parser current-mod))
-	 (pap (ly:parser-lookup parser '$defaultpaper))
-	 (in-layout? (or (module-defined? current-mod 'is-paper)
-			 (module-defined? current-mod 'is-layout)))
-
-	 ; maybe not necessary.
-	 ; but let's be paranoid. Maybe someone still refers to the
-	 ; old one. 
-	 (new-paper (ly:output-def-clone pap))
-	 
-	 (new-scope (ly:output-def-scope new-paper)))
-    
+         (pap (ly:parser-lookup '$defaultpaper))
+         (in-layout? (or (module-defined? current-mod 'is-paper)
+                         (module-defined? current-mod 'is-layout)))
+
+         ;; maybe not necessary.
+         ;; but let's be paranoid. Maybe someone still refers to the
+         ;; old one.
+         (new-paper (ly:output-def-clone pap))
+
+         (new-scope (ly:output-def-scope new-paper)))
+
     (if in-layout?
-	(ly:warning (_ "set-global-staff-size: not in toplevel scope")))
+        (ly:warning (_ "set-global-staff-size: not in toplevel scope")))
 
     (layout-set-absolute-staff-size-in-module new-scope
-					      (* sz (eval 'pt new-scope)))
+                                              (* sz (eval 'pt new-scope)))
     (module-define! current-mod '$defaultpaper new-paper)))
 
 (define-public paper-alist
@@ -115,6 +129,11 @@ size. SZ is in points"
   ;; don't use decimals.
   ;; ISO 216 has a tolerance of +- 2mm
 
+  ;; TODO Autogenerate the following list so it appears under the
+  ;; 'Predefined paper sizes' node in notation-appendices.itely
+  ;; currently the list below has been copied and formatted manually.
+  ;; Therefore, please add any new entries to the *itely file as well.
+
   '(("a10" . (cons (* 26 mm) (* 37 mm)))
     ("a9" . (cons (* 37 mm) (* 52 mm)))
     ("a8" . (cons (* 52 mm) (* 74 mm)))
@@ -153,10 +172,15 @@ size. SZ is in points"
     ("c1" . (cons (* 648 mm) (* 917 mm)))
     ("c0" . (cons (* 917 mm) (* 1297 mm)))
     ;; Below are North American paper sizes
+    ("junior-legal" . (cons (* 8.0 in) (* 5.0 in)))
     ("legal" . (cons (* 8.5 in) (* 14.0 in)))
     ("letter" . (cons (* 8.5 in) (* 11.0 in)))
     ;; Ledger (17x11) is a 90 degree rotation of Tabloid
+    ("17x11" . (cons (* 17.0 in) (* 11.0 in)))
+    ("ledger" . (cons (* 17.0 in) (* 11.0 in)))
+    ;; Tabloid (11x17)
     ("11x17" . (cons (* 11.0 in) (* 17.0 in)))
+    ("tabloid" . (cons (* 11.0 in) (* 17.0 in)))
     ;; government-letter by IEEE Printer Working Group, for children's writing
     ("government-letter" . (cons (* 8 in) (* 10.5 in)))
     ("government-legal" . (cons (* 8.5 in) (* 13.0 in)))
@@ -214,84 +238,132 @@ size. SZ is in points"
     ("pa10" . (cons (* 26 mm) (* 35 mm)))
     ;; F4 used in southeast Asia and Australia
     ("f4" . (cons (* 210 mm) (* 330 mm)))
-   ))
+    ))
 
 ;; todo: take dimension arguments.
-
-(define (set-paper-dimensions m w h)
+(define (lookup-paper-name module name landscape?)
+  "Look up @var{name} and return a number pair of width and height,
+where @var{landscape?} specifies whether the dimensions should be swapped
+unless explicitly overriden in the name."
+  (let* ((swapped?
+          (cond ((string-suffix? "landscape" name)
+                 (set! name
+                       (string-trim-right (string-drop-right name 9)))
+                 #t)
+                ((string-suffix? "portrait" name)
+                 (set! name
+                       (string-trim-right (string-drop-right name 8)))
+                 #f)
+                (else landscape?)))
+         (is-paper? (module-defined? module 'is-paper))
+         (entry (and is-paper?
+                     (eval-carefully (assoc-get name paper-alist)
+                                     module
+                                     #f))))
+    (and entry is-paper?
+         (if swapped? (cons (cdr entry) (car entry)) entry))))
+
+(define (set-paper-dimensions m w h landscape?)
   "M is a module (i.e. layout->scope_ )"
-  (let* ((mm (eval 'mm m)))
+  (let*
+      ;; page layout - what to do with (printer specific!) margin settings?
+      ((paper-default (or (lookup-paper-name
+                           m (ly:get-option 'paper-size) landscape?)
+                          (cons w h)))
+       ;; Horizontal margins, marked with #t in the cddr, are stored
+       ;; in renamed variables because they must not be overwritten.
+       ;; The cadr indicates whether a value is a vertical dimension.
+       ;; Output_def::normalize () needs to know
+       ;; whether the user set the value or not.
+       (scaleable-values '(("left-margin" #f . #t)
+                           ("right-margin" #f . #t)
+                           ("inner-margin" #f . #t)
+                           ("outer-margin" #f . #t)
+                           ("binding-offset" #f . #f)
+                           ("top-margin" #t . #f)
+                           ("bottom-margin" #t . #f)
+                           ("indent" #f . #f)
+                           ("short-indent" #f . #f)))
+       (scaled-values
+        (map
+         (lambda (entry)
+           (let ((entry-symbol
+                  (string->symbol
+                   (string-append (car entry) "-default")))
+                 (vertical? (cadr entry)))
+             (cons (if (cddr entry)
+                       (string-append (car entry) "-default-scaled")
+                       (car entry))
+                   (round (* (if vertical? h w)
+                             (/ (eval-carefully entry-symbol m 0)
+                                ((if vertical? cdr car)
+                                 paper-default)))))))
+         scaleable-values)))
+
     (module-define! m 'paper-width w)
     (module-define! m 'paper-height h)
-    (module-define! m 'line-width (- w
-				     (ly:modules-lookup (list m) 'left-margin (* 10 mm))
-				     (ly:modules-lookup (list m) 'right-margin (* 10 mm))))
-
-    (module-define! m 'indent (/ w 14))
-    (module-define! m 'short-indent 0)
-
-    ;; page layout - what to do with (printer specific!) margin settings?
+    ;; Sometimes, lilypond-book doesn't estimate a correct line-width.
+    ;; Therefore, we need to unset line-width.
+    (module-remove! m 'line-width)
 
-    ))
+    (for-each
+     (lambda (value)
+       (let ((value-symbol (string->symbol (car value)))
+             (number (cdr value)))
+         (module-define! m value-symbol number)))
+     scaled-values)))
 
 (define (internal-set-paper-size module name landscape?)
-  (define (swap x)
-    (cons (cdr x) (car x)))
-  
-  (let* ((entry (assoc name paper-alist))
-	 (is-paper? (module-defined? module 'is-paper))
-	 (mm (eval 'mm module)))
-    
+  (let* ((entry (lookup-paper-name module name landscape?))
+         (is-paper? (module-defined? module 'is-paper)))
     (cond
      ((not is-paper?)
       (ly:warning (_ "This is not a \\layout {} object, ~S") module))
-     ((pair? entry)
-
-      (set! entry (eval (cdr entry) module))
-      (if landscape?
-	  (set! entry (swap entry)))
-      (set-paper-dimensions module (car entry) (cdr entry))
+     (entry
+      (set-paper-dimensions module (car entry) (cdr entry) landscape?)
 
       (module-define! module 'papersizename name)
-      (module-define! module 'landscape 
-		      (if landscape? #t #f)))
+      (module-define! module 'landscape
+                      (if landscape? #t #f)))
      (else
       (ly:warning (_ "Unknown paper size: ~a") name)))))
 
 (define-safe-public (set-default-paper-size name . rest)
-  (internal-set-paper-size
-   (ly:output-def-scope (eval '$defaultpaper (current-module)))
-   name
-   (memq 'landscape rest)))
+  (let* ((pap (module-ref (current-module) '$defaultpaper))
+         (new-paper (ly:output-def-clone pap))
+         (new-scope (ly:output-def-scope new-paper)))
+    (internal-set-paper-size
+     new-scope
+     name
+     (memq 'landscape rest))
+    (module-set! (current-module) '$defaultpaper new-paper)))
 
 (define-public (set-paper-size name . rest)
   (if (module-defined? (current-module) 'is-paper)
       (internal-set-paper-size (current-module) name
-			       (memq 'landscape rest))
+                               (memq 'landscape rest))
 
       ;;; TODO: should raise (generic) exception with throw, and catch
       ;;; that in parse-scm.cc
       (ly:warning (_ "Must use #(set-paper-size .. ) within \\paper { ... }"))))
 
-(define-public (scale-layout pap scale)
-  (let* ((new-pap (ly:output-def-clone pap))
-	 (dim-vars (ly:output-def-lookup pap 'dimension-variables))
-	 (old-scope (ly:output-def-scope pap))
-	 (scope (ly:output-def-scope new-pap)))
+(define-public (scale-layout paper scale)
+  "Return a clone of the paper, scaled by the given scale factor."
+  (let* ((new-paper (ly:output-def-clone paper))
+         (dim-vars (ly:output-def-lookup paper 'dimension-variables))
+         (old-scope (ly:output-def-scope paper))
+         (scope (ly:output-def-scope new-paper)))
 
     (for-each
      (lambda (v)
        (let* ((var (module-variable old-scope v))
-	      (val (if (variable? var) (variable-ref var) #f)))
-
-	 (if (number? val)
-	     (module-define! scope v
-			     (/ val scale))
+              (val (if (variable? var) (variable-ref var) #f)))
 
-	     ;; spurious warnings, eg. for paper-width, paper-height. 
-	     ;; (ly:warning (_ "not a number, ~S = ~S " v  val))
-	     )))
-     
+         (if (number? val)
+             (module-define! scope v (/ val scale))
+             ;; Cannot warn for non-numbers, eg. for paper-width, paper-height.
+             )))
      dim-vars)
-    
-    new-pap))
+    ;; Mark the clone.
+    (ly:output-def-set-variable! new-paper 'cloned #t)
+    new-paper))