# HG changeset patch
# User Robert McIntyre <rlm@mit.edu>
# Date 1283139899 14400
# Node ID a769347618a17a721820e21b1d93221259113360
# Parent  962e223bab0d2291c7afa7cbef37534c0df2833b
saving

diff -r 962e223bab0d -r a769347618a1 src/laser/stupid-backup.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/laser/stupid-backup.clj	Sun Aug 29 23:44:59 2010 -0400
@@ -0,0 +1,240 @@
+(ns laser.rasterize
+  (:use [rlm
+	 image-utils
+	 map-utils]
+	[clojure.contrib
+	 [str-utils :only [str-join re-gsub]]
+	 [seq :only [indexed]]
+	 [math]
+	 [def]
+	 ])
+  (:import [ij ImagePlus IJ]))
+
+;(import '(java.io File))
+;(import '(org.apache.commons.io FileUtils))
+;(import '(javax.imageio ImageIO) )
+
+
+(set! *print-length* 20)
+(def feed 120)
+(def  dpi [500, 500])
+
+(def paramaters {:x-dpi 500 :y-dpi 500 :margin 0 :x-offset 0 :y-offset 0})
+
+;;; this process is divided into two tasks,
+;;; creating the raster g-code, which sweeps back and forth
+;;; and creating the gmask, which turns the laser on and off.
+
+
+;;; we'll be using frame-hashes, which represent picutres as
+;;; a 3D vector field over 2D space, with the vectors representing
+;;; the rgb values at that particular point. 
+
+(defn select-row
+  "returns a frame hash that is just a single line at the chosen y"
+  [y window]
+  (reduce  
+   (fn [old-map number]
+     (let [pixel (get window [number y] nil)]
+       (if-not (nil? pixel)
+	 (into old-map {[number y] pixel})
+	 old-map)))
+   {}
+   (range (width window))))
+
+(defn make-rows [pic]
+  (map (partial sort #(< (first %1) (first %2)))
+       (partition-by last
+		     (sort (fn [[x1 y1][x2 y2]] (> y2 y1))
+			   (map first (filter-vals (partial = black) pic))))))
+
+;;; generate rastering g-code
+
+(defn raster-preamble []
+  (str-join \newline ["M63 P0\nG61" (str "F" feed) "M101" "M3 S1\n"]))
+
+(defn raster-epilogue []
+  (str-join \newline ["M63 P0" "M5" "M2\n"]))
+
+(defn raster-comment
+  "wrap a statement in PARENTHENSIS to make it a comment in gcode.
+   parenthesis themselves aren't allowed in comments.
+   Oh the humanity!!"
+  [string]
+  (str "(" (re-gsub #"[()]" "" string) ")"))
+
+(defn rows
+  "creates a sequence of one dimensional vector fields which
+   represent the rows of a picture"
+  [pic]
+  (let [non-empty-rows (apply sorted-set (map (comp last first) pic))]
+    (pmap (fn [n] (select-row n pic)) non-empty-rows)))
+    
+  
+
+
+
+(defn row->gcode [{:keys [x-dpi y-dpi margin x-offset y-offset]} row]
+  (let [pixels (keys row)
+	x2 0
+	[_ y2] (first pixels)
+	[_ y1] (first pixels)
+	x1 533]
+
+					;(let [ordered-row
+;	(sort-map-by (fn [[x1 _] [x2 _]] (> x2 x1)) row)]
+    
+    (let [;[x1 y1] (last (keys ordered-row))
+	  ;[x2 y2] (first (keys ordered-row))
+	  [x1 y1 x2 y2] (if (odd? y1) [x2 y2 x1 y1] [x1 y1 x2 y2])]
+      
+      (str (format "G0 X%.3f Y%.3f\n"
+		   (float (* x1 (/ x-dpi)))
+		   (float (* y1 (/ y-dpi))))
+	   
+	   (format "G1 X%.3f Y%.3f\n"
+		   (float (* x2 (/ x-dpi)))
+		   (float (* y2 (/ y-dpi))))))))
+
+
+(defn pic->gcode [paramaters pic]
+  (reduce (fn [gcode current-height]
+	    (let [current-row (select-row current-height pic)]
+	      (if-not (empty? current-row)
+		(let [new-code (row->gcode paramaters current-row)] 
+		  (println new-code)
+		  (str gcode new-code))
+		gcode)))
+	  ""
+	  (range (height pic))))
+
+
+
+
+(defn pic->gcode 
+
+
+
+;(defn pic->gcode [paramaters pic]
+  
+
+(defn generate-gcode [pic]
+  (str (raster-preamble)
+       (row->gcode paramaters pic)
+       (raster-epilogue)))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+(defn gather-row [row]
+  (let [base    [[(first (first row)) (first (first row))]]]
+					;  (println base)
+    (reduce 
+     (fn colapse [collection new-n]
+       
+       (let [collection (apply vector collection)
+	     prevoius (last (last collection))
+	     range-start (first (last collection))]
+					;       (println new-n)
+					;       (println prevoius)
+					;       (println range-start)
+	 (if (<= new-n (+ prevoius 1))
+	   (do ;(println "join")
+					;(println (butlast collection)) 
+	     (conj (apply vector (butlast collection))
+		   (vector range-start new-n)))
+	   (conj collection  (vector new-n new-n)))))
+     
+     base
+     (map first row))))
+
+
+
+
+(defn row->gmask [[x-dpi y-dpi] forward? row]
+  (let [start (float (* (/ x-dpi) (first (first
+					  (if forward?
+					  (reverse row) row)))))]
+    (let [preamble (if-not forward?
+		     (format "0 0 0 %.3f\n" start)
+		     (format "0 0 1 %.3f\n" start))
+	  body
+	  (for [[x y]
+		(if forward?
+		  (reverse (gather-row row))
+		  (gather-row row))]
+	    (let [x (float (* x (/ x-dpi)))
+		  y (float (* y (/ x-dpi)))]
+;;		  x (+ x 0.159)];; shift by a small margin.
+	      (if-not forward?
+		(str (format "0 0 1 %.3f\n" x)
+		     (format "0 1 1 %.3f\n" y))
+		
+		(str (format "0 0 0 %.3f\n" y)
+		     (format "0 1 0 %.3f\n" x)))))]
+
+      (str preamble (str-join "" body)))))
+
+
+(defn generate-gmask [pic]
+  (str "1 0 0 0\n"
+       (str-join "" (map (fn [[index row]]
+			   (row->gmask dpi (even? index) row))
+			 (indexed (make-rows pic))))))
+
+
+
+
+;;;; testing
+
+(defn generate-files [pic]
+    (println "made-image")
+    (spit "/home/r/kevin/out.ngc" (generate-gcode pic))
+    (println "/home/r/kevin/out.ngc")
+    (spit "/home/r/kevin/out.gmask" (generate-gmask pic))
+    (println "/home/r/kevin/out.gmask")
+    pic)
+
+(defn update-state []
+  (def sing "/home/r/kevin/sing.png")
+  (def pic (frame-hash (ImagePlus. sing)))  
+  (def pic (b&w pic))
+  (def pic (filter-vals (partial = black) pic)))
+
+(defn compare-gen-fn
+  ([n f cmp]
+  (let [theirs (re-split #"\n" (slurp cmp))
+	ours   (re-split #"\n" (f pic))]
+    (println (format "%1$-25s%2$s" "OURS" "THEIRS"))
+    (println "_______________________________________")
+    (dorun (map (fn [[us them]] (println
+			     (format "%1$-25s%2$s" us them)))
+			     (take n (partition 2 (interleave  ours theirs))))))))
+
+(defn compare-gcode
+  ([] (compare-gcode 25))
+  ([n] (compare-gen-fn n generate-gcode "/home/r/kevin/reference.ngc")))
+
+(defn compare-gmask
+  ([] compare-gmask 25)
+  ([n]  (compare-gen-fn n generate-gmask "/home/r/kevin/reference.gmask")))
+  
+
+
+
+