!
! DEMO72.bas - AM72 & MOUSE Demo Program
!		Works with 480 line or 350 line monitors
!

PROGRAM	DEMO72,1.0

++INCLUDE	AMGSYM.BSI
++INCLUDE	FILES.MAP

MAP1	GCB			, X,56000
MAP1	DSP'MAX			, F,  6, 100
MAP1	DSP'ARRAY
	MAP2	DSP'COUNT	, B,  2
	MAP2	DSP'XY(100)
		MAP3	DSP'X	, B,  2
		MAP3	DSP'Y	, B,  2

MAP1	POINT'MAX		, F,  6, 100
MAP1	POINT'ARRAY
	MAP2	POINT'COUNT	, B,  2
	MAP2	POINTS(100)
		MAP3	POINT'X	, B,  2
		MAP3	POINT'Y	, B,  2

MAP1	MAX'ZONES		, F,  6, 20
MAP1	ZONES(20)
	MAP2	ZONES'X(2)	, F,  6
	MAP2	ZONES'Y(2)	, F,  6

MAP1	TEXT'X(20)		, F,  6
MAP1	TEXT'Y(20)		, F,  6
		
MAP1	STATUS			, F,  6	!Status retruned from AMIGOS calls
MAP1	TEXT$			, S, 80
MAP1	FIL'STAT		, S,  3	! FILE STATUS
MAP1	LEVEL			, F,  6
MAP1	INDEX			, F,  6
MAP1	ICONS			, F,  6
MAP1	COMMAND			, S,100	! CHAINING COMMAND
MAP1	CRLF			, S,  2	! CARRIAGE RETURN & LINE FEED FOR COMMAND
MAP1	DO'FILE			, S, 16	! COMMAND FILE USED IN MEM0:
MAP1	IPF'FILE		, S, 16	! CONFIG. FILE FOR LEVEL POSITIONING
MAP1	FILES(20)
	MAP2	 F'LEVEL       , X,   2	!  Level:
	MAP2	 F'DESC        , X,  30	!  Description:
	MAP2	 F'TYPE        , S,   1	!  Type:
	MAP2	 F'CMND'2      , S,  30	!  Command Line 2
	MAP2	 F'CMND'1      , S,  30	!  Command Line 1
	MAP2	 F'CMND'3      , S,  30	!  Command Line 3
	MAP2	 F'CMND'4      , S,  30	!  Command Line 4
	MAP2	 F'CMND'5      , S,  30	!  Command Line 5
	MAP2	 F'CMND'6      , S,  30	!  Command Line 6
	MAP2	 F'NEW'LEVEL   , B,   1	!  New Level

! FOR XCALL "TRMCHR"
MAP1	TRMCHR'MAP
	MAP2	TRMCHR'FLAGS	, F,  6
	MAP2	TRMCHR'ROWS	, F,  6
	MAP2	TRMCHR'COLS	, F,  6
	MAP2	TRMCHR'COLORS	, F,  6
	MAP2	TRMCHR'FORE	, F,  6
	MAP2	TRMCHR'BACK	, F,  6
	MAP2	TRMCHR'WINROW	, F,  6
	MAP2	TRMCHR'WINCOL	, F,  6


!***********************************************!
DEMO72:
!	ON ERROR GOTO ERROR'ROUTINE
	SIGNIFICANCE	11
	XCALL	TRMCHR, STATUS,TRMCHR'MAP
	PRINT	TAB(-2,1);	TAB(-3,0);

	LEVEL	= 1

	DO'FILE	= "MEM0:DEMO72.DO"

	PRINT	TAB(-1,0);
	CRLF	= CHR(13) + CHR(10)
	GOSUB	DO'OVERHEAD		! SET DEFAULTS
RQLC2:
	GOSUB	DO'EXIT'BOX		! WRITE EXIT BOX
	GOSUB	CREATE'ZONES		! CREATE THE ZONES FOR ICONS
	GOSUB	FILL'ZONES		! FILL ZONES BASED ON FILES.IDA
 	GOSUB	DO'SELECTION		! GET THE SELECTION

END'IT:
	GOSUB	CLOSE'FILES
	XCALL	AMGSBR,G'CLWK,GCB,STATUS
	PRINT	TAB(-1,0);
	END
!***********************************************!
DO'OVERHEAD:
! Set Mouse Cursor Shape
	PRINT	TAB(-1,29);
	PRINT	TAB(-1,160);CHR(32+3);
! Open the workstation
 	XCALL AMGSBR,G'OPWK,GCB,"",STATUS
! Clear the workstation
	XCALL AMGSBR,G'CLRW,GCB,STATUS
! Text Overhead
 	XCALL	AMGSBR,G'STXF,GCB,1001,STATUS	! font
	XCALL	AMGSBR,G'STXC,GCB,7,STATUS	! color
 	XCALL	AMGSBR,G'SCHH,GCB,1500,STATUS	! height
	XCALL	AMGSBR,G'SCHR,GCB,300,STATUS	! rotation
! Fill Area Overhead
 	XCALL	AMGSBR,G'SFAC,GCB,4,STATUS	! color
 	XCALL	AMGSBR,G'SFAS,GCB,2,STATUS	! style
 	XCALL	AMGSBR,G'SFAI,GCB,55,STATUS	! index
	
	RETURN
						!
!***********************************************!
DO'EXIT'BOX:
	! Exit Box
	COLOR	= 7
	XMIN	=300
	XMAX	=3500
	YMIN	=23000
	YMAX	=24500

	EXIT'X1	=300
	EXIT'Y1	=23000
	EXIT'X2	=3500
	EXIT'Y2	=24500
	
	GOSUB	DISP'BOX			! exit box

 	XCALL	AMGSBR,G'STXF,GCB,1001,STATUS	! font
	XCALL	AMGSBR,G'STXC,GCB,2,STATUS	! color
 	XCALL	AMGSBR,G'SCHH,GCB,900,STATUS	! height
	XCALL	AMGSBR,G'SCHR,GCB,0,STATUS	! rotation
	TEXT$	="EXIT"
	XVAL	=900
	YVAL	=23500
	GOSUB	DISP'TEXT

 	XCALL	AMGSBR,G'STXF,GCB,1003,STATUS	! font
	XCALL	AMGSBR,G'STXC,GCB,4,STATUS	! color
 	XCALL	AMGSBR,G'SCHH,GCB,1200,STATUS	! height
	XCALL	AMGSBR,G'SCHR,GCB,0,STATUS	! rotation
	TEXT$	= "AM72 DEMO SOFTWARE"
	XVAL	= 8100
	YVAL	= 23000
	GOSUB	DISP'TEXT

 	XCALL	AMGSBR,G'STXF,GCB,1006,STATUS	! font
	XCALL	AMGSBR,G'STXC,GCB,4,STATUS	! color
 	XCALL	AMGSBR,G'SCHH,GCB,1100,STATUS	! height
	XCALL	AMGSBR,G'SCHR,GCB,0,STATUS	! rotation
	TEXT$	= "- with mouse interface - "
	XVAL	= 7500
	YVAL	= 22000
	GOSUB	DISP'TEXT

	RETURN
!***********************************************!
CREATE'ZONES:
	! Screen Frame
	COLOR	= 7
 	POINT'X(1)	= 300
 	POINT'Y(1)	= 300
 	POINT'X(2)	= 300
 	POINT'Y(2)	= 31000
 	POINT'X(3)	= 31000
 	POINT'Y(3)	= 31000
 	POINT'X(4)	= 31000
 	POINT'Y(4)	= 300
 	POINT'X(5)	= POINT'X(1)
 	POINT'Y(5)	= POINT'Y(1)

 	XCALL	AMGSBR,G'SPLC,GCB,1,STATUS
	POINT'COUNT	=5
	XCALL	AMGSBR,G'PL,GCB,POINT'ARRAY,STATUS

	IF	(TRMCHR'ROWS = 24)	&
		YVAL	= 19200		&
	ELSE				&
		YVAL	= 19800
	ZONES'KTR= 0

	FOR I	= 1 TO 10
	
	XVAL	= 500
		FOR X	= 1 TO 2
			ZONES'KTR=ZONES'KTR+1

			ZONES'X(ZONES'KTR,1)=XVAL
			ZONES'Y(ZONES'KTR,1)=YVAL

			ZONES'X(ZONES'KTR,2)=XVAL+1500
			ZONES'Y(ZONES'KTR,2)=YVAL+1500
	
			TEXT'X(ZONES'KTR)   =XVAL+2000
			TEXT'Y(ZONES'KTR)   =YVAL+460

			XVAL	= XVAL + 16000
		NEXT X
		IF	(TRMCHR'ROWS = 24)	&
			YVAL 	= YVAL - 1825	&
		ELSE				&
			YVAL	= YVAL - 2000
	
	NEXT I

	RETURN

!***********************************************!
FILL'ZONES:
	GOSUB	CLEAR'FILES'ARRAY
	GOSUB	OPEN'FILES
	FILES'KEY1 = SPACE(32)
	ICONS	= 0
	IF	(TRMCHR'ROWS = 24)	&
		ROW	= 5		&
	ELSE				&
		ROW	= 6
	GOSUB	LOAD'ZONES'ARRAY

 	FOR I	= 1 TO ICONS

 	XCALL	AMGSBR,G'SWKV,GCB,ZONES'X(I,1),ZONES'Y(I,1),ZONES'X(I,2),ZONES'Y(I,2),STATUS

	GOSUB	DO'BOX

	XCALL	AMGSBR,G'SWKV,GCB,1,1,32000,32000,STATUS
	XCALL	AMGSBR,G'STXF,GCB,1001,STATUS	! font
	XCALL	AMGSBR,G'STXC,GCB,7,STATUS	! color
	XCALL	AMGSBR,G'SCHH,GCB,600,STATUS	! height
	XCALL	AMGSBR,G'SCHR,GCB,0,STATUS	! rotation

	XVAL	=TEXT'X(I)
	YVAL	=TEXT'Y(I)
!	TEXT$	= F'DESC(I)
!	GOSUB	DO'TEXT

! 480 line
	IF	(TRMCHR'ROWS <> 24)			&
		IF	(INT(I/2) <> I/2)		&
			PRINT	TAB(ROW,05);F'DESC(I);	&
		ELSE					&
			PRINT	TAB(ROW,45);F'DESC(I);	: &
			ROW	= ROW + 3			

! 350 line
	IF	(TRMCHR'ROWS = 24)			&
		IF	(INT(I/2) <> I/2)		&
			PRINT	TAB(ROW,05);F'DESC(I);	&
		ELSE					&
			PRINT	TAB(ROW,45);F'DESC(I);	: &
			ROW	= ROW + 2

	NEXT I

	RETURN

!***********************************************!
DO'SELECTION:
	GOSUB	GETCOR				! mouse input
	GOSUB	CHECK'EXIT
	IF EXIT'FLAG=1		&
		ZONES'PNTR = 0	: &
		RETURN	
	GOSUB	CHECK'ZONES
	IF	(ZONES'FLAG = 1)	&
		GOSUB	CHAIN'SELECTION	: &
		RETURN

	GOTO	DO'SELECTION
	
CHECK'EXIT:
	EXIT'FLAG=0	

	IF XVAL<(EXIT'X1-25) THEN RETURN
	IF XVAL>(EXIT'X2+25) THEN RETURN
	IF YVAL<(EXIT'Y1-25) THEN RETURN
	IF YVAL>(EXIT'Y2+25) THEN RETURN

	EXIT'FLAG=1

	RETURN

CHECK'ZONES:
	ZONES'FLAG=0	

	FOR	SELECT = 1 TO ICONS
		IF XVAL<(ZONES'X(SELECT,1)-25) GOTO CHECK'ZONES'10
		IF XVAL>(ZONES'X(SELECT,2)+25) GOTO CHECK'ZONES'10
		IF YVAL<(ZONES'Y(SELECT,1)-25) GOTO CHECK'ZONES'10
		IF YVAL>(ZONES'Y(SELECT,2)+25) GOTO CHECK'ZONES'10
		ZONES'FLAG	= 1
		ZONES'PNTR	= SELECT
		SELECT		= ICONS

CHECK'ZONES'10:
	NEXT	SELECT

	RETURN

! *****************************************************
DO'BOX:
	COLOR	= VAL(F'TYPE(I))
	XMIN	=1500
	XMAX	=20000
	YMIN	=1500
	YMAX	=22000
	GOSUB	DISP'BOX	

	RETURN
! *******************************************************

DISP'BOX:
 	POINT'X(1)	=XMIN
 	POINT'Y(1)	=YMIN
 	POINT'X(2)	=XMIN
 	POINT'Y(2)	=YMAX
 	POINT'X(3)	=XMAX
 	POINT'Y(3)	=YMAX
 	POINT'X(4)	=XMAX
 	POINT'Y(4)	=YMIN
 	POINT'X(5)	=POINT'X(1)
 	POINT'Y(5)	=POINT'Y(1)

 	XCALL	AMGSBR,G'SPLC,GCB,1,STATUS
 	XCALL	AMGSBR,G'SFAC,GCB,COLOR,STATUS	! color
	POINT'COUNT	= 4
 	XCALL	AMGSBR,G'FA,GCB,POINT'ARRAY,STATUS
	POINT'COUNT	= 5
 	XCALL	AMGSBR,G'PL,GCB,POINT'ARRAY,STATUS
	RETURN

DISP'LINE:
 	POINT'X(1)	=XMIN
 	POINT'Y(1)	=YMIN
 	POINT'X(2)	=XMIN
 	POINT'Y(2)	=YMAX
 	POINT'X(3)	=XMAX
 	POINT'Y(3)	=YMAX
 	POINT'X(4)	=XMAX
 	POINT'Y(4)	=YMIN
 	POINT'X(5)	=POINT'X(1)
 	POINT'Y(5)	=POINT'Y(1)
DISP'LINE'10:
	POINT'COUNT	=5
 	XCALL	AMGSBR,G'SPLC,GCB,COLOR,STATUS
 	XCALL	AMGSBR,G'PL,GCB,POINT'ARRAY,STATUS
	RETURN

!***********************************************!
DO'TEXT:
	XCALL	AMGSBR,G'TX,GCB,XVAL,YVAL,TEXT$,STATUS	
	RETURN
DISP'TEXT:
	XCALL	AMGSBR,G'TX,GCB,XVAL,YVAL,TEXT$,STATUS	
	RETURN
!***********************************************!

GETCOR:
	XCALL AMGSBR,G'RQLC,GCB,0,0,0,XVAL,YVAL,CHAR,VALID
	RETURN

GETCOR1:
	XCALL AMGSBR,G'RQLC,GCB,XVAL,YVAL,2,XVAL,YVAL,CHAR,VALID
	RETURN
	END

	
CLEAR'FILES'ARRAY:
	FOR	ZIP = 1 TO 20
		F'LEVEL       = SPACE(2)
		F'DESC        = SPACE(30)
	 	F'TYPE        = SPACE(1)
	 	F'CMND'2      = SPACE(30)
	 	F'CMND'1      = SPACE(30)
	 	F'CMND'3      = SPACE(30)
	 	F'CMND'4      = SPACE(30)
	 	F'CMND'5      = SPACE(30)
	 	F'CMND'6      = SPACE(30)
	 	F'NEW'LEVEL   = 0
	NEXT	ZIP

	RETURN

LOAD'ZONES'ARRAY:
	GOSUB	FILES'GET'NEXT	
	IF	(FIL'STAT <> "   ")		&
	   OR	(VAL(FILES'LEVEL) <> LEVEL)	&
		RETURN

	
	ICONS		= ICONS + 1
	FILES(ICONS)	= FILES'RECORD

	GOTO	LOAD'ZONES'ARRAY

CHAIN'SELECTION:
	LOOKUP	DO'FILE,Q
	IF	(Q = 0)		&
		GOTO	CONT'CHAIN
	KILL	DO'FILE
	GOTO	CHAIN'SELECTION

CONT'CHAIN:	
	COMMAND	= SPACE(100)	
	OPEN	#555,DO'FILE,OUTPUT
	PRINT	#555,":R"
	XCALL	STRIP, F'CMND'1(ZONES'PNTR)
	IF	(LEN(F'CMND'1(ZONES'PNTR)) > 0)		&
		PRINT	#555,F'CMND'1(ZONES'PNTR)

	XCALL	STRIP, F'CMND'2(ZONES'PNTR)
	IF	(LEN(F'CMND'2(ZONES'PNTR)) > 0)		&
		PRINT	#555,F'CMND'2(ZONES'PNTR)

	XCALL	STRIP, F'CMND'3(ZONES'PNTR)
	IF	(LEN(F'CMND'3(ZONES'PNTR)) > 0)		&
		PRINT	#555,F'CMND'3(ZONES'PNTR)

	XCALL	STRIP, F'CMND'4(ZONES'PNTR)
	IF	(LEN(F'CMND'4(ZONES'PNTR)) > 0)		&
		PRINT	#555,F'CMND'4(ZONES'PNTR)

	XCALL	STRIP, F'CMND'5(ZONES'PNTR)
	IF	(LEN(F'CMND'5(ZONES'PNTR)) > 0)		&
		PRINT	#555,F'CMND'5(ZONES'PNTR)

	XCALL	STRIP, F'CMND'6(ZONES'PNTR)
	IF	(LEN(F'CMND'6(ZONES'PNTR)) > 0)		&
		PRINT	#555,F'CMND'6(ZONES'PNTR)


	PRINT	#555,"RUN DEMO72"
	CLOSE	#555
	CHAIN	DO'FILE


! **************************************************
! ISAM FILE ACCESSING
! **************************************************
OPEN'FILES:
	FIL'STAT	= SPACE(3)
	OPEN	#FILES'CHN, FILES'FL$, INDEXED, FILES'RSZ, RECNO
	IF	(ERF(FILES'CHN) > 0)		&
		GOTO	REPORT'ERRORS

	RETURN

FILES'GET:
	FIL'STAT	= SPACE(3)
	ISAM	#FILES'CHN, 1, FILES'KEY1

	IF	(ERF(FILES'CHN) = 33)	&
		FIL'STAT	= "NOF"	: &
		RETURN

	IF	(ERF(FILES'CHN) > 0)	&
		GOTO	REPORT'ERRORS

	GOSUB	READ'FILES
	RETURN

FILES'GET'NEXT:
	FIL'STAT	= SPACE(3)

	ISAM	#FILES'CHN, 2, FILES'KEY1
	IF	(ERF(FILES'CHN) = 38)	&
		FIL'STAT	= "EOF"	: &
		RETURN

	IF	(ERF(FILES'CHN) = 33)	&
		FIL'STAT	= "NOF"	: &
		RETURN

	IF	(ERF(FILES'CHN) > 0)	&
		GOTO	REPORT'ERRORS

	GOSUB	READ'FILES
	RETURN

READ'FILES:
	READ	#FILES'CHN, FILES'RECORD
	RETURN

CLOSE'FILES:
	CLOSE	#FILES'CHN
	RETURN


REPORT'ERRORS:
	PRINT	TAB(24,1);"ERROR # ";ERF(FILES'CHN);" -- ABORTING JOB"
	GOTO	END'IT

!++INCLUDE	BAS:ERROR.BSI