\ vl_patch
\
\ patch (or "preset") class for the yamaha vl70m.
\
\ Code: Han-earl Park
\ Copyright	2000 Buster & Friends C-ALTO Labs
\ (Valencia, October 1998 -
\ (Southampton, July 2000 -
\
\ MOD: HeP 29/10/98	Started project.
\ MOD: HeP 01/27/99	After the nth redesign, the current class is just a
\					"dumb" data holder that is passed via the PUT.PRESET:
\					method to the instrument. The alternative design of
\					using a list of all the presets would add complexity
\					and memory overheads.
\ MOD: HeP 02/02/99	Audio effects data automatically loads since this file
\					loads before task-vl_fx.
\					Change name to from ob.vl.preset to ob.vl.patch
\ MOD: HeP 04/02/99	Due to complication w/ conditional compilation, loads
\					after all the relevant classes.
\ MOD: HeP 07/30/99	No longer redefines USER.INIT etc.
\ MOD: HeP 11/12/99	Add vl.patch.init and vl.patch.term for use with
\					patch lists.
\ MOD: HeP 11/19/99	PUT.CONTROLLER.RANGE: and GET.CONTROLLER.RANGE: now
\					conform to the methods of the vl.instrument class.
\					Add the STUFF{ ... }STUFF: method.
\ MOD: HeP 07/09/00	PRINT: layout is more in line with the vl.instrument
\					class' method.
\ ToDo:	add some elaborate range/error checking since this class isn't
\		intended to operate "on the fly"

include?  task-midi_plus      myt:midi_plus
include?  task-gm_instrument  myt:gm_instrument
include?  task-gm_patch       myt:gm_patch
include?  task-vl_instrument  myt:vl_instrument


anew task-vl_patch


:class  OB.VL.PATCH  <super  OB.GM.PATCH
	
	iv.byte  iv-vlpt-bank#
	
	iv.byte  iv-vlpt-note-lo
	iv.byte  iv-vlpt-note-hi
	
	vl_#ctrl  iv.array  iv-vlpt-ctrl
	
	exists? task-vl_fx  .IF
		iv.byte  iv-vlpt-rev-type
		iv.byte  iv-vlpt-cho-type
		iv.byte  iv-vlpt-var-type
		iv.byte  iv-vlpt-dist-type
		
		iv.byte  iv-vlpt-rev-alg
		iv.byte  iv-vlpt-cho-alg
		iv.byte  iv-vlpt-var-alg
		iv.byte  iv-vlpt-dist-alg
	.THEN
	
	
	
:m INIT:	(  --  )
	init: super
\
	01  iv=> iv-vlpt-bank#
\
	vl_#ctrl 0
	DO	127  i  iv-vlpt-ctrl !
	LOOP
\
	[ exists? task-vl_fx  .IF ]
		vl_hall       iv=> iv-vlpt-rev-type
		vl_chorus     iv=> iv-vlpt-cho-type
		vl_delay_lcr  iv=> iv-vlpt-var-type
		vl_distortion iv=> iv-vlpt-dist-type
		00  iv=> iv-vlpt-rev-alg
		00  iv=> iv-vlpt-cho-alg
		00  iv=> iv-vlpt-var-alg
		00  iv=> iv-vlpt-dist-alg
	[ .THEN ]
;m



\ midi bank and preset number

:m PUT.BANK:	( bank# --  )
	dup  1 4  within?
	IF
		iv=> iv-vlpt-bank#
	ELSE
		" put.bank:" " bank number outside range of 1 to 4" er_warning
		ob.report.error
		drop
	THEN
;m

:m GET.BANK:	(  -- bank# )
	iv-vlpt-bank#
;m



:m PUT.BEND.RANGE:	( n --  )
	dup  0 12  within?
	IF
		put.bend.range: super
	ELSE
		" put.bend.range:"
		" the vl70m has a maximum pitch bend range of 12 semitones"
		er_warning  ob.report.error
		drop
	THEN
;m



:m PUT.CONTROL.RANGE:	( depth ctrl# --  )
	dup  vl.valid.ctrl?
	IF
		over  -127 127  within?
		IF
			iv-vlpt-ctrl !
		ELSE
			" put.control.range:" " range must be within -127 and +127" er_warning
			ob.report.error
			2drop
		THEN
	ELSE
		" put.control.range:" " unrecognized controller type" er_warning
		ob.report.error
		2drop
	THEN
;m

:m GET.CONTROL.RANGE:	( ctrl# -- depth )
	dup vl.valid.ctrl?
	IF
		iv-vlpt-ctrl @
	ELSE
		" get.control.range:" " unrecognized controller type" er_warning
		ob.report.error
		drop
	THEN
;m



exists? task-vl_fx  .IF
	
	:m PUT.REV.TYPE:	( type alg --  )
		iv=> iv-vlpt-rev-alg  iv=> iv-vlpt-rev-type
	;m
	
	:m PUT.CHO.TYPE:	( type alg --  )
		iv=> iv-vlpt-cho-alg  iv=> iv-vlpt-cho-type
	;m
	
	:m PUT.VAR.TYPE:	( type alg --  )
		iv=> iv-vlpt-var-alg  iv=> iv-vlpt-var-type
	;m
	
	:m PUT.DIST.TYPE:	( type alg --  )
		iv=> iv-vlpt-dist-alg  iv=> iv-vlpt-dist-type
	;m
	
	
	:m GET.REV.TYPE:	(  -- type alg )
		iv-vlpt-rev-type  iv-vlpt-rev-alg
	;m
	
	:m GET.CHO.TYPE:	(  -- type alg )
		iv-vlpt-cho-type  iv-vlpt-cho-alg
	;m
	
	:m GET.VAR.TYPE:	(  -- type alg )
		iv-vlpt-var-type  iv-vlpt-var-alg
	;m
	
	:m GET.DIST.TYPE:	(  -- type alg )
		iv-vlpt-dist-type  iv-vlpt-dist-alg
	;m
	
.THEN

	
:m PRINT:	(  --  )
	print: super
	." Bank#      = "  iv-vlpt-bank#    3 .r  cr
	." Control range:"  cr
	space ." pressure   = "  vl_pressure   iv-vlpt-ctrl @  5 .r
	tab   ." growl      = "  vl_growl      iv-vlpt-ctrl @  5 .r  cr
	space ." throat     = "  vl_throat     iv-vlpt-ctrl @  5 .r
	tab   ." scream     = "  vl_scream     iv-vlpt-ctrl @  5 .r  cr
	space ." embouchure = "  vl_embouchure iv-vlpt-ctrl @  5 .r
	tab   ." tonguing   = "  vl_tonguing   iv-vlpt-ctrl @  5 .r  cr
	space ." damping    = "  vl_damping    iv-vlpt-ctrl @  5 .r
	tab   ." absorption = "  vl_absorption iv-vlpt-ctrl @  5 .r  cr
\
	[ exists? task-vl_fx  .IF ]
		." Audio fx type:"  cr
		space ." reverb     =" iv-vlpt-rev-type  3 .r ."  Alg =" iv-vlpt-rev-alg  2 .r cr
		space ." chorus     =" iv-vlpt-cho-type  3 .r ."  Alg =" iv-vlpt-cho-alg  2 .r cr
		space ." variation  =" iv-vlpt-var-type  3 .r ."  Alg =" iv-vlpt-var-alg  2 .r cr
		space ." distortion =" iv-vlpt-dist-type 3 .r ."  Alg =" iv-vlpt-dist-alg 2 .r cr
	[ .THEN ]
;m


:m }STUFF:	( $ p# b# off lo hi pB pr gr thr scr emb tng dmp abs --  )
			(      ... revT revA choT choA varT varA distT distA --  )
			(      ... xxxX xxxX xxxX xxxX xxxX xxxX xxxxX xxxxX --  )
	stuff.depth
	dup 23 =  over 15 =  OR
	IF
		23 =
		IF
			[ exists? task-vl_fx  .IF ]
				put.dist.type: self
				put.var.type: self
				put.cho.type: self
				put.rev.type: self
			[ .ELSE ]
				8  xdrop
			[ .THEN ]
		THEN
	\
		vl_#ctrl 0
		DO	[ vl_#ctrl 1- ] literal i -  put.control.range: self
		LOOP
	\
		put.bend.range: self
		put.note.range: self
		put.offset: self
		put.bank: self
		put.preset: self
		put.title: self
	ELSE
		drop	\ don't need stuff.depth
	\
		" }stuff:"
		" wrong number of parameters passed (should be 15 or 23 values)"
		er_return  ob.report.error
	THEN
;m

;class



\ setup and clearup words for patch lists
\ these are used in the same way as user.init, user.term and user.reset

: VL.PATCH.RESET	(  --  )
;
: VL.PATCH.INIT		(  --  )
;
: VL.PATCH.TERM		(  --  )
;

if.forgotten  vl.patch.term