: red-blue.pat assemble-particles [""] red-blue.hex.pat file>cam restore-particles xvds ; press Q "red-blue pattern" \ \ : surf.pat \ assemble-surf-12 \ [""] surf.hex.pat file>cam \ restore-surf-12 xvds \ ; press S "surf pattern" : x-mom-blue (s -- mom ) b3 field count-bits/field b0 field count-bits/field - 2* b2 field count-bits/field b4 field count-bits/field + b1 field count-bits/field b5 field count-bits/field + - + ; : x-mom-red (s -- mom ) r3 field count-bits/field r0 field count-bits/field - 2* r2 field count-bits/field r4 field count-bits/field + r1 field count-bits/field r5 field count-bits/field + - + ; : y-mom-blue (s -- mom ) b2 field count-bits/field b1 field count-bits/field + b4 field count-bits/field b5 field count-bits/field + - ; : y-mom-red (s -- mom ) r2 field count-bits/field r1 field count-bits/field + r4 field count-bits/field r5 field count-bits/field + - ; : blue-mass (s -- mass ) b0 field count-bits/field b1 field count-bits/field + b2 field count-bits/field b3 field count-bits/field + b4 field count-bits/field b5 field count-bits/field + + + ; : red-mass (s -- mass ) r0 field count-bits/field r1 field count-bits/field + r2 field count-bits/field r3 field count-bits/field + r4 field count-bits/field r5 field count-bits/field + + + ; surfactant_12 assume-field-order : count-surf-rule s0 -> n0 s1 -> n1 s2 -> n2 s3 -> n3 s4 -> n4 s5 -> n5 ; create-lut count-surf.tab ?rule>table count-surf-rule count-surf.tab 0 activate-subcell : x-mom-surf (s -- mom ) n3 field count-bits/field n0 field count-bits/field - 2* n2 field count-bits/field n4 field count-bits/field + n1 field count-bits/field n5 field count-bits/field + - + ; : y-mom-surf (s -- mom ) n2 field count-bits/field n1 field count-bits/field + n4 field count-bits/field n5 field count-bits/field + - ; : surf-mass (s -- mass ) n0 field count-bits/field n1 field count-bits/field + n2 field count-bits/field n3 field count-bits/field + n4 field count-bits/field n5 field count-bits/field + + + ; : Counts force-zero-subcell assemble-particles *count* restore-particles red_blue_particles assume-field-order cr ." Red mass: " red-mass 8 .r ." Xmom*2:" x-mom-red 8 .r ." Ymom: " y-mom-red 8 .r cr ." Blue mass: " blue-mass 8 .r ." Xmom*2:" x-mom-blue 8 .r ." Ymom: " y-mom-blue 8 .r cr red-mass blue-mass + x-mom-red x-mom-blue + y-mom-red y-mom-blue + ( m x y ) assemble-surf-12 lut-data count-surf.tab switch-luts *count-lut* restore-surf-12 surfactant_12 assume-field-order ." Surf mass: " surf-mass 8 .r ." Xmom*2:" x-mom-surf 8 .r ." Ymom: " y-mom-surf 8 .r cr ." Total mass:" rot surf-mass + 8 .r ." Xmom*2:" swap x-mom-surf + 8 .r ." Ymom: " y-mom-surf + 8 .r cr 0 activate-subcell restore-active-subcell ; press C "Show counts" : Watch-subcell0 ['] noop is before-display ['] noop is after-display show-state ; press W "Watch just subcell zero" : Display.0314 ['] assemble-surf-0314 is before-display ['] restore-surf-0314 is after-display ['] display-0314-table ['] display-table copy-buffer colormap 0314-map show-function ; press Z "Display 0314 surfactant" : Display.surfactant ['] assemble-surf-12 is before-display ['] restore-surf-12 is after-display ['] display-surf-table ['] display-table copy-buffer colormap surf-map show-function ; press D "Display surfactant" \ : 0314.pat \ assemble-surf-0314 \ [""] surf.hex.pat file>cam \ restore-surf-0314 xvds \ ; press H "surf pattern" : Display.particles ['] assemble-particles is before-display ['] restore-particles is after-display ['] display-particles-table ['] display-table copy-buffer colormap particle-map show-function ; press P "Display particles" Display.particles 0 5 == blue-particles 6 11 == red-particles 0 5 == surf-particles variable red% 50 red% ! variable blue% 50 blue% ! variable surf% 50 surf% ! variable svalue svalue off h# 3f constant surf-mask : set-surf-value svalue =arg 0 2 do i activate-subcell begin-line-io X 2/ Y 2/ read-point surf-mask or surf-mask xor svalue @ dup 3 << or or X 2/ Y 2/ write-point end-line-io step -1 +loop xvds ; press V "set surf value at midpoint" : rand-surf surf% =arg 0 2 do i activate-subcell surf-particles field surf% @ 100 /random>field site-src site kick surf-particles field start/field #bits/field bounds ?do i nn field random x random y loop run step -1 +loop xvds ; press S "rand surf pattern" : rand-blue blue% =arg assemble-particles blue-particles field blue% @ 100 /random>field site-src site kick blue-particles field start/field #bits/field bounds ?do i nn field random x random y loop run step restore-particles xvds ; press B "rand blue pattern" : rand-red red% =arg assemble-particles red-particles field red% @ 100 /random>field site-src site kick red-particles field start/field #bits/field bounds ?do i nn field random x random y loop run step restore-particles xvds ; press R "rand red pattern" : erase-all-subcells xvds 0 2 do i activate-subcell site-src 0 fix kick run step -1 +loop xvds ; press U "Erase all subcells."