Mercurial > lasercutter

comparison src/laser/stupid-backup.clj @ 18:a769347618a1

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