Oakland CPM Archive

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

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

Wrap

Text File | 1988-05-21 | 25.8 KB | 2,049 lines

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