LEX 'D2DLEX' TITLE DOT2DOT LEX - Fred Lipschultz [106] CHHU V2N7 * * DOT2DOT$ forms the bit patterns used to generate faster ThinkJet graphics * with the latest versions of the DOT2DOT program. * * SYNTAX: DOT2DOT$( string, bit #, stretch factor) where: * -- string is a set of bytes such as obtained by GDISP$ or PATTERN$ * -- bit # , from 0 to 7, is the display character row from top to bottom * of string * -- stretch factor is the number of times each bit is duplicated in the * bytes output * * Example: DOT2DOT$(PATTERN$('A'),0,3) should return the following bit pattern: * 000111111111000000000000 * Note that unused bits on the rightmost side of DOT2DOT$ are zero- * filled, ie. the function left justifies. * Note that PATTERN$ is six times longer than 'string' and that the * resulting DOT2DOT$ will be longer by the stretch factor * * -- the absolute value of the stretch factor is used, zero defaults to 1 * -- to maintain proportions, send each DOT2DOT$ to the Thinkjet * CEIL(stretch factor/2) times * ID #5D * scratch ID , 93 decimal MSG 0 POLL 0 POP1N EQU #0BD1C RJUST EQU #12AE2 DCHXW EQU #0ECDC CSLW5 EQU #0ED3D CSRW5 EQU #0ED2C POPMTH EQU #1B3DB POP1S EQU #0BD38 AHEAD EQU #181B7 MEMCKL EQU #012A5 A-MULT EQU #1B349 AVMEMS EQU #2F594 AVMEME EQU #2F599 R3=D10 EQU #03526 MPY EQU #0ECB8 MFERR EQU #09393 MEMERR EQU #0944D ENTRY START CHAR #F KEY 'DOT2DOT$' TOKEN 197 * M. Markov scratch resource managment scheme ENDTXT NIBHEX 88 3rd, 2nd arguments numeric NIBHEX 4 1st argument is string NIBHEX 33 3 arguments, MAX, MIN START GOSBVL R3=D10 save pointers in R3 GOSUB POPPER ready for 3rd argument (stretch) GOTO SVARG1 POPPER GOSBVL POP1N GOSBVL RJUST C=A W GOSBVL DCHXW RTN SVARG1 ?A#0 A if stretch=0, increment A to default stretch of 1 GOYES SVARG2 A=A+1 A SVARG2 R0=A GOSBVL POPMTH move to next argument GOSUB POPPER pop 2nd argument, converting dec to hex P= 0 LCHEX 7 A=A&C P add nib mod 8 C=0 X 1st 3 nibs clean LCHEX 1 ACEX X A=1; C= bit value B=0 P TSTLP1 ?B=C P B= bit value? GOYES MSKRDY yes; exit A=A+A X shift mask left 1 bit B=B+1 P increment bit count GOTO TSTLP1 do again MSKRDY C=A X copy bit mask to C GOSBVL CSLW5 shift mask left 5X R4=C store mask in R4 GOSBVL POPMTH get first argument; the string GOSBVL POP1S get string header; D1= last character, A[A]= nib length C=A A GOSBVL CSLW5 old length in nibs -->[5,9] CD1EX D1 -> C[A] R2=C B=0 W clean stretch, length for full word B=A A length --> B[A] C=R0 stretch --> C --> A[A] A=0 W A=C A C=B W length --> C CSRB SETHEX GOSBVL MPY full word *; res in A, B, C SB=0 clear stickybit for bit shift rt. ASRB ASRB ASRB integer divide by 8 ?SB=0 no bits lost? (was multiple of 8?) GOYES CONT1 A=A+1 W round up -- remainder #0 CONT1 C=A W save length of new string (in bytes) in D via C D=C W P= 0 C=0 W zero C for test LCHEX FFFF test for DOT2DOT$>65K ?A<=C W GOYES CONT2 GOTO ERROUT error exit CONT2 A=A+A A Convert length to nibs C=A A GOSBVL MEMCKL check MEM W/LEEWAY -- OK if carry clear GONC CONT3 GOTO EROUT1 new string would be too long CONT3 C=R2 get old D1 pointer R1=C save DOT2DOT$ hi-mem pointer D1=C A=C W GOSBVL CSRW5 shift C right 5X C=C+A A point to MSByte in old string D0=C A=R0 prepare to pack R1 with hi-mem pointer & stretch C=R1 GOSBVL CSLW5 hi-mem pointer --> C[5-9] C=C+A A add stretch to C R1=C should be ready for exit conditions ?D#0 A test for null new string GOYES CONT4 keep going GOTO EXIT null$ exit CONT4 B=C A stretch to C C=0 A clear new byte R0=C --> R0 P= 0 LCHEX 80 put bit mask in C (10000000) R2=C ready for loop MAINLP ST=0 8 D0=D0- 2 move up one byte AD0EX C=R1 GOSBVL CSRW5 ?A>=C A GOYES CONT6 AD0EX D1=D1- 2 DAT1=A B GOTO EXIT CONT6 AD0EX A=DAT0 B get byte from old string C=R4 get bit mask GOSBVL CSRW5 A=A&C B AND bit in old byte ?A=0 B was the bit clear? GOYES STEP1 ST=1 8 STEP1 A=R0 get back old byte C=R2 get back OR mask LOOP1 ?ST=0 8 old bit clear? GOYES SKIPOR A=A!C B OR bit to new byte SKIPOR SB=0 clear sticky bit CSRB shift OR mask right 1 bit ?SB=0 is new byte unfinished? GOYES STEP2 do not output, goto next test D1=D1- 2 DAT1=A B byte was full, output D=D-1 A decrement counter ?D#0 A not done? GOYES CONT5 keep going GOTO EXIT done CONT5 A=0 B zero new byte P= 0 LCHEX 0080 load new mask STEP2 B=B-1 A decrement B by 1 (stretch) ?B#0 A ready for another OR? GOYES LOOP1 R0=A save new byte in R0 R2=C save OR mask in R2 C=R1 get fresh stretch B=C A GOTO MAINLP ERROUT GOVLNG MFERR EROUT1 GOVLNG MEMERR EXIT D0=(5) AVMEMS C=DAT0 A D=C A D[A]=AVEMEMS C=R1 new string high mem pointer GOSBVL CSRW5 R1=C C=R3 D0=C restore original PC ST=0 0 P= 0 GOVLNG AHEAD should fall through EXPR -- done END