.TITLE	FLDIO
.IDENT	/2509.4/
;
;
;
;	WRITTEN BY	RAY DI MARCO
;			25-SEP-80.
;
;
;	VERSION		250980/04.
;
;
;--------------------------------------------------------------------------
;
;
; THIS MODULE CONTAINS THE ROUTINES NEEDED TO TRANSFER DATA OUT TO AND IN
; FROM A FIELD. THE ROUTUNES ARE-
;
; FLD.OU	TRANSFERS DATA FROM A RECORD INTO A FIELD AND DISPLAYS IT
;		ON THE CONSOLE.
;
; FLD.IN	INPUTS DATA FROM A FIELD BACK INTO ITS RECORD.
;
; FLD.CK	CHECKS DATA IN THE FIELD FOR VALIDITY. SHOULD BE USED
;		PRIOR TO CALLING 'FLD.IN'.
;
; FLD.ZE	IS USED TO ZERO THE CONTENTS OF A FIELD.
;
; FLD.ZP	ZERO FIELDS - IGNORE PROTECTION
;
;
.SBTTL	MODFICATIONS
;
;
; 27-OCT-80	CHANGE 'ASC #12 -> ASC #11' IN DATE BIN -> ASCII
; 12-JAN-81	ADD IN 'FLD.ZP' TO ZERO PROTECTED FIELDS
; 11-SEP-81	CHANGE 'FLD.Z*' SO SET DATE FIELDS TO 0! (NO 41)
;
;

;
;
;
.SBTTL	DOCUMENTATION	- ARGUMENT PASSING
;
;
; AT ENTRY 'FLD.OU' EXPECTS THE RECORD ADDRESS TO BE IN 'R5' AND THE
; ASSOCIATED RECORD DESCRIPTOR BLOCK TO BE IN 'R0'. THE ROUTINE TRANSFERS
; THE RECORD CONTENTS TO A ASCII WORK BUFFER AND ACTIVATES THE FIELD.
;
; AT ENTRY 'FLD.ZE' EXPECTS THE SAME ARGUMENTS AS 'FLD.OU'.
;
; THE OTHER TWO ROUTINES ACCEPT NO ARGUMENTS. THEY WORK ON THE RECORD LAST
; ACTIVATED BY 'FLD.OU'.
;
;
;
.SBTTL	DOCUMENTATION	- RECORD DESCRIPTOR BLOCK
;
;
; THE ADDRESS OF THIS BLOCK IS PASSED IN R0, AND IT HOLDS THE INFORMATION
; NEEDED TO WORK ON THE FIELD. ITS FORMAT IS-
;
;	.WORD	; TYPE OF FIELD (NUMBER 1-4)
;	.WORD	; SIZE OF ASCII FIELD
;	.WORD	; OFFSET FROM RECORD ADDRESS (R5) TO DATA
;	.WORD	; X COORDINATE OF FIELD
;	.WORD	; Y COORDINATE OF FIELD
;	.WORD	; CHECK WORD
;
;
;

;
;
.SBTTL	DECLARATIONS
;
;
.MCALL	.PUSH,.POP			; STACKING
;
;
.GLOBL	FLD.OU				; SET UP FIELD
.GLOBL	FLD.ZE,FLD.ZP			; ZERO A FIELD
.GLOBL	FLD.CK				; CHECK FIELD FOR LEGALITY
.GLOBL	FLD.IN				; INPUT FIELD INTO RECORD
;
.GLOBL	WNDIOT				; I/O SUPPORT ROUTINES
.GLOBL	WND.SU				; ACTIVATES FIELD (WNDIO)
.GLOBL	WND.SH				; SHOW FIELD CONTENTS
.GLOBL	CNAD				; NUMBER -> ASCII
.GLOBL	ASCNUM				; ASCII --> NUMBER
;
;
;
.SBTTL	DEFINITIONS
;
;
.TYPE	= 0				; TYPE WORD
.SIZE	= 2				; SIZE OF FIELD
.RECA	= 4				; ADDRESS OF RECORD
.XBASE	= 6				; X COORDINATE BASE
.YBASE	= 10				; Y COORDINATE BASE
.CHECK	= 12				; CHECK
;
;
;
	.PSECT	CODE			; OPEN CODE SECTION
;
;

;
;
;
.SBTTL	ROUTINE	- 'FLD.OU'	...	SET UP AND DISPLAY FIELD
;
;
;	THIS ROUTINE IS CALLED TO ACTIVATE A FIELD FOR USE WITH THE
;	'WNDIO' MODULE. THE PARAMETERS PASSED TO THIS ROUTINE ARE USED
;	TO SET UP THE 'WND.BL' TABLE.
;
;	HERE WE DISPATCH TO THE SECTION OF CODE DEPENDING ON THE
;	TYPE OF RECORD WE ARE PROCESSING. WE THEN DISPLAY THE FIELD CONTENTS.
;
;
FLD.OU:	.PUSH	<R0,R1,R2,R3,R4,R5>	; SAVE
	MOV	R0,RECPNT		; SAVE RECORD PARAMTER ADDRESS
	MOV	R5,RECADD		; SAVE ADDRESS OF RECORD
	MOV	(R0),R1			; TYPE CODE -> R1
	BIC	#^C377,R1		; FORGET FLAGS
	ADD	R1,R1			; 2*CODE -> R1
	CALL	@100$(R1)		; DISPATCH VIA TYPE
	CALL	WND.SH			; DISPLAY FIELD CONTENTS
	.POP	<R5,R4,R3,R2,R1,R0>	; RESTORE
	RETURN				; HOME
;
;
;
;
100$:	.WORD	1000$			; TYPE 0
	.WORD	1000$			; TYPE 1
	.WORD	2000$			; TYPE 2
	.WORD	3000$			; TYPE 3
	.WORD	4000$			; TYPE 4
;
;

;
;
;
;	THIS IS A ASCII TEXT TYPE RECORD. COPY THE CONTENTS OF THE
;	RECORD INTO THE TEMPORARY EDITING FIELD, AND SET UP
;	PARAMTERS.
;
;
;
2000$:
1000$:	CALL	SETUP			; SET UP RECORD DESCRIPTOR BLOCK
	MOV	.SIZE(R0),R1		; SIZE -> R1
	MOV	.RECA(R0),R2		; RECORD ADDRESS
	ADD	R5,R2			; GET ABSOLUTE RECORD ADDRESS
	MOV	#BUF,R3			; BUFFER ADDRESS -> R3
	CALL	COPY			; COPY ACCROSS RECORD
	CLRB	(R3)			; NULL AT END OF STRING PLEASE
	RETURN				; HOME
;
;
;

;
;
;
;	THIS IS A NUMBERIC RECORD. CONVERT THE BINARY NUMBER INTO
;	ASCII AND STORE THE RESULTANT STRING IN THE TEMPORARY BUFFER.
;
;
;
3000$:	CALL	SETUP			; SET UP RDB
	MOV	.RECA(R0),R2		; OFFSET TO NUMBER -> R2
	ADD	R5,R2			; GET ABSOLUTE RECORD ADDRESS
	CALL	LOADNM			; LOAD NUMBER INTO R2
	MOV	#BUF,R1			; BUFFER -> R1
	MOV	.SIZE(R0),R0		; SIZE -> R0
	CALL	CNAD			; NUMBER -> ASCII STRING
	CLRB	(R1)			; NULL PLEASE AT END
	RETURN				; HOME
;
;

;
;
;
;	THE RECORD IS A DATE. THE DATA IS STORE IN BINARY IN THE
;	FOLLOWING FORMAT-
;
;	BITS 15-12	YEAR (0==1972)
;	BITS 8-5	MONTH(1==JANUARY)
;	BITS 4-0	DAY
;
;	CONVERT THE BINARY PATTERN INTO A STRING OF THE FORMAT 'DD-MM-YY'
;	AND STORE IT IN THE BUFFER FOR EDITING.
;
4000$:	CALL	SETUP			; SET UP RDB
	MOV	.RECA(R0),R2		; OFFSET TO ADDRESS -> R2
	ADD	R5,R2			; GET ABSOLUTE RECORD ADDRESS
	CALL	LOADNM			; LOAD NUMBER INTO R2
	MOV	R2,R3			; DATE -> R3
	MOV	#BUF,R1			; BUF ADD -> R1
	MOV	#2,R0			; 2 BYTE NUMBERS FOR SUBFIELDS
	MOV	R3,R2			; DATE -> R2
	BIC	#^C31.,R2		; LEAVE DAYS ONLY
	CALL	CNAD			; DAYS -> ASCII
	MOVB	#'-,(R1)+		; DELIMITER
;
	MOV	R3,R2			; DATE -> R2
	ASH	#-5.,R2			; MONTH -> RIGHT
	BIC	#^C15.,R2		; LEAVE MONTH ONLY
	CALL	CNAD			; MONTH -> ASCII
	MOVB	#'-,(R1)+		; DELIMIT
;
	MOV	R3,R2			; DATE -> R2
	ASH	#-11.,R2		; YEAR -> RIGHT
	BIC	#^C15.,R2		; LEAVE YEAR ONLY
	ADD	#72.,R2			; ADJUST (OFFSET FROM 1972)
	CALL	CNAD			; TO ASCII
	CLRB	(R1)			; DELIMIT

	RETURN				; HOME
;
;
;

;
;
;
.SBTTL	ROUTINE	- 'FLD.IN'	...	INPUT CONTENTS OF FIELD
;
;
;	THIS ROUTINE CAUSES THE CONTENTS OF THE CURRENTLY ACTIVATED
;	FIELD TO BE INPUTED AND STORED IN ITS ASSOCIATED RECORD.
;
;	DISPATCH TO APPROPRIATE CODE DEPENDING ON TYPE OF FIELD/RECORD.
;
;
FLD.IN:	.PUSH	<R0,R1,R2,R3,R4,R5>	; SAVE
	MOV	RECPNT,R0		; GET RECORD DESCRIPT BLOCK ADDRESS
	MOV	RECADD,R5		; RECORD ADDRESS -> R5
	MOV	(R0),R1			; TYPE CODE -> R1
	BIC	#^C377,R1		; FORGET FLAGS
	ADD	R1,R1			; 2*CODE -> R1
	CALL	@100$(R1)		; DISPATCH VIA TYPE
	.POP	<R5,R4,R3,R2,R1,R0>	; RESTORE
	RETURN				; HOME
;
;
;
;
100$:	.WORD	1000$			; TYPE 0
	.WORD	1000$			; TYPE 1
	.WORD	2000$			; TYPE 2
	.WORD	3000$			; TYPE 3
	.WORD	4000$			; TYPE 4
;
;

;
;
;
;	WE ARE INPUT THE CONTENTS OF A TYPE 1/2 FIELD. SIMPLY COPY THE
;	ASCII STRING INTO THE RECORD.
;
;
;
1000$:					; CHARACTER RECORD
2000$:					; ALPA RECORD
	MOV	.SIZE(R0),R1		; NUM CHAR -> R1
	MOV	#BUF,R2			; BUFFER ADDRESS -> R2
	MOV	.RECA(R0),R3		; DESTINATION -> R3
	ADD	R5,R3			; ABOLUTE ADDRESS OF RECORD -> R3
	CALL	COPY			; COPY CHARACTERS
	RETURN				; HOME
;
;
;

;
;
;
;	WE ARE INPUTING THE CONTENTS OF A NUMERIC FIELD. CONVERT THE
;	ASCII NUMBER IN THE FIELD TO BINARY AND STORE IT.
;
;
;
3000$:	MOV	R0,R2			; SAVE
	MOV	#BUF,R1			; BUFFER ADDRESS -> R1
	CALL	ASCNUM			; NUMBER -> BINARY
	MOV	.RECA(R2),R2		; RECORD OFFSET -> R2
	ADD	R5,R2			; ABSOLUTE ADDRESS OF RECORD->R2
	CALL	SAVENM			; SAVE NUMBER
	RETURN				; HOME
;
;
;

;
;
;
;	INPUTTING THE CONTENTS OF A DATE FIELD. CONVERT THE DAY/MONTH/YEAR
;	TO BINARY AND MAKE UP A WORD QUANTITY FROM THE NUMBERS.
;
;
4000$:	MOV	R0,R4			; SAVE
	MOV	#BUF,R1			; POINT TO BUFFER
	CALL	ASCNUM			; DAY -> BINARY
	BIC	#^C31.,R0		; LEAVE DAY ONLY
	MOV	R0,R2			; SAVE
	TSTB	(R1)+			; SKIP DELIMITER
	CALL	ASCNUM			; MONTH -> BINARY
	BIC	#^C15.,R0		; LEAVE 4 BITS ONLY
	ASH	#5.,R0			; SHIFT
	ADD	R0,R2			; SAVE
	TSTB	(R1)+			; SKIP DELIMITER
	CALL	ASCNUM			; YEAR -> BINARY
	SUB	#72.,R0			; ADDJUST
	BIC	#^C31.,R0		; LEAVE YEAR ONLY
	ASH	#11.,R0			; SHIFT
	ADD	R0,R2			; ADD IN YEAR
	MOV	R2,R0			; DATE -> R0
	MOV	.RECA(R4),R2		; RECORD OFFSET -> R2
	ADD	R5,R2			; ABSOLUTE ADDRESS OF RECORD->R2
	CALL	SAVENM			; SAVE NUMBER
	RETURN				; HOME
;
;

;
;
;
.SBTTL	ROUTINE	- 'FLD.ZE/FLD.ZP'	...	ZERO FIELD
;
;
;	THIS ROUTINE IS CALLED TO ZERO A FIELD. THE 'FLD.ZE' ROUTINE WILL
;	NOT ZERO A PROTECTED FIELD, WHILE THE 'FLD.ZP' IGNORES THE
;	PROTECTION FLAG.

;
;	HERE WE DISPATCH TO THE SECTION OF CODE DEPENDING ON THE
;	TYPE OF RECORD WE ARE PROCESSING. WE THEN ZERO THE FIELD CONTENTS.
;
;
FLD.ZE:	.PUSH	<R0,R1,R2,R3,R4,R5>	; SAVE
	MOV	(R0),R1			; TYPE CODE -> R1
	.IIF	NDF,NOPROT,BMI	10$	; IF PROTECTED -> 10$
	BIC	#^C377,R1		; FORGET FLAGS
	ADD	R1,R1			; 2*CODE -> R1
	CALL	@ZE100$(R1)		; DISPATCH VIA TYPE
10$:	.POP	<R5,R4,R3,R2,R1,R0>	; RESTORE
	RETURN				; HOME
;
;
FLD.ZP:	.PUSH	<R0,R1,R2,R3,R4,R5>	; SAVE
	MOV	(R0),R1			; TYPE CODE -> R1
	BIC	#^C377,R1		; FORGET FLAGS
	ADD	R1,R1			; 2*CODE -> R1
	CALL	@ZE100$(R1)		; DISPATCH VIA TYPE
10$:	.POP	<R5,R4,R3,R2,R1,R0>	; RESTORE
	RETURN				; HOME
;
;
;
;
ZE100$:	.WORD	1000$			; TYPE 0
	.WORD	1000$			; TYPE 1
	.WORD	2000$			; TYPE 2
	.WORD	3000$			; TYPE 3
	.WORD	4000$			; TYPE 4
;
;

;
;
;
;	THIS IS AN ASCII TYPE FIELD - TO ZERO IT FILL IT WITH SPACES.
;
;
2000$:
1000$:	MOV	.SIZE(R0),R1		; SIZE -> R1
	MOV	.RECA(R0),R2		; RECORD ADDRESS
	ADD	R5,R2			; GET ABSOLUTE RECORD ADDRESS
2010$:	MOVB	#40,(R2)+		; SPACE
	SOB	R1,2010$		; LOOP
	RETURN				; HOME
;
;
;

;
;
;	TO ZERO A NUMBER MAKE IT '0'.
;
;
3000$:	MOV	.RECA(R0),R2		; OFFSET TO NUMBER -> R2
	ADD	R5,R2			; GET ABSOLUTE RECORD ADDRESS
	CLR	R0			; 0 -> R0
	CALL	SAVENM			; SAVE 0
	RETURN				; HOME
;
;

;
;
;
;	THE RECORD IS A DATE. THE DATA IS STORE IN BINARY IN THE
;	FOLLOWING FORMAT-
;
;	BITS 15-12	YEAR (0==1972)
;	BITS 8-5	MONTH(1==JANUARY)
;	BITS 4-0	DAY
;
;	ZERO DATE TIME.
;
;
4000$:	MOV	.RECA(R0),R2		; OFFSET TO ADDRESS -> R2
	ADD	R5,R2			; GET ABSOLUTE RECORD ADDRESS
;;	MOV	#41,R0			; 1/1/72 ==> R0
	CLR	R0			;; 0 -> R0
	CALL	SAVENM			; SAVE IT
	RETURN				; HOME
;
;

;
;
;
.SBTTL	ROUTINE	- 'FLD.CK'	...	CHECK FIELD FOR ERRORS
;
;
;	WE SCAN THE ACTIVATED FIELD TO SEE IF IT CONTAINS ERRONEOUS
;	DATA. DISPATCH TO CODE FOR EACH TYPE OF FIELD.
;
;
FLD.CK:	.PUSH	<R0,R1,R2,R3,R4,R5>	; SAVE
	MOV	RECPNT,R0		; GET RECORD DESCRIPT BLOCK ADDRESS
	MOV	RECADD,R5		; RECORD ADDRESS -> R5
	MOV	(R0),R1			; TYPE CODE -> R1
	BIC	#^C377,R1		; FORGET FLAGS
	ADD	R1,R1			; 2*CODE -> R1
	CALL	@100$(R1)		; DISPATCH VIA TYPE
	.POP	<R5,R4,R3,R2,R1,R0>	; RESTORE
	RETURN				; HOME
;
;
;
;
100$:	.WORD	1000$			; TYPE 0
	.WORD	1000$			; TYPE 1
	.WORD	2000$			; TYPE 2
	.WORD	3000$			; TYPE 3
	.WORD	4000$			; TYPE 4
;
;

;
;	NO NEED TO CHECK CHARACTER/ALPA FIELDS (DONE BY 'WNDIO')
;
;
1000$:					; CHARACTER RECORD
2000$:					; ALPA RECORD
	CLC				; HAS TO BE RIGHT
	RETURN				; HOME
;
;
;
;	CHECKING A NUMBER FIELD. ENSURE THAT NUMBER IN RANGE.
;
3000$:	MOV	R0,R2			; SAVE
	MOV	#BUF,R1			; BUFFER ADDRESS -> R1
	CALL	ASCNUM			; NUMBER -> BINARY
	CMP	R0,.CHECK(R2)		; WITHIN LIMITS?
	BHI	3100$			; NO -> 3100$
	CLC				; CLEAR ERROR FLAG
	RETURN				; HOME
3100$:	SEC				; SET FAIL
	RETURN				; HOME
;
;
;
;	CHECKING A DATE FIELD. CHECK DAY/MONTH FOR SILLIES.
;
;
4000$:	MOV	#BUF,R1			; POINT TO BUFFER
	.IRP	X,<#31.,#12.>		; ---- CHECK DAY/MONTH ----
	CALL	ASCNUM			; DAY -> BINARY
	TST	R0			; = 0?
;	BEQ	4100$			; YES -> ERROR
	CMP	R0,'X			; WITHIN LIMITS
	BHI	4100$			; NO -> ERROR
	TSTB	(R1)+			; SKIP DELIMITER
	.ENDR				; ---------------------------------
	CLC				; CLEAR FAIL FLAG
	RETURN				; HOME
4100$:	SEC				; SET FAIL
	RETURN				; HOME
;
;

;
;
;
.SBTTL	PRIMITIVE	- 'SETUP'	...	SET UP WND.BL
;
;
;	AT ENTRY R0 HOLDS THE RECORD TYPE BY TWO. USE THIS NUMBER
;	TO INDEX INTO 'WNDIOT' TO SELECT WHICH ROUTINES ARE
;	REQUIRED FOR I/O SUPPORT. SET UP THE ORIGIN COORDINATES
;	FOR THE FIELD AND ACTIVATE IT.
;
;
;
SETUP:	.PUSH	<R0,R4,R5>		; SAVE
	MOV	WNDIOT(R1),R5		; I/O ROUTINE TABLE -> R5
	MOV	#INSERT,R4		; STORE POINTER -> R4
	.REPT	4			; --- 4 WORDS TO COPY ---
		MOV	(R5)+,(R4)+	; SET UP I/O ADDRESS
	.ENDR				; END OF REPEAT SECTION
	MOV	.XBASE(R0),XBASE	; SET UP BASE COORDINATE
	MOV	.YBASE(R0),YBASE	; SET UP Y BASE
	MOV	.SIZE(R0),XMAX		; SET UP XMAX
	MOV	#XBASE,R0		; PARMATER BLOCK ADDRESS
	CALL	WND.SU			; ACTIVATE THIS FIELD
	.POP	<R5,R4,R0>		; RESTORE
	RETURN				; HOME
;
;
;

;
;
;
.SBTTL	PRIMITIVE	- 'COPY'	...	(R2)->(R3)
;
;
;	COPY STRING (R2) TO (R3), GIVEN THAT STRING LENGHT IS
;	HELD IN 'R1'.
;
;
COPY:	MOVB	(R2)+,(R3)+		; COPY
	SOB	R1,COPY			; LOOP
	RETURN				; HOME
;
;
;

;
;
;
.SBTTL	ROUTINE	- 'LOADNM'	... WORD (@R2) --> R3
;
;
;	LOAD A WORD QUANTITY INTO 'R3'. THE WORD ADDRESS IS IN R2 AND
;	IT CAN BE ODD!
;
;
LOADNM:	.PUSH	R1			; SAVE
	MOVB	(R2)+,R1		; LOB -> R1
	BIC	#^C377,R1		; LEAVE BOTTOM 8 BITS
	MOVB	(R2),R2			; HOB -> R2
	BIC	#^C377,R2		; LEAVE HOB ONLY
	SWAB	R2			; HOB -> HOB R2
	ADD	R1,R2			; FORM NUMBER
	.POP	R1			; RESTORE
	RETURN
;
;
;
.SBTTL	ROUTINE	- 'SAVENM'	...	SAVE WORD (R0) --> @R2
;
;
;	SAVE THE WORD IN R0 AT ADDRESS IN R2 (WHICH CAN BE ODD).
;
;
SAVENM:	.PUSH	<R0,R2>			; SAVE
	MOVB	R0,(R2)+		; SAVE LOB
	SWAB	R0			; HOB -> LOB
	MOVB	R0,(R2)+		; SAVE HOB
	.POP	<R2,R0>			; RESTORE
	RETURN
;
;
;

;
;
;
.SBTTL	VARIABLE AREA
;
;
RECPNT:	.WORD	0			; ADDRESS OF ACTIVE RECORD BLOCK
RECADD:	.WORD	0			; ADDRESS OF RECORD
;
;
;
XBASE:	.WORD	0			; X ORIGIN
YBASE:	.WORD	0			; Y ORIGIN
XMAX:	.WORD	0			; X MAX
YMAX:	.WORD	0			; Y MAX
;
BUFADD:	.WORD	BUF			; INPUT BUFFER ADDRESS
INSERT:	.WORD	0			; INSERT ROUTINE ADDRESS
CLEAR:	.WORD	0			; CLEAR ROUTINE
DELLFT:	.WORD	0			; DELETE ROUTINE ADDRESS
DELRHT:	.WORD	0			; DELETE RIGHT ROUTINE
;
;
;
BUF:	.BLKB	120.			; TEMP BUFFER
.END