|
rlm@1
|
1 (ns clojureDemo.ArchLearning
|
|
rlm@1
|
2 (:gen-class
|
|
rlm@1
|
3 :implements [connections.WiredBox]
|
|
rlm@1
|
4 :methods [ [process [Object] void] [setFile [Object] void] ]
|
|
rlm@1
|
5 :post-init register))
|
|
rlm@1
|
6
|
|
rlm@1
|
7 (use 'clojure.contrib.import-static)
|
|
rlm@1
|
8 (import '(java.io File))
|
|
rlm@1
|
9 (import '(org.apache.commons.io FileUtils))
|
|
rlm@1
|
10 (import '(javax.imageio ImageIO) )
|
|
rlm@1
|
11 (import '(javax.swing JFrame))
|
|
rlm@1
|
12 (import '(java.awt Color BorderLayout))
|
|
rlm@1
|
13 (import '(ij.plugin PlugIn))
|
|
rlm@1
|
14 (import '(ij ImagePlus IJ))
|
|
rlm@1
|
15 (import '(java.lang Math))
|
|
rlm@1
|
16 (import '(java.awt Polygon))
|
|
rlm@1
|
17 (import '(java.awt.geom Line2D$Double))
|
|
rlm@1
|
18
|
|
rlm@1
|
19 (use 'clojureDemo.appeture)
|
|
rlm@1
|
20
|
|
rlm@1
|
21 (import-static java.lang.Math pow abs)
|
|
rlm@1
|
22
|
|
rlm@1
|
23 (import '(ij Macro))
|
|
rlm@1
|
24
|
|
rlm@1
|
25 (import '(java.io BufferedReader InputStreamReader))
|
|
rlm@1
|
26 (import '(java.awt.image BufferedImage))
|
|
rlm@1
|
27 (import '(genesis Genesis))
|
|
rlm@1
|
28 (import '(utils Mark))
|
|
rlm@1
|
29 (import '(capenLow StoryProcessor))
|
|
rlm@1
|
30 (import '(connections Connections WiredBox))
|
|
rlm@1
|
31 (import '(specialBoxes BasicBox MultiFunctionBox))
|
|
rlm@1
|
32 (import '(engineering NewHardWiredTranslator))
|
|
rlm@1
|
33
|
|
rlm@1
|
34 (import '(java.awt Polygon))
|
|
rlm@1
|
35 (import '(java.awt.geom Line2D$Double))
|
|
rlm@1
|
36 (use 'clojure.contrib.str-utils)
|
|
rlm@1
|
37
|
|
rlm@1
|
38
|
|
rlm@1
|
39 ;genesis imports
|
|
rlm@1
|
40 (import '(http Start))
|
|
rlm@1
|
41
|
|
rlm@1
|
42
|
|
rlm@1
|
43 (use '[clojureDemo.Xuggle :only (video-seq trans-save flash display video-data)])
|
|
rlm@1
|
44 (use 'clojureDemo.MegaDeath)
|
|
rlm@1
|
45
|
|
rlm@1
|
46
|
|
rlm@1
|
47 (use 'clojure.contrib.combinatorics)
|
|
rlm@1
|
48
|
|
rlm@1
|
49 (use 'clojure.contrib.repl-utils)
|
|
rlm@1
|
50
|
|
rlm@1
|
51 (use 'clojureDemo.GenesisPlay)
|
|
rlm@1
|
52
|
|
rlm@1
|
53 (use ['clojureDemo.Defines
|
|
rlm@1
|
54 :only '(
|
|
rlm@1
|
55 lian look getto human0 blow base app0 app1 app2 app3 app4 app5
|
|
rlm@1
|
56 bounce0 bounce1 bounce2 bounce3 bounce4 bounce5 bounce6
|
|
rlm@1
|
57 collide0 collide1 collide2 collide3 collide4
|
|
rlm@1
|
58 give0 give1 give2 give3 give4 target default)])
|
|
rlm@1
|
59
|
|
rlm@1
|
60 (defn -register
|
|
rlm@1
|
61 "equivalent to Connections.getPorts(this).addSignalProcessor(\"process\"); in Java"
|
|
rlm@1
|
62 [this]
|
|
rlm@1
|
63 (println "ClojureBox (register) : Register is run
|
|
rlm@1
|
64 only when the object is created, as if it were a constructor.")
|
|
rlm@1
|
65 (. (connections.Connections/getPorts this) addSignalProcessor "process"))
|
|
rlm@1
|
66
|
|
rlm@1
|
67 (defn -process [ this obj ]
|
|
rlm@1
|
68 (println "ClojureBox (process) : This is a LISP function,
|
|
rlm@1
|
69 being called through Java, through the wiredBox metaphor.")
|
|
rlm@1
|
70 (.transmit (Connections/getPorts this) obj))
|
|
rlm@1
|
71
|
|
rlm@1
|
72 (defn -getName
|
|
rlm@1
|
73 "the [_] means that the function gets an explicit 'this'
|
|
rlm@1
|
74 argument, just like python. In this case we don't care about it."
|
|
rlm@1
|
75 [_] "ArchLearning")
|
|
rlm@1
|
76
|
|
rlm@1
|
77
|
|
rlm@1
|
78
|
|
rlm@1
|
79
|
|
rlm@1
|
80
|
|
rlm@1
|
81 (def output-base (File. "/home/r/Desktop/output-vision"))
|
|
rlm@1
|
82 (def rsgs (with-meta (take 10 gs) (meta gs)))
|
|
rlm@1
|
83 (def rrsgs (with-meta (take 3 rsgs) (meta gs)))
|
|
rlm@1
|
84 ; a concept is going to be derived from Genesis' own xml based representations.
|
|
rlm@1
|
85 ; this is an form of archlearning which figures out a function that representes
|
|
rlm@1
|
86 ; the concepts.
|
|
rlm@1
|
87
|
|
rlm@1
|
88
|
|
rlm@1
|
89 (def black {:r 0 :g 0 :b 0})
|
|
rlm@1
|
90 (def white {:r 255 :g 255 :b 255})
|
|
rlm@1
|
91
|
|
rlm@1
|
92
|
|
rlm@1
|
93 (defn window-frame
|
|
rlm@1
|
94 "analyzes a frame in terms of lots of tiny windows which
|
|
rlm@1
|
95 each try to find some sort of edge. keeps coordinates."
|
|
rlm@1
|
96 ([x-form frame]
|
|
rlm@1
|
97 (let [lines (frame-windows x-form frame)]
|
|
rlm@1
|
98 (zipmap (for [x lines] (first (rest x)))
|
|
rlm@1
|
99 lines)))
|
|
rlm@1
|
100 ([frame]
|
|
rlm@1
|
101 (window-frame identity frame)))
|
|
rlm@1
|
102
|
|
rlm@1
|
103
|
|
rlm@1
|
104 (defn intense-select-x-form
|
|
rlm@1
|
105 "discard silly gray things"
|
|
rlm@1
|
106 [window]
|
|
rlm@1
|
107 (with-meta
|
|
rlm@1
|
108 (zipmap
|
|
rlm@1
|
109 (keys window)
|
|
rlm@1
|
110 (map (fn [rgb]
|
|
rlm@1
|
111 (let [spread (- (max (:r rgb) (:g rgb) (:b rgb)) (min (:r rgb) (:g rgb) (:b rgb)))]
|
|
rlm@1
|
112 (if (> spread 45)
|
|
rlm@1
|
113 rgb
|
|
rlm@1
|
114 {:r 0 :g 0 :b 0}))) (vals window))) (meta window)))
|
|
rlm@1
|
115
|
|
rlm@1
|
116 (defn edges-x-form
|
|
rlm@1
|
117 [window]
|
|
rlm@1
|
118 (frame-hash (ImagePlus. "sad :(" (overlay-draw blank (frame-windows window)))))
|
|
rlm@1
|
119
|
|
rlm@1
|
120
|
|
rlm@1
|
121
|
|
rlm@1
|
122 (defn rgb-max
|
|
rlm@1
|
123 [rgb1 rgb2]
|
|
rlm@1
|
124 {:r (max (:r rgb1) (:r rgb2))
|
|
rlm@1
|
125 :g (max (:g rgb1) (:g rgb2))
|
|
rlm@1
|
126 :b (max (:b rgb1) (:b rgb2))})
|
|
rlm@1
|
127
|
|
rlm@1
|
128 (defn frame-hash-add
|
|
rlm@1
|
129 [frame1 frame2]
|
|
rlm@1
|
130 (with-meta
|
|
rlm@1
|
131 (let [indexes (apply hash-set (concat (keys frame1) (keys frame2)))]
|
|
rlm@1
|
132 (zipmap indexes (for [x indexes] (rgb-max (frame1 x black) (frame2 x black))))) (meta frame1)))
|
|
rlm@1
|
133
|
|
rlm@1
|
134
|
|
rlm@1
|
135
|
|
rlm@1
|
136 (defn vid-seq-add
|
|
rlm@1
|
137 "for black and white video-sequences. Just adds them together into one image sequence"
|
|
rlm@1
|
138 [vid-seq1 vid-seq2]
|
|
rlm@1
|
139 (with-meta
|
|
rlm@1
|
140 (map #(ImagePlus. "ADD B&W" (frame-hash->bufferedImage %)) (map frame-hash-add (map frame-hash vid-seq1) (map frame-hash vid-seq2)))
|
|
rlm@1
|
141 (meta vid-seq1)))
|
|
rlm@1
|
142
|
|
rlm@1
|
143 (defn edges-center-draw
|
|
rlm@1
|
144 ([base edges]
|
|
rlm@1
|
145 (frame-hash-add
|
|
rlm@1
|
146 base
|
|
rlm@1
|
147 (zipmap (keys edges) (repeat white))))
|
|
rlm@1
|
148 ([edges]
|
|
rlm@1
|
149 (edges-center-draw blank edges)))
|
|
rlm@1
|
150
|
|
rlm@1
|
151 (defn edge-dot-x-form
|
|
rlm@1
|
152 "gives a new frame-hash with only the edge points, all white."
|
|
rlm@1
|
153 [frame]
|
|
rlm@1
|
154 (edges-center-draw (window-frame frame)))
|
|
rlm@1
|
155
|
|
rlm@1
|
156
|
|
rlm@1
|
157 (defn rgb-euclidian
|
|
rlm@1
|
158 [{r1 :r g1 :g b1 :b} {r2 :r g2 :g b2 :b} ]
|
|
rlm@1
|
159 (pow (+ (pow (- r1 r2) 2)
|
|
rlm@1
|
160 (pow (- g1 g2) 2)
|
|
rlm@1
|
161 (pow (- b1 b2) 2)) 0.5))
|
|
rlm@1
|
162
|
|
rlm@1
|
163 (defn rgb-sub
|
|
rlm@1
|
164 [tolerance rgb1 rgb2]
|
|
rlm@1
|
165 (if (< (rgb-euclidian rgb1 rgb2) tolerance) black white))
|
|
rlm@1
|
166
|
|
rlm@1
|
167
|
|
rlm@1
|
168
|
|
rlm@1
|
169 (defn frame-subtract
|
|
rlm@1
|
170 [tolerance frame1 frame2]
|
|
rlm@1
|
171 (with-meta
|
|
rlm@1
|
172 (let [indexes (apply hash-set (concat (keys frame1) (keys frame2)))]
|
|
rlm@1
|
173 (zipmap indexes (for [x indexes] (rgb-sub tolerance (frame1 x) (frame2 x))))) (meta frame1)))
|
|
rlm@1
|
174
|
|
rlm@1
|
175
|
|
rlm@1
|
176 (defn image-subtract
|
|
rlm@1
|
177 [tolerance [img1 img2]]
|
|
rlm@1
|
178 (frame-subtract tolerance (frame-hash img1) (frame-hash img2)))
|
|
rlm@1
|
179
|
|
rlm@1
|
180
|
|
rlm@1
|
181 (defn motion-detect
|
|
rlm@1
|
182 ([tolerance video-seq]
|
|
rlm@1
|
183 (with-meta
|
|
rlm@1
|
184 (map (partial image-subtract tolerance) (partition 2 1 video-seq)) (meta video-seq)))
|
|
rlm@1
|
185 ([video-seq]
|
|
rlm@1
|
186 (motion-detect 40 video-seq)))
|
|
rlm@1
|
187
|
|
rlm@1
|
188 (defn motion-x-form
|
|
rlm@1
|
189 ([tolerance video-seq]
|
|
rlm@1
|
190 (with-meta
|
|
rlm@1
|
191 (map #(ImagePlus. "motion-detect!" (frame-hash->bufferedImage %)) (motion-detect tolerance video-seq))
|
|
rlm@1
|
192 (meta video-seq)))
|
|
rlm@1
|
193 ([video-seq]
|
|
rlm@1
|
194 (motion-x-form 40 video-seq)))
|
|
rlm@1
|
195 ;the edge detector is what finds objects.
|
|
rlm@1
|
196 ;movement disambiguates between different ways of interperting what objects are there
|
|
rlm@1
|
197 ;color / other qualifiers enable focus on a subset of objects, and can give objects names.
|
|
rlm@1
|
198
|
|
rlm@1
|
199
|
|
rlm@1
|
200
|
|
rlm@1
|
201
|
|
rlm@1
|
202
|
|
rlm@1
|
203 (defn find-an-object
|
|
rlm@1
|
204 "tries to find a single object from the current sensory-buffer, which
|
|
rlm@1
|
205 is a video-seq for now. My idea here is for this to feed-back on itself,
|
|
rlm@1
|
206 adjusting parameters till it can find it's target, and then using those
|
|
rlm@1
|
207 to construct an representation of the object in terms of how to find it using
|
|
rlm@1
|
208 other visual routines paramaters."
|
|
rlm@1
|
209 [video-seq])
|
|
rlm@1
|
210
|
|
rlm@1
|
211
|
|
rlm@1
|
212
|
|
rlm@1
|
213 (defn transform
|
|
rlm@1
|
214 [x-form video-seq]
|
|
rlm@1
|
215 (with-meta
|
|
rlm@1
|
216 (map (fn [imgPlus]
|
|
rlm@1
|
217 (let [play (frame-hash imgPlus)]
|
|
rlm@1
|
218 (x-form play)))
|
|
rlm@1
|
219 video-seq)
|
|
rlm@1
|
220 (meta video-seq)))
|
|
rlm@1
|
221
|
|
rlm@1
|
222
|
|
rlm@1
|
223 (defn apply-x-form
|
|
rlm@1
|
224 [x-form video-seq]
|
|
rlm@1
|
225 (with-meta
|
|
rlm@1
|
226 (map #(ImagePlus. "transformed!" (frame-hash->bufferedImage %))
|
|
rlm@1
|
227 (map (fn [imgPlus]
|
|
rlm@1
|
228 (let [play (frame-hash imgPlus)]
|
|
rlm@1
|
229 (x-form play)))
|
|
rlm@1
|
230 video-seq))
|
|
rlm@1
|
231 (meta video-seq)))
|
|
rlm@1
|
232
|
|
rlm@1
|
233
|
|
rlm@1
|
234
|
|
rlm@1
|
235 (defn only-white
|
|
rlm@1
|
236 "reduce the image to only its white points"
|
|
rlm@1
|
237 [window]
|
|
rlm@1
|
238 (with-meta
|
|
rlm@1
|
239 (let [new-keys
|
|
rlm@1
|
240 (filter #(= white (window %)) (keys window))]
|
|
rlm@1
|
241 (zipmap new-keys (map window new-keys))) (meta window)))
|
|
rlm@1
|
242
|
|
rlm@1
|
243
|
|
rlm@1
|
244
|
|
rlm@1
|
245
|
|
rlm@1
|
246 (defn white-sum
|
|
rlm@1
|
247 [& rgbs]
|
|
rlm@1
|
248 (let[ wht-map {white 1}]
|
|
rlm@1
|
249 (reduce + (map #(wht-map % 0) rgbs))))
|
|
rlm@1
|
250
|
|
rlm@1
|
251 (defn island?
|
|
rlm@1
|
252 "return false if there's nothing around it within a certain radius"
|
|
rlm@1
|
253 [window [x y]]
|
|
rlm@1
|
254 (let [radius 3]
|
|
rlm@1
|
255 (<= (apply white-sum (vals (rectangle-window x y radius radius window))) 1)))
|
|
rlm@1
|
256
|
|
rlm@1
|
257 (defn white-border
|
|
rlm@1
|
258 "anything that relies on a hack like this to work is wrong"
|
|
rlm@1
|
259 [window]
|
|
rlm@1
|
260 (with-meta
|
|
rlm@1
|
261 (let [info (meta window)]
|
|
rlm@1
|
262 (into window
|
|
rlm@1
|
263 (zipmap
|
|
rlm@1
|
264 (for [x (range (:width info)) y (range (:height info))
|
|
rlm@1
|
265 :when (or (= (-(:width info) 1) x) (= (- (:height info) 1) y) (= 0 y) (= 0 x))] [x y])
|
|
rlm@1
|
266 (repeat white))))(meta window)))
|
|
rlm@1
|
267
|
|
rlm@1
|
268 (defn polygonize
|
|
rlm@1
|
269 "for each edge-point, try to connect it with all the edge points around it,
|
|
rlm@1
|
270 or obliterate it if it doesn't have any edge points close by."
|
|
rlm@1
|
271 [window]
|
|
rlm@1
|
272 (with-meta
|
|
rlm@1
|
273 (let [edges (only-white window)]
|
|
rlm@1
|
274 (let [new-keys
|
|
rlm@1
|
275 (filter (comp not (partial island? window)) (keys window))]
|
|
rlm@1
|
276 (let [ready-points (zipmap new-keys (map window new-keys))]
|
|
rlm@1
|
277 (meta window))))))
|
|
rlm@1
|
278
|
|
rlm@1
|
279
|
|
rlm@1
|
280 (defn connect-the-dots
|
|
rlm@1
|
281 [radius window]
|
|
rlm@1
|
282 (let [edge-points (white-border (only-white window))
|
|
rlm@1
|
283 image (frame-hash->bufferedImage window)
|
|
rlm@1
|
284 g2 (.getGraphics image)]
|
|
rlm@1
|
285 (doall
|
|
rlm@1
|
286 (for [[x y] (keys edge-points)]
|
|
rlm@1
|
287
|
|
rlm@1
|
288 (let [points (apply cartesian-product (repeat 2 (keys (only-white (rectangle-window x y radius radius edge-points)))))]
|
|
rlm@1
|
289 (if (not (empty? points))
|
|
rlm@1
|
290 (doall
|
|
rlm@1
|
291 (for [[[x1 y1][x2 y2]] points]
|
|
rlm@1
|
292 (.drawLine g2 x1 y1 x2 y2)))))))
|
|
rlm@1
|
293 (frame-hash (ImagePlus. "stupid..." image))))
|
|
rlm@1
|
294
|
|
rlm@1
|
295
|
|
rlm@1
|
296 (defn blob-x-form
|
|
rlm@1
|
297 [window]
|
|
rlm@1
|
298 (with-meta
|
|
rlm@1
|
299 ((comp (partial connect-the-dots 4) edge-dot-x-form) window)
|
|
rlm@1
|
300 (meta window)))
|
|
rlm@1
|
301
|
|
rlm@1
|
302
|
|
rlm@1
|
303
|
|
rlm@1
|
304
|
|
rlm@1
|
305 (defn connect-points
|
|
rlm@1
|
306 [frame-hash overlay]
|
|
rlm@1
|
307 (let [image (frame-hash->bufferedImage frame-hash)
|
|
rlm@1
|
308 g2 (.getGraphics image)]
|
|
rlm@1
|
309 (doall (for [ x overlay]
|
|
rlm@1
|
310 (let [x1 (ffirst x) y1 (second (first x)) x2 (first (last x)) y2 (last (last x))]
|
|
rlm@1
|
311 (.drawLine g2 x1 y1 x2 y2))))
|
|
rlm@1
|
312 image))
|
|
rlm@1
|
313
|
|
rlm@1
|
314
|
|
rlm@1
|
315 (defn disambiguate-edges
|
|
rlm@1
|
316 "Like in project Prakesh, the thing that lets you discern shapes
|
|
rlm@1
|
317 is watching them *move* coherently. After many months of this
|
|
rlm@1
|
318 motion-boosting, the edge-detector itself becomes good enogh to
|
|
rlm@1
|
319 analyze static pictures without motion. This function takes edges
|
|
rlm@1
|
320 and tries to combine them into lines, dividing the world into
|
|
rlm@1
|
321 polygonal regions. Motion is used to associate two regions together.
|
|
rlm@1
|
322 associated with those points, that information is also used."
|
|
rlm@1
|
323 [edges motion]
|
|
rlm@1
|
324 )
|
|
rlm@1
|
325
|
|
rlm@1
|
326
|
|
rlm@1
|
327 (defn triple-seq
|
|
rlm@1
|
328 [triple]
|
|
rlm@1
|
329 (list (.getFirst triple) (.getSecond triple) (.getThird triple)))
|
|
rlm@1
|
330
|
|
rlm@1
|
331 (defn contains-word?
|
|
rlm@1
|
332 [word triple]
|
|
rlm@1
|
333 (contains? (set (map (fn [s] (re-sub #"-\d+" "" s)) (triple-seq triple))) word))
|
|
rlm@1
|
334
|
|
rlm@1
|
335
|
|
rlm@1
|
336 (defn write
|
|
rlm@1
|
337 [reference]
|
|
rlm@1
|
338 (fn [x] (dosync
|
|
rlm@1
|
339 (println "wrote " " to " "ref.")
|
|
rlm@1
|
340 (ref-set reference x))))
|
|
rlm@1
|
341
|
|
rlm@1
|
342
|
|
rlm@1
|
343 ;; (defn join-point-lists
|
|
rlm@1
|
344 ;; [pointlist1 pointlist2]
|
|
rlm@1
|
345 ;; (for [x :while (not(= x 5))] x)))
|
|
rlm@1
|
346
|
|
rlm@1
|
347 (defn extract-single-blob
|
|
rlm@1
|
348 "find the biggest blob in an image and return it"
|
|
rlm@1
|
349 [window]
|
|
rlm@1
|
350 ;we're assuming that there are only blobs left -- funning this on an unprocessed
|
|
rlm@1
|
351 ;image will just return the entire image
|
|
rlm@1
|
352 (map list window))
|
|
rlm@1
|
353
|
|
rlm@1
|
354
|
|
rlm@1
|
355
|
|
rlm@1
|
356
|
|
rlm@1
|
357 (def gen-out (ref nil))
|
|
rlm@1
|
358 (def triple (ref nil))
|
|
rlm@1
|
359
|
|
rlm@1
|
360
|
|
rlm@1
|
361
|
|
rlm@1
|
362 (def gen1 (ref ()))
|
|
rlm@1
|
363 (def gen2 (ref ()))
|
|
rlm@1
|
364 (def gen3 (ref ()))
|
|
rlm@1
|
365 (def gen4 (ref ()))
|
|
rlm@1
|
366 (def gen5 (ref ()))
|
|
rlm@1
|
367 (def gen6 (ref ()))
|
|
rlm@1
|
368 (def gen7 (ref ()))
|
|
rlm@1
|
369 (def gen8 (ref ()))
|
|
rlm@1
|
370
|
|
rlm@1
|
371
|
|
rlm@1
|
372 (defn make-color-generator
|
|
rlm@1
|
373 []
|
|
rlm@1
|
374 (let [r (java.util.Random. 58)
|
|
rlm@1
|
375 g (java.util.Random. 125)
|
|
rlm@1
|
376 b (java.util.Random. 8)]
|
|
rlm@1
|
377 #(hash-map :r (.nextInt r 255) :g (.nextInt r 255) :b (.nextInt r 255))))
|
|
rlm@1
|
378
|
|
rlm@1
|
379
|
|
rlm@1
|
380 ;a blob is a collection of:
|
|
rlm@1
|
381 ;points, colors
|
|
rlm@1
|
382 ;other blobs
|
|
rlm@1
|
383 ;so, a window is a blob too.
|
|
rlm@1
|
384
|
|
rlm@1
|
385
|
|
rlm@1
|
386
|
|
rlm@1
|
387
|
|
rlm@1
|
388
|
|
rlm@1
|
389
|
|
rlm@1
|
390 ;; (defn blob-color-absob
|
|
rlm@1
|
391 ;; [blob1 blob2]
|
|
rlm@1
|
392 ;; (if (and (< (rgb-euclidian (color-avg blob1) (color-avg blob2)) 20) (close-together blob1 blob2))
|
|
rlm@1
|
393 ;; (combine blob1 blob2)
|
|
rlm@1
|
394 ;; '(blob1 blob2)))
|
|
rlm@1
|
395
|
|
rlm@1
|
396
|
|
rlm@1
|
397 (defn make-test-box
|
|
rlm@1
|
398 "stupid."
|
|
rlm@1
|
399 []
|
|
rlm@1
|
400 (let [box (proxy [MultiFunctionBox] [] (getName [] "test-box [clojure]")
|
|
rlm@1
|
401 (process1 [obj] ((write gen1) obj))
|
|
rlm@1
|
402 (process2 [obj] ((write gen2) obj))
|
|
rlm@1
|
403 (process3 [obj] ((write gen3) obj))
|
|
rlm@1
|
404 (process4 [obj] ((write gen4) obj))
|
|
rlm@1
|
405 (process5 [obj] ((write gen5) obj))
|
|
rlm@1
|
406 (process6 [obj] ((write gen6) obj))
|
|
rlm@1
|
407 (process7 [obj] ((write gen7) obj))
|
|
rlm@1
|
408 (process8 [obj] ((write gen8) obj)))]
|
|
rlm@1
|
409
|
|
rlm@1
|
410 (.addSignalProcessor (Connections/getPorts box) "PORT1" "process1")
|
|
rlm@1
|
411 (.addSignalProcessor (Connections/getPorts box) "PORT2" "process2")
|
|
rlm@1
|
412 (.addSignalProcessor (Connections/getPorts box) "PORT3" "process3")
|
|
rlm@1
|
413 (.addSignalProcessor (Connections/getPorts box) "PORT4" "process4")
|
|
rlm@1
|
414 (.addSignalProcessor (Connections/getPorts box) "PORT5" "process5")
|
|
rlm@1
|
415 (.addSignalProcessor (Connections/getPorts box) "PORT6" "process6")
|
|
rlm@1
|
416 (.addSignalProcessor (Connections/getPorts box) "PORT7" "process7")
|
|
rlm@1
|
417 (.addSignalProcessor (Connections/getPorts box) "PORT8" "process8")
|
|
rlm@1
|
418 box))
|
|
rlm@1
|
419
|
|
rlm@1
|
420
|
|
rlm@1
|
421
|
|
rlm@1
|
422 (defn writer-box
|
|
rlm@1
|
423 [reference]
|
|
rlm@1
|
424 (let [box (proxy [MultiFunctionBox] []
|
|
rlm@1
|
425 (getName [] "ref-set\n [clojure]")
|
|
rlm@1
|
426 (process1 [obj] ((write reference) obj)))]
|
|
rlm@1
|
427 (.addSignalProcessor (Connections/getPorts box) "process1")
|
|
rlm@1
|
428 box))
|
|
rlm@1
|
429
|
|
rlm@1
|
430
|
|
rlm@1
|
431
|
|
rlm@1
|
432
|
|
rlm@1
|
433 (def triples (ref ()))
|
|
rlm@1
|
434 (def parse (ref ()))
|
|
rlm@1
|
435 (def raw (ref ()))
|
|
rlm@1
|
436 (def idioms (ref ()))
|
|
rlm@1
|
437 (def yes-no (ref ()))
|
|
rlm@1
|
438 (def imagine (ref ()))
|
|
rlm@1
|
439 (def traj (ref ()))
|
|
rlm@1
|
440 (def action (ref ()))
|
|
rlm@1
|
441 (def transfer (ref ()))
|
|
rlm@1
|
442 (def pix (ref ()))
|
|
rlm@1
|
443 (def property (ref ()))
|
|
rlm@1
|
444
|
|
rlm@1
|
445 (use 'clojure.contrib.str-utils)
|
|
rlm@1
|
446
|
|
rlm@1
|
447 (defn process-video-and-subtitles
|
|
rlm@1
|
448 [this file]
|
|
rlm@1
|
449 ;we're looking for a text file of the same name as the video file.
|
|
rlm@1
|
450 (let [subtitles (File. (.getParent file) (str (last (first (re-seq #"(^.*)\.avi$" (.getName file)))) ".txt"))]
|
|
rlm@1
|
451 (dorun
|
|
rlm@1
|
452 (for [line (re-split #"\n" (slurp (str subtitles)))]
|
|
rlm@1
|
453 (do (println line)
|
|
rlm@1
|
454 (.transmit (Connections/getPorts this) line)))))
|
|
rlm@1
|
455 (display (first (video-seq file))))
|
|
rlm@1
|
456
|
|
rlm@1
|
457 (defn process-triple
|
|
rlm@1
|
458 [this triple]
|
|
rlm@1
|
459 (println "RLM [vision-box]: " triple))
|
|
rlm@1
|
460
|
|
rlm@1
|
461 (defn visionBox
|
|
rlm@1
|
462 []
|
|
rlm@1
|
463 (let [box (proxy [MultiFunctionBox] []
|
|
rlm@1
|
464 (getName [] "VisionBox \n [clojure]")
|
|
rlm@1
|
465 (process1 [obj] (process-video-and-subtitles this obj))
|
|
rlm@1
|
466 (process2 [obj] (process-triple this obj)))]
|
|
rlm@1
|
467 (.addSignalProcessor (Connections/getPorts box) "video-in" "process1")
|
|
rlm@1
|
468 (.addSignalProcessor (Connections/getPorts box) "triple-in" "process2")
|
|
rlm@1
|
469
|
|
rlm@1
|
470 (println "the good box")
|
|
rlm@1
|
471 box))
|
|
rlm@1
|
472
|
|
rlm@1
|
473
|
|
rlm@1
|
474
|
|
rlm@1
|
475
|
|
rlm@1
|
476
|
|
rlm@1
|
477 (defn custom-genesis
|
|
rlm@1
|
478 "connects the writer boxes to genesis"
|
|
rlm@1
|
479 []
|
|
rlm@1
|
480 (Connections/obliterateNetwork)
|
|
rlm@1
|
481 (let [stupid-box (make-test-box) genesis (Genesis.) vis-box (visionBox) ]
|
|
rlm@1
|
482 (Connections/wire "tripple port" (.getStartParser genesis) (writer-box triples))
|
|
rlm@1
|
483 (Connections/wire "parse" (.getStartParser genesis) (writer-box parse))
|
|
rlm@1
|
484 (Connections/wire "result" (.getNewSemanticTranslator genesis) (writer-box raw))
|
|
rlm@1
|
485 (Connections/wire (.getIdiomExpert genesis) (writer-box idioms))
|
|
rlm@1
|
486 (Connections/wire "yes-no question" (.getCommandExpert genesis) (writer-box yes-no))
|
|
rlm@1
|
487 (Connections/wire "imagine" (.getCommandExpert genesis) (writer-box imagine))
|
|
rlm@1
|
488 (Connections/wire "viewer" (.getTrajectoryExpert genesis) (writer-box traj))
|
|
rlm@1
|
489 (Connections/wire "viewer" (.getActionExpert genesis) (writer-box action))
|
|
rlm@1
|
490 (Connections/wire "next" (.getTransferExpert genesis) (writer-box transfer))
|
|
rlm@1
|
491 (Connections/wire (.getRachelsPictureFinder genesis) (writer-box pix))
|
|
rlm@1
|
492 (Connections/wire "viewer" (.getPropertyExpert genesis) (writer-box property))
|
|
rlm@1
|
493 (Connections/wire "tripple port" (.getStartParser genesis) "triple-in" vis-box)
|
|
rlm@1
|
494
|
|
rlm@1
|
495
|
|
rlm@1
|
496 (Connections/wire (.getArchLearning genesis) "video-in" vis-box)
|
|
rlm@1
|
497 (Connections/wire vis-box "sentence" (.getStartParser genesis))
|
|
rlm@1
|
498
|
|
rlm@1
|
499 genesis))
|
|
rlm@1
|
500
|
|
rlm@1
|
501
|
|
rlm@1
|
502 (use 'clojure.contrib.def)
|
|
rlm@1
|
503
|
|
rlm@1
|
504 (defvar learning-hash {}
|
|
rlm@1
|
505 "Right now this serves as the visual memory.
|
|
rlm@1
|
506 It's full of verbs/objects and the programs
|
|
rlm@1
|
507 that find them.")
|
|
rlm@1
|
508
|
|
rlm@1
|
509 (def green {:r 0 :g 200 :b 0})
|
|
rlm@1
|
510 (def blue {:r 0 :g 0 :b 255})
|
|
rlm@1
|
511 (def red {:r 255 :g 0 :b 0})
|
|
rlm@1
|
512
|
|
rlm@1
|
513
|
|
rlm@1
|
514 (defn color-similar?
|
|
rlm@1
|
515 [threshold window color coord]
|
|
rlm@1
|
516 (< (rgb-euclidian (window coord) color) threshold))
|
|
rlm@1
|
517 ;should also have the same "shape" here
|
|
rlm@1
|
518
|
|
rlm@1
|
519 (defn color-select
|
|
rlm@1
|
520 [threshold color window]
|
|
rlm@1
|
521 (with-meta
|
|
rlm@1
|
522 (let [new-keys
|
|
rlm@1
|
523 (filter (partial color-similar? threshold window color) (keys window))]
|
|
rlm@1
|
524 (zipmap new-keys (map window new-keys)))
|
|
rlm@1
|
525 (meta window)))
|
|
rlm@1
|
526
|
|
rlm@1
|
527
|
|
rlm@1
|
528
|
|
rlm@1
|
529 (defn object-sequence
|
|
rlm@1
|
530 "get's the largest blob of the given color from a video sequence."
|
|
rlm@1
|
531 [color video-seq]
|
|
rlm@1
|
532 (apply-x-form (comp (partial color-select 135 color) intense-select-x-form) rrsgs))
|
|
rlm@1
|
533
|
|
rlm@1
|
534 (defn -setFile
|
|
rlm@1
|
535 [this file]
|
|
rlm@1
|
536 (println "file is " file)
|
|
rlm@1
|
537 (.process this file))
|
|
rlm@1
|
538
|
|
rlm@1
|
539
|
|
rlm@1
|
540
|
|
rlm@1
|
541
|
|
rlm@1
|
542 (comment (things you can do that will actually work!)
|
|
rlm@1
|
543
|
|
rlm@1
|
544 (do (use :reload-all 'clojureDemo.ArchLearning) (in-ns 'clojureDemo.ArchLearning))
|
|
rlm@1
|
545
|
|
rlm@1
|
546 (display (overlay-draw (green-select-x-form play) (frame-windows green-select-x-form play )))
|
|
rlm@1
|
547
|
|
rlm@1
|
548 ;vision stuff
|
|
rlm@1
|
549
|
|
rlm@1
|
550 (def edgesD (transform window-frame rrsgs))
|
|
rlm@1
|
551
|
|
rlm@1
|
552 (doall
|
|
rlm@1
|
553 (def edgesI (apply-x-form edges-x-form rrsgs))
|
|
rlm@1
|
554 (display (rectangle-window 50 50 50 50 (frame-hash (nth edgesI 1))))
|
|
rlm@1
|
555 )
|
|
rlm@1
|
556
|
|
rlm@1
|
557 (def polyjuice (white-border (only-white (edge-dot-x-form play))))
|
|
rlm@1
|
558
|
|
rlm@1
|
559 (count (color-select 135 red (intense-select-x-form (frame-hash (last sg)))))
|
|
rlm@1
|
560 (trans-save (File. output-base "only-red.avi")(apply-x-form (comp (partial color-select 135 red) intense-select-x-form) rrsgs))
|
|
rlm@1
|
561 )
|
|
rlm@1
|
562
|
