rlm@15: (ns laser.rasterize
rlm@15:   (:use [rlm
rlm@15: 	 image-utils
rlm@15: 	 map-utils]
rlm@15: 	[clojure.contrib
rlm@19: 	 [str-utils :only [str-join re-gsub re-split]]
rlm@15: 	 [seq :only [indexed]]
rlm@19: 	 [math]])
rlm@15:   (:import [ij ImagePlus IJ]))
rlm@0: 
rlm@15: ;(import '(java.io File))
rlm@15: ;(import '(org.apache.commons.io FileUtils))
rlm@15: ;(import '(javax.imageio ImageIO) )
rlm@0: 
rlm@0: 
rlm@15: (set! *print-length* 20)
rlm@1: (def feed 120)
rlm@1: (def  dpi [500, 500])
rlm@19: (def paramaters {:x-dpi 500 :y-dpi 500 :margin 0 :x-offset 1 :y-offset 1})
rlm@8: 
rlm@15: ;;; this process is divided into two tasks,
rlm@15: ;;; creating the raster g-code, which sweeps back and forth
rlm@15: ;;; and creating the gmask, which turns the laser on and off.
rlm@1: 
rlm@1: 
rlm@15: ;;; we'll be using frame-hashes, which represent picutres as
rlm@15: ;;; a 3D vector field over 2D space, with the vectors representing
rlm@19: ;;; the rgb values at that particulat point. 
rlm@2: 
rlm@15: (defn select-row
rlm@15:   "returns a frame hash that is just a single line at the chosen y"
rlm@15:   [y window]
rlm@19:   (filter-keys (comp (partial = y) last) window))
rlm@1: 
rlm@15: (defn make-rows [pic]
rlm@15:   (map (partial sort #(< (first %1) (first %2)))
rlm@15:        (partition-by last
rlm@15: 		     (sort (fn [[x1 y1][x2 y2]] (> y2 y1))
rlm@15: 			   (map first (filter-vals (partial = black) pic))))))
rlm@1: 
rlm@19: 
rlm@15: ;;; generate rastering g-code
rlm@1: 
rlm@3: (defn raster-preamble []
rlm@19:   (str-join \newline
rlm@19: 	    ["M63 P0\nG61"
rlm@19: 	    (str "F" feed)
rlm@19: 	    "M101"
rlm@19: 	    "M3 S1\n"]))
rlm@3: 
rlm@4: (defn raster-epilogue []
rlm@19:   (str-join \newline
rlm@19: 	    ["M63 P0"
rlm@19: 	     "M5"
rlm@19: 	     "M2\n"]))
rlm@3: 
rlm@19: (defn raster-comment [string]
rlm@4:   (str "(" (re-gsub #"[()]" "" string) ")"))
rlm@1: 
rlm@19: 
rlm@19: ;this is a sequence of rows
rlm@19: 
rlm@19: ;(defn span [row]
rlm@19: ;  (let [sorted-row (sort #(< (first %1) (first %2)) row)]
rlm@19: ;    (vector (first sorted-row) (last sorted-row))))
rlm@19: 
rlm@19: 
rlm@19: 
rlm@19: (defn row->gcode [{:keys [x-dpi y-dpi margin x-offset y-offset]} forward? row]
rlm@16:   
rlm@19:   (let [[x1 y1] (if forward? (last row) (first row))
rlm@19: 	[x2 y2] (if forward? (first row) (last row))]
rlm@5: 
rlm@19:     (let [x1 (* x1 (/ x-dpi))
rlm@19: 	  x2 (* x2 (/ x-dpi))
rlm@19: 	  y1 (* y1 (/ y-dpi))
rlm@19: 	  y2  (* y2(/ y-dpi))]
rlm@7: 
rlm@19:     (let [x1 (+ x1 x-offset)
rlm@19: 	  x2 (+ x2 x-offset)
rlm@19: 	  y1 (+ y1 y-offset)
rlm@19: 	  y2 (+ y2 y-offset)]
rlm@19: 	  
rlm@19:           
rlm@16:       (str (format "G0 X%.3f Y%.3f\n"
rlm@19: 		   (float x1 )
rlm@19: 		   (float  y1))
rlm@16: 	   
rlm@16: 	   (format "G1 X%.3f Y%.3f\n"
rlm@19: 		   (float x2)
rlm@19: 		   (float y2)))))))
rlm@14:   
rlm@15: (defn generate-gcode [pic]
rlm@15:   (str (raster-preamble)
rlm@19:        (str-join ""
rlm@19: 		 (map
rlm@19: 		  (fn [[index row]]
rlm@19: 		    (row->gcode paramaters (even? index) row))
rlm@19: 		    (indexed (make-rows pic))))
rlm@19: 		 (raster-epilogue)))
rlm@15: 
rlm@15: 
rlm@15: 
rlm@15: 
rlm@15: 
rlm@15: 
rlm@15: 
rlm@15: 
rlm@15: 
rlm@15: 
rlm@15: 
rlm@15: 
rlm@15: 
rlm@15: 
rlm@15: 
rlm@15: 
rlm@15: 
rlm@15: 
rlm@15: 
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:   (let [start (float (* (/ x-dpi) (first (first
rlm@11: 					  (if forward?
rlm@11: 					  (reverse row) row)))))]
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@15: 		  y (float (* y (/ x-dpi)))]
rlm@14: ;;		  x (+ x 0.159)];; shift by a small margin.
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: (defn generate-gmask [pic]
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@11: 
rlm@8: 
rlm@8: ;;;; testing
rlm@8: 
rlm@15: (defn generate-files [pic]
rlm@15:     (println "made-image")
rlm@15:     (spit "/home/r/kevin/out.ngc" (generate-gcode pic))
rlm@15:     (println "/home/r/kevin/out.ngc")
rlm@15:     (spit "/home/r/kevin/out.gmask" (generate-gmask pic))
rlm@15:     (println "/home/r/kevin/out.gmask")
rlm@15:     pic)
rlm@8: 
rlm@15: (defn update-state []
rlm@15:   (def sing "/home/r/kevin/sing.png")
rlm@19:   (def pic (frame-hash (rotate 180 (ImagePlus. sing))))  
rlm@19:   (def pic (b&w pic)))
rlm@8: 
rlm@19: (defn compare-gen-fn [n f cmp]
rlm@15:   (let [theirs (re-split #"\n" (slurp cmp))
rlm@15: 	ours   (re-split #"\n" (f pic))]
rlm@15:     (println (format "%1$-25s%2$s" "OURS" "THEIRS"))
rlm@15:     (println "_______________________________________")
rlm@15:     (dorun (map (fn [[us them]] (println
rlm@15: 			     (format "%1$-25s%2$s" us them)))
rlm@19: 			     (take n (partition 2 (interleave  ours theirs)))))))
rlm@8: 
rlm@19: (defn compare-gcode [n]
rlm@19:   (compare-gen-fn n generate-gcode "/home/r/kevin/reference.ngc"))
rlm@19: (defn compare-gmask [n]
rlm@19:   (compare-gen-fn n generate-gmask "/home/r/kevin/reference.gmask"))
rlm@15:   
rlm@8: 
rlm@8: 
rlm@8: 
rlm@8: