rlm@0: (ns laser.rasterize)
rlm@0: 
rlm@0: (import '(java.io File))
rlm@0: (import '(org.apache.commons.io FileUtils))
rlm@0: (import '(javax.imageio ImageIO) )
rlm@0: (import '(javax.swing JFrame))
rlm@0: (import '(java.awt Color BorderLayout))
rlm@0: (import '(ij ImagePlus IJ))
rlm@0: (import '(java.lang Math))
rlm@2: (import '(java.awt Graphics2D Panel))
rlm@0: (import '(ij Macro))
rlm@0: 
rlm@0: (import '(java.io BufferedReader InputStreamReader))
rlm@0: (import '(java.awt.image BufferedImage))
rlm@0: 
rlm@11: ;(use 'clojure.contrib.str-utils)
rlm@11: ;(use 'clojure.contrib.seq-utils)
rlm@11: ;(use 'clojure.contrib.combinatorics)
rlm@11: ;(use 'clojure.contrib.duck-streams)
rlm@0: 
rlm@11: ;(use 'clojure.contrib.repl-utils)
rlm@0: 
rlm@11: ;(set! *print-length* 20)
rlm@0: 
rlm@0: 
rlm@0: 
rlm@1: 
rlm@1: (def feed 120)
rlm@1: (def  dpi [500, 500])
rlm@8: 
rlm@8: 
rlm@1: 
rlm@1: 
rlm@5: (defn preserve-meta [f]
rlm@5:   (fn [& x] (with-meta
rlm@5: 	      (apply f x)
rlm@5: 	      (meta (last x)))))
rlm@2: 
rlm@8: (defmulti frame-hash-multi  class)
rlm@1: 
rlm@1: 
rlm@8: (defmethod frame-hash-multi ImagePlus
rlm@8:   [image+]
rlm@0:     (with-meta
rlm@0:       (let [buf (.. image+ getBufferedImage)
rlm@0: 	    color (.getColorModel buf)]
rlm@0: 	(apply hash-map 
rlm@0: 	       (interleave 
rlm@0: 		(doall (for [x (range (.getWidth image+)) y (range (.getHeight image+))]
rlm@0: 			 (vector x y)))
rlm@0: 		(doall (for [x (range (.getWidth image+)) y (range (.getHeight image+))]
rlm@0: 			 (let [data (.getRGB buf x y)] 
rlm@0: 			   (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
rlm@0: 				     :g (bit-shift-right (bit-and 0x00ff00 data) 8)
rlm@0: 				     :b (bit-and 0x0000ff data))))))))
rlm@8:       {:width  (.getWidth image+) :height (.getHeight image+)}))
rlm@0: 
rlm@0: 
rlm@8: (defmethod frame-hash-multi String
rlm@8:   [image-name]
rlm@8:   (let [image+ (ImagePlus. image-name)]
rlm@8:     (frame-hash-multi image+)))
rlm@5: 
rlm@5: 
rlm@8: (defn frame-hash
rlm@8:   "yields a convienent representation for the pixles in an image.
rlm@8:    Because of the size of the structvre generated, this must only be used
rlm@8:    in a transient way so that java can do it's garbage collection."
rlm@8:   [something]
rlm@8:   (frame-hash-multi something))
rlm@8: 
rlm@8: ;(def frame-hash (preserve-meta frame-hash))
rlm@8:  
rlm@5: 
rlm@5: 
rlm@5: 
rlm@1: (def white {:r 255, :g 255, :b 255})
rlm@1: (def black {:r 0,   :g 0,   :b 0})
rlm@1: 
rlm@11: 
rlm@1: 
rlm@1: (defn rgb-euclidian
rlm@1:   [{r1 :r g1 :g b1 :b} {r2 :r g2 :g b2 :b} ]
rlm@1:   (expt (+ (expt (- r1 r2) 2)
rlm@1: 	  (expt (- g1 g2) 2)
rlm@1: 	  (expt (- b1 b2) 2)) 0.5))
rlm@1: 
rlm@1: (defn b&w
rlm@1:   "turn everything strictly black or white"
rlm@1:   [window]
rlm@1:   (with-meta
rlm@1:   (zipmap
rlm@1:    (keys window)
rlm@1:    (map (fn  [rgb] 
rlm@1: 	  (if (> (rgb-euclidian rgb white) (rgb-euclidian rgb black))
rlm@1: 	    black white))
rlm@1: 	(vals window))) (meta window)))
rlm@1: 
rlm@1: 
rlm@1: 
rlm@3: (defn raster-preamble []
rlm@3:   (str-join \newline
rlm@3: 	    ["M63 P0\nG61"
rlm@3: 	    (str \F feed)
rlm@3: 	    "M101"
rlm@8: 	    "M3 S1\n"]))
rlm@3: 
rlm@4: (defn raster-epilogue []
rlm@4:   (str-join \newline
rlm@8: 	    ["M63 P0"
rlm@4: 	     "M5"
rlm@8: 	     "M2\n"]))
rlm@3: 
rlm@1: 
rlm@4: (defn raster-comment [string]
rlm@4:   (str "(" (re-gsub #"[()]" "" string) ")"))
rlm@1: 
rlm@4: (defn filter-keys [fun m]
rlm@4:   (select-keys m (filter fun (keys m))))
rlm@6: 
rlm@5: (def filter-keys (preserve-meta filter-keys))
rlm@2: 
rlm@4: (defn filter-vals [fun m]
rlm@5:     (into {} (filter (comp fun val) m)))
rlm@6: 
rlm@5: (def filter-vals (preserve-meta filter-vals))
rlm@1: 
rlm@0: (defn frame-hash->bufferedImage
rlm@0:   [frame-hash]
rlm@0:     (let [data  (meta frame-hash)
rlm@0: 	image (BufferedImage. (:width data) (:height data) BufferedImage/TYPE_INT_BGR)]
rlm@0: 	
rlm@0: 	(doall (for [element frame-hash] 
rlm@0: 	  (let [coord  (key element) 
rlm@0: 		rgb   (val element)
rlm@0: 		packed-RGB 
rlm@0: 		(+ (bit-shift-left (:r rgb) 16)
rlm@0: 		   (bit-shift-left (:g rgb) 8)
rlm@0: 		                   (:b rgb))]
rlm@0: 	    (.setRGB image (first coord) (last coord) packed-RGB))))
rlm@0: 	image))
rlm@5:   
rlm@5: (defmulti  display "Creates a JFrame and displays a buffered image"  class)
rlm@0: 
rlm@5: (defn- makePanel [image] (proxy [Panel] [] (paint [g]  (.drawImage g image 0 0 nil))))
rlm@0: 
rlm@6: (defn select-row [x window]
rlm@6:   (filter-keys (comp (partial = x) first) window))
rlm@6: 
rlm@6: 
rlm@0: 
rlm@5: (defmethod display 
rlm@5:   BufferedImage  [image] 
rlm@5:   (let [panel (makePanel image)
rlm@5: 	frame (JFrame. "Oh Yeah!")]
rlm@5:     (.add frame panel) 
rlm@5:     (.pack frame) 
rlm@5:     (.setVisible frame true ) 
rlm@5:     (.setSize frame(.getWidth image) (.getHeight image))))
rlm@5:  
rlm@5: (defmethod display
rlm@5:   ImagePlus [image]
rlm@5:   (display (.getBufferedImage image)))
rlm@5: 
rlm@5: (defmethod display
rlm@5:   clojure.lang.PersistentHashMap [frame-hash]
rlm@5:   (display (frame-hash->bufferedImage frame-hash)))
rlm@5: 
rlm@5: (defmethod display
rlm@5:     clojure.lang.PersistentArrayMap [frame-hash]
rlm@5:     (display (frame-hash->bufferedImage frame-hash)))
rlm@5: 
rlm@5: 
rlm@5: 
rlm@5: 
rlm@5: 
rlm@7: ;this is a sequence of rows
rlm@7: 
rlm@7: ;(defn span [row]
rlm@7: ;  (let [sorted-row (sort #(< (first %1) (first %2)) row)]
rlm@7: ;    (vector (first sorted-row) (last sorted-row))))
rlm@7: 
rlm@7: 
rlm@7: (defn row->gcode [[x-dpi y-dpi] row]
rlm@7:   (let [[x1 y1] (first row)
rlm@7: 	[x2 y2] (last row)]
rlm@8:     (str (format "G0 X%.3f Y%.3f\n"
rlm@7: 		 (float (* x1 (/ x-dpi)))
rlm@7: 		 (float (* y1 (/ y-dpi))))
rlm@7: 	 
rlm@7: 	 (format "G1 X%.3f Y%.3f\n"
rlm@7: 		 (float (* x2 (/ x-dpi)))
rlm@7: 		 (float (* y2 (/ y-dpi)))))))
rlm@7: 
rlm@7: (defn gather-row [row]
rlm@7:   (let [base    [[(first (first row)) (first (first row))]]]
rlm@7: 					;  (println base)
rlm@7:     (reduce 
rlm@7:      (fn colapse [collection new-n]
rlm@7:        
rlm@7:        (let [collection (apply vector collection)
rlm@7: 	     prevoius (last (last collection))
rlm@7: 	     range-start (first (last collection))]
rlm@7: 					;       (println new-n)
rlm@7: 					;       (println prevoius)
rlm@7: 					;       (println range-start)
rlm@7: 	 (if (<= new-n (+ prevoius 1))
rlm@11: 	   (do ;(println "join")
rlm@7: 					;(println (butlast collection)) 
rlm@11: 	     (conj (apply vector (butlast collection))
rlm@11: 		   (vector range-start new-n)))
rlm@11: 	   (conj collection  (vector new-n new-n)))))
rlm@7:      
rlm@7:      base
rlm@11:      (map first row))))
rlm@11: 
rlm@7: 
rlm@7: 
rlm@7: 
rlm@7: (defn row->gmask [[x-dpi y-dpi] forward? row]
rlm@11: ;  (println forward?)
rlm@11:   (let [start (float (* (/ x-dpi) (first (first
rlm@11: 					  (if forward?
rlm@11: 					  (reverse row) row)))))]
rlm@7: 
rlm@11:     (let [preamble (if-not forward?
rlm@7: 		     (format "0 0 0 %.3f\n" start)
rlm@11: 		     (format "0 0 1 %.3f\n" start))
rlm@7: 	  body
rlm@11: 	  (for [[x y]
rlm@11: 		(if forward?
rlm@11: 		  (reverse (gather-row row))
rlm@11: 		  (gather-row row))]
rlm@7: 	    (let [x (float (* x (/ x-dpi)))
rlm@7: 		  y (float (* y (/ x-dpi)))]
rlm@11: 	      (if-not forward?
rlm@7: 		(str (format "0 0 1 %.3f\n" x)
rlm@7: 		     (format "0 1 1 %.3f\n" y))
rlm@7: 		
rlm@11: 		(str (format "0 0 0 %.3f\n" y)
rlm@11: 		     (format "0 1 0 %.3f\n" x)))))]
rlm@7: 
rlm@7:       (str preamble (str-join "" body)))))
rlm@7: 
rlm@7: 
rlm@7: 
rlm@7: (defn make-rows [pic]
rlm@7:   
rlm@7:   (map (partial sort #(< (first %1) (first %2)))
rlm@7:        (partition-by last
rlm@7: 		     (sort (fn [[x1 y1][x2 y2]] (> y2 y1))
rlm@7: 			   (map first (filter-vals (partial = black) pic))))))
rlm@7: 
rlm@7: 
rlm@7: 
rlm@7: (defn generate-gmask [pic]
rlm@7: 
rlm@7:   (str "1 0 0 0\n"
rlm@8:        (str-join "" (map (fn [[index row]]
rlm@11: 			   (row->gmask dpi (even? index) row))
rlm@8: 			 (indexed (make-rows pic))))))
rlm@8: 
rlm@11: 
rlm@8: ;; 1 0 0 0
rlm@8: ;; 0 0 1 2.881
rlm@8: ;; 0 0 0 2.881
rlm@8: ;; 0 1 0 2.863
rlm@8: ;; 0 0 0 2.769
rlm@8: ;; 0 1 0 2.751
rlm@8: ;; 0 0 0 2.729
rlm@8: ;; 0 1 0 2.617
rlm@8: ;; 0 0 0 2.593
rlm@8: ;; 0 1 0 2.561
rlm@8: ;; 0 0 0 2.463
rlm@8: ;; 0 1 0 2.445
rlm@8: ;; 0 0 0 2.385
rlm@8: ;; 0 1 0 2.317
rlm@8: ;; 0 0 0 2.253
rlm@8: ;; 0 1 0 2.233
rlm@8: ;; 0 0 0 2.177
rlm@8: 
rlm@7: 
rlm@7: 
rlm@7: (defn generate-gcode [pic]
rlm@8:   (str (raster-preamble)
rlm@8:        
rlm@8:        
rlm@8:        (str-join "" (map (partial row->gcode dpi) (make-rows pic)))
rlm@8:        (raster-epilogue)))
rlm@8:   
rlm@7: 
rlm@7: 
rlm@8: (defn rotate [degrees #^ImagePlus image]
rlm@8:   (.rotate (.getChannelProcessor image) degrees)
rlm@8:   image)
rlm@7: 
rlm@8: (defn map-keys [f m]
rlm@8:   (into {} (map (fn [[key val]] [(f key) val]) m)))
rlm@8: 
rlm@8: 
rlm@8: 
rlm@8: (defn invert-frame-hash [pic]
rlm@8:   (map-keys (fn [[x y]] [x (- (:height (meta pic)) y 1)]) pic ))
rlm@8: 
rlm@8: 
rlm@8: (defn generate-files [pic]
rlm@8:   (let [image (invert-frame-hash (b&w (frame-hash  (rotate 180 (ImagePlus. pic)))))]
rlm@8:     (spit "/home/r/kevin/out.ngc" (generate-gcode image))
rlm@8:     (spit "/home/r/kevin/out.gmask" (generate-gmask image))
rlm@8:     image))
rlm@8: 
rlm@11: 
rlm@11: 
rlm@11: (defn update-state []
rlm@11: (def sing "/home/r/lasercutter/graster/signer4laser2x1.png")
rlm@11: 
rlm@11: (def pic (frame-hash (let [image  (ImagePlus. sing)]
rlm@11: 		       (.rotate (.getChannelProcessor image) 180)
rlm@11: 		       image)))
rlm@11: 
rlm@11: (def pic (b&w pic)))
rlm@11: 
rlm@11: 
rlm@11: 
rlm@11: 
rlm@11: 
rlm@11: 
rlm@11: 
rlm@11: 
rlm@11: 
rlm@11: 
rlm@8: 
rlm@8: ;;;; testing
rlm@8: 
rlm@8: (defn init []
rlm@8:   (let [stuff
rlm@8:     
rlm@8:       (bound-fn []
rlm@8: 
rlm@8: 	(do 
rlm@8: 	  (println "hi everyone")
rlm@8: 	  (def img "/home/r/kevin/sing.png")
rlm@8: 	  (def pic (frame-hash (let [image  (ImagePlus. img)]
rlm@8: 				 (.rotate (.getChannelProcessor image) 180)
rlm@8: 				 image)))
rlm@8: 
rlm@8: 
rlm@8: 	  (def test-image
rlm@8: 	       (invert-frame-hash (b&w (frame-hash  (rotate 180 (ImagePlus. img))))))
rlm@8: 	  
rlm@8: 	  (defn test-gmask []
rlm@8: 	    (println (str-join "" (take 170 (generate-gmask test-image)))))
rlm@8: 
rlm@8: 	  (println "ALL variables initialized!")
rlm@8: 
rlm@8: 	  ))]
rlm@8:   (.start
rlm@8:      (Thread. stuff))))
rlm@8: 
rlm@8: 
rlm@8: 
rlm@8: (defn thread-test []
rlm@8: 
rlm@8:   (let [temp *out*]
rlm@8:     (.start
rlm@8:      (Thread.
rlm@8:       (fn []
rlm@11: 	(with-bindings  {#'*out* temp}
rlm@8: 	  (Thread/sleep 5000)
rlm@8: 	  (println "hi")))))))