;*** FNKEYS.ASM  Osborne Executive Function Key Utility
;*** Version 2.1a -  E.Meyer 6/86
;*** This code is for nonprofit use only.
;
;Should assemble with most Z80 assemblers (I use SLR Z80ASM)
;
;>>> If you create and circulate a modified version of this
;>>> program, give credit where it's due, but DO NOT call it
;>>> "FNKEYS 2.2" etc -- create your own name.
;
; Syntax:  A>FNKEYS source [dest]      (use * for RAM)
; See FNKEYS.DOC for further details
;
; NOTE: The tricky thing in this program is dealing with Bank 8
; of RAM, where the function keys are stored in the ROM's RAM.
; Bank 8 has to be switched in; and it will overshadow the lower
; 16k of the TPA.  Thus the code that does the bank switching,
; and the buffers that hold the data for the swap, have to be
; above address 4000H.
;	The file format (.FNK) in which keys are stored by FNKEYS is
; exactly identical to the format in RAM.  Only the key definition
; bytes are significant, however; all other bytes (which have other
; functions in RAM) are ignored.
;
;
FBUF	EQU	4000H	;start of safe data buffer
FKOFF	EQU	014DH	;offset of start of key table in FBUF
FKLEN	EQU	0200H	;length of keys in FBUF (note SETUP only uses 100H)
FBUF2	EQU	4400H	;duplicate buffer, for copying
HILDIR	EQU	4800H	;place to put bank switch routine
STRING	EQU	4810H	;place to put new definition string
;
FKRAM	EQU	2155H	;address of fnkeys in bank 8
CTLESC	EQU	2095H	;address of ctl-ESC in keyboard tables, bank 8
CTLCR	EQU	209AH	;address of ctl-RET in tables
CTLCOD	EQU	08EH	;use this for ctl-RET (like SETUP)
CTLCD2	EQU	08FH	;and this for ctl-ESC
LEFTAR	EQU	08DH	;left arrow code (for correction)
;
;
	ORG	0100H
;
	LD	SP,STACK
	CALL	MSG
	DB	'FNKEYS 2.1a (06/86) - Osborne Executive',CR,LF,0
	LD	HL,B8LDIR
	LD	DE,HILDIR
	LD	BC,B8BYTS
	LDIR			;move B8LDIR code up to HILDIR
	LD	C,ERRM
	LD	E,0FFH
	CALL	BDOS		;set Error Mode to Return
	LD	C,GDRV
	CALL	BDOS
	LD	(CURDSK),A	;save current disk
	LD	A,(FCB2)
	OR	A
	JR	NZ,DODEF		;if no dest disk...
	LD	HL,FCB2+1	;take care of absent dest
	LD	A,(HL)
	CP	' '
	JR	NZ,DODEF
	LD	B,8		;turn " " into "*"
LP1:	LD	(HL),'?'
	INC	HL
	DJNZ	LP1
DODEF:	LD	HL,FCB+9
	LD	A,(HL)		;default filetypes = FNK
	CP	' '
	CALL	Z,DEFTYP
	LD	HL,FCB2+9
	LD	A,(HL)
	CP	' '
	CALL	Z,DEFTYP
	LD	HL,FCB2
	LD	DE,ARG2
	LD	BC,12		;copy "dest" filename....
	LDIR
	XOR	A		;... into a blank fcb
	LD	B,24
DDFLP:	LD	(DE),A
	INC	DE
	DJNZ	DDFLP
;
;--- read in the desired function keys
;
	CALL	MSG
	DB	'Reading...',0
	LD	A,(FCB+1)
	CP	'?'
	JP	Z,RRAM		;"*" is RAM source
	CP	' '
	JP	Z,RDISK		;no file? read sys trks.
;
RFILE:	LD	DE,FCB		;read in from file
	LD	C,FOPN
	CALL	BDOS
	INC	A
	JP	Z,FBAD
	LD	DE,FBUF
	LD	B,8
RFLP:	CALL	RFSBR		;read 8 sectors
	LD	HL,128
	ADD	HL,DE
	EX	DE,HL
	DJNZ	RFLP
	JP	GOTIT
RFSBR:	PUSH	DE		;subroutine to read record
	PUSH	BC
	LD	C,SDMA
	CALL	BDOS
	LD	DE,FCB
	LD	C,RSEQ
	CALL	BDOS
	POP	BC
	POP	DE
	OR	A
	JP	NZ,RBAD
	RET
;
RDISK:	LD	A,(FCB)		;read from sys trks
	OR	A
	JP	Z,OBAD
	CP	3
	JP	NC,OBAD		;A or B only.
	LD	HL,FBUF
	CALL	DOTRK2		;read track 2 block 4 into FBUF
	JP	GOTIT
;
RRAM:	LD	HL,FKRAM		;read from RAM.
	LD	DE,FBUF+FKOFF
	LD	BC,FKLEN
	CALL	HILDIR
;
;--- we now have the keys desired in the buffer
;
GOTIT:	CALL	FREE	;quick check for data integrity
	LD	A,B	;(cannot appear to have more than FKLEN free)
	CP	HIGH(FKLEN)
	JP	NC,DATERR
	LD	HL,FCB		;decide whether to edit?
	LD	DE,ARG2
	LD	B,12
GOTLP:	LD	A,(DE)		;just EDIT if source = dest
	INC	DE
	CP	(HL)
	INC	HL
	JR	NZ,GOTLPF
	DJNZ	GOTLP
	JR	EDITY
GOTLPF:	LD	A,(FCB+1)	;just LOAD if source=disk, dest=*
	CP	'?'
	JR	Z,EDITQ		;(otherwise ASK if want to Edit)
	LD	A,(ARG2+1)
	CP	'?'
	JP	Z,SAVE
EDITQ:	CALL	MSG
	DB	' Edit keys? (Y/N): ',0
	CALL	INP
	CALL	UCASE
	CALL	ECHO
	CP	'N'
	JP	Z,SAVE
EDITY:	LD	HL,FBUF2	;YES, want to edit
	LD	(HL),CTLCOD
	LD	DE,CTLCR
	LD	BC,1
	CALL	HILDIR		;set up ctl-RET code
	LD	(HL),CTLCD2
	LD	DE,CTLESC
	LD	BC,1
	CALL	HILDIR		;and ctl-ESC
	CALL	MSG
	DB	CLS,ESC,'f'	;disable fnkeys
	DB	'FNKEYS Function/Arrow Key Utility',CR,LF
	DB	'     v2.1a (c)1986  E.Meyer',CR,LF
	DB	'---------------------------------',0
;
EDIT:	CALL	DISPLA
EDIT0:	CALL	MSG
	DB	CR,'Select <0-L>, ESC to clear, or RET to save to ',0
	LD	A,(ARG2+1)
	CP	'?'
	JR	NZ,EDIT1
	CALL	MSG		;say what the dest is.
	DB	'RAM',0
	JR	EDIT2
EDIT1:	LD	A,(ARG2)
	OR	A
	JR	NZ,EDIT1A
	LD	A,(CURDSK)
	INC	A
EDIT1A:	ADD	'A'-1
	CALL	TYP
	LD	A,':'
	CALL	TYP
	LD	HL,ARG2+1
	LD	A,(HL)
	CP	' '
	JR	Z,EDIT2
	LD	B,8
	CALL	BMSG
	PUSH	HL
	LD	A,'.'
	CALL	TYP
	POP	HL
	LD	B,3
	CALL	BMSG
EDIT2:	CALL	MSG
	DB	': ',0
	CALL	INP
	CALL	UCASE
	CP	BRK
	JP	Z,ABORT
	CP	ESC
	JP	Z,ZAP
	CP	CR
	JP	Z,EQUIT
	LD	(GSCHR),A	;put char in input prompt
	CALL	ENCODE
	JP	C,BADKEY
	LD	(KEYNUM),A	;code is 0-9 plus 10-13 for arrows
	CALL	MSG
	DB	CR,ESC,'T',ESC,')'
	DB	'(^ESC quits, ^RET saves, <- corrects)',ESC,'(',CR,LF,0
	CALL	GETSTR
	CALL	NC,CHANGE
	JP	EDIT
BADKEY:	LD	A,BEL		;oops.
	CALL	TYP
	JP	EDIT0
;
ZAP:	LD	DE,FBUF+FKOFF	;wipe it all out
	XOR	A
	LD	B,10
ZAPLP:	LD	(DE),A
	INC	DE
	DJNZ	ZAPLP
	LD	HL,CPMARR	;but keep std CP/M arrows
	LD	B,8
	LDIR
	JP	EDIT
CPMARR:	DB	1,'K'-40H,1,'L'-40H,1,LF,1,BS
;
RESTOR:	LD	HL,FBUF2	;restore ctl-RET,ctl-ESC
	LD	(HL),CR
	LD	DE,CTLCR
	LD	BC,1
	CALL	HILDIR
	LD	(HL),ESC
	LD	DE,CTLESC
	LD	BC,1
	CALL	HILDIR
	CALL	MSG
	DB	ESC,'e',0	;reenable fnkeys
	RET
;
EQUIT:	CALL	RESTOR
	LD	A,CLS
	CALL	TYP
;
;--- keys edited, if desired - now write them
;
SAVE:	CALL	MSG
	DB	'   Saving...',0
	LD	A,(ARG2+1)
	CP	'?'
	JP	Z,WRAM		;"*" = RAM dest
	CP	' '
	JP	Z,WDISK		;no file? to sys trks.
;
WFILE:	LD	DE,ARG2		;write out to file
	LD	C,FDEL
	CALL	BDOS
	LD	DE,ARG2
	LD	C,FMAK
	CALL	BDOS
	INC	A
	JP	Z,WBAD
	LD	DE,FBUF
	LD	B,8
WFLP:	CALL	WFSUB		;write 8 records
	LD	HL,128
	ADD	HL,DE
	EX	DE,HL
	DJNZ	WFLP
	LD	DE,ARG2
	LD	C,FCLO
	CALL	BDOS
	INC	A
	JP	Z,WBAD
	JP	DONE
WFSUB:	PUSH	DE		;subroutine to write a record
	PUSH	BC
	LD	C,SDMA
	CALL	BDOS
	LD	DE,ARG2
	LD	C,WSEQ
	CALL	BDOS
	POP	BC
	POP	DE
	OR	A
	JP	NZ,WBAD
	RET
;
WDISK:	LD	A,(ARG2)	;to write to systrks,
	OR	A
	JP	Z,OBAD
	CP	3
	JP	NC,OBAD		;(A or B only)
	LD	HL,FBUF2
	CALL	DOTRK2		;  first read existing ones,
	LD	HL,FBUF+FKOFF
	LD	DE,FBUF2+FKOFF
	LD	BC,FKLEN
	LDIR			;  move new tables into them,
	LD	HL,WRITE
	LD	(T2OP+1),HL	;  and write them back.
	LD	A,(ARG2)
	LD	HL,FBUF2
	CALL	DOTRK2
	JP	DONE
;
WRAM:	LD	HL,FBUF+FKOFF	;write to RAM
	LD	DE,FKRAM
	LD	BC,FKLEN
	CALL	HILDIR
;
;--- all finished now
;
DONE:
EXIT:	CALL	MSG
	DB	CR,LF,0
	LD	C,0
	JP	BDOS
;
;
;--- SUBROUTINES follow ---
;
;BIOS disk functions to read/write track 2 block 4
;
SELDSK:	LD	(CREG),A	;C = disk #
	XOR	A
	LD	(EREG),A	;E = 00
	LD	A,9
	JR	BIOS
MULTIO:	LD	A,1
	LD	(CREG),A	;C = 1 block to read
	LD	A,23
	JR	BIOS
SETTRK:	LD	HL,2
	LD	(BCREG),HL	;BC = track 2
	LD	A,10
	JR	BIOS
SETSEC:	LD	HL,4
	LD	(BCREG),HL	;BC = block 4 for sector 35-40
	LD	A,11
	JR	BIOS
SETDMA:	LD	(BCREG),HL	;BC = DMA addr from HL
	LD	A,12
	JR	BIOS
SETBNK:	LD	A,1
	LD	(AREG),A	;A = bank 1
	LD	A,28
	JR	BIOS
READ:	LD	A,13
	JR	BIOS
WRITE:	LD	A,1
	LD	(CREG),A	;C = 1 (nondeferred write)
	LD	A,14
;
BIOS:	LD	(BIOSFN),A	;call BIOS fn in A
	LD	DE,BIOSPB
	LD	C,50
	JP	BDOS
;
BIOSPB:				;BIOS Parameter block
BIOSFN:	DB	0
AREG:	DB	0
BCREG:	DW	0
DEREG:	DW	0
HLREG:	DW	0
CREG	EQU	BCREG
EREG	EQU	DEREG
;
DOTRK2:	DEC	A		;takes drive in A, buff addr in HL
	PUSH	HL
	CALL	SELDSK
	CALL	MULTIO
	CALL	SETTRK
	CALL	SETSEC
	POP	HL
	CALL	SETDMA
	CALL	SETBNK
T2OP:	CALL	READ		;<--- changes to WRITE if needed
	PUSH	AF
	LD	A,(CURDSK)
	CALL	SELDSK		;restore original drive
	POP	AF
	OR	A
	JP	NZ,BIOSER
	RET
;
;
;
DISPLA:	CALL	MSG		;show the fnkeys
	DB	ESC,'=',34,82,ESC,'Y',0
	LD	HL,FBUF+FKOFF
	LD	B,14
DSPLP:	LD	A,14
	SUB	B
	PUSH	BC
	PUSH	HL
	CALL	DECODE
	LD	(DSCHR),A
	CALL	MSG
	DB	CR,LF,'<'
DSCHR:	DB	'?>',0		;<---- label goes here
	POP	HL
	LD	B,(HL)		;get count
	INC	HL
	XOR	A
	ADD	B
	CALL	Z,EMPTY
	CALL	BMSG		;show string
	POP	BC
	DJNZ	DSPLP
	CALL	MSG
	DB	CR,LF,'--------(',0
	CALL	FREE
	LD	H,B
	LD	L,C
	CALL	DECNUM		;show free bytes
	CALL	MSG
	DB	' bytes free)---------',CR,LF,LF,0
	RET
EMPTY:	PUSH	HL
	CALL	MSG
	DB	ESC,')','<NULL>',ESC,'(',0
	POP	HL
	RET
;
;
GETSTR:	CALL	MSG		;get new string
	DB	'<'
GSCHR:	DB	'?>',0		;<---- label goes here
	LD	HL,STRING+1
	LD	B,255		;max length
GSLP:	PUSH	BC
	PUSH	HL
	CALL	INP		;get char
	POP	HL
	POP	BC
	CP	CTLCOD
	JR	Z,GSCR		;ctl-CR ends
	CP	CTLCD2
	JR	Z,GSESC		;ctl-ESC quits
	CP	LEFTAR
	JR	Z,GSBS		;left arrow corrects
	BIT	7,A
	JR	NZ,GSLP		;ignore anything else over 80H
	PUSH	BC
	PUSH	HL
	CALL	ECHO		;show it
	POP	HL
	POP	BC
	LD	(HL),A		;add it
	INC	HL
	DJNZ	GSLP		;count it (fall thru to BS if full)
GSBS:	LD	A,255-1
	SUB	B
	JR	C,GSLP		;erase one?
	INC	B
	DEC	HL		;back up
	LD	A,(HL)
	CP	' '
	CALL	C,GSWIPE	;wipe "^" if present
	CALL	GSWIPE		;wipe out char
	JR	GSLP
GSCR:	LD	A,255		;done, figure length
	SUB	B
	LD	HL,STRING	;point to result
	LD	(HL),A
	RET
GSESC:	SCF			;return with Carry if ctl-ESC
	RET
;
GSWIPE:	PUSH	BC		;wipe out a character
	PUSH	HL
	CALL	MSG
	DB	BS,ESC,'T',0
	POP	HL
	POP	BC
	RET
;
;
CHANGE:	LD	HL,FBUF+FKOFF	;Replace the key
	LD	A,(KEYNUM)
	OR	A
	JR	Z,CHGL1F
CHGLP1:	LD	C,(HL)		;find key to delete
	LD	B,0
	ADD	HL,BC
	INC	HL
	DEC	A
	JR	NZ,CHGLP1
CHGL1F:	LD	A,(HL)		;old length
	PUSH	HL
	OR	A
	JR	Z,CHG1
	LD	E,(HL)
	LD	D,0
	LD	(HL),0
	INC	HL
	EX	DE,HL
	ADD	HL,DE
	LD	B,H
	LD	C,L
	PUSH	HL
	LD	HL,FBUF+FKOFF+FKLEN
	OR	A
	SBC	HL,BC		;bytes to move down
	LD	B,H
	LD	C,L
	POP	HL
	LDIR			;move them
CHG1:	CALL	FREE		;now, anything to add?
	INC	BC
	POP	HL
	LD	A,(STRING)
	OR	A
	JR	Z,CHGRET
	CP	C
	JR	C,CHG1A		;will it fit?
	LD	C,A
	XOR	A
	ADD	B
	JR	Z,CHGRET
	LD	A,C
CHG1A:	LD	(HL),A
	INC	HL
	LD	C,A
	LD	B,0
	PUSH	HL
	LD	HL,FBUF+FKOFF+FKLEN-1
	LD	D,H
	LD	E,L
	OR	A
	SBC	HL,BC		;from here
	POP	BC
	PUSH	HL
	SBC	HL,BC
	LD	B,H
	LD	C,L
	INC	BC		;bytes to move
	POP	HL
	LDDR			;make room
	LD	C,(HL)
	LD	B,0
	INC	HL
	EX	DE,HL
	LD	HL,STRING+1
	LDIR			;insert it
CHGRET:	RET
;
;
;
FREE:	LD	HL,FBUF+FKOFF	;figure free bytes
	LD	A,14
	LD	BC,FKLEN-14
	LD	D,0
FRELP:	PUSH	AF
	LD	A,C
	LD	E,(HL)
	SUB	E
	LD	C,A
	LD	A,B
	SBC	0
	LD	B,A
	INC	HL
	ADD	HL,DE
	POP	AF
	DEC	A
	JR	NZ,FRELP
	RET		;result in BC
;
DECNUM:	LD	C,0	;put decimal# 0-999 in HL to screen
DALP3:	LD	A,H
	OR	A	;  (100 = 0064H)
	JR	NZ,GT100
	LD	A,L
	CP	64H
	JR	C,LT100
GT100:	INC	C
	LD	DE,100
	OR	A
	SBC	HL,DE
	JR	DALP3
DBYTE:	LD	C,0	;put decimal# 0-255 in A to screen
DBLP:	CP	100
	JR	C,LT100
	INC	C
	SUB	100
	JR	DBLP
LT100:	PUSH	AF
	LD	A,30H
	ADD	C
	CALL	TYP
	POP	AF
	LD	C,0
DBLP2:	CP	10
	JR	C,LT10
	INC	C
	SUB	10
	JR	DBLP2
LT10:	PUSH	AF
	LD	A,30H
	ADD	C
	CALL	TYP
	POP	AF
	ADD	30H
	JP	TYP
;
;
DEFTYP:	LD	(HL),'F'	;make default type ".FNK"
	INC	HL
	LD	(HL),'N'
	INC	HL
	LD	(HL),'K'
	RET
;
;
DECODE:	ADD	'0'	;turn #0-13 into key ID
	CP	'9'+1
	RET	C
	SUB	'9'+1	;now arrow 0-3
	LD	E,A
	LD	D,0
	LD	HL,ARROWS
	ADD	HL,DE
	LD	A,(HL)
	RET
ENCODE:	SUB	'0'	;turn key into # (return C if illegal)
	RET	C
	CP	9+1
	CCF
	RET	NC
	ADD	'0'	;arrow
	LD	HL,ARROWS
	LD	BC,040AH
ENCLP:	CP	(HL)
	JR	Z,ENCLPF
	INC	HL
	INC	C
	DJNZ	ENCLP
	SCF
ENCLPF:	LD	A,C
	RET
ARROWS:	DB	'URDL'
;
;
ECHO:	CP	80H	;echo key IF not parity
	RET	NC
	PUSH	AF
	CALL	TYPE
	POP	AF
	RET
;
TYPE:	CP	' '	;put char in A to screen, with "^" filter
	JR	NC,TYP
	ADD	40H
	PUSH	AF
	CALL	MSG
	DB	ESC,')',0
	LD	A,'^'
	CALL	TYP
	POP	AF
	CALL	TYP
	CALL	MSG
	DB	ESC,'(',0
	RET
;
INP:	LD	A,0FDH	;CP/M Plus plain input
TYP:	LD	E,A	;and output
	LD	C,UCON
	JP	BDOS
MSG:	EX	(SP),HL	;put DB string ending in 0 to screen
	XOR	A
	ADD	(HL)
	INC	HL
	EX	(SP),HL
	RET	Z
	CALL	TYP	;no filtering
	JR	MSG
BMSG:	XOR	A	;put B bytes at (HL) to screen
	ADD	B
	RET	Z
	LD	A,(HL)
	INC	HL
	PUSH	BC
	PUSH	HL
	CALL	TYPE	;with filtering
	POP	HL
	POP	BC
	DJNZ	BMSG
	RET
;
UCASE:	CP	'a'	;uppercase A
	RET	C
	CP	'z'+1
	RET	NC
	AND	5FH
	RET
;
OBAD:	CALL	MSG
	DB	' <BAD ARGT>',0
	JP	EXIT
FBAD:	CALL	MSG
	DB	' <NO FILE>',0
	JP	EXIT
BIOSER:	CALL	MSG
	DB	' <BIOS ERR>',0
	JP	EXIT
WBAD:
RBAD:	CALL	MSG
	DB	' <BDOS ERR>',0
	JP	EXIT
DATERR:	CALL	MSG
	DB	' <DATA ERR>',0
	JP	EXIT
ABORT:	CALL	MSG
	DB	' <ABORTED>',0
	CALL	RESTOR
	JP	EXIT
;
B8LDIR:	LD	A,10000001B	;do LDIR with bank 8 RAM
	DI			;(has to be above 4000H to work)
	OUT	0,A
	LDIR
	LD	A,00000001B
	OUT	0,A
	EI
	RET
B8BYTS	EQU	$-B8LDIR
;
;data
;
CURDSK:	DB	0
;
KEYNUM:	DS	1
ARG2:	DS	35
;
	DS	64
STACK	EQU	$
;
CR	EQU	0DH
LF	EQU	0AH
BS	EQU	08H
ESC	EQU	1BH
BRK	EQU	03H
CLS	EQU	1AH
BEL	EQU	07H
;
BDOS	EQU	0005H
FCB	EQU	005CH
FCB2	EQU	006CH
DMA	EQU	0080H
;
UCON	EQU	6
FOPN	EQU	15
FCLO	EQU	16
FDEL	EQU	19
RSEQ	EQU	20
WSEQ	EQU	21
FMAK	EQU	22
GDRV	EQU	25
SDMA	EQU	26
ERRM	EQU	45
;
	END
