\ parser
\
\ abstract, specification input parser class.
\
\ note: Although parser is a subclass of device, it can't be used as a
\ device (interpreter) since the element.on: and element.off: methods
\ have been redefined and serve a different function.
\
\
\ description of methods:
\
\	PUT.SHAPE:	( addr --  )
\	GET.SHAPE:	(  -- addr )
\
\	MANY:		(  -- n )
\	SET.MANY:	( n --  )
\
\	PUT.INSTRUMENT:	( addr --  )
\	GET.INSTRUMENT:	(  -- addr )
\
\	ELEMENT.ON:		(  --  )
\	ELEMENT.OFF:	(  --  )
\
\	ON:		( x y z... --  )
\	OFF:	( x y z... --  )
\
\	RAW.ON:		( x y z... --  )
\	RAW.OFF:	( x y z... --  )
\
\	TIME:	(  -- ticks )
\
\	PUT.TIME:	( ticks --  )
\	GET.TIME:	(  -- ticks )
\
\ the on and off functions overrides the RAW.ON: and RAW.OFF: methods, and
\ can be used to preprocess the data before it is added to the shape. The
\ functions have the following stack behavior:
\
\	function	( x y z... addr --  )
\
\ where x y z... are the data items passed to the parser, and the addr is the
\ address of the parser. Note that the time of the event is automatically
\ recorded into the shape by the parser.
\
\
\ Code: Han-earl Park
\ Copyright	2000 Buster & Friends C-ALTO Labs
\ (Valencia, July 1999 -
\ (Southampton, September 2000 -
\
\ MOD: HeP 07/08/99	Started project.
\ MOD: HeP 11/01/99	Redesign parser and input components.
\					Change name from ob.input to ob.parser.
\ MOD: HeP 03/09/00	Write the ON: and OFF: methods. Extensive error checking
\					since these methods use the return stack to reorganize
\					the data items.
\ MOD: HeP 03/10/00	Specify the stack behaviour of the on and of functions.
\ MOD: HeP 03/15/00	Add provisions for recording absolute or reletive time.
\ MOD: HeP 03/18/00	Change the number of dimensions of this specification
\					class from 4 to 2.
\					Fix error where instrument was closed without checking
\					if invalid address (i.e. 0).
\					Very basic testing completed.
\ MOD: HeP 04/04/00	Add the MANY: method.
\					Does not new: the assigned shape if the shape has the
\					required number of dimensions, and has at least the
\					max number of elements.
\					Tested subclass, mono.parser, with MIDI input.
\ MOD: HeP 04/17/00	Add the CURRENT-PARSER variable which stores the address
\					of the most recent parser. (Note: this is global variable
\					is set to zero when any parser is opened!)
\					Add the RAW.ON: and RAW.OFF: methods that will _not_ be
\					called if a user specified on/off function is available.
\					These methods can, however, be called from the on/off
\					functions.
\					Rename the GET.TIME: as TIME:
\					A _new_ GET.TIME: method returns the time of the most
\					recent event.
\ MOD: HeP 05/19/00	Users can specify how the parser deals with the end of
\					shape via the PUT.MODE: method.
\ MOD: HeP 09/25/00	Implement shift_mode operation in addition to wrap_mode.
\					Cleanup code and comments.
\ MOD: HeP 10/15/00	Increment current element _after_ sending ELEMENT.ON: or
\					ELEMENT.OFF: to the recipient object!
\ MOD: HeP 10/18/00 Fix incorrect stack change argument for exec.stack? in
\					the on and off functions.
\ MOD: HeP 10/23/00	Implement RESET: and ?PRESENT: methods.
\ MOD: HeP 10/24/00	RAW.OPEN: calls RESET: at end.
\ MOD: HeP 11/01/00	RAW.ON: and RAW.OFF: are called late bound! ELEMENT.ON:
\					and ELEMENT.OFF: are then called via early binding.
\					Test shift mode!
\ MOD: HeP 11/07/00	Default mode is shift mode.
\
\ ToDo: Check if reset: on RAW.CLOSE: is necessary...

include?  task-device  myt:device


anew task-parser


variable  current-parser


00  constant  parser_wrap_mode
01  constant  parser_shift_mode
02  constant  parser_incr_mode


method ?PRESENT:

method ON:				method OFF:
method RAW.ON:			method RAW.OFF:

method TIME:
method PUT.TIME:		method GET.TIME:

method PUT.SHAPE:		method GET.SHAPE:

method PUT.MODE:		method GET.MODE:

method WRAP.MODE:		method SHIFT.MODE:
method INCR.MODE:		method DEFAULT.MODE:


:class  OB.PARSER  <super  OB.DEVICE
	
	iv.long  iv-prsr-instr			\ recipeient interpreter
	
	iv.long  iv-prsr-shape			\ shape for data storage
	iv.byte  iv-prsr-shape-dynamic?
	iv.long  iv-prsr-shape-many
	iv.long  iv-prsr-current-elm
	
	iv.byte  iv-prsr-add-mode		\ data adding mode
	iv.long  iv-prsr-add-cfa		\ adding function
	
	iv.byte  iv-prsr-present?
	
	iv.long  iv-prsr-time
	iv.byte  iv-prsr-time-set?
	
	iv.byte  iv-prsr-time-absolute?
	
	
:m INIT:	(  --  )
	init: super
\
	0     iv=> iv-prsr-instr
	0     iv=> iv-prsr-shape
	2     iv=> iv-prsr-shape-many
	false iv=> iv-prsr-shape-dynamic?
\
	false iv=> iv-prsr-present?
	false iv=> iv-prsr-time-set?
;m

:m DEFAULT:	(  --  )
	default: super
\
	self  default.mode: []		\ late bound!
\
	iv-prsr-shape NOT
	IF	2  iv=> iv-prsr-shape-many
	THEN
\
	true  iv=> iv-prsr-time-absolute?
;m

:m RESET:	(  --  )
	false iv=> iv-prsr-present?
	false iv=> iv-prsr-time-set?
\
	iv-prsr-shape
	?dup
	IF	empty: []
		0  iv=> iv-prsr-current-elm
	THEN
;m


\ dimensions
\ subclasses should override this method as necessary

:m DIMENSION:	(  -- #dim , number of dimensions )
	2
;m

:m GET.DUR.DIM:	(  -- dim# , dimesion storing the time value )
	0
;m


\ input active?

:m ?PRESENT:	(  -- flag , true if input is currently active )
	iv-prsr-present?
;m


\ open and close

:m RAW.OPEN:	(  --  )
	0  current-parser !
\
	iv-prsr-shape		\ has shape been assigned?
	IF
		iv-prsr-shape dimension: []
		self dimension: []  =
		IF
			iv-prsr-shape max.elements: []
			self many: []  <
			IF
				iv-prsr-shape-many  self dimension: [] iv-prsr-shape NEW: []
			ELSE
				iv-prsr-shape max.elements: []  iv=> iv-prsr-shape-many
			THEN
		ELSE
			iv-prsr-shape-many  self dimension: [] iv-prsr-shape NEW: []
		THEN
	\
		false iv=> iv-prsr-shape-dynamic?
	ELSE
		INSTANTIATE ob.shape  iv=> iv-prsr-shape
		iv-prsr-shape-many  self dimension: [] iv-prsr-shape NEW: []
	\
		true  iv=> iv-prsr-shape-dynamic?
	THEN
\
	iv-prsr-instr
	IF	iv-prsr-instr open: []
	THEN
\
	self  reset: []
;m

:m RAW.CLOSE:	(  --  )
	iv-prsr-shape-dynamic?
	IF	iv-prsr-shape  free: []
		iv-prsr-shape  DEINSTANTIATE
		0     iv=> iv-prsr-shape
		false iv=> iv-prsr-shape-dynamic?
	THEN
\
	false iv=> iv-prsr-present?
	false iv=> iv-prsr-time-set?
\
	iv-prsr-instr
	IF	iv-prsr-instr  close: []
	THEN
\
\	self  reset: []		\ ***
;m


\ shape for data passing

:m PUT.SHAPE:	( addr --  , assign a data holder )
	iv-prsr-shape iv-prsr-shape-dynamic?  AND
	IF	iv-prsr-shape  free: []
		iv-prsr-shape  DEINSTANTIATE
	THEN
\
	      iv=> iv-prsr-shape
	false iv=> iv-prsr-shape-dynamic?
\
	0  iv=> iv-prsr-current-elm
;m

:m GET.SHAPE:	(  -- addr )
	iv-prsr-shape
;m


:m MANY:	(  -- n )
	iv-prsr-shape-many
;m

:m SET.MANY:	( n --  , set maximum elements stored )
	dup  2 <
	IF
		" set.many:"
		" parser's memory should not be set to less than 2 elements"
		er_warning
		ob.report.error
		drop
	ELSE
		iv-prsr-shape
		IF	dup  self dimension: []  iv-prsr-shape new: []
		THEN
		iv=> iv-prsr-shape-many
	THEN
;m

:m FREE:	(  --  )
	iv-prsr-shape
	IF	iv-prsr-shape free: []
	\
		iv-prsr-shape-dynamic?
		IF	iv-prsr-shape  DEINSTANTIATE
			false iv=> iv-prsr-shape-dynamic?
		THEN
	THEN
;m


\ instrument or recipient object

:m PUT.INSTRUMENT:	( addr --  , assign a device to send data to )
	iv=> iv-prsr-instr
;m

:m GET.INSTRUMENT:	(  -- addr )
	iv-prsr-instr
;m


\ call the recipient object
\
\ the parser class' element.on: and element.off: methods serve a different
\ function from the device and instrument's methods. Parsers use these
\ methods to call the corresponding methods of the recipient object (device,
\ instrument, etc).

:m ELEMENT.ON:	(  --  , send data to recipient object )
	iv-prsr-instr
	IF	iv-prsr-current-elm iv-prsr-shape	\  -- elm shape
		iv-prsr-instr element.on: []
	THEN
;m

:m ELEMENT.OFF:	(  --  , send data to recipient object )
	iv-prsr-instr
	IF	iv-prsr-current-elm iv-prsr-shape	\  -- elm shape
		iv-prsr-instr element.off: []
	THEN
;m


\ time of event

:m PUT.TIME:	( ticks --  , call this before each ON: or OFF: )
	iv=> iv-prsr-time
	true  iv=> iv-prsr-time-set?
;m

:m GET.TIME:	(  -- tick , most recently assigned time value )
	iv-prsr-time
;m


:m TIME:	(  -- ticks , called by the ON: or OFF: method )
	iv-prsr-time-set?
	IF
		iv-prsr-time		\ user specified time
	ELSE
		time@				\ hmsl system time
		dup iv=> iv-prsr-time
	THEN
;m


:m USE.RELATIVE.TIME:	(  --  , time between events )
	false iv=> iv-prsr-time-absolute?
;m

:m USE.ABSOLUTE.TIME:	(  --  , use raw time )
	true  iv=> iv-prsr-time-absolute?
;m


\ recording mode

: PRSR.WRAP.ELEMENT		(  --  , wrap around shape if at end )
	iv-prsr-current-elm
	iv-prsr-shape  max.elements: []
	mod
	iv=> iv-prsr-current-elm
;

: PRSR.SHIFT.ELEMENT	(  --  , shift elements if at end of shape )
	iv-prsr-current-elm
	iv-prsr-shape max.elements: [] =
	IF
		0  iv-prsr-shape remove: []
		-1 iv+> iv-prsr-current-elm
	THEN
;

: PRSR.INCR.ELEMENT		(  --  , dynamically allocate memory if at end )
	iv-prsr-current-elm
	iv-prsr-shape max.elements: [] =
	IF
		8  iv-prsr-shape extend: []
	THEN
;


:m WRAP.MODE:	(  --  )
	parser_wrap_mode     iv=> iv-prsr-add-mode
	'c prsr.wrap.element iv=> iv-prsr-add-cfa
;m

:m SHIFT.MODE:	(  --  )
	parser_shift_mode     iv=> iv-prsr-add-mode
	'c prsr.shift.element iv=> iv-prsr-add-cfa
;m

:m INCR.MODE:	(  --  )
	parser_incr_mode     iv=> iv-prsr-add-mode
	'c prsr.incr.element iv=> iv-prsr-add-cfa
;m


:m PUT.MODE:	( id --  )
	CASE
		parser_wrap_mode  OF  wrap.mode: self   ENDOF
		parser_shift_mode OF  shift.mode: self  ENDOF
		parser_incr_mode  OF  incr.mode: self   ENDOF
	\
		" put.mode:" " unrecognized mode selector" er_warning
		ob.report.error
	ENDCASE
;m

:m GET.MODE:	(  -- id )
	iv-prsr-add-mode
;m


:m DEFAULT.MODE:	(  --  )
	shift.mode: self
;m


\ on and off

: PRSR.NEXT.ELEMENT	(  --  )
	iv-prsr-add-cfa  ?execute
;

: PRSR.ADD.ELEMENT	( x y z... --  , add values and time to shape )
	iv-prsr-current-elm  iv-prsr-shape set.many: []
\
	self dimension: []  self get.dur.dim: [] 1+  -  0
	DO	>r
	LOOP
\
	self time: []
\
	self dimension: []  self get.dur.dim: [] 1+  -  0
	DO	r>
	LOOP
\
	iv-prsr-shape add: []	\ dur x y... --
;


:m RAW.ON:	( x y z... --  )
	prsr.next.element
	prsr.add.element
\
	element.on: self
\
	1  iv+> iv-prsr-current-elm		\ increment current!
;m

:m RAW.OFF:	( x y z... --  )
	prsr.next.element
	prsr.add.element
\
	element.off: self
\
	1  iv+> iv-prsr-current-elm		\ increment current!
;m


:m ON:	( x y z... --  )
	true  iv=> iv-prsr-present?
\
	depth  self dimension: [] 1- >=
	IF
		self  current-parser !
	\
		iv-dev-on-cfa
		IF
			self
			iv-dev-on-cfa
			self dimension: []  negate
			exec.stack?					\ x y z... addr --
		ELSE
			self  RAW.ON: []			\ x y z...      --
		THEN
	ELSE
		" on:"
		" not enough items on the stack for this parser's number of dimensions"
		er_fatal
		ob.report.error
	THEN
\
	false iv=> iv-prsr-time-set?	\ reset for next event
;m

:m OFF:	( x y z... --  )
	false iv=> iv-prsr-present?
\
	depth  self dimension: [] 1- >=
	IF
		self  current-parser !
	\
		iv-dev-off-cfa
		IF
			self
			iv-dev-off-cfa
			self dimension: []  negate
			exec.stack?					\ x y z... addr --
		ELSE
			self  RAW.OFF: []			\ x y z...      --
		THEN
	ELSE
		" off:"
		" not enough items on the stack for this parser's number of dimensions"
		er_fatal
		ob.report.error
	THEN
	false iv=> iv-prsr-time-set?	\ reset for next event
;m


\ print

: PRSR.PRINT.Y/N	( flag --  )
	IF	." Yes"  ELSE  ." No"
	THEN
;

:m PRINT:	(  --  )
	print: super
	." Recipient    = "  iv-prsr-instr  ob.name                       cr
	." Shape        = "  iv-prsr-shape  ob.name                       cr
	space ." Dynamic?    = "  iv-prsr-shape-dynamic? prsr.print.y/n   cr
	iv-prsr-shape
	IF	." ELMT\DIM " iv-prsr-shape dimension: [] 0  DO  i  8 .r  LOOP  cr
		iv-prsr-shape many: [] dup
		IF
			0
			DO	i  6 .r  4 spaces
				i  iv-prsr-shape print.element: [] cr
				?pause
			LOOP
		ELSE
			drop ."   No Data!!" cr
		THEN
	THEN
	space ." Many         = "  iv-prsr-shape-many   4 .r              cr
	space ." Current elm# = "  iv-prsr-current-elm  4 .r              cr
	space ." Dimensions   = "  self dimension: []   4 .r              cr
	space ." DUR dim#     = "  self get.dur.dim: [] 4 .r              cr
	space ." Mode#        = "  iv-prsr-add-mode     4 .r              cr
	space ." Mode Func    = "  iv-prsr-add-cfa      cfa.              cr
	." Time:"                                                         cr
	space ." Last Time    ="   iv-prsr-time         5 .r              cr
	space ." Absolute     = "  iv-prsr-time-absolute? prsr.print.y/n  cr
;m
	
;class


\ test

false .IF
	
	ob.parser  test-parser
	
	
	: PRSR.TEST.INIT	(  --  )
		open: test-parser
	;
	
	: PRSR.TEST.TERM	(  --  )
		close: test-parser
	;
	
	if.forgotten prsr.test.term
	
	
	: PRSR.TEST	(  --  )
		prsr.test.init
	\
		cr  print: test-parser
	\
		cr  ." Hit the Q key to quit..." cr cr
		BEGIN
			key
		\
			dup  cr  ." Character = " emit  cr
		\
			dup  on: test-parser
			print: test-parser
		\
			dup  ascii q =
			swap ascii Q = OR
		UNTIL
	\
		prsr.test.term
	\
		cr  print: test-parser  cr
	;
	
	cr cr  ." Enter PRSR.TEST to run a qwerty based parser test..."  cr cr
	
.THEN