diff options
Diffstat (limited to 'dviware/ln03/rose/ffc.pas')
-rw-r--r-- | dviware/ln03/rose/ffc.pas | 277 |
1 files changed, 277 insertions, 0 deletions
diff --git a/dviware/ln03/rose/ffc.pas b/dviware/ln03/rose/ffc.pas new file mode 100644 index 0000000000..e33f4bd03d --- /dev/null +++ b/dviware/ln03/rose/ffc.pas @@ -0,0 +1,277 @@ +{4:}PROGRAM FFC(INPUT,OUTPUT,LN03FILE,PXLFILE,OUTFILE);LABEL{5:} +9998,9999;{:5}TYPE{6:}EIGHTBITS=0..255; +BYTEBLOCK=PACKED ARRAY[0..511]OF EIGHTBITS; +BYTEFILE=PACKED FILE OF BYTEBLOCK;{:6}VAR{7:}INLINE:VARYING[513]OF CHAR; +ILP,ISTART,ILLEN:INTEGER;VERB:INTEGER;{:7}{11:}LN03FILE:BYTEFILE; +LN03COUNT,LN03LEN,I:INTEGER; +LBUF:PACKED RECORD CASE BOOLEAN OF FALSE:(C:PACKED ARRAY[0..((512*512)-1 +)]OF CHAR);TRUE:(B:PACKED ARRAY[0..511]OF BYTEBLOCK);END;{:11}{15:} +PXLFILE:BYTEFILE;PXLCOUNT,PXLLEN:INTEGER; +PBUF:PACKED RECORD CASE BOOLEAN OF FALSE:(C:PACKED ARRAY[0..((512*512)-1 +)]OF CHAR);TRUE:(B:PACKED ARRAY[0..511]OF BYTEBLOCK);END;{:15}{22:} +DEFSTART,RASSTART:INTEGER;J,K,L,M,N:INTEGER; +VISIBLEBYTE:PACKED ARRAY[1..8]OF CHAR;{:22}{31:} +CHARXDEFOFFS,STRINGPOOLSI,STRINGXPOOLO:INTEGER; +PSIZE,LSIZE,MSIZE:INTEGER;FIRSTCHAR,LASTCHAR,NUMCHARS:INTEGER; +ALLBLANK:BOOLEAN;ZCHAR,TFMWIDTH,XOFFSET,YOFFSET:INTEGER;DSIZE,MAG:REAL; +{:31}{39:}FONTIDSTRING:PACKED ARRAY[1..31]OF CHAR;{:39}{44:} +POINTS:INTEGER;{:44}{47:}OUTFILE:BYTEFILE;{:47}{8:} +FUNCTION COMMANDVERB:INTEGER;VAR I:INTEGER;BEGIN{9:} +WHILE(ILP<=ILLEN)AND(INLINE[ILP]=' ')DO ILP:=ILP+1;ISTART:=ILP; +WHILE(ILP<=ILLEN)AND(INLINE[ILP]<>' ')DO ILP:=ILP+1; +FOR I:=ISTART TO ILP-1 DO BEGIN IF(INLINE[I]>='A')AND(INLINE[I]<='Z') +THEN INLINE[I]:=CHR(ORD(INLINE[I])+ORD('a')-ORD('A'))END;{:9} +IF INDEX(SUBSTR(INLINE,ISTART,ILP-ISTART),'rln03')=1 THEN COMMANDVERB:=1 +ELSE IF INDEX(SUBSTR(INLINE,ISTART,ILP-ISTART),'tln03long')=1 THEN +COMMANDVERB:=3 ELSE IF INDEX(SUBSTR(INLINE,ISTART,ILP-ISTART), +'tln03word')=1 THEN COMMANDVERB:=4 ELSE IF INDEX(SUBSTR(INLINE,ISTART, +ILP-ISTART),'tln03')=1 THEN COMMANDVERB:=2 ELSE IF INDEX(SUBSTR(INLINE, +ISTART,ILP-ISTART),'rpxl')=1 THEN COMMANDVERB:=5 ELSE IF INDEX(SUBSTR( +INLINE,ISTART,ILP-ISTART),'tpxllong')=1 THEN COMMANDVERB:=7 ELSE IF +INDEX(SUBSTR(INLINE,ISTART,ILP-ISTART),'tpxlword')=1 THEN COMMANDVERB:=8 +ELSE IF INDEX(SUBSTR(INLINE,ISTART,ILP-ISTART),'tpxl')=1 THEN +COMMANDVERB:=6 ELSE IF INDEX(SUBSTR(INLINE,ISTART,ILP-ISTART),'toln03x') +=1 THEN COMMANDVERB:=11 ELSE IF INDEX(SUBSTR(INLINE,ISTART,ILP-ISTART), +'toln03')=1 THEN COMMANDVERB:=9 ELSE IF INDEX(SUBSTR(INLINE,ISTART,ILP- +ISTART),'wln03')=1 THEN COMMANDVERB:=10 ELSE IF INDEX(SUBSTR(INLINE, +ISTART,ILP-ISTART),'exit')=1 THEN COMMANDVERB:=99 ELSE COMMANDVERB:=0 +END;{:8}{19:}FUNCTION GETFIXNUM:INTEGER;LABEL 1;VAR X,X1:INTEGER; +NEGATIVE:BOOLEAN;BEGIN X1:=0;NEGATIVE:=FALSE; +WHILE(ILP<=ILLEN)AND(INLINE[ILP]=' ')DO ILP:=ILP+1; +IF ILP>ILLEN THEN GOTO 1;IF INLINE[ILP]='-'THEN BEGIN NEGATIVE:=TRUE; +ILP:=ILP+1 END; +IF(ILP>ILLEN)OR(INLINE[ILP]<'0')OR(INLINE[ILP]>'9')THEN GOTO 1;X1:=0; +WHILE(INLINE[ILP]>='0')AND(INLINE[ILP]<='9')DO BEGIN X1:=10*X1+ORD( +INLINE[ILP])-ORD('0');ILP:=ILP+1;IF ILP>ILLEN THEN GOTO 1;END;1:X:=X1; +IF NEGATIVE THEN X:=-X;GETFIXNUM:=X END;{:19}{25:} +PROCEDURE BINREP(V:INTEGER);VAR CNT,REM,QUO:INTEGER; +BEGIN VISIBLEBYTE:='........';QUO:=V; +FOR CNT:=1 TO 8 DO BEGIN REM:=QUO MOD 2;QUO:=QUO DIV 2; +IF REM<>0 THEN VISIBLEBYTE[CNT]:='B'END;END;{:25}{27:} +PROCEDURE REVBINREP(V:INTEGER);VAR CNT,REM,QUO:INTEGER; +BEGIN VISIBLEBYTE:='........';QUO:=V; +FOR CNT:=1 TO 8 DO BEGIN REM:=QUO MOD 2;QUO:=QUO DIV 2; +IF REM<>0 THEN VISIBLEBYTE[9-CNT]:='B'END;END;{:27}{34:} +FUNCTION SIGNEDPXLWOR(INDEX:INTEGER):INTEGER; +BEGIN IF ORD(PBUF.C[INDEX])>=128 THEN SIGNEDPXLWOR:=(ORD(PBUF.C[(INDEX) ++1])+256*ORD(PBUF.C[INDEX]))-65536 ELSE SIGNEDPXLWOR:=(ORD(PBUF.C[(INDEX +)+1])+256*ORD(PBUF.C[INDEX]))END; +PROCEDURE SETLN03LONG(INDEX,VALUE:INTEGER);VAR NEGATIVE:BOOLEAN; +A,B,C,D,CARRY:INTEGER; +BEGIN IF VALUE<0 THEN NEGATIVE:=TRUE ELSE NEGATIVE:=FALSE; +IF NEGATIVE THEN VALUE:=-VALUE;A:=VALUE MOD 256; +B:=(VALUE DIV 256)MOD 256;C:=(VALUE DIV(256*256))MOD 256; +D:=VALUE DIV(256*256*256);IF NEGATIVE THEN BEGIN CARRY:=0;A:=256-A; +IF A=256 THEN BEGIN A:=0;CARRY:=1 END;B:=255+CARRY-B; +IF B=256 THEN B:=0 ELSE CARRY:=0;C:=255+CARRY-C; +IF C=256 THEN C:=0 ELSE CARRY:=0;D:=255+CARRY-D;IF D=256 THEN D:=0 END; +LBUF.C[INDEX]:=CHR(A);LBUF.C[INDEX+1]:=CHR(B);LBUF.C[INDEX+2]:=CHR(C); +LBUF.C[INDEX+3]:=CHR(D)END;{:34}{36:}FUNCTION REVERSEBYTE(U:CHAR):CHAR; +VAR CNT,RV:INTEGER;BEGIN BINREP(ORD(U));RV:=0; +FOR CNT:=1 TO 8 DO IF VISIBLEBYTE[CNT]='B'THEN RV:=1+2*RV ELSE RV:=2*RV; +REVERSEBYTE:=CHR(RV)END;{:36} +BEGIN WRITELN('Font File Converter, Version 3');WRITELN;{10:} +9998:WRITELN;WRITE('FFC>');READLN(INLINE); +IF LENGTH(INLINE)=513 THEN BEGIN WRITELN('Command line too long'); +GOTO 9998 END;INLINE:=INLINE+' ';ILP:=1;ILLEN:=LENGTH(INLINE); +VERB:=COMMANDVERB;IF VERB=0 THEN BEGIN WRITELN('No such command'); +GOTO 9998 END ELSE{12:} +IF VERB=1 THEN BEGIN WHILE(ILP<=ILLEN)AND(INLINE[ILP]=' ')DO ILP:=ILP+1; +ISTART:=ILP;WHILE(ILP<=ILLEN)AND(INLINE[ILP]<>' ')DO ILP:=ILP+1; +OPEN(LN03FILE,SUBSTR(INLINE,ISTART,ILP-ISTART),readonly,error:=continue) +;IF STATUS(LN03FILE)>0 THEN BEGIN WRITELN('Couldn''t open file'); +GOTO 9998 END;RESET(LN03FILE);{13:}LN03COUNT:=0; +WHILE(NOT EOF(LN03FILE))AND(LN03COUNT<512)DO BEGIN READ(LN03FILE,LBUF.B[ +LN03COUNT]);LN03COUNT:=LN03COUNT+1;END;LN03LEN:=LN03COUNT*512; +CLOSE(LN03FILE);{14:}IF LN03LEN<16 THEN WRITELN('LN03 file too short'); +IF(LBUF.C[4]<>'F')OR(LBUF.C[5]<>'O')OR(LBUF.C[6]<>'N')OR(LBUF.C[7]<>'T') +THEN WRITELN('Second longword not FONT'){:14}{:13}END{:12}{16:} +ELSE IF VERB=5 THEN BEGIN WHILE(ILP<=ILLEN)AND(INLINE[ILP]=' ')DO ILP:= +ILP+1;ISTART:=ILP;WHILE(ILP<=ILLEN)AND(INLINE[ILP]<>' ')DO ILP:=ILP+1; +OPEN(PXLFILE,SUBSTR(INLINE,ISTART,ILP-ISTART),readonly,error:=continue); +IF STATUS(PXLFILE)>0 THEN BEGIN WRITELN('Couldn''t open file'); +GOTO 9998 END;RESET(PXLFILE);{17:}PXLCOUNT:=0; +WHILE(NOT EOF(PXLFILE))AND(PXLCOUNT<512)DO BEGIN READ(PXLFILE,PBUF.B[ +PXLCOUNT]);PXLCOUNT:=PXLCOUNT+1;END;PXLLEN:=PXLCOUNT*512;CLOSE(PXLFILE); +{18:} +IF NOT(PXLLEN MOD 4=0)THEN WRITELN('PXL file length not multiple of 4'); +IF(ORD(PBUF.C[(0)+3])+(256*(ORD(PBUF.C[(0)+2])+256*(ORD(PBUF.C[(0)+1]) ++256*ORD(PBUF.C[0])))))<>1001 THEN WRITELN('Initial PXL format id wrong' +);I:=PXLLEN-4; +WHILE(I>=PXLLEN-512)DO BEGIN IF(ORD(PBUF.C[(I)+3])+(256*(ORD(PBUF.C[(I) ++2])+256*(ORD(PBUF.C[(I)+1])+256*ORD(PBUF.C[I])))))=1001 THEN BEGIN +PXLLEN:=I+4;I:=-1 END ELSE I:=I-4 END; +IF PXLLEN<16 THEN WRITELN('PXL file too short'); +IF(ORD(PBUF.C[(PXLLEN-4)+3])+(256*(ORD(PBUF.C[(PXLLEN-4)+2])+256*(ORD( +PBUF.C[(PXLLEN-4)+1])+256*ORD(PBUF.C[PXLLEN-4])))))<>1001 THEN WRITELN( +'Final PXL format id wrong');{:18}{:17}END{:16}{21:} +ELSE IF VERB=2 THEN BEGIN WHILE(ILP<=ILLEN)AND(INLINE[ILP]=' ')DO ILP:= +ILP+1; +IF ILP>ILLEN THEN BEGIN WRITELN('You have to say what character to type' +);GOTO 9998 END; +IF(INLINE[ILP]='''')AND(ILP<ILLEN)THEN I:=ORD(INLINE[ILP+1])ELSE I:= +GETFIXNUM; +IF(I<(ORD(LBUF.C[164])+(256*(ORD(LBUF.C[(164)+1])+256*(ORD(LBUF.C[(164) ++2])+256*ORD(LBUF.C[(164)+3]))))))OR(I>(ORD(LBUF.C[168])+(256*(ORD(LBUF. +C[(168)+1])+256*(ORD(LBUF.C[(168)+2])+256*ORD(LBUF.C[(168)+3]))))))THEN +BEGIN WRITELN('No such character');GOTO 9998 END; +I:=4*(I-(ORD(LBUF.C[164])+(256*(ORD(LBUF.C[(164)+1])+256*(ORD(LBUF.C[( +164)+2])+256*ORD(LBUF.C[(164)+3]))))))+(ORD(LBUF.C[120])+(256*(ORD(LBUF. +C[(120)+1])+256*(ORD(LBUF.C[(120)+2])+256*ORD(LBUF.C[(120)+3])))));{23:} +IF LBUF.C[I+3]>=CHR(128)THEN BEGIN WRITELN( +'Indirect locators not supported');GOTO 9998 END; +DEFSTART:=ORD(LBUF.C[I])+256*(ORD(LBUF.C[I+1])+256*ORD(LBUF.C[(I+1)+1])) +;IF DEFSTART=0 THEN BEGIN WRITELN('Locator is zero');GOTO 9998 END; +RASSTART:=DEFSTART+(ORD(LBUF.C[200])+(256*(ORD(LBUF.C[(200)+1])+256*(ORD +(LBUF.C[(200)+2])+256*ORD(LBUF.C[(200)+3]))))); +WRITELN(' ma = ',RASSTART:1); +IF RASSTART>((512*512)-1)THEN BEGIN WRITELN( +'Character outside piece of file read');GOTO 9998 END{:23};{24:} +WRITELN('width ',(((ORD(LBUF.C[DEFSTART+4])+(256*(ORD(LBUF.C[(DEFSTART+4 +)+1])+256*(ORD(LBUF.C[(DEFSTART+4)+2])+256*ORD(LBUF.C[(DEFSTART+4)+3]))) +)))/24.0):5:1,' pixels'); +IF ORD(LBUF.C[RASSTART+1])<>129 THEN BEGIN WRITELN( +'Run length encoding not supported');GOTO 9998 END; +IF ODD(ORD(LBUF.C[RASSTART]))THEN BEGIN WRITELN('landscape'); +I:=(ORD(LBUF.C[RASSTART+4])+256*ORD(LBUF.C[(RASSTART+4)+1])); +J:=(ORD(LBUF.C[RASSTART+6])+256*ORD(LBUF.C[(RASSTART+6)+1]))END ELSE +BEGIN WRITELN('portrait'); +I:=(ORD(LBUF.C[RASSTART+6])+256*ORD(LBUF.C[(RASSTART+6)+1])); +J:=(ORD(LBUF.C[RASSTART+4])+256*ORD(LBUF.C[(RASSTART+4)+1]))END; +WRITELN(I:1,' rows ',J:1,' columns');K:=I DIV 8;IF I<>8*K THEN K:=K+1; +FOR L:=0 TO J-1 DO BEGIN FOR M:=0 TO K-1 DO BEGIN BINREP(ORD(LBUF.C[ +RASSTART+8+K*L+M]));WRITE(VISIBLEBYTE)END;WRITELN END{:24}END{:21}{26:} +ELSE IF VERB=6 THEN BEGIN WHILE(ILP<=ILLEN)AND(INLINE[ILP]=' ')DO ILP:= +ILP+1; +IF ILP>ILLEN THEN BEGIN WRITELN('You have to say what character to type' +);GOTO 9998 END; +IF(INLINE[ILP]='''')AND(ILP<ILLEN)THEN I:=ORD(INLINE[ILP+1])ELSE I:= +GETFIXNUM;IF(I<0)OR(I>127)THEN BEGIN WRITELN('No such character'); +GOTO 9998 END;DEFSTART:=PXLLEN-4*517+16*I; +RASSTART:=4*(ORD(PBUF.C[(DEFSTART+8)+3])+(256*(ORD(PBUF.C[(DEFSTART+8)+2 +])+256*(ORD(PBUF.C[(DEFSTART+8)+1])+256*ORD(PBUF.C[DEFSTART+8]))))); +WRITELN(' rasters at ',RASSTART:1); +IF RASSTART>PXLLEN THEN BEGIN WRITELN('Rasters outside file'); +GOTO 9998 END;I:=(ORD(PBUF.C[(DEFSTART)+1])+256*ORD(PBUF.C[DEFSTART])); +J:=(ORD(PBUF.C[(DEFSTART+2)+1])+256*ORD(PBUF.C[DEFSTART+2])); +WRITELN(I:1,' columns ',J:1,' rows');K:=I DIV 32;IF I<>32*K THEN K:=K+1; +FOR L:=0 TO J-1 DO BEGIN FOR M:=0 TO K-1 DO BEGIN REVBINREP(ORD(PBUF.C[ +RASSTART+4*K*L+4*M]));WRITE(VISIBLEBYTE); +REVBINREP(ORD(PBUF.C[RASSTART+4*K*L+4*M+1]));WRITE(VISIBLEBYTE); +REVBINREP(ORD(PBUF.C[RASSTART+4*K*L+4*M+2]));WRITE(VISIBLEBYTE); +REVBINREP(ORD(PBUF.C[RASSTART+4*K*L+4*M+3]));WRITE(VISIBLEBYTE)END; +WRITELN END END{:26}{28:}ELSE IF VERB=3 THEN BEGIN I:=GETFIXNUM; +IF(I>=0)AND(I<LN03LEN)THEN WRITELN((ORD(LBUF.C[I])+(256*(ORD(LBUF.C[(I) ++1])+256*(ORD(LBUF.C[(I)+2])+256*ORD(LBUF.C[(I)+3]))))):1)ELSE WRITELN( +'Location not in file')END ELSE IF VERB=4 THEN BEGIN I:=GETFIXNUM; +IF(I>=0)AND(I<LN03LEN)THEN WRITELN((ORD(LBUF.C[I])+256*ORD(LBUF.C[(I)+1] +)))ELSE WRITELN('Location not in file')END ELSE IF VERB=7 THEN BEGIN I:= +GETFIXNUM; +IF(I>=0)AND(I<PXLLEN)THEN WRITELN((ORD(PBUF.C[(I)+3])+(256*(ORD(PBUF.C[( +I)+2])+256*(ORD(PBUF.C[(I)+1])+256*ORD(PBUF.C[I]))))):1)ELSE WRITELN( +'Location not in file')END ELSE IF VERB=8 THEN BEGIN I:=GETFIXNUM; +IF(I>=0)AND(I<PXLLEN)THEN WRITELN((ORD(PBUF.C[(I)+1])+256*ORD(PBUF.C[I]) +))ELSE WRITELN('Location not in file')END{:28}{30:} +ELSE IF(VERB=9)OR(VERB=11)THEN BEGIN FOR I:=0 TO((512*512)-1)DO LBUF.C[I +]:=CHR(0);IF VERB=9 THEN BEGIN FIRSTCHAR:=33; +LASTCHAR:=126 END ELSE BEGIN FIRSTCHAR:=0;LASTCHAR:=127 END; +NUMCHARS:=LASTCHAR-FIRSTCHAR+1;{32:}STRINGPOOLSI:=48; +STRINGXPOOLO:=480+4*NUMCHARS+4;CHARXDEFOFFS:=STRINGXPOOLO+STRINGPOOLSI; +LN03LEN:=CHARXDEFOFFS;PSIZE:=0;LSIZE:=0;MSIZE:=0; +FOR ZCHAR:=FIRSTCHAR TO LASTCHAR DO BEGIN{33:} +LBUF.C[LN03LEN+3]:=CHR(128);DEFSTART:=PXLLEN-4*517+16*ZCHAR; +RASSTART:=4*(ORD(PBUF.C[(DEFSTART+8)+3])+(256*(ORD(PBUF.C[(DEFSTART+8)+2 +])+256*(ORD(PBUF.C[(DEFSTART+8)+1])+256*ORD(PBUF.C[DEFSTART+8]))))); +IF RASSTART>PXLLEN THEN BEGIN WRITELN('Rasters outside file for ',ZCHAR: +1);GOTO 9998 END; +TFMWIDTH:=(ORD(PBUF.C[(DEFSTART+12)+3])+(256*(ORD(PBUF.C[(DEFSTART+12)+2 +])+256*(ORD(PBUF.C[(DEFSTART+12)+1])+256*ORD(PBUF.C[DEFSTART+12]))))); +DSIZE:=(ORD(PBUF.C[(PXLLEN-12)+3])+(256*(ORD(PBUF.C[(PXLLEN-12)+2])+256* +(ORD(PBUF.C[(PXLLEN-12)+1])+256*ORD(PBUF.C[PXLLEN-12]))))); +MAG:=(ORD(PBUF.C[(PXLLEN-16)+3])+(256*(ORD(PBUF.C[(PXLLEN-16)+2])+256*( +ORD(PBUF.C[(PXLLEN-16)+1])+256*ORD(PBUF.C[PXLLEN-16]))))); +DSIZE:=(DSIZE/(1048576))*(MAG/1500.0);XOFFSET:=SIGNEDPXLWOR(DEFSTART+4); +YOFFSET:=SIGNEDPXLWOR(DEFSTART+6); +SETLN03LONG(LN03LEN+4,ROUND((DSIZE*7200.0*TFMWIDTH)/((1048576)*72.27))); +SETLN03LONG(LN03LEN+8,-24*XOFFSET);SETLN03LONG(LN03LEN+12,-24*YOFFSET); +{:33}{35:}LBUF.C[LN03LEN+17]:=CHR(129); +I:=(ORD(PBUF.C[(DEFSTART)+1])+256*ORD(PBUF.C[DEFSTART])); +J:=(ORD(PBUF.C[(DEFSTART+2)+1])+256*ORD(PBUF.C[DEFSTART+2])); +ALLBLANK:=(I=0)AND(J=0);IF ALLBLANK THEN BEGIN I:=1;J:=1 END; +LBUF.C[LN03LEN+20]:=CHR(J MOD 256);LBUF.C[LN03LEN+21]:=CHR(J DIV 256); +LBUF.C[LN03LEN+22]:=CHR(I MOD 256);LBUF.C[LN03LEN+23]:=CHR(I DIV 256); +K:=I DIV 32;IF I<>32*K THEN K:=K+1;N:=I DIV 8;IF I<>8*N THEN N:=N+1; +IF NOT ALLBLANK THEN FOR L:=0 TO J-1 DO FOR M:=0 TO N-1 DO LBUF.C[ +LN03LEN+24+N*L+M]:=REVERSEBYTE(PBUF.C[RASSTART+4*K*L+M]); +SETLN03LONG(480+4*(ZCHAR-FIRSTCHAR),LN03LEN);LN03LEN:=LN03LEN+24+J*N; +IF ODD(LN03LEN)THEN LN03LEN:=LN03LEN+1;PSIZE:=PSIZE+J*N;K:=J DIV 8; +IF J<>8*K THEN K:=K+1;LSIZE:=LSIZE+I*K; +IF I*K>J*N THEN MSIZE:=MSIZE+I*K ELSE MSIZE:=MSIZE+J*N;{:35}END;{:32}; +{37:}IF LN03LEN MOD 4<>0 THEN LN03LEN:=LN03LEN+(4-(LN03LEN MOD 4)); +LN03LEN:=LN03LEN+8;SETLN03LONG(0,LN03LEN); +SETLN03LONG(LN03LEN-8,LN03LEN);LBUF.C[4]:='F';LBUF.C[LN03LEN-4]:='F'; +LBUF.C[5]:='O';LBUF.C[LN03LEN-3]:='O';LBUF.C[6]:='N'; +LBUF.C[LN03LEN-2]:='N';LBUF.C[7]:='T';LBUF.C[LN03LEN-1]:='T';{:37}{38:} +LBUF.C[8]:=CHR(1);LBUF.C[12]:=CHR(31);LBUF.C[16]:=CHR(20); +FONTIDSTRING:='U000000002SK00GG0001UZZZZ02F000'; +FOR I:=1 TO 31 DO LBUF.C[20+I-1]:=FONTIDSTRING[I]; +LBUF.C[88]:=CHR(1973 MOD 256);LBUF.C[89]:=CHR(1973 DIV 256); +LBUF.C[90]:=CHR(9);LBUF.C[92]:=CHR(11);LBUF.C[94]:=CHR(14);{:38}{40:} +SETLN03LONG(100,104);SETLN03LONG(104,252);SETLN03LONG(108,124); +SETLN03LONG(112,356);SETLN03LONG(116,4*NUMCHARS);SETLN03LONG(120,480); +SETLN03LONG(124,4);SETLN03LONG(128,480+4*NUMCHARS); +SETLN03LONG(136,480+4*NUMCHARS+4);SETLN03LONG(140,STRINGPOOLSI); +SETLN03LONG(144,480+4*NUMCHARS+4); +SETLN03LONG(152,480+4*NUMCHARS+4+STRINGPOOLSI); +SETLN03LONG(156,LN03LEN-8-CHARXDEFOFFS);SETLN03LONG(160,CHARXDEFOFFS); +{:40}{41:}SETLN03LONG(164,FIRSTCHAR);SETLN03LONG(168,LASTCHAR); +SETLN03LONG(192,32);SETLN03LONG(196,168);SETLN03LONG(200,16); +SETLN03LONG(204,NUMCHARS);SETLN03LONG(212,NUMCHARS); +SETLN03LONG(220,NUMCHARS);SETLN03LONG(228,PSIZE);SETLN03LONG(232,LSIZE); +SETLN03LONG(236,MSIZE);{:41}{42:}SETLN03LONG(252,2);SETLN03LONG(256,7); +SETLN03LONG(260,STRINGXPOOLO);LBUF.C[STRINGXPOOLO]:='0'; +LBUF.C[STRINGXPOOLO+1]:='B';LBUF.C[STRINGXPOOLO+2]:=CHR(9); +LBUF.C[STRINGXPOOLO+3]:='Z';LBUF.C[STRINGXPOOLO+4]:='Z'; +LBUF.C[STRINGXPOOLO+5]:='Z';LBUF.C[STRINGXPOOLO+6]:='Z'; +SETLN03LONG(264,7);SETLN03LONG(268,STRINGXPOOLO+7); +FOR I:=1 TO 7 DO LBUF.C[STRINGXPOOLO+7+I-1]:=FONTIDSTRING[I]; +SETLN03LONG(272,16);SETLN03LONG(276,STRINGXPOOLO+14); +FOR I:=1 TO 16 DO LBUF.C[STRINGXPOOLO+14+I-1]:=' ';SETLN03LONG(280,16); +SETLN03LONG(284,STRINGXPOOLO+30); +FOR I:=1 TO 16 DO LBUF.C[STRINGXPOOLO+30+I-1]:=FONTIDSTRING[I];{:42} +{43:} +I:=(ORD(PBUF.C[(PXLLEN-12)+3])+(256*(ORD(PBUF.C[(PXLLEN-12)+2])+256*(ORD +(PBUF.C[(PXLLEN-12)+1])+256*ORD(PBUF.C[PXLLEN-12]))))); +POINTS:=I DIV(1048576);K:=(10000*I MOD(1048576))DIV(1048576); +LBUF.C[304]:=CHR(POINTS MOD 256);LBUF.C[305]:=CHR(POINTS DIV 256); +LBUF.C[306]:=CHR(K MOD 256);LBUF.C[307]:=CHR(K DIV 256); +IF K>4999 THEN POINTS:=POINTS+1;SETLN03LONG(308,50*POINTS);{:43}{45:} +LBUF.C[314]:=CHR(24);LBUF.C[316]:=CHR(16);LBUF.C[320]:=CHR(16); +LBUF.C[324]:=CHR(1);LBUF.C[326]:=CHR(1);LBUF.C[328]:=CHR(1); +LBUF.C[330]:=CHR(1);LBUF.C[334]:=CHR(1);{:45}{46:} +SETLN03LONG(360,12*POINTS);SETLN03LONG(364,8*POINTS); +SETLN03LONG(368,-25*POINTS);SETLN03LONG(372,8*POINTS); +SETLN03LONG(376,-60*POINTS);SETLN03LONG(380,8*POINTS); +LBUF.C[386]:=CHR(1);LBUF.C[390]:=CHR(POINTS*12 MOD 256); +LBUF.C[391]:=CHR(POINTS*12 DIV 256);SETLN03LONG(392,-36*POINTS); +SETLN03LONG(400,16*POINTS);SETLN03LONG(408,24*POINTS); +SETLN03LONG(412,20*POINTS);SETLN03LONG(416,80*POINTS); +SETLN03LONG(420,25*POINTS);SETLN03LONG(424,100*POINTS); +SETLN03LONG(428,50*POINTS);SETLN03LONG(432,10*POINTS); +SETLN03LONG(436,35*POINTS);SETLN03LONG(440,-64*POINTS); +SETLN03LONG(444,-50*POINTS);SETLN03LONG(448,-35*POINTS); +SETLN03LONG(452,100*POINTS);SETLN03LONG(456,-65*POINTS); +SETLN03LONG(460,35*POINTS);SETLN03LONG(464,65*POINTS); +SETLN03LONG(468,35*POINTS);SETLN03LONG(472,10*POINTS); +SETLN03LONG(476,10*POINTS);{:46}END{:30}{48:} +ELSE IF VERB=10 THEN BEGIN WHILE(ILP<=ILLEN)AND(INLINE[ILP]=' ')DO ILP:= +ILP+1; +IF ILP>ILLEN THEN BEGIN WRITELN('You must specify a file to write into') +;GOTO 9998 END;ISTART:=ILP; +WHILE(ILP<=ILLEN)AND(INLINE[ILP]<>' ')DO ILP:=ILP+1; +OPEN(OUTFILE,SUBSTR(INLINE,ISTART,ILP-ISTART),error:=continue); +IF STATUS(OUTFILE)<>0 THEN BEGIN WRITELN('couldn''t open',SUBSTR(INLINE, +ISTART,ILP-ISTART));GOTO 9998 END;REWRITE(OUTFILE);I:=LN03LEN DIV 512; +IF LN03LEN<>I*512 THEN I:=I+1; +FOR J:=0 TO I-1 DO WRITE(OUTFILE,LBUF.B[J]);CLOSE(OUTFILE)END{:48}{49:} +ELSE IF VERB=99 THEN GOTO 9999{:49};GOTO 9998;9999:{:10}END.{:4} |