From 3e85d3ce7dbd8fb5b81607cde4f29ea619acc1d4 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sun, 21 Jan 2018 21:53:27 -0800 Subject: [PATCH] bubble-chamber: resurrect from unmaintained. --- extra/bubble-chamber/bubble-chamber.factor | 492 ++++++++++++++++++ .../hadron-chamber/hadron-chamber.factor | 8 + extra/bubble-chamber/hadron-chamber/tags.txt | 1 + extra/bubble-chamber/large/large.factor | 8 + extra/bubble-chamber/large/tags.txt | 1 + extra/bubble-chamber/medium/medium.factor | 8 + extra/bubble-chamber/medium/tags.txt | 1 + extra/bubble-chamber/original/original.factor | 8 + extra/bubble-chamber/original/tags.txt | 1 + .../quark-chamber/quark-chamber.factor | 8 + extra/bubble-chamber/quark-chamber/tags.txt | 1 + extra/bubble-chamber/small/small.factor | 8 + extra/bubble-chamber/small/tags.txt | 1 + extra/bubble-chamber/ten-hadrons/tags.txt | 1 + .../ten-hadrons/ten-hadrons.factor | 8 + 15 files changed, 555 insertions(+) create mode 100644 extra/bubble-chamber/bubble-chamber.factor create mode 100644 extra/bubble-chamber/hadron-chamber/hadron-chamber.factor create mode 100644 extra/bubble-chamber/hadron-chamber/tags.txt create mode 100644 extra/bubble-chamber/large/large.factor create mode 100644 extra/bubble-chamber/large/tags.txt create mode 100644 extra/bubble-chamber/medium/medium.factor create mode 100644 extra/bubble-chamber/medium/tags.txt create mode 100644 extra/bubble-chamber/original/original.factor create mode 100644 extra/bubble-chamber/original/tags.txt create mode 100644 extra/bubble-chamber/quark-chamber/quark-chamber.factor create mode 100644 extra/bubble-chamber/quark-chamber/tags.txt create mode 100644 extra/bubble-chamber/small/small.factor create mode 100644 extra/bubble-chamber/small/tags.txt create mode 100644 extra/bubble-chamber/ten-hadrons/tags.txt create mode 100644 extra/bubble-chamber/ten-hadrons/ten-hadrons.factor diff --git a/extra/bubble-chamber/bubble-chamber.factor b/extra/bubble-chamber/bubble-chamber.factor new file mode 100644 index 0000000000..8e0509b61d --- /dev/null +++ b/extra/bubble-chamber/bubble-chamber.factor @@ -0,0 +1,492 @@ +USING: accessors arrays calendar colors colors.gray +combinators.short-circuit frame-buffer kernel locals math +math.constants math.functions math.libm math.order math.points +math.ranges math.vectors namespaces processing.shapes random +sequences threads ui ui.gadgets ui.gestures ; + +IN: bubble-chamber + +! This is a Factor implementation of an art piece by Jared Tarbell: +! +! http://complexification.net/gallery/machines/bubblechamber/ +! +! Jared's version is written in Processing (Java) + +: 2random ( a b -- num ) 2dup swap - 100 / random ; + +: 1random ( b -- num ) 0 swap 2random ; + +: at-fraction ( seq fraction -- val ) over length 1 - * >integer swap nth ; + +: at-fraction-of ( fraction seq -- val ) swap at-fraction ; + +: mouse ( -- point ) hand-loc get ; + +: mouse-x ( -- x ) mouse first ; +: mouse-y ( -- y ) mouse second ; + +GENERIC: collide ( particle -- ) +GENERIC: move ( particle -- ) + +TUPLE: particle + bubble-chamber pos vel speed speed-d theta theta-d theta-dd myc mya ; + +: initialize-particle ( particle -- particle ) + + { 0 0 } >>pos + { 0 0 } >>vel + + 0 >>speed + 0 >>speed-d + 0 >>theta + 0 >>theta-d + 0 >>theta-dd + + 0 0 0 1 rgba boa >>myc + 0 0 0 1 rgba boa >>mya ; + +: center ( particle -- point ) bubble-chamber>> size>> 2 v/n ; + +DEFER: collision-theta + +: move-by ( obj delta -- obj ) over pos>> v+ >>pos ; + +: theta-dd-small? ( par limit -- par ? ) [ dup theta-dd>> abs ] dip < ; + +: random-theta-dd ( par a b -- par ) 2random >>theta-dd ; + +: turn ( particle -- particle ) + dup + [ speed>> ] [ theta>> [ sin ] [ cos ] bi 2array ] bi n*v + >>vel ; + +: step-theta ( p -- p ) [ ] [ theta>> ] [ theta-d>> ] tri + >>theta ; +: step-theta-d ( p -- p ) [ ] [ theta-d>> ] [ theta-dd>> ] tri + >>theta-d ; +: step-speed-sub ( p -- p ) [ ] [ speed>> ] [ speed-d>> ] tri - >>speed ; +: step-speed-mul ( p -- p ) [ ] [ speed>> ] [ speed-d>> ] tri * >>speed ; + +:: out-of-bounds? ( PARTICLE -- ? ) + PARTICLE pos>> first :> X + PARTICLE pos>> second :> Y + PARTICLE bubble-chamber>> size>> first :> WIDTH + PARTICLE bubble-chamber>> size>> second :> HEIGHT + + WIDTH neg :> LEFT + WIDTH 2 * :> RIGHT + HEIGHT neg :> BOTTOM + HEIGHT 2 * :> TOP + + { [ X LEFT < ] [ X RIGHT > ] [ Y BOTTOM < ] [ Y TOP > ] } 0|| ; + +TUPLE: axion < particle ; + +: ( -- axion ) axion new initialize-particle ; + +M: axion collide + + dup center >>pos + 2 pi * 1random >>theta + 1.0 6.0 2random >>speed + 0.998 1.000 2random >>speed-d + 0 >>theta-d + 0 >>theta-dd + + [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] while + + drop ; + +: dy>alpha ( dy -- alpha ) neg 6 * 30 + 255.0 / ; + +! : axion-white ( dy -- dy ) dup 1 swap dy>alpha 2array stroke-color set ; +! : axion-black ( dy -- dy ) dup 0 swap dy>alpha 2array stroke-color set ; + +: axion-white ( dy -- dy ) dup 1 swap dy>alpha gray boa stroke-color set ; +: axion-black ( dy -- dy ) dup 0 swap dy>alpha gray boa stroke-color set ; + +: axion-point- ( particle dy -- particle ) [ dup pos>> ] dip v-y draw-point ; +: axion-point+ ( particle dy -- particle ) [ dup pos>> ] dip v+y draw-point ; + +M: axion move + + T{ gray f 0.06 0.59 } stroke-color set + dup pos>> draw-point + + 1 4 [a,b] [ axion-white axion-point- ] each + 1 4 [a,b] [ axion-black axion-point+ ] each + + dup vel>> move-by + + turn + + step-theta + step-theta-d + step-speed-mul + + [ ] [ speed-d>> 0.9999 * ] bi >>speed-d + + 1000 random 996 > + [ + dup speed>> neg >>speed + dup speed-d>> neg 2 + >>speed-d + + 100 random 30 > [ collide ] [ drop ] if + ] + [ drop ] + if ; + +TUPLE: hadron < particle ; + +: ( -- hadron ) hadron new initialize-particle ; + +M: hadron collide + + dup center >>pos + 2 pi * 1random >>theta + 0.5 3.5 2random >>speed + 0.996 1.001 2random >>speed-d + 0 >>theta-d + 0 >>theta-dd + + [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] while + + 0 1 0 1 rgba boa >>myc + + drop ; + +M: hadron move + + T{ gray f 1 0.11 } stroke-color set dup pos>> 1 v-y draw-point + T{ gray f 0 0.11 } stroke-color set dup pos>> 1 v+y draw-point + + dup vel>> move-by + + turn + + step-theta + step-theta-d + step-speed-mul + + 1000 random 997 > + [ + 1.0 >>speed-d + 0.00001 >>theta-dd + + 100 random 70 > [ dup collide ] when + ] + when + + dup out-of-bounds? [ collide ] [ drop ] if ; + +CONSTANT: good-colors { + T{ rgba f 0.23 0.14 0.17 1 } + T{ rgba f 0.23 0.14 0.15 1 } + T{ rgba f 0.21 0.14 0.15 1 } + T{ rgba f 0.51 0.39 0.33 1 } + T{ rgba f 0.49 0.33 0.20 1 } + T{ rgba f 0.55 0.45 0.32 1 } + T{ rgba f 0.69 0.63 0.51 1 } + T{ rgba f 0.64 0.39 0.18 1 } + T{ rgba f 0.73 0.42 0.20 1 } + T{ rgba f 0.71 0.45 0.29 1 } + T{ rgba f 0.79 0.45 0.22 1 } + T{ rgba f 0.82 0.56 0.34 1 } + T{ rgba f 0.88 0.72 0.49 1 } + T{ rgba f 0.85 0.69 0.40 1 } + T{ rgba f 0.96 0.92 0.75 1 } + T{ rgba f 0.99 0.98 0.87 1 } + T{ rgba f 0.85 0.82 0.69 1 } + T{ rgba f 0.99 0.98 0.87 1 } + T{ rgba f 0.82 0.82 0.79 1 } + T{ rgba f 0.65 0.69 0.67 1 } + T{ rgba f 0.53 0.60 0.55 1 } + T{ rgba f 0.57 0.53 0.68 1 } + T{ rgba f 0.47 0.42 0.56 1 } +} + +: anti-colors ( -- seq ) good-colors ; + +: color-fraction ( particle -- particle fraction ) dup theta>> pi + 2 pi * / ; + +: set-good-color ( particle -- particle ) + color-fraction dup 0 1 between? + [ good-colors at-fraction-of >>myc ] [ drop ] if ; + +: set-anti-color ( particle -- particle ) + color-fraction dup 0 1 between? + [ anti-colors at-fraction-of >>mya ] [ drop ] if ; + +TUPLE: muon < particle ; + +: ( -- muon ) muon new initialize-particle ; + +M: muon collide + + dup center >>pos + 2 32 [a,b] random >>speed + 0.0001 0.001 2random >>speed-d + + dup collision-theta -0.1 0.1 2random + >>theta + 0 >>theta-d + 0 >>theta-dd + + [ 0.001 theta-dd-small? ] [ -0.1 0.1 random-theta-dd ] while + + set-good-color + set-anti-color + + drop ; + +M:: muon move ( MUON -- ) + + MUON bubble-chamber>> size>> first :> WIDTH + + MUON + + dup myc>> >rgba-components drop 0.16 stroke-color set + dup pos>> draw-point + + dup mya>> >rgba-components drop 0.16 stroke-color set + dup pos>> first2 [ WIDTH swap - ] dip 2array draw-point + + dup + [ speed>> ] [ theta>> [ sin ] [ cos ] bi 2array ] bi n*v + move-by + + step-theta + step-theta-d + step-speed-sub + + dup out-of-bounds? [ collide ] [ drop ] if ; + +TUPLE: quark < particle ; + +: ( -- quark ) quark new initialize-particle ; + +M: quark collide + + dup center >>pos + dup collision-theta -0.11 0.11 2random + >>theta + 0.5 3.0 2random >>speed + + 0.996 1.001 2random >>speed-d + 0 >>theta-d + 0 >>theta-dd + + [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] while + + drop ; + +M:: quark move ( QUARK -- ) + + QUARK bubble-chamber>> size>> first :> WIDTH + + QUARK + + dup myc>> >rgba-components drop 0.13 stroke-color set + dup pos>> draw-point + + dup pos>> first2 [ WIDTH swap - ] dip 2array draw-point + + [ ] [ vel>> ] bi move-by + + turn + + step-theta + step-theta-d + step-speed-mul + + 1000 random 997 > [ + dup speed>> neg >>speed + 2 over speed-d>> - >>speed-d + ] when + + dup out-of-bounds? [ collide ] [ drop ] if ; + +TUPLE: bubble-chamber < frame-buffer + paused particles collision-theta size ; + +! : randomize-collision-theta ( bubble-chamber -- bubble-chamber ) +! 0 2 pi * 0.001 random >>collision-theta ; + +: randomize-collision-theta ( bubble-chamber -- bubble-chamber ) + pi neg pi 0.001 random >>collision-theta ; + +: collision-theta ( particle -- theta ) bubble-chamber>> collision-theta>> ; + +M: bubble-chamber pref-dim* ( gadget -- dim ) size>> ; + +M: bubble-chamber ungraft* ( bubble-chamber -- ) t >>paused drop ; + +: iterate-particle ( particle -- ) move ; + +M:: bubble-chamber update-frame-buffer ( BUBBLE-CHAMBER -- ) + BUBBLE-CHAMBER particles>> [ iterate-particle ] each ; + +: iterate-system ( bubble-chamber -- ) drop ; + +:: start-bubble-chamber-thread ( GADGET -- ) + GADGET f >>paused drop [ + [ + GADGET paused>> + [ f ] + [ GADGET iterate-system GADGET relayout-1 1 milliseconds sleep t ] + if + ] loop + ] in-thread ; + +: ( -- bubble-chamber ) + bubble-chamber new + { 1000 1000 } >>size + randomize-collision-theta ; + +: bubble-chamber-window ( -- bubble-chamber ) + + dup start-bubble-chamber-thread + dup "Bubble Chamber" open-window ; + +:: add-particle ( BUBBLE-CHAMBER PARTICLE -- bubble-chamber ) + PARTICLE BUBBLE-CHAMBER >>bubble-chamber drop + BUBBLE-CHAMBER [ PARTICLE suffix ] change-particles ; + +:: mouse->collision-theta ( BUBBLE-CHAMBER -- BUBBLE-CHAMBER ) + mouse + BUBBLE-CHAMBER size>> 2 v/n + v- + first2 + fatan2 + BUBBLE-CHAMBER collision-theta<< + BUBBLE-CHAMBER ; + +:: mouse-pressed ( BUBBLE-CHAMBER -- ) + BUBBLE-CHAMBER mouse->collision-theta drop + + 11 [ + BUBBLE-CHAMBER particles>> [ hadron? ] filter random [ collide ] when* + BUBBLE-CHAMBER particles>> [ quark? ] filter random [ collide ] when* + BUBBLE-CHAMBER particles>> [ muon? ] filter random [ collide ] when* + ] times ; + +bubble-chamber H{ + { T{ button-down } [ mouse-pressed ] } +} set-gestures + +: collide-random-particle ( bubble-chamber -- bubble-chamber ) + dup particles>> random collide ; + +: big-bang ( bubble-chamber -- bubble-chamber ) + dup particles>> [ collide ] each ; + +: collide-one-of-each ( bubble-chamber -- bubble-chamber ) + dup + particles>> + [ [ muon? ] filter random collide ] + [ [ quark? ] filter random collide ] + [ [ hadron? ] filter random collide ] + tri ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: ten-hadrons ( -- ) + bubble-chamber-window + 10 [ add-particle ] times + drop ; + +: original ( -- ) + bubble-chamber-window + + 1789 [ add-particle ] times + 1300 [ add-particle ] times + 1000 [ add-particle ] times + 111 [ add-particle ] times + + particles>> + [ [ muon? ] filter random collide ] + [ [ quark? ] filter random collide ] + [ [ hadron? ] filter random collide ] + tri ; + +: hadron-chamber ( -- ) + bubble-chamber-window + 1000 [ add-particle ] times + big-bang + drop ; + +: quark-chamber ( -- ) + bubble-chamber-window + 100 [ add-particle ] times + big-bang + drop ; + +: small ( -- ) + bubble-chamber new + { 200 200 } >>size + randomize-collision-theta + dup start-bubble-chamber-thread + dup "Bubble Chamber" open-window + + 42 [ add-particle ] times + 30 [ add-particle ] times + 21 [ add-particle ] times + 7 [ add-particle ] times + + collide-one-of-each + drop ; + +: medium ( -- ) + bubble-chamber new + { 400 400 } >>size + randomize-collision-theta + dup start-bubble-chamber-thread + dup "Bubble Chamber" open-window + + 100 [ add-particle ] times + 81 [ add-particle ] times + 60 [ add-particle ] times + 9 [ add-particle ] times + + collide-one-of-each + drop ; + +: large ( -- ) + bubble-chamber new + { 600 600 } >>size + randomize-collision-theta + dup start-bubble-chamber-thread + dup "Bubble Chamber" open-window + + 550 [ add-particle ] times + 339 [ add-particle ] times + 100 [ add-particle ] times + 11 [ add-particle ] times + + collide-one-of-each + drop ; + +: muon-chamber ( -- ) + bubble-chamber-window + 1000 [ add-particle ] times + dup particles>> [ collide randomize-collision-theta ] each + drop ; + +: original-big-bang ( -- ) + + { 1000 1000 } >>size + dup start-bubble-chamber-thread + dup "Bubble Chamber" open-window + + 1789 [ add-particle ] times + 1300 [ add-particle ] times + 1000 [ add-particle ] times + 111 [ add-particle ] times + + big-bang + drop ; + +: original-big-bang-variant ( -- ) + bubble-chamber-window + 1789 [ add-particle ] times + 1300 [ add-particle ] times + 1000 [ add-particle ] times + 111 [ add-particle ] times + dup particles>> [ collide randomize-collision-theta ] each + drop ; diff --git a/extra/bubble-chamber/hadron-chamber/hadron-chamber.factor b/extra/bubble-chamber/hadron-chamber/hadron-chamber.factor new file mode 100644 index 0000000000..092dd1e2ad --- /dev/null +++ b/extra/bubble-chamber/hadron-chamber/hadron-chamber.factor @@ -0,0 +1,8 @@ + +USING: ui bubble-chamber ; + +IN: bubble-chamber.hadron-chamber + +: main ( -- ) [ hadron-chamber ] with-ui ; + +MAIN: main diff --git a/extra/bubble-chamber/hadron-chamber/tags.txt b/extra/bubble-chamber/hadron-chamber/tags.txt new file mode 100644 index 0000000000..cb5fc203e1 --- /dev/null +++ b/extra/bubble-chamber/hadron-chamber/tags.txt @@ -0,0 +1 @@ +demos diff --git a/extra/bubble-chamber/large/large.factor b/extra/bubble-chamber/large/large.factor new file mode 100644 index 0000000000..aef9d38ece --- /dev/null +++ b/extra/bubble-chamber/large/large.factor @@ -0,0 +1,8 @@ + +USING: ui bubble-chamber ; + +IN: bubble-chamber.large + +: main ( -- ) [ large ] with-ui ; + +MAIN: main diff --git a/extra/bubble-chamber/large/tags.txt b/extra/bubble-chamber/large/tags.txt new file mode 100644 index 0000000000..cb5fc203e1 --- /dev/null +++ b/extra/bubble-chamber/large/tags.txt @@ -0,0 +1 @@ +demos diff --git a/extra/bubble-chamber/medium/medium.factor b/extra/bubble-chamber/medium/medium.factor new file mode 100644 index 0000000000..a72ca1c58b --- /dev/null +++ b/extra/bubble-chamber/medium/medium.factor @@ -0,0 +1,8 @@ + +USING: ui bubble-chamber ; + +IN: bubble-chamber.medium + +: main ( -- ) [ medium ] with-ui ; + +MAIN: main diff --git a/extra/bubble-chamber/medium/tags.txt b/extra/bubble-chamber/medium/tags.txt new file mode 100644 index 0000000000..cb5fc203e1 --- /dev/null +++ b/extra/bubble-chamber/medium/tags.txt @@ -0,0 +1 @@ +demos diff --git a/extra/bubble-chamber/original/original.factor b/extra/bubble-chamber/original/original.factor new file mode 100644 index 0000000000..4940957801 --- /dev/null +++ b/extra/bubble-chamber/original/original.factor @@ -0,0 +1,8 @@ + +USING: ui bubble-chamber ; + +IN: bubble-chamber.original + +: main ( -- ) [ original ] with-ui ; + +MAIN: main diff --git a/extra/bubble-chamber/original/tags.txt b/extra/bubble-chamber/original/tags.txt new file mode 100644 index 0000000000..cb5fc203e1 --- /dev/null +++ b/extra/bubble-chamber/original/tags.txt @@ -0,0 +1 @@ +demos diff --git a/extra/bubble-chamber/quark-chamber/quark-chamber.factor b/extra/bubble-chamber/quark-chamber/quark-chamber.factor new file mode 100644 index 0000000000..97aaebe18a --- /dev/null +++ b/extra/bubble-chamber/quark-chamber/quark-chamber.factor @@ -0,0 +1,8 @@ + +USING: ui bubble-chamber ; + +IN: bubble-chamber.quark-chamber + +: main ( -- ) [ quark-chamber ] with-ui ; + +MAIN: main diff --git a/extra/bubble-chamber/quark-chamber/tags.txt b/extra/bubble-chamber/quark-chamber/tags.txt new file mode 100644 index 0000000000..cb5fc203e1 --- /dev/null +++ b/extra/bubble-chamber/quark-chamber/tags.txt @@ -0,0 +1 @@ +demos diff --git a/extra/bubble-chamber/small/small.factor b/extra/bubble-chamber/small/small.factor new file mode 100644 index 0000000000..774a2bcd7d --- /dev/null +++ b/extra/bubble-chamber/small/small.factor @@ -0,0 +1,8 @@ + +USING: ui bubble-chamber ; + +IN: bubble-chamber.small + +: main ( -- ) [ small ] with-ui ; + +MAIN: main diff --git a/extra/bubble-chamber/small/tags.txt b/extra/bubble-chamber/small/tags.txt new file mode 100644 index 0000000000..cb5fc203e1 --- /dev/null +++ b/extra/bubble-chamber/small/tags.txt @@ -0,0 +1 @@ +demos diff --git a/extra/bubble-chamber/ten-hadrons/tags.txt b/extra/bubble-chamber/ten-hadrons/tags.txt new file mode 100644 index 0000000000..cb5fc203e1 --- /dev/null +++ b/extra/bubble-chamber/ten-hadrons/tags.txt @@ -0,0 +1 @@ +demos diff --git a/extra/bubble-chamber/ten-hadrons/ten-hadrons.factor b/extra/bubble-chamber/ten-hadrons/ten-hadrons.factor new file mode 100644 index 0000000000..7eb6673021 --- /dev/null +++ b/extra/bubble-chamber/ten-hadrons/ten-hadrons.factor @@ -0,0 +1,8 @@ + +USING: ui bubble-chamber ; + +IN: bubble-chamber.ten-hadrons + +: main ( -- ) [ ten-hadrons ] with-ui ; + +MAIN: main