rlm@0
|
1 (ns laser.rasterize)
|
rlm@0
|
2
|
rlm@0
|
3 (import '(java.io File))
|
rlm@0
|
4 (import '(org.apache.commons.io FileUtils))
|
rlm@0
|
5 (import '(javax.imageio ImageIO) )
|
rlm@0
|
6 (import '(javax.swing JFrame))
|
rlm@0
|
7 (import '(java.awt Color BorderLayout))
|
rlm@0
|
8 (import '(ij ImagePlus IJ))
|
rlm@0
|
9 (import '(java.lang Math))
|
rlm@2
|
10 (import '(java.awt Graphics2D Panel))
|
rlm@0
|
11 (import '(ij Macro))
|
rlm@0
|
12
|
rlm@0
|
13 (import '(java.io BufferedReader InputStreamReader))
|
rlm@0
|
14 (import '(java.awt.image BufferedImage))
|
rlm@0
|
15
|
rlm@11
|
16 ;(use 'clojure.contrib.str-utils)
|
rlm@11
|
17 ;(use 'clojure.contrib.seq-utils)
|
rlm@11
|
18 ;(use 'clojure.contrib.combinatorics)
|
rlm@11
|
19 ;(use 'clojure.contrib.duck-streams)
|
rlm@0
|
20
|
rlm@11
|
21 ;(use 'clojure.contrib.repl-utils)
|
rlm@0
|
22
|
rlm@11
|
23 ;(set! *print-length* 20)
|
rlm@0
|
24
|
rlm@0
|
25
|
rlm@0
|
26
|
rlm@1
|
27
|
rlm@1
|
28 (def feed 120)
|
rlm@1
|
29 (def dpi [500, 500])
|
rlm@8
|
30
|
rlm@8
|
31
|
rlm@1
|
32
|
rlm@1
|
33
|
rlm@5
|
34 (defn preserve-meta [f]
|
rlm@5
|
35 (fn [& x] (with-meta
|
rlm@5
|
36 (apply f x)
|
rlm@5
|
37 (meta (last x)))))
|
rlm@2
|
38
|
rlm@8
|
39 (defmulti frame-hash-multi class)
|
rlm@1
|
40
|
rlm@1
|
41
|
rlm@8
|
42 (defmethod frame-hash-multi ImagePlus
|
rlm@8
|
43 [image+]
|
rlm@0
|
44 (with-meta
|
rlm@0
|
45 (let [buf (.. image+ getBufferedImage)
|
rlm@0
|
46 color (.getColorModel buf)]
|
rlm@0
|
47 (apply hash-map
|
rlm@0
|
48 (interleave
|
rlm@0
|
49 (doall (for [x (range (.getWidth image+)) y (range (.getHeight image+))]
|
rlm@0
|
50 (vector x y)))
|
rlm@0
|
51 (doall (for [x (range (.getWidth image+)) y (range (.getHeight image+))]
|
rlm@0
|
52 (let [data (.getRGB buf x y)]
|
rlm@0
|
53 (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
|
rlm@0
|
54 :g (bit-shift-right (bit-and 0x00ff00 data) 8)
|
rlm@0
|
55 :b (bit-and 0x0000ff data))))))))
|
rlm@8
|
56 {:width (.getWidth image+) :height (.getHeight image+)}))
|
rlm@0
|
57
|
rlm@0
|
58
|
rlm@8
|
59 (defmethod frame-hash-multi String
|
rlm@8
|
60 [image-name]
|
rlm@8
|
61 (let [image+ (ImagePlus. image-name)]
|
rlm@8
|
62 (frame-hash-multi image+)))
|
rlm@5
|
63
|
rlm@5
|
64
|
rlm@8
|
65 (defn frame-hash
|
rlm@8
|
66 "yields a convienent representation for the pixles in an image.
|
rlm@8
|
67 Because of the size of the structvre generated, this must only be used
|
rlm@8
|
68 in a transient way so that java can do it's garbage collection."
|
rlm@8
|
69 [something]
|
rlm@8
|
70 (frame-hash-multi something))
|
rlm@8
|
71
|
rlm@8
|
72 ;(def frame-hash (preserve-meta frame-hash))
|
rlm@8
|
73
|
rlm@5
|
74
|
rlm@5
|
75
|
rlm@5
|
76
|
rlm@1
|
77 (def white {:r 255, :g 255, :b 255})
|
rlm@1
|
78 (def black {:r 0, :g 0, :b 0})
|
rlm@1
|
79
|
rlm@11
|
80
|
rlm@1
|
81
|
rlm@1
|
82 (defn rgb-euclidian
|
rlm@1
|
83 [{r1 :r g1 :g b1 :b} {r2 :r g2 :g b2 :b} ]
|
rlm@1
|
84 (expt (+ (expt (- r1 r2) 2)
|
rlm@1
|
85 (expt (- g1 g2) 2)
|
rlm@1
|
86 (expt (- b1 b2) 2)) 0.5))
|
rlm@1
|
87
|
rlm@1
|
88 (defn b&w
|
rlm@1
|
89 "turn everything strictly black or white"
|
rlm@1
|
90 [window]
|
rlm@1
|
91 (with-meta
|
rlm@1
|
92 (zipmap
|
rlm@1
|
93 (keys window)
|
rlm@1
|
94 (map (fn [rgb]
|
rlm@1
|
95 (if (> (rgb-euclidian rgb white) (rgb-euclidian rgb black))
|
rlm@1
|
96 black white))
|
rlm@1
|
97 (vals window))) (meta window)))
|
rlm@1
|
98
|
rlm@1
|
99
|
rlm@1
|
100
|
rlm@3
|
101 (defn raster-preamble []
|
rlm@3
|
102 (str-join \newline
|
rlm@3
|
103 ["M63 P0\nG61"
|
rlm@3
|
104 (str \F feed)
|
rlm@3
|
105 "M101"
|
rlm@8
|
106 "M3 S1\n"]))
|
rlm@3
|
107
|
rlm@4
|
108 (defn raster-epilogue []
|
rlm@4
|
109 (str-join \newline
|
rlm@8
|
110 ["M63 P0"
|
rlm@4
|
111 "M5"
|
rlm@8
|
112 "M2\n"]))
|
rlm@3
|
113
|
rlm@1
|
114
|
rlm@4
|
115 (defn raster-comment [string]
|
rlm@4
|
116 (str "(" (re-gsub #"[()]" "" string) ")"))
|
rlm@1
|
117
|
rlm@4
|
118 (defn filter-keys [fun m]
|
rlm@4
|
119 (select-keys m (filter fun (keys m))))
|
rlm@6
|
120
|
rlm@5
|
121 (def filter-keys (preserve-meta filter-keys))
|
rlm@2
|
122
|
rlm@4
|
123 (defn filter-vals [fun m]
|
rlm@5
|
124 (into {} (filter (comp fun val) m)))
|
rlm@6
|
125
|
rlm@5
|
126 (def filter-vals (preserve-meta filter-vals))
|
rlm@1
|
127
|
rlm@0
|
128 (defn frame-hash->bufferedImage
|
rlm@0
|
129 [frame-hash]
|
rlm@0
|
130 (let [data (meta frame-hash)
|
rlm@0
|
131 image (BufferedImage. (:width data) (:height data) BufferedImage/TYPE_INT_BGR)]
|
rlm@0
|
132
|
rlm@0
|
133 (doall (for [element frame-hash]
|
rlm@0
|
134 (let [coord (key element)
|
rlm@0
|
135 rgb (val element)
|
rlm@0
|
136 packed-RGB
|
rlm@0
|
137 (+ (bit-shift-left (:r rgb) 16)
|
rlm@0
|
138 (bit-shift-left (:g rgb) 8)
|
rlm@0
|
139 (:b rgb))]
|
rlm@0
|
140 (.setRGB image (first coord) (last coord) packed-RGB))))
|
rlm@0
|
141 image))
|
rlm@5
|
142
|
rlm@5
|
143 (defmulti display "Creates a JFrame and displays a buffered image" class)
|
rlm@0
|
144
|
rlm@5
|
145 (defn- makePanel [image] (proxy [Panel] [] (paint [g] (.drawImage g image 0 0 nil))))
|
rlm@0
|
146
|
rlm@6
|
147 (defn select-row [x window]
|
rlm@6
|
148 (filter-keys (comp (partial = x) first) window))
|
rlm@6
|
149
|
rlm@6
|
150
|
rlm@0
|
151
|
rlm@5
|
152 (defmethod display
|
rlm@5
|
153 BufferedImage [image]
|
rlm@5
|
154 (let [panel (makePanel image)
|
rlm@5
|
155 frame (JFrame. "Oh Yeah!")]
|
rlm@5
|
156 (.add frame panel)
|
rlm@5
|
157 (.pack frame)
|
rlm@5
|
158 (.setVisible frame true )
|
rlm@5
|
159 (.setSize frame(.getWidth image) (.getHeight image))))
|
rlm@5
|
160
|
rlm@5
|
161 (defmethod display
|
rlm@5
|
162 ImagePlus [image]
|
rlm@5
|
163 (display (.getBufferedImage image)))
|
rlm@5
|
164
|
rlm@5
|
165 (defmethod display
|
rlm@5
|
166 clojure.lang.PersistentHashMap [frame-hash]
|
rlm@5
|
167 (display (frame-hash->bufferedImage frame-hash)))
|
rlm@5
|
168
|
rlm@5
|
169 (defmethod display
|
rlm@5
|
170 clojure.lang.PersistentArrayMap [frame-hash]
|
rlm@5
|
171 (display (frame-hash->bufferedImage frame-hash)))
|
rlm@5
|
172
|
rlm@5
|
173
|
rlm@5
|
174
|
rlm@5
|
175
|
rlm@5
|
176
|
rlm@7
|
177 ;this is a sequence of rows
|
rlm@7
|
178
|
rlm@7
|
179 ;(defn span [row]
|
rlm@7
|
180 ; (let [sorted-row (sort #(< (first %1) (first %2)) row)]
|
rlm@7
|
181 ; (vector (first sorted-row) (last sorted-row))))
|
rlm@7
|
182
|
rlm@7
|
183
|
rlm@7
|
184 (defn row->gcode [[x-dpi y-dpi] row]
|
rlm@7
|
185 (let [[x1 y1] (first row)
|
rlm@13
|
186 [x2 y2] (last row)
|
rlm@13
|
187 x2 (+ x2 (* x-dpi 0.318))]
|
rlm@13
|
188
|
rlm@13
|
189
|
rlm@13
|
190 ; (println x2)
|
rlm@8
|
191 (str (format "G0 X%.3f Y%.3f\n"
|
rlm@7
|
192 (float (* x1 (/ x-dpi)))
|
rlm@7
|
193 (float (* y1 (/ y-dpi))))
|
rlm@7
|
194
|
rlm@7
|
195 (format "G1 X%.3f Y%.3f\n"
|
rlm@7
|
196 (float (* x2 (/ x-dpi)))
|
rlm@7
|
197 (float (* y2 (/ y-dpi)))))))
|
rlm@7
|
198
|
rlm@7
|
199 (defn gather-row [row]
|
rlm@7
|
200 (let [base [[(first (first row)) (first (first row))]]]
|
rlm@7
|
201 ; (println base)
|
rlm@7
|
202 (reduce
|
rlm@7
|
203 (fn colapse [collection new-n]
|
rlm@7
|
204
|
rlm@7
|
205 (let [collection (apply vector collection)
|
rlm@7
|
206 prevoius (last (last collection))
|
rlm@7
|
207 range-start (first (last collection))]
|
rlm@7
|
208 ; (println new-n)
|
rlm@7
|
209 ; (println prevoius)
|
rlm@7
|
210 ; (println range-start)
|
rlm@7
|
211 (if (<= new-n (+ prevoius 1))
|
rlm@11
|
212 (do ;(println "join")
|
rlm@7
|
213 ;(println (butlast collection))
|
rlm@11
|
214 (conj (apply vector (butlast collection))
|
rlm@11
|
215 (vector range-start new-n)))
|
rlm@11
|
216 (conj collection (vector new-n new-n)))))
|
rlm@7
|
217
|
rlm@7
|
218 base
|
rlm@11
|
219 (map first row))))
|
rlm@11
|
220
|
rlm@7
|
221
|
rlm@7
|
222
|
rlm@7
|
223
|
rlm@7
|
224 (defn row->gmask [[x-dpi y-dpi] forward? row]
|
rlm@11
|
225 ; (println forward?)
|
rlm@11
|
226 (let [start (float (* (/ x-dpi) (first (first
|
rlm@11
|
227 (if forward?
|
rlm@11
|
228 (reverse row) row)))))]
|
rlm@7
|
229
|
rlm@11
|
230 (let [preamble (if-not forward?
|
rlm@7
|
231 (format "0 0 0 %.3f\n" start)
|
rlm@11
|
232 (format "0 0 1 %.3f\n" start))
|
rlm@7
|
233 body
|
rlm@11
|
234 (for [[x y]
|
rlm@11
|
235 (if forward?
|
rlm@11
|
236 (reverse (gather-row row))
|
rlm@11
|
237 (gather-row row))]
|
rlm@7
|
238 (let [x (float (* x (/ x-dpi)))
|
rlm@13
|
239 y (float (* y (/ x-dpi)))
|
rlm@13
|
240 x (+ x 0.159)];; shift by a small margin.
|
rlm@11
|
241 (if-not forward?
|
rlm@7
|
242 (str (format "0 0 1 %.3f\n" x)
|
rlm@7
|
243 (format "0 1 1 %.3f\n" y))
|
rlm@7
|
244
|
rlm@11
|
245 (str (format "0 0 0 %.3f\n" y)
|
rlm@11
|
246 (format "0 1 0 %.3f\n" x)))))]
|
rlm@7
|
247
|
rlm@7
|
248 (str preamble (str-join "" body)))))
|
rlm@7
|
249
|
rlm@7
|
250
|
rlm@7
|
251
|
rlm@7
|
252 (defn make-rows [pic]
|
rlm@7
|
253 (map (partial sort #(< (first %1) (first %2)))
|
rlm@7
|
254 (partition-by last
|
rlm@7
|
255 (sort (fn [[x1 y1][x2 y2]] (> y2 y1))
|
rlm@7
|
256 (map first (filter-vals (partial = black) pic))))))
|
rlm@7
|
257
|
rlm@7
|
258
|
rlm@7
|
259
|
rlm@7
|
260 (defn generate-gmask [pic]
|
rlm@7
|
261
|
rlm@7
|
262 (str "1 0 0 0\n"
|
rlm@8
|
263 (str-join "" (map (fn [[index row]]
|
rlm@11
|
264 (row->gmask dpi (even? index) row))
|
rlm@8
|
265 (indexed (make-rows pic))))))
|
rlm@8
|
266
|
rlm@11
|
267
|
rlm@8
|
268 ;; 1 0 0 0
|
rlm@8
|
269 ;; 0 0 1 2.881
|
rlm@8
|
270 ;; 0 0 0 2.881
|
rlm@8
|
271 ;; 0 1 0 2.863
|
rlm@8
|
272 ;; 0 0 0 2.769
|
rlm@8
|
273 ;; 0 1 0 2.751
|
rlm@8
|
274 ;; 0 0 0 2.729
|
rlm@8
|
275 ;; 0 1 0 2.617
|
rlm@8
|
276 ;; 0 0 0 2.593
|
rlm@8
|
277 ;; 0 1 0 2.561
|
rlm@8
|
278 ;; 0 0 0 2.463
|
rlm@8
|
279 ;; 0 1 0 2.445
|
rlm@8
|
280 ;; 0 0 0 2.385
|
rlm@8
|
281 ;; 0 1 0 2.317
|
rlm@8
|
282 ;; 0 0 0 2.253
|
rlm@8
|
283 ;; 0 1 0 2.233
|
rlm@8
|
284 ;; 0 0 0 2.177
|
rlm@8
|
285
|
rlm@7
|
286
|
rlm@7
|
287
|
rlm@7
|
288 (defn generate-gcode [pic]
|
rlm@8
|
289 (str (raster-preamble)
|
rlm@8
|
290
|
rlm@8
|
291
|
rlm@8
|
292 (str-join "" (map (partial row->gcode dpi) (make-rows pic)))
|
rlm@8
|
293 (raster-epilogue)))
|
rlm@8
|
294
|
rlm@7
|
295
|
rlm@7
|
296
|
rlm@8
|
297 (defn rotate [degrees #^ImagePlus image]
|
rlm@8
|
298 (.rotate (.getChannelProcessor image) degrees)
|
rlm@8
|
299 image)
|
rlm@7
|
300
|
rlm@8
|
301 (defn map-keys [f m]
|
rlm@8
|
302 (into {} (map (fn [[key val]] [(f key) val]) m)))
|
rlm@8
|
303
|
rlm@8
|
304
|
rlm@8
|
305
|
rlm@8
|
306 (defn invert-frame-hash [pic]
|
rlm@8
|
307 (map-keys (fn [[x y]] [x (- (:height (meta pic)) y 1)]) pic ))
|
rlm@8
|
308
|
rlm@8
|
309
|
rlm@8
|
310 (defn generate-files [pic]
|
rlm@8
|
311 (let [image (invert-frame-hash (b&w (frame-hash (rotate 180 (ImagePlus. pic)))))]
|
rlm@8
|
312 (spit "/home/r/kevin/out.ngc" (generate-gcode image))
|
rlm@8
|
313 (spit "/home/r/kevin/out.gmask" (generate-gmask image))
|
rlm@8
|
314 image))
|
rlm@8
|
315
|
rlm@11
|
316
|
rlm@11
|
317
|
rlm@11
|
318 (defn update-state []
|
rlm@11
|
319 (def sing "/home/r/lasercutter/graster/signer4laser2x1.png")
|
rlm@11
|
320
|
rlm@11
|
321 (def pic (frame-hash (let [image (ImagePlus. sing)]
|
rlm@11
|
322 (.rotate (.getChannelProcessor image) 180)
|
rlm@11
|
323 image)))
|
rlm@11
|
324
|
rlm@11
|
325 (def pic (b&w pic)))
|
rlm@11
|
326
|
rlm@11
|
327
|
rlm@11
|
328
|
rlm@11
|
329
|
rlm@11
|
330
|
rlm@11
|
331
|
rlm@11
|
332
|
rlm@11
|
333
|
rlm@11
|
334
|
rlm@11
|
335
|
rlm@8
|
336
|
rlm@8
|
337 ;;;; testing
|
rlm@8
|
338
|
rlm@8
|
339 (defn init []
|
rlm@8
|
340 (let [stuff
|
rlm@8
|
341
|
rlm@8
|
342 (bound-fn []
|
rlm@8
|
343
|
rlm@8
|
344 (do
|
rlm@8
|
345 (println "hi everyone")
|
rlm@8
|
346 (def img "/home/r/kevin/sing.png")
|
rlm@8
|
347 (def pic (frame-hash (let [image (ImagePlus. img)]
|
rlm@8
|
348 (.rotate (.getChannelProcessor image) 180)
|
rlm@8
|
349 image)))
|
rlm@8
|
350
|
rlm@8
|
351
|
rlm@8
|
352 (def test-image
|
rlm@8
|
353 (invert-frame-hash (b&w (frame-hash (rotate 180 (ImagePlus. img))))))
|
rlm@8
|
354
|
rlm@8
|
355 (defn test-gmask []
|
rlm@8
|
356 (println (str-join "" (take 170 (generate-gmask test-image)))))
|
rlm@8
|
357
|
rlm@8
|
358 (println "ALL variables initialized!")
|
rlm@8
|
359
|
rlm@8
|
360 ))]
|
rlm@8
|
361 (.start
|
rlm@8
|
362 (Thread. stuff))))
|
rlm@8
|
363
|
rlm@8
|
364
|
rlm@8
|
365
|
rlm@8
|
366 (defn thread-test []
|
rlm@8
|
367
|
rlm@8
|
368 (let [temp *out*]
|
rlm@8
|
369 (.start
|
rlm@8
|
370 (Thread.
|
rlm@8
|
371 (fn []
|
rlm@11
|
372 (with-bindings {#'*out* temp}
|
rlm@8
|
373 (Thread/sleep 5000)
|
rlm@8
|
374 (println "hi")))))))
|
rlm@13
|
375
|
rlm@13
|
376
|
rlm@13
|
377 (comment
|
rlm@13
|
378 (do
|
rlm@13
|
379 (require 'rlm.quick)
|
rlm@13
|
380 (ns laser.rasterize)
|
rlm@13
|
381 (rlm.quick/dirty)
|
rlm@13
|
382 (use :reload-all 'laser.rasterize)
|
rlm@13
|
383 (undef map-keys)
|
rlm@13
|
384 (use :reload-all 'laser.rasterize)))
|