Oakland CPM Archive

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 | 18.9 KB | 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