.z80


	;Application for Write-Hand-Man to allow users
	;to define the function keys on an Amstrad PCW8256 (JOYCE).
	;Written by D.W.Clements for HiSoft
	;July 1986


	;Rewriten by Dave Nutkins March 1987


	; This applicattion relies on
	; 1. The f1..f8 keys remain programmed
	;    to produce #81..#88 as on the standard system.
	; 2. the fact that RETURN key gives 13

	org	0

xbios	macro	adr
	call	0fc5ah	;sorry chaps
	dw	adr
	endm

KM_SET_EXPAND	equ	0d4h
KM_KT_GET	equ	0dah
KM_KT_PUT	equ	0ddh
TE_ASK		equ	0bfh

kshift	equ	21
kalt	equ	80
kextra	equ	84
kshlock	equ	70
kright	equ	6
kleft	equ	15
kup	equ	14
kdown	equ	79
kplus	equ	23
kminus	equ	76
kexit	equ	8
kdelback equ	72
kcopy	equ	11
kfind	equ	20
kcut	equ	10
kcr	equ	18
kenter	equ	78
kfind	equ	20
kC	equ	62
kH	equ	44
kJ	equ	45
kV	equ	55
kY	equ	43

repeat	equ	3
shift	equ	5	; bit in the shift status byte
alt	equ	7


base	equ	$
ctle	equ	5
ctlx	equ	24
bdos	equ	base+5
buf	equ	base+128
HOME	EQU	BASE+010H
ctlh	equ	8
ctlg	equ	7
ctls	equ	19
ctld	equ	4
return	equ	13
esc	equ	27
screen	equ	2
conio	equ	6
string	equ	9
par	equ	255
F1	equ	BASE+080h
F2	equ	BASE+090h
F3	equ	BASE+0a0h
F4	equ	BASE+0b0h
F5	equ	BASE+0c0h
F6	equ	BASE+0d0h
F7	equ	BASE+0e0h
F8	equ	BASE+0f0h


	org	0100H

START:	
	xbios	TE_ASK
	ld	(viewtop),bc
	ld	(viewsize),de
	CALL	dispage
	CALL	setwindow
	call	ReadKeys
;may be we should define the fuction keys to be the usual tokens here.

	CALL	HOME
	LD	HL,F1
	LD	DE,16
	LD	B,8
FIRSTLOOP:
	PUSH	HL
	PUSH	DE
	PUSH	BC
	CALL	PSTRING
	LD	DE,CRLF
	LD	C,STRING
	CALL	BDOS
	POP	BC
	POP	DE
	POP	HL
	ADD	HL,DE
	DJNZ	FIRSTLOOP

	LD	A,(COLUMN)
	LD	B,A
	LD	A,(ROW)
	CALL	DOPOS


KEYLOOP:
loop:
key1:	xbios	KM_KT_GET
	jr	nc,loop
; key number in bc
;ignore shifted stuff on its own
	ld	a,c
	cp	kshift
	jr	z,key1
	cp	kalt
	jr	z,key1
	cp	kextra
	jr	z,key1
	cp	kshlock
	jr	Z,key1

	res	3,b
	dec	b
	inc	b
	jr	nz,Shifted
;the unshifted codes
	cp	kdelback
	jp	z,DELCHAR
	cp	kexit	   ; an esc
	jp	z,EXIT  ; quit
	cp	kcr	; cr
	jp	z,DORETURN
	cp	kenter
	jp	z,DORETURN
	cp	kdown	; down cursor
	jp	z,DODOWN
	cp	kleft	; left
	jp	z,DOLEFT
	cp	kup	; up cursor
	jp	z,DOUP
	cp	kright	; right cursor
	jp	z,DORIGHT
;now make it ASCII
normal:	xbios	KM_KT_PUT
	ld	c,conio
loop2:	ld	e,255
	call	bdos
	or	a
	jr	z,loop2
	cp	" "
	jr	c,key1
	jp	DOCHAR
Shifted: bit	shift,b
	jr	nz,normal	;really shifted
Alted:	bit	alt,b
	jp	z,normal	;not shift or alt assume ascii
	cp	kH
	jp	z,BACKSPACE		;destructive backspace
	jr	normal

EXIT:
	call	WriteKeys
	call	restwindow
	JP	BASE


; A Subroutine which outputs a length prefaced string padding to 15 spaces
PSTRING:
	LD	A,(HL)
	CP	255
	LD	B,15
LOOPQ:	INC	HL
	CP	0
	JP	Z,DONESTRING
	LD	E,(HL)
	LD	C,2
	PUSH	HL
	PUSH	BC
	PUSH	AF
	CALL	BDOS
	POP	AF
	POP	BC
	POP	HL
	DEC	A
	Jr	NEXT
DONESTRING:
	LD	E,32
	LD	C,2
	PUSH	HL
	PUSH	BC
	PUSH	AF
	CALL	BDOS
	POP	AF
	POP	BC
	POP	HL
NEXT:	DJNZ	LOOPQ
	RET

;Takes 1..8 from ROW and returns with HL=F1,F2...
;destroys DE,AF

FINDF:	LD	A,(ROW)
	dec	a
	add	a,a
	add	a,a
	add	a,a
	add	a,a
	ld	hl,F1
	ld	e,a
	ld	d,0
	add	hl,de
	ret


;insert an 'ordinary' character into the thingey
DOCHAR:
	PUSH	AF
	CALL	FINDF
	LD	A,(COLUMN)
	CP	16
	JP	NZ,CONT
;already full
	POP	AF
	JP	KEYLOOP

CONT:	PUSH	AF
	LD	C,(HL)
	SUB	C
	CP	1
	JP	NZ,CONT2
;increment the character count if at the right place
	INC	(HL)
CONT2:	POP	AF
	LD	C,A
	LD	B,0
	POP	AF
	PUSH	HL
	ADD	HL,BC
	LD	(HL),A
	LD	HL,COLUMN
	INC	(HL)
	LD	A,(ROW)
	LD	B,1
	CALL	DOPOS		;cursor positioning
	POP	HL
	CALL	PSTRING
	LD	A,(COLUMN)
	LD	B,A
	LD	A,(ROW)
	CALL	DOPOS		; and some more
	JP	KEYLOOP
COLUMN:
	DEFB	1
ROW:
	DEFB	1

DOPOS:	LD	C,A
	PUSH	BC
	CALL	HOME
	POP	BC
	PUSH	BC
	DEC	B
	XOR	A
	CP	B
	JP	Z,ZERO1
	LD	C,9
	LD	DE,RIGHT
LOOPX:	PUSH	BC
	PUSH	DE
	CALL	BDOS
	POP	DE
	POP	BC
	DJNZ	LOOPX
ZERO1:	POP	BC
	LD	B,C
	DEC	B
	XOR	A
	CP	B
	JP	Z,ZERO2
	LD	C,2
	LD	E,10
LOOPZ:	PUSH	BC
	PUSH	DE
	CALL	BDOS
	POP	DE
	POP	BC
	DJNZ	LOOPZ
ZERO2:	RET

ReadKeys:
	ld	b,8		;there are 8 function keys
	ld	de,F1
	ld	hl,fkeylist
ReadK10:
	push	bc
	ld	bc,kcr
	xbios	KM_KT_PUT
	ld	c,(hl)
	inc	hl
	ld	b,(hl)
	inc	hl
	push	hl
	xbios	KM_KT_PUT

;Now read until we have a 13
	push	de		;the start of this string
	ld	c,0	
ReadK20: push	bc
	push	de

	ld	e,-3
	ld	c,6
	call	BDOS
	cp	13
	pop	de
	pop	bc
	jr	z,ReadK30
	cp	" "
	jr	c,ReadK20		; other control code - naughty
	inc	de
	ld	(de),a
	inc	c
	ld	a,15
	cp	c
	jr	nz,ReadK20
ReadK30: pop	hl		;update length byte
	ld	(hl),c
	ld	de,16		;to the next one
	add	hl,de
	ex	de,hl
	pop	hl		;for which key to do next
	pop	bc
	inc	c
	djnz	ReadK10
	ret


fkeylist:	defb 2,0,2,20h,0,0,0,20h,73,0,73,20h,77,0,77,20h
; Sends the key defintions to the BIOS
WriteKeys:
	ld	hl,F1
	ld	b,8
	ld	c,81h
WriteK10: push	bc
	push	hl
	ld	b,c
	ld	c,(hl)
	inc	hl
	xbios	KM_SET_EXPAND
	pop	hl
	ld	de,16
	add	hl,de
	pop	bc
	inc	c
	djnz	WriteK10
	ret

DELCHAR:
	CALL	FINDF
	LD	A,(COLUMN)
	LD	B,(HL)
	SUB	B
	CP	1
	JP	Z,KEYLOOP
	PUSH	HL
	DEC	(HL)
	CP	0
	JP	Z,MISSMOVE
	LD	A,(COLUMN)
	LD	B,A
	LD	A,(HL)
	SUB	B
	INC	A
	LD	C,A
	LD	B,0
	PUSH	BC
	LD	A,(COLUMN)
	LD	C,A
	ADD	HL,BC
	PUSH	HL
	INC	HL
	POP	DE
	POP	BC
	LDIR
MISSMOVE:
	LD	A,(ROW)
	LD	B,1
	CALL	DOPOS
	POP	HL
	CALL	PSTRING
	LD	A,(COLUMN)
	LD	B,A
	LD	A,(ROW)
	CALL	DOPOS
	JP	KEYLOOP



;i.e. delete forwards
BACKSPACE:
	CALL	FINDF
	LD	A,(COLUMN)
	CP	1
	JP	Z,KEYLOOP
	DEC	(HL)
	DEC	A
	LD	(COLUMN),A
	LD	B,A
	LD	A,(HL)
	SUB	B
	INC	A
	PUSH	HL
	AND	A
	JP	Z,NOMOVE
	LD	B,0
	LD	C,A
	PUSH	BC
	LD	A,(COLUMN)
	LD	C,A
	ADD	HL,BC
	PUSH	HL
	INC	HL
	POP	DE
	POP	BC
	LDIR
NOMOVE:
	LD	A,(ROW)
	LD	B,1
	CALL	DOPOS
	POP	HL
	CALL	PSTRING
	LD	A,(COLUMN)
	LD	B,A
	LD	A,(ROW)
	CALL	DOPOS
	JP	KEYLOOP


; Cursor Up
DOUP:	LD	A,(ROW)
	CP	1
	JP	Z,KEYLOOP
	DEC	A
	LD	(ROW),A
	CALL	FINDF
	LD	B,(HL)
	LD	A,(COLUMN)
	INC	B
	CP	B
	JP	C,LEGAL
	LD	A,B
	LD	(COLUMN),A
LEGAL:	LD	B,A
	LD	A,(ROW)
	CALL	DOPOS
	JP	KEYLOOP


;Cursor Down
DODOWN:
	LD	A,(ROW)
	CP	8
	JP	Z,KEYLOOP
	INC	A
	LD	(ROW),A
	CALL	FINDF
	LD	B,(HL)
	LD	A,(COLUMN)
	INC	B
	CP	B
	JP	C,OK
	LD	A,B
	LD	(COLUMN),A
OK:	LD	B,A
	LD	A,(ROW)
	CALL	DOPOS
	JP	KEYLOOP

;Cursor Left
DOLEFT:
	LD	A,(COLUMN)
	CP	1
	JP	Z,KEYLOOP
	DEC	A
	LD	(COLUMN),A
	LD	DE,LEFT
	LD	C,9
	CALL	BDOS
	JP	KEYLOOP
LEFT:	DEFB	27,68,"$"
; Cursor Right
DORIGHT:
	LD	A,(COLUMN)
	CP	16
	JP	Z,KEYLOOP
	PUSH	AF
	CALL	FINDF
	POP	AF
	LD	B,(HL)
	SUB	B
	CP	1
	JP	Z,KEYLOOP
	LD	A,(COLUMN)
	INC	A
	LD	(COLUMN),A
	LD	DE,RIGHT
	LD	C,9
	CALL	BDOS
	JP	KEYLOOP
RIGHT:	DEFB	27,67,"$"

; Carriage RETURN
DORETURN:
	LD	A,(ROW)
	CP	8
	JP	Z,KEYLOOP
	INC	A
	LD	(ROW),A
	XOR	A
	INC	A
	LD	(COLUMN),A
	LD	DE,CRLF
	LD	C,9
	CALL	BDOS
	JP KEYLOOP

title:	defb	086h,esc,"p","    Function  Keys    ",esc,"q",08ch,13,10
blkline:
	defb	085h
	defs	22,32
	defb	085h,13,10,024h
CRLF	EQU	BLKLINE+24
fline:	defb	085h," f1 - "
	defs	16,32
	defb	085h,13,10,"$"
num	equ	fline+3

dispage:
	CALL	HOME
	ld	de,title
	ld	c,9
	call	bdos
	ld	b,8
	ld	c,9
	ld	de,fline
dloop:	ld	a,"9"
	sub	b
	ld	(num),a
	push	de
	push	bc
	
	call	bdos
	
	pop	bc
	pop	de
	djnz	dloop

	ld	e,083h
	ld	c,2
	call	bdos
	ld	c,2
	ld	b,22
	ld	e,08ah
loopbot: push	bc
	push	de
	call	bdos
	pop	de
	pop	bc
	djnz	loopbot
	ld	e,089h
	call	bdos

	jp	HOME


restwindow:

	ld	a,27
	call	writechar
	ld	a,'X'
	call	writechar
	ld	a,(viewtop+1)
	call	writeascii
	ld	a,(viewtop)
	call	writeascii
	ld	a,(viewsize+1)
	call	writeascii
	ld	a,(viewsize)
	call	writeascii

writeascii: add	a,32
writechar: push	de
	push	bc
	push	af
	ld	e,a
	ld	c,6
	call	bdos
	pop	af
	pop	bc
	pop	de
	ret


setwindow:
	ld	a,27
	call	writechar
	ld	a,'X'
	call	writechar
	ld	a,(viewtop+1)
	add	a,2		; 2 down
	call	writeascii
	ld	a,(viewtop)	; 7 across
	add	a,7
	call	writeascii
	ld	a,18
	call	writeascii
	ld	a,19		;width 
	jr	writeascii


viewtop:	dw	0
viewsize:	dw	0


;
END