extra/bubble-chamber/bubble-chamber.factor

   1
   2 USING: kernel syntax accessors sequences
   3        arrays calendar
   4        combinators.cleave combinators.short-circuit
   5        locals math math.constants math.functions math.libm
   6        math.order math.points math.vectors
   7        namespaces random sequences threads ui ui.gadgets ui.gestures
   8        math.ranges
   9        colors
  10        colors.gray
  11        vars
  12        multi-methods
  13        multi-method-syntax
  14        processing.shapes
  15        frame-buffer ;
  16
  17 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  18
  19 IN: bubble-chamber
  20
  21 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  22
  23 ! This is a Factor implementation of an art piece by Jared Tarbell:
  24 !
  25 !   http://complexification.net/gallery/machines/bubblechamber/
  26 !
  27 ! Jared's version is written in Processing (Java)
  28
  29 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  30 ! processing
  31 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  32
  33 : 2random ( a b -- num ) 2dup swap - 100 / <range> random ;
  34
  35 : 1random ( b -- num ) 0 swap 2random ;
  36
  37 : at-fraction ( seq fraction -- val ) over length 1- * swap nth ;
  38
  39 : at-fraction-of ( fraction seq -- val ) swap at-fraction ;
  40
  41 : mouse ( -- point ) hand-loc get ;
  42
  43 : mouse-x ( -- x ) mouse first  ;
  44 : mouse-y ( -- y ) mouse second ;
  45
  46 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  47 ! bubble-chamber.particle
  48 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  49
  50 GENERIC: collide ( particle -- )
  51 GENERIC: move    ( particle -- )
  52
  53 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  54
  55 TUPLE: particle
  56   bubble-chamber pos vel speed speed-d theta theta-d theta-dd myc mya ;
  57
  58 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  59
  60 : initialize-particle ( particle -- particle )
  61
  62   0 0 {2} >>pos
  63   0 0 {2} >>vel
  64
  65   0 >>speed
  66   0 >>speed-d
  67   0 >>theta
  68   0 >>theta-d
  69   0 >>theta-dd
  70
  71   0 0 0 1 rgba boa >>myc
  72   0 0 0 1 rgba boa >>mya ;
  73
  74 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  75
  76 : center ( particle -- point ) bubble-chamber>> size>> 2 v/n ;
  77
  78 DEFER: collision-theta
  79
  80 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  81
  82 : move-by ( obj delta -- obj ) over pos>> v+ >>pos ;
  83
  84 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  85
  86 : theta-dd-small? ( par limit -- par ? ) [ dup theta-dd>> abs ] dip < ;
  87
  88 : random-theta-dd  ( par a b -- par ) 2random >>theta-dd ;
  89
  90 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  91
  92 : turn ( particle -- particle )
  93   dup
  94     [ speed>> ] [ theta>> { sin cos } <arr> ] bi n*v
  95   >>vel ;
  96
  97 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  98
  99 : step-theta     ( p -- p ) [ ] [ theta>>   ] [ theta-d>>  ] tri + >>theta   ;
 100 : step-theta-d   ( p -- p ) [ ] [ theta-d>> ] [ theta-dd>> ] tri + >>theta-d ;
 101 : step-speed-sub ( p -- p ) [ ] [ speed>>   ] [ speed-d>>  ] tri - >>speed   ;
 102 : step-speed-mul ( p -- p ) [ ] [ speed>>   ] [ speed-d>>  ] tri * >>speed   ;
 103
 104 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 105
 106 :: out-of-bounds? ( PARTICLE -- ? )
 107   [let | X      [ PARTICLE pos>> first                    ]
 108          Y      [ PARTICLE pos>> second                   ]
 109          WIDTH  [ PARTICLE bubble-chamber>> size>> first  ]
 110          HEIGHT [ PARTICLE bubble-chamber>> size>> second ] |
 111
 112     [let | LEFT   [ WIDTH  neg ]
 113            RIGHT  [ WIDTH  2 * ]
 114            BOTTOM [ HEIGHT neg ]
 115            TOP    [ HEIGHT 2 * ] |
 116
 117       { [ X LEFT < ] [ X RIGHT > ] [ Y BOTTOM < ] [ Y TOP > ] } 0|| ] ] ;
 118
 119 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 120 ! bubble-chamber.particle.axion
 121 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 122
 123 TUPLE: <axion> < particle ;
 124
 125 : axion ( -- <axion> ) <axion> new initialize-particle ;
 126
 127 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 128
 129 METHOD: collide ( <axion> -- )
 130
 131   dup center          >>pos
 132   2 pi *      1random >>theta
 133   1.0   6.0   2random >>speed
 134   0.998 1.000 2random >>speed-d
 135   0                   >>theta-d
 136   0                   >>theta-dd
 137
 138   [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] [ ] while
 139
 140   drop ;
 141
 142 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 143
 144 : dy>alpha ( dy -- alpha ) neg 6 * 30 + 255.0 / ;
 145
 146 ! : axion-white ( dy -- dy ) dup 1 swap dy>alpha {2} \ stroke-color set ;
 147 ! : axion-black ( dy -- dy ) dup 0 swap dy>alpha {2} \ stroke-color set ;
 148
 149 : axion-white ( dy -- dy ) dup 1 swap dy>alpha gray boa \ stroke-color set ;
 150 : axion-black ( dy -- dy ) dup 0 swap dy>alpha gray boa \ stroke-color set ;
 151
 152 : axion-point- ( particle dy -- particle ) [ dup pos>> ] dip v-y point ;
 153 : axion-point+ ( particle dy -- particle ) [ dup pos>> ] dip v+y point ;
 154
 155 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 156
 157 METHOD: move ( <axion> -- )
 158
 159   T{ gray f 0.06 0.59 } \ stroke-color set
 160   dup pos>>  point
 161
 162   1 4 [a,b] [ axion-white axion-point- ] each
 163   1 4 [a,b] [ axion-black axion-point+ ] each
 164
 165   dup vel>> move-by
 166
 167   turn
 168
 169   step-theta
 170   step-theta-d
 171   step-speed-mul
 172
 173   [ ] [ speed-d>> 0.9999 * ] bi >>speed-d
 174
 175   1000 random 996 >
 176     [
 177       dup speed>>   neg     >>speed
 178       dup speed-d>> neg 2 + >>speed-d
 179
 180       100 random 30 > [ collide ] [ drop ] if
 181     ]
 182     [ drop ]
 183   if ;
 184
 185 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 186 ! bubble-chamber.particle.hadron
 187 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 188
 189 TUPLE: <hadron> < particle ;
 190
 191 : hadron ( -- <hadron> ) <hadron> new initialize-particle ;
 192
 193 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 194
 195 METHOD: collide ( <hadron> -- )
 196
 197   dup center          >>pos
 198   2 pi *      1random >>theta
 199   0.5   3.5   2random >>speed
 200   0.996 1.001 2random >>speed-d
 201   0                   >>theta-d
 202   0                   >>theta-dd
 203
 204   [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] [ ] while
 205
 206   0 1 0 1 rgba boa >>myc
 207
 208   drop ;
 209
 210 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 211
 212 METHOD: move ( <hadron> -- )
 213
 214   T{ gray f 1 0.11 } \ stroke-color set  dup pos>> 1 v-y point
 215   T{ gray f 0 0.11 } \ stroke-color set  dup pos>> 1 v+y point
 216
 217   dup vel>> move-by
 218
 219   turn
 220
 221   step-theta
 222   step-theta-d
 223   step-speed-mul
 224
 225   1000 random 997 >
 226     [
 227       1.0     >>speed-d
 228       0.00001 >>theta-dd
 229
 230       100 random 70 > [ dup collide ] when
 231     ]
 232   when
 233
 234   dup out-of-bounds? [ collide ] [ drop ] if ;
 235
 236 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 237 ! bubble-chamber.particle.muon.colors
 238 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 239
 240 : good-colors ( -- seq )
 241   {
 242     T{ rgba f 0.23 0.14 0.17 1 }
 243     T{ rgba f 0.23 0.14 0.15 1 }
 244     T{ rgba f 0.21 0.14 0.15 1 }
 245     T{ rgba f 0.51 0.39 0.33 1 }
 246     T{ rgba f 0.49 0.33 0.20 1 }
 247     T{ rgba f 0.55 0.45 0.32 1 }
 248     T{ rgba f 0.69 0.63 0.51 1 }
 249     T{ rgba f 0.64 0.39 0.18 1 }
 250     T{ rgba f 0.73 0.42 0.20 1 }
 251     T{ rgba f 0.71 0.45 0.29 1 }
 252     T{ rgba f 0.79 0.45 0.22 1 }
 253     T{ rgba f 0.82 0.56 0.34 1 }
 254     T{ rgba f 0.88 0.72 0.49 1 }
 255     T{ rgba f 0.85 0.69 0.40 1 }
 256     T{ rgba f 0.96 0.92 0.75 1 }
 257     T{ rgba f 0.99 0.98 0.87 1 }
 258     T{ rgba f 0.85 0.82 0.69 1 }
 259     T{ rgba f 0.99 0.98 0.87 1 }
 260     T{ rgba f 0.82 0.82 0.79 1 }
 261     T{ rgba f 0.65 0.69 0.67 1 }
 262     T{ rgba f 0.53 0.60 0.55 1 }
 263     T{ rgba f 0.57 0.53 0.68 1 }
 264     T{ rgba f 0.47 0.42 0.56 1 }
 265   } ;
 266
 267 : anti-colors ( -- seq ) good-colors <reversed> ;
 268
 269 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 270
 271 : color-fraction ( particle -- particle fraction ) dup theta>> pi + 2 pi * / ;
 272
 273 : set-good-color ( particle -- particle )
 274   color-fraction dup 0 1 between?
 275     [ good-colors at-fraction-of >>myc ]
 276     [ drop ]
 277   if ;
 278
 279 : set-anti-color ( particle -- particle )
 280   color-fraction dup 0 1 between?
 281     [ anti-colors at-fraction-of >>mya ]
 282     [ drop ]
 283   if ;
 284
 285 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 286 ! bubble-chamber.particle.muon
 287 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 288
 289 TUPLE: <muon> < particle ;
 290
 291 : muon ( -- <muon> ) <muon> new initialize-particle ;
 292
 293 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 294
 295 METHOD: collide ( <muon> -- )
 296
 297   dup center           >>pos
 298   2 32 [a,b] random    >>speed
 299   0.0001 0.001 2random >>speed-d
 300
 301   dup collision-theta  -0.1 0.1 2random + >>theta
 302   0                                    >>theta-d
 303   0                                    >>theta-dd
 304
 305   [ 0.001 theta-dd-small? ] [ -0.1 0.1 random-theta-dd ] [ ] while
 306
 307   set-good-color
 308   set-anti-color
 309
 310   drop ;
 311
 312 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 313
 314 METHOD: move ( <muon> -- )
 315
 316   [let | MUON [ ] |
 317
 318     [let | WIDTH [ MUON bubble-chamber>> size>> first ] |
 319
 320       MUON
 321
 322       dup myc>> 0.16 >>alpha \ stroke-color set
 323       dup pos>> point
 324
 325       dup mya>> 0.16 >>alpha \ stroke-color set
 326       dup pos>> first2 [ WIDTH swap - ] dip 2array point
 327
 328       dup
 329       [ speed>> ] [ theta>> { sin cos } <arr> ] bi n*v
 330       move-by
 331
 332       step-theta
 333       step-theta-d
 334       step-speed-sub
 335
 336       dup out-of-bounds? [ collide ] [ drop ] if ] ] ;
 337
 338 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 339 ! bubble-chamber.particle.quark
 340 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 341
 342 TUPLE: <quark> < particle ;
 343
 344 : quark ( -- <quark> ) <quark> new initialize-particle ;
 345
 346 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 347
 348 METHOD: collide ( <quark> -- )
 349
 350   dup center                             >>pos
 351   dup collision-theta -0.11 0.11 2random +  >>theta
 352   0.5 3.0 2random                        >>speed
 353
 354   0.996 1.001 2random                    >>speed-d
 355   0                                      >>theta-d
 356   0                                      >>theta-dd
 357
 358   [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] [ ] while
 359
 360   drop ;
 361
 362 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 363
 364 METHOD: move ( <quark> -- )
 365
 366   [let | QUARK [ ] |
 367
 368     [let | WIDTH [ QUARK bubble-chamber>> size>> first ] |
 369
 370       QUARK
 371
 372       dup myc>> 0.13 >>alpha \ stroke-color set
 373       dup pos>>              point
 374
 375       dup pos>> first2 [ WIDTH swap - ] dip 2array point
 376
 377       [ ] [ vel>> ] bi move-by
 378
 379       turn
 380
 381       step-theta
 382       step-theta-d
 383       step-speed-mul
 384
 385       1000 random 997 >
 386       [
 387       dup speed>> neg    >>speed
 388       2 over speed-d>> - >>speed-d
 389       ]
 390       when
 391
 392       dup out-of-bounds? [ collide ] [ drop ] if ] ] ;
 393
 394 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 395
 396 USE: syntax ! Switch back to non-multi-method 'TUPLE:' syntax
 397
 398 TUPLE: <bubble-chamber> < <frame-buffer>
 399   paused particles collision-theta size ;
 400
 401 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 402
 403 ! : randomize-collision-theta ( bubble-chamber -- bubble-chamber )
 404 !   0  2 pi *  0.001  <range>  random >>collision-theta ;
 405
 406 : randomize-collision-theta ( bubble-chamber -- bubble-chamber )
 407   pi neg  pi  0.001 <range> random >>collision-theta ;
 408
 409 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 410
 411 : collision-theta ( particle -- theta ) bubble-chamber>> collision-theta>> ;
 412
 413 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 414
 415 M: <bubble-chamber> pref-dim* ( gadget -- dim ) size>> ;
 416
 417 M: <bubble-chamber> ungraft* ( <bubble-chamber> -- ) t >>paused drop ;
 418
 419 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 420
 421 : iterate-particle ( particle -- ) move ;
 422
 423 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 424
 425 M:: <bubble-chamber> update-frame-buffer ( BUBBLE-CHAMBER -- )
 426
 427   BUBBLE-CHAMBER particles>> [ iterate-particle ] each ;
 428
 429 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 430
 431 : iterate-system ( <bubble-chamber> -- ) drop ;
 432
 433 :: start-bubble-chamber-thread ( GADGET -- )
 434   GADGET f >>paused drop
 435   [
 436     [
 437       GADGET paused>>
 438         [ f ]
 439         [ GADGET iterate-system GADGET relayout-1 1 milliseconds sleep t ]
 440       if
 441     ]
 442     loop
 443   ]
 444   in-thread ;
 445
 446 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 447
 448 : bubble-chamber ( -- <bubble-chamber> )
 449   <bubble-chamber> new-gadget
 450     { 1000 1000 } >>size
 451     randomize-collision-theta ;
 452
 453 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 454
 455 : bubble-chamber-window ( -- <bubble-chamber> )
 456   bubble-chamber
 457     dup start-bubble-chamber-thread
 458     dup "Bubble Chamber" open-window ;
 459
 460 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 461
 462 :: add-particle ( BUBBLE-CHAMBER PARTICLE -- bubble-chamber )
 463
 464   PARTICLE BUBBLE-CHAMBER >>bubble-chamber drop
 465
 466   BUBBLE-CHAMBER  BUBBLE-CHAMBER particles>> PARTICLE suffix  >>particles ;
 467
 468 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 469
 470 :: mouse->collision-theta ( BUBBLE-CHAMBER -- BUBBLE-CHAMBER )
 471   mouse
 472   BUBBLE-CHAMBER size>> 2 v/n
 473   v-
 474   first2
 475   fatan2
 476   BUBBLE-CHAMBER (>>collision-theta)
 477   BUBBLE-CHAMBER ;
 478
 479 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 480
 481 :: mouse-pressed ( BUBBLE-CHAMBER -- )
 482
 483   BUBBLE-CHAMBER mouse->collision-theta drop
 484
 485   11
 486   [
 487     BUBBLE-CHAMBER particles>> [ <hadron>? ] filter random [ collide ] when*
 488     BUBBLE-CHAMBER particles>> [ <quark>?  ] filter random [ collide ] when*
 489     BUBBLE-CHAMBER particles>> [ <muon>?   ] filter random [ collide ] when*
 490   ]
 491   times ;
 492
 493 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 494
 495 <bubble-chamber> H{ { T{ button-down } [ mouse-pressed ] } } set-gestures
 496
 497 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 498
 499 : collide-random-particle ( bubble-chamber -- bubble-chamber )
 500   dup particles>> random collide ;
 501
 502 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 503
 504 : big-bang ( bubble-chamber -- bubble-chamber )
 505   dup particles>> [ collide ] each ;
 506
 507 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 508
 509 : collide-one-of-each ( bubble-chamber -- bubble-chamber )
 510   dup
 511   particles>>
 512   [ [ <muon>?   ] filter random collide ]
 513   [ [ <quark>?  ] filter random collide ]
 514   [ [ <hadron>? ] filter random collide ]
 515   tri ;
 516
 517 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 518 ! Some initial configurations
 519 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 520
 521 : ten-hadrons ( -- )
 522   bubble-chamber-window
 523   10 [ drop hadron add-particle ] each
 524   drop ;
 525
 526 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 527
 528 : original ( -- )
 529
 530   bubble-chamber-window
 531
 532     1789 [ muon   add-particle ] times
 533     1300 [ quark  add-particle ] times
 534     1000 [ hadron add-particle ] times
 535      111 [ axion  add-particle ] times
 536
 537     particles>>
 538     [ [ <muon>?   ] filter random collide ]
 539     [ [ <quark>?  ] filter random collide ]
 540     [ [ <hadron>? ] filter random collide ]
 541     tri ;
 542
 543 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 544
 545 : hadron-chamber ( -- )
 546   bubble-chamber-window
 547   1000 [ hadron add-particle ] times
 548   big-bang
 549   drop ;
 550
 551 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 552
 553 : quark-chamber ( -- )
 554   bubble-chamber-window
 555   100 [ quark add-particle ] times
 556   big-bang
 557   drop ;
 558
 559 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 560
 561 : small ( -- )
 562   <bubble-chamber> new-gadget
 563     { 200 200 } >>size
 564     randomize-collision-theta
 565     dup start-bubble-chamber-thread
 566     dup "Bubble Chamber" open-window
 567
 568     42 [ muon   add-particle ] times
 569     30 [ quark  add-particle ] times
 570     21 [ hadron add-particle ] times
 571      7 [ axion  add-particle ] times
 572
 573     collide-one-of-each
 574
 575   drop ;
 576
 577 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 578
 579 : medium ( -- )
 580   <bubble-chamber> new-gadget
 581     { 400 400 } >>size
 582     randomize-collision-theta
 583     dup start-bubble-chamber-thread
 584     dup "Bubble Chamber" open-window
 585
 586     100 [ muon   add-particle ] times
 587      81 [ quark  add-particle ] times
 588      60 [ hadron add-particle ] times
 589       9 [ axion  add-particle ] times
 590
 591     collide-one-of-each
 592
 593   drop ;
 594
 595 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 596
 597 : large ( -- )
 598   <bubble-chamber> new-gadget
 599     { 600 600 } >>size
 600     randomize-collision-theta
 601     dup start-bubble-chamber-thread
 602     dup "Bubble Chamber" open-window
 603
 604     550 [ muon   add-particle ] times
 605     339 [ quark  add-particle ] times
 606     100 [ hadron add-particle ] times
 607      11 [ axion  add-particle ] times
 608
 609     collide-one-of-each
 610
 611   drop ;
 612
 613 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 614 ! Experimental
 615 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 616
 617 : muon-chamber ( -- )
 618   bubble-chamber-window
 619   1000 [ muon add-particle ] times
 620   dup particles>> [ collide randomize-collision-theta ] each
 621   drop ;
 622
 623 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 624
 625 : original-big-bang ( -- )
 626   bubble-chamber
 627     { 1000 1000 } >>size
 628     dup start-bubble-chamber-thread
 629     dup "Bubble Chamber" open-window
 630
 631   1789 [ muon   add-particle ] times
 632   1300 [ quark  add-particle ] times
 633   1000 [ hadron add-particle ] times
 634    111 [ axion  add-particle ] times
 635
 636   big-bang
 637
 638   drop ;
 639
 640 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 641
 642 : original-big-bang-variant ( -- )
 643   bubble-chamber-window
 644   1789 [ muon   add-particle ] times
 645   1300 [ quark  add-particle ] times
 646   1000 [ hadron add-particle ] times
 647    111 [ axion  add-particle ] times
 648   dup particles>> [ collide randomize-collision-theta ] each
 649   drop ;
 650
 651 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 652