include	BDS.LIB
	include	EPDATA

	.request EPEXEC

	.comment	`
functions EPSINIT, EPERROR, LOADFT


/************************************************/
/*	Initialization of Epson & other things	*/
/************************************************/
epsinit()
{	int i;

	loadi(0); /* initialize values using 'ep.ini';
			sets mode and tabwid */
	emode = tallflag = 0;
	pn = 1;

	outbuf = xoutbuf;
	attrbuf = xattrbuf;
	widbuf = xwidbuf;

	newinline();
	newoutline();

	spdots = skdots = 0;
	vposition = tm;

	brccount = brcpt[0] = 0;

	PTESCCH('@');		/* Epson master reset		*/
	unidir = FALSE;


/* This was for broken 8th bit on Sluder
	PTESCCH('=');
*/

	mreset(mode);

	newfonts();
}

			`

epsinit::

;	loadi(0); /* initialize values using 'ep.ini';
;			sets mode and tabwid */

	lxi	h,0
	push	h
	call	loadi##
	pop	d
;	emode = tallflag = 0;
	xra	a
	sta	tallflag
	lxi	h,0
	shld	emode	;done by mreset(0) below?
;	pn = 1;
	inx	h
	shld	pn
;
;	outbuf = xoutbuf;
;	attrbuf = xattrbuf;
;	widbuf = xwidbuf;

	lxi	h,xoutbuf
	shld	outbuf
	lxi	h,xattrbuf
	shld	attrbuf
	lxi	h,xwidbuf
	shld	widbuf
;
;	newinline();
;	newoutline();
	call	newinline##
	call	newoutline##
;
;	spdots = skdots = 0;
	lxi	h,0
	shld	skdots
;??	shld	spdots (not currently used)

;	vposition = tm;
;;; - hm
;
;	lhld	tm
;	xchg
;	lhld	hm
;	call	cmh
;	dad	d
	lxi	h,-1	;HM now 0 -- paperup will init this
	shld	vposition

;	brccount = brcpt[0] = 0;
	lxi	h,0
	shld	brcpt
	shld	brccount
;
;	PTESCCH('@');		/* Epson master reset		*/

;call mreset first to init bios vector in presc routine
	lxi	h,0
	push	h
	call	mreset##
	pop	d

	mvi	a,'@'
	call	presc1##

;	unidir = FALSE;
	mvi	a,0
	sta	unidir
;
;	mreset(mode);
	lhld	mode
	push	h
	call	mreset##
	pop	d
;
;	newfonts();
;}
	jmp	newfonts##

	.comment	`

eperror(errn)
int errn;
{	errcode = errn;
	exec("EPERROR");
	puts("\n\nERROR\n");
	exit(ERROR);
}

			`

eperror::
	pop	d
	pop	h
	shld	errcode

;	lxi	h,$errprog
;	push	h
;	call	exec##
	call	epexec##

	lxi	h,$errmsg
;	push	h
	call	puts##

	lxi	h,-1
	push	h
;	call	exit##	;or call exit ??
	call	.exit

;$errprog:
;	db	'EPERROR',0
$errmsg:
	db	0AH,0AH,'ERROR',0AH,0



	.comment	`

/************************************************/
/* Load in from disk one font of graphics data	*/
/************************************************/
loadft(fntreq)
int fntreq;
{
	int fdft, i, k, ftrecs;
	char fullname[17];

	/* if no more room, load over last font		*/
	if (fntreq == NUMFTS)
	{	fntreq--;
		free(ftp[fntreq]);
		ftp[fntreq] = 0;
	}

	/* maybe already loaded?			*/
	if (ftp[fntreq]) return(0);

	errtype = fntreq;
	fprefix(fullname);

	strcat(fullname,ftname[fntreq]);
	strcat(fullname,".FN2");

	if ((fdft = open(fullname,0)) == ERROR)
		{puts("\nno font\n"); eperror(120+fntreq);}

	/* read the index to where data for each char is	*/
	if (read(fdft, fix[fntreq], 2) != 2)
		{puts("\nbad font\n"); eperror(130+fntreq);}

	/* only read enough of the font to get info for char's
		up to ascii nul (which is not used)		*/
	ftrecs = (fix[fntreq][127]+127)/128;

	/* get memory space -- overwrite old fonts, if necessary	*/
	k = nextft - 1;
	while
	(	!(ftp[fntreq] = alloc(ftrecs * 128))
		&& k > 0
	)
	{	if (k == fntreq) { k--; continue; }
		if (ftp[k]) free(ftp[k]);
		ftp[k] = 0;
		k--;
	}

	/* this should never happen				*/
	if (!ftp[fntreq]) eperror(111);

	if (read(fdft, ftp[fntreq], ftrecs) != ftrecs)
		eperror(130+fntreq);

	fabort(fdft);

	/* calculate widths of characters for later reference	*/
	ftlen[fntreq][0] = 0;
	for (i = 1; i < 127; i++)
		ftlen[fntreq][i] = (fix[fntreq][i+1] - fix[fntreq][i])/3;

	return(0);
}

			`


loadft::
	pop	d
	pop	h
	push	h
	push	d

	push	b
;B = fntreq
	mov	b,l

;	/* if no more room, load over last font		*/
;	if (fntreq == NUMFTS)

	mov	a,b
	cpi	NUMFTS
	jnz	.ldf1

;	{	fntreq--;

	dcr	b
	dcr	l

;		free(ftp[fntreq]);

;HL still = fntreq
	dad	h
	lxi	d,ftp
	dad	d
	push	h	;for next stmt

	mov	e,m
	inx	h
	mov	d,m
;check if allocated?
;	push	d
	xchg
	call	free##
;	pop	d

;		ftp[fntreq] = 0;
;	}
	pop	h
	xra	a
	mov	m,a
	inx	h
	mov	m,a
;
;	/* maybe already loaded?			*/
;	if (ftp[fntreq]) return(0);

.ldf1:
	mov	l,b
	mvi	h,0
	dad	h
	lxi	d,ftp
	dad	d
	mov	a,m
	inx	h
	ora	m
	jz	.ldf2
	lxi	h,0
	pop	b
	ret

;
;	errtype = fntreq;
.ldf2:
	mov	l,b
	mvi	h,0
	shld	errtype

;if drive prefix was stored with name, don't add another
	call	getftn##
;(2 copies for later)
	push	h
	push	h
	inx	h
	mov	a,m
	cpi	':'


;	fprefix(fullname);
	lxi	h,fullname
;nul in case go directly to strcat
	mvi	m,0
;well, was it a colon? then don't get def. prefix
	jz	.ldf2a
	push	h
	call	fprefix##
	pop	d
.ldf2a:
;first copy ftname ptr (one still on stack)
	pop	h
;
;	strcat(fullname,ftname[fntreq]);
;	call	getftn##
;	push	h

	mov	a,m
	ani	80h
	sta	itsagf
	mov	a,m
	push	psw
	ani	7fh
	mov	m,a

	xchg
	lxi	h,fullname
	
	call	strcat##

	pop	psw
;use 2nd copy of ftname ptr to restore 1st char as was
	pop	h
	mov	m,a

;	strcat(fullname,".FN2");

	lxi	d,$xtbtp
;	lda	itsagf
;	ora	a
	ani	80h
	jnz	$+6
	lxi	d,$xtfn2

	lxi	h,fullname
	call	strcat##

;
;	if ((fdft = open(fullname,0)) == ERROR)
	lxi	h,0
	push	h
	lxi	h,fullname
	push	h
	call	open##
	pop	d
	pop	d
	shld	fdft
	inx	h
	mov	a,h
	ora	l
	jnz	.ldf3
;		{puts("\nno font\n"); eperror(120+fntreq);}
	lxi	h,$no_font
	call	puts##
	lxi	d,120
.ldf2b:	mov	l,b
	mvi	h,0
	dad	d
	push	h
	call	eperror

;
;	/* read the index to where data for each char is	*/
;	if (read(fdft, fix[fntreq], 2) != 2)
.ldf3:
	lxi	h,2
	push	h

	mov	h,b
	mvi	l,0	;fntreq*100h
	lxi	d,fix
	dad	d

	lda	itsagf
	ora	a
	jz	.ldf3a
	pop	d	;discard 2 (rec count)
	call	fixfake
	jmp	.ldf4
.ldf3a:
	push	h

	lhld	fdft
	push	h
	call	read##
	pop	d
	pop	d
	pop	d

	dcx	h
	dcx	h
	mov	a,h
	ora	l
	jz	.ldf4
;		{puts("\nbad font\n"); eperror(130+fntreq);}
	lxi	h,$bad_font
;	push	h
	call	puts##
;	pop	d
	lxi	d,130
	jmp	.ldf2b

;
;	/* only read enough of the font to get info for char's
;		up to ascii nul (which is not used)		*/
;	ftrecs = (fix[fntreq][127]+127)/128;
.ldf4:
	mov	h,b
	mvi	l,0
	lxi	d,fix + 127*2
	dad	d

	mov	e,m
	inx	h
	mov	d,m

	lxi	h,127
	dad	d
	push	h
	xchg
	lxi	h,128
	call	usdiv

	shld	ftrecs
	pop	h
	mvi	a,80h
	ana	l
	mov	l,a
	shld	ftbytes
;
;	/* get memory space -- overwrite old fonts, if necessary	*/
;	k = nextft - 1;
;C = k
	lda	nextft
	dcr	a
	mov	c,a

;	while
;	(	!(ftp[fntreq] = alloc(ftrecs * 128))
;		&& k > 0
;	)
.ldf5:
	mov	l,b
	mvi	h,0
	dad	h
	lxi	d,ftp
	dad	d
	push	h

	lhld	ftbytes
;	push	h
	call	alloc##
;	pop	d

	xchg
	pop	h
	mov	m,e
	inx	h
	mov	m,d

	mov	a,d
	ora	e
	jnz	.ldf8a

	mov	a,c
	ora	a
	jz	.ldf8

;	{	if (k == fntreq) { k--; continue; }

	cmp	b
	jnz	.ldf6
	dcr	c
	jmp	.ldf5

;		if (ftp[k]) free(ftp[k]);
.ldf6:
	mov	l,c
	mvi	h,0
	dad	h
	lxi	d,ftp
	dad	d
	push	h	;for next stmt
	mov	e,m
	inx	h
	mov	d,m
	mov	a,d
	ora	e

;	push	d
	xchg
	cnz	free##
;	pop	d
;		ftp[k] = 0;
.ldf7:
	pop	h
	xra	a
	mov	m,a
	inx	h
	mov	m,a
;		k--;
;	}

	dcr	c
	jmp	.ldf5
;
;	/* this should never happen				*/
;	if (!ftp[fntreq]) eperror(111);
.ldf8:
;to here from above only if nothing allocated, and k = 0
	lxi	h,111
	push	h
	call	eperror

.ldf8a:
;
;	if (read(fdft, ftp[fntreq], ftrecs) != ftrecs)
;		eperror(130+fntreq);
.ldf9:
	lhld	ftrecs
	push	h

	mov	l,b
	mvi	h,0
	dad	h
	lxi	d,ftp
	dad	d
	mov	e,m
	inx	h
	mov	d,m
	push	d

	lhld	fdft
	push	h
	call	read##
	pop	d
	pop	d
	pop	d

	xchg
	lhld	ftrecs
	call	eqwel
	jz	.ldf10

	mov	l,b
	mvi	h,0
	lxi	d,130
	dad	d
	push	h
	call	eperror

;
;	fabort(fdft);
.ldf10:
;	lhld	fdft
;	push	h
	lda	fdft
	call	fabort##
;	pop	d
;
;	/* calculate widths of characters for later reference	*/
;	ftlen[fntreq][0] = 0;

	mov	l,b
	mvi	h,0
;	lxi	d,128
;	call	usmul
	dad	h
	dad	h
	dad	h
	dad	h
	dad	h
	dad	h
	dad	h

	lxi	d,ftlen
	dad	d
	mvi	m,0
	lda	itsagf
	ora	a
	jnz	lenfake

;	for (i = 1; i < 127; i++)
;C = i
	mvi	c,1

.ldf11:
	mov	a,c
	cpi	127
	jnc	.ldf12

;		ftlen[fntreq][i] = (fix[fntreq][i+1] - fix[fntreq][i])/3;

;	mov	l,b
;	mvi	h,0
;	lxi	d,128
;	call	usmul
;	lxi	d,ftlen
;	dad	d

	inx	h
	push	h

	mov	h,b
	mvi	l,0
	lxi	d,fix
	dad	d
	xchg

;i
	mov	l,c
	mvi	h,0
;word array
	dad	h

	dad	d
	mov	e,m
	inx	h
	mov	d,m
;DE = fix[fntreq][i]

	push	d
	inx	h
	mov	e,m
	inx	h
	mov	d,m
	xchg
;HL = fix[fntreq][i+1]

	pop	d
;- fix[fntreq][i]
	call	cmd
	dad	d

	lxi	d,3
	xchg
	call	usdiv

	xchg
	pop	h
	mov	m,e

	inr c
	jmp	.ldf11

;
;	return(0);
;}
.ldf12:	lxi	h,0
.ldf13:
	pop	b
	ret

;make up char lens for graphics font -- each is 0ffh
;HL points to the ftlen for this font on entry
lenfake:
	xra	a
	mvi	c,0ffh
	mov	b,a
.lfak1: mov	m,b
	cpi	'@'
	jc	.lfak2
	cpi	'@'+40
	jnc	.lfak2
	mov	m,c
.lfak2:
	inx	h
	inr	a
	cpi	128
	jnz	.lfak1
	jmp	.ldf12

;make up a directory for graphics font
;HL points to the fix for this font on entry
fixfake:
	push	b
	xra	a
	lxi	d,0
	lxi	b,450
.ffak1:	mov	m,e
	inx	h
	mov	m,d
	inx	h
	cpi	'@'
	jc	.ffak2
	cpi	'@'+40
	jnc	.ffak2
	xchg		;if char in range, len was 450
	dad	b
	xchg
.ffak2:
	inr	a
	cpi	128
	jnz	.ffak1
	pop	b
	ret

$xtfn2:		db	'.FN2',0
$xtbtp:		db	'.BTP',0
itsagf:		db	0
$no_font:	db	0AH,'no font',0AH,0
$bad_font:	db	0AH,'bad font',0AH,0

ftrecs:		dw	0
ftbytes:	dw	0
fdft:		dw	0
;fullname:	ds	17

	end