TITLE 'VT52 EMULATOR FOR KAYPRO II/IV'
*HEADING June 1, 1985
	LIST	X
; THINGS TO ADD:
;	1) SETUP MENU (at least baud rate)
;	2) BREAK KEY

	ORG	100H
*LIST OFF
*INCLUDE BDOS.EQU
*INCLUDE ASCII.EQU
*LIST ON
;SOME EQUATES SPECIFIC TO THIS PROGRAM
MNPORT	EQU	04H		;Modem data port
MNPTSA	EQU	06H		;Modem status port
MNPTSB	EQU	07H		;Modem status port - B channel
BAUDP	EQU	0		;baud rate port - a channel
OUTPUT	EQU	04H		;Transmit buffer empty
INPUT	EQU	01H		;Receive data available
DEFESC	EQU	'\'-40H		;The default is Control \ -- it's easier B.E.
XOFF$L	EQU	128
XON$L	EQU	XOFF$L-32
FALSE	EQU	0
TRUE	EQU	0FFH

*EJECT
START:	NOP			;Make sure we have a zero where
	NOP			;DDT will set the stack pointer
	LD	HL,0		;Clear out hl pair
	ADD	HL,SP		;and fetch the system stack pointer
	LD	(OLDSP),HL	;and save for later restoral
	LD	SP,STACK	;and move in our own stack.
	LD	DE,INTDES	;destination for INTERRUPT
	LD	HL,INTSRC	;source
	LD	BC,MOVLEN	;length
	LDIR
	LD	HL,KPTBL1	;Load the address of the status table
	LD	D,KPLEN1	;Length of status table
	CALL	SETPRT
	CALL	SETBD		;set default baud rate
	CALL	KEYEXC
	call	vidinit		; set up video
	call	print
VERSIO:	db	'Kaypro VT52 emulator V1.2 as of 7/1/85',CR,LF
	db	'by Ray Rizzuto',cr,lf,0
	LD	A,.HIGH.INTVEC
	LD	I,A
	IM	2
	EI			;let the fun begin!
CHRLUP:	ld	hl,(brktim)	;break time
	ld	a,h
	or	l
	jp	z,nobrk
	in	a,mnptsa
	and	output
	jp	z,stbrk		;transmiter still full
	out	mnport,a	;send anything
	dec	hl		;decrement time
	ld	(brktim),hl	;and save
	ld	a,h
	or	l
	jp	nz,stbrk	;continue till time=0
	call	wtemp		;wait for xmit empty
	ld	a,5
	out	mnptsa,a	;point to reg 5
	ld	a,(reg5)
	out	mnptsa,a	;clear break bit
nobrk:	CALL	CONCHR		;See if char at cons (type to port).
stbrk:	CALL	PRTCHR		;See if char at port (type to cons).
	JP	CHRLUP		;Go do it again.

*EJECT
KEYEXC:	LD	DE,KEYTAB
	LD	HL,(1)
	LD	BC,32H
	ADD	HL,BC
	LD	C,KTLEN
SETKEY:	LD	A,(DE)		;get new key value
	LD	B,A		;save it
	LD	A,(HL)		;get old key value
	LD	(DE),A		;move to where new value was
	LD	A,B		;restore new value
	LD	(HL),A		;complete the exchange
	INC	HL
	INC	DE
	DEC	C
	JP	NZ,SETKEY
	RET	

SETPRT:	LD	C,(HL)		;Load the port number into C
	INC	HL		;Index the pointer
	LD	A,(HL)		;get the data byte into A
	INC	HL		;Index the pointer
	OUT	(C),A		;Send it to the port
	DEC	D		;Decrement the entry counter
	JP	NZ,SETPRT	;jump back for more
	RET

resstr:	db	esc,'=',20h+23,20h,'$'
EXIT:	CALL	KEYEXC
	LD	HL,KPTBL2	;Load the address of the status table
	LD	D,KPLEN2	;Length of status table
	CALL	SETPRT
	call	vidrst		;remove "VT52 cursor"
	ld	de,resstr	;and get standard cursor
	ld	c,prstr
	call	bdos
	LD	HL,(OLDSP)	;restore cp/m stack
	LD	SP,HL
	DI			;just in case
	IM	0
	RET	
*EJECT
GETCHR:	LD	HL,(OUTDEX)	;get pointer to character
	DI			;don't let interrupt screw things up 
	LD	A,(CHCNT)	;see if there are any characters
	OR	A
	JP	Z,NOCHR		;if not
	DEC	A		;yes, decrement character count
	LD	(CHCNT),A
	LD	E,A		;save a copy of the char count
	LD	B,(HL)		;get character
	EI			;o.k. we're safe
	LD	A,E		;get char count
	CP	XOFF$L		;buffer getting full?
	JP	NC,S$XOFF	;yes, send xoff
	CP	XON$L		;buffer getting empty
	JP	NC,NOFLOW	;no, continue
S$XON:	LD	A,(XOFFED)	;have we already sent an xoff?
	OR	A
	JP	Z,NOFLOW	;no, so we don't need an xon
	LD	A,FALSE		;yes, so send one and update flag
	LD	(XOFFED),A
	LD	E,XON
	CALL	OUTCHR
	JP	NOFLOW
S$XOFF:	LD	A,(XOFFED)	;have we already sent an xoff?
	OR	A
	JP	NZ,NOFLOW	;yes, so don't send another
	LD	A,TRUE		;no, so send one and update flag
	LD	(XOFFED),A
	LD	E,XOFF
	CALL	OUTCHR
NOFLOW:	LD	A,B		;get character
	INC	L		;increment our pointer mod 256
	LD	(OUTDEX),HL
	SCF	
	CCF			;clear carry for success
	RET	
NOCHR:	EI	
	SCF	
	RET	
*EJECT
;************************System Dependent****************************
PRTCHR:	CALL	GETCHR
	RET	C
	AND	7FH		;Make seven bit.
	LD	E,A		;Set the char aside.
	CP	0		;if the char is a null
	JP	Z,PRTCHR	;ignore it
	CP	XON		;likewise for xons
	JP	Z,PRTCHR	;
	CP	XOFF		;and xoffs
	JP	Z,PRTCHR	;
	CP	DEL		;and deletes
	JP	Z,PRTCHR	;
	push	de
	ld	c,e
	call	vidout
	pop	de

PRTTST:	
	LD	A,(ESCFLG)	;Get the escape flag.
	OR	A		;Is the flag set?
	JP	NZ,VT52		;If so go translate the sequence.
	LD	A,E		;Get the char for testing.
	CP	DEL		;Is the char a delete.
	RET	Z		;If so then forget this foolishness.
	CP	ESC		;Is the char an escape?
	JP	NZ,PRTCHR	;If not skip on.
	LD	A,1		;Get a one.
	LD	(ESCFLG),A	;Set the escape flag.
	JP	PRTCHR		;Get another char...


VT52:	LD	A,00H		;Reset the ol' escape flag.
	LD	(ESCFLG),A
	LD	A,E		;Get the char.
IDENT:	CP	'Z'		;if request for identification
	JP	NZ,APTST
	LD	HL,IDSTR
	JP	SNDSTR		;jump=call+ret
APTST:	CP	'='		;set to application keypad
	JP	NZ,NUMTST
	LD	HL,APTAB
	LD	(PADPTR),HL
	RET	
NUMTST:	CP	'>'		;set to numeric keypad
	JP	NZ,PRTCHR
	LD	HL,NUMTAB
	LD	(PADPTR),HL
	RET	




*EJECT
CONCHR:	
	LD	C,DCONIO	;Direct console I/O BDOS call.
	LD	E,0FFH		;Input.
	CALL	BDOS
	OR	A
	RET	Z		;no input
	ld	e,a		;save character
	LD	A,(CMDFLG)
	ld	b,a
	ld	a,0
	ld	(cmdflg),a	;clear for next time
	ld	a,b
	or	a
	JP	NZ,DOCMD	;process a command
	ld	a,e
	or	a
	JP	P,NKEY		;if bit 8 set then translate
	RLCA
	RLCA			;use char as index to table
	AND	0FCH
	LD	C,A
	LD	B,0
	LD	HL,(PADPTR)
	ADD	HL,BC
	JP	SNDSTR		;same as call + ret

NKEY:	LD	A,(ESCCHR)	;Get the escape char.
	CP	E		;Is it an escape char?
	JP	NZ,OUTCHR	;jump instead of call+ret
	LD	A,1
	LD	(CMDFLG),A	;set flag
	RET

DOCMD:
	LD	A,(ESCCHR)
	CP	E
	JP	Z,OUTCHR
	LD	A,E
	CP	'?'
	JP	NZ,TSTnul
	ld	a,(escchr)
	or	40H
	ld	(echr),a
	CALL	PRINT
	DB	cr,lf,'X = exit',cr,lf
	db	'S = setup',cr,lf
	db	'B = send break',cr,lf
	db	'@ = send null',cr,lf
	db	'^'
echr	db	'\ = send the command character',cr,lf
	db	'? = this menu',cr,lf,0
	ret
tstnul:	cp	'@'
	jp	nz,tstbrk
	ld	e,0
	jp	outchr

tstbrk	res	5,a		;upper case conversion
	cp	'B'
	jp	nz,tstex
	call	wtemp		;wait until xmit empty
	ld	a,(dfbaud)
	add	a,a		;double for word index
	ld	c,a
	ld	a,0
	ld	b,a		;bc = index to table of break times
	ld	hl,brkttb
	add	hl,bc
	ld	c,(hl)
	inc	hl
	ld	b,(hl)		;get break character count
	ld	(brktim),bc	;and save it
	ld	a,5
	out	mnptsa,a	;point to reg 5
	ld	a,(reg5)
	set	4,a
	out	mnptsa,a	;start break
	ret
tstex
	cp	'X'
	jp	z,exit
	cp	'S'
	ret	nz
	call	print
	db	cr,lf,'Enter baud rate desired:',cr,lf
	db	'A - no change  ',tab,'J - 1800 baud',cr,lf
	db	'B - 50 baud    ',tab,'K - 2000 baud',cr,lf
	db	'C - 75 baud    ',tab,'L - 2400 baud',cr,lf
	db	'D - 110 baud   ',tab,'M - 3600 baud',cr,lf
	db	'E - 134.5 baud ',tab,'N - 4800 baud',cr,lf
	db	'F - 150 baud   ',tab,'O - 7200 baud',cr,lf
	db	'G - 300 baud   ',tab,'P - 9600 baud',cr,lf
	db	'H - 600 baud   ',tab,'Q - 19200 Baud',cr,lf
	db	'I - 1200 baud  ',tab,'? ',0
gtbd:	ld	c,dconio
	ld	e,0ffh
	call	bdos		; do input
	or	a
	res	5,a		;upper case conversion
	jp	z,gtbd
	cp	'A'
	jp	c,gtbd
	cp	'R'
	jp	nc,gtbd
	push	af
	ld	c,a
	call	vidout
	call	print
	db	cr,lf,0
	pop	af
	sub	'A'
	or	a
	ret	z		; no change to baud rate
	sub	1
	ld	(dfbaud),a	; and save value
	call	setbd
	ret

setbd:	ld	a,(dfbaud)
	out	baudp,a
	ret


wtemp:	ld	a,1		;read reg 1
	out	mnptsa,a
	in	a,mnptsa
	bit	0,a		;until all characters sent
	jp	z,wtemp
	ret

*EJECT
;************************System Dependent****************************
;	Put a char in E to the port.

OUTCHR:	IN	A,(MNPTSA);Get the output ready flag.
	AND	OUTPUT		;Is it set?
	JP	Z,OUTCHR	;If so, loop until it isn't.
	LD	A,E
	OUT	(MNPORT),A	;Output it.
	RET	




SNDSTR:	LD	A,(HL)
	OR	A
	RET	Z
	LD	E,A
	CALL	OUTCHR
	INC	HL
	JP	SNDSTR

*EJECT
;  storage that does NOT need to be common to both pages of kaypro
OLDSP:	ds	2		;Room for old system stack.
ESCFLG:	db	0		;Escape flag (start off).
XOFFED:	db	FALSE		;Have we xoffed the host?
ESCCHR:	db	DEFESC
IDSTR:	db	ESC,'/Z',0
CMDFLG:	DB	0
brktim:	dw	0		;how many characters to send to
				;send during break
brkttb:	dw	4		; min = 4 baud =50
	dw	4		;75
	dw	4		;110
	dw	4		;134.5
	dw	5		;150
	dw	9		;300
	dw	18		;600
	dw	36		;1200
	dw	54		;1800
	dw	60		;2000
	dw	72		;2400
	dw	108		;3600
	dw	144		;4800
	dw	216		;7200
	dw	288		;9600
	dw	576		;19.2k

dfbaud:	db	7		;default baud rate (3rd entry)

KPTBL1:	;Status table for SIO
	db	MNPTSA,0		;register 0
	db	MNPTSA,18H		;Channel reset
	db	MNPTSA,04H		;Register 4
	db	MNPTSA,44H		;x16,1 stop, no parity
	db	MNPTSA,03H		;Register 3
	db	MNPTSA,0C1H		;Rx enable, 8 bit Rx character
	db	MNPTSA,05H		;Register 5
	db	MNPTSA
reg5:	db	0EAH			;DTR, 8 bit Tx character
					;Tx enable, RTS
	db	MNPTSA,01H		;Register 1
	db	MNPTSA,00011000B	;enable rcv interrupts
					;go to port b
	db	MNPTSB,0		;register 0
	db	MNPTSB,02		;Register 2
	db	MNPTSB,.LOW.INTVEC	;Interrupt vector
	db	MNPTSB,01H		;Register 1
	db	MNPTSB,00000000B	;make sure "status affects vector" is off
KPLEN1	EQU	($-KPTBL1)/2
KPTBL2:	;Status table for SIO
	db	MNPTSA,1		;register 1
	db	MNPTSA,0		;disable receive interrupts
KPLEN2	EQU	($-KPTBL2)/2


KEYTAB:	db	80H,81H,82H,83H
	db	84H,85H,86H,87H
	db	88H,89H,8AH,8BH
	db	8CH,8DH,8EH,8FH
	db	90H,91H
KTLEN	EQU	$-KEYTAB

PADPTR:	dw	NUMTAB
APTAB:	db	ESC,'A',0,0	;up
	db	ESC,'B',0,0	;down
	db	ESC,'D',0,0	;left
	db	ESC,'C',0,0	;right
	db	ESC,'?p',0	;0
	db	ESC,'?q',0	;1
	db	ESC,'?r',0	;2
	db	ESC,'?s',0	;3
	db	ESC,'?t',0	;4
	db	ESC,'?u',0	;5
	db	ESC,'?v',0	;6
	db	ESC,'?w',0	;7
	db	ESC,'?x',0	;8
	db	ESC,'?y',0	;9
	db	ESC,'P',0,0	;-
	db	ESC,'R',0,0	;,
	db	ESC,'?M',0	;enter
	db	ESC,'?n',0	;.


NUMTAB:	db	ESC,'A',0,0	;up
	db	ESC,'B',0,0	;down
	db	ESC,'D',0,0	;left
	db	ESC,'C',0,0	;right
	db	'0',0,0,0	;0
	db	'1',0,0,0	;1
	db	'2',0,0,0	;2
	db	'3',0,0,0	;3
	db	'4',0,0,0	;4
	db	'5',0,0,0	;5
	db	'6',0,0,0	;6
	db	'7',0,0,0	;7
	db	'8',0,0,0	;8
	db	'9',0,0,0	;9
	db	'-',0,0,0	;-
	db	',',0,0,0	;,
	db	0DH,0,0,0	;enter
	db	'.',0,0,0	;.

*EJECT
; start of code and data that MUST be common to both pages and

INTDES	EQU	4000H
INTSRC	EQU	$
BIAS	EQU	INTDES-INTSRC

; data
; THIS VECTOR MUST BE ON AN EVEN (LOW BIT =0) ADDRESS!!!!
INTVEC	EQU	$+BIAS
	dw	RCVINT
	ds	80H		;Room for 64 levels of calls.
STACK	equ	$+bias
INDEX	EQU	$+BIAS
	dw	RCVBUF
OUTDEX	EQU	$+BIAS
	dw	RCVBUF
CHCNT	EQU	$+BIAS
	db	0
	;set to even 256 boundry
	ORG	(($+BIAS+0FFH).AND.0FF00H)-BIAS
RCVBUF	EQU	$+BIAS
	ds	256


; code

RCVINT	EQU	$+BIAS
	PUSH	AF
	PUSH	HL
CKCHR	EQU	$+BIAS
	IN	A,(MNPTSA)	;read reg 0
	AND	INPUT
	JP	Z,USRTMT
	LD	A,00000001B	;point to read reg 1
	OUT	(MNPTSA),A
	IN	A,(MNPTSA)	;read stat		
	AND	01100000B	;check for ok char
	JP	NZ,CHRERR	;don't save bad char
	LD	A,(CHCNT)	;get character count
	INC	A		;add 1 to count
	JP	Z,BFRERR	;and see if it wraps to 0
	LD	(CHCNT),A	;if not, save count
	IN	A,(MNPORT)	;read character
	LD	HL,(INDEX)	;find input location
	LD	(HL),A		;save character
	INC	L		;do a mod 256 add
	LD	(INDEX),HL	;save input pointer for next time
	JP	INTEX
CHRERR	EQU	$+BIAS
	IN	A,(MNPORT)	;clear bad character
	LD	A,00110000B	;clear error condition
	OUT	(MNPTSA),A
	JP	INTEX
BFRERR	EQU	$+BIAS
	IN	A,(MNPORT)	;clear character and ignore
INTEX	EQU	$+BIAS
	JP	CKCHR
USRTMT	EQU	$+BIAS
	POP	HL
	POP	AF
	EI	
	RETI

*include vt52vid.azm
MOVLEN	EQU	$-INTSRC

	END	START