path: root/dviware/ln03/rose/ffc.pas

{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}