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