\ 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  <super  OB.JOB
	
	iv.long  iv-prtpl-particle-addr
	iv.long  iv-prtpl-particle#
	iv.long  iv-prtpl-element#
	
	iv.long  iv-prtpl-dur-dim
    iv.long  iv-prtpl-dur-cfa
	
	
:m INIT:	(  --  )
	init: super
\
	 0  iv=> 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