Mercurial > lasercutter

annotate src/laser/rasterize.clj @ 19:3b255dcd6c50

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