Oakland CPM Archive

home *** CD-ROM | disk | FTP | other *** search

/ Oakland CPM Archive / oakcpm.iso / cpm / list / ep-src.ark / PAPERUP.MAC < prev next >

Wrap

Text File | 1988-05-21 | 11.5 KB | 854 lines

include BDSYM.EQU include EPDATA .comment ` functions PAPERUP, DOPAGENO /************************************************/ /* Move print head to beginning of line and down*/ /* accumulated 'skdots' */ /************************************************/ paperup(needmore) int needmore; { /* here page */ if (skdots < 0) if (mx) skdots = 0; else { if (vposition + skdots < 0) skdots = -vposition; vposition += skdots; while (skdots <= -216) { PTESCCH('j'); PTCH(216); skdots += 216; } if (skdots < 0) { PTESCCH('j'); PTCH(-skdots); } skdots = 0; } if (vposition + skdots + needmore + bm > pl) { if (!fm) skdots = pl - vposition + tm; else { skdots = pl - bm + fm - vposition; vposition = 0; dopageno(); skdots += bm - vposition + tm; } vposition = tm; } else vposition += skdots; while (skdots >= 216) { PTESCCH('J'); PTCH(216); skdots -= 216; } if (!skdots) return; PTESCCH('J'); PTCH(skdots); skdots = 0; } ` ;call paperup before printing a line, to do accumulated skips and ; if necessary, footing and heading lines paperup:: pop d pop h push h push d ;if called while doing a title, don't trigger page break lda nospec ora a jnz ejct ;if this will be the first line of a paragraph, add ; widow threshhold to needmore lda val + 54*('P'-'@') + 2*('P'-'@') ora a jz .ppm1 xchg lhld val + 54*('W'-'@') + 2*('I'-'@') dad d .ppm1: push h ;save needmore ;if vposition is -1, this is the very first time we are being ; called, so initialize vposition, and do top of page business lhld vposition inx h mov a,h ora l jnz .tti0 ;init _savec lda ec sta _savec lhld tm xchg lhld hm call cmh dad d shld vposition lhld skdots push h lxi h,0 shld skdots call ttitle pop d lhld skdots dad d shld skdots .tti0: pop h call ejct ;call ttitle to check if time to print heading, and if so do it ttitle: ;also, here is a good place to set noprint flag, if pn is out of range ;(well, it's a place, anyway) lhld pn xchg ; before beginning page? lhld bp mov a,h ora l jz .pchk2 call albu mvi a,0 jc .pchk3 ;(noprint) ; after ending page? .pchk2: lhld ep mov a,h ora l jz .pchk4 call blau ;c if pn > ep mvi a,0 jnc .pchk4 ;(yes print) .pchk3: inr a .pchk4: sta noprint ;see if time to print heading lda hdgdone ora a rnz ;otherwise, if heading is not requested, just skip down to tm lhld hm mov a,h ora l ;if hm = 0, no heading ;... (this doesn't seem necessary -- would have done the 'rnc' above) ;- jz .tti1 ;try just ret, instead: rz ;else do heading ;now print the heading lhld val + 2*('H'-'@') call dopageno ;and set the flag lxi h,hdgdone inr m ;here set skips to to tm .tti1: lhld vposition xchg lhld skdots dad d call cmh xchg lhld tm dad d ;now HL is additional distance to skip to get down to tm ;don't skip up and print text over heading MOV A,H ORA A RM xchg lhld skdots dad d shld skdots ;and go do them jmp .pu9 ;; jmp .pu10 ;;?? ret ;call ejct to do a conditional page ;(called once at very end from epm) ejct:: ;save needmore shld needmore ; if (skdots < 0) ; if (mx) skdots = 0; lhld skdots mov a,h ral jnc .pu6 lda mx ora a jz .pu1 lxi h,0 shld skdots jmp .pu6 ; else ; { ; if (vposition + skdots < 0) skdots = -vposition; .pu1: lhld vposition xchg lhld skdots dad d mov a,h ral jnc .pu2 lhld vposition call cmh shld skdots ; vposition += skdots; .pu2: lhld vposition xchg lhld skdots dad d shld vposition ; while (skdots <= -216) .pu3: lhld skdots lxi d,VINCH-1 dad d mov a,h ral jnc .pu4 ; { PTESCCH('j'); PTCH(216); ; skdots += 216; ; } mvi a,'j' call presc1## mvi a,VINCH call pr1## lhld skdots lxi d,VINCH dad d shld skdots jmp .pu3 ; if (skdots < 0) .pu4: lhld skdots mov a,h ral jnc .pu5 ; { PTESCCH('j'); PTCH(-skdots); ; } ; skdots = 0; ; } mvi a,'j' call presc1## lhld skdots call cmh mov a,l call pr1## .pu5: lxi h,0 shld skdots ; ; if (vposition + skdots + needmore + bm > pl) ;see if time to do bottom of page action .pu6: ;never print footing when doing heading or footing lda nospec ora a jnz .pu9 lhld vposition xchg lhld skdots dad d xchg lhld needmore dad d xchg lhld bm dad d xchg lhld pl call agbs jnc .pu9 ;here it's time for a page break ;signal that we're going to want a heading on next page xra a sta hdgdone ;now see if we have to print a footing ; { if (!fm) skdots = pl - vposition + tm; lhld fm mov a,h ora l jnz .pu7 ;no, no footing, so set skips to first line of next page ; (rest of this page and down to hm-tm on next) lhld pl xchg lhld vposition call cmh dad d xchg lhld tm dad d xchg lhld hm call cmh dad d shld skdots ;now go set vposition jmp .pu8 ; else ; { skdots = pl - bm + fm - vposition; ;here we have to print a footing, so ; set skips down to that place .pu7: lhld pl xchg lhld bm call cmh dad d xchg lhld fm dad d xchg lhld vposition call cmh dad d shld skdots ; vposition = 0; ; dopageno(); ; skdots += bm - vposition + tm; ;... and - hm ; } ;now do the footing line ;arg is address of '$f', which if 0 will give def. centered page num. lhld val + 2*('F'-'@') call dopageno ;next page number lhld pn inx h shld pn ;set to skip over rest of this page, and down to first line of next lhld pl xchg lhld vposition call cmh dad d ;check over past bm here? xchg lhld tm dad d xchg lhld hm call cmh dad d ;(not this many ADDITIONAL dots -- just this many) ;- xchg ;- lhld skdots ;- dad d shld skdots ; vposition = tm; ;... - hm ; } ;now set vposition to what it will be when we're done doing the ; skips that have accumulated in 'skdots' .pu8: ;here we're going to be on first line of next page lhld tm xchg lhld hm call cmh dad d shld vposition jmp .pu10 ; else vposition += skdots; ;here we didn't hit a page break, so just add the skips in .pu9: lhld vposition xchg lhld skdots dad d shld vposition ; ; ; while (skdots >= 216) ;now do the downward skips, first by inches, then the remainder .pu10: lhld skdots push h .pu10.0: lxi d,-PICA*2 dad d mov a,h ora a jm .pu10.1 push h lxi h,0 mvi a,newlin call termput## pop h jmp .pu10.0 .pu10.1: pop h lxi d,-VINCH dad d mov a,h ral jc .pu11 ; { PTESCCH('J'); PTCH(216); ; skdots -= 216; ; } mvi a,'J' call presc1## mvi a,VINCH call pr1## lhld skdots lxi d,-VINCH dad d shld skdots jmp .pu10 ; ; if (!skdots) return; .pu11: lhld skdots mov a,h ora l rz ; ; PTESCCH('J'); PTCH(skdots); .pu12: mvi a,'J' call presc1## lda skdots call pr1## ; ; skdots = 0; ;} lxi h,0 shld skdots ret needmore: dw 0 ;flag to remember whether have put a heading on current page yet hdgdone: db 0 ;(initially: no) .comment ` int soutpoint, sglen, slindent, snc, scc, sllength, sdpmode; char sepsflag, sgrfflag, sduplflag, stallflag; dopageno() { outbuf += outpoint+20; attrbuf += outpoint+20; widbuf += outpoint+20; soutpoint = outpoint; slindent = lindent[cc]; sglen = glen; snc = nc; scc = cc; sllength = llength; sepsflag = epsflag; sgrfflag = grfflag; stallflag = tallflag; sduplflag = duplflag; glen = outpoint = lindent[0] = nc = cc = 0; epsflag = grfflag = tallflag = duplflag = FALSE; llength = ll - ir; sdpmode = mode; mode = 0x100; stowc(CEFLAG); inject(pn); gstr(); outbuf = xoutbuf; attrbuf = xattrbuf; widbuf = xwidbuf; outpoint = soutpoint; nc = snc; cc = scc; lindent[cc] = slindent; glen = sglen; llength = sllength; epsflag = sepsflag; grfflag = sgrfflag; tallflag = stallflag; duplflag = sduplflag; mode = sdpmode; pn++; } ` dopageno:: ; outbuf += outpoint+20; ; attrbuf += outpoint+20; ; widbuf += outpoint+20; ;save address of heading string shld _hdgstrng ;flag disable global print mode features lxi h,nospec mov a,m ora a rnz mvi m,1 lhld outpoint push h xchg lhld endovr call albu jnc $+4 xchg ;if outpoint < endovr, use latter ; lxi d,20 ; dad d ; xchg lhld outbuf push h dad d shld outbuf xchg dad h xchg lhld attrbuf push h dad d shld attrbuf lhld widbuf push h dad d shld widbuf ; soutpoint = outpoint; ; slindent = lindent[cc]; (need only save indent[0]) ; sglen = glen; lhld lindent push h lhld glen push h ; snc = nc; scc = cc; lhld nc push h lhld cc push h ; sllength = llength; lhld llength push h ; sepsflag = epsflag; ; sgrfflag = grfflag; ; stallflag = tallflag; ; sduplflag = duplflag; lda brkflag push psw lxi h,bkaft mov a,m mvi m,0 push psw lda epsflag push psw lda grfflag push psw lda tallflag push psw lda duplflag push psw ; ;following added in case of internal break in head or foot lhld co push h lhld ju push h lhld endovr push h lhld begovr push h ;and still more lhld bo push h lhld st push h lhld sh push h lhld cheight push h lhld cs push h lhld sl push h lhld ke push h lhld cw push h lhld be push h lhld align push h lhld uc push h ;must have standard escape char lhld ec push h lda _savec sta ec ; ; glen = outpoint = lindent[0] = nc = cc = 0; lxi h,0 shld co shld ju shld cc shld nc ; shld lindent ; shld outpoint ; shld glen shld uc shld align shld be shld cw shld ke shld sh shld st shld bo lxi h,POINT shld cs dad h shld sl lxi h,PICA shld cheight ; epsflag = grfflag = tallflag = duplflag = FALSE; ;(done in newoutline) ; ; sdpmode = mode; mode = 0x100; lhld mode push h ;default print mode is font 1 with all style mod's off lxi h,0100H shld mode call newoutline## ;if '$footing' or '$heading' defined, use it lhld _hdgstrng mov a,h ora l jz .dpg1 call shfdirect## call processline## call shfdown## jmp .dpg2 ; ; stowc(CEFLAG); .dpg1: ; call newoutline## lxi h,ceflag push h call stowc## pop d ; inject(pn); lhld pn push h call inject## pop d ; gstr(); .dpg2: call gstr## ;restoring now done off stack ; ; outbuf = xoutbuf; ; attrbuf = xattrbuf; ; widbuf = xwidbuf; ;;etc. pop h shld mode pop h shld ec pop h shld uc pop h shld align pop h shld be pop h shld cw pop h shld ke pop h shld sl pop h shld cs pop h shld cheight pop h shld sh pop h shld st pop h shld bo pop h shld begovr pop h shld endovr pop h shld ju pop h shld co pop psw sta duplflag pop psw sta tallflag pop psw sta grfflag pop psw sta epsflag pop psw sta bkaft pop psw sta brkflag pop h shld llength pop h shld cc pop h shld nc pop h shld glen pop h shld lindent pop h shld widbuf pop h shld attrbuf pop h shld outbuf pop h shld outpoint ; pn++; ;} ;now incr pn in ejct above ; lhld pn ; inx h ; shld pn ;flag re-enable global print mode features xra a sta nospec ret _hdgstrng: dw 0 _savec: db 0 end