1 USING: accessors arrays ascii calendar colors colors.gray
2 combinators.short-circuit kernel math math.constants
3 math.functions math.libm math.order math.points math.vectors
4 namespaces opengl processing.shapes quotations random ranges
5 sequences splitting timers ui ui.gadgets ui.gadgets.borders
6 ui.gadgets.buttons ui.gadgets.frame-buffer ui.gadgets.packs
11 ! This is a Factor implementation of an art piece by Jared Tarbell:
13 ! http://complexification.net/gallery/machines/bubblechamber/
15 ! Jared's version is written in Processing (Java)
17 : 2random ( a b -- num ) 2dup swap - 100 / <range> random ;
19 : 1random ( b -- num ) 0 swap 2random ;
21 : at-fraction ( seq fraction -- val ) over length 1 - * >integer swap nth ;
23 : at-fraction-of ( fraction seq -- val ) swap at-fraction ;
25 : mouse ( -- point ) hand-loc get ;
27 : mouse-x ( -- x ) mouse first ;
28 : mouse-y ( -- y ) mouse second ;
31 gl-scale-factor get-global [
32 stroke-color get fill-color set
38 GENERIC: collide ( particle -- )
39 GENERIC: move ( particle -- )
42 bubble-chamber pos vel speed speed-d theta theta-d theta-dd myc mya ;
44 : initialize-particle ( particle -- particle )
55 0 0 0 1 rgba boa >>myc
56 0 0 0 1 rgba boa >>mya ;
58 : center ( particle -- point ) bubble-chamber>> size>> 2 v/n ;
60 DEFER: collision-theta
62 : move-by ( obj delta -- obj ) over pos>> v+ >>pos ;
64 : theta-dd-small? ( par limit -- par ? ) [ dup theta-dd>> abs ] dip < ;
66 : random-theta-dd ( par a b -- par ) 2random >>theta-dd ;
68 : turn ( particle -- particle )
70 [ speed>> ] [ theta>> [ sin ] [ cos ] bi 2array ] bi n*v
73 : step-theta ( p -- p ) [ ] [ theta>> ] [ theta-d>> ] tri + >>theta ;
74 : step-theta-d ( p -- p ) [ ] [ theta-d>> ] [ theta-dd>> ] tri + >>theta-d ;
75 : step-speed-sub ( p -- p ) [ ] [ speed>> ] [ speed-d>> ] tri - >>speed ;
76 : step-speed-mul ( p -- p ) [ ] [ speed>> ] [ speed-d>> ] tri * >>speed ;
78 :: out-of-bounds? ( PARTICLE -- ? )
79 PARTICLE pos>> first :> X
80 PARTICLE pos>> second :> Y
81 PARTICLE bubble-chamber>> size>> first :> WIDTH
82 PARTICLE bubble-chamber>> size>> second :> HEIGHT
89 { [ X LEFT < ] [ X RIGHT > ] [ Y BOTTOM < ] [ Y TOP > ] } 0|| ;
91 TUPLE: axion < particle ;
93 : <axion> ( -- axion ) axion new initialize-particle ;
98 2 pi * 1random >>theta
99 1.0 6.0 2random >>speed
100 0.998 1.000 2random >>speed-d
104 [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] while
108 : dy>alpha ( dy -- alpha ) neg 6 * 30 + 255.0 / ;
110 ! : axion-white ( dy -- dy ) dup 1 swap dy>alpha 2array stroke-color set ;
111 ! : axion-black ( dy -- dy ) dup 0 swap dy>alpha 2array stroke-color set ;
113 : axion-white ( dy -- dy ) dup 1 swap dy>alpha gray boa stroke-color set ;
114 : axion-black ( dy -- dy ) dup 0 swap dy>alpha gray boa stroke-color set ;
116 : axion-point- ( particle dy -- particle ) [ dup pos>> ] dip v-y draw ;
117 : axion-point+ ( particle dy -- particle ) [ dup pos>> ] dip v+y draw ;
121 T{ gray f 0.06 0.59 } stroke-color set
124 4 [1..b] [ axion-white axion-point- ] each
125 4 [1..b] [ axion-black axion-point+ ] each
135 [ ] [ speed-d>> 0.9999 * ] bi >>speed-d
139 dup speed>> neg >>speed
140 dup speed-d>> neg 2 + >>speed-d
142 100 random 30 > [ collide ] [ drop ] if
147 TUPLE: hadron < particle ;
149 : <hadron> ( -- hadron ) hadron new initialize-particle ;
154 2 pi * 1random >>theta
155 0.5 3.5 2random >>speed
156 0.996 1.001 2random >>speed-d
160 [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] while
162 0 1 0 1 rgba boa >>myc
168 T{ gray f 1 0.11 } stroke-color set dup pos>> 1 v-y draw
169 T{ gray f 0 0.11 } stroke-color set dup pos>> 1 v+y draw
184 100 random 70 > [ dup collide ] when
188 dup out-of-bounds? [ collide ] [ drop ] if ;
190 CONSTANT: good-colors {
191 T{ rgba f 0.23 0.14 0.17 1 }
192 T{ rgba f 0.23 0.14 0.15 1 }
193 T{ rgba f 0.21 0.14 0.15 1 }
194 T{ rgba f 0.51 0.39 0.33 1 }
195 T{ rgba f 0.49 0.33 0.20 1 }
196 T{ rgba f 0.55 0.45 0.32 1 }
197 T{ rgba f 0.69 0.63 0.51 1 }
198 T{ rgba f 0.64 0.39 0.18 1 }
199 T{ rgba f 0.73 0.42 0.20 1 }
200 T{ rgba f 0.71 0.45 0.29 1 }
201 T{ rgba f 0.79 0.45 0.22 1 }
202 T{ rgba f 0.82 0.56 0.34 1 }
203 T{ rgba f 0.88 0.72 0.49 1 }
204 T{ rgba f 0.85 0.69 0.40 1 }
205 T{ rgba f 0.96 0.92 0.75 1 }
206 T{ rgba f 0.99 0.98 0.87 1 }
207 T{ rgba f 0.85 0.82 0.69 1 }
208 T{ rgba f 0.99 0.98 0.87 1 }
209 T{ rgba f 0.82 0.82 0.79 1 }
210 T{ rgba f 0.65 0.69 0.67 1 }
211 T{ rgba f 0.53 0.60 0.55 1 }
212 T{ rgba f 0.57 0.53 0.68 1 }
213 T{ rgba f 0.47 0.42 0.56 1 }
216 : anti-colors ( -- seq ) good-colors <reversed> ;
218 : color-fraction ( particle -- particle fraction ) dup theta>> pi + 2 pi * / ;
220 : set-good-color ( particle -- particle )
221 color-fraction dup 0 1 between?
222 [ good-colors at-fraction-of >>myc ] [ drop ] if ;
224 : set-anti-color ( particle -- particle )
225 color-fraction dup 0 1 between?
226 [ anti-colors at-fraction-of >>mya ] [ drop ] if ;
228 TUPLE: muon < particle ;
230 : <muon> ( -- muon ) muon new initialize-particle ;
235 2 32 [a..b] random >>speed
236 0.0001 0.001 2random >>speed-d
238 dup collision-theta -0.1 0.1 2random + >>theta
242 [ 0.001 theta-dd-small? ] [ -0.1 0.1 random-theta-dd ] while
249 M:: muon move ( MUON -- )
251 MUON bubble-chamber>> size>> first :> WIDTH
255 dup myc>> >rgba-components drop 0.16 <rgba> stroke-color set
258 dup mya>> >rgba-components drop 0.16 <rgba> stroke-color set
259 dup pos>> first2 [ WIDTH swap - ] dip 2array draw
262 [ speed>> ] [ theta>> [ sin ] [ cos ] bi 2array ] bi n*v
269 dup out-of-bounds? [ collide ] [ drop ] if ;
271 TUPLE: quark < particle ;
273 : <quark> ( -- quark ) quark new initialize-particle ;
278 dup collision-theta -0.11 0.11 2random + >>theta
279 0.5 3.0 2random >>speed
281 0.996 1.001 2random >>speed-d
285 [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] while
289 M:: quark move ( QUARK -- )
291 QUARK bubble-chamber>> size>> first :> WIDTH
295 dup myc>> >rgba-components drop 0.13 <rgba> stroke-color set
298 dup pos>> first2 [ WIDTH swap - ] dip 2array draw
300 [ ] [ vel>> ] bi move-by
309 dup speed>> neg >>speed
310 2 over speed-d>> - >>speed-d
313 dup out-of-bounds? [ collide ] [ drop ] if ;
315 TUPLE: bubble-chamber < frame-buffer
316 particles collision-theta size timer ;
318 M: bubble-chamber graft*
319 [ timer>> start-timer ] [ call-next-method ] bi ;
321 M: bubble-chamber ungraft*
322 [ timer>> stop-timer ] [ call-next-method ] bi ;
324 ! : randomize-collision-theta ( bubble-chamber -- bubble-chamber )
325 ! 0 2 pi * 0.001 <range> random >>collision-theta ;
327 : randomize-collision-theta ( bubble-chamber -- bubble-chamber )
328 pi neg pi 0.001 <range> random >>collision-theta ;
330 : collision-theta ( particle -- theta ) bubble-chamber>> collision-theta>> ;
332 M: bubble-chamber pref-dim* ( gadget -- dim ) size>> ;
334 : iterate-particle ( particle -- ) move ;
336 M:: bubble-chamber update-frame-buffer ( BUBBLE-CHAMBER -- )
337 BUBBLE-CHAMBER particles>> [ iterate-particle ] each ;
339 : iterate-system ( bubble-chamber -- ) drop ;
341 : <bubble-chamber> ( -- bubble-chamber )
344 randomize-collision-theta
345 dup '[ _ dup iterate-system relayout-1 ]
346 f 10 milliseconds <timer> >>timer ;
348 : bubble-chamber-window ( -- bubble-chamber )
349 <bubble-chamber> dup "Bubble Chamber" open-window ;
351 :: add-particle ( BUBBLE-CHAMBER PARTICLE -- bubble-chamber )
352 PARTICLE BUBBLE-CHAMBER >>bubble-chamber drop
353 BUBBLE-CHAMBER [ PARTICLE suffix ] change-particles ;
355 :: mouse->collision-theta ( BUBBLE-CHAMBER -- BUBBLE-CHAMBER )
357 BUBBLE-CHAMBER size>> 2 v/n
361 BUBBLE-CHAMBER collision-theta<<
364 :: mouse-pressed ( BUBBLE-CHAMBER -- )
365 BUBBLE-CHAMBER mouse->collision-theta drop
368 BUBBLE-CHAMBER particles>> [ hadron? ] filter random [ collide ] when*
369 BUBBLE-CHAMBER particles>> [ quark? ] filter random [ collide ] when*
370 BUBBLE-CHAMBER particles>> [ muon? ] filter random [ collide ] when*
374 { T{ button-down } [ mouse-pressed ] }
377 : collide-random-particle ( bubble-chamber -- bubble-chamber )
378 dup particles>> random collide ;
380 : big-bang ( bubble-chamber -- bubble-chamber )
381 dup particles>> [ collide ] each ;
383 : collide-one-of-each ( bubble-chamber -- bubble-chamber )
386 [ [ muon? ] filter random collide ]
387 [ [ quark? ] filter random collide ]
388 [ [ hadron? ] filter random collide ]
391 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
394 bubble-chamber-window
395 10 [ <hadron> add-particle ] times
399 bubble-chamber-window
401 1789 [ <muon> add-particle ] times
402 1300 [ <quark> add-particle ] times
403 1000 [ <hadron> add-particle ] times
404 111 [ <axion> add-particle ] times
407 [ [ muon? ] filter random collide ]
408 [ [ quark? ] filter random collide ]
409 [ [ hadron? ] filter random collide ]
412 : hadron-chamber ( -- )
413 bubble-chamber-window
414 1000 [ <hadron> add-particle ] times
418 : quark-chamber ( -- )
419 bubble-chamber-window
420 100 [ <quark> add-particle ] times
427 dup "Bubble Chamber" open-window
429 42 [ <muon> add-particle ] times
430 30 [ <quark> add-particle ] times
431 21 [ <hadron> add-particle ] times
432 7 [ <axion> add-particle ] times
440 dup "Bubble Chamber" open-window
442 100 [ <muon> add-particle ] times
443 81 [ <quark> add-particle ] times
444 60 [ <hadron> add-particle ] times
445 9 [ <axion> add-particle ] times
453 dup "Bubble Chamber" open-window
455 550 [ <muon> add-particle ] times
456 339 [ <quark> add-particle ] times
457 100 [ <hadron> add-particle ] times
458 11 [ <axion> add-particle ] times
463 : muon-chamber ( -- )
464 bubble-chamber-window
465 1000 [ <muon> add-particle ] times
466 dup particles>> [ collide randomize-collision-theta ] each
469 : original-big-bang ( -- )
472 dup "Bubble Chamber" open-window
474 1789 [ <muon> add-particle ] times
475 1300 [ <quark> add-particle ] times
476 1000 [ <hadron> add-particle ] times
477 111 [ <axion> add-particle ] times
482 : original-big-bang-variant ( -- )
483 bubble-chamber-window
484 1789 [ <muon> add-particle ] times
485 1300 [ <quark> add-particle ] times
486 1000 [ <hadron> add-particle ] times
487 111 [ <axion> add-particle ] times
488 dup particles>> [ collide randomize-collision-theta ] each
491 MAIN-WINDOW: run-bubble-chamber { { title "Bubble Chamber" } }
492 <filled-pile> { 2 2 } >>gap {
493 original small medium large hadron-chamber
494 quark-chamber muon-chamber ten-hadrons
495 original-big-bang original-big-bang-variant
497 [ name>> "-" " " replace >title ]
498 [ 1quotation [ drop ] prepend ] bi
499 <border-button> add-gadget
500 ] each { 2 2 } <border> >>gadgets ;