Oakland CPM Archive

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

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

Wrap

Text File | 1988-05-21 | 16.9 KB | 1,255 lines

include BDSYM.EQU include EPDATA .comment ` /************************************************/ /* Called when there are enough characters in */ /* outbuf to make up a line. */ /* Determines how many of these should be */ /* printed, prints them, and moves the */ /* remainder back so they will be part of */ /* next line */ /************************************************/ prtsbuf() { int /* endcol, begcol,*/ i, savlen; char c; /* debug */ /*printf("\n .IN is %d; lindent is %d.", in, lindent);*/ /* If no char's, or char's with no width, just reset values */ if (!outpoint || !glen) {newoutline(); return;} /* If break, print it all */ if (brkflag || !co || nc) {gstr(); return;} /* Determine how much to print */ /* later when move unprinted stuff back, stop here */ endovr = outpoint; /* go back and find first preceding word break */ while (outpoint && (c = outbuf[--outpoint]) != ' ' && c != SOFTHY) glen -= widbuf[outpoint]; /* save in case can't find any word break */ savlen = glen; /* later when move unprinted stuff back, start here */ begovr = outpoint + 1; /* trim off interword spaces */ while (outpoint >= 0 && outbuf[outpoint] == ' ') { glen -= widbuf[outpoint]; outpoint--; } /* maybe line all tabs or SP from gotocol */ if (!glen || outpoint < 0) {newoutline(); return; } /* if it was soft hyphen, substitute real one */ if (c == SOFTHY) { outbuf[outpoint] = '-'; /* and correct width */ glen += widbuf[outpoint]; } /* print up to first interword space or through '-' */ if (outpoint) outpoint++; else {outpoint = begovr = endovr - 1; glen = savlen;} /* debug */ putchar('\n'); /* Print it */ gstr(); /* Move back remainder */ while (begovr < endovr) { glen += widbuf[outpoint] = widbuf[begovr]; attrbuf[outpoint] = attrbuf[begovr]; outbuf[outpoint++] = outbuf[begovr++]; } } ` prtsbuf:: push b ;BC not used yet ; /* If no char's, or char's with no width, just reset values */ ; if (!outpoint || !glen) ; {newoutline(); return;} lhld outpoint mov a,h ora l jz .pb9 ;added 1/12/85 ;; jz .pb1 lhld glen mov a,h ora l jz .pb9 ;added 1/12/85 (.pb9 = .pb1) ;; jnz .pb2 ;; ;;.pb1: call newoutline## ;; pop b ;; ret ; ; /* If break, print it all */ ; if (brkflag || !co || nc) {gstr(); return;} .pb2: lda brkflag ora a jnz .pb3 lda co ora a jz .pb3 lda nc ora a jz .pb4 .pb3: call gstr## pop b ret ; ; /* Determine how much to print */ ; /* later when move unprinted stuff back, stop here */ ; endovr = outpoint; .pb4: ;[Save original glen here in case justify wants a tight line] lhld glen shld biglen lhld outpoint shld endovr ;no before break spaces yet lxi h,0 shld jbspaces shld jblen ; /* go back and find first preceding word break */ ; while (outpoint && (c = outbuf[--outpoint]) != ' ' ; && c != SOFTHY) ; glen -= widbuf[outpoint]; .pb5: lhld outpoint mov a,h ora l jz .pb6 lhld outbuf xchg lhld outpoint dcx h shld outpoint dad d mov a,m sta jbchar cpi ' ' jz .pb6 cpi SOFTHY jz .pb6 lhld widbuf xchg lhld outpoint dad h dad d mov e,m inx h mov d,m call cmd lhld glen dad d shld glen jmp .pb5 ; ; /* save in case can't find any word break */ ; savlen = glen; .pb6: lhld glen shld savlen ; /* later when move unprinted stuff back, start here */ ; begovr = outpoint + 1; lhld outpoint inx h shld begovr ; /* trim off interword spaces */ ; while (outpoint >= 0 && outbuf[outpoint] == ' ') ; { glen -= widbuf[outpoint]; ; outpoint--; ; } .pb7: lhld outpoint mov a,h ral jc .pb8 xchg lhld outbuf dad d mov a,m cpi ' ' jnz .pb8 lxi h,jbspaces inr m lhld widbuf xchg lhld outpoint dad h dad d mov e,m inx h mov d,m lhld jblen dad d shld jblen ;now wait and subtract total jblen ; call cmd ; lhld glen ; dad d ; shld glen lhld outpoint dcx h shld outpoint jmp .pb7 ; ; /* maybe line all tabs or SP from gotocol */ ; if (!glen || outpoint < 0) {newoutline(); return; } .pb8: ;now first update glen lhld jblen call cmh xchg lhld glen dad d shld glen mov a,h ora l jz .pb9 lhld outpoint mov a,h ral jnc .pb10 .pb9: call newoutline## pop b ret ; ; /* if it was soft hyphen, substitute real one */ ; if (c == SOFTHY) .pb10: lda jbchar cpi SOFTHY jnz .pb11 ; { outbuf[outpoint] = '-'; ; /* and correct width */ ; glen += widbuf[outpoint]; ; } lhld outbuf xchg lhld outpoint dad d ;but if there's already a real hyphen before it, just leave the soft one dcx h mov a,m inx h cpi '-' jz .pb11 mvi m,'-' lhld widbuf xchg lhld outpoint dad h dad d mov e,m inx h mov d,m lhld glen dad d shld glen ; ; /* print up to first interword space or through '-' */ ; if (outpoint) outpoint++; .pb11: lhld outpoint mov a,h ora l jz .pb12 inx h shld outpoint jmp .pb13 ; else {outpoint = begovr = endovr - 1; glen = savlen;} .pb12: lhld endovr dcx h shld begovr shld outpoint lhld savlen shld glen ; ;/* debug */ ;putchar('\n'); .pb13: ;(now gstr puts nl) ; /* Print it */ ; gstr(); call gstr## ; ; /* Move back remainder */ ; while (begovr < endovr) .pb14: lhld begovr xchg lhld endovr call albu ;(was albs) jnc .pb16 ; { glen += widbuf[outpoint] = widbuf[begovr]; lhld widbuf xchg lhld outpoint dad h dad d push h lhld widbuf xchg lhld begovr dad h dad d mov e,m inx h mov d,m pop h mov m,e inx h mov m,d lhld glen dad d shld glen ; attrbuf[outpoint] = attrbuf[begovr]; lhld attrbuf xchg lhld outpoint dad h dad d push h lhld attrbuf xchg lhld begovr dad h dad d mov e,m inx h mov d,m pop h mov m,e inx h mov m,d ; outbuf[outpoint++] = outbuf[begovr++]; ; } lhld outbuf xchg lhld outpoint inx h shld outpoint dcx h dad d push h lhld outbuf xchg lhld begovr inx h shld begovr dcx h dad d mov e,m pop h mov m,e jmp .pb14 ;} .pb16: pop b ret savlen: dw 0 ;length of line if made tight: biglen: dw 0 ;number of spaces before the break word: jbspaces: dw 0 ;length of these spaces jblen: dw 0 ;char that made the break jbchar: db 0 ;/********************************************************/ ;/* Add enough width to the spaces to line up on right */ ;/********************************************************/ ; int jui, juspcs, cepos, rapos, adds0, adds1, addsb; ; char juc; ; ; FUNCTION JUSTIFY JUSTIFY:: ;justify() ;{ /*int i, spcs, cepos, rapos, adds0, adds1, addsb; ; char c;*/ ; push b lxi h,jxit push h ; /* this should not be necessary, but it is */ ; while (outpoint && outbuf[outpoint-1] == ' ') trimsp: lhld outpoint mov a,h ora l rz XCHG LHLD outbuf DCX D dad d MOV A,M cpi ' ' jnz ra_ce ; { outpoint--; XCHG shld outpoint ; glen -= widbuf[outpoint]; ; } call widget call cmd LHLD GLEN dad d shld glen jmp trimsp ;/* (should go up past initial "gotocol" space, here) */ ; cepos = rapos = -1; ra_ce: lxi h,-1 shld rapos shld cepos ; for (jui = 0, juspcs = 0; jui < outpoint; jui++) LHLD OUTBUF ;indexing outbuf removed from loop below XCHG ;keep it in DE LHLD OUTPOINT MOV B,H MOV C,L ;keep outpoint for comparison in BC lxi h,0 shld tswidth ;jui kept in HL shld juspcs shld jstrt cntsp: ; outpoint is in BC and jui in HL, ; and we don't need a signed comparison. MOV A,H CMP B JNZ ps.c1 MOV A,L CMP C ps.c1: jnc ce_chk ; { if ((juc = outbuf[jui]) == ' ') juspcs++; LDAX D ;char just kept in A, so juc store not necessary cpi ' ' jnz pr.c2 PUSH H ;save jui ;and save ptr outbuf push d ;get widbuf[HL=jui] in DE call widget ;update total of spaces width lhld tswidth dad d shld tswidth pop d lxi h,juspcs inr m POP H ; jmp cnxt ; else if (juc == CEFLAG) cepos = jui; pr.c2: cpi CEFLAG ;90H jnz c3 shld cepos ; jmp cnxt jump anyway below ; else if (juc == RAFLAG) rapos = jui; c3: cpi RAFLAG ;91H jnz c4 push h lhld rapos inx h mov a,h ora l jz c3.1 dcx h shld cepos c3.1: pop h shld rapos jmp cnxt ; } ; c4: cpi SPFLAG jnz cnxt push h inx h shld jstrt lxi h,0 shld juspcs pop h cnxt: inx h ;next jui INX D ;also next outbuf index jmp cntsp ; ; if (cepos >= 0 || rapos >= 0) ce_chk: LDA CEPOS+1 ral jnc addsinit LDA RAPOS+1 ral jc chkbrk ; { for (jui = 0, adds0 = adds1 = glen; jui < outpoint; jui++) addsinit: lhld glen shld adds1 shld adds0 lxi h,0 ; shld jui adnxt: shld jui ; lhld jui MOV A,H CMP B JNZ ad1 MOV A,L CMP C ad1: jnc doce ; { if (jui <= cepos) adds0 -= widbuf[jui]; ; lhld jui ;jui to DE xchg lhld cepos call agbs jc ad2 lhld jui call widget CALL CMD LHLD ADDS0 dad d shld adds0 ; if (jui <= rapos) adds1 -= widbuf[jui]; ad2: lhld jui XCHG lhld rapos call agbs jc ad3 lhld jui call widget CALL CMD LHLD ADDS1 dad d shld adds1 ad3: lhld jui inx h ; shld jui jmp adnxt ; } ; ; if (cepos >= 0) doce: LDA CEPOS+1 ral jc dora ; { addsb = glen - adds0; lhld adds0 call cmh XCHG LHLD GLEN dad d shld addsb ; if (rapos >= 0) adds0 -= adds1 + widbuf[rapos]; LDA RAPOS+1 ral jc ce1 ; lhld rapos ; call widget LHLD ADDS1 ; dad d call cmh XCHG LHLD ADDS0 dad d shld adds0 ; outbuf[cepos] = ' '; ce1: lhld cepos XCHG LHLD OUTBUF dad d mvi m,' ' ; if (adds0 > 0) adds0 = ; ((llength + ir - lindent[cc] ; - adds0) >> 1) - addsb; lhld adds0 lxi d,-1 dad d mov a,h ral lxi h,0 jc ce2 ;lindent[cc] call getlindent ;+adds0 lhld adds0 dad d call cmh ;-(lindent[cc] + adds0) xchg lhld llength dad d xchg lhld ir dad d lxi d,1 call shlrbe xchg lhld addsb call cmh dad d ; else adds0 = 0; ce2: shld adds0 ; widbuf[cepos] += adds0; lhld widbuf xchg lhld cepos dad h dad d push h MOV E,M inx h MOV D,M lhld adds0 dad d xchg pop h mov m,e inx h mov m,d ; glen += adds0; lhld glen XCHG lhld adds0 dad d shld glen ; } ; ; if (rapos >= 0) dora: LDA RAPOS+1 ral rc ; { addsb = glen - adds1; lhld adds1 call cmh XCHG LHLD GLEN dad d shld addsb ; outbuf[rapos] = ' '; lhld rapos XCHG LHLD OUTBUF dad d mvi m,' ' ; adds0 = llength + ir - lindent[cc] ; - adds1 - addsb; ;-(lindent[cc] + adds1 + addsb) call getlindent lhld adds1 dad d xchg lhld addsb dad d call cmh xchg lhld llength dad d xchg lhld ir dad d shld adds0 ; widbuf[rapos] += adds0; lhld widbuf xchg lhld rapos dad h dad d push h MOV E,M inx h MOV D,M lhld adds0 dad d xchg pop h mov m,e inx h mov m,d ; glen += adds0; ;; lhld glen ;; XCHG ;; lhld adds0 ;; dad d ;; shld glen lhld adds0 xchg lhld glen dad d shld glen ;fill in right endpoint of rule #1 ; first, is it defined as a horizontal? lhld rulist+6 mov a,h ora l ; if not, forget it rz lhld rulist+4 dad d shld rulist+6 ; } ; return; ; } ret ; if (brkflag || !ju) return; chkbrk: LDA BRKFLAG ora a rnz LDA JU ORA A rz ; if ((adds1 = llength - (glen + lindent[cc])) <= 0) return; ;How much do we have to loosen it? (-> adds1) totsp: ;note whether last char in break word is italic lhld attrbuf xchg lhld endovr dcx h dad h dad d ;; mov a,m ;; ani ITALIC ;; jz totsp.1 mov e,m inx h mov d,m xchg call endcorr lhld biglen ;; lxi d,8 dad d shld biglen totsp.1: ;note whether last char in line is italic lhld attrbuf xchg lhld outpoint dcx h dad h dad d mov a,m ani ITALIC jz totsp.2 lhld glen lxi d,8 dad d shld glen totsp.2: ;calculate total width of spaces for tight line lhld tswidth xchg lhld jblen dad d shld ttswidth ;overage of tight line is biglen+lindent-llength call getlindent lhld biglen dad d xchg lhld llength call cmh dad d shld subs1 ;the demispace for a tight line is (subs1*256)/ttswidth, ; or infinity if not conatenating, or subs1 >= ttswidth ;(really should prevent tightening to less than a point per space) lda co ora a jz .td0 xchg ;(+ tswidth -1?) lhld ttswidth xchg call agbs jc .td1 .td0: lxi h,-1 jmp .td2 .td1: push d mov d,l mvi e,0 ;now DE = (subs1+127)*256 pop h call usdiv ;DE/HL mov d,h mov e,l lda val + 54*('L'-'@') + 2*('F'-'@') dcr a dcr a ;if lf is 0 or 1, no preference jm .td2 ;but if it's 2, loosening is twice as good, etc. .td1.1: dad d dcr a jp .td1.1 .td2: shld tdemi call setadds ;(adds1 returned in HL) ;If 0, it's perfect (should not be possible to have ; negative looseness here, but you never can tell) dcx h mov a,h ora a rm ;now the demispace for a loose line inx h ;(+ (tswidth-1) ?) mov d,l mvi e,0 lhld tswidth call usdiv shld ldemi ; if (!juspcs) return; ;We need some blanks to work with lhld juspcs mov a,h ora l rz ;decide now if want a tight line ;tight is not feasible if demispace > 255 (or infinite) lhld tdemi mov a,h ora a jnz .jloose ;tightening is 4 times worse than loosening ;(yes, but do this above) ;; dad h ;; dad h xchg lhld ldemi ;which requires the least adjustment: tightening or loosening? call albu jnc .jloose ;so we tighten -- use the break word lhld endovr shld outpoint ;if we broke at a soft hyphen, change the real hyphen put in ; by prtsbuf back to a soft hyphen dcx h lda jbchar cpi SOFTHY jnz $+4 mov m,a ;tell prtsbuf not to put the break word in the next line lxi h,0 shld endovr ;length includes break word lhld biglen shld glen ;use the subtract routine to adjust the spaces lxi h,sbjspp jmp $+6 .jloose: ;do proportional loosening lxi h,adjspp shld _chspfu call chgsp ;smooth out right edge with further adjustments to space widths .jsmooth: call setadds mov a,h ora l rz mov a,h ora a ;did we add too much? lxi h,lesssp jm $+6 ;here we didn't add enough lxi h,moresp shld _chspfu call chgsp ;??? ret jmp .jsmooth jxit: pop b ret chgsp: lhld jstrt shld jui addsp: ; lhld jui (HL always has jui here) xchg lhld outpoint call albs rnc ; if (outbuf[jui] == ' ') lhld outbuf xchg lhld jui dad d mov a,m cpi ' ' jnz nxadd ; { widbuf[jui] += adds0; lhld widbuf xchg lhld jui dad h dad d push h mov e,m inx h mov d,m _chspfu equ $+1 call adjspp ;and store it pop h mov m,e inx h mov m,d ; }; nxadd: lhld jui inx h shld jui jmp addsp ;} lesssp: ;on entry DE = present width of space lhld adds1 ;adds1 is <= 0 mov a,h ora l ;take away a dot, if adds1 not zero yet rz inx h shld adds1 lhld glen dcx h shld glen dcx d ret moresp: ;on entry DE = present width of space lhld adds1 ;adds1 is >= 0 mov a,h ora l ;add a dot, if adds1 not zero yet rz dcx h shld adds1 lhld glen inx h shld glen inx d ret adjspp: ;save present width push d ;additional is (present * demispace)/256 lhld ldemi call usmul lxi d,127 dad d mov e,h mvi d,0 .adjs1: ;keep track of glen lhld glen dad d shld glen ;add it in pop h dad d ;return new width in DE xchg ret sbjspp: ;save present width push d ;decrement is (present * demispace)/256 lhld tdemi call usmul lxi d,127 dad d mov e,h mvi d,0 call cmd ;rest is same as for loosening jmp .adjs1 getlindent:: lhld cc dad h lxi d,lindent dad d mov e,m inx h mov d,m ret ;receive mode in HL ;return width correction for italic or bent in DE endcorr:: lxi d,0 mov a,l ani ITALIC jz $+5 mvi e,8 mov a,h ani BENT shr 8 rz push d lda be push psw call bntcorr pop psw pop d dad d push d rar rar rar rar call bntcorr pop d dad d xchg ret bntcorr: lxi h,0 ani 0fh rz cma ani 0fh inr a mov l,a lxi d,46 jmp usdiv widget: dad h xchg lhld widbuf dad d mov e,m inx h mov d,m ret setadds: call getlindent lhld glen dad d call cmh xchg lhld llength dad d shld adds1 ret adds0: dw 0 adds1: dw 0 addsb: dw 0 juc: dw 0 jui: dw 0 juspcs: dw 0 cepos: dw 0 rapos: dw 0 jstrt: dw 0 ;total width of spaces in loose line (before justification) tswidth: dw 0 ;total width of spaces in tight line ttswidth: dw 0 ;width that has to be removed from a tight line subs1: dw 0 ldemi: dw 0 tdemi: dw 0 END