include	BDS.LIB
	include	EPDATA.MAC

	.comment	`

/************************************************/
/* Put char in outbuf, and record width & mode	*/
/************************************************/

stowc(c)
char c;
{	int /* stowlen,*/ font;
	char hyflag;

	if (mode & IGNORE) return;

	/* check BS				*/
	if (c == '\b')
	{	if (outpoint) bsflag = TRUE;
		return;
	}

	/* if several spaces between words, it's possible to
	   get a SP at beginning of line during concatenation --
	   but we don't want that		*/
	if (!outpoint && c == ' ') return;

	/* store the character			*/
	outbuf[outpoint] = c;

	/* check soft hyphen			*/
	if (c == SOFTHY) {c = '-'; hyflag = TRUE; }
	else hyflag = FALSE;

	/* check flag character and required blank			*/
	if (c >= 0x7F || c == rb) c = ' ';

	/* if graphic char or font undefined, look at earlier fonts	*/
	font = (mode >> 8) & 7;
	while
	(	font
		&& !(	(stowlen = ftlen[font-1][c])
			  && ftname[font-1][0]
		   )
	) font--;

	stowmode = mode;
	stowkern = cs - val['K'-'@']['E'-'@'];


	/* flag "have one char in output line"	*/
	if (font)
	{	grfflag = TRUE;

		stowmode = fix[font-1][0];
		if (stowmode & 0xFF00)
		{	if (stowmode < 0) stowkern -= stowmode >> 8;
			else	stowkern += stowmode >> 8;
			stowmode &= 0x00FF;
		}
		if (stowmode & PRPTNL)
		{	stowmode &= ~PRPTNL;
			stowmode |= TALL;
			duplflag = TRUE;
		}
		stowmode |= mode;

		if (stowmode & TALL) tallflag = TRUE;
	}
	else epsflag = TRUE;


	/* determine width			*/
	if (bsflag) 	stowlen = 0;
	else if (font) {if (cw) stowlen = cw;
			else if (stowlen + stowkern >  0)
				stowlen += stowkern;
			}
	else if (!(stowlen = modelen[mode & 63]))
			stowlen = pmlen[c];

	/* font number to b8-b10		*/
	attrbuf[outpoint] =  (stowmode & 0xF8FF) | (font << 8);

	bsflag = FALSE;

	/* adjust for expanded, etc.		*/
	if (stowmode & EXPNDD) stowlen <<= 1;
	if (font)
	{	if (stowmode & CMPRSSD) stowlen -= stowlen >> 2;
		if (stowmode & ELITE)   stowlen -= stowlen / 5;
		if (st)		    stowlen += stowlen / st;
		if (sh)		    stowlen -= stowlen / sh;
		if (stowmode & EMPHSZD && bo)
				    stowlen += bo << 1;
	}

	/* record width and inc't pointers	*/
	widbuf[outpoint++] = stowlen;
	if (!hyflag) glen += stowlen;
}

			`

stowc::
	pop	d
	pop	h
	push	h
	push	d

;c argument kept in reg. C
; and (later) font kept in reg. B
	push	b
	mov	c,l

;back to here if repeat-char
.stc00:
;	if (mode & IGNORE) return;
	lda	mode+1
	ani	IGNORE shr 8
	jnz	.stcxt
;
;	/* check BS				*/
;	if (c == '\b')
;	{	if (outpoint) bsflag = TRUE;
;		return;
;	}
	lhld	outpoint	;for a bit later

	mov	a,c
;special characters C1-FF give automatic backspace
	cpi	0C1H
	jc	.stbs1
	ani	3FH
	mov	c,a
	sta	bsflag
.stbs1:	cpi	BCKFLAG		;was 8
	jnz	.stc1
	mov	a,h
	ora	l
	jz	.stcxt
	mvi	a,1
	sta	bsflag
	jmp	.stcxt


;logic for punctuation factor
;(1) if SP ' " ) leave p_space as is
punctset:
	cpi	' '
	rz
	cpi	27
	rz
	cpi	'"'
	rz
	cpi	')'
	rz
;(2) if . ! ? set p_space = p.f.
	lda	pf
	sta	p_space
	mov	a,c
	cpi	'.'
	rz
	cpi	'!'
	rz
	cpi	'?'
	rz
;(3) otherwise reset
	xra	a
	sta	p_space
	ret
p_space:	db	0
;
;	/* if several spaces between words, it's possible to
;	   get a SP at beginning of line during concatenation --
;	   but we don't want that		*/
;	if (!outpoint && c == ' ') return;
.stc1:
	call	punctset


;	lhld	outpoint
	mov	a,h
	ora	l
	jnz	.stc2

;(better do the following in newoutline -- here is not foolproof)
;reset punctuation space
	sta	p_space

;except if we're just putting to the terminal, go ahead
	lda	val + 54*('P'-'@') + 2*('T'-'@')
	ora	a
	jnz	.stc2
	mov	a,c
	cpi	' '
	jz	.stcxt
;
;	/* store the character			*/
;	outbuf[outpoint] = c;
.stc2:
;check for upper-case
	lda	val + 54*('U'-'@') + 2*('C'-'@')
	ora	a
	mov	a,c
	cnz	mapuc
	mov	c,a

	xchg
	lhld	outbuf
	xchg
;	lhld	outpoint
	dad	d
	mov	m,c

	dcx	h
	mov	a,m
	inx	h
	sta	laststow

;
;	/* check soft hyphen			*/
;	if (c == SOFTHY) {c = '-'; hyflag = TRUE; }
;	else hyflag = FALSE;
	mov	a,c
	cpi	SOFTHY
	mvi	a,0
	jnz	.stc3
	mvi	c,'-'
	inr	a
.stc3:	sta	hyflag

;if it's a from-flag, make it a RA & remember outpoint
	mov	a,c
	cpi	FRFLAG
	jnz	.stc3a
	mvi	m,RAFLAG
	lhld	outpoint
	shld	frplace
.stc3a:
;
;	/* check flag character and required blank			*/
;	if (c >= 0x7F || c == rb) c = ' ';

	mov	a,c
	inr	a
	jm	.stc4
	lda	rb
	cmp	c
	jnz	.stc5
.stc4:	mvi	c,' '
.stc5:

;Here put it to the console, if appropriate

	lda	val + 54*('P'-'@') + 2*('T'-'@')
	ora	a

	.comment	`
have to keep glen up for templates
	jz	.stc5a

	mov	a,c
	call	termput##
;if put-terminal, don't actually store it
	jmp	.stcxt
			`
	mov	a,c
	cnz	termput##

.stc5a:
;
;	/* if graphic char or font undefined, look at earlier fonts	*/
;	font = (mode >> 8) & 7;

	lda	mode+1
	ani	7
	mov	b,a	;henceforth B = font

;	while
;	(	font
;		&& !(	(stowlen = ftlen[font-1][c])
;			  && ftname[font-1][0]
;		   )
;	) font--;

.stc6:
	mov	a,b
	ora	a
	jz	.stc8

	mov	l,b
	dcr	l
	mvi	h,0
;HL = (font-1)*100H
;	lxi	d,128
;	call	usmul

	dad	h
	dad	h
	dad	h
	dad	h
	dad	h
	dad	h
	dad	h

	lxi	d,ftlen
	dad	d
	mov	e,c
	mvi	d,0
	dad	d
	mov	l,m
	mvi	h,0
	shld	stowlen

	mov	a,h
	ora	l
	jz	.stc7

	dcr	b
	call	getftn##
	inr	b

	mov	a,m
	ora	a
	jnz	.stc8
.stc7:
	dcr	b	;font--
	jmp	.stc6
;end while
.stc8:

;
;	stowmode = mode;

	lhld	mode
	shld	stowmode

;	stowkern = cs - val['K'-'@']['E'-'@'];
	lhld	cs
	xchg
	lhld	ke
	call	cmh
	dad	d

;check for graphics font char
	lda	stowlen
	cpi	0ffh
	jnz	.stc8a
	lxi	h,450
	shld	stowlen
	lxi	h,0
.stc8a:
	shld	stowkern
;
;
;	/* flag "have one char in output line"	*/
;	if (font)
	mov	a,b
	ora	a
	jz	.stc12
;	{	grfflag = TRUE;
	mvi	a,1
	sta	grfflag
;
;		stowmode = fix[font-1][0];
	mov	h,b
	dcr	h
	mvi	l,0	;(font-1)*100h
	lxi	d,fix
	dad	d
	mov	a,m
	inx	h
	mov	h,m
	mov	l,a
	shld	stowmode
;		if (stowmode & 0xFF00)
;		{	if (stowmode < 0) stowkern -= stowmode >> 8;
;			else	stowkern += stowmode >> 8;
;			stowmode &= 0x00FF;
;		}
;	lhld	stowmode
	mov	a,h
	ora	a
	jz	.stc10

;DE = stowmode >> 8
	mov	e,h
	mvi	d,0

;	lhld	stowmode
;	mov	a,h
	ral
	jnc	.stc9
;here stowmode < 0
	call	cmd
.stc9:	lhld	stowkern
	dad	d
	shld	stowkern

	xra	a
	sta	stowmode+1

;		if (stowmode & PRPTNL)
;		{	stowmode &= ~PRPTNL;
;			stowmode |= TALL;
;			duplflag = TRUE;
;		}
.stc10:	lhld	stowmode
	mov	a,l
	ani	PRPTNL
	jz	.stc11

	mov	a,l
	ani	UNDRLN
	jz	.stc10.1
	mov	a,c
	cpi	' '
	jc	.stc7
	cpi	60H
	jnc	.stc7

.stc10.1:
	mov	a,h
	ori	TALL shr 8
	mov	h,a
	mov	a,l
;;	ani	not (PRPTNL or UNDRLN)
	ani	not UNDRLN
	mov	l,a

	mvi	a,1
	sta	duplflag	;?? was 'hycorrect'
;		stowmode |= mode;
.stc11:
	xchg
	lhld	mode
	mov	a,h
	ora	d
	mov	h,a
	mov	a,l
	ora	e
	mov	l,a
	shld	stowmode
;
;		if (stowmode & TALL) tallflag = TRUE;
;	lhld	stowmode
	mov	a,h
	ani	TALL shr 8
	jz	.stc11.1
	mvi	a,1
	sta	tallflag

;and ... if ' ' && p_space, add it in
.stc11.1:
	mov	a,c
	cpi	' '
	jnz	.stc13
	lxi	h,p_space
	mov	a,m
	ora	a
	jz	.stc13
	mov	e,a
	xra	a
	mov	m,a
	mov	d,a
	lhld	stowlen
	push	h
	dad	h
	xchg
	call	usdiv
	pop	d
	dad	d
	shld	stowlen
;	}
	jmp	.stc13


;	else epsflag = TRUE;
.stc12:	mvi	a,1	;(if not font)
	sta	epsflag
;
;
;	/* determine width			*/
;	if (bsflag) 	stowlen = 0;
;	else if (font) {if (cw) stowlen = cw;
;			else if (stowlen + stowkern >  0)
;				stowlen += stowkern;
;			}
;	else if (!(stowlen = modelen[mode & 63]))
;			stowlen = pmlen[c];
.stc13:	lda	bsflag
	ora	a

	mvi	l,0
	jnz	.stc17
;;	jz	.stc14
;;	lxi	h,0
;;	shld	stowlen
;;	jmp	.stc18

.stc14:
	mov	a,b
	ora	a
	jz	.stc16

	lhld	cw
	mov	a,h
	ora	l
;;	jz	.stc15
;;	lhld	cw
;;	shld	stowlen
;;	jmp	.stc18
	jnz	.stc17a

.stc15:	lhld	stowlen
	xchg
	lhld	stowkern
	dad	d

;(space-caps now separate)
;-	lda	val + 54*('U'-'@') + 2*('C'-'@')
;-	mov	e,a
;-	mvi	d,0
;-	dad	d

	dcx	h
	mov	a,h
	inx	h
	ora	a
	jm	.stc18
;;	shld	stowlen
;;	jmp	.stc18
	jmp	.stc17a



;(if not font)
.stc16:	lda	mode
	ani	63
	mov	e,a
	mvi	d,0

	lxi	h,modelen
	dad	d
	mov	l,m

	mov	a,l
	ora	a
	jnz	.stc17

	mov	l,c
	mvi	h,0
	lxi	d,pmlen
	dad	d
	mov	l,m
.stc17:	mvi	h,0
.stc17a:
	shld	stowlen
;
;	/* font number to b8-b10		*/
;	attrbuf[outpoint] =  (stowmode & 0xF8FF) | (font << 8);
.stc18:	lhld	attrbuf
	xchg
	lhld	outpoint
	dad	h
	dad	d

	xchg
	lhld	stowmode
	mov	a,h
	ani	0f8h
	ora	b
	mov	h,a
	xchg

	mov	m,e
	inx	h
	mov	m,d

;no correction for native font
	mov	a,b
	ora	a
	jz	.stcNIT
;no correction for graphic font
	lda	stowlen+1
	ora	a
	jm	.stcNIT
;no correction if cw
	lda	cw
	ora	a
	jnz	.stcNIT

	call	.italcorr
	call	.kerncorr
	call	.capcorr
	jmp	.stcNIT

.capcorr:
	lda	val + 54*('S'-'@') + 2*('C'-'@')
	ora	a
	rz
	mov	l,a
	mov	a,c
	cpi	'A'
	rc
	cpi	'Z'+1
	rnc
	lda	laststow
	cpi	'A'
	rc
	cpi	'Z'+1
	rnc
	pop	d
	mvi	h,0
	jmp	.lastwch

.kerncorr:
;high byte of last attr left in E by italcorr
	mov	a,e
	ani	7
	cmp	b	;not if fonts differ
	rnz

;font in B
	mov	a,b
	dcr	a
;(should also compare last font)
	mov	l,a
	mvi	h,0
	dad	h
	lxi	d,klist
	dad	d
	mov	e,m
	inx	h
	mov	d,m
	xchg
	mov	a,h
	ora	l
	rz

	mvi	e,0
	push	b
	lda	laststow
	mov	b,a
.kc1:	call	.ksearch
	ora	a
	jnz	.kc1
	pop	b
	mov	d,a
	mov	a,e
	ora	a
	rz
	pop	h	;escape from call
	xchg
	dad	h	;? 2 dots per mention
	call	cmh
	jmp	.lastwch

.ksearch:
	mov	a,m
	ora	a
	rz
	mov	d,a
	inx	h
	mov	a,m
	ora	a
	rz
	inx	h
	cmp	c
	rnz
	mov	a,b
	cmp	d
	rnz
	inr	e
	ret


.italcorr:
;italic correction for non-italic char preceded by italic
;(does not take account of bending, or expanded, or stretching)
	mov	a,e
	ani	ITALIC
	mov	e,a
	mov	a,d
	ani	BENT shr 8
	ora	e
;(wait)	rnz	;no correction if this is italic

;step back in attrbuf to previous char
;(if outpoint = 0, invalid -- check later)
	dcx	h
	dcx	h
	mov	e,m	;get last font for kerncorr
	rnz		;NOW ret if this is italic or bent
	dcx	h
	mov	a,m
	ani	ITALIC
;if that was not italic, no correction
	jnz	$+7
	mov	a,e
	ani	BENT shr 8
	rz
	mov	d,e
	mov	e,m
;last mode in DE

;now do correction
;first, escape from caller so other corrections not done
	pop	h

;;	lxi	h,8
	xchg
	call	endcorr##
	xchg
.lastwch:
	shld	deltaL
	lxi	h,.stcNIT
	push	h

;now make sure not at beginning of output line
	lhld	outpoint
	mov	a,h
	ora	l
	rz

;here we have to correct
	dcx	h	;point last
	dad	h	;word array
	xchg
	lhld	widbuf
	dad	d

;a little patchwork -- if current is space, add width to it,
; instead of last, to prevent double corrections at end of line
	mov	a,c
	cpi	' '
	jnz	$+6
	lxi	h,stowlen

;save array index
	push	h
;get previous width of last char in DE
	mov	e,m
	inx	h
	mov	d,m
;add the correction -- 1 dot per point, assuming 8 points high
;(change here for other correction: 'lhld deltal')
	lhld	deltaL
	dad	d
	xchg
;and enter it
	pop	h

;check for small width
	mov	a,d
	ora	a
	rm
	ora	e
	rz

	mov	m,e
	inx	h
	mov	m,d

;now adjust glen, unless adding to current SP
	mov	a,c
	cpi	' '
	rz

	lhld	glen
;(change here for other correction: 'deltal equ $+1')
deltaL	equ	$+1
	lxi	d,8

	dad	d
	shld	glen
	ret




.stcNIT:
;
;	bsflag = FALSE;
	xra	a
	sta	bsflag
	mov	a,c
	sta	laststow
;
;	/* adjust for expanded, etc.		*/
;	if (stowmode & EXPNDD) stowlen <<= 1;

	push	b

	lda	stowmode
	mov	c,a
;from here, keep low byte of stowmode in C
	lhld	stowlen
;... and stowlen in HL

	ani	EXPNDD
	jz	.stc19
;;	lhld	stowlen
	dad	h
	shld	stowlen
;	if (font)
.stc19:
	mov	a,b
	ora	a
	jz	.stc24
;	{	if (stowmode & CMPRSSD) stowlen -= stowlen >> 2;

	mov	a,c
	ani	CMPRSSD
	jz	.stc20

;;	lhld	stowlen
	push	h
;;	lhld	stowlen
	lxi	d,2
	call	shlrbe
	pop	d
	call	cmh
	dad	d
	shld	stowlen

;		if (stowmode & ELITE)   stowlen -= stowlen / 5;
.stc20:
	mov	a,c
	ani	ELITE
	jz	.stc21

;;	lhld	stowlen
	push	h
;;	lhld	stowlen
	lxi	d,5
	xchg
	call	sdiv
	pop	d
	call	cmh
	dad	d
	shld	stowlen

;		if (st)		    stowlen += stowlen / st;
.stc21:
	lhld	st
	mov	a,h
	ora	l
	jz	.stc22

	xchg
	lhld	stowlen
	push	h
	xchg
	call	sdiv
	pop	d
	dad	d
	shld	stowlen

;		if (sh)		    stowlen -= stowlen / sh;
.stc22:	lhld	sh
	mov	a,h
	ora	l
	jz	.stc23

	xchg
	lhld	stowlen
	push	h
	xchg
	call	sdiv
	pop	d
	call	cmh
	dad	d
	shld	stowlen
;		if (stowmode & EMPHSZD && bo)
;				    stowlen += bo << 1;
;	}
.stc23:
	lhld	bo
	mov	a,h
	ora	l
	jz	.stc24
	mov	a,c
	ani	EMPHSZD
	jz	.stc24

	lhld	stowlen
	xchg
	lhld	bo
	dad	h
	dad	d
	shld	stowlen
;
;	/* record width and inc't pointers	*/
;	widbuf[outpoint++] = stowlen;
.stc24:
;get back char in c
	pop	b

	lhld	widbuf
	xchg
	lhld	outpoint
	inx	h

;is this right?
	lda	val + 54*('P'-'@') + 2*('T'-'@')
	ora	a
	jnz	$+6

	shld	outpoint
	dcx	h
	dad	h
	dad	d

	xchg
	lhld	stowlen
	xchg
	mov	m,e
	inx	h
	mov	m,d

;	if (!hyflag) glen += stowlen;
	lda	hyflag
	ora	a
	jnz	.stcxt

	lhld	glen
	dad	d
	shld	glen
;}
.stcxt:
	lxi	h,val + 54*('R'-'@') + 2*('C'-'@')
	mov	a,m
	ora	a
	jz	.stxxt
	dcr	m
	jnz	.stc00	;go back and do it all again
.stxxt:
	pop	b
	ret

hyflag:		db	0
laststow:	db	0

stowlen:	dw	0
stowmode:	dw	0
stowkern:	dw	0


	end