changeset 15:8ad629298649

major refactoring
author Robert McIntyre <rlm@mit.edu>
date Sun, 29 Aug 2010 19:02:26 -0400
parents db745c95aabd
children 52f544d05414
files src/laser/rasterize.clj
diffstat 1 files changed, 83 insertions(+), 272 deletions(-) [+]
line wrap: on
line diff
     1.1 --- a/src/laser/rasterize.clj	Sun Aug 29 00:09:28 2010 -0400
     1.2 +++ b/src/laser/rasterize.clj	Sun Aug 29 19:02:26 2010 -0400
     1.3 @@ -1,107 +1,50 @@
     1.4 -(ns laser.rasterize)
     1.5 +(ns laser.rasterize
     1.6 +  (:use [rlm
     1.7 +	 image-utils
     1.8 +	 map-utils]
     1.9 +	[clojure.contrib
    1.10 +	 [str-utils :only [str-join re-gsub]]
    1.11 +	 [seq :only [indexed]]
    1.12 +	 [math]])
    1.13 +  (:import [ij ImagePlus IJ]))
    1.14  
    1.15 -(import '(java.io File))
    1.16 -(import '(org.apache.commons.io FileUtils))
    1.17 -(import '(javax.imageio ImageIO) )
    1.18 -(import '(javax.swing JFrame))
    1.19 -(import '(java.awt Color BorderLayout))
    1.20 -(import '(ij ImagePlus IJ))
    1.21 -(import '(java.lang Math))
    1.22 -(import '(java.awt Graphics2D Panel))
    1.23 -(import '(ij Macro))
    1.24 +;(import '(java.io File))
    1.25 +;(import '(org.apache.commons.io FileUtils))
    1.26 +;(import '(javax.imageio ImageIO) )
    1.27  
    1.28 -(import '(java.io BufferedReader InputStreamReader))
    1.29 -(import '(java.awt.image BufferedImage))
    1.30  
    1.31 -;(use 'clojure.contrib.str-utils)
    1.32 -;(use 'clojure.contrib.seq-utils)
    1.33 -;(use 'clojure.contrib.combinatorics)
    1.34 -;(use 'clojure.contrib.duck-streams)
    1.35 -
    1.36 -;(use 'clojure.contrib.repl-utils)
    1.37 -
    1.38 -;(set! *print-length* 20)
    1.39 -
    1.40 -
    1.41 -
    1.42 -
    1.43 +(set! *print-length* 20)
    1.44  (def feed 120)
    1.45  (def  dpi [500, 500])
    1.46  
    1.47  
    1.48 +;;; this process is divided into two tasks,
    1.49 +;;; creating the raster g-code, which sweeps back and forth
    1.50 +;;; and creating the gmask, which turns the laser on and off.
    1.51  
    1.52  
    1.53 -(defn preserve-meta [f]
    1.54 -  (fn [& x] (with-meta
    1.55 -	      (apply f x)
    1.56 -	      (meta (last x)))))
    1.57 +;;; we'll be using frame-hashes, which represent picutres as
    1.58 +;;; a 3D vector field over 2D space, with the vectors representing
    1.59 +;;; the rgb values at that particulat point. 
    1.60  
    1.61 -(defmulti frame-hash-multi  class)
    1.62 +(defn select-row
    1.63 +  "returns a frame hash that is just a single line at the chosen y"
    1.64 +  [y window]
    1.65 +  (filter-keys (comp (partial = y) last) window))
    1.66  
    1.67 +(defn make-rows [pic]
    1.68 +  (map (partial sort #(< (first %1) (first %2)))
    1.69 +       (partition-by last
    1.70 +		     (sort (fn [[x1 y1][x2 y2]] (> y2 y1))
    1.71 +			   (map first (filter-vals (partial = black) pic))))))
    1.72  
    1.73 -(defmethod frame-hash-multi ImagePlus
    1.74 -  [image+]
    1.75 -    (with-meta
    1.76 -      (let [buf (.. image+ getBufferedImage)
    1.77 -	    color (.getColorModel buf)]
    1.78 -	(apply hash-map 
    1.79 -	       (interleave 
    1.80 -		(doall (for [x (range (.getWidth image+)) y (range (.getHeight image+))]
    1.81 -			 (vector x y)))
    1.82 -		(doall (for [x (range (.getWidth image+)) y (range (.getHeight image+))]
    1.83 -			 (let [data (.getRGB buf x y)] 
    1.84 -			   (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
    1.85 -				     :g (bit-shift-right (bit-and 0x00ff00 data) 8)
    1.86 -				     :b (bit-and 0x0000ff data))))))))
    1.87 -      {:width  (.getWidth image+) :height (.getHeight image+)}))
    1.88  
    1.89 -
    1.90 -(defmethod frame-hash-multi String
    1.91 -  [image-name]
    1.92 -  (let [image+ (ImagePlus. image-name)]
    1.93 -    (frame-hash-multi image+)))
    1.94 -
    1.95 -
    1.96 -(defn frame-hash
    1.97 -  "yields a convienent representation for the pixles in an image.
    1.98 -   Because of the size of the structvre generated, this must only be used
    1.99 -   in a transient way so that java can do it's garbage collection."
   1.100 -  [something]
   1.101 -  (frame-hash-multi something))
   1.102 -
   1.103 -;(def frame-hash (preserve-meta frame-hash))
   1.104 - 
   1.105 -
   1.106 -
   1.107 -
   1.108 -(def white {:r 255, :g 255, :b 255})
   1.109 -(def black {:r 0,   :g 0,   :b 0})
   1.110 -
   1.111 -
   1.112 -
   1.113 -(defn rgb-euclidian
   1.114 -  [{r1 :r g1 :g b1 :b} {r2 :r g2 :g b2 :b} ]
   1.115 -  (expt (+ (expt (- r1 r2) 2)
   1.116 -	  (expt (- g1 g2) 2)
   1.117 -	  (expt (- b1 b2) 2)) 0.5))
   1.118 -
   1.119 -(defn b&w
   1.120 -  "turn everything strictly black or white"
   1.121 -  [window]
   1.122 -  (with-meta
   1.123 -  (zipmap
   1.124 -   (keys window)
   1.125 -   (map (fn  [rgb] 
   1.126 -	  (if (> (rgb-euclidian rgb white) (rgb-euclidian rgb black))
   1.127 -	    black white))
   1.128 -	(vals window))) (meta window)))
   1.129 -
   1.130 -
   1.131 +;;; generate rastering g-code
   1.132  
   1.133  (defn raster-preamble []
   1.134    (str-join \newline
   1.135  	    ["M63 P0\nG61"
   1.136 -	    (str \F feed)
   1.137 +	    (str "F" feed)
   1.138  	    "M101"
   1.139  	    "M3 S1\n"]))
   1.140  
   1.141 @@ -111,68 +54,9 @@
   1.142  	     "M5"
   1.143  	     "M2\n"]))
   1.144  
   1.145 -
   1.146  (defn raster-comment [string]
   1.147    (str "(" (re-gsub #"[()]" "" string) ")"))
   1.148  
   1.149 -(defn filter-keys [fun m]
   1.150 -  (select-keys m (filter fun (keys m))))
   1.151 -
   1.152 -(def filter-keys (preserve-meta filter-keys))
   1.153 -
   1.154 -(defn filter-vals [fun m]
   1.155 -    (into {} (filter (comp fun val) m)))
   1.156 -
   1.157 -(def filter-vals (preserve-meta filter-vals))
   1.158 -
   1.159 -(defn frame-hash->bufferedImage
   1.160 -  [frame-hash]
   1.161 -    (let [data  (meta frame-hash)
   1.162 -	image (BufferedImage. (:width data) (:height data) BufferedImage/TYPE_INT_BGR)]
   1.163 -	
   1.164 -	(doall (for [element frame-hash] 
   1.165 -	  (let [coord  (key element) 
   1.166 -		rgb   (val element)
   1.167 -		packed-RGB 
   1.168 -		(+ (bit-shift-left (:r rgb) 16)
   1.169 -		   (bit-shift-left (:g rgb) 8)
   1.170 -		                   (:b rgb))]
   1.171 -	    (.setRGB image (first coord) (last coord) packed-RGB))))
   1.172 -	image))
   1.173 -  
   1.174 -(defmulti  display "Creates a JFrame and displays a buffered image"  class)
   1.175 -
   1.176 -(defn- makePanel [image] (proxy [Panel] [] (paint [g]  (.drawImage g image 0 0 nil))))
   1.177 -
   1.178 -(defn select-row [x window]
   1.179 -  (filter-keys (comp (partial = x) first) window))
   1.180 -
   1.181 -
   1.182 -
   1.183 -(defmethod display 
   1.184 -  BufferedImage  [image] 
   1.185 -  (let [panel (makePanel image)
   1.186 -	frame (JFrame. "Oh Yeah!")]
   1.187 -    (.add frame panel) 
   1.188 -    (.pack frame) 
   1.189 -    (.setVisible frame true ) 
   1.190 -    (.setSize frame(.getWidth image) (.getHeight image))))
   1.191 - 
   1.192 -(defmethod display
   1.193 -  ImagePlus [image]
   1.194 -  (display (.getBufferedImage image)))
   1.195 -
   1.196 -(defmethod display
   1.197 -  clojure.lang.PersistentHashMap [frame-hash]
   1.198 -  (display (frame-hash->bufferedImage frame-hash)))
   1.199 -
   1.200 -(defmethod display
   1.201 -    clojure.lang.PersistentArrayMap [frame-hash]
   1.202 -    (display (frame-hash->bufferedImage frame-hash)))
   1.203 -
   1.204 -
   1.205 -
   1.206 -
   1.207  
   1.208  ;this is a sequence of rows
   1.209  
   1.210 @@ -202,6 +86,34 @@
   1.211  		 (float (* x2 (/ x-dpi)))
   1.212  		 (float (* y2 (/ y-dpi)))))))
   1.213  
   1.214 +
   1.215 +(defn generate-gcode [pic]
   1.216 +  (str (raster-preamble)
   1.217 +       (str-join ""
   1.218 +		 (map
   1.219 +		  (fn [[index row]]
   1.220 +		    (row->gcode dpi (even? index) row))
   1.221 +		    (indexed (make-rows pic))))
   1.222 +		 (raster-epilogue)))
   1.223 +
   1.224 +
   1.225 +
   1.226 +
   1.227 +
   1.228 +
   1.229 +
   1.230 +
   1.231 +
   1.232 +
   1.233 +
   1.234 +
   1.235 +
   1.236 +
   1.237 +
   1.238 +
   1.239 +
   1.240 +
   1.241 +
   1.242  (defn gather-row [row]
   1.243    (let [base    [[(first (first row)) (first (first row))]]]
   1.244  					;  (println base)
   1.245 @@ -228,11 +140,9 @@
   1.246  
   1.247  
   1.248  (defn row->gmask [[x-dpi y-dpi] forward? row]
   1.249 -;  (println forward?)
   1.250    (let [start (float (* (/ x-dpi) (first (first
   1.251  					  (if forward?
   1.252  					  (reverse row) row)))))]
   1.253 -
   1.254      (let [preamble (if-not forward?
   1.255  		     (format "0 0 0 %.3f\n" start)
   1.256  		     (format "0 0 1 %.3f\n" start))
   1.257 @@ -242,7 +152,7 @@
   1.258  		  (reverse (gather-row row))
   1.259  		  (gather-row row))]
   1.260  	    (let [x (float (* x (/ x-dpi)))
   1.261 -		  y (float (* y (/ x-dpi)))
   1.262 +		  y (float (* y (/ x-dpi)))]
   1.263  ;;		  x (+ x 0.159)];; shift by a small margin.
   1.264  	      (if-not forward?
   1.265  		(str (format "0 0 1 %.3f\n" x)
   1.266 @@ -254,144 +164,45 @@
   1.267        (str preamble (str-join "" body)))))
   1.268  
   1.269  
   1.270 -
   1.271 -(defn make-rows [pic]
   1.272 -  (map (partial sort #(< (first %1) (first %2)))
   1.273 -       (partition-by last
   1.274 -		     (sort (fn [[x1 y1][x2 y2]] (> y2 y1))
   1.275 -			   (map first (filter-vals (partial = black) pic))))))
   1.276 -
   1.277 -
   1.278 -
   1.279  (defn generate-gmask [pic]
   1.280 -
   1.281    (str "1 0 0 0\n"
   1.282         (str-join "" (map (fn [[index row]]
   1.283  			   (row->gmask dpi (even? index) row))
   1.284  			 (indexed (make-rows pic))))))
   1.285  
   1.286  
   1.287 -;; 1 0 0 0
   1.288 -;; 0 0 1 2.881
   1.289 -;; 0 0 0 2.881
   1.290 -;; 0 1 0 2.863
   1.291 -;; 0 0 0 2.769
   1.292 -;; 0 1 0 2.751
   1.293 -;; 0 0 0 2.729
   1.294 -;; 0 1 0 2.617
   1.295 -;; 0 0 0 2.593
   1.296 -;; 0 1 0 2.561
   1.297 -;; 0 0 0 2.463
   1.298 -;; 0 1 0 2.445
   1.299 -;; 0 0 0 2.385
   1.300 -;; 0 1 0 2.317
   1.301 -;; 0 0 0 2.253
   1.302 -;; 0 1 0 2.233
   1.303 -;; 0 0 0 2.177
   1.304 -
   1.305 -
   1.306 -
   1.307 -(defn generate-gcode [pic]
   1.308 -  (str (raster-preamble)
   1.309 -
   1.310 -       (str-join ""
   1.311 -		 (map
   1.312 -		  (fn [index row]
   1.313 -		    (partial row->gcode dpi (even? index)) (indexed (make-rows pic))))
   1.314 -		 (raster-epilogue))))
   1.315 -
   1.316 -
   1.317 -       
   1.318 -;       (str-join "" (map (partial row->gcode dpi) (make-rows pic)))
   1.319 - ;      (raster-epilogue)))
   1.320 -  
   1.321 -
   1.322 -
   1.323 -(defn rotate [degrees #^ImagePlus image]
   1.324 -  (.rotate (.getChannelProcessor image) degrees)
   1.325 -  image)
   1.326 -
   1.327 -(defn map-keys [f m]
   1.328 -  (into {} (map (fn [[key val]] [(f key) val]) m)))
   1.329 -
   1.330 -
   1.331 -
   1.332 -(defn invert-frame-hash [pic]
   1.333 -  (map-keys (fn [[x y]] [x (- (:height (meta pic)) y 1)]) pic ))
   1.334 -
   1.335 -
   1.336 -(defn generate-files [pic]
   1.337 -  (let [image (invert-frame-hash (b&w (frame-hash  (rotate 180 (ImagePlus. pic)))))]
   1.338 -    (spit "/home/r/kevin/out.ngc" (generate-gcode image))
   1.339 -    (spit "/home/r/kevin/out.gmask" (generate-gmask image))
   1.340 -    image))
   1.341 -
   1.342 -
   1.343 -
   1.344 -(defn update-state []
   1.345 -(def sing "/home/r/lasercutter/graster/signer4laser2x1.png")
   1.346 -
   1.347 -(def pic (frame-hash (let [image  (ImagePlus. sing)]
   1.348 -		       (.rotate (.getChannelProcessor image) 180)
   1.349 -		       image)))
   1.350 -
   1.351 -(def pic (b&w pic)))
   1.352 -
   1.353 -
   1.354 -
   1.355 -
   1.356 -
   1.357 -
   1.358 -
   1.359 -
   1.360 -
   1.361  
   1.362  
   1.363  ;;;; testing
   1.364  
   1.365 -(defn init []
   1.366 -  (let [stuff
   1.367 -    
   1.368 -      (bound-fn []
   1.369 +(defn generate-files [pic]
   1.370 +    (println "made-image")
   1.371 +    (spit "/home/r/kevin/out.ngc" (generate-gcode pic))
   1.372 +    (println "/home/r/kevin/out.ngc")
   1.373 +    (spit "/home/r/kevin/out.gmask" (generate-gmask pic))
   1.374 +    (println "/home/r/kevin/out.gmask")
   1.375 +    pic)
   1.376  
   1.377 -	(do 
   1.378 -	  (println "hi everyone")
   1.379 -	  (def img "/home/r/kevin/sing.png")
   1.380 -	  (def pic (frame-hash (let [image  (ImagePlus. img)]
   1.381 -				 (.rotate (.getChannelProcessor image) 180)
   1.382 -				 image)))
   1.383 +(defn update-state []
   1.384 +  (def sing "/home/r/kevin/sing.png")
   1.385 +  (def pic (frame-hash (ImagePlus. sing)))  
   1.386 +  (def pic (b&w pic)))
   1.387  
   1.388 +(defn compare-gen-fn [n f cmp]
   1.389 +  (let [theirs (re-split #"\n" (slurp cmp))
   1.390 +	ours   (re-split #"\n" (f pic))]
   1.391 +    (println (format "%1$-25s%2$s" "OURS" "THEIRS"))
   1.392 +    (println "_______________________________________")
   1.393 +    (dorun (map (fn [[us them]] (println
   1.394 +			     (format "%1$-25s%2$s" us them)))
   1.395 +			     (take n (partition 2 (interleave  ours theirs)))))))
   1.396  
   1.397 -	  (def test-image
   1.398 -	       (invert-frame-hash (b&w (frame-hash  (rotate 180 (ImagePlus. img))))))
   1.399 -	  
   1.400 -	  (defn test-gmask []
   1.401 -	    (println (str-join "" (take 170 (generate-gmask test-image)))))
   1.402 +(defn compare-gcode [n]
   1.403 +  (compare-gen-fn n generate-gcode "/home/r/kevin/reference.ngc"))
   1.404 +(defn compare-gmask [n]
   1.405 +  (compare-gen-fn n generate-gmask "/home/r/kevin/reference.gmask"))
   1.406 +  
   1.407  
   1.408 -	  (println "ALL variables initialized!")
   1.409  
   1.410 -	  ))]
   1.411 -  (.start
   1.412 -     (Thread. stuff))))
   1.413  
   1.414  
   1.415 -
   1.416 -(defn thread-test []
   1.417 -
   1.418 -  (let [temp *out*]
   1.419 -    (.start
   1.420 -     (Thread.
   1.421 -      (fn []
   1.422 -	(with-bindings  {#'*out* temp}
   1.423 -	  (Thread/sleep 5000)
   1.424 -	  (println "hi")))))))
   1.425 -
   1.426 -
   1.427 -(comment
   1.428 -  (do
   1.429 -    (require 'rlm.quick)
   1.430 -    (ns laser.rasterize)
   1.431 -    (rlm.quick/dirty)
   1.432 -    (use :reload-all 'laser.rasterize)
   1.433 -    (undef map-keys)
   1.434 -    (use :reload-all 'laser.rasterize)))