[bknr-cvs] hans changed trunk/projects/quickhoney/src/

[BKNR Commits]

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

Interface to store images, add function to convert all pixel images.

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

Modified: trunk/projects/quickhoney/src/image.lisp
===================================================================
--- trunk/projects/quickhoney/src/image.lisp	2008-12-21 14:07:37 UTC (rev 4148)
+++ trunk/projects/quickhoney/src/image.lisp	2008-12-21 21:04:33 UTC (rev 4149)
@@ -57,3 +57,14 @@
 (defmethod destroy-object :before ((image quickhoney-animation-image))
   (delete-object (quickhoney-animation-image-animation image)))
 
+(defun convert-all-pixel-images (directory)
+  (dolist (category (remove :pixel (quickhoney::all-categories) :test-not #'eql :key #'car))
+    (dolist (image (quickhoney:images-in-category category))
+      (format t "; image ~A~%" image)
+      (handler-case
+          (pixel-pdf:convert-store-image-to-pdf image
+                                                (make-pathname :name (store-image-name image)
+                                                               :type "pdf"
+                                                               :defaults directory))
+        (error (e)
+          (format t "; error ~A~%" e))))))
\ No newline at end of file

Modified: trunk/projects/quickhoney/src/packages.lisp
===================================================================
--- trunk/projects/quickhoney/src/packages.lisp	2008-12-21 14:07:37 UTC (rev 4148)
+++ trunk/projects/quickhoney/src/packages.lisp	2008-12-21 21:04:33 UTC (rev 4149)
@@ -91,7 +91,8 @@
 
 (defpackage :pixel-pdf
   (:use :cl)
-  (:export #:convert))
+  (:export #:convert-image-file-to-pdf
+           #:convert-store-image-to-pdf))
 
 (defpackage :turtle
   (:use :cl)

Modified: trunk/projects/quickhoney/src/pixel-pdf.lisp
===================================================================
--- trunk/projects/quickhoney/src/pixel-pdf.lisp	2008-12-21 14:07:37 UTC (rev 4148)
+++ trunk/projects/quickhoney/src/pixel-pdf.lisp	2008-12-21 21:04:33 UTC (rev 4149)
@@ -17,6 +17,10 @@
    (looking-in-direction :initform :east
                          :accessor looking-in-direction)))
 
+(defmacro with-converter ((&rest args) &body body)
+  `(let ((*converter* (apply #'make-instance 'converter ,args)))
+     , at body))
+
 (defun width (converter)
   (array-dimension (pixels converter) 0))
 
@@ -43,17 +47,17 @@
                        (ldb (byte 8 0) retval) (cl-gd::gd-image-get-blue img raw-pixel))
                  retval))))))
 
-(defmethod initialize-instance :after ((converter converter) &key image-pathname)
-  (cl-gd:with-image-from-file* (image-pathname)
-    (let ((width (cl-gd:image-width))
-          (height (cl-gd:image-height)))
-      (with-slots (seen pixels) converter
-        (setf seen (make-array (list width height)
-                               :element-type 'boolean :initial-element nil)
-              pixels (make-array (list width height)))
-        (cl-gd:do-rows (y)
-          (cl-gd:do-pixels-in-row (x)
-            (setf (aref pixels x y) (convert-color converter (cl-gd:raw-pixel)))))))))
+(defmethod initialize-instance :after ((converter converter) &key)
+  (let ((width (cl-gd:image-width))
+        (height (cl-gd:image-height)))
+    (with-slots (seen pixels) converter
+      (setf seen (make-array (list width height)
+                             :element-type 'boolean :initial-element nil)
+            pixels (make-array (list width height)))
+      (cl-gd:do-rows (y)
+        (cl-gd:do-pixels-in-row (x)
+          (setf (aref pixels x y) (convert-color converter (cl-gd:raw-pixel)))))))
+  (turtle:reset))
 
 (defun in-range (x y)
   (and (< -1 x (width *converter*))
@@ -135,6 +139,8 @@
         (y *converter*) y))
 
 (defun flood-fill ()
+  ;; This function certainly is stack hungry.  If needed, increase the
+  ;; stack size of the Lisp runtime (SBCL: --control-stack-size 64)
   (labels
       ((maybe-descend (x y)
          (when (and (same-color x y)
@@ -179,9 +185,8 @@
        (turtle:forward))))
   (turtle:pen-up))
 
-(defun pixels-pdf (image-pathname)
-  (let ((*converter* (make-instance 'converter :image-pathname image-pathname)))
-    (turtle:reset)
+(defun convert-pixels-to-pdf (pdf-pathname)
+  (with-converter ()
     (pdf:with-document ()
       (let ((bounds (if (> (width *converter*)
                            (height *converter*))
@@ -209,15 +214,25 @@
                 (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)
+                               (+ y-offset 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)))))
+                (pdf:show-text (format nil "~C Nana Rausch QuickHoney" #\Copyright_Sign))))))
+        (pdf:write-document pdf-pathname)))))
 
+(defun convert-image-file-to-pdf (image-pathname
+                                  &optional (pdf-pathname (make-pathname :type "pdf" :defaults image-pathname)))
+  (cl-gd:with-image-from-file* (image-pathname)
+    (convert-pixels-to-pdf pdf-pathname)))
+
+(defun convert-store-image-to-pdf (store-image pdf-pathname)
+  (bknr.images:with-store-image* (store-image)
+    (convert-pixels-to-pdf pdf-pathname)))
+
 (defun print-seen ()
   (dotimes (y (height *converter*))
     (dotimes (x (width *converter*))
       (write-char (if (seen x (- (height *converter*) y 1))
                       #\* #\.)
                   *error-output*))
-    (terpri *error-output*)))
\ No newline at end of file
+    (terpri *error-output*)))
+