1	!

	!	D A T A    E N T R Y    D E M O


2!		PROGRAM		: DEDEMO
5!		VERSION		: 6B
6!		EDIT		: 04
7!		EDIT DATE	: 19-FEB-77
8!
9!		AUTHOR		: MARTIN MINOW

100!	THIS PROGRAM DEMONSTRATES A SIMPLE KEY-TO-DISK SYSTEM.
	IT HANDLES A VARIETY OF TERMINAL TYPES, AND ALLOWS
	MULTIPLE FORMS PER TERMINAL.  (DIFFERENT TERMINALS
	MAY HAVE DIFFERENT FORMS).
	IT WAS WRITTEN TO DEMONSTRATE THE POWER OF RSTS/E
	VERSION 6B TERMINAL HANDLING, INCLUDING CURSOR CONTROL,
	MULTI-TTY SERVICE, AND ECHO-CONTROL MODE.
200	!

	!	O P E R A T I N G    I N S T R U C T I O N S


202!	THIS PROGRAM DEMONSTRATES MULTI-TERMINAL, MULTI-FORM
	DATA ENTRY.  ALL OUTPUT (FROM ALL FORMS) IS MERGED
	INTO ON OUTPUT FILE.
204!	TO RUN, TYPE "RUN DEDEMO".  THE PROGRAM WILL ASK FOR
	A LIST OF KEYBOARDS AND THEIR SCOPE CHARACTERISTICS.
	THEN  -- LIKE MAGIC -- THE FIRST FORM WILL APPEAR
	ON ALL THE SCREENS.
206!	WHEN ENTERING DATA, THE FOLLOWING CHARACTERS HAVE
	SPECIAL SIGNIFICANCE:
208!		<CR>	END OF FIELD
		<LF>	END OF FIELD
		<ENTER>	END OF FIELD
		<FF>	END OF KEYPUNCH FIELD
		<FF>	DO LAST FIELD NOW IF NO DATA IN FIELD
210!		^D	REPAINT THE FORM AND RETRY FROM THE START
		<ESC>	WITH ADDITIONAL DATA:  END OF FIELD
			WITHOUT ANY DATA:	BACKUP ONE FIELD
		^C,^Z	STOP (IMMEDIATELY) IF FROM THE MASTER KB:
			OTHERWISE GO BACK TO THE MENU FORM.

220!	FORMS ARE DEFINED BY A SET OF DATA STATEMENTS.  WHEN
	THE PROGRAM STARTS, THESE STATEMENTS ARE COMPILED INTO
	A FILE, DEDEMO.TMP.  DURING OPERATION, THIS FILE IS
	ACCESSED AS A VIRTUAL ARRAY TO SPEED UP PROCESSING.
	THE FILE WILL BE DELETED UPON COMPLETION OF PROCESSING.
	EACH LINE OF A FORM HAS ONE OF TWO FORMATS:
222!		000RRRCCC(0-10 CHARACTERS OF TEXT)	BACKGROUND
		HHHRRRCCCLLLOOOPPP			FIELD DEFINITION
	WHERE THE SYMBOLS HAVE THE FOLLOWING MEANING:
224!		HHH	FORMAT HANDLER INDEX (0 MEANS BACKGROUND)
		RRR	ROW ON THE SCREEN
		CCC	COLUMN ON THE SCREED
		LLL	FIELD LENGTH AND KEYPUNCH-MODE FLAG
		OOO	POSITION IN THE OUTPUT RECORD
		PPP	"PAINT" CHARACTER ASCII VALUE
800	!

	!	P R E S E T    V A R I A B L E S


810	R0%=32767%+1%\ R1%=-16384%\ S0$=CHR$(11%)+CHR$(1%)
	\K9$=",VT05,VT50,VT52,VT55,VT61"
		!R0%	BIT 15 -- MULTI-TTY FLAG
		!R1%	GET FROM ANY TERMINAL IN MULTI-TTY SERVICE
		!S0$	CANCEL TYPE-AHEAD BOILERPLATE (RSTS/E V06B)
		!K9$	SUPPORTED TERMINAL TYPES.

820	L0%=128%
		!L0%	MAXIMUM OUTPUT RECORD LENGTH (FOR BUFFER)

830	C0$=CHR$(128%+27%)
	\C1$=C0$+"H"
	\C2$=C0$+"J"
	\C3$=C0$+"C"
	\C4$=C0$+"Y"
		!VT5X, VT6X CURSOR CONTROL:
		!C0$	<ESC>
		!C1$	<HOME>
		!C2$	<ERASE EOS>
		!C3$	<CURSOR RIGHT>
		!C4$	<CURSOR ADDRESS LEAD-IN>

840	V1$=CHR$(29%)
	\V2$=CHR$(31%)
	\V3$=CHR$(14%)
		!VT05 CURSOR CONTROL:
		!V1$	HOME
		!V2$	<ERASE EOS>
		!V3$	<CURSOR ADDRESS LEAD-IN>
900	!

	!	A R R A Y    D E C L A R A T I O N S


902!	THE ARRAY DIMENSIONS ARE
	  K	THE MAXIMUM NUMBER OF LOGICAL KEYBOARDS
	  F	THE MAXIMUM NUMBER OF DATA FIELDS

910	DIM K1%(8)	!K1%(K)		PHYSICAL KB: FOR LOGICAL KB:'S
914	DIM T%(8)	!T%(K)		CURSOR-CONTROL TYPE
918	DIM I%(8)	!I%(K)		CURRENT PICTURE FOR THIS KB:
920	DIM F%(8)	!F%(K)		THE CURRENT FIELD FOR DATA ENTRY
922	DIM F0%(8%)	!F0%(K)		MAXIMUM FIELDS IN CURRENT PICTURE
924	DIM M%(8)	!M%(K)		ERROR MESSAGE CONTROL VECTOR
926	DIM V%(8,20)	!V%(K,F)	TRUE IF DATA PRESENT/CHANGED
928	DIM F$(8,20)	!F$(K,F)	FIELD DATA VALUE

930!	THE FOLLOWING CONTAIN FIELD FORMATTING INFORMATION FOR EACH
	FIELD.  THEY ARE LOADED FROM THE PICTURE CONTROL FILE
	WHEN THE PICTURE CHANGES FOR A TERMINAL.

931	DIM H%(7,20)	!H%(K,F)	HANDLER FOR DATUM CONVERSION
932	DIM R%(7,20)	!R%(K,F)	ROW-COORDINATE (Y-AXIS)
934	DIM C%(7,20)	!C%(K,F)	COL-COORDINATE (X-AXIS)
936	DIM L%(7,20)	!L%(K,F)	LENGTH OF INPUT DATUM
940	DIM P%(7,20)	!P%(K,F)	"PAINT" CHARACTER
942	DIM O%(7,20)	!O%(K,F)	OFFSET IN OUTPUT RECORD

960!	THE FOLLOWING DEFINES THE VIRTUAL ARRAY USED FOR COMPILED
	FORMAT STATEMENTS.  NOTE THAT P8$ AND P9$ OVERLAY P8% AND P9%.

962	DIM #10%, P8%(63),   P9%(63,7)	!NUMERIC FORMAT VALUES
964	DIM #10%, P8$(63)=2, P9$(63)=16	!STRING  FORMAT VALUES
999	!

	!	M A I N   C O D E   B E G I N S   H E R E


1000	ON ERROR GOTO 19000
		!SETUP STANDARD ERROR TRAP

1010	I$="V06B-04"\ I0$="DEDEMO"
		!SETUP VERSION/EDIT FOR HEADER.  ALSO PROGRAM NAME

1020	PRINT I0$;CHR$(9%);I$;CHR$(9%);FNE$(0%)
		!PRINT HEADER

1040	OPEN "DEDEMO.TMP" FOR OUTPUT AS FILE 10%\ KILL "DEDEMO.TMP"
	\GOSUB 12000
		!DEFINE THE FORMAT FILE AND SET IT UP FOR PROCESSING
		!MAKE SURE IT'S NOT AROUND WHEN WE EXIT

1050	GOSUB 11100
		!ASK FOR TERMINAL LIST

1070	OPEN "NL:" AS FILE 9%, RECORDSIZE L0%
	\FIELD #9%, L0% AS D0$
		!DEFINE A WORK AREA FOR OUTPUT STRING PROCESSING
1100	!

	!	G E T   P A R A M E T E R S


1110	PRINT\ PRINT "Output file name, <CR> to log on master";
	\INPUT LINE O9$\ O9$=CVT$$(O9$,-1%)
	\L9%=(LEN(O9$)=0%)\ GOTO 1200 IF L9%
	\ON ERROR GOTO 1160
		!REQUEST OUTPUT FILE
		!NOTHING TO OPEN IF JUST LOGGING

1120	OPEN O9$ FOR INPUT AS FILE 2%
	\ON ERROR GOTO 19000\ CLOSE 2%
		!CHECK IF IT EXISTS.  IF WE COME THROUGH, IT'S THERE

1130	 PRINT 'File "';O9$;'" exists'
	\PRINT 'Type "D" to delete and recreate'
	\PRINT 'Type "A" to append new data'
	\PRINT 'Type "R" to retry'\ PRINT "Option"
		!WHAT TO DO, WHAT TO DO

1140	INPUT LINE Q$\ Q$=LEFT(CVT$$(Q$,-1%),1%)
	\IF       Q$="D" THEN GOTO 1170
	  ELSE IF Q$="A" THEN GOTO 1150
	  ELSE IF Q$="R" THEN GOTO 1110
	  ELSE GOTO 1140
		!DIGEST THE OPTION

1150	OPEN O9$ FOR INPUT AS FILE 2%, MODE 2%
	\GOTO 1200
		!OPEN THE OUTPUT FOR APPENDING

1160	IF ERR=5 AND ERL=1120 THEN RESUME 1170
	  ELSE GOTO 19000
		!IF FILE NOT FOUND, CREATE IT, ELSE ITS FATAL

1170	ON ERROR GOTO 19000
	\OPEN O9$ FOR OUTPUT AS FILE 2%
		!INITIALIZE THE NEW FILE

1200	OPEN "KB:" AS FILE 1%, RECORDSIZE 128%, MODE 8%
	\FIELD #1%, 1% AS K$, 127% AS F0$
		!OPEN MASTER KEYBOARD AND DEFINE INPUT BUFFER

1210	FOR K1%=1% TO K9%
	  \K%=K1%(K1%)\ K2%=K%+R0%\ I%(K1%)=0% \Q%=FNC0%(0%)
	  \GOSUB 12100\ F%,F%(K1%)=1%\ GOSUB 13100
		!GET PHYSICAL KB: NUMBER AND PUT PARAMETER,
		!THEN PAINT THE INITIAL FORM AND CLEAR SCREEN AND ALL
		!FIELDS; THEN DECLARE THE FIRST FIELD.

1230	NEXT K1%
		!SETUP ALL LOGICAL KB:'S

1240	!GOSUB 11400
		!TRAP CONTROL/C
2000	!

	!	R E A D    F R O M    A N Y    T E R M I N A L


2010	ON ERROR GOTO 2020
	\GET #1%, RECORD R1%\ L%=RECOUNT-2%\ GOTO 2050
		!HANDLE ERRORS (^Z) INTERNALLY.
		!READ FROM ANY TERMINAL WITH INFINITE WAIT
		!GET DATA LENGTH AND GO PROCESS DATA.

2020	IF ERR=28%
	  THEN IF LINE=2010	THEN RESUME 2030
				ELSE   GOTO 2080
	  ELSE IF ERR = 11%	THEN RESUME 2040
				ELSE   GOTO 19000
		!ACCEPT ^Z AND ^C ERRORS.
		!^C WILL BE ACCEPTED ONLY IF IT OCCURS WHILE
		!WAITING FOR INPUT.  OTHERWISE, WE'VE CRASHED.

2030	LSET K$=K0$\ LSET F0$=CHR$(3%)
		!CTRL/C TYPED ON MASTER.  FAKE BUFFER
		!CONTENTS AND LET LATER CODE HANDLE IT

2040	L%=0%
		!^Z AND ^C, NO DATA, JUST A DELIMITER

2050	ON ERROR GOTO 19000
	\K%=ASCII(K$)\ K1%=INSTR(1%,K0$,K$)\ K2%=K%+R0%
	\IF K1%<>0% THEN GOTO 2100 ELSE
	  PRINT #1%, RECORD K2%, "GO AWAY, YOU'RE NOT ONE OF MINE"
	  \GOTO 2000
		!K%	PHYSICAL KB:
		!K1%	LOGICAL  KB:
		!K2%	RECORD PARAMETER FOR PUT.
		!AND GO GET DATUM IF OK

2080	E%=ERR\ E1%=LINE\ RESUME 19020
		!CTRL/C TRAP.  SINCE WE WERE NOT WAITING FOR INPUT,
		!WE MUST CRASH.  TOO BAD.
2100	!

	!	E X T R A C T   A N D   P R O C E S S   D E L I M I T E R


2102!	THE LINE OF DATA IS IN THE KB: BUFFER.  MAP THE DATUM AND
	EXTRACT THE DELIMITER.

2110	F%=F%(K1%)
	\FIELD #1%, 1% AS Q$, L% AS Q$, 1% AS D$\ D%=ASCII(D$)
	\L%=L%-1% IF L%>0% AND D%=10% AND ASCII(RIGHT(Q$,L%))=13%
	\FIELD #9%, L% AS D$\ LSET D$=Q$
		!GET CURRENT FIELD, AND DATUM STUFF.
		!REMOVE <LF> FROM <CR><LF> SEQUENCE
		!F%	CURRENT FIELD NUMBER
		!D$	INPUT DATUM
		!L%	DATUM LENGTH
		!D%	TERMINATOR VALUE

2200	!THE TEXTUAL DATUM IS IN D$, THE DELIMITER IN D%.
	!PROCESS THE DELIMITER:
	!	<FF>	DO LAST FIELD NOW IF NO DATA IN FIELD
	!	^D	REPAINT THE SCREEN (THEN RETYPE ALL)
	!	<ESC>	BACKUP ONE FIELD IF NO DATUM
	!	^C ^Z	CLOSE UP SHOP IF FROM MASTER
	!		OTHERWISE, OFF TO THE MENU
	!	<155>	ESCAPE SEQUENCE (IT'S A DELIMITER)

2220	IF D%=12% AND L%=0% THEN F%=F0%(K1%)\ GOTO 2560
		!<FF>	IMMEDIATELY DO THE LAST FIELD

2230	IF D%=4% THEN GOSUB 12100\ GOTO 2540
		!^D	REPAINT THE FORM AND RESTART AT FIELD 1

2240	IF D%=27%
	  THEN IF L%>0% THEN GOTO 2300
			ELSE F%,F%(K1%)=F%-1% IF M%(K1%)=0%
				\IF F%=0% THEN GOTO 2540
					  ELSE GOTO 2560
		!<ESC> WITH DATA IS NORMAL
		!<ESC> WITHOUT DATA BACKS UP ONE FIELD.
		!	THIS MAY NEED FIXING FOR VT5X AND VT6X

2250	IF D%=155% THEN L%=INSTR(1%,D$,CHR$(128%))-1%
	  \IF L%>=0% THEN FIELD #9%, L% AS D$
		     ELSE GOSUB 12100
			\Q%=FNM%("Illegial escape sequence")\ GOTO 2540
		!ESCAPE SEQUENCE READ.  THROW AWAY TRAILING JUNK.
		!WE CAN'T HANDLE WACKO ESCAPE SEQUENCES

2260	IF D%=3% OR D%=26% THEN IF K%=K0% AND I%(K1%)=0%
	  THEN GOTO 9000
	  ELSE I%(K1%)=0%\ Q%=FNC0%(0%)\ GOSUB 12100\ GOTO 2500
		!^C OR ^Z FROM MASTER AT PICTURE 0 SHUTS UP SHOP
		!^C OR ^Z FROM SLAVE RESTARTS FROM FORM 0
2300	!

	!	P R O C E S S    A    D A T U M


2302!	FIRST CHECK IF WE'RE VERIFYING THIS DATUM, IF SO, CHANGE THE
	FIELD ONLY IF SOMETHING WAS TYPED.

2310	LSET D$=CVT$$(D$,137%)
		!SAVE THE DATA PART FOR LATER PROCESSING
		!NOTE THAT D$ IS A "CLEAN" COPY OF THE INPUT DATUM
		!WITH NORMALIZED PARITY AND NO JUNK BYTES.
		!137% = 1% + 8% + 128%

2320	IF V%(K1%,F%) <> 0% THEN
	  IF L%=0%
	    THEN IF M%(K1%)<>0% THEN GOTO 2560 ELSE GOTO 2340
	    ELSE PRINT #1%, RECORD K2%, FNC1$(L%);
			STRING$((L%(K1%,F%) AND 127%)-L%,P%(K1%,F%))
		!IF VERIFYING, EXIT IF NULL (AND NO PREVIOUS ERROR)
		!ERROR PEOPLE MUST TYPE SOMETHING.
		!BLANK OUT TRAILING JUNK

2330	M%(K1%)=FNM%("") IF M%(K1%)<>0%\ V%(K1%,F%)=-1%\ V%=FNV%
	\IF V% = 0%
	  THEN F$(K1%,F%)=D$+""
	  ELSE Q%=FNM%(E$)\ V%(K1%,F%)=0%\ GOTO 2560
		!A NEW DATUM, MARK FOR VERIFICATION
		!VERIFY THE DATUM.  IF OK, STUFF THE ITEM AWAY

2340	F%=F%+1%
	\GOTO 2560 IF F%<=F0%(K1%)
	\ON I%(K1%)+1% GOTO 3000,3100,3200
		!STEP TO NEXT FIELD, GO GET IT IF THERE'S MORE
		!ALL FIELDS ARE INPUT, GO TO THE PICTURE HANDLER
2500	!

	!	C L E A N    U P   A F T E R    T H E    D A T U M


2502!	EXITS FROM EACH DATUM:
		GOTO	2500	TO ZAP ALL FIELDS
		GOTO	2540	TO START AT FIELD 1
		GOTO	2560	TO (RE)DECLARE CURRENT FIELD

2510	GOSUB 13000 FOR F%=1% TO F0%(K1%)
		!CLEAR OUT ALL FIELDS

2540	F%=1%
		!START AT FIELD 1

2560	F%(K1%)=F%\ GOSUB 13100
		!DECLARE CURRENT FIELD

2590	GOTO 2000
		!THIS INPUT OPERATION IS COMPLETE, GET ANOTHER
3000	!

	!	P I C T U R E   H A N D L E R S


3010	!

	!	P I C T U R E   Z E R O   ( M E N U )


3020	I%=INSTR(1%,CHR$(0%)+"XDP",CVT$$(F$(K1%,1%),-1%))-2%
	\IF I%<0% OR (I%=0% AND K%<> K8%) THEN
	  Q%=FNM%("No such picture")
	  \GOTO 2500
		!LOOK AT THE CHARACTER TYPED, EXIT IF IT'S BAD

3030	I%(K1%)=I%
	\IF I%=0% THEN GOTO 9000 ELSE GOSUB 12100\ GOTO 2540
		!GET THE REAL PICTURE NUMBER.  STOP IF "EXIT".
		!LOAD THE PICTURE AND PAINT IT
		!AND GO GET THE FIELDS ONE BY ONE

3100	!

	!	P I C T U R E   O N E   (P H O N E   C A T A L O G )


3110	IF CVT$$(F$(K1%,F0%(K1%)),-1%)<>"Y"
	  THEN GOTO 2540
	  ELSE F0%=F0%(K1%)-1%\ GOSUB 12200\ GOTO 2500
		!MAKE SURE IT'S VERIFIED,
		! IF NOT, LET IT BE CORRECTED
		! IF SO,  WRITE IT OUT

3200	!

	!	P I C T U R E   T W O  ( P R I C E   T Y P E I N )


3210	GOSUB 13200\ GOTO 2560 IF F%>0%
	\F0%=F0%(K1%)\ GOSUB 12200\ GOTO 2500
		!MAKE SURE ALL FIELDS ARE FILLED OUT, THEN
		!WRITE IT OUT AND GET ANOTHER
9000	!

	!	E X I T    F R O M    T H E    P R O G R A M


9002!	HERE ON ^C FROM THE MASTER KB:.  CLOSE UP SHOP.
	(WE REALLY SHOULD ASK FOR CONFIRMATION)


9010	CLOSE Q% FOR Q%=1% TO 12%
		!^C TYPED FROM MASTER KB:, CLOSE ALL FILES

9020	IF K9%>1% THEN PRINT
	  \PRINT "Warning -- the slave terminals are still assigned"
	  \PRINT "KB";NUM1$(K1%(Q%));": "; FOR Q%=2% TO K9%
	  \PRINT
		!A WORD TO THE WISE

9090	GOTO 32767
		!AND CLOSE UP SHOP
10000	!

	!	S U B R O U T I N E S


11100	!

	!	S E T    U P    K E Y B O A R D    L I S T


11102!	SETUP KEYBOARD TABLES, NOTING WHICH IS THE "MASTER" TERMINAL.
	IN A REAL SITUATION, THIS WOULD BE DONE BY A TABLE OR
	CONTROL FILE.

11110	K9%=0%\ K0$=""\ S$=SYS(CHR$(6%)+CHR$(9%))
	\K0%,K8%,K%=ASCII(MID(S$,2%,1%))/2%
		!GET THE MASTER KB: NUMBER AND SAVE IN K8%

11120	PRINT "Master KB: (";NUM1$(K0%);")  Type -- ";
		RIGHT(K9$,2%);
	\INPUT LINE Q$\ Q$=CVT$$(Q$,-1%)\ GOSUB 11200
	\GOTO 11120 IF T%=0%\ PRINT "Enter slave terminal list (Number, Type)"
	\GOTO 11170

11130	E%=0%\ INPUT LINE L$\ L$=CVT$$(L$,-1%)
	\L$=RIGHT(L$,3%) IF LEFT(L$,2%) = "KB"
	\IF L$="" OR L$="END" THEN RETURN
		!GET THE NEXT KB: NUMBER AND TYPE

11140	Q%=INSTR(1%,L$,",")\ Q%=INSTR(1%,L$,":") IF Q%=0%
	\IF Q%<2% THEN PRINT "Missing keyboard number"\ GOTO 11130
		!MUST HAVE   NNN , TTTT
		!OR	  KB NNN : TTTT

11150	K$=LEFT(L$,Q%-1%)\ GOSUB 11300\ IF E% THEN GOTO 11130
		!EXTRACT KEYBOARD NUMBER AND ASSIGN THE BEAST
		!RETRY IF ERROR

11160	Q$=RIGHT(L$,Q%+1%)\ GOSUB 11200
	\IF T%=0% THEN PRINT "Illegal KB: Type"\ GOTO 11130
		!EXTRACT ",TYPE" AND TEST IT.

11170	K9%=K9%+1%\ K0$=K0$+CHR$(K%)\ K1%(K9%)=K%\ T%(K9%)=T%
	\F%(K9%)=0%
		!SETUP ALL THE PARAMETER TABLES

11180	IF K9%=8% THEN RETURN ELSE GOTO 11130
		!WE HAVE TABLE SPACE FOR EIGHT KB:'S

11200	T%=(INSTR(1%,K9$,","+Q$)+4%)/5%
	\RETURN
		!SUBROUTINE TO SEARCH KB: TYPE STRING.
11300	!

	!	A S S I G N    K B :   ( K $ )


11302!	K$ IS THE KEYBOARD NUMBER IN NUM$ FORMAT.
	MAKE SURE WE DON'T HAVE IT (CURRENTLY) AND ASSIGN IT.

11310	ON ERROR GOTO 11350\ K%=VAL(K$)
	\IF INSTR(1%,K0$,CHR$(K%))<>0%
	  THEN PRINT "Cannot assign twice"\ E%=-1%\ RETURN
		!GET AS A NUMBER AND CHECK FOR DUPLICATES.

11320	Q$=SYS(CHR$(6%)+CHR$(10%)+SPACE$(4%)
		+CHR$(0%)+CHR$(0%)+SPACE$(14%)
		+"KB"+CHR$(K%)+CHR$(255%))
			!ASSIGN THIS KEYBOARD

11330	E%=0%\ GOTO 11390
		!WENT LIKE A CHARM

11350	IF ERL=11310 THEN RESUME 11360
	  ELSE IF ERL=11320 THEN RESUME 11370
	  ELSE GOTO 19000
		!ERROR -- IS IT ONE OF OURS?

11360	PRINT 'Bad keyboard number "';K$;'" -- ';
	\GOTO 11380
		!ERROR CONVERTING KB: NUMBER TO INTEGER

11370	PRINT "Cannot assign keyboard";K%;" -- ";
		!ERROR ASSIGNING KB:

11380	E%=ERR\ PRINT FNE$(E%)

11390	ON ERROR GOTO 19000
	\RETURN
		!EXIT FROM ASSIGNMENT ROUTINE

11400	!

	!	T R A P   ^ C    F U N C T I O N    C A L L


11410	Q$=SYS(CHR$(6%)+CHR$(-7%))
	\RETURN
12000	!

	!	L O A D   V I R T U A L    A R R A Y S


12002!	THIS ROUTINE LOADS THE VIRTUAL ARRAYS P8%, P9%, P8$, AND P9$
	FROM A DATA STATEMENT.  TO SAVE SPACE, THIS SEGMENT (AND
	THE DATA STATEMENTS) SHOULD BE IN A SEPERATE PROGRAM.

12010	I%,F%,P8%(0%)=0%
	\P8%(Q%)=0% FOR Q%=0% TO 63%
	\P9$(Q%)=STRING$(16%,0%) FOR Q%=0% TO 63%
		!INITIALIZE POINTERS AND CLEAR ARRAYS

12020	READ X$
	  \IF LEFT(X$,1%)="*"
	    THEN I%=I%+1%\ P8%(I%)=F%
	         \IF X$="**" THEN GOTO 12050 ELSE GOTO 12020
			!GET NEXT ITEM, HANDLE PICTURE AND DATA ENDS

12030	  P9%(F%,Q%)=FNP9% FOR Q%=0% TO 2%
	  \IF P9%(F%,0%)<>0%
	    THEN P9%(F%,Q%)=FNP9% FOR Q%=3% TO 7%
	    ELSE P9$(F%)=LEFT(P9$(F%),5%)+CHR$(0%)+RIGHT(X$,10%)
		!DO A LINE OF EITHER TYPE
		!NOTE: THE CHR$(0%) IS A KLUDGE

12040	  F%=F%+1%\ GOTO 12020
		!THIS ITEM IS FINISHED, READ THE NEXT

12050	RETURN
		!EVERYTHING IS LOADED, EXIT.

12060	DEF FNP9% = VAL(MID(X$,Q%*3%+1%,3%))
		!INTERNAL SUBROUTINE FOR LOADING VECTORS,
		!EXTRACT THREE BYTES AND CONVERT TO AN INTEGER
12100	!

	!	L O A D    F O R M A T S    A N D    P A I N T


12102!	THIS SUBROUTINE LOADS PICTURE I%(K1%) INTO THE FORMAT VECTORS
	FOR LOGICAL KEYBOARD K1%.  THE PICTURE IS ALSO PAINTED
	ON THE SCREEN.


12110	I1%=P8%(I%(K1%))\ I2%=P8%(I%(K1%)+1%)-1%\ F%=FNC0%(P9%(I1%,1%))
	\FOR J%=I1% TO I2%
	  \H%=P9%(J%,0%)\ R%=P9%(J%,1%)\ C%=P9%(J%,2%)
		!GET NUMBER OF LINES IN THIS FORMAT AND DO,
		!FOR EACH LINE...

12120	  IF H%=0%
	    THEN PRINT #1%, RECORD K2%, FNC$(R%,C%); RIGHT(P9$(J%),7%);
		\GOTO 12140
			!PROCESS A BACKGROUND LINE

12130	    F%=F%+1%\ H%(K1%,F%)=H%\ R%(K1%,F%)=R%\ C%(K1%,F%)=C%
		\L%(K1%,F%)=P9%(J%,3%)\ P%(K1%,F%)=P9%(J%,4%)
		\O%(K1%,F%)=P9%(J%,5%)
		\GOSUB 13000
			!PROCESS A DATA LINE

12140	NEXT J%
	\F0%(K1%)=F%
	\RETURN
		!FINISHED, NOTE THE NUMBER OF FIELDS AND RETURN

12200	!

	!	W R I T E   O U T   A   B U F F E R


12210	LSET D0$=""
	\FOR F%=1% TO F0%
	  \FIELD #9%, O%(K1%,F%) AS Q$, (L%(K1%,F%) AND 127%) AS Q$
	  \LSET Q$=F$(K1%,F%)
		!LOAD EACH FIELD ITEM IN THE WORK BUFFER

12220	NEXT F%
		!FOR ALL FIELDS

12230	IF L9%=0% THEN PRINT #2%, D0$\ GOTO 12290
		!IF REAL OUTPUT, THEN DO IT

12240	U1%=K1%\ U2%=K2%\ U3%=F%\ K1%=1%\ K2%=R0%+K1%(1%)\ F%=F%(1%)+FNC0%(11%)
	\Q$=SYS(S0$+CHR$(K2%))\ PRINT #1%, RECORD K2%, CVT$$(D0$,16%);
	\GOSUB 13000 IF U1%<>K1%\ GOSUB 13100 IF U1%<>K1%
	\F%=U3%\ K2%=U2%\ K1%=U1%
		!SAVE CONTEXT AND SWITCH TO MASTER KB:
		!WRITE RECORD ON MASTER AND REDECLARE MASTER FIELD IF ANY
		!THEN SWITCH CONTEXT BACK AGAIN

12290	RETURN
		!AND EXIT
13000	!

	!	Z A P   F I E L D   F %


13010	PRINT #1%, RECORD K2%, FNC1$(0%);
			STRING$((L%(K1%,F%) AND 127%),P%(K1%,F%));
	\F$(K1%,F%)=""\ V%(K1%,F%)=0%
		!CLEAR FIELD F% AND PAINT THE BACKGROUND CHARACTER
		!ON THE SCREEN.  NULLIFY FIELD, NOTHING TO VERIFY YET.

13090	RETURN

13100	!

	!	D E C L A R E   F I E L D   F %


13110	PRINT #1%, RECORD K2%, FNC1$(0%);
	\PRINT #1%, RECORD K2%+256%, CHR$(L%(K1%,F%))+CHR$(P%(K1%,F%));
		!POSITION THE CURSOR AND DECLARE FIELD F%

13190	RETURN

13200	!

	!	C H E C K   F O R   A L L   F I E L D S   E N T E R E D

	! EXIT WITH F% SET TO THE FIRST NON-ENTERED FIELD, OR
	! EXIT WITH F% SET TO ZERO IF ALL FIELDS WERE ENTERED

13210	GOTO 13290 IF V%(K1%,F%) = 0% FOR F%=1% TO F0%(K1%)
	\F%=0%
		! CHECK ALL FIELDS FOR PRESENCE

13290	RETURN
15000	!

	!	F U N C T I O N S


15300	!

	!	F N C $ ( R % , C % )


15310	DEF FNC$(R%,C%)
		!RETURN STRING TO POSITION CURSOR TO (R%,C%)
		!NOTE THAT T%(K1%) HAS THE TERMINAL TYPE CODE

15320	ON T%(K1%) GOSUB 15340,15350,15360,15360,15360
		!         VT05  VT50  VT52  VT55  VT61

15330	FNEND
		!SIMPLE, NO?

15340	FNC$=V3$+CHR$(32%+R%)+CHR$(32%+C%)
	\RETURN
		!VT05

15350	C$=C1$+STRING$(R%,10%)\ C$=C$+C3$ FOR R%=1% TO C%
	\FNC$=C$\ RETURN
		!VT50'S ARE FAKED

15360	FNC$=C4$+CHR$(32%+R%)+CHR$(32%+C%)
	\RETURN
		!VT52, VT55, VT61

15400	!

	!	F N C 0 % ( R % )


15410	DEF FNC0%(R%)
		!BLANK SCREEN BEGINNING AT ROW R%

15420	FNC0%=0%
	\IF T%(K1%) = 1%
	  THEN PRINT #1%, RECORD K2%, FNC$(R%,0%); V2$;
	  ELSE PRINT #1%, RECORD K2%, FNC$(R%,0%); C2$;
		!BLANK AWAY

15430	FNEND

15450	!

	!	F N C 1 $ ( Q % )


15460	DEF FNC1$(Q%) = FNC$(R%(K1%,F%),C%(K1%,F%)+Q%)
		!MOVE CURSOR TO START OF CURRENT FIELD
		!OFFSET BY Q%
15500	!

	!	F N V %


15510	DEF FNV%
		!CHECK FIELD F%.  NOTE THAT IN A REAL SITUATION,
		!THIS FUNCTION WOULD BE EXPANDED CONSIDERABLY.
		!NOW WE CHECK THAT NUMERIC FIELDS ARE CORRECT

15520	FNV%=0%
	\ON H%(K1%,F%) GOTO 15590,15530,15530,15570
		!PROCESS   STRING  REAL  INT STRING
		!NOTE: THIS SHOULD BE EXPANDED

15530	Q%=L%(K1%,F%) AND 127%
	\IF L%<Q% THEN PRINT #1%, RECORD K2%, FNC1$(0%);
			STRING$(Q%-L%,P%(K1%,F%)); D$;
		!GET FIELD LENGTH, IF GREATER THAN TYPEIN LENGTH,
		!BACKSPACE TO THE BEGINNING OF THE FIELD AND
		!RIGHT-JUSTIFY THE DATA.

15540	ON ERROR GOTO 15560\ Q=VAL(D$)
	\GOTO 15580 IF H%(K1%,F%)=2%
	\FOR I%=1% TO LEN(D$)
	  \GOTO 15550 IF INSTR(1%," 0123456789",MID(D$,I%,1%)) = 0%
	\NEXT I%
	\Q%=Q\ IF Q%=Q THEN GOTO 15580
		!TEST NUMBER FOR GOOD FORMAT
		!CHECK INTEGERS FOR INTEGRAL VALUES, TOO

15550	FNV%=51%\ E$=FNE$(51%)\ GOTO 15580
		!ERROR (NON-INTEGRAL VALUE)

15560	FNV%=ERR\ E$=FNE$(ERR)\ RESUME 15580
		!NUMBER ERROR, SIGNAL IT FOR ERROR PRINTING

15570	IF L%=0% THEN FNV%=31%\ E$="?Input must be non-null"
		!HANDLER INDEX 4  (NON-NULL STRING)

15580	ON ERROR GOTO 19000
		!RESTORE ERROR HANDLER

15590	FNEND

15600	!

	!	F N M % ( Q $ )


15610	DEF FNM%(Q$)
		!PRINT ERROR MESSAGE Q$

15620	FNM%=0%
	\PRINT #1%, RECORD K2%, CHR$(7%); FNC$(0%,25%);
			Q$; STRING$(32%-LEN(Q$),32%);
	\Q$=SYS(S0$+CHR$(K2%))\ M%(K1%)=1%
		!PRINT IT AWAY AND CANCEL TYPE-AHEAD
		!DON'T FORGET TO SET THE "MESSAGE UP" FLAG

15630	FNEND
15900	!

	!	F N Q % ( Q % , Q $ )

15910	DEF FNQ%(Q%,Q$)
		!DEBUG FUNCTION TO PRINT FIELD INPUT CONTENTS.
		!THIS ROUTINE IS NOT USED IN NORMAL PROCESSING

15920	Q$=Q$+""
	\PRINT #1%, RECORD K2%, FNC$(Q%,0%);F%;"FIELD",L%;"LENGTH",
				LEN(Q$);'DATA LENGTH "';Q$;'"';

15990	FNEND

18000	!

	!	D E F I N E    P I C T U R E S


18002!	EACH PICTURE IS DEFINED AS A SERIES OF DATA STATEMENTS.
	A STATEMENT MAY DEFINE A FIELD (FIRST 3 BYTES ARE NON-ZERO)
	OR A TEXT MESSAGE.  THE FIELD VALUES ARE AS FOLLOWS:
18004!		H	HANDLER INDEX
		R	ROW
		C	COLUMN
		L	LENGTH + KEYPUNCH FLAG
18006!		P	PAINT CHARACTER
		O	OFFSET IN OUTPUT RECORD
18008!	NOTE:  THE FOLLOWING TEXT CONTAINS LOWER-CASE
	           H  R  C  L  P  O	   H  R  C  L  P  O
18100	DATA	"  0  1 22D A T A",	"  0  1 32E N T R Y",
		"  0  1 44D E M O",	"  0  4 20Choose one"
18140	DATA	"  0  4 31of the fol",	"  0  4 41lowing:",
		"  0  5 25D Director",	"  0  5 35y Entry"
18180	DATA	"  0  6 25P Price En",	"  0  6 35try",
		"  1  7 25129 95  0",	"*"
18400	DATA	"  0  2  5Name",	"  1  2 11 22 95  1",
		"  1  2 37 16 95 24",	"  1  2 57129 95 41"
18440	DATA	"  0  3 30Last",	"  0  3 42First",
		"  0  3 56Mid",		"  0  5  5Location"
18480	DATA	"  1  5 15130 95 43",	"  0  5 19Building",
		"  1  5 29131 95 46",	"  0  5 34Floor"
18520	DATA	"  1  5 41130 95 50",	"  0  8  5Extension",
		"  3  8 16132 95 62",	"  0  8 25Alternate"
18560	DATA	"  3  8 36132 95 66",	"  0 10  5Ok?",
		"  1 10  9129 95129",	"*",
		"  0  2  1"
18600	DATA	"  4  5  1134 95  1",	"  1  5  8 22 46  7",
		"  3  5 32131 48 30",	"  0  5 35."
18640	DATA	"  3  5 36130 48 32",	"  0  6  1Code",
		"  0  6  9Descripti",	"  0  6 18on"
18680	DATA	"  0  6 33Price",	"*"
18990	DATA	"**"
18999!	END OF DEFINITIONS
19000	!

	!	F A T A L    E R R O R S


19010	IF E%<>0% THEN ON ERROR GOTO 0
	  ELSE E%=ERR\ E1%=ERL\ RESUME 19020
		!STOP FATALLY IF WE LOOP, ELSE START CRASH SEQUENCE

19020	ON ERROR GOTO 19000
	\Q%=FNE%("Fatal error at line"+NUM$(E1%)+"-- "+FNE$(E%),K8%)
		!LOG STATUS MESSAGE ON MASTER KB:

19030	STOP
		!FATALLY STOP FOR DEBUGGING

19040	GOTO 32767
		!EXIT FROM THE PROGRAM
20000	!

	!	E R R O R    A N D    M E S S A G E    F U N C T I O N S


20100	!

	!	F N E $ ( Q % )


20110	DEF FNE$(Q%) =
	  CVT$$(RIGHT(SYS(CHR$(6%)+CHR$(9%)+CHR$(Q%)),3%),4%)
		!RETURN ERROR MESSAGE Q%

20120	!

	!	F N E % ( Q $ )


20130	DEF FNE%(Q$,Q%) =
	  FNB%(I0$+CHR$(9%)+DATE$(0%)+" "+TIME$(0%)+" "+Q$,Q%)
		!SEND LOG MESSAGE TO KB: Q%

20140	!

	!	F N B % ( Q $ , Q % )


20150	DEF FNB%(Q$,Q%)
		!SEND STRING Q$ TO KEYBOARD Q%
		!ZERO IS RETURNED

20160	FNB%=ASCII(SYS(CHR$(6%)+CHR$(-5%)+CHR$(Q%)+Q$
			+CHR$(13%)+CHR$(10%))) AND 0%
		!BROADCAST STRING Q$ TO KEYBOARD Q%
		!RETURN EXPLICITLY ZERO

20170	FNEND

32767	END

     Cross Reference Listing of DECDED.BAC on 01-Mar-77 at 04:01 PM      Page 1 


#    0             19010 
# 1110              1140 
# 1140              1140 
# 1150              1140 
# 1160              1110 
# 1170              1140   1160 
# 1200              1110   1150 
# 2000              2050   2590 
# 2020              2010 
# 2030              2020 
# 2040              2020 
# 2050              2010 
# 2080              2020 
# 2100              2050 
# 2300              2240 
# 2340              2320 
# 2500              2260   3020   3110   3210 
# 2540              2230   2240   2250   3030   3110 
# 2560              2220   2240   2320   2330   2340   3210 
# 3000              2340 
# 3100              2340 
# 3200              2340 
# 9000              2260   3030 
#11100              1050 
#11120             11120 
#11130             11140  11150  11160  11180 
#11170             11120 
#11200             11120  11160 
#11300             11150 
#11350             11310 
#11360             11350 
#11370             11350 
#11380             11360 
#11390             11330 
#12000              1040 
#12020             12020  12040 
#12050             12020 
#12100              1210   2230   2250   2260   3030 
#12140             12120 
#12200              3110   3210 
#12290             12230 
#13000              2510  12130  12240 
#13100              1210   2560  12240 
#13200              3210 
#13290             13210 
#15340             15320 
#15350             15320 
#15360             15320  15320  15320 
#15530             15520  15520 
#15550             15540 
#15560             15540 
#15570             15520 
#15580             15540  15540  15550  15560 
#15590             15520 
#19000              1000   1120   1160   1170   2020   2050  11350  11390 
                   15580  19020 
     Cross Reference Listing of DECDED.BAC on 01-Mar-77 at 04:01 PM      Page 2 

#19020              2080  19010 
#32767              9090  19040 
C$                 15350@ 15350  15350@ 15350 
C%                 12110@ 12120  12130  15310# 15340  15350  15360 
C%(7,20)             934# 12130@ 15460 
C0$                  830@   830    830    830    830 
C1$                  830@ 15350 
C2$                  830@ 15420 
C3$                  830@ 15350 
C4$                  830@ 15360 
D$                  2110@  2110   2110@  2110@  2250   2250@  2310   2310@
                    2330  15530  15540  15540  15540 
D%                  2110@  2110   2220   2230   2240   2250   2260   2260 
D0$                 1070@ 12210@ 12230  12240 
E$                  2330  15550@ 15560@ 15570@
E%                  2080@ 11130@ 11150  11310@ 11330@ 11380@ 11380  19010 
                   19010@ 19020 
E1%                 2080@ 19010@ 19020 
ERL                 1160  11350  11350  19010 
ERR                 1160   2020   2020   2080  11380  15560  15560  19010 
F$(8,20)             928#  2330@  3020   3110  12210  13010@
F%                  1210@  2110@  2220@  2240   2240@  2240   2320   2320 
                    2320   2330   2330   2330   2340   2340@  2340   2510@
                    2540@  2560   3210  12010@ 12020  12030  12030  12030 
                   12030  12030  12040  12040@ 12110@ 12130  12130@ 12130 
                   12130  12130  12130  12130  12130  12140  12210@ 12210 
                   12210  12210  12220@ 12240  12240@ 12240@ 13010  13010 
                   13010  13010  13110  13110  13210@ 13210  13210@ 15460 
                   15460  15520  15530  15530  15540  15920 
F%(8)                920#  1210@  2110   2240@  2560@ 11170@ 12240 
F0$                 1200@  2030@
F0%                 3110@  3210@ 12210 
F0%(8)               922#  2220   2340   2510   3110   3110   3210  12140@
                   13210 
FNB%               20130  20150# 20160@
FNC$               12120  15310# 15340@ 15350@ 15360@ 15420  15420  15460 
                   15620  15920 
FNC0%               1210   2260  12110  12240  15410# 15420@
FNC1$               2320  13010  13110  15460# 15460@ 15530 
FNE$                1020  11380  15550  15560  19020  20110# 20110@
FNE%               19020  20130# 20130@
FNM%                2250   2330   2330   3020  15610# 15620@
FNP9%              12030  12030  12060# 12060@
FNQ%               15910#
FNV%                2330  15510# 15520@ 15550@ 15560@ 15570@
H%                 12110@ 12120  12130 
H%(7,20)             931# 12130@ 15520  15540 
I$                  1010@  1020 
I%                  3020@  3020   3020   3030   3030  12010@ 12020  12020@
                   12020  15540@ 15540  15540@
I%(8)                918#  1210@  2260   2260@  2340   3030@ 12110  12110 
I0$                 1010@  1020  20130 
I1%                12110@ 12110  12110 
I2%                12110@ 12110 
J%                 12110@ 12110  12110  12110  12120  12130  12130  12130 
                   12140@
     Cross Reference Listing of DECDED.BAC on 01-Mar-77 at 04:01 PM      Page 3 

K$                  1200@  2030@  2050   2050  11150@ 11310  11360 
K%                  1210@  1210   2050@  2050   2260   3020  11110@ 11170 
                   11170  11310@ 11310  11320  11370 
K0$                 2030   2050  11110@ 11170  11170@ 11310 
K0%                 2260  11110@ 11120 
K1%                 1210@  1210   1210   1210   1230@  2050@  2050   2110 
                    2220   2240   2240   2260   2260   2320   2320   2320 
                    2320   2330   2330   2330   2330   2330   2340   2340 
                    2510   2560   3020   3030   3110   3110   3110   3210 
                   12110  12110  12130  12130  12130  12130  12130  12130 
                   12140  12210  12210  12210  12240  12240@ 12240  12240 
                   12240@ 13010  13010  13010  13010  13110  13110  13210 
                   13210  15320  15420  15460  15460  15520  15530  15530 
                   15540  15620 
K1%(8)               910#  1210   9020  11170@ 12240 
K2%                 1210@  2050@  2050   2320  12120  12240  12240@ 12240 
                   12240  12240@ 13010  13110  13110  15420  15420  15530 
                   15620  15620  15920 
K8%                 3020  11110@ 19020 
K9$                  810@ 11120  11200 
K9%                 1210   9020   9020  11110@ 11170  11170@ 11170  11170 
                   11170  11180 
L$                 11130@ 11130  11130@ 11130  11130  11130@ 11130  11130 
                   11140  11140  11150  11160 
L%                  2010@  2040@  2110   2110   2110   2110   2110@  2110 
                    2220   2240   2250@  2250   2250   2320   2320   2320 
                   15530  15530  15570  15920 
L%(7,20)             936#  2320  12130@ 12210  13010  13110  15530 
L0%                  820@  1070   1070 
L9%                 1110@  1110  12230 
LINE                2020   2080 
M%(8)                924#  2240   2320   2330   2330@ 15620@
O%(7,20)             942# 12130@ 12210 
O9$                 1110@  1110   1110@  1110   1120   1130   1150   1170 
P%(7,20)             940#  2320  12130@ 13010  13110  15530 
P8$(63)=2, #10       964#
P8%(63), #10         962# 12010@ 12010@ 12020@ 12110  12110 
P9$(63)=16, #10      964# 12010@ 12030  12030@ 12120 
P9%(63,7), #10       962# 12030@ 12030  12030@ 12110  12110  12110  12110 
                   12130  12130  12130 
Q                  15540@ 15540  15540 
Q$                  1140@  1140   1140@  1140   1140   1140   2110@  2110@
                    2110   2110  11120@ 11120  11120@ 11160@ 11200  11320@
                   11410@ 12210@ 12210@ 12210@ 12240@ 15610# 15620  15620 
                   15620@ 15910# 15920  15920@ 15920  15920  20130# 20130 
                   20150# 20160 
Q%                  1210@  2250@  2260@  2330@  3020@  9010@  9010   9020@
                    9020  11140@ 11140  11140@ 11140  11150  11160  12010@
                   12010  12010@ 12010  12030@ 12030  12030@ 12030  12060 
                   15460# 15460  15530@ 15530  15530  15540@ 15540  15910#
                   15920  19020@ 20110# 20110  20130# 20130  20150# 20160 
R%                 12110@ 12120  12130  15310# 15340  15350  15350@ 15360 
                   15410# 15420  15420 
R%(7,20)             932# 12130@ 15460 
R0%                  810@  1210   2050  12240 
R1%                  810@  2010 
     Cross Reference Listing of DECDED.BAC on 01-Mar-77 at 04:01 PM      Page 4 

RECOUNT             2010 
S$                 11110@ 11110 
S0$                  810@ 12240  15620 
T%                 11120  11160  11170  11200@
T%(8)                914# 11170@ 15320  15420 
U1%                12240@ 12240  12240  12240 
U2%                12240@ 12240 
U3%                12240@ 12240 
V%                  2330@  2330 
V%(8,20)             926#  2320   2330@  2330@ 13010@ 13210 
V1$                  840@
V2$                  840@ 15420 
V3$                  840@ 15340 
X$                 12020@ 12020  12020  12030  12060 

The following variables may not have been referenced properly:
F0$               FNQ%              P8$(63)=2, #10    V1$               


   142 Variables   737 References   239 Statements  2023 Code elements

K-Words Reserved      Used      Free
  Data      3.49      2.35      1.15
  Code      4.51      4.15       .35
 Total      8.00      6.50      1.50