\ 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