\ fan_out
\
\ fan.out class which "fans out" element.on: and element.off: methods
\ to multiple recipient objects.
\
\ For example, a single player may call more than one instrument
\ (interpreter) via a fan.out object. In practice any class that
\ implements the element.on: and element.off, and/or open: and close:
\ methods may be called via this class.
\
\ Code: Han-earl Park
\ Copyright	2000 Buster & Friends C-ALTO Labs
\ (Valencia, October 1999 -
\ (Southampton, June 2000 -
\
\ MOD: HeP 10/31/99	Started project.
\ MOD: HeP 11/02/99	Tested.
\ MOD: HeP 11/08/99	Seems to be an error that involves the fan.out object
\					being sent a CLOSE: message one too many times. Thus
\					remove the corresponding error warning.
\ MOD: HeP 03/29/00	FREE: may cause problems with standard hmsl morphs.
\					Sending a FREE.HIERARCHY: message to a morph will FREE:
\					the instrument, but in the case of the fan.out class,
\					this will not be echoed to the recipient devices. Thus,
\					FREE: now calls FREEALL: before freeing memory.
\ MOD: HeP 06/22/00	Check if elemement is non-zero before sending an OPEN:
\					CLOSE: or FREE: message.
\ MOD: HeP 10/10/00	Check if fan.out was assigned as its own instrument.
\ MOD: HeP 11/03/00	Prints message on OPEN: and CLOSE: if if-debug is on.


anew task-fan_out


:class  OB.FAN.OUT  <super  OB.OBJLIST
	
	iv.long  iv-fout-#opened
	
	
:m INIT:	(  --  )
	init: super
	0 iv=> iv-fout-#opened
;m


: FAN.OUT.OPEN	(  --  )
	many: self
	?dup
	IF	0
		DO	i get: self
			?dup
			IF	open: []
			THEN
		LOOP
		iv-fout-#opened 1+  iv=> iv-fout-#opened
	THEN
;

: FAN.OUT.CLOSE	(  --  )
	many: self
	?dup
	IF	0
		DO	i get: self
			?dup
			IF	close: []
			THEN
		LOOP
		iv-fout-#opened 1-  iv=> iv-fout-#opened
	THEN
;


:m OPEN:	(  --  )
	if-debug @
	IF
		>newline ." FAN.OUT -- open:" space name: self space ascii [ emit
		fan.out.open  space ascii ] emit
	ELSE
		fan.out.open
	THEN
;m

:m CLOSE:	(  --  )
	if-debug @
	IF
		>newline ." FAN.OUT -- close:" space name: self space ascii [ emit
		fan.out.close  space ascii ] emit
	ELSE
		fan.out.close
	THEN
;m

 
:m ELEMENT.ON:	( elm# sh --  )
	many: self  dup
	IF	0
		DO	2dup  i get: self  element.on: []
		LOOP
		2drop
	ELSE
		3drop
	THEN
;m

:m ELEMENT.OFF:	( elm# sh --  )
	many: self  dup
	IF	0
		DO	2dup  i get: self  element.off: []
		LOOP
		2drop
	ELSE
		3drop
	THEN
;m


\ additional pass thru methods

:m PUT.MUTE:	( flag --  )
	many: self  dup
	IF	0
		DO	dup  i get: self  put.mute: []
		LOOP
		drop
	ELSE
		2drop
	THEN
;m

:m ALL.OFF:	(  --  )
	many: self  0
	DO	i get: self  all.off: []
	LOOP
;m


:m FREEALL:	(  --  , close and free all elements )
	many: self  0
	DO	i get: self
		?dup
		IF	iv-fout-#opened
			IF	dup close: []
			THEN
			free: []
		THEN
	LOOP
\
	0  iv=> iv-fout-#opened
;m


\ memory allocation

:m NEW:		(  --  )
	new: super
	0  iv=> iv-fout-#opened
;m

:m FREE:	(  --  )
	freeall: self
	free: super
;m


:m PRINT:	(  --  )
	print: super
	." # Times Opened = "  iv-fout-#opened  3 .r
;m


\ redefine std methods

: FOUT.REPORT.ERROR	( $ --  )
	" attempted to assign fan.out to itself"  er_return  ob.report.error
;

:m ADD:	( addr --  )
	dup  self =
	IF
		drop
		" add:"  FOUT.REPORT.ERROR
	ELSE
		add: super
	THEN
;m

:m PUT:	( addr elm# --  )
	dup  self =
	IF
		2drop
		" put:"  FOUT.REPORT.ERROR
	ELSE
		put: super
	THEN
;m

:m INSERT:	( addr elm# --  )
	dup  self =
	IF
		2drop
		" insert:"  FOUT.REPORT.ERROR
	ELSE
		insert: super
	THEN
;m

:m }STUFF:	( addr... --  )
	false
	stuff.depth  0
	DO	i pick  self =
		IF	drop true
			LEAVE
		THEN
	LOOP
	IF
		stuff.depth  xdrop
		" }stuff:"  FOUT.REPORT.ERROR
	ELSE
		}stuff: super
	THEN
;m

;class



\ test

false .IF
	
	ob.fan.out  test-fout
	
	: TEST.FOUT.REP.FUNC	{ player | instr --  }
		get.instrument: player
		4 choose  swap get: []  -> instr
		32 choose
		IF
			get.offset: instr  1 choose+/- +  put.offset: instr
		ELSE
			get.offset: instr
			dup  put.offset: ins-midi-1
			dup  put.offset: ins-midi-2
			dup  put.offset: ins-midi-3
			     put.offset: ins-midi-4
		THEN
	;
	
	
	: TEST.FOUT.INIT	(  --  )
		prefab: shape-1
		1 new: player-1
		1000 put.repeat: player-1
		shape-1 test-fout  build: player-1
	\
		'c test.fout.rep.func  put.repeat.function: player-1
	\
		4 new: test-fout
		ins-midi-1  add: test-fout
		ins-midi-2  add: test-fout
		ins-midi-3  add: test-fout
		ins-midi-4  add: test-fout
	\
		36  put.offset: ins-midi-1
		36  put.offset: ins-midi-2
		36  put.offset: ins-midi-3
		36  put.offset: ins-midi-4
		1  put.channel: ins-midi-1
		2  put.channel: ins-midi-2
		3  put.channel: ins-midi-3
		4  put.channel: ins-midi-4
	;
	
	: TEST.FOUT.TERM	(  --  )
		free: shape-1
		free: player-1
		free: test-fout
	;
	
	if.forgotten  test.fout.term
	
	
	: TEST.FOUT	(  --  )
		test.fout.init  player-1 hmsl.play  test.fout.term
	;
	
	cr cr
	." Enter TEST.FOUT to run a silly test."
	cr cr
	
.THEN