From 469470347b6f3692544c0ecb53c483a96708a230 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 8 Apr 2008 02:27:43 -0500 Subject: [PATCH] bubble-chamber: use inheritance for the particles --- .../bubble-chamber/bubble-chamber.factor | 92 ++++++++----------- 1 file changed, 38 insertions(+), 54 deletions(-) diff --git a/extra/processing/gallery/bubble-chamber/bubble-chamber.factor b/extra/processing/gallery/bubble-chamber/bubble-chamber.factor index c6e000e74f..5d128d5102 100644 --- a/extra/processing/gallery/bubble-chamber/bubble-chamber.factor +++ b/extra/processing/gallery/bubble-chamber/bubble-chamber.factor @@ -25,12 +25,6 @@ IN: processing.gallery.bubble-chamber ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: 2random ( a b -- num ) 2dup swap - 100 / random ; - -: 1random ( b -- num ) 0 swap 2random ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - : move-by ( obj delta -- obj ) over pos>> v+ >>pos ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -103,23 +97,34 @@ VARS: particles muons quarks hadrons axions ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +TUPLE: particle 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 >>myc + 0 0 0 1 >>mya ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + GENERIC: collide ( particle -- ) GENERIC: move ( particle -- ) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -TUPLE: muon pos speed theta speed-d theta-d theta-dd myc mya ; +TUPLE: muon < particle ; -: ( -- muon ) - muon construct-empty - 0 0 2array >>pos - 0 >>speed - 0 >>speed-d - 0 >>theta - 0 >>theta-d - 0 >>theta-dd - 0 0 0 1 >>myc - 0 0 0 1 >>mya ; +: ( -- muon ) muon construct-empty initialize-particle ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -177,18 +182,9 @@ METHOD: move { muon } ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -TUPLE: quark pos vel speed theta speed-d theta-d theta-dd myc ; +TUPLE: quark < particle ; -: ( -- quark ) - quark construct-empty - 0 0 2array >>pos - 0 0 2array >>vel - 0 >>speed - 0 >>speed-d - 0 >>theta - 0 >>theta-d - 0 >>theta-dd - 0 0 0 1 >>myc ; +: ( -- quark ) quark construct-empty initialize-particle ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -228,7 +224,8 @@ METHOD: move { quark } [ ] [ theta-d>> ] [ theta-dd>> ] tri + >>theta-d [ ] [ speed>> ] [ speed-d>> ] tri * >>speed - 1000 random 997 > + ! 1000 random 997 > + 3/1000 chance [ dup speed>> neg >>speed 2 over speed-d>> - >>speed-d @@ -242,18 +239,9 @@ METHOD: move { quark } ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -TUPLE: hadron pos vel speed theta speed-d theta-d theta-dd myc ; +TUPLE: hadron < particle ; -: ( -- hadron ) - hadron construct-empty - 0 0 2array >>pos - 0 0 2array >>vel - 0 >>speed - 0 >>speed-d - 0 >>theta - 0 >>theta-d - 0 >>theta-dd - 0 0 0 1 >>myc ; +: ( -- hadron ) hadron construct-empty initialize-particle ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -296,12 +284,14 @@ METHOD: move { hadron } [ ] [ theta-d>> ] [ theta-dd>> ] tri + >>theta-d [ ] [ speed>> ] [ speed-d>> ] tri * >>speed - 1000 random 997 > + ! 1000 random 997 > + 3/1000 chance [ 1.0 >>speed-d 0.00001 >>theta-dd - 100 random 70 > + ! 100 random 70 > + 30/100 chance [ dim 2 / dup 2array >>pos dup collide @@ -317,17 +307,9 @@ METHOD: move { hadron } ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -TUPLE: axion pos vel speed theta speed-d theta-d theta-dd ; +TUPLE: axion < particle ; -: ( -- axion ) - axion construct-empty - 0 0 2array >>pos - 0 0 2array >>vel - 0 >>speed - 0 >>speed-d - 0 >>theta - 0 >>theta-d - 0 >>theta-dd ; +: ( -- axion ) axion construct-empty initialize-particle ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -381,12 +363,14 @@ METHOD: move { axion } [ ] [ speed-d>> 0.9999 * ] bi >>speed-d - 1000 random 996 > + ! 1000 random 996 > + 4/1000 chance [ dup speed>> neg >>speed dup speed-d>> neg 2 + >>speed-d - 100 random 30 > + ! 100 random 30 > + 70/100 chance [ dim 2 / dup 2array >>pos collide