\ io
\
\ io_interp_table
\ tables used by the interpreter for the piece io.
\
\
\ see the file io_interp for the use of this component.
\
\ see the file io_top for more information on io itself.
\
\
\ constructor: Han-earl Park
\ copyright 2008 buster & friends' C-ALTO Labs
\
\ www.busterandfriends.com/io
\
\ (Edinburgh, November 1996 -
\ (London, August 1997 -
\ (Den Haag, October 1997 -
\ (Valencia, March 1999 -
\ (Southampton, May 2000 -
\ (Cork, April 2006 -
\
\ (Cork, October 2008 -
\
\	REV: 0.0.1 alpha   (Southampton, October  2000)
\	REV: 0.0.1 beta    (Southampton, November 2000)
\	REV: 0.0.1 alpha++ (Southampton, July 2004)
\	REV: 0.0.1 beta++  (Cork, May 2010)
\
\
\ MOD: HeP 10-26-08	Add the io_interp_table component.
\ MOD: HeP 11-04-08	Make the pitch tables 4 bytes wide because they need
\					to contain signed data.
\ MOD: HeP 11-05-08	Provisional test of the table lookup version of hp->midi
\					suggests that it is almost twice as fast as the old
\					version (12725 msec for 10,000,000 conversions in
\					comparison to 20413 msec).
\ MOD: HeP 11-06-08	Use !BYTES.
\ MOD: HeP 11-07-08	hp_ conversion words (e.g. HP->MIDI ) now reside in
\					io:mobules:io_interp_table.
\ MOD: HeP 11-08-08	Add words to be called from io_matrix.
\ MOD: HeP 11-09-08	Add tables for output pulse generator.
\					Initial (klugy) version of the exponential curve.
\ MOD: HeP 03-23-09	Only have 3000 cent range pitch tables.
\					Add "negative" versions of the linear mirror tables.
\ MOD: HeP 03-24-09	Move (MODIFY.INTERP) from modules:io_interp. See:
\					io_matrix.
\ REV: 0.0.1 b ++	__________________________________________________________
\					Version for performance at Blackrock Castle Observatory,
\					Cork, Ireland, May 25, 2010.
\ MOD: HeP 08-12-10	Add fast-pulse-group-table.
\ MOD: HeP 08-18-10	Add primary and secondary interpreters.
\
\
\ ToDo: *** ROTATED S-CURVE ***
\		*** PRIMARY AND SECONDARY CURVES ***
\
\		*** use of vel-table inconsistent with comments
\		    add HP->VEL ...?                            ***
\
\
\ ToDo:	Potential off-by-one problem with hp_range and hp_range/2. The range
\		of the particles are actually between -hp_range/2 and hp_range/2 - 1.
\		Watch out!
\		
\		Tested: hp_ is range -254 to +254!
\		
\ ToDo: Current BUILD.EXP.TABLE is clunky at best, the system should auto
\		scale itself according the range demanded of it.
\ ToDo:	Add guaussian distribution, and the 90 degree rotated version of the
\		s-curve.
\ ToDo: Can we have signed values stored, and retrived from, a byte or
\		word?
\ ToDo:	Can we SET.INLINE the new version of HP->MIDI without running afoul
\		addressing issues?

include?  task-graph_plus  myt:graph_plus


anew task-io_interp_table


\ address of the current tables

variable  ctrl-table-1		\ midi controller, primary
variable  ctrl-table-2		\ midi controller, secondary
variable  pan-table			\ pan control
variable  cent-table-1		\ pitch output, primary
variable  cent-table-2		\ pitch output, secondary

variable  vel-table			\ input midi velocity to hp_ coordinate

variable  pulse-table		\ ouput pulse duration
variable  pulse-group-table	\ output pulse grouping



\ table holders

ob.list  ctrl-table-list
ob.list  pan-table-list
ob.list  cent-table-list

ob.list  vel-table-list

ob.list  pulse-table-list
ob.list  pulse-group-table-list



\ lookup tables

\ for converting hp_ coordinates to midi range

create  linear-table             hp_range allot
create  linear-mirror-table      hp_range allot
create  linear-mirror-neg-table  hp_range allot

create  scurve-table             hp_range allot


\ converting to signed pitch ( in cents )

create  linear-cent-table             hp_range cell*  allot
create  linear-mirror-cent-table      hp_range cell*  allot
create  linear-mirror-neg-cent-table  hp_range cell*  allot

create  scurve-cent-table  hp_range cell*  allot


\ for converting input midi velocity to hp_

create  linear-vel-table  128 cell*  allot	\ could be 127, but just in case...
create  scurve-vel-table  128 cell*  allot


\ selecting output pulse duration
\
\ we don't need the full range of values here, and we'll assume that the
\ pulse value will not be larger than 16 bits

32  constant  pulse_table_size

create  linear-pulse-table  pulse_table_size 2*  allot
create  exp-pulse-table     pulse_table_size 2*  allot
create  expexp-pulse-table  pulse_table_size 2*  allot


\ selecting ouput pulse groupings
\
\ we don't need the full range of values here, and we'll assume that the
\ pulse value will not be larger than a byte

32  constant  pulse_group_table_size

create  linear-pulse-group-table  pulse_group_table_size  allot
create  exp-pulse-group-table     pulse_group_table_size  allot
create  expexp-pulse-group-table  pulse_group_table_size  allot
create  fast-pulse-group-table    pulse_group_table_size  allot	\ fast as possible



\ change tables

: RANDOM.CTRL.TABLE	(  --  )
	many: ctrl-table-list  choose
	get: ctrl-table-list  ctrl-table-1 !
\
	many: ctrl-table-list  choose
	get: ctrl-table-list  ctrl-table-2 !
;

: RANDOM.PAN.TABLE	(  --  )
	many: pan-table-list  choose
	get: pan-table-list  pan-table !
;

: RANDOM.CENT.TABLE	(  --  )
	many: cent-table-list  choose
	get: cent-table-list  cent-table-1 !
\
	many: cent-table-list  choose
	get: cent-table-list  cent-table-2 !
;

: RANDOM.VEL.TABLE	(  --  )
	many: vel-table-list  choose
	get: vel-table-list  vel-table !
;

: RANDOM.PULSE.TABLE	(  --  )
	many: pulse-table-list  choose
	get: pulse-table-list  pulse-table !
\
	many: pulse-group-table-list  choose
	get: pulse-group-table-list  pulse-group-table !
;

\ meta-alert-matrix function (see: io_matrix)

: (MODIFY.INTERP)	(  --  , change interp table )
	random.ctrl.table
	random.pan.table
	random.cent.table
	random.vel.table
\	random.pulse.table
;




\ conversion between hp_ and midi values

: HP->MIDI.1	( coord -- midi , convert hp_ coordinate to midi range )
	hp_range/2 +
	ctrl-table-1 @  +
	c@
;

: HP->MIDI.2	( coord -- midi , convert hp_ coordinate to midi range )
	hp_range/2 +
	ctrl-table-2 @  +
	c@
;

io_test? .IF
	
	variable min-hp	\ for testing purposes only!
	variable max-hp	\ for testing purposes only!
	
	0 min-hp !
	0 max-hp !
	
	: HP->MIDI.1	( coord -- midi , convert hp_ coordinate to midi range )
		dup  min-hp @ <
		IF
			dup min-hp !
		ELSE
			dup  max-hp @ >
			IF
				dup max-hp !
			THEN
		THEN
	\
		HP->MIDI.1
	;
	
.THEN

\ hp->pan wraps around so that max coord and min coord both map to 127

: HP->PAN	( coord -- pan , convert coordinate to midi pan )
	hp_range/2 +
	pan-table @  +
	c@
;


: HP->CENT.1	( coord -- cent , convert coordinate to pitch in cents )
	hp_range/2 +  cell*
	cent-table-1 @  +
	@
;

: HP->CENT.2	( coord -- cent , convert coordinate to pitch in cents )
	hp_range/2 +  cell*
	cent-table-2 @  +
	@
;


\ vel->hp does _not_ map to the full coord space

: VEL->HP	( vel -- coord , convert midi velocity to coordinate )
	cell*
	vel-table @ +
	@
;



\ output pulse

: CHOOSE.PULSE	(  -- dur , select new pulse value )
	pulse-table @
	pulse_table_size choose  2*  +
	w@
;

: CHOOSE.PULSE.GROUP	(  -- n , select new pulse multiplier )
	pulse-group-table @
	pulse_group_table_size choose  +
	c@
;



\ curves

\ linear function
\
\ y = x
\

: BUILD.LINEAR.TABLE	{ initial range #items cell_size array_addr --  }
	range   float
	#items  float  f/		\  -f- increment
\
	initial float			\  -f- increment initial
\
	#items 0
	DO
		fover  i float  f*	\  -f- increment initial dy
		fover  f+			\  -f- increment initial y
	\
		fix  array_addr  i cell_size *  +
	\
		cell_size  !bytes	\ value address size --
	LOOP
\
	fdrop fdrop				\  -f-
;

: BUILD.LINEAR.MIRROR.TABLE	{ initial range #items cell_size array_addr --  }
\
\ build the first half...
\
	initial range  #items 2/  cell_size  array_addr  build.linear.table
\
\ and the second...
\
	initial  range +
	initial  over -
	#items  2/
	cell_size
	over cell_size *  array_addr +
	build.linear.table
;

: BUILD.LINEAR.TABLES	(  --  )
	>newline ." building linear tables"
\
\
\	  min range    #items  size  array_addr
\
	0			\ initial
	127			\ range
	hp_range	\ #items
	1			\ cell size
	linear-table  build.linear.table
\
	-1500		\ initial
	3000		\ range
	hp_range	\ #items
	cell		\ cell size
	linear-cent-table  build.linear.table
\
	hp_range/2 negate
	hp_range
	128
	cell
	linear-vel-table  build.linear.table
\
	io_min_pulse			\ initial
	io_max_pulse			\ range
	pulse_table_size		\ #items
	2						\ cell size
	linear-pulse-table  build.linear.table
\
	0						\ initial
	12						\ range
	pulse_group_table_size	\ #items
	1						\ cell size
	linear-pulse-group-table  build.linear.table
\
\
	0			\ initial
	127			\ range
	hp_range	\ #items
	1			\ cell size
	linear-mirror-table  build.linear.mirror.table
\
	-1500		\ initial
	3000		\ range
	hp_range	\ #items
	cell		\ cell size
	linear-mirror-cent-table  build.linear.mirror.table
\
\
	127			\ initial
	-127		\ range
	hp_range	\ #items
	1			\ cell size
	linear-mirror-neg-table  build.linear.mirror.table
\
	1500		\ initial
	-3000		\ range
	hp_range	\ #items
	cell		\ cell size
	linear-mirror-neg-cent-table  build.linear.mirror.table
;



\ s-curve (aka the sigmoid function)
\
\ y = 1 / (1 + exp(-x))
\

: SCURVE	( x -f- y , calculate s-curve )
	fnegate  fexp
	1 float  f+
	1 float  fswap f/
;

: -SCURVE	( x -f- y , calculate s-curve )
	1 float  fswap f/
	-1 float  f+
	fln
;

: BUILD.SCURVE.TABLE	{ initial range slope #items cell_size array_addr --  }
	initial float			\  -f- initial
	range   float			\  -f- initial range
\
	#items float
	slope  float  fover f/	\  -f- initial range #items scale
\
	fswap 2 float f/		\  -f- initial range scale offset
\
	#items 0
	DO
		i float  fover f-	\  -f- ... x-offset
		2 fpick  f*			\  -f- ... x-offset*scale
		scurve				\  -f- ... y
		3 fpick  f*			\  -f- ... y*range
		4 fpick  f+			\  -f- ... y*range+initial
		fix
	\
		array_addr  i cell_size *  +
	\
		cell_size  !bytes	\ value address size --
	LOOP
\
	fdrop fdrop fdrop fdrop	\  -f-
;

: BUILD.SCURVE.TABLES	(  --  )
	>newline ." building s-curve tables"
\
\
\	  min range slope    #items  size  array_addr
\
	    0   127    10  hp_range     1  scurve-table       build.scurve.table
\
	-1500  3000    10  hp_range  cell  scurve-cent-table  build.scurve.table
\
	hp_range/2 negate
	   hp_range    10       128  cell  scurve-vel-table   build.scurve.table

;



\ guassian
\
\ y = exp( -x^2 )
\

\ hyperbolic sine
\
\ y = sinh(x) =  (exp(x) - exp(-x)) / 2
\

\ hyperbolic tangent
\
\ y = tanh(x) = sinh(x) / cosh(x)
\             = (exp(x) - exp(-x)) / (exp(x) + exp(-x))
\             = (exp(2x) - 1) / (exp(2x) + 1)
\



\ exponential
\
\ y = exp(x)
\

: BUILD.EXP.TABLE	{ initial range slope #items cell_size array_addr --  }
	#items 0
	DO
		i float				\  -f- x
		
		slope float  f*
		range float  f/		\  -f- x_scaled
		
		fexp				\  -f- exp(x)
		initial float  f+	\  -f- exp(x)+offset
	\
		fix  array_addr  i cell_size *  +
	\
		cell_size  !bytes	\ value address size --
	LOOP
;

: BUILD.EXP.TABLES	(  --  )
	>newline ." building exponential tables"
\
	io_min_pulse			\ initial
	io_max_pulse			\ range
	75						\ slope
	pulse_table_size		\ #items
	2						\ cell size
	exp-pulse-table  build.exp.table
\
	0						\ initial
	12						\ range
	1						\ slope
	pulse_group_table_size	\ #items
	1						\ cell size
	exp-pulse-group-table  build.exp.table
;


 
\ exponential exponential
\
\ y = exp( exp(x) )
\

\ damped sine
\
\ y = sine(x) / x
\



\ fast as possible!
\
\ y = 1

: BUILD.FAST.TABLES	(  --  )
	>newline ." building 'fast as possible' table"
\
	pulse_group_table_size  0
	DO
		1
		fast-pulse-group-table  i +
		c!
	LOOP
;



: BUILD.INTERP.TABLES	(  --  )
	fpinit
\
	build.linear.tables
	build.scurve.tables
	build.exp.tables
	build.fast.tables
;



\ table lists

: BUILD.INTERP.TABLE.LISTS	(  --  )
	stuff{
		linear-table
		linear-mirror-table  linear-mirror-neg-table
		scurve-table
	}stuff: ctrl-table-list
\
	stuff{
		linear-table
		linear-mirror-table  linear-mirror-neg-table
		scurve-table
	}stuff: pan-table-list
\
	stuff{
		linear-cent-table
		linear-mirror-cent-table  linear-mirror-neg-cent-table
		scurve-cent-table
	}stuff: cent-table-list
\
	stuff{
		linear-vel-table
		scurve-vel-table
	}stuff: vel-table-list
\
	stuff{
		linear-pulse-table
		exp-pulse-table
	}stuff: pulse-table-list
\
	[ io_4gel? .IF ]
	\
		stuff{
			fast-pulse-group-table
		}stuff: pulse-group-table-list
	\
	[ .ELSE ]
	\
		stuff{
			linear-pulse-group-table
			exp-pulse-group-table
			fast-pulse-group-table
		}stuff: pulse-group-table-list
	\
	[ .THEN ]
;



\ setup & clearup
\
\ note that these get called from io.init and io.term
\

: IO.INTERP.TABLE.INIT	(  --  )
	test" IO.INTERP.TABLE.INIT"
\
	build.interp.tables
	build.interp.table.lists
\
	linear-table  ctrl-table-1 !
	linear-table  ctrl-table-2 !
	linear-table  pan-table !
\
	scurve-cent-table  cent-table-1 !
	scurve-cent-table  cent-table-2 !
\
	linear-vel-table vel-table !
\
	exp-pulse-table       pulse-table !
	exp-pulse-group-table pulse-group-table !
;

: IO.INTERP.TABLE.TERM	(  --  )
	test" IO.INTERP.TABLE.TERM"
\
	free: ctrl-table-list
	free: pan-table-list
	free: cent-table-list
	free: vel-table-list
	free: pulse-table-list
;

if.forgotten  io.interp.table.term



\ test

true .IF
	
	8  constant  iit_y_scale
	
	3000 iit_y_scale /  constant  iit_window_height
	
	
	: DRAW.TABLES	(  --  )
		hmsl-window @ 0=
		IF	HMSL-NewWindow window.defaults
		\
			40  dup  hmsl-newwindow .. wt_rect ..! rect_top
			 4  dup  hmsl-newwindow .. wt_rect ..! rect_left
			hp_range +           hmsl-newwindow .. wt_rect ..! rect_right
			iit_window_height +  hmsl-newwindow .. wt_rect ..! rect_bottom
		\
			" Interp Tables"  HMSL-NewWindow ..! wt_title
		\
			HMSL-NewWindow gr.openwindow dup hmsl-window !
			dup
			IF	gr.set.curwindow
 				0  TextFont()
			ELSE 
				drop  ." Could not open window!" cr abort
			THEN
		THEN
		hmsl-window @ SelectWindow()
	\
		128 0
		DO
			gr.color@
			4  gr.color!
		\	i  linear-vel-table over cell* + @  hp_range/2 + 2/  gr.dot
		\	i  scurve-vel-table over cell* + @  hp_range/2 + 2/  gr.dot
			gr.color!
		LOOP
	\
		pulse_table_size 0
		DO
			gr.color@
			1  gr.color!
			many: pulse-table-list  0
			DO
				j
				i get: pulse-table-list  over 2* +  w@  2/
				gr.dot
			LOOP
			gr.color!
		LOOP
	\
		pulse_group_table_size 0
		DO
			gr.color@
			1  gr.color!
			many: pulse-group-table-list  0
			DO
				j
				i get: pulse-group-table-list  over +  c@
				gr.dot
			LOOP
			
			gr.color!
		LOOP
	\
		hp_range  0
		DO
			gr.color@
			2  gr.color!
			many: cent-table-list  0
			DO
				j
				i get: cent-table-list  over cell* +  @  1500 +  iit_y_scale /
				gr.dot
			LOOP
			gr.color!
		\
			many: ctrl-table-list  0
			DO
				j
				i get: ctrl-table-list  over +  c@
				gr.dot
			LOOP
		LOOP
	\
		BEGIN
			?closebox
		UNTIL
		hmsl.close
	;
	
	
	ob.gm.instrument  iit-instr
	
	75 put.offset: iit-instr
	
	: (PLAY.TABLE)	{  | dx x --  }
		8  -> dx
		hp_range/2  negate  -> x
	\
		open: iit-instr
	\
		BEGIN
			x  hp->cent.1  100  4  tone.on.for: iit-instr
		\
			2 delay
		\
			x dx +  -> x
		\
			x hp_range/2 > 
		UNTIL
	\
		4 delay
	\
		close: iit-instr
	;
	
	: PLAY.TABLE	(  --  )
		many: cent-table-list  0
		DO
			i get: cent-table-list  cent-table-1 !
			(play.table)
		LOOP
	;
	
	
	>newline cr
	." enter IO.INTERP.TABLE.INIT..." cr
	." enter DRAW.TABLES to see tables, PLAY.TABLE to hear them."
	cr cr
	
.THEN