; ---------------------------------------------------
; system handling routines via cp/m.

; .... version #3
; ---------------------------------------------------

; jump table......

outch	jp xoutch	; output character in 'A'.
inch	jp xinch	; wait for, and get, chr to 'A'.
uinch	jp xuinch	; as inch, but force upper case
inhex	jp xinhex	; fetch hex byte from kbd
in4hex	jp xin4h	; fetch 4 hex digits to hl
lc2uc	jp xlc2uc	; force upper case chr
crlf	jp xcrlf	; print cr, lf.
clrpget	jp xclrp	; clear screen, print from 'de', get upper key.
decurs	jp xdec		; cursor to row, col in 'DE'
revsel	jp xrev		; into reverse video
vnorm	jp xnorm	; normal video
pbyte	jp xpbyte	; print hex byte
c4hex	jp xc4hex	; print 4 hex in HL at posn DE
p4hex	jp xp4hex	; print 4 hex at cursor
pdbyte	jp xpdb		; print byte in 3 digit decimal
pbbyte	jp xpbb		; print byte in binary form
echeck	jp xcex		; to cp/m if cntrl 'C typed
ctest	jp xctest	; test for cntrl 'C, zero if so.
inkey	jp xinkey	; fetch key if pressed else zero
pstr	jp xpstr	; print string, adr in 'de' then term.
delay	jp xdel		; delay 'de' millisecs
dark	jp xdchar	; dark background
light	jp xlchar	; light background
con	jp xcon		; cursor blob on.
coff	jp xcoff	; cursor off
cscreen	jp xcsc		; clear screen

; ---------------------------------------------------

; cp/m equates, function codes and call addresses.

conin	equ 1	; console input to 'A'
conout	equ 2	; console output from 'E'
ptrout	equ 5	; printer output from 'E'
strpnt	equ 9	; print string, DE adr, then:
term	equ 4	; ..string terminator
cnstat	equ 11	; get console status to 'A'

bdos	equ 5H	; cp/m BDOS entry address
warms	equ 0	; cp/m warm start address
himem	equ 6	; cp/m first address store

; ---------------------------------------------

; terminal control characters.


bell	equ 7		; bell code
lf	equ 10		; line feed
cr	equ 13		; carriage return
esc	equ 27		; escape

; terminal escape control sequences.

cup	equ 256*"A"+esc	; cursor up
cdn	equ 256*"B"+esc	; cursor down
crt	equ 256*"C"+esc	; cursor right
cle	equ 256*"D"+esc	; cursor left
clear	equ 256*"E"+esc	; clear screen
home	equ 256*"H"+esc	; cursor home
pcurs	equ 256*"Y"+esc	; set cursor position r,c
dline	equ 256*"l"+esc	; clear all line
rev	equ 256*"p"+esc	; into reverse video
revoff	equ 256*"q"+esc	; out of reverse
ulon	equ 256*"r"+esc	; underline on
uloff	equ 256*"u"+esc	; underline off
econ	equ 256*"e"+esc ; cursor enabled
dcon	equ 256*"f"+esc ; cursor disabled

; -----------------------------------------------


; test for control 'C', exit cp/m if so.

xcex	call xctest	; cntrl'C' ?
	ret nz		; no
	jp warms	; yes, cp/m

; test for control 'C typed, exit zero if so.

xctest	call xinkey	; get keyboard status
	cp 3		; cntrl 'C?
	ret		; out

; return keyboard status to 'A', zero = no chr
; if key pressed, get it.

xinkey	ld c,cnstat
	call bdos
	cp 0		; zero for no chr?
	ret z		; yes, out
	call xinch		; no, get chr.
	add a,0		; set z untrue
	ret

; print carriage return, line feed.

xcrlf	ld a,0dH
	call xoutch
	ld a,0aH
	jp xoutch

; select reverse video

xrev	push de
	ld de, xrev1
	call pstr
	pop de
	ret

xrev1	defw rev
	defb term

; select normal video

xnorm	push de
	ld de, xnorm1
	call pstr
	pop de
	ret

xnorm1	defw revoff,uloff
	defb term

; clear screen

xcsc	push de
	ld de, xcsc1
	call pstr
	pop de
	ret

xcsc1	defw home, clear
	defb term

; select cursor blob on

xcon	push de
	ld de, xcon1
	call pstr
	pop de
	ret

xcon1	defw econ
	defb term

; select cursor blob off

xcoff	push de
	ld de, xcoff1
	call pstr
	pop de
	ret

xcoff1	defw dcon
	defb term

; wair for, and get char, force upper case.

xuinch	call inch
	jr xlc2uc

; wait for, and get keyboard character.

xinch	push hl
	push de
	push bc
	ld c,1
	call bdos	
	pop bc
	pop de
	pop hl
	ret

; force ascii upper case if lower

xlc2uc	cp "a"
	jr c,lc1	; branch if <"a" (not lower)
	cp "z"+1
	jr nc,lc1	; branch if >"z" (not lower)
	sub "a"-"A"	; change "a".."z" to "A".."Z"
lc1	ret

; clear screen, print message at 'de' and get key press-
; forcing upper case.

xclrp	call xcsc	; clear screen
	call pstr	; print string
	jp xuinch	; get key in upper.

; fetch 4 hex digits to HL. Exit carry set is error.

xin4h	call xinhex	; get MS byte
	ret c		; abort if error
	ld h,a		; save
	call xinhex	; get LS byte
	ld l,a
	ret

; fetch hex byte from keyboard

xinhex	call xinh1	; get ms hex nibble
	ret c		; out if error
	rla
	rla
	rla
	rla		; shift up ms nibble
	and 0f0h
	push af		; clean up and save
	call xinh1	; get ls nibble
	pop bc
	ret c		; out if error
	add a,b		; add both chrs
	ret		; out clear carry

xinh1	call inch	; get chr
	call lc2uc	; force upper case
	sub "0"		; less than zero dec?
	jr c,xinh2	; yes, bad
	cp 10		; no. 0-9 inc?
	jr c,xinh3	; yes. got chr
	sub "A"-"0"-10	; remove chr base
	cp 16		; out of hex range?
	jr nc,xinh2	; yes. bad
xinh3	scf
	ccf		; clear carry
	ret		; return with good chr
xinh2	xor a
	scf
	ret		; return with carry error

; string print, address in 'de', ends in 'term'.

xpstr	push af
	push bc
xpstr1	ld a,(de)	; fetch chr
	cp 4		; end of string?
	jr z,xpstr2	; yes, out
	call outch	; print it
	inc de
	jr xpstr1	; loop
xpstr2	pop bc
	pop af
	ret

; print one hex byte.

xpbyte	push af		; save byte
	rra		; move nibble right
	rra
	rra
	rra
	call pb1	; print ms nibble
	pop af		; restore byte
pb1	and 0FH		; mask rh nibble
	cp 10		; 0-9 inc?
	jp nc, pb2	; no.
	add a, 30H	; yes, add ascii base
pb3	jp xoutch	; and print then out
pb2	add a, 65-10	; add ascii A-F base
	jr pb3		; and print

; print 4 hex digits in 'HL' at screen position 'DE',
; -DE = row,col, 0 is base.

xc4hex	call xdec	; cursor to position

; print 4 hex at cursor

xp4hex	ld a,h
	call pbyte	; print upper byte
	ld a,l
	jp pbyte	; print lower byte

; move cursor to position in 'DE'. Org is 00 and row,col.

xdec	push af
	ld a,esc
	call outch
	ld a,"Y"
	call outch	; cursor position select
	ld a,d
	add a,32
	call outch	; out row
	ld a,e
	add a,32
	call outch	; out col
	pop af
	ret

; print byte in 'A' in 3-digit decimal.

xpdb	ld c,2fh	; dec '0'-1
pdb1	inc c
	ld b,a		; save byte
	sub 100		; test hundreds
	jr nc, pdb1	; loop until counted hdrds
	ld a,c
	call outch	; print hundreds

	ld a,b
	ld c,2fh	; dec '0'-1
pdb2	inc c
	ld b,a		; save byte
	sub 10		; test tens
	jr nc, pdb2	; loop until counted tens
	ld a,c
	call outch	; print tens

	ld a,b		; restore byte
	add a,"0"	; remainder is units
	jp outch

; print byte in 'A' in binary form.

xpbb	ld c,8		; set up bit count
	ld b,a		; set up work reg
xpbb1	ld a,"0"	; assume bit is '0'
	rlc b		; shift left
	jr nc,xpbb2	; yes, was '0'.
	ld a,"1"	; no, was '1'.
xpbb2	call outch	; print bit
	dec c
	jr nz, xpbb1	; loop 8 bits
	ret

; print a character from 'A'.

xoutch	push af
	push hl
	push de
	push bc
	ld e,a		; move character
	ld c,conout	; out character BDOS code
	call bdos		; print it.
	pop bc
	pop de
	pop hl
	pop af
	ret

; set dark dackground.

xdchar	ld de, xdc1
	jp pstr

xdc1	defb esc,"c",32,term

; set video for light background.

xlchar	ld de, xlc1
	jp pstr

xlc1	defb esc,"c",0,term

; delay 'de' millisecs.

xdel	push af
	push bc
xdel1	ld b,200
xdel2	dec b
	jr nz, xdel2	; loop 1mS core

	dec de
	ld a,d
	or e		; dec and test 'de'
	jr nz, xdel1	; loop until done
	pop bc
	pop af

	ret

; end of system handling routines
; ---------------------------------------------------