[bknr-cvs] hans changed trunk/projects/quickhoney/src/pixel-pdf.lisp

[BKNR Commits]

Revision: 4146
Author: hans
URL: http://bknr.net/trac/changeset/4146

Scale to letter paper size, add credit line.

U   trunk/projects/quickhoney/src/pixel-pdf.lisp

Modified: trunk/projects/quickhoney/src/pixel-pdf.lisp
===================================================================
--- trunk/projects/quickhoney/src/pixel-pdf.lisp	2008-12-20 16:39:51 UTC (rev 4145)
+++ trunk/projects/quickhoney/src/pixel-pdf.lisp	2008-12-21 11:09:32 UTC (rev 4146)
@@ -183,18 +183,36 @@
   (let ((*converter* (make-instance 'converter :image-pathname image-pathname)))
     (turtle:reset)
     (pdf:with-document ()
-      (pdf:with-page ()
-        (let ((scale (float (/ +paper-width+ (max (width *converter*)
-                                                  (height *converter*)))))
-              (*print-pretty* nil))
-          (pdf:set-transform-matrix 1.0 0.0 0.0 -1.0 80.0 800.0)
-;          (pdf:scale scale scale)
-          (dotimes (y (height *converter*))
-            (dotimes (x (width *converter*))
-              (unless (seen x y)
-                (fill-from x y))))))
-      (pdf:write-document (make-pathname :type "pdf" :defaults image-pathname)))
-    (print (color-map *converter*))))
+      (let ((bounds (if (> (width *converter*)
+                           (height *converter*))
+                        pdf:*letter-landscape-page-bounds*
+                        pdf:*letter-portrait-page-bounds*)))
+        (pdf:with-page (:bounds bounds)
+          (let* ((*print-pretty* nil)
+                 (border 36)
+                 (page-width (- (aref bounds 2) (* border 2)))
+                 (page-height (- (aref bounds 3) (* border 2)))
+                 (scale (/ 1 (max (/ (width *converter*) page-width)
+                                  (/ (height *converter*) page-height))))
+                 (x-offset (/ (- page-width (* (width *converter*) scale)) 2))
+                 (y-offset (/ (- page-height (* (height *converter*) scale)) 2)))
+            (pdf:with-saved-state 
+              (pdf:set-transform-matrix scale 0.0 0.0 (- scale)
+                                        (+ border x-offset)
+                                        (+ border y-offset (* scale (height *converter*))))
+              (dotimes (y (height *converter*))
+                (dotimes (x (width *converter*))
+                  (unless (seen x y)
+                    (fill-from x y)))))
+            (pdf:with-saved-state
+              (pdf:in-text-mode
+                (pdf:set-font (pdf:get-font "Helvetica") 7.0)
+                (pdf:set-rgb-fill 0.5 0.5 0.5)
+                (pdf:translate (+ border x-offset 3 (* scale (width *converter*)))
+                               125.5)
+                (pdf:rotate -90.0)
+                (pdf:show-text (format nil "~C Nana Rausch QuickHoney" #\Copyright_Sign)))))))
+      (pdf:write-document (make-pathname :type "pdf" :defaults image-pathname)))))
 
 (defun print-seen ()
   (dotimes (y (height *converter*))