;		13 May 85

;**
;**		80 COLUMN FUNCTION CODE
;**

fixed$8563	equ	false

;*
;*	Write character in D to current cursor address
;*	Advance cursor next position
;*
wr$char$80:
	lhld	char$adr
	call	write$char$80
	lda	char$col	; get cursor column number
	cpi	80-1
	jrz	do$crlf
	inr	a
	sta	char$col	; update column number
	lhld	char$adr	; get cursor address
	inx	h
	shld	char$adr	; update cursor address

;
;	input:
;		HL=current cursor address
;
set$cursor:
	mvi	a,14			;
	call	wait			;
	outp	h
	mvi	a,15			;
	call	wait			;
	outp	l
	ret

	page


;*
;*	Set current ROW and COL  (supplied in DE)
;*
;*
crs$pos$80:
	mov	a,d
	cpi	25
	rnc
	mov	a,e
	cpi	80
	rnc
	xchg				; cursor row # in D,column # in C
	shld	char$col

;
;	returns with cursor set and current ROW, COLUMN in BC
;	and character screen address in HL 
;
compute$adr:
	lhld	char$col
	call	cur$adr$hl		; HL=cursor address on return
	shld	char$adr
	jr	set$cursor		; call/ret

	page
;*
;*	Move cursor up one line; do nothing if on the 
;*	top line
;*
crs$up$80:
	lda	char$row
	ora	a
	rz
	dcr	a
set$row$80:
	sta	char$row
	jr	compute$adr


do$crlf:
	xra	a
	sta	char$col

;*
;*
;*
;*
crs$down$80:
	lda	char$row
	cpi	lines-1			; on bottom line ?
	jrz	scroll$up		; yes, scroll the screen
	jrnc	set$24$80		; past it, set it to line 24
	inr	a
	jr	set$row$80

;*
;*
;*
;*
crs$left$80:
	lda	char$col
	ora	a
	rz
	dcr	a
set$col$80:
	sta	char$col
	jr	compute$adr

	page
;*
;*
;*
;*
crs$rt$80:
	lda	char$col
	inr	a
	cpi	80
	jrnz	set$col$80
	ret

;*
;*
;*
;*
crs$cr$80:
	xra	a
	jr	set$col$80

	page
;
;
;
set$24$80:
	mvi	a,lines-1
	sta	char$row
;
;
;
scroll$up:
	  lxi	h,80
	  lxi	d,0
	  lxi	b,80*(lines-1)
	  call	block$move$80

;
;
;
clear$bottom$line:
	lxi	h,80*(lines-1)
	lxi	b,80
	call	block$fill$space$80
	jr	compute$adr

	page
;*
;*	B= bit position to set or clear
;*	C= new bit value
;*
;*	attr byte def. (in B and C)
;*		bit 7-alternate char set (uper case set)
;*		bit 6-reverse video
;*		bit 5-underline
;*		bit 4-blink
;*		bit 0-full intensity
;*
;*
set$attr$80:
	lda	current$atr
	cma				; invert A
	ora	b			; force new bit to 1
	cma				; restore A
	ora	c
	sta	current$atr
	ret

	page
;*
;*	ASCII codes(B)	20h to 2Fh set character color
;*			30h to 3Fh set background color
;*			50h to 5Fh set logical character color
;*			60h to 6Fh set logical background color
;*			all others code do nothing
;*
;*
set$color$80:
	mov	a,b			; get color to A
	sui	20h			; remove the BIAS
	cpi	20h			; physical color ? (00h-1Fh)
	jrc	?col$80			; yes, go set it
	mvi	c,20h			; max color value+1 (00h-1Fh)
	call	lookup$color$1		; convert char in A to color (ret in A)
					; C=max color character
	rc				; return if error
	mov	a,m			; get color bytes
	ani	0fh			; LSB is 80 column color
	add	b			; Add color offset back
					; 0-f set forground color
					; 10-1f set background color

	page	
;
;	set color in A	(00-0F sets the character color)
;			(10-1F sets the background color)
;
;	This routine first calls lookup color to convert the 40 column
;	color (normal color) to the 80 column RGBI color 
;
?col$80:
	sta	temp1
	mvi	c,20h			; max color value+1 (00h-1Fh)
	adi	30h			; restore a bias
	lxi	h,color$convert$tbl	; table to use
	call	lookup$color$2		; convert to same color as 40 Column
	mov	a,m			; get character color
	add	b			; add color offset back

	cpi	10h			; character color? (0-f)
	jrc	chr$col$80		; yes, go do it
					; no, fall thru and set background
;
;	set background color (10-1F)
;
	ani	0Fh			; get value of 0 to F
	sta	bg$color$80
	push	psw
	mvi	a,26			; color register
	call	wait
	pop	psw
	outp	a	
	ret

;*
;*
;*
rd$color$80:
	lda	bg$color$80
	mov	b,a
	lda	current$atr
	mov	d,a
	lda	char$color$80
	ret

	page
;
;	set character color
;
chr$col$80:
	mov	b,a
	lda	current$atr
	ani	0f0h		; remove old color
	ora	b		; merge new color
	sta	current$atr	; save new attr
	lda	temp1
	sta	char$color$80
;
;	set current char position color to new color 
;
	lhld	char$adr	; get current cursor adr
	lxi	d,800h		; offset to attr
	dad	d		; pointing to current char attr
	call	set$update$adr	; point to attr byte
	lda	current$atr
	outp	a
	ret

	page
;*
;*
;*
;*
CEL$80:
	call	cur$adr$80$hl$sz$a	; HL=cur adr, DE=line start adr
					; BC=count to move, A=BC+1
	inx	b			; 1 to 80 to fill
	jr	cont$space$fill


;*
;*
;*
;*
CES$80:
	call	cur$adr$80$hl$sz$a	; HL=cur adr, DE=line start adr
					; BC=count to move, A=BC+1
	xchg				; cursor address in DE
	lxi	h,lines*80
	xra	a			; clear the carry
	dsbc	DE			; count will be minus if on status line
	rm				; return if on status line
	mov	b,h
	mov	c,l			; count to BC
	xchg				; cursor address back to HL

cont$space$fill:
	jmp	block$fill$space$80

	page
;*
;*
;*
char$ins$80:
	call	cur$adr$80$hl$sz$a	; HL=cur adr, DE=line start adr
					; BC=count to move, A=BC+1 (1-80) 
	lxi	h,80-1
	dad	d			; point to end of line
	dcr	a			; A=1 if at end of line
	jrz	char$ins$80$end
	mov	d,h
	mov	e,l			; HL=DE= end of line address
	dcx	h			; [HL--] -> [DE--] count BC

	push	b
	push	h
	push	d
	call	insert$low
	lxi	b,800h			; attribute offset
	pop	h
	dad	b
	xchg
	pop	h
	dad	b
	pop	b

insert$low:
	push	b
	call	set$update$adr
	inp	a
	xchg
	push	psw
	call	set$update$adr
	pop	psw
	outp	a
	xchg
	pop	b
	dcx	h
	dcx	d
	dcx	b
	mov	a,b
	ora	c
	jrnz	insert$low

	lhld	char$adr

char$ins$80$end:
	jmp	write$space$80

	page
;*
;*
;*
;*
char$del$80:
	call	cur$adr$80$hl$sz$a	; HL=cur adr, DE=line start adr
					; BC=count to move, A=BC+1
	push	d			; save line start address
	mov	d,h
	mov	e,l			; DE=HL=cursor address
	inx	h			; [HL++]->[DE++] count BC
	call	block$move$80		; DE points to last position

	pop	h			; recover line start address
	lxi	d,80-1
	dad	d			; point to end of line
	jmp	write$space$80

	page
;*
;*
;*	Moves one line at a time, down one line, starting with the next
;*	to the bottom line. Once the cursor line is moved down, the
;*	cursor line is cleared.
;*
line$ins$80:
	lxi	d,new$offset
	mvi	a,lines-1		; cursor on or past the last line ?
	lhld	char$col
	cmp	h
	jz	clear$bottom$line	; no bottom, clear bottom line
	jrc	line$ins$cont		; past,
	lxi	h,(lines-2)*80
	lxi	d,(lines-1)*80
	mvi	b,lines
move$next$down:
	call	move$line$down
	lda	char$row
	cmp	b
	jrnz	move$next$down

	call	cur$adr$80$hl$sz$a	; HL=cur adr, DE=line start adr
					; BC=count to move, A=BC+1
	xchg				; get line start adr
	lxi	b,80
	jr	block$fill$space$80

;
;
;
line$ins$cont:
	inr	a
	cmp	l
	rnz
	jmp	update$it

	page
;
;	INPUT:
;		HL=source
;		DE=dest
;		 B=line number
;	OUTPUT:
;		HL=source-80
;		DE=dest-80
;		 B=line number - 1
;
move$line$down:
	push	b
	push	h
	push	d
	lxi	b,80
	call	block$move$80
	lxi	b,-80
	pop	h
	dad	b
	xchg
	pop	h
	dad	b
	pop	b
	dcr	b
	ret

	page
;*
;*
;*
line$del$80:
	lda	char$row
	cpi	lines			; is the cursor past the bottom line ?
	rnc				; yes, exit
	call	cur$adr$80$hl$sz$a	; HL=cur adr, DE=line start adr
					; BC=count to move, A=BC+1
	lxi	h,80			; line length
	dad	d			; HL=start of next line
	xchg				; move from address in DE
	push	h			; save TO address
	lxi	h,lines*80
	xra	a			; clear the carry
	dsbc	DE
	mov	b,h
	mov	c,l			; count to BC
	pop	h			; recover TO address 
	xchg				; move from address back to HL

	call	block$move$80		; DE points to last position
	jmp	clear$bottom$line

	page
;
;	user interface point
;
blk$fill:
	pop	h			; get the return addres
	xthl				; get HL, ret adr to stack.
	jr	block$fill$80
;
;	INPUT:
;		HL=start address
;		BC=count
;
block$fill$space$80:
	lda	current$atr
	mov	e,a
	mvi	d,' '
;
;	80 block fill
;
;	INPUT:
;		HL=start address
;		BC=count
;		D=fill character, E=attribute
;
block$fill$80:
	mov	a,b			; get MSB of count to A
	ana	a			; is it zero
	jrz	fill$less$256		; yes, move less than 256 bytes
block$fill$cont$80:
	push	h
	push	d
	push	b
	xra	a
	call	fill$data$80
	pop	b
	pop	d
	pop	h
	inr	h
	djnz	block$fill$cont$80

	page
;
;
;
fill$less$256:
	mov	a,c			; get LSB of count to A
	ana	a			; is it zero ?
	rz				; yes, none left to fill, return 
;
;	count in A (1 to 256) (0=256)
;	HL=fill adr
;	DE=fill character, and attribute
;
fill$data$80:
	push	psw			; save count
	push	h			; save adr
	push	d			; save fill character
	call	fill$half$80
	pop	d			; recover fill character
	lxi	b,800h			; offset to attributes 
	pop	h			; recover adr
	dad	b			; HL=attr adr
	call	do$twice?
	pop	psw			; recover count
	mov	d,e			; get the attr to D

	page
;
;
fill$half$80:
	push	psw			; save the count
	call	set$update$adr		; write address to chip R18,R19
	outp	d			; write update data (R31)

	pop	psw
	dcr	a			; already wrote one above 
	rz				; return if only one required
	push	psw
	
	mvi	a,24
	call	wait
	inp	a			; get old value in reg 24
	ani	7fh
	outp	a			; clear R24(7), enabling block writes

	mvi	a,30
	call	wait
	pop	psw			; recover the count
	outp	a			; write count to R30
    if	fixed$8563
	ret
    else
	mvi	b,0	
	mov	c,a
	inx	b			; add back the one removed above
	dad	b
	push	d			; save fill char (in D)
	push	h			; HL=end address

	mvi	a,18
	call	wait
	inp	h
	mvi	a,19
	call	wait
	inp	l			; HL=current pointer

	pop	d			; DE=end adr
	pop	b			; get fill char (to B)
finish$fill:
	call	cmp$HL$DE		; compare dest with chip dest
					; HL<DE carry is set
	rnc				; return if done

	push	b			; save fill char
	call	set$update$adr		; HL&DE NOT changed (BC&A changed)
	pop	b			; recover fill char
	outp	b
	inx	h			; add one to dest pointer
	jr	finish$fill

    endif

	page
;
;	user entry point return adr on top of stack
;	and HL next
;
blk$move:
	pop	h			; get return adr
	xthl				; get HL save ret adr
;
;	block move 80 column chip memory
;
;	INPUT:
;		HL=source
;		DE=dest
;		BC=count
;
block$move$80:
	mov	a,b			; get MSB of count to A
	ana	a			; is it zero
	jrz	move$less$256		; yes, move less than 256 bytes
block$move$cont$80:
	push	h
	push	d
	push	b
	xra	a
	call	move$data$80
	pop	b
	pop	d
	pop	h
	inr	h
	inr	d
	djnz	block$move$cont$80

move$less$256:
	mov	a,c			; get LSB of count to A
	ana	a			; is it zero ?
	rz				; yes, none left to move, return 

	page
;
;	count in A (1 to 256) (0=256)
;	HL=source
;	DE=dest
;
move$data$80:
	xchg				; HL=dest DE=source
	push	psw			; save count
	push	h			; save dest
	push	d			; save source
	call	move$half$80
	lxi	b,800h			; offset to attributes 
	pop	h			; recover source addr
	dad	b			; make attr source
	xchg				; DE=attr source
	pop	h			; recover dest
	dad	b			; HL=attr dest
	call	do$twice?
	pop	psw			; recover count

;
;
move$half$80:
	push	psw			; save the count
	call	set$update$adr		; write dest address to chip R18,R19

	mvi	a,24
	call	wait
	inp	a			; get old value in reg 24
	ori	80h
	outp	a			; set R24(7), enabling block copy

; call	set$source$adr		; write source address (R32,R33=DE)
;set$source$adr:
	mvi	a,32
	call	wait
	outp	d
	mvi	a,33
	call	wait
	outp	e
; ret

	mvi	a,30
	call	wait
	pop	psw			; recover the count
	outp	a			; write count to R30
	ret

	page

;
;
;
do$twice?:
	mov	a,h			; HL=video memory address
	cpi	DS$char$def/256		; Char def area?
	rc				; no, return, must be char, attr area
	pop	psw			; remove return adr
	pop	psw			; remove old A and psw
	ret				; return to org caller

	page
;
;
;
write$space$80:
	mvi	d,' '
write$char$80:
	lda	current$atr

;
;	HL=cursor adr, D=char to write, A=attr to write
;
write$memory:
	push	h
	push	d			; save character
	lxi	d,800h			; offset to attribrute
	dad	d
	mov	d,a
	call	wr$mem
	pop	d
	pop	h

wr$mem:
	call	set$update$adr
	outp	d
	ret

;*
;*	input:
;*		D=Char ROW, E=Char COLUMN
;*	output:
;*		B=Char, C=attribute (true RGBI color)	
;*
rd$chr$80:
	call	crs$pos$80
	lhld	char$adr
	call	read$memory
	mov	c,a			; attr was in A
	ret

;*
;*	input:
;*		D=Char ROW, E=Char COLUMN
;*		B=Char, C=attribute (true RGBI color)	
;*	output:
;*
wr$chr$80:
	push	b			; save Char and attr
	call	crs$pos$80
	lhld	char$adr
	pop	b			; recover Char and attr
	mov	d,b			; char to D
	mov	a,c			; attr to A
	jr	write$memory		; write char and attr to memory

;
;
;
read$memory:
	push	h
	lxi	d,800h			; offset to attribute
	dad	d
	call	rd$mem
	mov	a,b
	pop	h
;
;	
rd$mem:
	push	psw
	call	set$update$adr
	pop	psw
	inp	b
	ret

	page
;
;
;
wait:
	push	psw
	lxi	b,0d600h		; point to adr register
wait$loop:
	inp	a			; check if chip is ready yet
	ral				; (MSB=1 when ready)
	jrnc	wait$loop		; not ready, loop
	pop	psw
	outp	a			; set chip register
	inr	c			; point to data register
	ret

;
;
;
set$update$adr:
	mvi	a,18
	call	wait
	outp	h
	mvi	a,19
	call	wait
	outp	l
	mvi	a,31
	call	wait
	dcr	c
	
update$wait:
	inp	a
	ral
	jrnc	update$wait
	inr	c
	ret

	page
;**
;**	40 COLUMN TERMINAL FUNCTION CODE 
;**
;**

;*
;*
;*
wr$char$40:
	mov	b,d
	call	ascii$to$petascii	; convert to pet ASCII
	lhld	char$adr$40
	mov	b,a
	lda	rev$40
	ora	b
	mov	m,a
	inx	h
	shld	char$adr$40
	lxi	d,800h-1
	dad	d			; point to attribute byte
	lda	attr$40			; get current attribute
	mov	m,a			; set it

	lda	char$col$40
	cpi	80-1			; at end of line?
	jrz	crlf$40			; yes, do crlf
	inr	a
	sta	char$col$40		; move cursor right
	jmp	set$cursor$40		; set cursor & paint the current ROW

	page
;*
;*	input:
;*		D=Char ROW, E=Char COLUMN
;*	output:
;*		H=Char ROW, L=Char COLUMN
;*		B=Char, C=attribute (40 col attr and color)	
;*
rd$chr$40:
	call	crs$pos$only$40
	lhld	char$adr$40
	mov	b,m
	lxi	d,800h
	dad	d
	mov	c,m
	ret

;*
;*	input:
;*		D=Char ROW, E=Char COLUMN
;*		B=Char, C=attribute (40 col attr and color)	
;*	output:
;*		H=Char ROW, L=Char COLUMN
;*
wr$chr$40:
	push	b
	call	crs$pos$only$40
	pop	b
	lhld	char$adr$40
	mov	a,b
	ani	7fh			; remove reverse video bit
	bit	6,c
	jrz	not$rev$vid$bit
	adi	80h			; set reverse video
not$rev$vid$bit:
	mov	m,a
	lxi	d,800h
	dad	d
	mov	m,c
	jmp	set$cursor$40


;*
;*
;*
crs$pos$40:
	lxi	h,old$offset
	setb	6,m			; force page paint
crs$pos$only$40:
	mov	a,d
	cpi	25
	rnc
	mov	a,e
	cpi	80
	rnc
	xchg
	shld	char$col$40
;
;
;
compute$adr$40:
	lhld	char$col$40
	call	cur$adr$hl		; HL=cursor adr relative to zero
	lxi	d,screen$40		; get screen offset
	dad	d			; true cursor address
	shld	char$adr$40
	jmp	set$cursor$40

	page
;*
;*
;*
;*
crs$up$40:
	lda	char$row$40
	ora	a
	rz

	dcr	a
set$row$40:
	sta	char$row$40
cont$compute$adr$40:
	lxi	h,old$offset
	setb	6,m
	jr	compute$adr$40

;
;
;
crlf$40:
	xra	a
	sta	char$col$40
;*
;*
;*
;*
crs$down$40:
	lda	char$row$40
	cpi	lines-1
	jrz	scroll$up$40
	jrnc	set$24$40
	inr	a
	jr	set$row$40

	page
;
;
;
set$24$40:
	mvi	a,lines-1
	sta	char$row$40
;
;
;
scroll$up$40:
	lxi	h,screen$40+80
	lxi	d,screen$40
	lxi	b,80*(24-1)
	ldir				; move characters up one line

	xchg				; get start of last line in HL
	lxi	d,screen$40+80*23+1
	lxi	b,80-1
	call	space$fill$40		; clear the bottom line

	lxi	h,screen$40+800h+80
	lxi	d,screen$40+800h
	lxi	b,80*(lines-1)
	ldir				; move attributes up one line

	xchg				; get start of last line in HL
	lxi	d,screen$40+800h+80*23+1
	lxi	b,80-1
	lda	attr$40
	mov	m,a
	ldir				; set color attribute 
	jr	cont$compute$adr$40

	page
;*
;*
;*
;*
crs$left$40
	lda	char$col$40
	ora	a
	rz

	dcr	a
set$col$40:
	sta	char$col$40
	jr	compute$adr$40

;*
;*
;*
;*
crs$rt$40:
	lda	char$col$40
	inr	a
	cpi	80
	jrnz	set$col$40
	ret

;*
;*
;*
;*
crs$cr$40:
	xra	a
	jr	set$col$40

	page
;*
;*
;*
;*
CEL$40:
	lxi	h,line$paint
	push	h
	call	cur$adr$40$hl$sz$a	; HL=cursor adr, DE=start of line adr
					; BC=DE+80-HL-1, A=BC+1 (1-80)
	lxi	d,screen$40		; get start of screen
	dad	d			; HL=cursor position in memory
	call	write$space$40		; place a space at the cursor adr
	mov	a,c
	ana	a
	rz
	push	b
	push	h
	mov	d,h
	mov	e,l			; DE=HL=cursor pos 
	inx	d			; point to next location
	ldir				; BC=count (0-79)
	jr	clear$attr$also

	page
;*
;*
;*
;*
CES$40:
	lxi	h,screen$paint
	push	h
	lxi	d,screen$40+80*lines-1	; DE=end of screen
	lhld	char$adr$40		; clear from char$adr to DE
	xchg
	xra	a			; clear the carry bit
	DSBC	DE			; result is minus if on status line
	rm				; return if on status line

	xchg
	jrz	write$space$40		; at end, clear cursor position

	mov	b,d
	mov	c,e			; count in BC
	mov	d,h
	mov	e,l			; start adr in HL
	inx	d			; start adr+1 in DE
	push	b			; save number of bytes to move
	push	h			; save start address
	call	space$fill$40		; move space thru screen
;
;
;
clear$attr$also:
	lxi	b,800h
	pop	h
	dad	b			; 1st attribute
	pop	b			; get the count
	mov	d,h
	mov	e,l
	inx	d			; 2nd attribute
	lda	attr$40
	mov	m,a
	ldir				; move current attribute to screen
	ret

	page
;*
;*
;*
;*
char$ins$40:
	lxi	h,line$paint
	push	h
	call	cur$adr$40$hl$sz$a	; HL=cur adr, DE=line start adr
					; BC=count to move, A=BC+1 (1-80) 
	lxi	h,screen$40-1+80
	dad	d			; point to end of current line
	dcr	a			; at right end of screen ?
	jrz	write$space$40		; yes, insert a space
	mov	d,h
	mov	e,l			; HL=DE= end of line address
	dcx	h			; [HL--] -> [DE--] count BC
	push	b
	push	d
	lddr				; DE=cursor position
	xchg
	call	write$space$40		; write a space at the cursor adr
	pop	h
	lxi	b,800h			; now move the attributes
	dad	b
	pop	b
	mov	d,h
	mov	e,l			; HL=DE= end of line address
	dcx	h			; [HL--] -> [DE--] count BC
	lddr				; DE=cursor position
	ret

;
;
;
write$space$40:
	lda	rev$40
	adi	' '			; clear character, enable cursor
	mov	m,a
	ret

	page
;*
;*
;*
;*
char$del$40:
	lxi	h,line$paint
	push	h
	call	cur$adr$40$hl$sz$a	; HL=cur adr, DE=line start adr
					; BC=count to move, A=BC+1
	lxi	d,screen$40
	dad	d			; point to screen memory location

	dcr	a			; at end of line ?
	jrz	write$space$40		; yes, then just erase cursor pos

	mov	d,h
	mov	e,l			; DE=HL=cursor address
	push	b
	push	h
	inx	h			; [HL++]->[DE++] count BC
	ldir				; DE points to last position
	xchg
	call	write$space$40		; place a space at the end of line
	pop	h
	lxi	b,800h+1		; now move the attributes
	dad	b
	pop	b
	mov	d,h
	mov	e,l			; HL=DE= cursor attr address
	inx	h			; [HL++] -> [DE++] count BC
	ldir				;
	ret

	page
;*
;*
;*
;*
line$ins$40:
	lxi	h,screen$paint
	push	h
	lda	char$row$40
	cpi	lines-1
	jrz	clear$bottom$line$40
	rnc				; return if on status line
	call	cur$adr$40$hl$sz$a	; HL=cur adr, DE=line start adr
					; BC=count to move, A=BC+1
	lxi	h,screen$40
	dad	d			; point to line start memory location
	push	h			; save start address
	lxi	d,80
	dad	d			; point to start of next line

	xchg				; cursor line(+1) start address in DE
	lxi	h,screen$40+80*lines	; end of screen address
	xra	a			; clear the carry bit (and A)
	dsbc	DE			; HL=HL-DE
	mov	b,h
	mov	c,l			; count in

	lxi	h,screen$40+80*(lines-1)-1	; HL=end of screen-80
	lxi	d,screen$40+80*lines-1		; DE=end of screen

	push	b
	lddr

	page

	pop	b
	lxi	h,screen$40+80*(lines-1)-1+800h
	lxi	d,screen$40+80*lines-1+800h
	lddr				; scroll the attributes
	pop	h			; get cursor line start address
	mov	d,h
	mov	e,l
	inx	d
	lxi	b,80-1
	jr	space$fill$40

;
;
;
clear$bottom$line$40:
	lxi	h,screen$40+(lines-1)*80
	lxi	d,screen$40+(lines-1)*80+1
	lxi	b,80-1
space$fill$40:
	lda	rev$40
	adi	' '
	mov	m,a
	ldir
	ret

	page
;*
;*
;*
;*
line$del$40:
	lxi	h,screen$paint
	push	h
	lda	char$row$40
	cpi	lines-1			; on or past last line ?
	jrz	clear$bottom$line$40	; on, just clear it
	rnc				; past it, return

	call	cur$adr$40$hl$sz$a	; HL=cur adr, DE=line start adr
					; BC=count to move, A=BC+1
	lxi	h,screen$40
	dad	d			; point to line start memory location
	push	h			; save cursor line start adr
	lxi	d,80
	dad	d			; point to start of next line

	xchg				; cursor line(+1) start address in DE
	lxi	h,screen$40+80*lines	; end of screen address
	xra	a			; clear the carry bit (and A)
	dsbc	DE			; HL=HL-DE
	mov	b,h
	mov	c,l			; count in

	xchg				; HL=start of line after cursor line
	pop	d			; start of cursor line

	push	b			; save count
	push	h			; save source
	push	d			; save dest
	ldir

	lxi	b,800h			; get attribute offset
	pop	h			; recover dest
	dad	b			; attr dest
	xchg				; dest belongs in DE
	pop	h			; recover source
	dad	b			; attr source
	pop	b			; recover count
	ldir
	jr	clear$bottom$line$40	

	page
;*
;*	B=bits to set or clear
;*	C=bits new value
;* 
;*	attr byte def. (in B)
;*		bit 7-
;*		bit 6-reverse video *
;*		bit 5-underline
;*		bit 4-blink
;*		bit 0-full intensity (masked off)
;*
;*
set$attr$40:
	mov	a,b
	ani	070h
	mov	b,a

	mov	a,c
	ani	070h
	mov	c,a

	lda	attr$40
	cma
	ora	b
	cma				; bits in B cleared A
	ora	c			; add new value 
	sta	attr$40
	ral				; get reverse attr in bit 7
	ani	80h
	sta	rev$40
	ret

	page
;*
;*	ASCII codes	20h to 2Fh set character color
;*			30h to 3Fh set background color
;*			40h to 4Fh set border color
;*			50h to 5Fh set locical character color
;*			60h to 6Fh set logical background color
;*			70h to 7Fh set logical border color
;*			all others code do nothing 
;*
;*	All colors are assigned from color lookup table
;*
set$color$40:
	mov	a,b
	sui	20h
	cpi	30h
	jrc	?col$40
	mvi	c,30h			; max color value+1 (00h-2Fh)
	call	lookup$color$1		; HL points to table entry on ret
	rc				; exit if error
	mov	a,m			; get table value again
	rrc
	rrc
	rrc
	rrc				; get upper 4 bits to lower
	ani	0fh
	add	b			; get old MSB

?col$40:
	cpi	10h			; character color? (0-f)
	jrc	char$color$40		; yes, go do it
					; no, fall thru test background, border
	cpi	20h			; background color? (10-1f) 
	jrc	back$color$40		; yes, go do it
					; no, fall thru and set border color 
;
;	set border color
;
	ani	0fh			; color from 0-f
	sta	bd$color$40	
	lxi	b,VIC+32
	outp	a
	ret 

	page
;
;	set background color (10-1F)
;
back$color$40:
	ani	0Fh			; get value of 0 to F
	sta	bg$color$40
	lxi	b,VIC+33
	outp	a
	ret

;*
;*
;*
rd$color$40:
	lda	bg$color$40
	mov	b,a
	lda	bd$color$40
	mov	c,a
	lda	attr$40
	mov	d,a
	ani	0fh
	ret

;
;	set character color
;
char$color$40:
	mov	b,a
	lda	attr$40
	ani	0f0h
	ora	b
	sta	attr$40

	lhld	char$adr$40
	lxi	d,800h
	dad	d
	mov	m,a
; jmp	line$paint

	page
;
;
;
line$paint:
	lda	old$offset
	mov	b,a
	ora	a
	cm	trk$40

	lda	@off40			; 
	cmp	b
	sta	old$offset
	jrnz	screen$paint

	call	cur$adr$40$hl$sz$a	; DE=start of row adr (REL)
	lxi	h,screen$40		; get start of screen
	dad	d			; HL=row start address (ABS)
	xchg				; save in DE
	lhld	@off40			; get current screen offset (0-39)
	dad	d			; screen source adr in HL
	push	h			; save for later

	lda	char$row$40		; get current row #
	mov	l,a			; HL=row # (H=0)
	call	Lx40$plus$VIC
	xchg				; place screen adr (25X40) in DE
	pop	h			; recover logical screen adr (25X80)

	push	h			; save for attr move
	push	d

	mvi	a,1			; one line only

	call	update$window$fun
	pop	h			; recover screen pointer (25X40)
	lxi	b,vic$color-vic$screen
	dad	b			; point to Vic color memory
	xchg				; DE=color memory pointer
	pop	h			; recover screen pointer (25X80)
	lxi	b,800h			; offset to attributes
	dad	b
	mvi	a,1			; one line only
	jr	update$window$fun	;

	page
;
;	hl=offset (0 to 39)
;
screen$paint:
	lhld	@off40
	lda	paint$size		; number of lines to move
	push	h
	push	psw			; save the count

	lxi	d,screen$40
	dad	d			; point to start of visible screen
	lxi	d,vic$screen		; place to move it to
	call	update$window$fun

	pop	psw
	pop	h
	lxi	d,screen$40+800h
	dad	d			; add the screen offset
	lxi	d,vic$color
;
;	Always called from bank 0, Placed in common so that IO
;	will not overlay this code. Can go in ROM 
;
update$window$fun:
	sta	io$0
update$window$loop:
	lxi	b,40			; number of bytes to move
	ldir
	push	d
	lxi	d,80-40			; advance pointer to next line
	dad	d
	pop	d
	dcr	a
	jrnz	update$window$loop

	sta	bank$0
	ret


	page
;
;
;
trk$40:
	lda	char$col$40		; get the current column number
	sui	40-8			; remove 1st 32 columns
	jrnc	use$offset		; if pass column 32, set an offset
	xra	a
use$offset:
	ani	0f8h			; move 
	sta	@off40
	ret

	page
;
;
;
set$cursor$40:
	call	no$cursor
	call	line$paint		; will do a screen paint if required

	lda	@off40			; get screen offset
	mov	b,a			; save offset (0 to 39)
	lhld	char$col$40		; H=row, L=col
	mov	a,l			; get col # in A
	sub	b			; remove offset
	jrc	no$cursor
	cpi	40
	jrnc	no$cursor
 	mov	c,a
	mvi	b,0			; BC=cursor column #
	mov	l,h			; get row # in L
	call	Lx40$plus$VIC
	dad	b
	jr	set$flash
;
no$cursor:
	lxi	h,0			; if H=0 (L=xx) then cursor off
;
set$flash:
	shld	flash$pos
	ret

	page
;
;
;
Lx40$plus$VIC:
	mvi	h,0
	dad	h			; 2X
	dad	h			; 4X
	dad	h			; 8X
	mov	d,h
	mov	e,l			; DE=8X
	dad	h			; 16X
	dad	h			; 32X
	dad	d			; 8X+32X=40X
	lxi	d,vic$screen
	dad	d			; point to screen area
	ret

	page
;
;	input:
;		range 20h to 7fh in B
;	output:
;		in A
;
ascii$to$petascii:
	mov	a,b
	cpi	40h
	jrz	is40		; get at sign
	rc			; ret if code was 20h - 3fh

	cpi	'Z'+1		; is it an upper case letter ?
	rc			; yes, code was 41h - 5Ah

	sui	40h
	cpi	60h-40h
	jrz	was$60		; 60h converted to 27h

	jrc	was$5b$to$5f

	sui	20h
	cpi	'z'+1-60h
	rc			; code was 61h - 7Ah

	cpi	'{'-60h
	jrz	is$left$brace
	cpi	'|'-60h
	jrz	is$vert$bar
	cpi	'}'-60h
	jrz	isright$brace
	cpi	'~'-60h
	rnz
	mvi	a,64		; commodore horz bar
	ret

was$60:
	mvi	a,126		; solid upper left corner
	ret

is$left$brace:
	mvi	a,115		;
	ret

is$vert$bar:
	mvi	a,93		; commodore vertical bar
	ret

is$right$brace:
	mvi	a,107		; 
	ret

was$5b$to$5f:
	cpi	'\'-40h
	jrz	is$back$slash
	cpi	'_'-40h
	rnz
	mvi	a,100			; commodore under line
	ret

is$back$slash:
	mvi	a,127			; upper left and lower right corners
	ret

is40:
	xra	a
	ret

	page
;
;
;
cur$adr$40$hl$sz$a:
	lhld	char$col$40
	jr	cur$adr$hl$sz$a
;
;
;
cur$adr$80$hl$sz$a:
	lhld	char$col

;
;	INPUT:
;		H=row L=col
;
;	OUTPUT:
;		HL=cursor address
;		DE=cursor line start address
;		BC=# character to end of line ( <80 )
;			(not counting the cursor position) 
;		A=BC+1
;
cur$adr$hl$sz$a:
	mvi	a,80-1		; get line length
	sub	l		; A=
	mov	c,a

cur$adr$hl:
	mov	b,l		; save column #
	mov	l,h
	mvi	h,0		; HL=row #
	dad	h		; 2x
	dad	h		; 4x
	dad	h		; 8x
	dad	h		; 16x
	mov	d,h
	mov	e,l		; save 16x
	dad	h		; 32x
	dad	h		; 64x
	dad	d		; 64x+16x=80x
	xchg			; DE=row start address
	mov	l,b		; get saved column #
	mvi	h,0		; HL=column #
	dad	d		; HL=cursor address

	mvi	b,0		; BC= count (if call to cur$adr$hl$sz$a:)
	inr	a		; number of bytes to end of line (1-80)
	ret

	page	
;
;	destroys DE,HL,B,A
;
lookup$color:
	mov	a,b			; color supplied in B

lookup$color$1:
	lhld	color$tbl$ptr
;
;	HL=table adr
;	A= color input
;	C= max allowable color value
;
lookup$color$2:
	sui	30h			; remove bias
	rc
	cmp	c			; above limit
	cmc
	rc				; yes, return input out-of-range
	mov	b,a			; save adjusted color #
	ani	0fh			; get only the color #

	mov	e,a
	mvi	d,0
	dad	d			; get converted color address
	mov	a,b			; get the ASCII char back
	ani	30h			; keep only char/background/borber bits
	mov	b,a			; save char/background bit
	ret

	page
;
;
;
bell:
	lxi	b,sid+24
	lhld	sound$1
	outp	h
	mvi	c,5
	outp	l

	lhld	sound$2
	inr	c
	outp	h
	mvi	c,1
	outp	l

	lhld	sound$3
	mvi	c,4
	outp	h
	outp	l
	ret