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))) + ,@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*))) +