Mercurial > lasercutter

annotate src/laser/rasterize.clj @ 17:962e223bab0d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
saving
author Robert McIntyre <rlm@mit.edu>
date Sun, 29 Aug 2010 23:44:55 -0400
parents 52f544d05414
children 3b255dcd6c50
rev   line source
rlm@15 1 (ns laser.rasterize
rlm@15 2 (:use [rlm
rlm@15 3 image-utils
rlm@15 4 map-utils]
rlm@15 5 [clojure.contrib
rlm@15 6 [str-utils :only [str-join re-gsub]]
rlm@15 7 [seq :only [indexed]]
rlm@16 8 [math]
rlm@16 9 [def]
rlm@16 10 ])
rlm@15 11 (:import [ij ImagePlus IJ]))
rlm@0 12
rlm@15 13 ;(import '(java.io File))
rlm@15 14 ;(import '(org.apache.commons.io FileUtils))
rlm@15 15 ;(import '(javax.imageio ImageIO) )
rlm@0 16
rlm@0 17
rlm@15 18 (set! *print-length* 20)
rlm@1 19 (def feed 120)
rlm@1 20 (def dpi [500, 500])
rlm@8 21
rlm@16 22 (def paramaters {:x-dpi 500 :y-dpi 500 :margin 0 :x-offset 0 :y-offset 0})
rlm@8 23
rlm@15 24 ;;; this process is divided into two tasks,
rlm@15 25 ;;; creating the raster g-code, which sweeps back and forth
rlm@15 26 ;;; and creating the gmask, which turns the laser on and off.
rlm@1 27
rlm@1 28
rlm@15 29 ;;; we'll be using frame-hashes, which represent picutres as
rlm@15 30 ;;; a 3D vector field over 2D space, with the vectors representing
rlm@16 31 ;;; the rgb values at that particular point.
rlm@2 32
rlm@15 33 (defn select-row
rlm@15 34 "returns a frame hash that is just a single line at the chosen y"
rlm@15 35 [y window]
rlm@16 36 (reduce
rlm@16 37 (fn [old-map number]
rlm@16 38 (let [pixel (get window [number y] nil)]
rlm@16 39 (if-not (nil? pixel)
rlm@16 40 (into old-map {[number y] pixel})
rlm@16 41 old-map)))
rlm@16 42 {}
rlm@16 43 (range (width window))))
rlm@1 44
rlm@15 45 (defn make-rows [pic]
rlm@15 46 (map (partial sort #(< (first %1) (first %2)))
rlm@15 47 (partition-by last
rlm@15 48 (sort (fn [[x1 y1][x2 y2]] (> y2 y1))
rlm@15 49 (map first (filter-vals (partial = black) pic))))))
rlm@1 50
rlm@15 51 ;;; generate rastering g-code
rlm@1 52
rlm@3 53 (defn raster-preamble []
rlm@16 54 (str-join \newline ["M63 P0\nG61" (str "F" feed) "M101" "M3 S1\n"]))
rlm@3 55
rlm@4 56 (defn raster-epilogue []
rlm@16 57 (str-join \newline ["M63 P0" "M5" "M2\n"]))
rlm@3 58
rlm@16 59 (defn raster-comment
rlm@16 60 "wrap a statement in PARENTHENSIS to make it a comment in gcode.
rlm@16 61 parenthesis themselves aren't allowed in comments.
rlm@16 62 Oh the humanity!!"
rlm@16 63 [string]
rlm@4 64 (str "(" (re-gsub #"[()]" "" string) ")"))
rlm@1 65
rlm@16 66 (defn rows
rlm@16 67 "creates a sequence of one dimensional vector fields which
rlm@16 68 represent the rows of a picture"
rlm@16 69 [pic]
rlm@16 70 (let [non-empty-rows (apply sorted-set (map (comp last first) pic))]
rlm@16 71 (pmap (fn [n] (select-row n pic)) non-empty-rows)))
rlm@16 72
rlm@16 73
rlm@5 74
rlm@7 75
rlm@7 76
rlm@16 77 (defn row->gcode [{:keys [x-dpi y-dpi margin x-offset y-offset]} row]
rlm@16 78 (let [pixels (keys row)
rlm@16 79 x2 0
rlm@16 80 [_ y2] (first pixels)
rlm@16 81 [_ y1] (first pixels)
rlm@16 82 x1 533]
rlm@7 83
rlm@16 84 ;(let [ordered-row
rlm@16 85 ; (sort-map-by (fn [[x1 _] [x2 _]] (> x2 x1)) row)]
rlm@16 86
rlm@16 87 (let [;[x1 y1] (last (keys ordered-row))
rlm@16 88 ;[x2 y2] (first (keys ordered-row))
rlm@16 89 [x1 y1 x2 y2] (if (odd? y1) [x2 y2 x1 y1] [x1 y1 x2 y2])]
rlm@16 90
rlm@16 91 (str (format "G0 X%.3f Y%.3f\n"
rlm@16 92 (float (* x1 (/ x-dpi)))
rlm@16 93 (float (* y1 (/ y-dpi))))
rlm@16 94
rlm@16 95 (format "G1 X%.3f Y%.3f\n"
rlm@16 96 (float (* x2 (/ x-dpi)))
rlm@16 97 (float (* y2 (/ y-dpi))))))))
rlm@14 98
rlm@16 99
rlm@16 100 (defn pic->gcode [paramaters pic]
rlm@16 101 (reduce (fn [gcode current-height]
rlm@16 102 (let [current-row (select-row current-height pic)]
rlm@16 103 (if-not (empty? current-row)
rlm@16 104 (let [new-code (row->gcode paramaters current-row)]
rlm@16 105 (println new-code)
rlm@16 106 (str gcode new-code))
rlm@16 107 gcode)))
rlm@16 108 ""
rlm@16 109 (range (height pic))))
rlm@16 110
rlm@16 111
rlm@17 112
rlm@17 113
rlm@17 114 (defn pic->gcode
rlm@17 115
rlm@17 116
rlm@17 117
rlm@16 118 ;(defn pic->gcode [paramaters pic]
rlm@14 119
rlm@15 120
rlm@15 121 (defn generate-gcode [pic]
rlm@15 122 (str (raster-preamble)
rlm@16 123 (row->gcode paramaters pic)
rlm@16 124 (raster-epilogue)))
rlm@15 125
rlm@15 126
rlm@15 127
rlm@15 128
rlm@15 129
rlm@15 130
rlm@15 131
rlm@15 132
rlm@15 133
rlm@15 134
rlm@15 135
rlm@15 136
rlm@15 137
rlm@15 138
rlm@15 139
rlm@15 140
rlm@15 141
rlm@15 142
rlm@15 143
rlm@7 144 (defn gather-row [row]
rlm@7 145 (let [base [[(first (first row)) (first (first row))]]]
rlm@7 146 ; (println base)
rlm@7 147 (reduce
rlm@7 148 (fn colapse [collection new-n]
rlm@7 149
rlm@7 150 (let [collection (apply vector collection)
rlm@7 151 prevoius (last (last collection))
rlm@7 152 range-start (first (last collection))]
rlm@7 153 ; (println new-n)
rlm@7 154 ; (println prevoius)
rlm@7 155 ; (println range-start)
rlm@7 156 (if (<= new-n (+ prevoius 1))
rlm@11 157 (do ;(println "join")
rlm@7 158 ;(println (butlast collection))
rlm@11 159 (conj (apply vector (butlast collection))
rlm@11 160 (vector range-start new-n)))
rlm@11 161 (conj collection (vector new-n new-n)))))
rlm@7 162
rlm@7 163 base
rlm@11 164 (map first row))))
rlm@11 165
rlm@7 166
rlm@7 167
rlm@7 168
rlm@7 169 (defn row->gmask [[x-dpi y-dpi] forward? row]
rlm@11 170 (let [start (float (* (/ x-dpi) (first (first
rlm@11 171 (if forward?
rlm@11 172 (reverse row) row)))))]
rlm@11 173 (let [preamble (if-not forward?
rlm@7 174 (format "0 0 0 %.3f\n" start)
rlm@11 175 (format "0 0 1 %.3f\n" start))
rlm@7 176 body
rlm@11 177 (for [[x y]
rlm@11 178 (if forward?
rlm@11 179 (reverse (gather-row row))
rlm@11 180 (gather-row row))]
rlm@7 181 (let [x (float (* x (/ x-dpi)))
rlm@15 182 y (float (* y (/ x-dpi)))]
rlm@14 183 ;; x (+ x 0.159)];; shift by a small margin.
rlm@11 184 (if-not forward?
rlm@7 185 (str (format "0 0 1 %.3f\n" x)
rlm@7 186 (format "0 1 1 %.3f\n" y))
rlm@7 187
rlm@11 188 (str (format "0 0 0 %.3f\n" y)
rlm@11 189 (format "0 1 0 %.3f\n" x)))))]
rlm@7 190
rlm@7 191 (str preamble (str-join "" body)))))
rlm@7 192
rlm@7 193
rlm@7 194 (defn generate-gmask [pic]
rlm@7 195 (str "1 0 0 0\n"
rlm@8 196 (str-join "" (map (fn [[index row]]
rlm@11 197 (row->gmask dpi (even? index) row))
rlm@8 198 (indexed (make-rows pic))))))
rlm@8 199
rlm@11 200
rlm@11 201
rlm@8 202
rlm@8 203 ;;;; testing
rlm@8 204
rlm@15 205 (defn generate-files [pic]
rlm@15 206 (println "made-image")
rlm@15 207 (spit "/home/r/kevin/out.ngc" (generate-gcode pic))
rlm@15 208 (println "/home/r/kevin/out.ngc")
rlm@15 209 (spit "/home/r/kevin/out.gmask" (generate-gmask pic))
rlm@15 210 (println "/home/r/kevin/out.gmask")
rlm@15 211 pic)
rlm@8 212
rlm@15 213 (defn update-state []
rlm@15 214 (def sing "/home/r/kevin/sing.png")
rlm@15 215 (def pic (frame-hash (ImagePlus. sing)))
rlm@16 216 (def pic (b&w pic))
rlm@16 217 (def pic (filter-vals (partial = black) pic)))
rlm@8 218
rlm@16 219 (defn compare-gen-fn
rlm@16 220 ([n f cmp]
rlm@15 221 (let [theirs (re-split #"\n" (slurp cmp))
rlm@15 222 ours (re-split #"\n" (f pic))]
rlm@15 223 (println (format "%1$-25s%2$s" "OURS" "THEIRS"))
rlm@15 224 (println "_______________________________________")
rlm@15 225 (dorun (map (fn [[us them]] (println
rlm@15 226 (format "%1$-25s%2$s" us them)))
rlm@16 227 (take n (partition 2 (interleave ours theirs))))))))
rlm@8 228
rlm@16 229 (defn compare-gcode
rlm@16 230 ([] (compare-gcode 25))
rlm@16 231 ([n] (compare-gen-fn n generate-gcode "/home/r/kevin/reference.ngc")))
rlm@16 232
rlm@16 233 (defn compare-gmask
rlm@16 234 ([] compare-gmask 25)
rlm@16 235 ([n] (compare-gen-fn n generate-gmask "/home/r/kevin/reference.gmask")))
rlm@15 236
rlm@8 237
rlm@8 238
rlm@8 239
rlm@8 240