\ ob.particle.player
\
\ hp_particle_player
\ class of morph designed to schedule the interpretation of particles.
\ Although it is a subclass of the job class, it is functionally closer
\ to the player class in that particle.player decides when to send
\ the particle (the "shape" data) to the instrument to be interpreted.
\ Part of the collection of software componenets: "henri poincare."
\
\ Based on ideas presented by Joel Ryan.
\
\ Code: Han-earl Park
\ Copyright 2000 Buster & Friends C-ALTO Labs
\ (Den haag, December 1997 -
\ (Valencia, October 1998 -
\ (Southampton, October 2000 -
\
\ MOD: HeP 11/05/99 Added particle.player class.
\ After a confusing attempt at subclassing the player
\ class, change to subclassing the job class.
\ MOD: HeP 11/06/99 Tested preliminary version.
\ MOD: HeP 11/08/99 Fixed put.dur.function: method.
\ MOD: HeP 11/30/99 Add DURATION: method in order to avoid the duration
\ function calling the GET.DURATION: method (which it
\ may need to). GET.DURATION: now acts the same way as
\ the job's method.
\ MOD: HeP 10/09/00 Use iv-jb-duration to store the current duration. The
\ value returned by GET.ON.TIME: is then based on
\ iv-jb-duration. This prevents problems that arise if
\ the duration function returns a different value at
\ different times. See implementation of PRTPL.EXEC.STUFF
include? task-hp_util myt:hp_util
include? task-hp_particle myt:hp_particle
include? task-hp_force myt:hp_force
include? task-hp_space myt:hp_space
anew task-hp_particle_player
method DURATION:
:class OB.PARTICLE.PLAYER iv-prtpl-particle-addr
-1 iv=> iv-prtpl-particle#
-1 iv=> iv-prtpl-element#
\
-1 iv=> iv-prtpl-dur-dim
0 iv=> iv-prtpl-dur-cfa
;m
:m WHERE: ( -- elm# prt# , last one played )
iv-prtpl-element# iv-prtpl-particle#
;m
:m GOTO: ( elm# prt# -- , jump to different particle )
1- iv=> iv-prtpl-particle#
1- iv=> iv-prtpl-element#
;m
:m NEXT: ( -- elm# prt# , next particle to be played )
-1
iv-prtpl-particle# 1+ dup many: self + swap
DO
drop \ drop value from prev time around loop
i many: self MOD \ wrap around
dup get: self \ address of particle
dup
IF
many: [] \ memory allocated?
IF
LEAVE
ELSE
drop
-1
THEN
ELSE
2drop
-1
THEN
LOOP
\
dup 0>=
IF
dup get: self get.active.elm: []
ELSE
hp_position
THEN
\
swap
;m
\ duration
:m DURATION: ( -- ticks )
iv-prtpl-dur-cfa
IF
iv-prtpl-element# iv-prtpl-particle-addr iv-prtpl-dur-cfa
-1 exec.stack?
ELSE
iv-jb-duration
THEN
;m
:m PUT.DUR.FUNCTION: ( cfa -- )
iv=> iv-prtpl-dur-cfa
;m
:m GET.DUR.FUNCTION: ( -- cfa )
iv-prtpl-dur-cfa
;m
\ on time
:m GET.ON.TIME: ( -- ticks )
iv-jb-duration
;m
\ execution
:m UPDATE: ( -- )
get.instrument: self dup
IF
iv-prtpl-element# iv-prtpl-particle-addr rot
element.on: []
ELSE
drop ." No instrument!"
THEN
;m
: PRTPL.EXEC.STUFF ( -- , call parent task: method )
jb.in.time? \ is it too late?
IF \ -- done? default_dur self
self next: [] \ late bound!
\
dup 0>=
IF
iv=> iv-prtpl-particle#
iv=> iv-prtpl-element#
\
iv-prtpl-particle# get: self
iv=> iv-prtpl-particle-addr
\
self duration: [] iv=> iv-jb-duration \ late bound!
\
self get.on.time: [] -> on.time \ late bound!
self update: [] \ late bound!
ELSE
2drop ." No particle or particle data!"
THEN
THEN
iv-jb-duration jb.set.delay
;
:m TASK: ( -- , check if time )
iv-time-next doitnow?
IF
iv-col-done?
IF
col.do.repeat iv-repcount 0=
IF
iv-time-next self terminate: []
ELSE
false iv=> iv-col-done?
iv-time-next doitnow? \ in case of repeat delay
IF
PRTPL.EXEC.STUFF
THEN
THEN
ELSE
PRTPL.EXEC.STUFF
THEN
THEN
;m
\ print
:m PRINT.ELEMENT: ( e# -- )
at: self ob.name
;m
:m PRINT: ( -- )
print: super ?pause
\
." Forces = " iv-space-force ob.name cr
;m
;class
\ test
false .IF
include? task-hp_gravity myt:hp_gravity
ob.particle p-1
ob.particle p-2
ob.gravity f-1
ob.space s-1
ob.particle.player pl-1
ob.instrument i-1
: PPL.INTERP { elm# prt instr -- }
cr
." Particle: " prt ob.name tab
dimension: prt 0
DO
elm# i ed.at: prt 4 .r
LOOP
cr
;
: PPL.TEST.INIT ( -- )
3 new: p-1
3 new: p-2
500 put.mass: p-1
300 put.mass: p-2
\
3 new: f-1
\
2 new: s-1
p-1 add: s-1
p-2 add: s-1
f-1 put.force: s-1
randomize: s-1
\
2 new: pl-1
p-1 add: pl-1
p-2 add: pl-1
i-1 put.instrument: pl-1
'c ppl.interp put.on.function: i-1
\
2 new: coll-p-1
pl-1 add: coll-p-1
s-1 add: coll-p-1
;
: PPL.TEST.TERM ( -- )
free.hierarchy: coll-p-1
;
if.forgotten ppl.test.term
: PPL.TEST ( -- )
ppl.test.init coll-p-1 hmsl.play ppl.test.term
;
cr ." Enter PPL.TEST to test the particle.player class." cr cr
.THEN