[patch] Custom paper size

[Bertalan Fodor]

I've made a patch that enables me to define arbitrary paper sizes. The 
implementation could be more general, but that way it would have taken 
very much time for me, and I'm in a hurry :-) It works with PDF and PNG 
backends.

The patch also contains some definitions for some more ISO paper sizes 
(b2-b6).

Patch is against 2.7 CVS

Bert

Index: lilypond-2.7/Documentation/user/global.itely
===================================================================
RCS file: /cvsroot/lilypond/lilypond/Documentation/user/global.itely,v
retrieving revision 1.31
diff -u -d -r1.31 global.itely
--- lilypond-2.7/Documentation/user/global.itely        9 Aug 2005 09:23:03 
-0000       1.31
+++ lilypond-2.7/Documentation/user/global.itely        9 Aug 2005 14:06:14 
-0000
@@ -206,11 +206,12 @@
 @cindex page size
 @cindex @code{papersize}
 
-To change the paper size, there are two commands,
+To change the paper size, there are three commands,
 @example
 #(set-default-paper-size "a4")
 \paper @{
   #(set-paper-size "a4")
+  #(set-custom-paper-size 150 225)
 @}
 @end example
 
@@ -218,10 +219,12 @@
 of the pages that the @code{\paper} block applies to -- if the @code{\paper}
 block is at the top of the file, then it will apply to all pages.  If the
 @code{\paper} block is inside a @code{\book}, then the paper size will only
-apply to that book.
+apply to that book. The third commands applies the same way, but it sets the 
paper width
+to 150 mm and the paper height to 225 mm.
 
 The following paper sizes are supported: @code{a6}, @code{a5}, @code{a4},
address@hidden, @code{legal}, @code{letter}, @code{tabloid}.
address@hidden, @code{legal}, @code{letter}, @code{tabloid}, @code{b6}, 
address@hidden, @code{b4}, @code{b3}, @code{b2}.
 
 @cindex orientation
 @cindex landscape
Index: lilypond-2.7/scm/backend-library.scm
===================================================================
RCS file: /cvsroot/lilypond/lilypond/scm/backend-library.scm,v
retrieving revision 1.40
diff -u -d -r1.40 backend-library.scm
--- lilypond-2.7/scm/backend-library.scm        19 Jun 2005 14:52:33 -0000      
1.40
+++ lilypond-2.7/scm/backend-library.scm        9 Aug 2005 14:06:15 -0000
@@ -84,6 +84,47 @@
     (ly:system cmd)
     ))
 
+(define-public (postscript->pdf_customsize customwidth customheight name)
+  (let* ((pdf-name (string-append (basename name ".ps") ".pdf"))
+        (cmd (format #f
+                     "~a\
+ ~a\
+ ~a\
+ -dCompatibilityLevel=1.4 \
+ -dDEVICEWIDTHPOINTS=~a\
+ -dDEVICEHEIGHTPOINTS=~a\
+ -dNOPAUSE\
+ -dBATCH\
+ -r1200 \
+ -sDEVICE=pdfwrite\
+ -sOutputFile=~S\
+ -c .setpdfwrite\
+ -f ~S\
+"
+                     (search-gs)
+                     (if (ly:get-option 'verbose) "" "-q")
+                     (if (ly:get-option 'gs-font-load)
+                         " -dNOSAFER "
+                         " -dSAFER ")
+                         (sanitize-command-option customwidth)
+                         (sanitize-command-option customheight)
+                     pdf-name
+                     name)))
+    ;; The wrapper on windows cannot handle `=' signs,
+    ;; gs has a workaround with #.
+    (if (eq? PLATFORM 'windows)
+       (begin
+         (set! cmd (string-regexp-substitute "=" "#" cmd))
+         (set! cmd (string-regexp-substitute "-dSAFER " "" cmd))))
+
+    (if (access? pdf-name W_OK)
+       (delete-file pdf-name))
+
+    (ly:message (_ "Converting to `~a'...") pdf-name)
+    (ly:progress "\n")
+    (ly:system cmd)
+    )) 
+
 (use-modules (scm ps-to-png))
 
 (define-public (postscript->png resolution paper-size-name name)
@@ -98,6 +139,20 @@
     (make-ps-images name resolution paper-size rename-page-1 verbose
                    (ly:get-option 'anti-alias-factor))
     (ly:progress "\n")))
+
+(define-public (postscript->png_customsize resolution customwidth customheight 
name)
+    ;; Do not try to guess the name of the png file,
+    ;; GS produces PNG files like BASE-page%d.png.
+    ;;(ly:message (_ "Converting to `~a'...")
+    ;;     (string-append (basename name ".ps") "-page1.png" )))
+  (let ((custom-width (sanitize-command-option customwidth))
+               (custom-height (sanitize-command-option customheight))
+       (verbose (ly:get-option 'verbose))
+       (rename-page-1 #f))
+    (ly:message (_ "Converting to ~a...") "PNG")
+    (make-ps-images_customsize name resolution custom-width custom-height 
rename-page-1 verbose
+                   (ly:get-option 'anti-alias-factor))
+    (ly:progress "\n"))) 
 
 (define-public (postprocess-output paper-book module filename formats)
   (let*
Index: lilypond-2.7/scm/framework-ps.scm
===================================================================
RCS file: /cvsroot/lilypond/lilypond/scm/framework-ps.scm,v
retrieving revision 1.130
diff -u -d -r1.130 framework-ps.scm
--- lilypond-2.7/scm/framework-ps.scm   7 Aug 2005 07:17:37 -0000       1.130
+++ lilypond-2.7/scm/framework-ps.scm   9 Aug 2005 14:06:15 -0000
@@ -543,12 +543,17 @@
 
 (define-public (convert-to-pdf book name)
   (let* ((defs (ly:paper-book-paper book))
-        (papersizename (ly:output-def-lookup defs 'papersizename)))
+        (papersizename (ly:output-def-lookup defs 'papersizename))
+        (customwidth (ly:output-def-lookup defs 'customwidth))
+        (customheight (ly:output-def-lookup defs 'customheight)))
 
     (if (equal? (basename name ".ps") "-")
        (ly:warning (_ "can't convert <stdout> to ~S" "PDF"))
-       (postscript->pdf (if (string? papersizename) papersizename "a4")
-                        name))))
+       (if (number? customwidth)
+               (postscript->pdf_customsize (number->string customwidth) 
(number->string customheight) name)
+               (postscript->pdf (if (string? papersizename) papersizename "a4")
+                       name)))))
+ 
 
 (define-public (convert-to-png book name)
   (let* ((defs (ly:paper-book-paper book))
@@ -556,11 +561,15 @@
         (resolution (if (number? defs-resolution)
                         defs-resolution
                         (ly:get-option 'resolution)))
-        (papersizename (ly:output-def-lookup defs 'papersizename)))
-
-    (postscript->png resolution
+        (papersizename (ly:output-def-lookup defs 'papersizename))
+        (customwidth (ly:output-def-lookup defs 'customwidth))
+        (customheight (ly:output-def-lookup defs 'customheight)))
+  
+  (if (number? customwidth)
+         (postscript->png_customsize resolution (number->string customwidth) 
(number->string customheight) name)
+       (postscript->png resolution
                     (if (string? papersizename) papersizename "a4")
-                    name)))
+                    name)))) 
 
 (define-public (convert-to-dvi book name)
   (ly:warning (_ "can't generate ~S using the postscript back-end") "DVI"))
Index: lilypond-2.7/scm/paper.scm
===================================================================
RCS file: /cvsroot/lilypond/lilypond/scm/paper.scm,v
retrieving revision 1.56
diff -u -d -r1.56 paper.scm
--- lilypond-2.7/scm/paper.scm  21 Jul 2005 01:11:50 -0000      1.56
+++ lilypond-2.7/scm/paper.scm  9 Aug 2005 14:06:15 -0000
@@ -78,7 +78,13 @@
     ("a3" . (cons (* 297.9 mm) (* 420 mm)))
     ("legal" . (cons (* 8.5 in) (* 14.0 in)))
     ("letter" . (cons (* 8.5 in) (* 11.0 in)))
-    ("tabloid" . (cons (* 11.0 in) (* 17.0 in)))))
+    ("tabloid" . (cons (* 11.0 in) (* 17.0 in)))
+       ("b6" . (cons (* 125 mm) (* 176 mm)))
+    ("b5" . (cons (* 176 mm) (* 250 mm)))
+    ("b4" . (cons (* 250 mm) (* 353 mm)))
+    ("b3" . (cons (* 353 mm) (* 500 mm)))
+       ("b2" . (cons (* 500 mm) (* 707 mm))) 
+       ))
 
 ;; todo: take dimension arguments.
 
@@ -139,6 +145,16 @@
       ;;; TODO: should raise (generic) exception with throw, and catch
       ;;; that in parse-scm.cc
       (ly:warning (_ "Must use #(set-paper-size .. ) within \\paper { ... 
}"))))
+
+;;; to set a non-standard custom paper size
+(define-public (set-custom-paper-size w h)
+  (if (module-defined? (current-module) 'is-paper)
+    (begin 
+      (set-paper-dimensions (current-module) w h)
+      (module-define! (current-module) 'customheight (* 72 (/ h 25.4))) ; in 
points
+      (module-define! (current-module) 'customwidth (* 72 (/ w 25.4))))
+    (ly:warning (_ "Must use #(set-custom-paper-size .. ) within \\paper { ... 
}"))))
+ 
 
 (define-public (scale-layout pap scale)
   (let* ((new-pap (ly:output-def-clone pap))
Index: lilypond-2.7/scm/ps-to-png.scm
===================================================================
RCS file: /cvsroot/lilypond/lilypond/scm/ps-to-png.scm,v
retrieving revision 1.12
diff -u -d -r1.12 ps-to-png.scm
--- lilypond-2.7/scm/ps-to-png.scm      21 Jun 2005 21:43:36 -0000      1.12
+++ lilypond-2.7/scm/ps-to-png.scm      9 Aug 2005 14:06:15 -0000
@@ -185,3 +185,83 @@
                    files))
                            
      files)))
+
+(define-public (make-ps-images_customsize ps-name . rest)
+  (let-optional
+   rest ((resolution 90)
+        (custom-width "595")
+        (custom-height "842" )
+        (rename-page-1? #f)
+        (verbose? #f)
+        (aa-factor 1) 
+        )
+   
+   (let* ((base (basename (re-sub "[.]e?ps" "" ps-name)))
+         (header (gulp-port (open-file ps-name "r") 10240))
+         (png1 (string-append base ".png"))
+         (pngn (string-append base "-page%d.png"))
+         (pngn-re (re-sub "%d" "[0-9]*" pngn))
+         (multi-page? (and (string-match "\n%%Pages: " header)
+                           (not (string-match "\n%%Pages: 1\n" header))))
+         (output-file (if multi-page? pngn png1))
+
+         ;;png16m is because Lily produces color nowadays.
+         (gs-variable-options
+           (if multi-page?
+               ""
+               "-dEPSCrop"))
+         (cmd (format #f "~a\
+ ~a\
+ ~a\
+ -dGraphicsAlphaBits=4\
+ -dTextAlphaBits=4\
+ -dNOPAUSE\
+ -sDEVICE=png16m\
+ -dDEVICEWIDTHPOINTS=~a\
+ -dDEVICEHEIGHTPOINTS=~a\
+ -sOutputFile=~S\
+ -r~S\
+ ~S\
+ -c quit"
+                          (search-gs)
+                          (if verbose? "" "-q")
+                          gs-variable-options
+                          custom-width
+                          custom-height
+                          output-file 
+                          (* aa-factor resolution) ps-name))
+         (status 0)
+         (files '()))
+     
+     (for-each delete-file (append (dir-re "." png1)
+                                  (dir-re "." pngn-re)))
+     
+     ;; The wrapper on windows cannot handle `=' signs,
+     ;; gs has a workaround with #.
+     (if (eq? PLATFORM 'windows)
+        (begin
+          (set! cmd (re-sub "=" "#" cmd))
+          (set! cmd (re-sub "-dSAFER " "" cmd))))
+
+     (set! status (my-system verbose? #f cmd))
+
+     (set! files
+          (append (dir-re "." png1) (dir-re "." pngn-re)))
+
+     (if (not (= 0 status))
+        (begin
+          (map delete-file files)
+          (exit 1)))
+     
+     (if (and rename-page-1? multi-page?)
+        (rename-file (re-sub "%d" "1" pngn) png1))
+     
+     (set! files
+          (append (dir-re "." png1) (dir-re "." pngn-re)))
+
+     
+     (if (not (= 1 aa-factor))
+        (for-each  (lambda (f) (scale-down-image verbose? aa-factor f))
+                   files))
+                           
+     files)))