	.title	'Hazeltine 1500 Emulation'
	.ident	haz15
hazversion ==	2
hazrevision ==	0	;last modified 5-Apr-83

;
;		TABLE OF CONTENTS		PAGE
;
; 1. Equates
;	equates for crtfox rom			2
;	equates for emulation			6
; 2. General Purpose Macros			7
; 3. ROM entry points				8
; 4. Initialisation Code			10
; 5. Mainline emulation				
;	normal printable character processing	12
;	adjust attributes for changed map	14
;	leading sequences			20
;	erase line or screen			29
;	bitmap routines				31
; 6. Emulation ram data				40
; 7. Ram for rom definitions			42
;

	.insert	romequs
	.page
	.sbttl	'equates for emulation'
forversion ==	2	;rom version this emulation is 
			;to be run with
forrevision ==	0	;revision emulation is for
foreground ==	80h	;char to set to foreground
			;display
background ==	81h	;char to set to background
			;display
	.insert genmacro
	.insert romentry.20
	.page
	.sbttl	'Initialisation Code'
	.pabs
	.phex
	.sall
	.ife	romeloc,[
	.loc	ramloc][
	.loc	7400h]

	lhld	disptab	;get address of first line
	res	7,h	;on screen
	shld	elloc
	lxi	h,hbf1	;emulation of hazeltine
	lded	elloc
	lxi	b,charsperline
	ldir		;copy buffer error line
	lda	verloc
	cpi	forversion
	jrnz	..badversion
	lda	revloc
	cpi	forrevision
	jrz	..versionok
..badversion:
	lxi	h,hbf2	;improper rom version exiting
	lded	elloc
	lxi	b,charsperline
	ldir
;
;	stall for a bit before reseting
;	controller
;
	mvi	h,5
			;note bc not inited first
			;time thru but who cares
..stallloop:
	dcx	b
	mov	a,b
	ora	c
	jrnz	..stallloop
	lxi	b,0ffffh
	dcr	h
	mov	a,h
	ora	a
	jrnz	..stallloop
	jmp	0	;software reset of
			;crt controller
	.page
..versionok:
;
;	set up escape and interupt processing to
;	be from rom in case takeing over from
;	other emulations
;
	lxi	h,normesc
	shld	altesc
	lxi	h,normint
	shld	altint
;
;	set up table of actions to be taken for
;	non printable ascii chars
;
	lxi	h,hazcharact
	shld	acttabloc
;
;	set up testing for hazeltine leadin character
;
	lxi	h,isitleadin
	shld	ascspecial

;
;	put screen into hazeltine startup mode
;
	call	bmset	;set all bits on screen as
			;background
	call	gothome
	mvi	a,background
	sta	fillmode
	call	heratoendofscreen

	jmp	normret

	.page
	.sbttl	'normal printable character processing'
;
;	see if a character is a leadin character
;
isitleadin:
	cpi	'~'
	jrnz	hazasc
	lxi	h,lead2nd	;set up for second
	shld	actspecial	;character of leadin
	ret			;sequence

;
;	see if substitution for foreign char
;	set needed
;
hazasc:
	lxi	h,disptranspose
	add	l	;add character to table 
	mov	l,a	;which is on boundary to
	mov	a,m	;assure no carry
	lhld	nextchar	;adr of next screen pos
	mov	m,a		;insert char

;
;	if screen position is already tagged
;	as it should be, no need to set/reset bit
;	or adjust display attribute characters
;
	lhld	lcurxy	;position of bit
	call	bmbtest		;test existing bit
				;value
	jrnz	..isset
	lda	tagfollows
	cpi	true
	jrz	..doadjust
	jmpr	..bumpcur
..isset:
	lda	tagfollows
	cpi	true
	jrz	..bumpcur
;
;	adjust the bit map and then display 
;	characters
;
..doadjust:
	lhld	lcurxy	;set up for taging 
	lda	tagfollows	;bitmap
	cpi	true
	jrz	..maketag
	call	bmbreset	;reset tag bit
	jmpr	..tagdone
..maketag:
	call	bmbset		;set tag bit
..tagdone:
	call	adjlinedisplay	;adjust display to
				;reflect new tag bit
..bumpcur:
	lhld	nextchar
	inx	h
	call	skipattributechar
	lxi	h,maxchar	;chars to end of line
	dcr	m
	jz	hdocrlf	;scroll
	call	bumpcur		;bump cursor one forward
	ret

	.insert	bmadjust



	.page
	.sbttl	'leadin sequences'
;
;	the leadin sequences are in the same order
;	as the table in appendix III of Hazeltine
;	reference manual
lead2nd:
	cpi	18
	jz	hazhome
	cpi	12
	jz	hazup
	cpi	11
	jz	hazdown
	cpi	17
	jz	hazaddresscursor
	cpi	5
	jz	hazreadcursor	
	cpi	28
	jz	hazcs	;clear screen
	cpi	29
	jz	hazcf	;clear forground
	cpi	15	
	jz	hazcel	;clear to end of ground
	cpi	24
	jz	hazces	;clear to end of screen
	cpi	23
	jz	hazbces	;background clear to end of 
			;screen
	cpi	25
	jz	setbackground
	cpi	31
	jz	setforeground
	cpi	19
	jz	hazdeleteline
	cpi	26
	jz	hazinsertline
	cpi	21
	jz	hazlock
	cpi	6
	jz	hazunlock

	jmp	normret	;unknown leadin sequence


;
;	home routine for hazel
;
hazhome:
	call	normret	;set up normal character
			;processing
	jmp	gothome	;return from there
;
;	cursor up
;
hazup:
	call	normret
	lda	lcury
	cpi	0
	rz		;no action if on top line
	jmp	gotup	;return from there
;
;	cursor down
;
hazdown:
	call	normret
	lda	lcury
	cpi	23	;maximum line number
	rz
	jmp	dolf	;line feed action
			;return from there
;
;	backspace routine for hazeltine
;
hazback:
	lhld lcurxy	;if at home position
			;no action
	mov	a,h
	ora	l
	rz
	jmp	gotback	;standard backspace
			;return from there
;
;	forward space routine for hazeltine
;
hazforward:
	lda	lcurx
	inr	a
	lxi	h,chars	;per line
	cmp	m
	jnz	gotforward	;not on last char 
				;of line
	lda	lcury
	inr	a
	lxi	h,lines
	cmp	m
	jnz	gotforward	;not on last postion
				;on screen
	ret		;no action at end of screen
;
;	set cursor address
;
hazaddresscursor:
	lxi	h,hsetcol
	shld	actspecial
	ret
hsetcol:
	cpi	charsperline	;last column
	jrnc	..noteasy
..colset:
	sta	lcurx
	lxi	h,hsetrow
	shld	actspecial
	ret
..noteasy:
	cpi	96	;first of substituted lines
	jrnc	..substituted
	mvi	a,79
	jmpr	..colset
..substituted:
	sui	96	;normalize
	jmpr	..colset

hsetrow:
	ani	1fh	;strip high order bits
	cpi	24	;last row
	jrc	..rowset
	mvi	a,23
..rowset:
	sta	lcury
	jmp	newcursor	;display new cursor
			;return from there
;
;	read the cursor coordinates
;
hazreadcursor:
	mvi	a,cr
	call	aintolifo	;stuff into keyboard buf
	lda	lcury
	adi	96	;turn into proper form
	call	aintolifo
	lda	lcurx
	cpi	32
	jnc	..xok
	adi	96	;turn into proper form	
..xok:
	call	aintolifo
	jmp	normret
;
;	clear screen and set to foreground mode
;
hazcs:
	call	gothome
	mvi	a,foreground
	sta	fillmoded
	lhld	lcurxy
	call	bmesreset	;reset bits to end 
				;of screen
	call	heratoendofscreen	
	jmp	normret


;
;	clear foreground characters from screen
;
;	
hazcf:
	lxi	h,0
	shld	lcurxy
	call	newcursor	;home
	mvi	a,false
	sta	inforeground
..cfloop:
	lhld	nextchar
	dcx	h
	mov	a,m
	bit	7,a
	jrz	..notattribute
	cpi	foreground
	jrz	..isforeground
	mvi	a,false
	sta	inforeground
	jmpr	..notattribute
..isforeground:
	mvi	a,true
	sta	inforeground
..notattribute:
	inx	h
	lda	inforeground
	cpi	true
	jrnz	..dontblank
	mvi	m,' '
..dontblank:			;get to next char on line
	lda	lcurx
	inr	a
	cpi	80
	jrz	..nxtline
	sta	lcurx
	inx	h	;point to next character
	bit	7,m
	jrz	..nextnotattribute
	inx	h
..nextnotattribute:
	shld	nextchar
	jmpr	..cfloop
..nxtline:
	lda	lcury
	inr	a
	cpi	24
	jrz	..done
	sta	lcury
	mvi	a,0
	sta	lcurx
	call	newcursor
	jmpr	..cfloop
..done:
	lxi	h,0	;home cursor
	shld	lcurxy
	jmp	newcursor	;return from there

;
;	clear to end of line with foreground spaces
;
hazcel:
	lhld	lcurxy
	call	bmelreset ;reset bits to end of line
	mvi	a,foreground
	sta	fillmode
	call	heraline	
	jmp	normret		;return from there

;
;	clear to end of screen with foreground spaces
;
hazces:
	lhld	lcurxy
	call	bmesreset	;reset bits to end 
				;of screen
	mvi	a,foreground
	sta	fillmode
	call	heratoendofscreen
	jmp	normret

;
;	clear to end of screen with background spaces
;
hazbces:
	lhld	lcurxy
	call	bmelset	;set bits to end of line
	mvi	a,background
	sta	fillmode
	call	heratoendofscreen
	jmp	normret

;
;	set for background follows
;
setbackground:
	mvi	a,true
	sta	tagfollows
	jmp	normret

;
;	set for foreground follows
;
setforeground:
	mvi	a,false
	sta	tagfollows
	jmp	normret


;
;	delete a line from screen
;
;	
hazdeleteline:
	call	bsetalterattribute
	lda	lcury	;row to delete
	call	bmdlreset ;delete line from bit map
	call	hltobeginingcurrentline
	shld	hazsavecurrentline ;save address of 
			;current line buffer
	xchg
	inx	h
	call	filline ;blank current line
	mov	d,h
	mov	e,l
	dcx	d
	dcx	d
	inx	h
	shld	hazplacetocopyfrom ;save place to copy from
	lda	lines
	dcr	a
	lxi	h,lcury
	sub	m	;get number of lines to move up
	jrz	fillforeground ;on last line, nothing to move
	mov	c,a
	rlc		;*2
	add	c	;*3 (bytes per entry in table
	mov	c,a
	mvi	b,0
	lhld	hazplacetocopyfrom
	ldir		;mov following lines up
	xchg
	lded	hazsavecurrentline ;put blanked last 
			;line at end
	set	7,d	;bit to tell 8275 to grab chars
	mov	m,e
	inx	h
	mov	m,d
	inx	h
	mvi	m,0	;set count of attributes
;
;	set line at bottom of screen to be foreground
;	filled
;
	lhld	lcurxy
	mvi	l,0	;go to begining of line
	shld	hazxysave
	mvi	h,23	;lastline
	shld	lcurxy
	call	newcursor
	mvi	a,foreground
	call	storecontrol
	lhld	hazxysave
	shld	lcurxy
	call	bresetalterattribute
	jmp	newcursor	;return from there

;
;	insert a line
;
;	
hazinsertline:
	call	bsetalterattribute
	lda	lcury	;row to insert
	call	bmilreset ;insert line in bitmap
	lxi	h,disptab+24*3	;get to last line of display
	mov	e,m
	inx	h
	mov	d,m
	sded	hazlastlinesave
	inx	h	;place to copy to
	xchg
;
;	see how many lines to copy down
;
	lda	lines
	dcr	a
	lxi	h,lcury
	sub	m
	jz	..fill
	mov	c,a
	rlc		;*2
	add	c	;*3
	mov	c,a
	mvi	b,0
	lxi	h,disptab+(24*3)-1	;place to copy
			;from
	lddr
..fill:
	xchg
	dcx	h
	lded	hazlastlinesave
	mov	m,d
	dcx	h
	mov	m,e
	inx	h
	inx	h
	call	filline
fillforeground:
	lxi	h,lcurx
	mvi	m,0	;move to begining of line
	call	newcursor
	call	bresetalterattribute
	mvi	a,foreground
	jmp	storecontrol	;return from there

;
;	tab for hazeltine
;
haztab:
	lhld	lcurxy
	shld	hazxysave
;
;	get to end of current foreground field if
;	in one
;
..outofforegroundloop:
	push	h
	call	bmbtest	;test bit
	pop	h
	jrnz	..searchnextloop
	inr	l
	mvi	a,charsperline
	sub	l
	jrnz	..outofforegroundloop
	mvi	l,0
	inr	h
	mvi	a,linesonscreen-1
	sub	h
	jrnz	..outofforegroundloop
	jmpr	..noforeground
;
;	search for next foreground field
;
..searchnextloop:
	inr	l
	mvi	a,charsperline
	sub	l
	jrnz	..checknext
	mvi	l,0
	inr	h
	mvi	a,linesonscreen-1
	sub	h
	jrnz	..checknext
	jmpr	..noforeground
..checknext:
	push	h
	call	bmbtest
	pop	h
	jrnz	..searchnextloop
;
;	found it
;
	shld	lcurxy
	jmp	newcursor	;return from there

..noforeground:
	lhld	hazxysave	;no foreground found
	shld	lcurxy		;restore original cursor
	jmp	newcursor	;return from there

hazlock:		;lock the keyboard
	lxi	h,flags2
	set	kybdlocked,m
	jmp	normret

hazunlock:		;unlock the keyboard
	lxi	h,flags2
	res	kybdlocked,m
	jmp	normret
hdocrlf:
	call	docr	
;
;perform line feed
;
hazdolf:
	lxi	h,lcury
	inr	m
	lda	lines
	cmp	m		;past bottom line
	jrz	..scroll
	jmp	newcursor	;set cursor to new line
				;return from there
..scroll:
	push	h		;save ptr to lcury for
				;scroll routine
	call	bmscrreset	;scroll bitmap
	pop	h
	call	scroll		;scroll characters
	lhld	lcurxy
	push	h
	mvi	l,0		;put forground 
			;character at begining
			;of line
	shld	lcurxy
	call	newcursor
	mvi	a,foreground
	call	storecontrol
	pop	h
	shld	lcurxy
	jmp	newcursor	;return from there

	.page
	.sbttl	'erase line or screen'
;
;	erase to end of screen and line 
;
heratoendofscreen:
	call	heraline  ;erase to end of current
			;line
	lda	lines
	lxi	h,lcury
	sub	m	;a is count of lines
		;to clear, note: current line
		;is already cleared
	push	psw	;save count of lines
	call	hltobeginingcurrentline
	inx	d
	xchg
	pop	psw
	call	bsetalterattribute
..erascreenloop:
	dcr	a
	jz	bresetalterattribute
	inx	h
	mov	e,m
	inx	h
	mov	d,m
	inx	h
	push	psw
	call	hfilline
	pop	psw
	jmpr	..erascreenloop

;	fill line with blanks o

;	
;	on input regs are:
;	de - address to fill
;	hl - address of count of attribute
;		chars on line
;
;	de,bc,a destroyed
;	NOTE: FILLINE DOES NOT SET ALTERING ATTRIBUTE
;	COUNT FLAG DEPENDING ON CALLING ROUTINE TO
;	DO SO
;
hfilline:
	push	h	;save incoming hl register
	mvi	m,1	;set count of attribute chars
	xchg
	res	7,h	;reset bit that may be set to
			;tell 8275 to grab char
	lda	fillmode
	mov	m,a	;control char to get
			;desired display of chars
	inx	h
	mvi	m,' '	;blank first char on line
	push	h
	pop	d
	inx	d
	lda	chars
	dcr	a
	mov	c,a
	mvi	b,0
	ldir		;fill line with blanks
	pop	h	;restore
	ret


heraline:
	lhld	lcurxy
	call	bmelreset	;reset to end of line
	call	eraline
;
;	insert control char to make following screen 
;	character mode appropriate 
	lda	fillmode
	jmp	storecontrol	;return from there

	.insert	foxbitm

	.page
	.sbttl	'Emulation ram data'
;
;	hazeltine message buffers
;
;		/1234567890123456789012345678901234567890/
hbf1:	
	.ascii	/                        Hazeltine 1500 E/
	.ascii	/mulation Ver /
	.byte	hazver+'0','.',hazrev+'0'
	.ascii	/                        $/

hbf2:	
	.ascii	/                  This emulation must ru/
	.ascii	/n with crt version /
	.byte	forversion + '0','.',forrevision + '0'
	.ascii	/                   /

;
;	key action table for non-printable characters
;	for hazeltine 1500
;
hazcharact:
	.word	donull		;0
	.word	gotasc		;1
	.word	gotasc		;2
	.word	gotasc		;3
	.word	gotasc		;4
	.word	gotasc		;5
	.word	gotasc		;6
	.word	gotbell		;7
	.word	hazback		;8
	.word	haztab		;9
	.word	hazdolf		;10 (ah)
	.word	gotasc		;11 (bh)
	.word	gotasc		;12 (ch)
	.word	docr		;13 (dh)
	.word	gotasc		;14 (eh)
	.word	gotasc		;15 (fh)
	.word	hazforward	;16 (10h) 
	.word	gotasc		;17 (11h) 
	.word	gotasc		;18 (12h)
	.word	gotasc		;19 (13h)
	.word	gotasc		;20 (14h)
	.word	gotasc		;21 (15h)
	.word	gotasc		;22 (16h)
	.word	gotasc		;23 (17h)
	.word	gotasc		;24 (18h)
	.word	gotasc		;25 (19h)
	.word	gotasc		;26 (1ah)
	.word	esckey		;27 (1bh)
	.word	gotasc		;28 (1ch)
	.word	gotasc		;29 (1dh)
	.word	gotasc		;30 (1eh)
	.word	gotasc		;31 (1fh)


elloc:	.blkw	1	;location of error line

hazplacetocopyfrom: .blkw	1
hazsavecurrentline: .blkw	1
hazlastlinesave:    .blkw	1	
hazxysave:          .blkw	1
tagfollows: .byte true	;true if background chars
	;follow,false if foreground chars follow
tagattribute: .byte	background  ;tagged characters
	;have this display characteristic
notagattribute: .byte	foreground  ;untagged chars
	;have this display characteristic
inforeground:.blkb	1	;in clear foreground
		;function true if in fore ground false
		;if in background
fillmode: .blkb	1	;when eraseing to end of screen
			;or end of line is screen
			;characteristic to fill with
			;i.e. foreground or background
	.ife	romeloc,[
	.ifg	. - (ramloc + lencode),[
	.prntx /Code too long/][
	.prntx /Code length ok/]
	][
	.ifg	. - (7fffh),[
	.prntx /Code too long/][
	.prntx /Code length ok/]
	]
	.insert	ramfrrom
	.end
	
