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@0: (use 'clojure.contrib.str-utils)
rlm@0: 
rlm@0: (use 'clojure.contrib.combinatorics)
rlm@0: 
rlm@0: 
rlm@0: (use 'clojure.contrib.repl-utils)
rlm@0: 
rlm@0: (set! *print-length* 20)
rlm@0: 
rlm@0: 
rlm@0: (def img "/home/r/graster/test.png")
rlm@0: 
rlm@1: 
rlm@1: (def feed 120)
rlm@1: (def  dpi [500, 500])
rlm@1: (def on_range [0.0, 0.5])
rlm@1: (def overshoot 0.5)
rlm@1: (def offset [1.0, 1.0])
rlm@1: (def tiles [1, 1])
rlm@1: (def tile_size [false, false])
rlm@1: (def tile_spacing [0.125, 0.125])
rlm@1: (def feed 120)
rlm@1: (def cut_feed 20)
rlm@1: (def corner_radius 0)
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@1: 
rlm@1: 
rlm@0: (defn frame-hash
rlm@0:   "yields a convienent representation for the pixles in an image.
rlm@0:    Because of the size of the structvre generated, this must only be used
rlm@0:    in a transient way so that java can do it's garbage collection."
rlm@0:   [#^java.lang.String image-name]
rlm@0:   (let [image+ (ImagePlus. image-name)]
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@0:       {:width  (.getWidth image+) :height (.getHeight image+)})))
rlm@0: 
rlm@0: 
rlm@5: 
rlm@5: 
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@1: (def expt #(Math/pow %1 %2))
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@3: 	    "M3 S1"]))
rlm@3: 
rlm@4: (defn raster-epilogue []
rlm@4:   (str-join \newline
rlm@4: 	    ["M63 PO"
rlm@4: 	     "M5"
rlm@4: 	     "M2"]))
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@7:     (str (format "GO 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@7: 		     (do ;(println "join")
rlm@7: 					;(println (butlast collection)) 
rlm@7: 		       (conj (apply vector (butlast collection))  (vector range-start new-n)))
rlm@7: 		     (conj collection  (vector new-n new-n)))))
rlm@7:      
rlm@7:      base
rlm@7: 	       (map first row))))
rlm@7: 
rlm@7: 
rlm@7: 
rlm@7: (defn row->gmask [[x-dpi y-dpi] forward? row]
rlm@7: 
rlm@7:   (let [start (float (* (/ x-dpi) (first (first row))))]
rlm@7: 
rlm@7:     (let [preamble (if forward?
rlm@7: 		     (str 
rlm@7: 		     (format "0 0 0 %.3f\n" start)
rlm@7: 		     (format "0 0 1 %.3f\n" start)))
rlm@7: 	  body
rlm@7: 	  (for [[x y] (gather-row row)]
rlm@7: 	    (let [x (float (* x (/ x-dpi)))
rlm@7: 		  y (float (* y (/ x-dpi)))]
rlm@7: 	      (if forward?
rlm@7: 		(str (format "0 0 1 %.3f\n" x)
rlm@7: 		     (format "0 1 1 %.3f\n" y))
rlm@7: 		
rlm@7: 		(str (format "0 0 0 %.3f\n" x)
rlm@7: 		     (format "0 1 0 %.3f\n" y)))))]
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: 
rlm@7: ;sequence of numbers indicating width
rlm@7: (def mega 
rlm@7:  
rlm@7:      ;sequence of rows
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: 
rlm@7: (defn generate-gmask [pic]
rlm@7: 
rlm@7:   (str "1 0 0 0\n"
rlm@7:        (str-join "" (map (fn [[index row]]  (row->gmask dpi (even? index) row)) (indexed (make-rows pic))))))
rlm@7: 
rlm@7: 
rlm@7: (defn generate-gcode [pic]
rlm@7:   (str-join "" (map (partial row->gcode dpi) (make-rows pic))))
rlm@7: 
rlm@7: 
rlm@7: