was auch immer das hier sein soll, wir checkens ieber ein

arc.lisp

@@ -20,6 +20,12 @@
 	  (+ angle (* 2 *PI*))
 	  angle))))
 
+(defmethod transform-object ((arc arc) matrix)
+  (make-arc :a (transform-object (arc-a arc) matrix)
+	    :b (transform-object (arc-b arc) matrix)
+	    :direction (arc-direction arc)
+	    :centre (transform-object (arc-centre arc) matrix)))
+
 (deftest :arc "Test arc angle cw"
   (let ((arc (make-arc :centre (2dp 0 0)
 		       :a (2dp -1 0)

holz-box.lisp

@@ -96,7 +96,25 @@
 	    (mill-d)
 	    )
 	  (progn
-	    (s-mill-round-r) (s-mill-round-d))))))
+	    (s-mill-round-r) (s-mill-round-d)))
+
+  (when *logo2*
+    (let* ((rlogo2 (rotate-and-bring-to-zero *logo2* 180))
+	   (bbox (bounding-box rlogo2))
+	   (logo-w (bbox-width bbox))
+	   (logo-h (bbox-height bbox))
+	   (scale-w (/ (* 0.6 wx) logo-w))
+	   (scale-h (/ (* 0.6 height) logo-h))
+	   (scale (min scale-w scale-h))
+	   (real-logo-w (* scale logo-w))
+	   (real-logo-h (* scale logo-h)))
+      (format t "scale: ~A~%" scale)
+      (with-transform ((translation-matrix (* (- wx real-logo-w) 0.5)
+					   (* (- height real-logo-h) 0.4)))
+	(with-transform ((scaling-matrix scale))
+	  (dolist (curve rlogo2)
+	    (mill-curve curve :depth 1)))))))
+      ))
 
 (defun holz-box-bottom (&key (wx *holz-box-wx*) (wy *holz-box-wy*) (height *holz-box-height*))
   (let* ((x-width (calc-box-width wx))
@@ -185,8 +203,10 @@
 		    (mill-d++ y-step-width) (s-mill-round-r)
 		    (mill-d-- y-step-width) (s-mill-round-l))
 	    (mill-d++) (s-mill-round-r) (mill-d))))))
-
-(defun holz-box-2 (&key (wx *holz-box-wx*) (wy *holz-box-wy*) (height *holz-box-height*))
+
+(defparameter *logo* nil)
+(defparameter *logo2* nil)
+(defun holz-box-2 (&key (wx *holz-box-wx*) (wy *holz-box-wy*) (height *holz-box-height*) )
   (let* ((x-width (calc-box-width wx))
 	 (y-width (calc-box-width wy))
 	 (h-width (calc-box-width height))
@@ -232,7 +252,23 @@
 	      (mill-d++ h-step-width) (s-mill-round-r)
 	      (mill-d-- h-step-width) (s-mill-round-l))
       (mill-d++) (s-mill-round-r) (mill-d--) (s-mill-round-l)
-      (mill-d++) (mill-d))))
+      (mill-d++) (mill-d)))
+
+  (when *logo*
+    (let* ((bbox (bounding-box *logo*))
+	   (logo-w (bbox-width bbox))
+	   (logo-h (bbox-height bbox))
+	   (scale-w (/ (* 0.6 wx) logo-w))
+	   (scale-h (/ (* 0.6 height) logo-h))
+	   (scale (min scale-w scale-h))
+	   (real-logo-w (* scale logo-w))
+	   (real-logo-h (* scale logo-h)))
+      (format t "scale: ~A~%" scale)
+      (with-transform ((translation-matrix (* (- wx real-logo-w) 0.5)
+					   (* (- height real-logo-h) 0.6)))
+	(with-transform ((scaling-matrix scale))
+	  (dolist (curve *logo*)
+	    (mill-curve curve :depth 1)))))))
 
 (defun holz-box-3 (&key (wx *holz-box-wx*) (wy *holz-box-wy*) (height *holz-box-height*))
   (let* ((x-width (calc-box-width wx))
@@ -386,6 +422,13 @@
 	(*holz-box-wx* wx)
 	(*holz-box-wy* wy)
 	(*holz-box-height* height))
+
+
+  ;; XXX hack
+    (let ((logo
+	   (or *logo*
+	       (mapcar #'curve-to-arcs (trace-image "/Users/manuel/logo-transparent.png" :colors (list 0))))))
+      (setf *logo* logo))
 
   (with-program ("small-cube")
     (with-tool (*cube-tool*)
@@ -395,8 +438,9 @@
 
       (with-transform ((translation-matrix 0 20))
 	(let* ((panels (holz-box-panels :wx wx :wy wy :height height))
-	       (orders (order-panels panels '((5))
-				     #+nil'((2 )
+	       (orders (order-panels panels
+				     #+nil'((5))
+				     #-nil'((2 )
 					    (3 4)
 					    (1 5))
 

mididuino.lisp

@@ -18,6 +18,33 @@
 	   for panel = (first order)
 	   do (schedule-panel panel x y))))))
 
+(defun hubble-circle (&key (x 5) (y 5))
+  (let ((width 7))
+    (with-named-pass ("mill")
+      (goto-abs :x x :y (- y (/ width 2)))
+      (repeat-for-depth (4)
+			(circle (/ width 2))))
+    (with-named-pass ("drill")
+      (drill :x x :y y :diameter 3 :depth 4))))
+
+(defun make-panel-array (num x y)
+  (make-list y :initial-element (make-list x :initial-element num)))
+
+(defun hubble-program ()
+  (let ((panels (list (calculate-panel 'hubble-circle))))
+
+  (with-program ("hubble")
+    (with-tool (*plywood-board-tool*)
+      (spindle-on)
+      (goto-abs :x 0 :y 0)
+      (goto-abs :z *fly-height*)
+      (let ((orders (order-panels panels (make-panel-array 1 10 6) 3)))
+	(loop for order in orders
+	   for x = (second order)
+	   for y = (third order)
+	   for panel = (first order)
+	     do (schedule-panel panel x y)))))))
+
 
 (defun maennchen-trace-panel (num &key (scale 0.4) cache)
   (let* ((image (format nil "/Users/manuel/siff-svn/ruinwesen/mididuino-boards/boards/board-eyes-~A.png" num))
@@ -59,7 +86,6 @@
     (let ((bbox (bounding-box (append curves-outline curves-eyes))))
       (with-tool (*plywood-board-tool*)
 
-	#+nil
 	(with-named-pass ("drills")
 	  (with-tool (*plywood-board-tool*)
 	    (with-transform ((translation-matrix 7 60))
@@ -81,7 +107,7 @@
 	(with-transform ((translation-matrix (* scale (- (2d-point-x (line-a bbox))))
 					     (* scale (- (2d-point-y (line-a bbox))))))
 
-	  #+nil
+	  #-nil
 	  (with-named-pass ("eyes")
 	    (with-tool (*plywood-board-tool*)
 	      (dolist (curve curves-eyes)
@@ -103,42 +129,44 @@
 	  (with-named-pass ("font")
 	    (with-tool (*plywood-board-tool*)
 	      (dolist (curve curves-name)
-		(mill-curve curve :scale scale :depth 3))))
+		(mill-curve curve :scale scale :depth 0.7))))
 
-	  #+nil
+	  #-nil
 	  (with-named-pass ("inner")
 	    (with-tool (*plywood-board-tool*)
 	      (mill-curve (offset-curve (first curves-outline) 3) :depth 0.7 :scale scale)))
 
-	  #+nil
+	  #-nil
 	  (with-named-pass ("outline")
 	    (with-tool (*plywood-board-tool*)
 	      (mill-curve (offset-curve (first curves-outline) -6) :scale scale :depth 4))))))))
 
 ;; board = 1035 pixel width
 (defun test-eyes-offset (&key (scale 0.4))
   (with-program ("maennchen")
-    (with-tool (*pcb-tool*)
-  (let ((bbox (bounding-box (append *outline* *eyes*))))
-    (with-tool (*pcb-tool*)
-      (spindle-on)
-      (goto-abs :x 0 :y 0)
-      (goto-abs :z *fly-height*)
-      (with-transform ((translation-matrix (* scale (- (2d-point-x (line-a bbox))))
-					   (* scale (- (2d-point-y (line-a bbox))))))
-
-	(with-named-pass ("eyes")
-	  (let ((logo (first (last *eyes*))))
-	    (mill-curve *logo* :depth 2 :scale scale)))))))))
-    
+    (with-transform ((translation-matrix 0 4))
+      (with-tool (*plywood-board-tool*)
+	(let ((bbox (bounding-box (append *outline* *eyes*))))
+	  (spindle-on)
+	  (goto-abs :x 0 :y 0)
+	  (goto-abs :z *fly-height*)
+	  (with-transform ((translation-matrix (* scale (- (2d-point-x (line-a bbox))))
+					       (* scale (- (2d-point-y (line-a bbox))))))
+	    
+	    (with-named-pass ("eyes")
+	      (let ((logo (first (last *eyes*))))
+		(mill-curve *logo* :depth 2 :scale scale)))))))))
+
 
 
 
 (defun maennchen-trace (num &key (scale 0.337) cache)
   (with-program ("maennchen")
-    (with-tool (*trace-tool*)
-      (spindle-on)
-      (goto-abs :x 0 :y 0)
-      (goto-abs :z *fly-height*)
-      (maennchen-trace-panel num :scale scale :cache cache))))
+    (with-transform ((translation-matrix 0 4))
+      (with-tool (*plywood-board-tool*)
+	(spindle-on)
+	(goto-abs :x 0 :y 0)
+	(goto-abs :z *fly-height*)
+	(maennchen-trace-panel num :scale scale :cache cache)
+	))))
 

panel.lisp

@@ -30,15 +30,21 @@
 
 (defun calculate-panel (function-name)
   ;; new program XXX
-  (let ((*current-program* (make-instance 'gcode-program :name "calculate shit")))
-    (with-new-pass ("calculate pass")
-      (let ((res (with-save-xy () (funcall (symbol-function function-name)))))
+  (let* ((*current-program* (make-instance 'gcode-program :name "calculate shit")))
+    (funcall (symbol-function function-name))
+    (let* ((passes (gcode-program-passes *current-program*))
+	   (min-x (apply #'min (mapcar #'pass-min-x passes)))
+	   (max-x (apply #'max (mapcar #'pass-max-x passes)))
+	   (min-y (apply #'min (mapcar #'pass-min-y passes)))
+	   (max-y (apply #'max (mapcar #'pass-max-y passes)))
+	   (min-z (apply #'min (mapcar #'pass-min-z passes)))
+	   (max-z (apply #'max (mapcar #'pass-max-z passes))))
 	(make-instance 'panel :name function-name
 		       :gcode res
-		       :min-x (min-x) :max-x (max-x)
-		       :min-y (min-y) :max-y (max-y)
-		       :min-z (min-z) :max-z (max-z)
-		       :code `(,function-name))))))
+		       :min-x min-x :max-x max-x
+		       :min-y min-y :max-y max-y
+		       :min-z min-z :max-z max-z
+		       :code `(,function-name)))))
 
 (defun calculate-panel-code (code &key passname)
   (let ((*current-program* (make-instance 'gcode-program :name "calculate shit")))

potrace.lisp

@@ -253,6 +253,13 @@
 	 (max-y (reduce #'max (mapcar #'(lambda (x) (2d-point-y (line-b x))) bboxes))))
     (make-line :a (2dp min-x min-y) :b (2dp max-x max-y))))
 
+(defun rotate-and-bring-to-zero (object angle)
+  (let* ((robj (transform-object object (rotation-matrix angle)))
+	 (bbox (bounding-box robj))
+	 (bottom (bbox-bottom bbox))
+	 (left (bbox-left bbox)))
+    (transform-object robj (translation-matrix (- left) (- bottom)))))
+
 (defun bbox-below-p (obj y)
   (let ((bbox (bounding-box obj)))
     (< (2d-point-y (line-b bbox)) y)))
@@ -283,7 +290,7 @@
 
 (defparameter *plywood-board-tool*
   (make-instance 'tool
-		 :diameter 2
+		 :diameter 1
 		 :number 6
 		 :feed-xy 600
 		 :feed-z 240

shapes.lisp

@@ -102,7 +102,7 @@
        (arc-cw-rel :x radius :y (- radius) :i 0 :j (- radius))
        (arc-cw-rel :x (- radius) :y (- radius) :i (- radius) :j 0))))
 
-(defun make-circle (radius &key ccw)
+#+nil(defun make-circle (radius &key ccw)
   (if ccw
       (progn
 	(arc-ccw-rel :x radius :y radius :i 0 :j radius :f (tool-feed-z *current-tool*))