home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Oakland CPM Archive
/
oakcpm.iso
/
cpm
/
list
/
ep-src.ark
/
GSTR.MAC
< prev
next >
Wrap
Text File
|
1988-05-21
|
19KB
|
1,395 lines
include BDSYM.EQU
include EPDATA
.request SENDIT
; .request JUSTIFY now with prtsbuf
.request UNDERLI
.comment `
functions GSTR
(also internal COLUMNCHK, GPASS)
/************************************************/
/************************************************/
columnchk()
{
/* if not in multiple column mode, proceed normally */
if (!(nc || cc)) return(FALSE);
/* when all columns ready, print whole line */
if (cc >= nc || !nc)
{ outpoint += outbuf - xoutbuf;
outbuf = xoutbuf;
attrbuf = xattrbuf;
widbuf = xwidbuf;
return(FALSE);
}
/* otherwise, ready put next line into next column */
gotocol(llength + ir + gu);
outbuf += outpoint;
attrbuf += outpoint;
widbuf += outpoint;
/* save mode of previous column */
brcstk[cc][brcpt[cc]++] = mode;
cc++;
/* restore mode for next column */
modepop();
newoutline();
return(TRUE);
}
`
columnchk:
; /* if not in multiple column mode, proceed normally */
; if (!(nc || cc)) return(FALSE);
lda nc
mov l,a
lda cc
mov h,a
ora l
jnz $+7
shld mcoloffset ;global used in setting rule ends
ret
;
; /* when all columns ready, print whole line */
; if (cc >= nc || !nc)
;if nc 0, print
mov a,l
ora a
jz .clchk2
;nc (in A) > cc (in H)?
dcr a
cmp h
jnc .clchk3
; { outpoint += outbuf - xoutbuf;
.clchk2:
lxi h,0
shld mcoloffset
lhld outbuf
lxi d,xoutbuf
call cmd
dad d
xchg
lhld outpoint
dad d
shld outpoint
; outbuf = xoutbuf;
lxi h,xoutbuf
shld outbuf
; attrbuf = xattrbuf;
lxi h,xattrbuf
shld attrbuf
; widbuf = xwidbuf;
lxi h,xwidbuf
shld widbuf
; return(FALSE);
; }
xra a
ret
;
; /* otherwise, ready put next line into next column */
; gotocol(llength + ir + gu);
.clchk3:
lhld llength
xchg
lhld ir
dad d
xchg
lhld gu
dad d
push h ;pass to gotocol
xchg
lhld mcoloffset
dad d
shld mcoloffset
call gotocol##
pop d
; outbuf += outpoint;
; attrbuf += outpoint;
; widbuf += outpoint;
lhld outpoint
xchg
lhld outbuf
dad d
shld outbuf
xchg ;next are word arrays
dad h
xchg
lhld attrbuf
dad d
shld attrbuf
lhld widbuf
dad d
shld widbuf
; /* save mode of previous column */
; brcstk[cc][brcpt[cc]++] = mode;
call pshbrc
; cc++;
;; lhld cc
;; inx h
;; shld cc
lxi h,cc
inr m
; /* restore mode for next column */
; modepop();
; newoutline();
call modepop##
; call newoutline##
call nnewout
; return(TRUE);
;}
mvi a,1
ora a
ret
.comment `
/************************************************/
/* Output a line of characters */
/************************************************/
int gsti, tness;
char tripleh;
gstr()
{
/* if no characters, just go down one line */
if (!outpoint && outbuf == xoutbuf)
{ if (columnchk()) return;
skdots += PICA + sl;
newoutline();
return;
}
if (outpoint) justify();
if (columnchk()) return;
if (fa && unidir)
{ PTESCCH('U');
PTCH('0');
unidir = FALSE;
}
else
if (grfflag ^ unidir)
{ PTESCCH('U');
if (grfflag) PTCH('1'); else PTCH('0');
unidir = grfflag;
}
tripleh = (cheight >= (3 * PICA));
if (tallflag && cheight != (3 * PICA))
{
tness = (cheight <= PICA || duplflag) ? (2 * PICA) : cheight;
if (tness < (2 * PICA))
{ gsti = (2 * PICA) - tness;
if (skdots >= gsti) skdots -= gsti;
}
else if (tripleh)
{ gsti = PICA - (tness % PICA) - sl;
if (gsti > 0 && skdots >= gsti) skdots -= gsti;
}
paperup(tness - PICA + 3);
tabottom = FALSE;
if (tripleh)
{ if (tness > (5*PICA)) gpass(0);
if (tness > (4*PICA)) gpass(1);
gpass(2);
}
else
{ if (tness > (PICA + 2)) gpass(0);
if (tness > (PICA + 1)) gpass(1);
if (tness > PICA) gpass(2);
skdots += PICA - 4;
}
}
else if (tallflag) paperup(3 * PICA);
else paperup(3);
tabottom = TRUE;
nativeline();
gpass(0);
gpass(1);
gpass(2);
if (cheight < PICA)
skdots += cheight - 4;
else skdots += PICA - 4;
skdots += sl;
/* reset pointers, etc. */
if (nc && cc >= nc)
{ brcstk[cc][brcpt[cc]++] = mode;
cc = 1;
modepop();
}
if (!nc) cc = 0;
newoutline();
}
`
gstr::
; /* if no characters, just go down one line */
; if (!outpoint && outbuf == xoutbuf)
lhld outpoint
mov a,h
ora l
jnz .gs2
;flag new paragraph
lxi h,val + 54*('P'-'@') + 2*('P'-'@')
inr m
lhld outbuf
xchg
lxi h,xoutbuf
call eqwel
jnz .gs2
; { if (columnchk()) return;
call columnchk
rnz
; skdots += PICA + sl;
.gs1:
;use paragraph-spacing
; lhld sl
; lxi d,PICA
; dad d
;RULES!
lhld val + 54*('P'-'@') + 2*('S'-'@')
call docvrule
;; xchg
;; lhld skdots
;; dad d
;; shld skdots
; newoutline();
; return;
; }
jmp newoutline##
;
; if (outpoint) justify();
.gs2: lhld outpoint
mov a,h
ora l
cnz justify##
;
; if (columnchk()) return;
call columnchk
rnz
;
; if (fa && unidir)
.gs4:
push b
;henceforth C = tness
lda fa
ora a
jz .gs5
lda unidir
ora a
jz .gs5
; { PTESCCH('U');
; PTCH('0');
; unidir = FALSE;
; }
mvi a,'U'
call presc1##
mvi a,'0'
call pr1##
xra a
sta unidir
jmp .gs8
; else
; if (grfflag ^ unidir)
.gs5: lda grfflag
mov l,a
lda unidir
xra l
jz .gs8
; { PTESCCH('U');
; if (grfflag) PTCH('1'); else PTCH('0');
mvi a,'U'
call presc1##
; lda grfflag
mov a,l
sta unidir ;cf. below
ora a
mvi a,'1'
jnz .gs6
;; mvi a,'0'
dcr a
.gs6: call pr1##
; unidir = grfflag;
; }
; lda grfflag
; sta unidir
;
; tripleh = (cheight >= (3 * PICA));
.gs8:
lhld cheight
shld _savheight
lda duplflag
ora a
; jz .gs8b
;10/86 change
jz .gs8a
mvi e,1
call shlrbe
mov a,l
cpi PICA+1 ;was 2 * PICA
mvi a,0
jc .gs8a
shld cheight
inr a
inr a
.gs8a: sta tduplex
.gs8b: lda cheight
cpi 3 * PICA
mvi a,0
sta afterdup
jc .gs8e
inr a
.gs8e: sta tripleh
;
; if (tallflag && cheight != (3 * PICA))
; {
lda tallflag
ora a
jz .gs22
lda cheight
cpi 3 * PICA
jz .gs22
; tness = (cheight <= PICA || duplflag) ? (2 * PICA) : cheight;
mvi h,2 * PICA ;min val
mov l,a ;(cheight)
cpi PICA + 1
;(it turns out we do want duplex < 16p high)
jc .gs9
lda tduplex
ora a
jnz .gs11
lda duplflag
ora a
jz .gs11
;back up (16p - cheight)/2
mov a,h
sub l
ora a
jm .gs9
rar
sta afterdup
add l
mov h,a
.gs9: mov l,h ;(2 * PICA)
.gs11: mov c,l
;
; if (tness < (2 * PICA))
mov a,c
cmp h ;(2 * PICA)
jnc .gs13
; { gsti = (2 * PICA) - tness;
; if (skdots >= gsti) skdots -= gsti;
; }
mov a,h
sub l
mov e,a
mvi d,0
;DE = (2 * PICA) - tness
call cmd
lhld skdots
dad d
;if >= 0, is new skdots
mov a,h
ora a
jm .gs14
jmp .gs13a ;go store in skdots
; else if (tripleh)
.gs13: lda tripleh
ora a
jz .gs14
; { gsti = PICA - (tness % PICA) - sl;
;(L = tness)
mvi h,0
lxi d,pica
xchg
call smod
;HL = tness % PICA
xchg
lhld sl
dad d
call cmh
;HL = - (tness % PICA) - sl
lxi d,PICA
dad d
; if (gsti > 0 && skdots >= gsti) skdots -= gsti;
; }
;(ok if 0)
mov a,h
ora a
jm .gs14
xchg
call cmd
lhld skdots
dad d
;HL = skdots - "gsti"
mov a,h
ora a
jm .gs14
.gs13a: shld skdots
;
; paperup(tness - PICA + 3);
.gs14:
mov l,c
mvi h,0
lxi d,- PICA + 3
dad d
push h
call paperup##
pop d
;
; tabottom = FALSE;
xra a
sta tabottom
;
; if (tripleh)
lda tripleh
ora a
jz .gs17
; { if (tness > (5*PICA)) gpass(0);
mov a,c
cpi 5*PICA + 1
jc .gs15
xra a
call gpass
; if (tness > (4*PICA)) gpass(1);
.gs15:
mov a,c
cpi 4*PICA + 1
jc .gs16
mvi a,1
call gpass
; gpass(2);
; }
.gs16: mvi a,2
call gpass
jmp .gs21
; else
; { if (tness > (PICA + 2)) gpass(0);
.gs17:
mov a,c
cpi PICA + 2 + 1
jc .gs18
xra a
call gpass
; if (tness > (PICA + 1)) gpass(1);
.gs18:
mov a,c
cpi PICA + 1 + 1
jc .gs19
mvi a,1
call gpass
; if (tness > PICA) gpass(2);
.gs19:
mov a,c
cpi PICA + 1
jc .gs20
mvi a,2
call gpass
; skdots += PICA - 4;
; }
;
; }
.gs20: lhld skdots
lxi d,PICA - 4
dad d
shld skdots
.gs21: jmp .gs24
; else if (tallflag) paperup(3 * PICA);
.gs22: lda tallflag
ora a
lxi h,3
jz .gs23
lxi h,3*PICA
; else paperup(3);
.gs23: push h
call paperup##
pop d
;
; tabottom = TRUE;
.gs24:
mvi a,1
sta tabottom
;
; nativeline();
; gpass(0);
; gpass(1);
; gpass(2);
call inover##
.gs24.1:
lxi d,-PICA
dad d
mov a,h
ora a
jm .gs24.2
push h
mvi a,' '
call termput##
pop h
jmp .gs24.1
.gs24.2:
call nativeline##
xra a
call gpass
mvi a,1
call gpass
mvi a,2
call gpass
;
; if (cheight < PICA)
lhld skdots
xchg
lxi h,PICA - 4
;*** change this, since cheight may > 255 with big duplex chars ***
lda cheight
cpi PICA+1
;; jnc .gs25
jc .gs25.1
lda duplflag
ora a
jz .gs25.3
lda afterdup
cma
inr a
add l
jmp .gs25.2
;$afterdup: db 0
;$_savheight: dw 0
;$tduplex: db 0
.gs25.1:
; skdots += cheight - 4;
dcr a
dcr a
dcr a
dcr a
.gs25.2:
mov l,a
;HL = cheight - 4
; else skdots += PICA - 4;
.gs25.3:
dad d
;
; skdots += sl;
;.gs26:
;; xchg
;interline RULES!
;; lhld sl
;; dad d
shld skdots
;for lines with duplex characters > 16 points high,
; do all passes twice, once with tduplex=2, then with tduplex=1
lxi h,tduplex
dcr m
jm $+6
jnz .gs8b
lhld _savheight
shld cheight
lhld sl
call docvrule
;
; /* reset pointers, etc. */
; if (nc && cc >= nc)
lda nc
ora a
jz .gs27
mov l,a
lda cc
cmp l
jc .gs27
; { brcstk[cc][brcpt[cc]++] = mode;
call pshbrc
; cc = 1;
; modepop();
; }
lxi h,1
shld cc
call modepop##
; if (!nc) cc = 0;
.gs27: lda nc
ora a
jnz .gs28
lxi h,0
shld cc
; newoutline();
;}
.gs28:
call nnewout
pop b
ret
nnewout:
lda nospec
ora a
jnz newoutline##
lxi h,0
shld val + 54*('P'-'@') + 2*('P'-'@')
shld val + 54*('L'-'@') + 2*('A'-'@')
shld val + 54*('U'-'@') + 2*('N'-'@')
shld val + 54*('I'-'@') + 2*('L'-'@')
jmp newoutline##
pshbrc::
lhld cc
lxi d,12
call usmul
lxi d,brcstk
dad d
push h
lhld cc
dad h
lxi d,brcpt
dad d
mov e,m
inx h
mov d,m
inx d
mov m,d
dcx h
mov m,e
dcx d
xchg
dad h
pop d
dad d
xchg
lhld mode
xchg
mov m,e
inx h
mov m,d
ret
;gsti: dw 0 not used
;tness: dw 0 kept in C
;$tripleh: db 0
.comment `
/************************************************/
/* Do one of three passes necessary to print */
/* a line of graphics characters */
/************************************************/
gpass(pass)
int pass;
{
if (!grfflag || (fa && pass != 1))
{ skdots++; return; }
/* assume no dots */
gpoint = 0;
setmem(gbuf, 2000, 0);
/* store the dots for each character */
for (gsti = 0; gsti < outpoint; gsti++) gchr(gsti, pass);
/* kern for possible italic in last col & right trim */
while (gbuf[gpoint++] || gbuf[gpoint++]);
while (gpoint >= 0 && !gbuf[gpoint]) gpoint--;
gpoint++;
/* underlining goes in 2nd row of dots from bottom */
if (pass == 2 && tabottom) underline();
/* now send it out */
sendit();
if (tripleh)
{ sendit();
sendit();
skdots += PICA - 4;
}
}
`
gpass:
;(made internal with arg 'pass' in A)
; pop d
; pop h
; push h
; push d
;
; mov a,l
sta _gpass
push b
; if (!grfflag || (fa && pass != 1))
lda grfflag
ora a
jz .gp1
lda fa
ora a
jz .gp2
lda _gpass
dcr a
jz .gp2
; { skdots++; return; }
;
.gp1: lhld skdots
inx h
shld skdots
pop b
ret
;
; /* assume no dots */
; gpoint = 0;
.gp2:
;; lxi h,0
;; shld gpoint
;zeroing of gbuf and (gpoint) now done in dohrule
;signal this is not an interline call
xra a
call dohrule
;
; /* store the dots for each character */
; for (gsti = 0; gsti < outpoint; gsti++) gchr(gsti, pass);
;BC = gsti
lxi b,0
.gp3:
mov d,b
mov e,c
lhld outpoint
call albs
jnc .gp4
lda _gpass
mov l,a
mvi h,0
push h
push b
call gchr##
pop d
pop d
inx b
jmp .gp3
;
; /* kern for possible italic in last col & right trim */
; while (gbuf[gpoint++] || gbuf[gpoint++]);
;BC = gpoint
.gp4:
lxi h,GBUFSIZ-1
;;; lhld gpoint
mov b,h
mov c,l
lxi d,gbuf
dad d
;;;.gp5:
;;; mov a,m
;;; inx h
;;; inx b
;;; ora a
;;; jnz .gp5
;;; mov a,m
;;; inx h
;;; inx b
;;; ora a
;;; jnz .gp5
; while (gpoint >= 0 && !gbuf[gpoint]) gpoint--;
.gp6:
;BC = gpoint
mov a,b
ral
jc .gp7
mov a,m
ora a
jnz .gp7
dcx h
dcx b
jmp .gp6
; gpoint++;
.gp7: inx b
mov h,b
mov l,c
shld gpoint ;(underline & sendit use gpoint)
;
; /* underlining goes in 2nd row of dots from bottom */
; if (pass == 2 && tabottom) underline();
lda _gpass
cpi 2
jnz .gp8
lda tduplex
cpi 2
jz .gp8
lda tabottom
ora a
cnz underline##
;
; /* now send it out */
; sendit();
.gp8:
call bumpgpt
call sendit##
;
; if (tripleh)
; { sendit();
; sendit();
; skdots += PICA - 4;
; }
pop b
lda tripleh
ora a
rz
lda tallflag
ora a
rz
call sendit##
call sendit##
lda tduplex
cpi 2
jnz .gpnnx
lda _gpass
cpi 2
jnz .gpnnx
lda cheight
cpi 3 * PICA
rz
.gpnnx:
lhld skdots
lxi d,PICA - 4
dad d
shld skdots
ret
;}
.gpX: pop b
ret
;in case there was a rule drawn, maybe increase gpoint
bumpgpt::
lhld maxgpt
xchg
lhld gpoint
call albu
rc
xchg
shld gpoint
ret
clrgbuf::
;init maxgpt (for last of last rule)
call inover##
shld gpoint
lxi h,0
shld maxgpt
; setmem(gbuf, 2000, 0);
mov e,l ;(0)
lxi h,gbuf
lxi b,GBUFSIZ
.gp2a: mov m,e
inx h
dcx b
mov a,b
ora c
jnz .gp2a
ret
;$_gpass: db 0
;$maxgpt: dw 0
;$nvdots: db 0
dohrule:
sta nvdots
call clrgbuf
;examine each rule to see if it's defined and horizontal
mvi b,NUMRULES
lxi h,rulist-2
lda nospec
ora a
jz .dhr0
mvi b,NUMRULES-24
lxi h,rulist + 4*24 - 2
.dhr0: inx h
inx h
.dhr1: dcr b ;looked at all possible rules?
rm
;examine left endpoint
mov a,m
inx h
ora m
mov a,m
inx h
jz .dhr0 ;no rule here
;here's a rule, but is it horizontal?
;if b15, we left a mark meaning vertical rule has been started
ani 80h
jz .dhr1.1
;save rulist pointer for return to loop
push h
;get the endpoint (without b15)
push h
dcx h
mov a,m
ani 7fh
mov d,a
dcx h
mov e,m
;assume solid, for continuing
mvi c,0ffh
;get back pointer to test second word
pop h
;check not interline
lda nvdots
ora a
jz .dhr1.1b
;here it's a continuing interline vertical
;calculate dot pattern from nvdots requested
mov l,a
mvi a,80h
call vdotpat
mov c,a
jmp .dhr1.1c
;one dot at top for every 3 dots of skip (at least one)
vdotpat:
dcr l
rz
dcr l
rz
dcr l
rz
rm
rar
ori 80h
jmp vdotpat
.dhr1.1b:
;test second word at HL
mov a,m
inx h
ora m
jz .dhr1.1c
;don't terminate verticals in tops of tall characters
lda tabottom
ora a
jz .dhr1.1c
;if something else was put there, terminate the v. rule
mvi c,0f0h ;top only
;(but shouldn't we wait 'til third pass?? ((if not fast)))
lda _gpass
cpi 2
jnz .dhr1.1c
xra a
mov m,a
dcx h
mov m,a
dcx h
mov m,a
dcx h
mov m,a
.dhr1.1c:
;check no tops or bottoms flag
lda val + 54*('R'-'@') + 2*('H'-'@') + 1
ani 2
cz vdotset
pop h
jmp .dhr0
.dhr1.1:
;don't do any horizontals or start verticals if interline
lda nvdots
ora a
jnz .dhr0
;likewise if not tabottom
lda tabottom
ora a
jz .dhr0
;examine right endpoint to see if it's a horizontal
mov a,m
inx h
ora m
inx h
jnz .dhr1.2
;here we want to start a new vertical
push h
dcx h
dcx h
dcx h
lda fa
dcr a
jz $+8
lda _gpass
cpi 2
mov a,m
mov d,a
;mark as started
;(but don't mark on pass 0,1 else will look continuing on pass 1,2)
jnz $+5
ori 80h
mov m,a
dcx h
mov e,m
;check no tops or bottoms flag
lda val + 54*('R'-'@') + 2*('H'-'@') + 1
ani 2
jnz $+8
mvi c,0fh
call vdotset
;loop
pop h
jmp .dhr1
;called by draw with acc = num of dots
vvdotset::
push b
jmp $+7
vdotset:
push b
lda val + 54*('R'-'@') + 2*('V'-'@')
mov b,a
.vds1:
call sublind
jnc .vdsx
mov a,m
ora c
mov m,a
;; inx d
inx d
dcr b
jp .vds1
pop b
jmp notemxg
.vdsx: pop b
ret
sublind:
lxi h,gbuf
dad d
push h
;check offset of corrected endpoint
lxi h,GBUFSIZ
call albu
pop h
ret
.dhr1.2:
;check thick flag
lda val + 54*('R'-'@') + 2*('H'-'@') + 1
ani 1
jnz $+10
lda _gpass
dcr a
jnz .dhr1
;yes, here we have one horizontal to do
; save rulist pointer and count
push b
push h
;get back right endpoint and undefine
xra a
dcx h
mov d,m
mov m,a
dcx h
mov e,m
mov m,a
push d
;now left
dcx h
mov d,m
mov m,a
dcx h
mov e,m
mov m,a
;get back right
pop h
;and save left
push d
;sigh, ...save right now
push h
;how long is it? that's: right - left
call cmd
dad d
;and this is the count
mov b,h
mov c,l
;use right to set maximal rule point
;note maximal rule dot
pop d
;too big?
call sublind
;; lxi h,GBUFSIZ
;; call albu
jc $+7
pop d ;bad -- discard left and abort
jmp .dhr3
;ok -- mark up gpoint
call notemxg
;now use left to find starting place in gbuf
pop d
call sublind
;; lxi h,gbuf
;; pop d
;; dad d
;get the requested pattern
lda val + 54*('R'-'@') + 2*('H'-'@')
mov e,a
;get the mask
lda val + 54*('R'-'@') + 2*('H'-'@') + 1
rar
ani 07eh
mov d,a
;now loop to store
; done?
.dhr2:
mov a,b
ora c
jz .dhr3
mov a,l
ana d
jnz $+4
mov m,e
inx h
dcx b
jmp .dhr2
.dhr3:
;restore rulist pointer and rule count
pop h
pop b
;go back and do next rule
jmp .dhr1
notemxg:
lhld maxgpt
call albu
rc
mov h,d
mov l,e
inx h
shld maxgpt
ret
;do continuing verticals for interline, or just
;skip down be leading, if none
;assume required skips in HL
;(called twice from above and also from cseq for \sk)
docvrule::
mov a,h
ora l
rz
;do at most 8 points at a time
xchg
lxi h,PICA+1
call albu
jc .cv1
call cmh
dad d
push h
lxi d,PICA
call .cv1
pop h
jmp docvrule
.cv1:
push d
mov a,e
call dohrule
lhld maxgpt
mov a,h
ora l
pop d
jz .cvskip
;so sendit sends enough
shld gpoint
push d
push d
call paperup##
pop d
;if was page break, quit
lhld vposition
xchg
lhld tm
inx h
call albu
pop d
rc
;(DE has orig. arg -- for now, assume <= 24 points)
push d
;loop to print it
mvi d,3
.cvLoop:
push d
call sendit##
pop d
dcr d
jnz .cvLoop
;now how far to skip to get below the rules?
pop d
;we've gone down 3 dots already
dcx d
dcx d
dcx d
;add rest to skips
.cvskip:
lhld skdots
dad d
shld skdots
ret
end