{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;
ZCHAR,TFMWIDTH,XOFFSET,YOFFSET:INTEGER;DSIZE,MAG:REAL;{:31}{39:}
FONTIDSTRING:PACKED ARRAY[1..31]OF CHAR;{:39}{44:}POINTS:INTEGER;{:44}
{47:}CNTWORD,PXFWORD:INTEGER;RAW,COLUMN,PXFCOLUMN:INTEGER;
PXFRAS:INTEGER;BITCLEAR:INTEGER;PXFDICT:ARRAY[0..16*128+4*5]OF CHAR;
PXFRASTER:ARRAY[0..((512*512)-1)]OF CHAR;{:47}{51:}TFMMOD:INTEGER;{:51}
{53:}OUTFILE:BYTEFILE;{:53}{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')<>0 THEN COMMANDVERB:=
1 ELSE IF INDEX(SUBSTR(INLINE,ISTART,ILP-ISTART),'tln03long')<>0 THEN
COMMANDVERB:=3 ELSE IF INDEX(SUBSTR(INLINE,ISTART,ILP-ISTART),
'tln03word')<>0 THEN COMMANDVERB:=4 ELSE IF INDEX(SUBSTR(INLINE,ISTART,
ILP-ISTART),'tln03')<>0 THEN COMMANDVERB:=2 ELSE IF INDEX(SUBSTR(INLINE,
ISTART,ILP-ISTART),'rpxl')<>0 THEN COMMANDVERB:=5 ELSE IF INDEX(SUBSTR(
INLINE,ISTART,ILP-ISTART),'tpxllong')<>0 THEN COMMANDVERB:=7 ELSE IF
INDEX(SUBSTR(INLINE,ISTART,ILP-ISTART),'tpxlword')<>0 THEN COMMANDVERB:=
8 ELSE IF INDEX(SUBSTR(INLINE,ISTART,ILP-ISTART),'tpxl')<>0 THEN
COMMANDVERB:=6 ELSE IF INDEX(SUBSTR(INLINE,ISTART,ILP-ISTART),'toln03x')
<>0 THEN COMMANDVERB:=11 ELSE IF INDEX(SUBSTR(INLINE,ISTART,ILP-ISTART),
'toln03')<>0 THEN COMMANDVERB:=9 ELSE IF INDEX(SUBSTR(INLINE,ISTART,ILP-
ISTART),'wln03')<>0 THEN COMMANDVERB:=10 ELSE IF INDEX(SUBSTR(INLINE,
ISTART,ILP-ISTART),'fixpxl')<>0 THEN COMMANDVERB:=12 ELSE IF INDEX(
SUBSTR(INLINE,ISTART,ILP-ISTART),'dmppxl')<>0 THEN COMMANDVERB:=13 ELSE
IF INDEX(SUBSTR(INLINE,ISTART,ILP-ISTART),'widpxl')<>0 THEN COMMANDVERB
:=14 ELSE IF INDEX(SUBSTR(INLINE,ISTART,ILP-ISTART),'exit')<>0 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}{49:}
PROCEDURE TOPXFWORDDIC(OFFSET,VALUE:INTEGER);
BEGIN PXFDICT[OFFSET]:=CHR(VALUE DIV 256);
PXFDICT[OFFSET+1]:=CHR(VALUE MOD 256);
IF(ORD(PXFDICT[(OFFSET)+1])+256*ORD(PXFDICT[OFFSET]))<>VALUE THEN
WRITELN('>>> La fonction TO_PXF_WORD_DICT est incorrecte')END;
PROCEDURE TOPXFLONGDIC(OFFSET,VALUE:INTEGER);
BEGIN TOPXFWORDDIC(OFFSET,VALUE DIV(256*256));
TOPXFWORDDIC(OFFSET+2,VALUE MOD(256*256));
IF(ORD(PXFDICT[(OFFSET)+3])+(256*(ORD(PXFDICT[(OFFSET)+2])+256*(ORD(
PXFDICT[(OFFSET)+1])+256*ORD(PXFDICT[OFFSET])))))<>VALUE THEN WRITELN(
'>>> La fonction TO_PXF_LONG_DICT est incorrecte')END;
PROCEDURE BITMASK(VAR CAR:CHAR;BITCLEAR:INTEGER);VAR MASK:UNSIGNED;
BEGIN MASK:=2**(BITCLEAR+1)-1;MASK:=UNOT(MASK);
CAR:=CHR(UAND(ORD(CAR),MASK))END;{:49}
BEGIN WRITELN('Font File Converter, Version 0.1.b');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(ORD(LBUF.C[0])+(256*(ORD(LBUF.C[(0)+1])+256*(ORD(LBUF.C[(0)+2])+256*
ORD(LBUF.C[(0)+3])))))<>LN03LEN THEN WRITELN('File length field ',(ORD(
LBUF.C[0])+(256*(ORD(LBUF.C[(0)+1])+256*(ORD(LBUF.C[(0)+2])+256*ORD(LBUF
.C[(0)+3]))))):1,' differs from true length ',LN03LEN:1);
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');WRITELN('File length ',PXLLEN:1);{: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:}
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 WRITELN('Rasters outside file for ',ZCHAR:1);
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]));
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;
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:}
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:=(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:=TRUNC((DSIZE/(1048576))*(MAG/1000.0));
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=12 THEN BEGIN WHILE(ILP<=ILLEN)AND(INLINE[ILP]=' ')DO ILP:=
ILP+1;IF ILP<ILLEN THEN PXFCOLUMN:=GETFIXNUM ELSE PXFCOLUMN:=-1;
IF PXFCOLUMN<=0 THEN BEGIN WRITELN('Search largest character');
FOR J:=0 TO 127 DO BEGIN DEFSTART:=PXLLEN-4*517+16*J;
COLUMN:=(ORD(PBUF.C[(DEFSTART)+1])+256*ORD(PBUF.C[DEFSTART]));
IF COLUMN>PXFCOLUMN THEN BEGIN PXFCOLUMN:=COLUMN;M:=J END END;
WRITELN('Largest character is ',CHR(M),' (',M:1,')',' with ',PXFCOLUMN:1
,' columns');END;PXFWORD:=PXFCOLUMN DIV 32;
IF PXFCOLUMN<>PXFWORD*32 THEN PXFWORD:=PXFWORD+1;
BITCLEAR:=(PXFWORD*32)-PXFCOLUMN;PXFRAS:=4;
FOR J:=0 TO 127 DO BEGIN DEFSTART:=PXLLEN-4*517+16*J;
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');
GOTO 9998 END;
COLUMN:=(ORD(PBUF.C[(DEFSTART)+1])+256*ORD(PBUF.C[DEFSTART]));
RAW:=(ORD(PBUF.C[(DEFSTART+2)+1])+256*ORD(PBUF.C[DEFSTART+2]));
CNTWORD:=COLUMN DIV 32;IF CNTWORD*32<>COLUMN THEN CNTWORD:=CNTWORD+1;
IF CNTWORD>PXFWORD THEN BEGIN WRITELN('Character ',J:1,' is too large');
WRITELN(COLUMN,' --- ',PXFCOLUMN)END;K:=J*16;TOPXFWORDDIC(K,PXFCOLUMN);
TOPXFWORDDIC(K+2,RAW);TOPXFLONGDIC(K+8,PXFRAS DIV 4);
IF CNTWORD<=PXFWORD THEN BEGIN FOR L:=0 TO RAW-1 DO BEGIN FOR M:=0 TO(
CNTWORD*4)-1 DO PXFRASTER[PXFRAS+M]:=PBUF.C[RASSTART+M];
FOR M:=(4*CNTWORD)TO(4*PXFWORD)-1 DO PXFRASTER[PXFRAS+M]:=CHR(0);
PXFRAS:=PXFRAS+(4*PXFWORD);RASSTART:=RASSTART+(4*CNTWORD);
END END ELSE BEGIN K:=4*PXFWORD;
FOR L:=0 TO RAW-1 DO BEGIN FOR M:=0 TO(CNTWORD*4)-1 DO IF M<K THEN
PXFRASTER[PXFRAS+M]:=PBUF.C[RASSTART+M];PXFRAS:=PXFRAS+(4*PXFWORD);
RASSTART:=RASSTART+(4*CNTWORD);BITMASK(PXFRASTER[PXFRAS-1],BITCLEAR);
END END END;FOR J:=0 TO 127 DO BEGIN DEFSTART:=PXLLEN-4*517+16*J;
K:=J*16;FOR M:=0 TO 3 DO BEGIN PXFDICT[K+M+4]:=PBUF.C[DEFSTART+M+4];
PXFDICT[K+M+12]:=PBUF.C[DEFSTART+M+12];END END;M:=128*16+5*4;
FOR L:=1 TO 5*4 DO PXFDICT[M-L]:=PBUF.C[PXLLEN-L];
FOR L:=4 TO PXFRAS-1 DO PBUF.C[L]:=PXFRASTER[L];M:=PXFRAS;
FOR L:=0 TO(128*16)-1 DO PBUF.C[M+L]:=PXFDICT[L];
FOR L:=(128*16)TO(128*16)+(5*4)-1 DO PBUF.C[M+L]:=PXFDICT[L];
M:=M+(128*16)+(5*4);FOR L:=M TO PXLLEN DO PBUF.C[L]:=CHR(0);PXLLEN:=M;
PXLCOUNT:=PXLLEN DIV 512;
IF(PXLLEN MOD 4)<>0 THEN WRITELN('PXL file length not multiple of 4')
ELSE 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')ELSE 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')ELSE
WRITELN('PXL Length ',PXLLEN:1)END{:48}{50:}
ELSE IF VERB=13 THEN BEGIN WHILE(ILP<=ILLEN)AND(INLINE[ILP]=' ')DO ILP:=
ILP+1;IF ILP<ILLEN THEN K:=GETFIXNUM ELSE K:=0;
IF(K<0)OR(K>127)THEN K:=0;
FOR J:=K TO 127 DO BEGIN DEFSTART:=PXLLEN-4*517+J*16;
COLUMN:=(ORD(PBUF.C[(DEFSTART)+1])+256*ORD(PBUF.C[DEFSTART]));
RAW:=(ORD(PBUF.C[(DEFSTART+2)+1])+256*ORD(PBUF.C[DEFSTART+2]));
RASSTART:=(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])))));
XOFFSET:=(ORD(PBUF.C[(DEFSTART+4)+1])+256*ORD(PBUF.C[DEFSTART+4]));
YOFFSET:=(ORD(PBUF.C[(DEFSTART+6)+1])+256*ORD(PBUF.C[DEFSTART+6]));
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])))));
WRITELN('-------------------');WRITELN('Caractere <',J:1,'>');
WRITE(' Code ');
IF(32<=J)AND(J<127)THEN WRITELN(CHR(J))ELSE IF J=127 THEN WRITELN('DEL')
ELSE WRITELN('^',CHR(ORD('A')+J-1));
WRITELN(' Ligne ',RAW:1,' -- Colonne ',COLUMN:1);
WRITELN(' X offset ',XOFFSET:1,' -- Y offset ',YOFFSET:1);
WRITELN(' TFM WIDTH ',TFMWIDTH:1);WRITELN END END{:50}{52:}
ELSE IF VERB=14 THEN BEGIN WHILE(ILP<=ILLEN)AND(INLINE[ILP]=' ')DO ILP:=
ILP+1;IF ILP<ILLEN THEN N:=GETFIXNUM ELSE N:=0;
IF N<=0 THEN BEGIN TFMMOD:=0;
FOR J:=0 TO 127 DO BEGIN DEFSTART:=PXLLEN-4*517+J*16;
K:=(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])))));
IF K>TFMMOD THEN BEGIN TFMMOD:=K;M:=J;TFMWIDTH:=DEFSTART END END;
END ELSE BEGIN DEFSTART:=PXLLEN-4*517+N*16;
TFMMOD:=(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])))));
M:=N;TFMWIDTH:=DEFSTART END;
WRITE('La valeur TFM_WIDTH retenue est celle du caractere ',M:1,' <');
IF(32<=M)AND(M<127)THEN WRITE(CHR(M))ELSE IF M=127 THEN WRITE('DEL')ELSE
WRITE('^',CHR(ORD('A')+M-1));WRITELN('> et vaut ',TFMMOD:1);
FOR J:=0 TO 127 DO BEGIN DEFSTART:=PXLLEN-4*517+J*16;
FOR M:=12 TO 15 DO PBUF.C[DEFSTART+M]:=PBUF.C[TFMWIDTH+M]END END{:52}
{54:}
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{:54}{55:}
ELSE IF VERB=99 THEN GOTO 9999{:55};GOTO 9998;9999:{:10}END.{:4}
