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

[BKNR Commits]

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