RomWBW/Source/Images/d_fortran/u0/TTYDRV.MAC

	TITLE	TTYDRV - FORTRAN-80 TTY I/O DRIVER

	.8080

	EXTRN	$IOERR,$BL,$BF,$ERR,$TTYIN,$TTYOT

; TTY: & PUN:/RDR: DRIVER ENTRIES:

	ENTRY	TTYDRV,PUNRDR

; FORTRAN-80 UTILITY SUBROUTINES:

	ENTRY	PUNCH,READER,GOTOXY,SCREEN
	ENTRY	HOME,INKEY,CONOUT

	DSEG

DEVFLG:	DB	0

	CSEG

PUNRDR:	DW	PUNFR	;FORMATTED READ
	DW	PUNFW	;FORMATTED WRITE
	DW	$IOERR	;UNFORMATTED READ
	DW	PUNUWR	;UNFORMATTED WRITE
	DW	NULL	;REWIND
	DW	NULL	;BACKSPACE
	DW	NULL	;ENDFILE
	
TTYDRV:	DW	TTYFR	;SAME AS ABOVE
	DW	TTYFW
	DW	$IOERR
	DW	TTYUWR
	DW	NULL
	DW	NULL
	DW	NULL

TTYFR:	XRA	A	;TTY = 0
	DB	1	;SKIP 2 BYTES WITH 'LXI B,'

PUNFR:	MVI	A,1	;READER = 1
	STA	DEVFLG	;DEVICE FLAG

	XRA	A
	MOV	E,A	;ZERO LO BYTE OF $BL
	STA	$BL+1	;ZERO HI BYTE

	LHLD	$BF	;GET BUFFER ADDR

DRV31:	CALL	INCHR	;GET A CHARACTER
DRV39:	CPI	10	;INGNORE LINE FEEDS
	JZ	DRV31

	MOV	M,A

	INX	H
	INR	E
	
	CPI	13	;TEST FOR END OF LINE
	MOV	A,E
	STA	$BL
	RZ

	CPI	132	;MAX 132 CHARS
	JC	DRV31

	CALL	$ERR	;GIVE 'INPUT RECORD TOO LONG' WARNING
	DB	18

NULL:	XRA	A	;CLEAR CARRY AND ZERO FLAGS
	RET

TTYFW:	XRA	A	;TTY = 0
	DB	1	;SKIP 2 WITH 'LXI B,'

PUNFW:	MVI	A,1	;PUNCH = 1
	STA	DEVFLG

	LDA	$BL	;GET BUFFER LENGTH
	ORA	A
	RZ		;EMPTY BUFFER - JUST RETURN

	LHLD	$BF	;BUFFER ADDRESS
	DCR	A
	MOV	E,A	;SAVE LENGTH IN [E]

	MOV	A,M	;GET CARRIAGE CONTROL CHAR
	CPI	'*'	;DO NOTHING?
	JZ	TTYNOT

	CALL	OUTCR	;PRINT A CARRIAGE RETURN
	MOV	A,M	;REGET FIRST CHAR
	CPI	'+'	;A '+' MEANS CR BUT NO LF
	JZ	TTYNOT

	CPI	'1'	;A '1' MEANS CLEAR SCREEN/FORM FEED
	JNZ	TTYLFO
	CALL	HOM1	;GO CLEAR SCREEN OR SEND FF CHAR
	JMP	TTYNOT

TTYLFO:	CALL	OUTLF	;PRINT A LINE FEED
Š	MOV	A,M	;GET CARR CONTROL CHAR BACK
	CPI	'0'	;'0' MEANS DOUBLE SPACING
	CZ	OUTLF	;ANYTHING ELSE IS JUST SINGLE SPACING

TTYNOT:	INX	H	;INCREMENT BUFFER POINTER
	MVI	D,0	;HI BYTE OF COUNT = 0

TTYLOP:	MOV	A,E	;DONE SENDING CHARACTERS?
	ORA	D
	RZ		;YES, RETURN
	MOV	C,M	;GET CHARACTER INTO [C]
	CALL	OUTCH	;SEND THE CHAR
	INX	H	;INC BUFFER PTR
	DCX	D	;DEC CHARACTER COUNT
	JMP	TTYLOP

TTYUWR:	XRA	A

	DB	1	;SKIP 2 WITH 'LXI B,'

PUNUWR:	MVI	A,1
	STA	DEVFLG
	LHLD	$BL	;GET NO. OF CHARS TO SEND
	XCHG		;INTO [DE]
	LHLD	$BF	;GET BUFFER POINTER INTO [HL]
	JMP	TTYLOP	;AND GO SEND THEM

OUTLF:	MVI	C,10	;OUTPUT A LINE FEED
	JMP	OUTCH

OUTCR:	MVI	C,13	;OUTPUT A CARRIAGE RETURN

OUTCH:	LDA	DEVFLG	;PRINT CHARACTER TO EITHER
	ORA	A	;TTY: OR PUN: DEVICE
	MOV	A,C
	JNZ	$PUNOT
	JMP	$TTYOT

PUNCH:	MOV	A,M	;FORTRAN PUNCH SUBROUTINE

$PUNOT:	PUSH	B
	PUSH	D
	MVI	C,4	;CP/M PUNCH DEVICE OUTPUT
	MOV	E,A
GOCPM:	PUSH	H
 	CALL	5
	POP	H
	POP	D
	POP	B
	RET

CONOUT:	MOV	A,M	;FORTRAN CONOUT SUBROUTINE
	JMP	$TTYOT

READER:			;FORTRAN READER FUNCTION

$RDRIN:	PUSH	B
	PUSH	D
	MVI	C,3
	JMP	GOCPM

INCHR:	LDA	DEVFLG	;GET CHAR FROM EITHER
	ORA	A	;TTY OR READER DEVICE
	JNZ	$RDRIN
	JMP	$TTYIN

HOM1:	LDA	DEVFLG	;CLEAR SCREEN IF TTY,
	ORA	A	;SEND FF CHAR IF PUNCH
	JZ	HOME
	MVI	A,12	;FF CHAR
	JMP	$PUNOT

HOME:	MVI	A,1	;CLEAR CONSOLE SCREEN
	JMP	DOFUN

SCREEN:	MOV	A,M	;GET FUNCTION #

DOFUN:	PUSH	H
	LXI	H,0F397H	;SSFTAB
	ADD	L		;POINT TO DESIRED FUN CHAR
	MOV	L,A
	MOV	A,M		;GET IT INTO A
	ORA	A		;REQUIRE LEAD-IN?
	JP	NOLDIN
	PUSH	PSW
	LDA	0F397H		;YES, SO SEND IT FIRST
	CALL	$TTYOT
	POP	PSW
NOLDIN:	CALL	$TTYOT
	POP	H
	RET

GOTOXY:	MVI	A,7		;DO CURSOR POSITION FUNCTION
	CALL	DOFUN

	LDAX	D		;GET COORDS
	MOV	H,M		;H=X, L=Y
	MOV	L,A

	DCR	L		;MAP 1..24,1..80 TO 0..23,0..79
	DCR	H		

	LDA	0F396H		;XY COORD OFFSET
	ORA	A
	JP	NORVS

	MOV	E,L		;SWAP
	MOV	L,H
	MOV	H,E

NORVS:	MOV	E,A		;SAVE IN [E]
	ADD	H		;ADD OFFSET
	PUSH	PSW		;SAVE CHAR
	MOV	A,E
	ADD	L		;OUTPUT FIRST COORD
	CALL	$TTYOT
	POP	PSW
	MOV	E,A		;OUTPUT SECOND COORD
	JMP	$TTYOT

INKEY:	MOV	A,M		;GET PARAMETER
	ORA	A		;SEE WHAT IT IS
	JZ	INK1		;ZERO - JUST TEST STATUS

INKLP:	CALL	INK1		;READ CONSOLE STATUS
	ORA	A
	JZ	INKLP		;WAIT UNTIL KEYPRESS
	RET

INK1:	MVI	C,6		;CONSOLE STATUS CALL
	MVI	E,255
	JMP	5		;GO TO BDOS

	END