1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/laser/stupid-backup.clj	Sun Aug 29 23:44:59 2010 -0400
     1.3 @@ -0,0 +1,240 @@
     1.4 +(ns laser.rasterize
     1.5 +  (:use [rlm
     1.6 +	 image-utils
     1.7 +	 map-utils]
     1.8 +	[clojure.contrib
     1.9 +	 [str-utils :only [str-join re-gsub]]
    1.10 +	 [seq :only [indexed]]
    1.11 +	 [math]
    1.12 +	 [def]
    1.13 +	 ])
    1.14 +  (:import [ij ImagePlus IJ]))
    1.15 +
    1.16 +;(import '(java.io File))
    1.17 +;(import '(org.apache.commons.io FileUtils))
    1.18 +;(import '(javax.imageio ImageIO) )
    1.19 +
    1.20 +
    1.21 +(set! *print-length* 20)
    1.22 +(def feed 120)
    1.23 +(def  dpi [500, 500])
    1.24 +
    1.25 +(def paramaters {:x-dpi 500 :y-dpi 500 :margin 0 :x-offset 0 :y-offset 0})
    1.26 +
    1.27 +;;; this process is divided into two tasks,
    1.28 +;;; creating the raster g-code, which sweeps back and forth
    1.29 +;;; and creating the gmask, which turns the laser on and off.
    1.30 +
    1.31 +
    1.32 +;;; we'll be using frame-hashes, which represent picutres as
    1.33 +;;; a 3D vector field over 2D space, with the vectors representing
    1.34 +;;; the rgb values at that particular point. 
    1.35 +
    1.36 +(defn select-row
    1.37 +  "returns a frame hash that is just a single line at the chosen y"
    1.38 +  [y window]
    1.39 +  (reduce  
    1.40 +   (fn [old-map number]
    1.41 +     (let [pixel (get window [number y] nil)]
    1.42 +       (if-not (nil? pixel)
    1.43 +	 (into old-map {[number y] pixel})
    1.44 +	 old-map)))
    1.45 +   {}
    1.46 +   (range (width window))))
    1.47 +
    1.48 +(defn make-rows [pic]
    1.49 +  (map (partial sort #(< (first %1) (first %2)))
    1.50 +       (partition-by last
    1.51 +		     (sort (fn [[x1 y1][x2 y2]] (> y2 y1))
    1.52 +			   (map first (filter-vals (partial = black) pic))))))
    1.53 +
    1.54 +;;; generate rastering g-code
    1.55 +
    1.56 +(defn raster-preamble []
    1.57 +  (str-join \newline ["M63 P0\nG61" (str "F" feed) "M101" "M3 S1\n"]))
    1.58 +
    1.59 +(defn raster-epilogue []
    1.60 +  (str-join \newline ["M63 P0" "M5" "M2\n"]))
    1.61 +
    1.62 +(defn raster-comment
    1.63 +  "wrap a statement in PARENTHENSIS to make it a comment in gcode.
    1.64 +   parenthesis themselves aren't allowed in comments.
    1.65 +   Oh the humanity!!"
    1.66 +  [string]
    1.67 +  (str "(" (re-gsub #"[()]" "" string) ")"))
    1.68 +
    1.69 +(defn rows
    1.70 +  "creates a sequence of one dimensional vector fields which
    1.71 +   represent the rows of a picture"
    1.72 +  [pic]
    1.73 +  (let [non-empty-rows (apply sorted-set (map (comp last first) pic))]
    1.74 +    (pmap (fn [n] (select-row n pic)) non-empty-rows)))
    1.75 +    
    1.76 +  
    1.77 +
    1.78 +
    1.79 +
    1.80 +(defn row->gcode [{:keys [x-dpi y-dpi margin x-offset y-offset]} row]
    1.81 +  (let [pixels (keys row)
    1.82 +	x2 0
    1.83 +	[_ y2] (first pixels)
    1.84 +	[_ y1] (first pixels)
    1.85 +	x1 533]
    1.86 +
    1.87 +					;(let [ordered-row
    1.88 +;	(sort-map-by (fn [[x1 _] [x2 _]] (> x2 x1)) row)]
    1.89 +    
    1.90 +    (let [;[x1 y1] (last (keys ordered-row))
    1.91 +	  ;[x2 y2] (first (keys ordered-row))
    1.92 +	  [x1 y1 x2 y2] (if (odd? y1) [x2 y2 x1 y1] [x1 y1 x2 y2])]
    1.93 +      
    1.94 +      (str (format "G0 X%.3f Y%.3f\n"
    1.95 +		   (float (* x1 (/ x-dpi)))
    1.96 +		   (float (* y1 (/ y-dpi))))
    1.97 +	   
    1.98 +	   (format "G1 X%.3f Y%.3f\n"
    1.99 +		   (float (* x2 (/ x-dpi)))
   1.100 +		   (float (* y2 (/ y-dpi))))))))
   1.101 +
   1.102 +
   1.103 +(defn pic->gcode [paramaters pic]
   1.104 +  (reduce (fn [gcode current-height]
   1.105 +	    (let [current-row (select-row current-height pic)]
   1.106 +	      (if-not (empty? current-row)
   1.107 +		(let [new-code (row->gcode paramaters current-row)] 
   1.108 +		  (println new-code)
   1.109 +		  (str gcode new-code))
   1.110 +		gcode)))
   1.111 +	  ""
   1.112 +	  (range (height pic))))
   1.113 +
   1.114 +
   1.115 +
   1.116 +
   1.117 +(defn pic->gcode 
   1.118 +
   1.119 +
   1.120 +
   1.121 +;(defn pic->gcode [paramaters pic]
   1.122 +  
   1.123 +
   1.124 +(defn generate-gcode [pic]
   1.125 +  (str (raster-preamble)
   1.126 +       (row->gcode paramaters pic)
   1.127 +       (raster-epilogue)))
   1.128 +
   1.129 +
   1.130 +
   1.131 +
   1.132 +
   1.133 +
   1.134 +
   1.135 +
   1.136 +
   1.137 +
   1.138 +
   1.139 +
   1.140 +
   1.141 +
   1.142 +
   1.143 +
   1.144 +
   1.145 +
   1.146 +
   1.147 +(defn gather-row [row]
   1.148 +  (let [base    [[(first (first row)) (first (first row))]]]
   1.149 +					;  (println base)
   1.150 +    (reduce 
   1.151 +     (fn colapse [collection new-n]
   1.152 +       
   1.153 +       (let [collection (apply vector collection)
   1.154 +	     prevoius (last (last collection))
   1.155 +	     range-start (first (last collection))]
   1.156 +					;       (println new-n)
   1.157 +					;       (println prevoius)
   1.158 +					;       (println range-start)
   1.159 +	 (if (<= new-n (+ prevoius 1))
   1.160 +	   (do ;(println "join")
   1.161 +					;(println (butlast collection)) 
   1.162 +	     (conj (apply vector (butlast collection))
   1.163 +		   (vector range-start new-n)))
   1.164 +	   (conj collection  (vector new-n new-n)))))
   1.165 +     
   1.166 +     base
   1.167 +     (map first row))))
   1.168 +
   1.169 +
   1.170 +
   1.171 +
   1.172 +(defn row->gmask [[x-dpi y-dpi] forward? row]
   1.173 +  (let [start (float (* (/ x-dpi) (first (first
   1.174 +					  (if forward?
   1.175 +					  (reverse row) row)))))]
   1.176 +    (let [preamble (if-not forward?
   1.177 +		     (format "0 0 0 %.3f\n" start)
   1.178 +		     (format "0 0 1 %.3f\n" start))
   1.179 +	  body
   1.180 +	  (for [[x y]
   1.181 +		(if forward?
   1.182 +		  (reverse (gather-row row))
   1.183 +		  (gather-row row))]
   1.184 +	    (let [x (float (* x (/ x-dpi)))
   1.185 +		  y (float (* y (/ x-dpi)))]
   1.186 +;;		  x (+ x 0.159)];; shift by a small margin.
   1.187 +	      (if-not forward?
   1.188 +		(str (format "0 0 1 %.3f\n" x)
   1.189 +		     (format "0 1 1 %.3f\n" y))
   1.190 +		
   1.191 +		(str (format "0 0 0 %.3f\n" y)
   1.192 +		     (format "0 1 0 %.3f\n" x)))))]
   1.193 +
   1.194 +      (str preamble (str-join "" body)))))
   1.195 +
   1.196 +
   1.197 +(defn generate-gmask [pic]
   1.198 +  (str "1 0 0 0\n"
   1.199 +       (str-join "" (map (fn [[index row]]
   1.200 +			   (row->gmask dpi (even? index) row))
   1.201 +			 (indexed (make-rows pic))))))
   1.202 +
   1.203 +
   1.204 +
   1.205 +
   1.206 +;;;; testing
   1.207 +
   1.208 +(defn generate-files [pic]
   1.209 +    (println "made-image")
   1.210 +    (spit "/home/r/kevin/out.ngc" (generate-gcode pic))
   1.211 +    (println "/home/r/kevin/out.ngc")
   1.212 +    (spit "/home/r/kevin/out.gmask" (generate-gmask pic))
   1.213 +    (println "/home/r/kevin/out.gmask")
   1.214 +    pic)
   1.215 +
   1.216 +(defn update-state []
   1.217 +  (def sing "/home/r/kevin/sing.png")
   1.218 +  (def pic (frame-hash (ImagePlus. sing)))  
   1.219 +  (def pic (b&w pic))
   1.220 +  (def pic (filter-vals (partial = black) pic)))
   1.221 +
   1.222 +(defn compare-gen-fn
   1.223 +  ([n f cmp]
   1.224 +  (let [theirs (re-split #"\n" (slurp cmp))
   1.225 +	ours   (re-split #"\n" (f pic))]
   1.226 +    (println (format "%1$-25s%2$s" "OURS" "THEIRS"))
   1.227 +    (println "_______________________________________")
   1.228 +    (dorun (map (fn [[us them]] (println
   1.229 +			     (format "%1$-25s%2$s" us them)))
   1.230 +			     (take n (partition 2 (interleave  ours theirs))))))))
   1.231 +
   1.232 +(defn compare-gcode
   1.233 +  ([] (compare-gcode 25))
   1.234 +  ([n] (compare-gen-fn n generate-gcode "/home/r/kevin/reference.ngc")))
   1.235 +
   1.236 +(defn compare-gmask
   1.237 +  ([] compare-gmask 25)
   1.238 +  ([n]  (compare-gen-fn n generate-gmask "/home/r/kevin/reference.gmask")))
   1.239 +  
   1.240 +
   1.241 +
   1.242 +
   1.243 +