From 62b497f2b502fbf9ab322acf210f52d4871a19fb Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Mon, 15 Dec 2008 15:08:46 -0800 Subject: [PATCH 01/11] Update formatting docs. --- extra/formatting/formatting-docs.factor | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/extra/formatting/formatting-docs.factor b/extra/formatting/formatting-docs.factor index c249f1d6f3..4203dd891f 100644 --- a/extra/formatting/formatting-docs.factor +++ b/extra/formatting/formatting-docs.factor @@ -49,27 +49,27 @@ HELP: printf } { $examples { $example - "USING: printf ;" + "USING: formatting ;" "123 \"%05d\" printf" "00123" } { $example - "USING: printf ;" + "USING: formatting ;" "HEX: ff \"%04X\" printf" "00FF" } { $example - "USING: printf ;" + "USING: formatting ;" "1.23456789 \"%.3f\" printf" "1.235" } { $example - "USING: printf ;" + "USING: formatting ;" "1234567890 \"%.5e\" printf" "1.23457e+09" } { $example - "USING: printf ;" + "USING: formatting ;" "12 \"%'#4d\" printf" "##12" } { $example - "USING: printf ;" + "USING: formatting ;" "1234 \"%+d\" printf" "+1234" } } ; @@ -109,6 +109,12 @@ HELP: strftime { "%Z" "Time zone name (no characters if no time zone exists)." } { "%%" "A literal '%' character." } } +} +{ $examples + { $example + "USING: calendar formatting ;" + "now \"%c\" strftime" + "Mon Dec 15 14:40:43 2008" } } ; ARTICLE: "formatting" "Formatted printing" From 2c23d2ac4d7b8257f609b0e65f0439e2ede8ef2b Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Mon, 15 Dec 2008 15:09:18 -0800 Subject: [PATCH 02/11] Update use of old printf vocabulary. --- extra/webapps/irc-log/irc-log.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/webapps/irc-log/irc-log.factor b/extra/webapps/irc-log/irc-log.factor index c193550719..bd9843bdc9 100644 --- a/extra/webapps/irc-log/irc-log.factor +++ b/extra/webapps/irc-log/irc-log.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: calendar kernel http.server.dispatchers prettyprint -sequences printf furnace.actions html.forms accessors +sequences formatting furnace.actions html.forms accessors furnace.redirection ; IN: webapps.irc-log From 98bfac3f63b483fa31cf6f15c9decfe7dfb56099 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 15 Dec 2008 18:32:52 -0600 Subject: [PATCH 03/11] Remove 'ui.gadgets.frame-buffer' --- .../gadgets/frame-buffer/frame-buffer.factor | 115 ------------------ 1 file changed, 115 deletions(-) delete mode 100644 extra/ui/gadgets/frame-buffer/frame-buffer.factor diff --git a/extra/ui/gadgets/frame-buffer/frame-buffer.factor b/extra/ui/gadgets/frame-buffer/frame-buffer.factor deleted file mode 100644 index 2d58037982..0000000000 --- a/extra/ui/gadgets/frame-buffer/frame-buffer.factor +++ /dev/null @@ -1,115 +0,0 @@ - -USING: kernel alien.c-types combinators sequences splitting grouping - opengl.gl ui.gadgets ui.render - math math.vectors accessors math.geometry.rect ; - -IN: ui.gadgets.frame-buffer - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -TUPLE: frame-buffer < gadget action pdim last-dim graft ungraft pixels ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: init-frame-buffer-pixels ( frame-buffer -- frame-buffer ) - dup - rect-dim product "uint[4]" - >>pixels ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: new-frame-buffer ( class -- gadget ) - new-gadget - [ ] >>action - { 100 100 } >>pdim - [ ] >>graft - [ ] >>ungraft ; - -: ( -- frame-buffer ) frame-buffer new-frame-buffer ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: draw-pixels ( fb -- fb ) - dup >r - dup >r - rect-dim first2 GL_RGBA GL_UNSIGNED_INT r> pixels>> glDrawPixels - r> ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: read-pixels ( fb -- fb ) - dup >r - dup >r - >r - 0 0 r> rect-dim first2 GL_RGBA GL_UNSIGNED_INT r> pixels>> glReadPixels - r> ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -M: frame-buffer pref-dim* pdim>> ; -M: frame-buffer graft* graft>> call ; -M: frame-buffer ungraft* ungraft>> call ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: copy-row ( old new -- ) - 2dup min-length swap >r head-slice 0 r> copy ; - -! : copy-pixels ( old-pixels old-width new-pixels new-width -- ) -! [ group ] 2bi@ -! [ copy-row ] 2each ; - -! : copy-pixels ( old-pixels old-width new-pixels new-width -- ) -! [ 16 * group ] 2bi@ -! [ copy-row ] 2each ; - -: copy-pixels ( old-pixels old-width new-pixels new-width -- ) - [ 16 * ] 2bi@ - [ copy-row ] 2each ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -M: frame-buffer layout* ( fb -- ) - { - { - [ dup last-dim>> f = ] - [ - init-frame-buffer-pixels - dup - rect-dim >>last-dim - drop - ] - } - { - [ dup [ rect-dim ] [ last-dim>> ] bi = not ] - [ - dup [ pixels>> ] [ last-dim>> first ] bi - - rot init-frame-buffer-pixels - dup rect-dim >>last-dim - - [ pixels>> ] [ rect-dim first ] bi - - copy-pixels - ] - } - { [ t ] [ drop ] } - } - cond ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -M: frame-buffer draw-gadget* ( fb -- ) - - dup rect-dim { 0 1 } v* first2 glRasterPos2i - - draw-pixels - - dup action>> call - - glFlush - - read-pixels - - drop ; - From 1e9f7b65b5a3d8ce18276ded58d8a6a82a35c493 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 15 Dec 2008 18:36:52 -0600 Subject: [PATCH 04/11] Add extra/frame-buffer --- extra/frame-buffer/frame-buffer.factor | 112 +++++++++++++++++++++++++ 1 file changed, 112 insertions(+) create mode 100644 extra/frame-buffer/frame-buffer.factor diff --git a/extra/frame-buffer/frame-buffer.factor b/extra/frame-buffer/frame-buffer.factor new file mode 100644 index 0000000000..708c0d8bd4 --- /dev/null +++ b/extra/frame-buffer/frame-buffer.factor @@ -0,0 +1,112 @@ + +USING: accessors alien.c-types combinators grouping kernel + locals math math.geometry.rect math.vectors opengl.gl sequences + ui.gadgets ui.render ; + +IN: frame-buffer + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: < gadget pixels last-dim ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +GENERIC: update-frame-buffer ( -- ) + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: init-frame-buffer-pixels ( frame-buffer -- ) + dup + rect-dim product "uint[4]" + >>pixels + drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: frame-buffer ( -- ) new-gadget ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: draw-pixels ( FRAME-BUFFER -- ) + + FRAME-BUFFER rect-dim first2 + GL_RGBA + GL_UNSIGNED_INT + FRAME-BUFFER pixels>> + glDrawPixels ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: read-pixels ( FRAME-BUFFER -- ) + + 0 + 0 + FRAME-BUFFER rect-dim first2 + GL_RGBA + GL_UNSIGNED_INT + FRAME-BUFFER pixels>> + glReadPixels ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: copy-row ( OLD NEW -- ) + + [let | LEN [ OLD NEW min-length ] | + + OLD LEN head-slice 0 NEW copy ] ; + +: copy-pixels ( old-pixels old-width new-pixels new-width -- ) + [ 16 * ] 2bi@ + [ copy-row ] 2each ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: update-last-dim ( frame-buffer -- ) dup rect-dim >>last-dim drop ; + +M:: layout* ( FRAME-BUFFER -- ) + + { + { + [ FRAME-BUFFER last-dim>> f = ] + [ + FRAME-BUFFER init-frame-buffer-pixels + + FRAME-BUFFER update-last-dim + ] + } + { + [ FRAME-BUFFER [ rect-dim ] [ last-dim>> ] bi = not ] + [ + [let | OLD-PIXELS [ FRAME-BUFFER pixels>> ] + OLD-WIDTH [ FRAME-BUFFER last-dim>> first ] | + + FRAME-BUFFER init-frame-buffer-pixels + + FRAME-BUFFER update-last-dim + + [let | NEW-PIXELS [ FRAME-BUFFER pixels>> ] + NEW-WIDTH [ FRAME-BUFFER last-dim>> first ] | + + OLD-PIXELS OLD-WIDTH NEW-PIXELS NEW-WIDTH copy-pixels ] ] + ] + } + { [ t ] [ ] } + } + cond ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +M:: draw-gadget* ( FRAME-BUFFER -- ) + + FRAME-BUFFER rect-dim { 0 1 } v* first2 glRasterPos2i + + FRAME-BUFFER draw-pixels + + FRAME-BUFFER update-frame-buffer + + glFlush + + FRAME-BUFFER read-pixels ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + From 5219ba99f3e3208df1ffc51612878e56e761adef Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 15 Dec 2008 18:40:19 -0600 Subject: [PATCH 05/11] Rewrite bubble-chamber: something to old us over till LHC is completed --- extra/bubble-chamber/bubble-chamber.factor | 584 +++++++++++++++++++++ 1 file changed, 584 insertions(+) create mode 100644 extra/bubble-chamber/bubble-chamber.factor diff --git a/extra/bubble-chamber/bubble-chamber.factor b/extra/bubble-chamber/bubble-chamber.factor new file mode 100644 index 0000000000..b70c65c037 --- /dev/null +++ b/extra/bubble-chamber/bubble-chamber.factor @@ -0,0 +1,584 @@ + +USING: accessors arrays calendar +combinators.cleave combinators.short-circuit +kernel locals math math.constants math.functions math.libm +math.order math.points math.vectors + namespaces +random sequences threads ui ui.gadgets ui.gestures ; + +USING: + + kernel + + syntax + + sequences + + math.ranges + + colors + colors.gray + + vars + + multi-methods + multi-method-syntax + + processing.shapes + + frame-buffer + + ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +IN: bubble-chamber + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! processing +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: 2random ( a b -- num ) 2dup swap - 100 / random ; + +: 1random ( b -- num ) 0 swap 2random ; + +: at-fraction ( seq fraction -- val ) over length 1- * 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 ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! bubble-chamber.particle +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +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 {2} >>pos + 0 0 {2} >>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 ? ) >r dup theta-dd>> abs r> < ; + +: random-theta-dd ( par a b -- par ) 2random >>theta-dd ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: turn ( particle -- particle ) + dup + [ speed>> ] [ theta>> { sin cos } ] 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 -- ? ) + [let | X [ PARTICLE pos>> first ] + Y [ PARTICLE pos>> second ] + WIDTH [ PARTICLE bubble-chamber>> size>> first ] + HEIGHT [ PARTICLE bubble-chamber>> size>> second ] | + + [let | LEFT [ WIDTH neg ] + RIGHT [ WIDTH 2 * ] + BOTTOM [ HEIGHT neg ] + TOP [ HEIGHT 2 * ] | + + { [ X LEFT < ] [ X RIGHT > ] [ Y BOTTOM < ] [ Y TOP > ] } 0|| ] ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! bubble-chamber.particle.axion +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: < particle ; + +: axion ( -- ) new initialize-particle ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +METHOD: 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 {2} \ stroke-color set ; +! : axion-black ( dy -- dy ) dup 0 swap dy>alpha {2} \ 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 ) >r dup pos>> r> v-y point ; +: axion-point+ ( particle dy -- particle ) >r dup pos>> r> v+y point ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +METHOD: move ( -- ) + + T{ gray f 0.06 0.59 } \ stroke-color set + dup pos>> 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 ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! bubble-chamber.particle.hadron +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: < particle ; + +: hadron ( -- ) new initialize-particle ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +METHOD: 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 ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +METHOD: move ( -- ) + + T{ gray f 1 0.11 } \ stroke-color set dup pos>> 1 v-y point + T{ gray f 0 0.11 } \ stroke-color set dup pos>> 1 v+y 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 ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! bubble-chamber.particle.muon.colors +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: good-colors ( -- seq ) + { + 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 ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! bubble-chamber.particle.muon +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: < particle ; + +: muon ( -- ) new initialize-particle ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +METHOD: 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 ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +METHOD: move ( -- ) + + [let | MUON [ ] | + + [let | WIDTH [ MUON bubble-chamber>> size>> first ] | + + MUON + + dup myc>> 0.16 >>alpha \ stroke-color set + dup pos>> point + + dup mya>> 0.16 >>alpha \ stroke-color set + dup pos>> first2 [ WIDTH swap - ] dip 2array point + + dup + [ speed>> ] [ theta>> { sin cos } ] bi n*v + move-by + + step-theta + step-theta-d + step-speed-sub + + dup out-of-bounds? [ collide ] [ drop ] if ] ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! bubble-chamber.particle.quark +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: < particle ; + +: quark ( -- ) new initialize-particle ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +METHOD: 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 ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +METHOD: move ( -- ) + + [let | QUARK [ ] | + + [let | WIDTH [ QUARK bubble-chamber>> size>> first ] | + + QUARK + + dup myc>> 0.13 >>alpha \ stroke-color set + dup pos>> point + + dup pos>> first2 [ WIDTH swap - ] dip 2array 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 ] ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +USE: syntax ! Switch back to non-multi-method 'TUPLE:' syntax + +TUPLE: < + 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: pref-dim* ( gadget -- dim ) size>> ; + +M: ungraft* ( -- ) t >>paused drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: iterate-particle ( particle -- ) move ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +M:: update-frame-buffer ( BUBBLE-CHAMBER -- ) + + BUBBLE-CHAMBER particles>> [ iterate-particle ] each ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: iterate-system ( -- ) 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 ( -- ) + new-gadget + { 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 BUBBLE-CHAMBER particles>> PARTICLE suffix >>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>> [ ? ] filter random [ collide ] when* + BUBBLE-CHAMBER particles>> [ ? ] filter random [ collide ] when* + BUBBLE-CHAMBER particles>> [ ? ] filter random [ collide ] when* + ] + times ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + 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 ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Some initial configurations +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: ten-hadrons ( -- ) + bubble-chamber-window + 10 [ drop hadron add-particle ] each + drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: original ( -- ) + + bubble-chamber-window + + 1789 [ muon add-particle ] times + 1300 [ quark add-particle ] times + 1000 [ hadron add-particle ] times + 111 [ axion add-particle ] times + + particles>> + [ [ ? ] filter random collide ] + [ [ ? ] filter random collide ] + [ [ ? ] filter random collide ] + tri ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: original-big-bang ( -- ) + bubble-chamber + { 1000 1000 } >>size + dup start-bubble-chamber-thread + dup "Bubble Chamber" open-window + + 1789 [ muon add-particle ] times + 1300 [ quark add-particle ] times + 1000 [ hadron add-particle ] times + 111 [ axion add-particle ] times + + big-bang + + drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: hadron-chamber ( -- ) + bubble-chamber-window + 1000 [ hadron add-particle ] times + big-bang + drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: muon-chamber ( -- ) + bubble-chamber-window + 1000 [ muon add-particle ] times + dup particles>> [ collide randomize-collision-theta ] each + drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: original-big-bang-variant ( -- ) + bubble-chamber-window + 1789 [ muon add-particle ] times + 1300 [ quark add-particle ] times + 1000 [ hadron add-particle ] times + 111 [ axion add-particle ] times + dup particles>> [ collide randomize-collision-theta ] each + drop ; + From 0884a3f16266befc4fd8f9ba19c0a16dd36b7b70 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 15 Dec 2008 18:43:50 -0600 Subject: [PATCH 06/11] bubble-chamber: minor tidying --- extra/bubble-chamber/bubble-chamber.factor | 30 +++++----------------- 1 file changed, 7 insertions(+), 23 deletions(-) diff --git a/extra/bubble-chamber/bubble-chamber.factor b/extra/bubble-chamber/bubble-chamber.factor index b70c65c037..086faf4f23 100644 --- a/extra/bubble-chamber/bubble-chamber.factor +++ b/extra/bubble-chamber/bubble-chamber.factor @@ -1,34 +1,18 @@ -USING: accessors arrays calendar -combinators.cleave combinators.short-circuit -kernel locals math math.constants math.functions math.libm -math.order math.points math.vectors - namespaces -random sequences threads ui ui.gadgets ui.gestures ; - -USING: - - kernel - - syntax - - sequences - +USING: kernel syntax accessors sequences + arrays calendar + combinators.cleave combinators.short-circuit + locals math math.constants math.functions math.libm + math.order math.points math.vectors + namespaces random sequences threads ui ui.gadgets ui.gestures math.ranges - colors colors.gray - vars - multi-methods multi-method-syntax - processing.shapes - - frame-buffer - - ; + frame-buffer ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From 9b17f0a7f213cea6067d4c678a3eedb2fb8659be Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 15 Dec 2008 19:01:07 -0600 Subject: [PATCH 07/11] bubble-chamber: Rearrange the example configurations --- extra/bubble-chamber/bubble-chamber.factor | 35 +++++++++++----------- 1 file changed, 18 insertions(+), 17 deletions(-) diff --git a/extra/bubble-chamber/bubble-chamber.factor b/extra/bubble-chamber/bubble-chamber.factor index 086faf4f23..292ac7e59f 100644 --- a/extra/bubble-chamber/bubble-chamber.factor +++ b/extra/bubble-chamber/bubble-chamber.factor @@ -524,6 +524,24 @@ M:: update-frame-buffer ( BUBBLE-CHAMBER -- ) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +: hadron-chamber ( -- ) + bubble-chamber-window + 1000 [ hadron add-particle ] times + big-bang + drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Experimental +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: muon-chamber ( -- ) + bubble-chamber-window + 1000 [ muon add-particle ] times + dup particles>> [ collide randomize-collision-theta ] each + drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + : original-big-bang ( -- ) bubble-chamber { 1000 1000 } >>size @@ -541,22 +559,6 @@ M:: update-frame-buffer ( BUBBLE-CHAMBER -- ) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: hadron-chamber ( -- ) - bubble-chamber-window - 1000 [ hadron add-particle ] times - big-bang - drop ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: muon-chamber ( -- ) - bubble-chamber-window - 1000 [ muon add-particle ] times - dup particles>> [ collide randomize-collision-theta ] each - drop ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - : original-big-bang-variant ( -- ) bubble-chamber-window 1789 [ muon add-particle ] times @@ -565,4 +567,3 @@ M:: update-frame-buffer ( BUBBLE-CHAMBER -- ) 111 [ axion add-particle ] times dup particles>> [ collide randomize-collision-theta ] each drop ; - From 23330d7653793f13ad2e6e7508da4fae1c608c55 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 15 Dec 2008 19:02:46 -0600 Subject: [PATCH 08/11] Add runnable demo vocabulary 'bubble-chamber.ten-hadrons' --- extra/bubble-chamber/ten-hadrons/tags.txt | 1 + extra/bubble-chamber/ten-hadrons/ten-hadrons.factor | 8 ++++++++ 2 files changed, 9 insertions(+) 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/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..a29ecf8990 --- /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 \ No newline at end of file From 078988b5231131e8a64253745368630cec8106a6 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 15 Dec 2008 19:03:31 -0600 Subject: [PATCH 09/11] Add runnable demo vocabulary 'bubble-chamber.hadron-chamber' --- extra/bubble-chamber/hadron-chamber/hadron-chamber.factor | 8 ++++++++ extra/bubble-chamber/hadron-chamber/tags.txt | 1 + 2 files changed, 9 insertions(+) create mode 100644 extra/bubble-chamber/hadron-chamber/hadron-chamber.factor create mode 100644 extra/bubble-chamber/hadron-chamber/tags.txt 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..4046724b82 --- /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 \ No newline at end of file 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 From 5d20b0e202a3cf63d0e20d76dc7ab77fa5085be5 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 15 Dec 2008 19:03:55 -0600 Subject: [PATCH 10/11] Add runnable demo vocabulary 'bubble-chamber.original' --- extra/bubble-chamber/original/original.factor | 8 ++++++++ extra/bubble-chamber/original/tags.txt | 1 + 2 files changed, 9 insertions(+) create mode 100644 extra/bubble-chamber/original/original.factor create mode 100644 extra/bubble-chamber/original/tags.txt diff --git a/extra/bubble-chamber/original/original.factor b/extra/bubble-chamber/original/original.factor new file mode 100644 index 0000000000..4d1744eb64 --- /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 \ No newline at end of file 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 From 6098fb09cb01289a16fef81a92c8a0ee21417321 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 15 Dec 2008 19:28:34 -0600 Subject: [PATCH 11/11] bubble-chamber: Add comment giving credit to J Tarbell --- extra/bubble-chamber/bubble-chamber.factor | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/extra/bubble-chamber/bubble-chamber.factor b/extra/bubble-chamber/bubble-chamber.factor index 292ac7e59f..d88c53c99f 100644 --- a/extra/bubble-chamber/bubble-chamber.factor +++ b/extra/bubble-chamber/bubble-chamber.factor @@ -18,6 +18,14 @@ USING: kernel syntax accessors sequences 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) + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! processing ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!