Revision: 4140 Author: hans URL: http://bknr.net/trac/changeset/4140
progress! 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-18 00:09:18 UTC (rev 4139) +++ trunk/projects/quickhoney/src/pixel-pdf.lisp 2008-12-18 06:39:24 UTC (rev 4140) @@ -107,16 +107,16 @@ (:right :east))))))
(defun forward () - (turtle:forward) - - (look :forward (lambda (x y) - (setf (x *converter*) x - (y *converter*) y - (aref (seen *converter*) x y) t)))) + (turtle:forward))
(defun set-color (color) (format t "can't set PDF color ~A yet~%" color))
+(defun move-to-pixel (x y) + (setf (x *converter*) x + (y *converter*) y + (aref (seen *converter*) x y) t)) + (defun fill-from (from-x from-y) ;; XXX true-color-behandlung fehlt. (format t "filling at ~A/~A~%" from-x from-y) @@ -126,6 +126,7 @@ (y *converter*) from-y (color *converter*) (aref (pixels *converter*) from-x from-y)) (set-color (color *converter*)) + (turtle:reset) (turtle:move-to from-x from-y) (turtle:pen-down) (turtle:forward) @@ -135,19 +136,26 @@ (eql from-y (turtle:y)))) (cond ((can-turn-right) - (format t " RIGHT~%") + #+(or) (format t " RIGHT~%") + (look :right #'move-to-pixel) (turn :right) - (forward)) + (turtle:forward)) ((can-go-forward) - (format t " FORWARD~%") - (forward)) + #+(or) (format t " FORWARD~%") + (look :forward #'move-to-pixel) + (turtle:forward)) (t - (format t " LEFT~%") + #+(or) (format t " LEFT~%") (turn :left) (turtle:forward))) - (princ turtle::*turtle*) - (terpri)) - (turtle:pen-up)) + #+(or) (format t "at ~A/~A looking ~A ~A~%" + (x *converter*) (y *converter*) + (looking-in-direction *converter*) + turtle::*turtle*) + (assert (and (<= (abs (- (x *converter*) (turtle:x))) 1) + (<= (abs (- (y *converter*) (turtle:y))) 1)))) + (turtle:pen-up) + (print-seen))
(defun pixels-pdf (image-pathname) (let ((*converter* (make-instance 'converter :image-pathname image-pathname))) @@ -162,4 +170,12 @@ (dotimes (x (width *converter*)) (unless (aref (seen *converter*) x y) (fill-from x y)))))) - (pdf:write-document (make-pathname :type "pdf" :defaults image-pathname))))) \ No newline at end of file + (pdf:write-document (make-pathname :type "pdf" :defaults image-pathname))))) + +(defun print-seen () + (dotimes (y (height *converter*)) + (dotimes (x (width *converter*)) + (write-char (if (aref (seen *converter*) x (- (height *converter*) y 1)) + #* #.) + *error-output*)) + (terpri *error-output*))) \ No newline at end of file