INCLUDE BDSYM.EQU
;	INCLUDE	EPSYM.EQU
	INCLUDE	EPDATA


;	FUNCTION	GCHR
	EXT		EPERROR,LOADFT




;/************************************************/
;/* Set the bits for 1/3 of one graphics char	*/
;/************************************************/
;gchr(ix,pass)
;int ix, pass;
;{	int	len,	+00
;		i,	+02
;		j,	+04
;		cbase,	+06
;		gindex; +08
;	char	c,	+0AH
;		c0,	+0BH
;		c1,	+0CH
;		c2,	+0DH
;		charft,	+0EH
;		*ptft,	+0FH
;		ftn;	+11H
;(locals: 6 ints + 6 bytes = 18 bytes)
;		(bc)	+12H
;		(ret)	+14H
;		ix	+16H
;		pass	+18H
gchr::

	pop	d
	pop	h
	shld	ix
	mov	a,l
	ora	h
	jnz	gc0
	shld	lstlen
gc0:	pop	h
	mov	a,l
	sta	pass
	add	a
	add	a
	add	a
	sta	pix	;for use by dotset
	push	h
	push	h
	push	d

	push	b

	LHLD	WIDBUF
	XCHG

	lhld	ix
	dad	h
	dad	d

	mov	a,m
	inx	h
	mov	h,m
	mov	l,a
	shld	widix	;for later
;
;	/* get char out of buffer		*/
;	c = outbuf[ix];
	LHLD	OUTBUF
	XCHG

	lhld	ix
	dad	d	;= (outbuf) + (ix)
	mov	a,m
	sta	ch	

;
;	/* skip soft hyphen & flag chars	*/
;	if (c == SOFTHY || c >= 0x7F) return;

;(ch still in acc)
	cpi	SOFTHY	;1EH
	jz	gchrret

	cpi	SPFLAG
	jnz	g1
	mvi	a,' '
	sta	ch
g1:	cpi	HSFLAG
	jz	g2
	cpi	7FH
	jnc	gchrret


g2:
	cpi	newlin
	jz	g2.1
	mov	e,a
	lda	tabottom
	ora	a
	jz	g2.1
	lda	pass
	dcr	a
	jnz	g2.1
	mov	a,e
	cpi	' '
	jnz	g2.0
	lhld	widix
g2.sp:	push	h
	mvi	a,' '
	call	termput##
	pop	h
	lxi	d,-PICA
	dad	d
	mov	a,h
	ora	a
	jp	g2.sp
	jmp	g2.1
g2.0:	call	termput##
g2.1:
;
;	/* what font?				*/
;	charft = 7 & (attrbuf[ix] >> 8);

	LHLD	ATTRBUF
	XCHG

	lhld	ix
	dad	h
;ix word
	dad	d
	mov	e,m
	inx	h
	mov	d,m
;attrbuf[ix]
;+	for later
	mov	b,d
	mov	c,e
;	shld	attrix
	mov	a,d
;	lxi	d,8
;	call	SHLRBE
;>> 8
;+
	ani	7
;& 7
	sta	charft
;charft =
;

;	/* if not in font, or native Epson font,
;	   or required blank, make it a space	*/
;	if (!charft || c < ' ' || c == rb) c = ' ';
;/*(change to allow c < SP) */

	ora	a
;$$	jz	i31f0
	jz	i322.sp
	dcr	a	;for later
	sta	ftn
;!charft
	lda	ch
;new June '84
	cpi	HSFLAG
;$$	jz	i31f0
	jz	i322.sp

;	cpi	' '
;	jc	i31f0
;c < ' '
	lhld	rb	;rb
	cmp	l
	jz	i322.sp
;$$	jnz	i31f6
;== rb
;$$i31f0:
;$$	mvi	a,' '
;$$	sta	ch
; c = ' '

;
;	/* if 1st 3 of passes and not tall char, just space	*/
;	if (!tabottom && !(attrbuf[ix] & TALL))  c = ' ';
;
i31f6:
;also if 1st big duplex pass & not duplex
	lda	tduplex
	cpi	2
	jnz	i31f6a
	mov	a,c
	ani	PRPTNL
	jz	i322.sp

i31f6a:
	lda	tabottom
	ora	a
	jnz	i3229

;!tabottom
;	lhld	attrix
	mov	a,b
	ani	40H
;	attrix & 4000H
;TALL
	jnz	i3229

;... and add: also sp if cheight > 16p 

;if alignment requested, keep non-tall char
	LDA	ALIGN
	ORA	A
	JNZ	i3229


i322.sp:
	mvi	a,' '
	sta	ch
;c = ' '


;	/* if it's a space, just move pointer over	*/
;	if (c == ' ')
;	{	gpoint += widbuf[ix];
;		return;
;	}

i3229:
;also treat all as space if noprint
	lda	noprint
	ora	a
	jnz	i3229a

	lda	ch
	cpi	' '
	jnz	i3257
;c = ' ' ??
i3229a:
	lhld	gpoint
	xchg
	lhld	widix
	shld	lstlen
	dad	d
	shld	gpoint
	jmp	gchrret

i3257:

;
;	/* which font to use? number of graphics font is 0-7,
;		corresponding to 'fo' value of 1-8	*/
;	ftn = charft - 1;

;	lda	charft
;	dcr	a
;done	sta	ftn

;	/* ... and where is the font?			*/
;	if (!ftp[ftn]) /* reload if necessary */

	lda	ftn
	mov	l,a
	mvi	h,0
	dad	h
;ftn word
	lxi	d,ftp
	dad	d
	push	h
	mov	e,m
	inx	h
	mov	d,m

	pop	h
	xchg	
	mov	a,h
;ftp[ftn]
	ora	l
	jnz	i329c

;	 if (loadft(ftn) == ERROR) eperror(120+ftn);

	push	d	;save addr. font location
	lda	ftn
	mov	l,a
	mvi	h,0
	push	h
	call	loadft
	pop	d
	inx	h
	mov	a,h
	ora	l
	pop	h
	jnz	i329c0
;== ERROR
	lda	ftn
	adi	120
	mov	l,a
	mvi	h,0
;+120
	push	h
	call	eperror	;never returns
;;	pop	d


shftdup:
;check for duplex font
;(change here, since stowc will now leave mode prptnl for duplex)

;;	lda	ftn
;;	mov	h,a
;;	mvi	l,0
;;	lxi	d,fix
;;	dad	d
;;	mvi	a,PRPTNL
;;	ana	m
	mov	a,c
	ani	PRPTNL
	rz

;***
	lda	tduplex
	ora	a
	jz	.sdup3
;if tduplex=2, treat as though tabottom=0,
;if tduplex=1, treat as though tabottom=1.
	ani	1
	mov	l,a
	jmp	.sdup4


.sdup3:
;***

	mov	a,b		;pretend not tall
	ani	not (TALL shr 8)	;0BFH
	mov	b,a
	lhld	tabottom	;L = tabottom, for later test
.sdup4:
	lda	ch
	mov	h,a
	cpi	5FH	;should change to a sp if not tabottom
	rz
;if ch < 20H and top, shift up
	cpi	20H
	rz
	jnc	dup1
	mov	a,l
	ora	a
	rnz
dup4:	mov	a,h
	adi	20H
	jmp	dup
;if ch >= 60H and top, shift down
dup1:	cpi	60H
	jc	dup2
	mov	a,l
	ora	a
	rnz
dup3:	mov	a,h
	sui	20H
;;	jmp	dup
dup:	sta	ch
	ret
;if 21H <= ch <= 5F and top, no shift, 
dup2:	mov	a,l
	ora	a
	rz
;otherwise when bottom, shift up if >= 40H, or shift down if less
	mov	a,h
	cpi	40H
	jc	dup3
	jmp	dup4





;	ptft = ftp[ftn];
;
i329c0:
	mov	e,m	;reload ptr after
	inx	h	;loadft call
	mov	d,m
	xchg

i329c:
;ftp[ftn]
	shld	ptft

	call	shftdup

ndup:


;ptft =

;	/* where to start laying in the black		*/
;	gindex = gpoint;

	lhld	gpoint
	shld	gindex

;	/* update for next dots after these		*/
;	gpoint += widbuf[ix];
;

;	lhld	gpoint
	xchg
	lhld	widix
	dad	d
;check not > 1920 = 780H
	mov	a,h
	cpi	GBUFSIZ shr 8	;was 7
	jc	twok
	jnz	gchrret
	mov	a,l
	cpi	GBUFSIZ and 0FFH	;was 80H
	jnc	gchrret
twok:	shld	gpoint

;	/* what width?					*/
;	len = ftlen[ftn][c];
;
;or:
	lda	ftn
	ora	a
	rar
	mov	h,a
	mvi	a,0
	rar
	mov	l,a

;-	lda	ftn
;-	mov	l,a
;-	mvi	h,0
;ftn
;-	lxi	d,80H
;-	call	USMUL
	lxi	d,ftlen
	dad	d
	xchg
	lda	ch
	mov	l,a
	mvi	h,0
;c
	dad	d
	mov	a,m
	sta	len
;len =

;	/* if width is 0, overprint			*/
;	if (!widbuf[ix]) gindex -= widbuf[ix-1];

	lhld	widix
	mov	a,h
	ora	l
	jnz	i334d
;!widbuf[ix] ??
;gindex
	LHLD	WIDBUF
	XCHG

	lhld	ix
	dcx	h
;check not neg
	mov	a,h
	ora	a
	jm	i334d
;ix-1
	dad	h
	dad	d
	MOV	E,M
	INX	H
	MOV	D,M
	call	cmd
	lhld	gindex
	dad	d
	push	h

	lhld	lstlen
	xchg
	lhld	len
	mvi	h,0
	call	cmh
	dad	d
	lxi	d,2
	xchg
	call	sdiv
	xchg
	pop	h
	dad	d
	shld	gindex
;gpoint =
	jmp	i33b2

;	/* if non-proportional, center in char field	*/
;	else if (cw) gindex += (j = (widbuf[ix] - len) / 2) > 0 ? j : 0;
;		/* bad way to test - can be sync problem */
;
;

i334d:
;store st and sw in temporary locations
	lhld	st
	shld	_st
	lhld	sh
	shld	_sh

;no fixed cw if graphic
	lda	len
	inr	a
	jz	i33b2

	lhld	cw
	mov	a,h
	ora	l
	jz	i33b2
;here fixed cw request

;desired new ink width is recorded width - character-spacing
;(here we neglect shrink or stretch of cs itself)

	lhld	widix
	xchg
	lhld	cs
	call	cmh
	dad	d
;check for cs > cw
	mov	a,h
	ora	a
	jm	i33b2

;;Tried calling wadjust -- Worse than before
;;;new -- if high is > 1, use max stretch
;;;(try to prevent overflow in rest of calc.)
;;	dcr	a
;;	dcr	a
;;	jm	.gcw1
;;	mvi	a,200
;;	jmp	.gcw5
;;.gcw1:

;;;new vers -- ready to take percent change
;;	lxi	d,100
;;	call	usmul

;old ink width is in len -- take difference
	lda	len
	mov	e,a
	mvi	d,0
;;;new - round and get percent change
;;	dcx	d
;;	dad	d
;;	inx	d
;;	xchg
;;	call	usdiv
;;;now wadjust calculates desired st and sh
;;	mov	a,l
;;.gcw5:
;;	call	wadjust##
;;	shld	_st
;;	xchg
;;	shld	_sh

	push	d	;save len for a moment

	call	cmd
	dad	d

;if positive, we want to stretch
	mov	a,h
	ora	a
	pop	d	;get len back
;remember sign
	push	psw
	jm	.gcw6
;if positive and diff. > len, max stretch will be insufficient,
; and we should center it (if diff = len, center vacuously)
	call	 albu
	jnc	.gcw7
	call	cmd
	dad	d
;HL = diff - len, which is amount that cannot be done by stretching
	mvi	e,1
	call	shlrbe
	xchg
	lhld	gindex
	dad	d
	shld	gindex
;now it's centered -- go stretch by maximum
	lxi	h,1
	jmp	.gcw8

.gcw6:
;get absolute value
	call	cmh
.gcw7:
;st or sh = old-ink / |new-ink - old-ink|
	push	h
	xchg
	lhld	widix
;round up
	dcx	d
	dad	d
	xchg
	pop	h
	call	usdiv
.gcw8:
;other value will be 0
	lxi	d,0
	pop	psw
	jp	$+4
	xchg

;(if stretching, shouldn't allow stretch 0 -- can we get that here?)

	shld	_st
	xchg
;don't allow shrink 1
	mov	a,l
	dcr	a
	jnz	$+4
	inx	h
	shld	_sh




	.comment	`
Real old code for cw ...
(it would still be nice to do a little centering) <-- now done
	lhld	widix
	xchg
	lda	len
	mov	l,a
	mvi	h,0
;len
	call	CMH
	dad	d
;widbuf[ix] - len
	mov	a,h
	ora	a
	jm	i33b2
	rar
	mov	h,a
	mov	a,l
	rar
	mov	l,a

	xchg
	lhld	gindex
	dad	d
	shld	gindex
		`

i33b2:
	lda	len
	sta	lstlen

;	/* where do the bits start in the font?		*/
;	cbase = fix[ftn][c] + pass*len;
;
	lda	ftn

	mov	h,a
	mvi	l,0
	lxi	d,fix
	dad	d

	xchg
	lda	ch
	mov	l,a
	mvi	h,0
	dad	h
	dad	d

	mov	e,m
	inx	h
	mov	d,m
;fix[ftn][c]
	lhld	ptft
	dad	d
	shld	ptft0

	lda	len
;graph char only 1 pass
	cpi	0ffh
	jnz	$+4
	xra	a
	mov	e,a
	mvi	d,0
	dad	d
	shld	ptft1
	dad	d

;exchange 1st and 3rd pass data if bent and upside down or gothic
	mov	a,b
	ani	BENT shr 8
	jz	i33b.nb
	lda	be+1
	ani	30H
	jz	i33b.nb
	xchg
	lhld	ptft0
	xchg
	shld	ptft0
	xchg
i33b.nb:
	shld	ptft2

;and another little change for graph char
	xra	a
	sta	len+1
	lxi	h,450
	lda	len
	cpi	0ffh
	jnz	$+6
	shld	len

;	/* move the dots into the output graphics buffer	*/
;	for (i = cbase; i < cbase + len; i++)

;**-> for ( ; len; len--)
;i < cbase + len ff.
i3400:
	lhld	len
	mov	a,h
	ora	l
	jz	gchrret
	dcx	h
	shld	len

;	{	c = ptft[i];
;
;**-> c = ptft0 if pass 0, = ptft1 if pass 1, = ptft2 if pass 2

	lhld	ptft0
	mov	a,m
	sta	c0
	sta	ch
	lhld	ptft1
	mov	a,m
	sta	c1
	lhld	ptft2
	mov	a,m
	sta	c2

;For tall and cheight > 8 points but not 16-<24p,
;  stretch up as per char. height
	mov	a,b
	ani	40H
	jz	i33nt
	lda	cheight
	cpi	3*8+1
	jc	i33nt
	cpi	3*16
	jc	i33ts
	cpi	3*24
	jc	i33nt
i33ts:	push	b
	call	canon
	call	hidots
	call	decanon
	pop	b
	lda	c0
	sta	ch
i33nt:
	lda	pass
	ora	a
	jz	i3400c
	dcr	a
	jz	i3400a
	lda	c2
	jmp	i3400b
i3400a:	lda	c1
i3400b:	sta	ch
i3400c:

;c =
;		/* modify vertical format of char		*/
;		if
;		(	fa
;			|| attrbuf[ix]
;			   & (	SUPSCRPT | SUBSCRPT | DBLSTRK | TALL)
;		)
;
;(should fix tall super- and subscripts)
	lda	fa	;fa
	ora	a
	jnz	i3468
;fa ??
;	lhld	attrix
;	lxi	d,5810H	;0101100000010000

	mov	a,b
	ani	58H
	mov	h,a
	mov	a,c
	ani	10H
	ora	h
	jz	i37cb

;		{	j = i - pass*len;
i3468:
;*-> nothing, work done already
;done			c0 = ptft[j];
;done			c1 = ptft[j + len];
;done			c2 = ptft[j + len + len];
;			if (attrbuf[ix] & DBLSTRK)

;	lhld	attrix
;	lda	attrix
	mov	a,c
	ani	10H
	jz	i35be
;disable double striking for tall char?
;	MOV	A,B
;	ANI	40H
;	JNZ	i35be
;			{	c = c1;
	lxi	h,c1
	mov	a,m
	sta	ch
;				c1 |= c0;
;	lxi	h,c1
	lda	c0
	ora	m
	mov	m,a

;				c0 |= c2 >> 1;
	lxi	h,c0
	lda	c2
	ora	a
	rar
	ora	m
	mov	m,a

;				c2 |= c;
	lxi	h,c2
	lda	ch
	ora	m
	mov	m,a

;				if (!pass) c = c0;
	lda	pass
	ora	a
	jnz	i3597

	lda	c0
;	sta	ch

	jmp	i35b3x


;				else if (pass == 1) c = c1; else c = c2;
;			}
i3597:
	dcr	a
	ora	a
	jnz	i35b3
;pass == 1 ??
	lda	c1
;	sta	ch
;c = c1
	jmp	i35b3x

i35b3:
	lda	c2
i35b3x:	sta	ch
;c = c2

;			if (attrbuf[ix] & (SUPSCRPT | SUBSCRPT))

i35be:

;	lda	attrix+1
	mov	a,b
	ani	18H
;	lxi	d,1800H...
	jz	i3743
;if TALL superscript, no shrinking ...
	mov	a,b
	ani	40H
	jz	i35ss
	mov	a,b
	ani	10H
	jz	i35ss
	lda	tabottom
	ora	a
	jz	i37cb
	xra	a
	sta	ch
	jmp	i37cb

i35ss:
;			{	if (!pass) c2 = 0;

	lda	pass
	ora	a
	jnz	i35f9
	sta	c2
	jmp	i3649
;				else if (pass == 1)
;					{c1 = 0; c0 <<= 1;}
i35f9:
;	lda	pass
	dcr	a
	jnz	i361c
;pass == 1 ??
	sta	c1
;c1 = 0
	lda	c0
	add	a
	sta	c0
;c0 <<= 1
	jmp	i3649
;				else if (pass == 2)
;				-> else
i361c:
;	dcr	a
;	jnz	i3649
;					{c0 = 0; c1 <<= 1; c2 <<= 1;}
	xra	a
	sta	c0
;c0 = 0
	lda	c1
	add	a
	sta	c1
;c1 <<= 1
	lda	c2
	add	a
	sta	c2
;c2 <<= 1
;				c = c0 | c1 | c2;
i3649:
	lda	c0
	lxi	h,c1
	ora	m
	lxi	h,c2
	ora	m
;	sta	ch
;				c = (c & 128) |
	mov	h,a
	ani	80H
	mov	l,a
;					((c << 1) & 64) |
	mov	a,h
	add	a
	mov	h,a
	ani	40H
	ora	l
	mov	l,a
;					((c << 2) & 32) |
	mov	a,h
	add	a
	mov	h,a
	ani	20H
	ora	l
	mov	l,a
;					((c << 3) & 16);
	mov	a,h
	add	a
	ani	10H
	ora	l

	sta	ch
;c =
;				if (attrbuf[ix] & SUBSCRPT) c >>= 2;
;	lda	attrix+1
	mov	a,b
	ani	10H	;attrix & 1000H
	jz	i370d

	lda	ch
	rar
	rar
	ani	3FH
	sta	ch
;				if (!(attrbuf[ix] & SUPSCRPT)) c >>= 2;
;			}
i370d:
;	lda	attrix+1
	mov	a,b
	ani	8	;attrix & 0800H
	jnz	i3743

	lda	ch
	rar
	rar
	ani	3FH
	sta	ch
;			if (attrbuf[ix] & TALL)
i3743:
;	lda	attrix+1
	mov	a,b
	ani	40H	;attrix & 4000H
	jz	i3799
;double height for 0..8points or 16..<24 points
	lda	cheight
	cpi	3*24
	jnc	i3799
	cpi	3*8+1
	jc	i37tt
	cpi	3*16
	jc	i3799
i37tt:
;			 c = maketall(pass,c0,c1,c2);
;maketall references now global
	call	maketall
	jmp	i37cb

;			else if (fa) c = c0 | c1 | c2;
;		}
i3799:
	lhld	fa	;fa
	mov	a,h
	ora	l
	jz	i37cb

	lda	c0
	lxi	h,c1
	ora	m
	lxi	h,c2
	ora	m
	sta	ch

;
;		dotset(attrbuf[ix], gindex++, pass << 3, c);
i37cb:
;2nd parm now passed in HL, others global
	lhld	gindex

;if no dots, skip down to gindex adjustments
	LDA	CH
	ORA	A
	JNZ	i37tg
	INX	H
	SHLD	GINDEX
	JMP	i38c4

i37tg:
;align non-tall characters in tall lines
	mov	a,b
	ani	40H
	jnz	i37dt	;not if tall
	mov	a,c
	ani	PRPTNL
	jnz	i37dt	;not if duplex

	lda	tallflag
	ora	a
	jz	i37dt	;not if line not tall
	lda	align
	ora	a
	jz	i37dt	;not if no alignment request
	mov	e,a
	lhld	ch
	mvi	h,0
	call	shllbe
	lda	tabottom
	ora	a
	jnz	alg1
	mov	l,h
alg1:	mov	a,l
	sta	ch
	lhld	gindex
i37dt:
	push	h
	call	dotset
	pop	h
	inx	h
	shld	gindex
;
;		if (attrbuf[ix] & EMPHSZD)

;	lda	attrix
	mov	a,c
	ani	8
	jz	i38c4
;		{	j = (bo << 1) -1;
;			if (j < 0) j = 1;
	LDA	BO
	ora	a
	JNZ	I3853
	INR	A

;			for ( ; j > 0; j--,j--)
i3853:
	MVI	L,1
	MOV	H,A
i385l:
	PUSH	H
	MVI	H,0


	.comment	`
May as well give up on this.
	lda	callig
	ora	a
	jz	i385m

	push	h
;index + 1 pass for each level of emphasis
	lda	pass
	mov	e,a
	mvi	d,0
	dad	d
	push	h
	xchg
	lxi	h,3
	call	usmod
	xchg
	lxi	h,c0
	dad	d
	mov	l,m
	mvi	h,0
;shift left 1 every 3rd level of emphasis
	pop	d
	push	h
	lxi	h,3
	call	usdiv
	xchg
	pop	h
	call	shllbe
	mov	a,l

	sta	ch
	pop	h
;;	JMP	I385N
	jmp	$+4
			`



i385m:	DAD	H
	DCX	H
i385n:
;			dotset(attrbuf[ix], gindex + j, pass << 3, c);
;		}
	xchg
	lhld	gindex
	dad	d

	call	dotset
;((... j--,j--

	POP	H
	INR	L
	DCR	H
	JNZ	I385L


;		if (attrbuf[ix] & EXPNDD) gindex++;
i38c4:
	lhld	gindex
	push	h

;	lda	attrix
	mov	a,c
	ani	20H	;& 0020H
	jz	i38f4
	pop	h
	inx	h
	push	h
;		if (attrbuf[ix] & CMPRSSD && i % 4 == 1) gindex--;
i38f4:

;	lda	attrix
	mov	a,c
	ani	4
	jz	i3939

	lda	ptft0	;no longer use i
	ani	3
	dcr	a
	jnz	i3939

	pop	h
	dcx	h
	push	h

;		if (attrbuf[ix] & ELITE   && i % 5 == 3) gindex--;
i3939:
;	lda	attrix
	mov	a,c
	ani	1
	jz	i3980
	lhld	ptft0
	lxi	d,5
	xchg
	call	USMOD
	dcx	h
	dcx	h
	dcx	h
	mov	a,h
	ora	l
	jnz	i3980

	pop	h
	dcx	h
	push	h
;		if (sh && !(i % sh)) gindex--;
i3980:
	lhld	_sh
	mov	a,h
	ora	l
	jz	i39a8
	xchg
	lhld	ptft0
	xchg
	call	USMOD
	mov	a,h
	ora	l
	jnz	i39a8

	pop	h
	dcx	h
	push	h
;		if (st && !(i % st)) gindex++;
i39a8:
	lhld	_st
	mov	a,h
	ora	l
	jz	i39d0

	xchg
	lhld	ptft0
	xchg
	call	USMOD
	mov	a,h
	ora	l
	jnz	i39d0

	pop	h
	inx	h
	push	h
;	}
;}
;

i39d0:
	pop	h
	shld	gindex

	lhld	ptft0
	inx	h
	shld	ptft0
	lhld	ptft1
	inx	h
	shld	ptft1
	lhld	ptft2
	inx	h
	shld	ptft2

	jmp	i3400

gchrret:
	pop	b
	ret


;
;dotset(kind, gindex, pix, c)
;int		kind,	+08 === attrbuf[ix]
;		gindex,	+0A === gindex or gindex + j
;		pix;	+0C === pass << 3
;char		c;	+0E === c
;{	int	bx,	+00
;		power;	+02
;

dotset:
	shld	dtgindex

;	if (kind & BENT)
	mov	a,b
;	lda	attrix+1
	ani	20H	;& 2000H
	jz	i3b17
;;	LDA	BE
;;	ORA	A
;;	JZ	I3B17

;Now mode is bent and bend > 0
;	for (bx = 0, power = 1; bx < 8; bx++, power <<= 1)

	xra	a
	sta	bx
	inr	a
	sta	power
;bx = 0
;power = 1


;start of loop for bent chars

i3a14:
;(test now at end)
;	{	if (kind & ITALIC)
;		gbuf[gindex + bx + bending[be-1][pix + bx]] |= power & c;

	lhld	dtgindex

	.comment	`
;here A = power
	mov	e,a
	lda	be+1
	ani	80h
	jz	i3a14.1
	push	h
	mov	a,e
	lxi	d,gbuf-1
	dad	d
	ana	m
	pop	h
	jz	i3af9
if really want to do this, just jmp so not bent next time
i3a14.1:
			`

;(if italic add bx)
	mov	a,c
	ani	80H
	jz	i3a14a
	lda	bx
	mov	e,a

;top of italicized tall or duplex character over by 8
	mov	a,c
	ani	PRPTNL
	jnz	$+9

	MOV	A,B
	ANI	40H
	JZ	i3nt1
	LDA	TABOTTOM
	ORA	A
	JNZ	i3nt1
	MOV	A,E
	ADI	8
	MOV	E,A
i3nt1:
	mvi	d,0
	dad	d
i3a14a:
	push	h



;;	lhld	be	;be
	lda	be+1
	ani	7
	mov	h,a
	dcr	a
	jm	.bnt1
	mov	l,a
	add	a	;*2
	add	l	;*3
	mov	l,a
	mvi	h,0
	dad	h	;*6
	dad	h	;*12
	dad	h	;*24

;;	dcx	h
;be - 1
;;	lxi	d,24
;;	call	USMUL

	lxi	d,bending
	dad	d
.bnt1:
	xchg

	lda	pix
	mov	l,a
	lda	bx

;for tall, index every other
	MOV	H,A
	MOV	A,B
	ANI	40H
	JZ	i3nt2
	MOV	A,H
	RAR
	MOV	H,A
	LDA	TABOTTOM
	ORA	A
	JNZ	i3nt2
	MOV	A,H
	ADI	4
	MOV	H,A
i3nt2:
	MOV	A,H
	push	psw

	add	l
	mov	l,a
;L = row (0-23) to index
	mvi	h,0

;high of DE is 0 if no table value sought
	mov	a,d
	ora	a
	jz	.bnt2
;DE is still bending[...]
	dad	d

	mov	d,m
.bnt2:
	mov	l,d
;L = right displacement for this row of dots
	mvi	h,0

	lda	pass
	mov	d,a
;get back adjusted bx
	pop	psw	;is 0..7
	inr	a	;is 1..8
	mov	e,a
	add	a
	add	e	;*3 -- is 3..24

	dcr	a	;is 2..23
	sub	d	;is 0..23

	add	a	;is 0..46
	mov	e,a
	mov	d,h


;any slant?
	lda	be
	push	psw
;add in foreslant or backslant according to row in E

;low nib is foreslant
	call	..slant
;invert row for backslant in high nib
	mvi	a,46
	sub	e
	mov	e,a

	pop	psw
	rar
	rar
	rar
	rar
	call	..slant

;bending[be-1][pix + bx]

	pop	d	;dtgindex + bx
	dad	d

	lxi	d,gbuf
	dad	d
	push	h
	mov	e,m

;;	lda	power
;;	mov	l,a
;;	lda	ch
	call	updwnch
	lda	power

	ana	l
		;gbuf[...]
	ora	e

	pop	h	;@gbuf[...]
	mov	m,a
;	jmp	i3af9
;		else gbuf[gindex + bending[be-1][pix + bx]] |= power & c;
;	}

;("else" included in preceding loop now)
;
;((	for (...;...; bx++, power <<= 1)
;
i3af9:
	lda	bx
	inr	a
	sta	bx

	lda	power
	add	a
	sta	power

	rc
	jmp	i3a14
;
;i3b14:	jmp	dsetret


;add to displ. in HL slant in Acc according to row # in DE
..slant:
	ani	0fh
	rz
	push	d
	push	h
	cma
	ani	0fh
	jz	..slax
	inr	a
	mov	l,a
	mvi	h,0
	call	usdiv
	pop	d
	dad	d
	pop	d
	ret
..slax:	pop	h
	dad	d
	pop	d
	ret


updwnch:
	lda	be+1
	ani	20h
	lda	ch
	mov	l,a
	rz
	mvi	d,8
.upd1:	mov	a,l
	rar
	mov	l,a
	mov	a,h
	ral
	mov	h,a
	dcr	d
	jnz	.upd1
	mov	l,h
	ret




;	else if (kind & ITALIC)
i3b17:
;	lda	attrix
	mov	a,c
	ani	80H
	jz	i3ba0
;	for (bx = 0, power = 1; bx < 8; bx++, power <<= 1)

;;	push	b
;;	mvi	c,1
	lhld	dtgindex
	lxi	d,gbuf
;over 8 more for top of tall or duplex character
	mov	a,c
	ani	PRPTNL
	push	b
	mvi	c,1
	jnz	$+9
	MOV	A,B
	ANI	40H
	JZ	i3nt3
	LDA	TABOTTOM
	ORA	A
	JNZ	i3nt3
	LXI	D,GBUF+8
i3nt3:

	dad	d
	lda	ch
	mov	d,a
;bx = 0
;power = 1
i3b3c:
;		gbuf[gindex++] |= power & c;
	mov	e,m
	mov	a,d
	ana	c
	ora	e
	mov	m,a
	inx	h
	mov	a,c
	add	a
	mov	c,a

	jnc	i3b3c
;	jmp	i3b3c

i3b9d:	pop	b
;	jmp	dsetret
	ret
;	else gbuf[gindex] |= c;

i3ba0:
	lhld	dtgindex
	lxi	d,gbuf
	dad	d
	mov	e,m
	lda	ch
	ora	e
	mov	m,a

;}
;

;dsetret:
;	pop	b
	ret


;
;maketall(pass,c0,c1,c2)
;char		pass,	05
;		c0,	07
;		c1,	09
;		c2;	0B
;{	char	c;	00	(returned)
maketall:
	push	b
;
;	if (tabottom)
	lhld	tabottom
	mov	a,l
	ora	a
	jz	i3c07
;	{	c0 <<= 4;
	lda	c0
	add	a
	add	a
	add	a
	add	a
	sta	c0
;		c1 <<= 4;
	lda	c1
	add	a
	add	a
	add	a
	add	a
	sta	c1
;		c2 <<= 4;
;	}
	lda	c2
	add	a
	add	a
	add	a
	add	a
	sta	c2
;
;	switch (pass)

i3c07:
	lda	pass

;	cpi	0
;	jz	i3c1f
	cpi	1
	jz	i3c4c
	cpi	2
	jz	i3c79
;	jmp	i3ca6
;	{	case 0:	c = tallfu(c0) | tallfu(c1) >> 1; break;
;i3c1f:
	lda	c0
	call	tallfu
	push	psw
	lda	c1
	jmp	i3c79b

;	jmp	i3ca6
;		case 1:	c = tallfu(c0) | tallfu(c2) >> 1; break;
i3c4c:
	lda	c0
	jmp	i3c79a

;	jmp	i3ca6
;		case 2:	c = tallfu(c1) | tallfu(c2) >> 1; break;
i3c79:
	lda	c1
i3c79a:	call	tallfu
	push	psw
	lda	c2
i3c79b:	call	tallfu
	ora	a
	rar
	mov	l,a
	pop	psw
	ora	l

;	}
;
;	return(c);
;}
i3ca6:
	sta	ch
	pop	b
	ret


;
;tallfu(c)
;char c;
;{

tallfu:
	push	b
	mov	b,a
;	return
;	(	   c	   & 128
	ani	80H
	mov	c,a
;		| (c >> 1) &  32
	mov	a,b
	rar
	ani	20H
	ora	c
	mov	c,a
;		| (c >> 2) &   8
	mov	a,b
	rar
	rar
	ani	8
	ora	c
	mov	c,a	
;		| (c >> 3) &   2
	mov	a,b
	rar
	rar
	rar
	ani	2
	ora	c

;	);
;}
;
	pop	b
	ret

;$pass:	db	0
;$ch:	db	0
;$c0:	db	0
;$c1:	db	0
;$c2:	db	0
;$bx:	db	0
;$ftn:	db	0
;$charft:	db	0
;$len:	dw	0
;$lstlen:	dw	0
;$pix:	db	0

;$power:	db	0
;$gindex:	dw	0
;$dtgindex:	dw	0
;$ix:		dw	0
;(kept in BC)
;attrix:	dw	0
;$widix:	dw	0
;$ptft:	dw	0
;$ptft0:	dw	0
;$ptft1:	dw	0
;$ptft2:	dw	0
;$gcj:	dw	0

;$cx48:	db	0,0,0,0,0,0

;$_st:	dw	0
;$_sh:	dw	0

;For a tall=1 character:
; canon, hidots, decanon
;(Ref. to cheight required)


;canonicalize C0,C1,C2 with result in CX48
canon:
	lxi	h,0
	shld	cx48
	shld	cx48+2
	lda	c0
	mov	h,a
	lda	c1
	mov	l,a
	lda	c2
	mov	e,a
	mvi	b,8
	call	shft
	sta	cx48+3
	mvi	b,8
	call	shft2
	sta	cx48+4
	mvi	b,8
	call	shft3
	sta	cx48+5
	ret

;decanonicalize CX48 with result in C0,C1,C2
; Distribute the 24 bits of the first 3 bytes (for
; the top part of a tall char.) or the last 3 (for
; the bottom part) among c0,c1,c2
decanon:
	lxi	h,cx48
	lda	tabottom
	ora	a
	jz	dcnn0
	lxi	h,cx48+3
dcnn0:	mov	d,m
	inx	h
	mov	e,m
	inx	h
	mov	l,m
	xchg
	lda	cheight
	cpi	3*24
	jc	dcnn1
	mov	a,h
	sta	c0
	mov	a,l
	sta	c1
	mov	a,e
	sta	c2
	ret
dcnn1:	mvi	b,8
dcnn2:	call	dshft
	mov	a,c
	ral
	mov	c,a
	call	dshft
	mov	a,d
	ral
	mov	d,a
	call	dshft
	lda	c2
	ral
	sta	c2
	dcr	b
	jnz	dcnn2
	mov	a,d
	sta	c1
	mov	a,c
	sta	c0
	ret

;collect bits in C from 24 bits in H-L-E
shft:
	mov	a,h
	ral
	mov	h,a
	mov	a,c
	ral
	mov	c,a
	dcr	b
	rz
shft3:	mov	a,l
	ral
	mov	l,a
	mov	a,c
	ral
	mov	c,a
	dcr	b
	rz
shft2:	mov	a,e
	ral
	mov	e,a
	mov	a,c
	ral
	mov	c,a
	dcr	b
	rz
	jmp	shft

;rotate left 24 bits in H-L-E, returning
; with high bit in carry
dshft:
	mov	a,e
	ral
	mov	e,a
	mov	a,l
	ral
	mov	l,a
	mov	a,h
	ral
	mov	h,a
	ret

;if character height > 8 points, stretch pattern accordingly
hidots:
	lda	cheight
	cpi	3*24
	jc	hdts0
	rz
;for >= 24 points, use points instead of dots
	mov	l,a
	mvi	h,0
	lxi	d,3
	xchg
	call	USDIV
	mov	a,l
hdts0:
	sui	3*8
	rm
	cpi	3*8+1
	rnc

	mov	e,a
	lxi	h,sttab
	lda	ta
	dcr	a
	jnz	hidots2
	inr	e
hidots1:
	dcr	e
	rz
	mov	c,m	;load byte offset and bit mask
	inx	h
	mov	b,m
	inx	h
	push	d
	push	h
	call	stret
	pop	h
	pop	d
	jmp	hidots1

hidots2:
	dcr	a
	mov	a,e
	jz	$+9
;here tall was >= 3
	lxi	b,041FH	;row 35
	jmp	hirowb

;;	mov	a,e
	ora	a
	rar
	ora	a
	jnz	hdts2a
	inr	a
hdts2a:
;(new version)
	push	psw
	lxi	b,037FH
	call	hirowb
	pop	psw
	lxi	b,0503H

;;	mov	e,a
;;	mov	d,a
;;hidots3:
;;	lxi	b,037FH	;25th row
;;	push	d
;;	call	stret
;;	pop	d
;;	dcr	e
;;	jnz	hidots3
;;hidots4:
;;	lxi	b,0503H	;46th row
;;	push	d
;;	call	stret
;;	pop	d
;;	dcr	d
;;	jnz	hidots4
;;	ret

hirowb:
	push	psw
	push	b
	call	stret
	pop	b
	pop	psw
	dcr	a
	jnz	hirowb
	ret

;stretch out pattern in cx48 by doubling one bit
; the bit is in the byte at offset B, and a mask
; for the lesser bits to remain unaffected is in C
stret:
	lxi	h,cx48
	mov	e,b
	mvi	d,0
	dad	d	;HL-> highest byte to change
	mov	a,m
	mov	e,a	;E = original
	ana	c	;use mask
	mov	d,a	;D = bits to save
	mov	a,c	;invert mask for bits to change
	xri	0FFH
	mov	c,a
	mov	a,e
	ral
	ana	c	;A = new rotated bits
	ora	d	;restore old saved bits
	mov	m,a	;now lowest order byte is ready
			; and e still has original (for b7)
stret1:
	dcr b
	rm		;if just did lowest byte, done
	dcx	h	;-> next lower byte
	mov	a,e	;get b7 of last in carry
	ral
	mov	a,m	;get the original
	mov	e,a	;save for sake of b7
	ral
	mov	m,a	;change it
	jmp	stret1

;Table contains list of bits to double, in
; increasing order of priority
; First byte of each 2 byte entry is a mask
; for the low order bits to remain unaffected
; (which will include the doubled bit),
; and high byte is offset = 0,1,2,3,4,5 of the
; byte in cx48 where the doubled bit is to be found
;Present table values just to test
sttab:
	db	0FFH shr (27 mod 8), 27 / 8
	db	0FFH shr (35 mod 8), 35 / 8
	db	0FFH shr (45 mod 8), 45 / 8
; 9 points
	db	0FFH shr (36 mod 8), 36 / 8
	db	0FFH shr (21 mod 8), 21 / 8
	db	0FFH shr (30 mod 8), 30 / 8
;10 points
	db	0FFH shr (42 mod 8), 42 / 8
	db	0FFH shr (37 mod 8), 37 / 8
	db	0FFH shr (23 mod 8), 23 / 8
;11 points
	db	0FFH shr (25 mod 8), 25 / 8
	db	0FFH shr (47 mod 8), 47 / 8
	db	0FFH shr (38 mod 8), 38 / 8
;12 points
	db	0FFH shr (15 mod 8), 15 / 8
	db	0FFH shr (30 mod 8), 30 / 8
	db	0FFH shr (42 mod 8), 42 / 8
;13 points
	db	0FFH shr (25 mod 8), 25 / 8
	db	0FFH shr (15 mod 8), 15 / 8
	db	0FFH shr (32 mod 8), 32 / 8
;14 points
	db	0FFH shr (38 mod 8), 38 / 8
	db	0FFH shr (19 mod 8), 19 / 8
	db	0FFH shr ( 4 mod 8),  4 / 8
;15 points
	db	0FFH shr (34 mod 8), 34 / 8
	db	0FFH shr (45 mod 8), 45 / 8
	db	0FFH shr (13 mod 8), 13 / 8
;16 points

	END