;***************************************************************************;
;                              STUVUE.M68
;	for use with STUVUE.BAS 
;									    ;
;		ORIGINALLY    EDIT.M68   by David F. Pallmann				    ;
;		CRT-oriented type-checked field input routine		    ;
;									    ;
;			  Author: David F. Pallmann			    ;
;	     Copyright (C) 1984 by LMS Technical Services, Inc.		    ;
;			modified for STUVUE.M68 						    ;
;                           22-may-86 
;                        James A. Jarboe IV
;***************************************************************************;
;
;	Calling Format--.
;
;		XCALL STUVUE, "row col type minsiz maxsiz flags ", field, key
;
;	Where--.
;		row	= CRT row (1-24)
;		col	= CRT column (1-80)
;		type	= one of the following--.
;				* = string
;				A = alphabetic
;				@ = alphanumeric
;				I = integer
;				F = floating point
;				$ = dollar amount
;				Y = yes/no
;		minsiz	= minimum field size
;		maxsiz	= maximum field size
;		flags	= zero or more of the following--.
;				R = required field
;				A = automatic field
;				U = upper-case field
;				L = lower-case field
;				F = folded field
;				N = no blanks allowed
;				- = leading minus allowed
;				E = position at end of field
;				T = trap ^Cs
;				P = password field
;		
;		field	= string variable to edit
;		key	= 2 byte binary return code--.
;				0   = standard end of field
;				1   = ESCape
;				2   = up-arrow (^K)
;				3   = down-arrow (^J)
;				4   = TAB
;				5   = ^T
;				6   = ^R
;				7   = ^B
;				8   = ^E
;				9   = ^^ (home)
;				1xx = function code xx
;				2xx = shifted function code xx

	OBJNAM	STUVUE.SBR

	VMAJOR=1

	;edit history

;	VEDIT=0		;22-Jun-84 DFP created from CRT.M68
	VEDIT=1         ;22-May-86 JAJ modified for STUVUE 

	;universals

	SEARCH	SYS
	SEARCH	SYSSYM
	SEARCH	TRM
	SEARCH	MACLIB

	;ASCII chars

	BS=10
	TAB=11
	LF=12
	CR=15
	ESC=33
	DEL=177

	;XCALL offsets

	.OFINI
	.OFDEF	XC.ARG,2			;argument count
	.OFDEF	XC.TY1,2			;parameter string (type)
	.OFDEF	XC.AD1,4			;parameter string (addr)
	.OFDEF	XC.SZ1,4			;parameter string (size)
	.OFDEF	XC.TY2,2			;string variable (type)
	.OFDEF	XC.AD2,4			;string variable (addr)
	.OFDEF	XC.SZ2,4			;string variable (size)
	.OFDEF	XC.TY3,2			;return variable (type)
	.OFDEF	XC.AD3,4			;return variable (addr)
	.OFDEF	XC.SZ3,4			;return variable (size)
	.OFDEF	XC.TY4,2			;status line text (type)
	.OFDEF	XC.AD4,4			;status line text (addr)
	.OFDEF	XC.SZ4,4			;status line text (size)
	.OFSIZ	XC.SIZ

	;variable type codes

	XC$STR=2
	XC$BIN=6

	;impure area

	.OFINI
	.OFDEF	ROW,2				;cursor row
	.OFDEF	COL,2				;cursor column
	.OFDEF	TYPE,2				;field type--.
		T.STR=0				; string
		T.ALF=2				; alphabetic
		T.ANM=4				; alphanumeric
		T.INT=6				; integer
		T.FLT=10			; floating point
		T.AMT=12			; dollar amount
		T.YNO=14			; yes/no
	.OFDEF	MINSIZ,2			;min. field size
	.OFDEF	MAXSIZ,2			;max. field size
	.OFDEF	FLAGS,4				;flags--.
		F.REQ=1				; required field
		F.AUT=2				; automatic field
		F.UCS=4				; upper-case field
		F.LCS=10			; lower-case field
		F.NAM=20			; namefold field
		F.NSP=40			; spaces invalid
		F.NEG=100			; leading minus valid
		F.END=200			; position cursor at end of field
		F.CTC=400			; trap ^Cs			101
		F.PSW=1000			; password field		101
		F.UND=20000
		F.CHR=40000
		F.ERR=100000			; an error has occurred
	.OFDEF	SIZE,2				;field size
	.OFDEF	POS,2				;position within field
	.OFSIZ	IMPSIZ

PAGE
;entry point from AlphaBASIC
;A3 indexes argument list

ENTRY:	PHDR	-1,0,PH$REE!PH$REU	;program header
	CALL	INIT			;initialize storage
	CALL	CHKPRM			;check parameters
	RNE				; errors
 	CALL	DISFLD			;display field
	CALL	EDTFLD			;edit field
 	CALL	REDISP			;re-display field
	RTN				;return to BASIC

PAGE
;******
;CHKPRM
;******
;check paramters

CHKPRM:	CALL	CHKARG			;check argument types and sizes
	CALL	GETROW			;get row
	CALL	GETCOL			;get column
	CALL	GETTYP			;get data type
	CALL	GETMIN			;get min size
	CALL	GETMAX			;get max size
	CALL	GETFLG			;get flags
	CALL	GETSTS			;get status line
	BIT	#F.ERR,FLAGS(A4)	;set Z according to errors
	RTN

;check types and sizes of arguments

CHKARG:	CMMW	XC.ARG(A3),#3		;3 arguments (or more) present?	103
	JLT	ARGERR			; no - error			103
	CMMW	XC.TY1(A3),#XC$STR	;1st argument a string?
	JNE	VARERR			; no - error
	CMMW	XC.TY2(A3),#XC$STR	;2nd argument a string?
	JNE	VARERR			; no - error
	CMMW	XC.TY3(A3),#XC$BIN	;3rd argument binary?
	JNE	VARERR			; no - error
	CMM	XC.SZ3(A3),#2		;3rd argument 2 bytes in length?
	JNE	SIZERR			; no - error
	MOV	XC.AD1(A3),A2		;index parameter string
	RTN

;get row from parameter string

GETROW:	BYP
	NUM
	JNE	MISERR
	GTDEC
	MOVW	D1,ROW(A4)
	RTN

;get column from parameter string

GETCOL:	BYP
	NUM
	JNE	MISERR
	GTDEC
	MOVW	D1,COL(A4)
	RTN

;get data type from parameter string

GETTYP:	BYP
	MOVB	(A2)+,D1
	UCS
	LEA	A0,TYPTBL
	MOV	#-2,D0
10$:	TSTB	@A0
	JEQ	TYPERR
	ADD	#2,D0
	CMMB	(A0)+,D1
	BNE	10$
	MOVW	D0,TYPE(A4)
	RTN

TYPTBL:	ASCIZ	/*A@IF$Y/
	EVEN

;get min size from parameter string

GETMIN:	BYP
	NUM
	JNE	MISERR
	GTDEC
	MOVW	D1,MINSIZ(A4)
	RTN

;get max size from parameter string

GETMAX:	BYP
	NUM
	JNE	MISERR
	GTDEC
	MOVW	D1,MAXSIZ(A4)
	RTN

;get flags from parameter string

GETFLG:	BYP				;bypass leading spaces
10$:	MOVB	(A2)+,D1		;get char
	UCS				;fold to upper case
	LEA	A0,FLGTBL		;index flag table
	MOV	#1,D0			;set bit flag
20$:	TSTB	@A0			;end of table?
	REQ				; yes - end of flag processing
	CMMB	(A0)+,D1		;char match?
	BEQ	30$			; yes
	ASL	D0			; no - shift to next bit
	BR	20$			;try again
30$:	OR	D0,FLAGS(A4)		;set bit flag
	BR	10$			;process next flag char

FLGTBL:	ASCIZ	/RAULFN-ETP/
	EVEN

;get status line (if specified)						103

GETSTS: CMMW	XC.ARG(A3),#4		;status line specified?		103
	BGE	10$			; yes - branch			103
	RTN				; no				103
10$:	MOV	XC.AD4(A3),A0		;				103
	MOV	XC.SZ4(A3),D0		;				103
	MOVW	#-1_8.+38.,D1		;start				103
	TCRT				; status line			103
20$:	MOVB	(A0)+,D1		;				103
	TTY				;				103
	SOB	D0,20$			;				103
	MOVW	#-1_8.+39.,D1		;end				103
	TCRT				; status line			103
;	MOVW	#-1_8.+40.,D1		;status line			103
;	TCRT				; on				103
	RTN

PAGE
;****
;INIT
;****
;initialize storage

INIT:	MOV	XC.AD3(A3),A6		;index return code
	CLRW	@A6			;clear return code
	CLRW	SIZE(A4)
	CLRW	POS(A4)
	CLR	FLAGS(A4)
	RTN

PAGE
;******
;DISFLD
;******
;display field for editing

DISFLD:	CRT	ROW(A4),COL(A4)		;position cursor at start of field
	BIT	#F.UND,FLAGS(A4)	;				105
	BEQ	4$			;				105
	CRT	#5			;				105
	CRT	#30.			;				105
4$:	CRT	#12.			;high intensity
	MOV	XC.AD2(A3),A2		;index start of buffer
	CLR	D0
	MOVW	MAXSIZ(A4),D0		;D0 ::= max size
	BEQ	40$			;if zero return
10$:	MOVB	(A2)+,D1		;get next char
 	BEQ	20$			;branch if NUL
 	CALL	TTY			;display char			101
	INCW	SIZE(A4)		;update size
	SOB	D0,10$			;loop till all chars output
	BR	40$			;if full bufferm branch
20$:;	CRT	#11.			;low intensity
    ;	CALL	PADCHR			;				105
30$:;	TTY				;output pad char
    ;	SOB	D0,30$			;loop till full size displayed
40$:	BIT	#F.UND,FLAGS(A4)	;				105
	BEQ	44$			;				105
	CRT	#31.			;				105
44$:	RTN				;return

PAGE
;******
;EDTFLD
;******
;edit field

EDTFLD:	MOV	JOBCUR,A0		;index own JCB
	MOV	JOBTRM(A0),A0		;index own TRMDEF block
	ORW	#<T$DAT!T$ECS>,T.STS(A0);set data mode, no echo
	CRT	#12.			;high intensity
	BIT	#F.END,FLAGS(A4)	;end-of-field bit set?
	BNE	POSEND			; yes - special processing

;index start of field

POSBEG:	CRT	ROW(A4),COL(A4)
	MOV	XC.AD2(A3),A2
	BR	GETCHR

;index end of field

POSEND:	MOVW	ROW(A4),D1
	ROLW	D1,#8.
	ADDW	COL(A4),D1
	ADDW	SIZE(A4),D1
	TCRT
	MOVW	SIZE(A4),POS(A4)
	MOV	XC.AD2(A3),A2
	ADDW	SIZE(A4),A2

GETCHR:	KBD				;get char

FKEY:	CMPB	D1,#'@			;simulated function key?
	BEQ	SIMFKY			; yes
	TSTB	D1			;function key sequence?		102
	BPL	CHKCTL			; no				102
	CMPB	D1,#240			;shifted function key?		102
	BHIS	10$			; yes				102
	SUB	#28.,D1			;unshifted keys return 100. up	102
	BR	20$			;				102
10$:	SUB	#<40+8.>,D1		;shifted keys return 200. up	102
20$:	MOV	XC.AD3(A3),A6		; yes - return code		102
	MOVW	D1,@A6			;				102
	JMP	ENDFLD			;				102

SIMFKY:	KBD
	CMPB	D1,#'1
	BLE	CHKCTL
	AND	#177,D1
	SUBW	#'1,D1
	MOV	XC.AD3(A3),A6
	MOVW	D1,@A6
	JMP	ENDFLD

CHKCTL:	AND	#177,D1			;mask to 7-bit ASCII
	BIT	#F.CHR,FLAGS(A4)	;single char?
	JNE	VALID			; yes - valid
	LEA	A0,CHRTBL		;index char table
	MOV	#-2,D0			;pre-set jump index
10$:	TSTB	@A0			;end of table?
	JEQ	CHECK			; yes - process as a text char
	ADD	#2,D0			;update jump index
	CMMB	(A0)+,D1		;char match?
	BNE	10$			; no - try next char in table
	TJMP	D0			; yes - branch on index
	OFFSET	BCKWRD			;^A  - back word
	OFFSET  CTRL.B			;^B  - 
	OFFSET	CTRL.C			;^C  - abort
	OFFSET	DELCHR			;^D  - delete char
	OFFSET  CTRL.E			;^E
	OFFSET	INSCHR			;^F  - insert char
	OFFSET	BCKCHR			;BS  - char left
	OFFSET	TABSCR			;TAB - forward screen
	OFFSET	FWDFLD			;^J  - forward field
	OFFSET	BCKFLD			;^K  - back field
	OFFSET	FWDCHR			;^L  - char right
	OFFSET	RETURN			;CR  - end of field
	OFFSET	ENDLIN			;^N  - end of field
 	OFFSET	RTNPGE			;^R  - same as ESC
 	OFFSET	TRNPGE			;^T  - same as TAB
	OFFSET	BEGFLD			;^U  - beginning of field
	OFFSET	FWDFLD			;^V  - forward field
	OFFSET	FWDWRD			;^W  - forward word
	OFFSET	DELEOL			;^Y  - delete to end of line
	OFFSET	DELFLD			;^Z  - delete field
	OFFSET	TOGGLE			;^\  - namefold toggle
	OFFSET	ESCAPE			;ESC - back screen
	OFFSET	DELCHR			;_   - delete char
	OFFSET	DELCHR			;DEL - delete char
	OFFSET  HOME			;^^

CHRTBL:	BYTE	'A-'@			;^A
	BYTE	'B-'@			;^B
	BYTE	'C-'@			;^C
	BYTE	'D-'@			;^D
	BYTE	'E-'@			;^E
	BYTE	'F-'@			;^F
	BYTE	BS			;backspace
	BYTE	TAB			;tab
	BYTE	LF			;LF
	BYTE	'K-'@			;^K
	BYTE	'L-'@			;^L
	BYTE	CR			;CR
	BYTE	'N-'@			;^N
	BYTE	'R-'@			;^R
	BYTE	'T-'@			;^T
	BYTE	'U-'@			;^U
	BYTE	'V-'@			;^V
	BYTE	'W-'@			;^W
	BYTE	'Y-'@			;^Y
	BYTE	'Z-'@			;^Z
	BYTE	'\-'@			;^\
	BYTE	ESC			;ESC
	BYTE	'_			;_
	BYTE	DEL			;DEL
	BYTE	'^-'@			;^^
	BYTE	0
	EVEN

;^A
;back word

BCKWRD:	TSTW	POS(A4)
	JEQ	GETCHR
	BR	20$
10$:	TSTW	POS(A4)
	JEQ	GETCHR
	CMMB	@A2,#40
	BNE	30$
20$:	CRT	#5
	DEC	A2
	DECW	POS(A4)
	BR	10$
30$:	TSTW	POS(A4)
	JEQ	GETCHR
	CMMB	-1(A2),#40
	JEQ	GETCHR
	CRT	#5
	DEC	A2
	DECW	POS(A4)
	BR	30$

;^F
;insert char

INSCHR:	CMMW	SIZE(A4),MAXSIZ(A4)
	JEQ	GETCHR
	CMMW	POS(A4),SIZE(A4)
	JEQ	GETCHR
	TYPESP
	CLR	D0
	MOVW	SIZE(A4),D0
	SUBW	POS(A4),D0
	SAVE	A2
10$:	MOVB	(A2)+,D1
	CALL	TTY			;				101
	SOB	D0,10$
	MOVW	SIZE(A4),D0
	SUBW	POS(A4),D0
	INC	D0
	MOV	XC.AD2(A3),A2
	ADDW	SIZE(A4),A2
	INC	A2
20$:	MOVB	-(A2),1(A2)
	SOB	D0,20$
	REST	A2
	MOVB	#40,@A2
	INCW	SIZE(A4)
	MOVW	ROW(A4),D1
	ROLW	D1,#8.
	ADDW	COL(A4),D1
	ADDW	POS(A4),D1
	TCRT
	JMP	GETCHR

;^H
;move back one char

BCKCHR:	TSTW	POS(A4)
	JEQ	GETCHR
	CRT	#5
	DECW	POS(A4)
	DEC	A2
	JMP	GETCHR

;^K
;back field

BCKFLD:	MOV	XC.AD3(A3),A6
	MOVW	#2,@A6
	JMP	ENDFLD

;^I, TAB
;end screen

TABSCR:	MOV	XC.AD3(A3),A6
	MOVW	#4,@A6
	JMP	CHKFLD

;^J, LF
;next field

FWDFLD:	MOV	XC.AD3(A3),A6
	MOVW	#3,@A6
	JMP	CHKFLD

;^L
;forward char

FWDCHR: CMMW	POS(A4),SIZE(A4)
	JEQ	GETCHR
	CRT	#6
	INCW	POS(A4)
	INC	A2
	JMP	GETCHR

;^M, CR
;end of field

RETURN:	MOV	XC.AD3(A3),A6
	CLRW	@A6

;check for valid end of field

CHKFLD:	CMMW	POS(A4),MINSIZ(A4)
	JGE	ENDFLD
	TSTW	POS(A4)
	JNE	GETCHR
	CMMW	SIZE(A4),MINSIZ(A4)
	JGE	ENDFLD
	BIT	#F.REQ,FLAGS(A4)
	JEQ	ENDFLD
	JMP	GETCHR

;^U
;beginning of field

BEGFLD:	TSTW	POS(A4)
	JEQ	GETCHR
	CLRW	POS(A4)
	MOV	XC.AD2(A3),A2
	CRT	ROW(A4),COL(A4)
	JMP	GETCHR

;^N
;end of field

ENDLIN:	CMMW	POS(A4),SIZE(A4)
	JEQ	GETCHR
	MOVW	SIZE(A4),POS(A4)
	MOV	XC.AD2(A3),A2
	ADDW	SIZE(A4),A2
	MOVW	ROW(A4),D1
	ROLW	D1,#8.
	ADDW	COL(A4),D1
	ADDW	SIZE(A4),D1
	TCRT
	JMP	GETCHR

;^W
;forward word

FWDWRD:	;CMMW	POS(A4),SIZE(A4)
	;JEQ	GETCHR
	;BR	20$
10$:	CMMW	POS(A4),SIZE(A4)
	JEQ	GETCHR
	CMMB	@A2,#40
	BEQ	30$
20$:	CRT	#6
	INC	A2
	INCW	POS(A4)
	BR	10$
30$:	CMMW	POS(A4),SIZE(A4)
	JEQ	GETCHR
	CMMB	@A2,#40
	JNE	GETCHR
	CRT	#6
	INC	A2
	INCW	POS(A4)
	BR	30$

;^Y
;delete to end of line

DELEOL:	TSTW	SIZE(A4)
	JEQ	GETCHR
	CLR	D0
	MOVW	SIZE(A4),D0
	SUBW	POS(A4),D0		;D0 := chars to right of cursor
	JEQ	GETCHR			;nothing to delete
	MOVW	POS(A4),SIZE(A4)
	CLRB	@A2
      	CRT	#11.
      	CALL	PADCHR			;				105
10$:  	TTY
      	SOB	D0,10$
      	CRT	#12.
	MOVW	ROW(A4),D1
	ROLW	D1,#8.
	ADDW	COL(A4),D1
	ADDW	SIZE(A4),D1
	TCRT
	JMP	GETCHR

;^Z
;delete field

DELFLD:	CRT	ROW(A4),COL(A4)
	CLRW	POS(A4)
	CLRW	SIZE(A4)
	MOV	XC.AD2(A3),A2
	CLR	D0
	MOVW	MAXSIZ(A4),D0
	CRT	#11.
	CALL	PADCHR			;			105
10$:	TTY
	SOB	D0,10$
	CRT	#12.
	CRT	ROW(A4),COL(A4)
	JMP	GETCHR

;^\
;toggle namefold

TOGGLE:	TTYI
	BYTE	7,0
	XOR	#F.NAM,FLAGS(A4)
	JMP	GETCHR

;^C
CTRL.C:	BIT	#F.CTC,FLAGS(A4)
	JNE	GETCHR
	MOV	JOBCUR,A0
	ORW	#<J.CCC>,JOBSTS(A0)
	BR	ENDFLD

;^E
;End of file
CTRL.E:
	MOV	XC.AD3(A3),A6
	MOVW	#8.,@A6
	JMP	ENDFLD
;^^
;HOME
HOME:
	MOV	XC.AD3(A3),A6
	MOVW	#9.,@A6
	JMP	ENDFLD

;^B
; New line
CTRL.B:
	MOV	XC.AD3(A3),A6
	MOVW	#7,@A6
	JMP	ENDFLD
;^T
; turn a page
TRNPGE:
	MOV	XC.AD3(A3),A6
	MOVW	#5,@A6
	JMP 	CHKFLD
;^R
; return a page
RTNPGE:
	MOV	XC.AD3(A3),A6
	MOVW	#6,@A6
	JMP 	CHKFLD
;ESC
;back screen

ESCAPE:	MOV	XC.AD3(A3),A6
	MOVW	#1,@A6

;end of field processing

ENDFLD:	;TSTW	POS(A4)							104
	;BNE	10$							104
	MOVW	SIZE(A4),POS(A4)
10$:	MOV	JOBCUR,A0
	MOV	JOBTRM(A0),A0
	ANDW	#^C<T$DAT!T$ECS!T$XLT>,T.STS(A0)
	CMMW	POS(A4),MAXSIZ(A4)
	BEQ	20$
	MOV	XC.AD2(A3),A2
	MOVW	POS(A4),D7
	ADDW	D7,A2
	CLRB	@A2
20$:	MOVW	POS(A4),SIZE(A4)
	CMMW	XC.ARG(A3),#4		;status line specified?		103
;	BLT	30$			; no				103
;	MOVW	#-1_8.+41.,D1		;status line			103
;	TCRT				; off				103
30$:	RTN				;				103

;^D, DEL
;delete char

DELCHR:	TSTW	SIZE(A4)
	JEQ	GETCHR
	CMMW	POS(A4),SIZE(A4)
	BLT	DELMID
	CRT	#11.
	TTYI
	BYTE	10,0
	CALL	PADCHR
	TTY
	TTYI
	BYTE	10,0
	CRT	#12.
	DECW	POS(A4)
	DECW	SIZE(A4)
	DEC	A2
	JMP	GETCHR

;delete char in middle of string

DELMID:	CLR	D0
	MOVW	SIZE(A4),D0
	SUBW	POS(A4),D0
;	INC	D0
	SAVE	A2
	INC	A2
10$:	MOVB	(A2)+,D1
	CALL	TTY			;				101
	MOVB	D1,-2(A2)
	SOB	D0,10$
	CRT	#11.
	CALL	PADCHR
	TTY
	CRT	#12.
	REST	A2
	MOVW	ROW(A4),D1
	ROLW	D1,#8.
	ADDW	COL(A4),D1
	ADDW	POS(A4),D1
	TCRT
	DECW	SIZE(A4)
	JMP	GETCHR

PAGE
;check char against data type

CHECK:	CMPB	D1,#40
	JLT	GETCHR
	CMPB	D1,#125.
	JGT	GETCHR
	TJMP	TYPE(A4)
	OFFSET	CHKSTR
	OFFSET	CHKALF
	OFFSET	CHKANM
	OFFSET	CHKINT
	OFFSET	CHKFLT
	OFFSET	CHKAMT
	OFFSET	CHKYNO

;string

CHKSTR:	CALL	SPACE
	JEQ	VALID
	JMP	VALID

;alphabetic

CHKALF:	CALL	SPACE
	JEQ	VALID
	CALL	ALPHA
	JEQ	VALID
	JMP	GETCHR

;alphanumeric

CHKANM:	CALL	SPACE
	JEQ	VALID
	CALL	ALPHA
	JEQ	VALID
	CALL	NUMBER
	JEQ	VALID
	JMP	GETCHR

;integer

CHKINT:	CALL	SPACE
	JEQ	VALID
	CALL	MINUS
	JEQ	VALID
	CALL	NUMBER
	JEQ	VALID
	JMP	GETCHR

;floating point

CHKFLT:	CALL	MINUS
	JEQ	VALID
	CALL	NUMBER
	JEQ	VALID
	JMP	GETCHR

;dollar amount

CHKAMT:	CALL	MINUS
	JEQ	VALID
	CALL	NUMBER
	JEQ	VALID
	JMP	GETCHR

;yes/no

CHKYNO:	CMPB	D1,#'Y
	BEQ	10$
	CMPB	D1,#'N
	BEQ	10$
	CMPB	D1,#'y
	BEQ	10$
	CMPB	D1,#'n
	BEQ	10$
	JMP	GETCHR
10$:	JMP	VALID

;return Z=1 if alphabetic char

ALPHA:	CMPB	D1,#'A
	BLT	10$
	CMPB	D1,#'z
	BGT	10$
	CMPB	D1,#'Z
	BLE	20$
	CMPB	D1,#'a
	BGE	20$
10$:	LCC	#0
	RTN
20$:	LCC	#4
	RTN

;return Z=1 if numeric char

NUMBER:	CMPB	D1,#'0
	BLT	20$
	CMPB	D1,#'9
	BGT	20$
10$:	LCC	#4
	RTN
20$:	LCC	#0
	RTN

;return Z=1 if char is a space, and F.NSP is not set

SPACE:	CMPB	D1,#40
	BNE	20$
	BIT	#F.NSP,FLAGS(A4)
	BNE	20$
10$:	LCC	#4
	RTN
20$:	LCC	#0
	RTN

;return Z=1 if char is a minus, and F.NEG set

MINUS:	CMPB	D1,#'-
	BNE	20$
	BIT	#F.NEG,FLAGS(A4)
	BEQ	20$
	TSTW	POS(A4)
	BNE	20$
10$:	LCC	#4
	RTN
20$:	LCC	#0
	RTN

PAGE
;character has been determined to be a valid text character for this field.

VALID:	CMMW	POS(A4),MAXSIZ(A4)	;is field full?
	JGE	GETCHR			; yes - must reject char
	CALL	CASE			;perform special case checking
	CALL	TTY			;display the char		101
	MOVB	D1,(A2)+		;store the char
	INCW	POS(A4)			;update position
	CMMW	POS(A4),SIZE(A4)	;do we need to update size?
	BLE	10$			; no - get next char
	INCW	SIZE(A4)		; yes - update size
10$:	BIT	#F.CHR,FLAGS(A4)	;single char?
	JNE	RETURN			; yes
	BIT	#F.AUT,FLAGS(A4)	;automatic field?
	JEQ	GETCHR			; no - get next char
	CMMW	POS(A4),MAXSIZ(A4)	; yes - end of field?
	JNE	GETCHR			;  no - get next char
	JMP	RETURN			;  yes - end of edit

;special case fold checking

CASE:	CALL	CHKUCS			;check for upper case folding
	CALL	CHKLCS			;check for lower case folding
	CALL	CHKNAM			;check for namefolding
	RTN

;if F.UCS set, fold to upper case

CHKUCS:	BIT	#F.UCS,FLAGS(A4)
	REQ
	UCS
	RTN

;if F.LCS set, fold to lower case

CHKLCS:	BIT	#F.LCS,FLAGS(A4)
	REQ
	LCS
	RTN

;if F.NAM set, fold chars at the beginnings of words to upper case

CHKNAM:	BIT	#F.NAM,FLAGS(A4)
	REQ
	TSTW	POS(A4)
	BEQ	10$
	CMMB	-1(A2),#40
	RNE
10$:	UCS
	RTN

PAGE
;******
;REDISP
;******
;redisplay field after edit

REDISP:	CRT	#12.
	CMMW	TYPE(A4),#T.AMT		;amount field?
	BEQ	DISAMT			; yes - right justify field
	CLR	D0
	MOVW	MAXSIZ(A4),D0
	SUBW	SIZE(A4),D0
RTN
	REQ
   	MOVW	SIZE(A4),D7
	ADDW	D7,COL(A4)
	CRT	ROW(A4),COL(A4)
     	MOV	#40,D1
10$:	TTY
	
	SOB	D0,10$
	RTN

;Dollar-amount fields are displayed right-justified, and formatted w/a
;decimal point and a dollar sign

DISAMT:	CRT	ROW(A4),COL(A4)
	CRT	#5
	CRT	#5
	CLR	D0
	MOVW	MAXSIZ(A4),D0
	SUBW	SIZE(A4),D0
	BEQ	20$
	MOV	#40,D1
10$:	TTY
	SOB	D0,10$
20$:	TYPE	$
	MOVW	SIZE(A4),D0
	BEQ	50$
	MOV	XC.AD2(A3),A2
30$:	CMPB	D0,#2
	BNE	40$
	TYPE	.
40$:	MOVB	(A2)+,D1
	CALL	TTY			;				101
	SOB	D0,30$
50$:	RTN

TTY:	BIT	#F.CHR,FLAGS(A4)
	BNE	20$
	BIT	#F.PSW,FLAGS(A4)
	BNE	10$
	TTY
	RTN
10$:	TYPE	$
20$:	RTN

PADCHR:	BIT	#F.UND,FLAGS(A4)
	BEQ	10$
	MOV	#40,D1
	RTN
10$:	MOV	#' ,D1
	RTN

PAGE
	DEFINE	ERROR	TEXT
		TYPE	<? 'TEXT'>
		JMP	ABORT
		ENDM

ARGERR:	ERROR	improper number of arguments
VARERR:	ERROR	argument type error
SIZERR:	ERROR	argument size error
MISERR:	ERROR	missing numeric parameter
TYPERR:	ERROR	invalid field type

ABORT:	TYPECR	< in EDIT.SBR>
	OR	#F.ERR,FLAGS(A4)
	MOV	JOBCUR,A6
	ORW	#J.CCC,JOBSTS(A6)
	RTN

	END

.