unmaintained/bubble-chamber/particle/particle.factor

   1
   2 USING: kernel sequences combinators
   3        math math.vectors math.functions multi-methods
   4        accessors combinators.cleave processing
   5        bubble-chamber.common colors ;
   6
   7 IN: bubble-chamber.particle
   8
   9 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  10
  11 GENERIC: collide ( particle -- )
  12 GENERIC: move    ( particle -- )
  13
  14 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  15
  16 TUPLE: particle pos vel speed speed-d theta theta-d theta-dd myc mya ;
  17
  18 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  19
  20 : initialize-particle ( particle -- particle )
  21
  22   0 0 {2} >>pos
  23   0 0 {2} >>vel
  24
  25   0 >>speed
  26   0 >>speed-d
  27   0 >>theta
  28   0 >>theta-d
  29   0 >>theta-dd
  30
  31   0 0 0 1 rgba boa >>myc
  32   0 0 0 1 rgba boa >>mya ;
  33
  34 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  35
  36 : move-by ( obj delta -- obj ) over pos>> v+ >>pos ;
  37
  38 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  39
  40 : theta-dd-small? ( par limit -- par ? ) >r dup theta-dd>> abs r> < ;
  41
  42 : random-theta-dd  ( par a b -- par ) 2random >>theta-dd ;
  43
  44 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  45
  46 : turn ( particle -- particle )
  47   dup
  48     [ speed>> ] [ theta>> { sin cos } <arr> ] bi n*v
  49   >>vel ;
  50
  51 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  52
  53 : step-theta     ( p -- p ) [ ] [ theta>>   ] [ theta-d>>  ] tri + >>theta   ;
  54 : step-theta-d   ( p -- p ) [ ] [ theta-d>> ] [ theta-dd>> ] tri + >>theta-d ;
  55 : step-speed-sub ( p -- p ) [ ] [ speed>>   ] [ speed-d>>  ] tri - >>speed   ;
  56 : step-speed-mul ( p -- p ) [ ] [ speed>>   ] [ speed-d>>  ] tri * >>speed   ;
  57
  58 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  59
  60 : x ( particle -- x ) pos>> first  ;
  61 : y ( particle -- x ) pos>> second ;
  62
  63 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  64
  65 : out-of-bounds? ( particle -- particle ? )
  66   dup
  67   { [ x dim neg < ] [ x dim 2 * > ] [ y dim neg < ] [ y dim 2 * > ] } cleave
  68   or or or ;