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