summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/source/fonts/apl/clean.pas
diff options
context:
space:
mode:
Diffstat (limited to 'Master/texmf-dist/source/fonts/apl/clean.pas')
-rw-r--r--Master/texmf-dist/source/fonts/apl/clean.pas226
1 files changed, 0 insertions, 226 deletions
diff --git a/Master/texmf-dist/source/fonts/apl/clean.pas b/Master/texmf-dist/source/fonts/apl/clean.pas
deleted file mode 100644
index 611d434fe59..00000000000
--- a/Master/texmf-dist/source/fonts/apl/clean.pas
+++ /dev/null
@@ -1,226 +0,0 @@
-
-%============================================================================
-% C L E A N . P A S
-%============================================================================
-
-% A sample Turbo Pascal (3.0) program for truncating downloaded pixel files
-% to the standard size assumed by some TeX-oriented programs (starting from
-% a file of type: File of Array[0..511] of Byte.
-
-Program Clean_Up(Output,Input,Font_List_File);
-
-LABEL
-
-Report;
-
-
-TYPE
-
-Name_Of_File =String[20];
-Name_Of_Font =String[20];
-Byte =0..255;
-Byte_Block =Array[0..511] Of Byte;
-Word =Array[0..3] Of Byte;
-
-
-
-VAR
-
-Font_List_File:Text;
-Pxl_File:File of Byte_Block;
-Block:Byte_Block;
-Last_Blocks:Array[0..1023] Of Byte;
-One_Word:Word;
-File_Name,New_File_Name:Name_Of_File;
-Font_Name:Name_Of_Font;
-New_Pxl_File:File Of Word;
-File_Id_Found,Bad_Pxl_File:Boolean;
-End_Of_Block:Boolean;
-IOR,Word_Pos:Integer;
-Ch:Char;
-Word_Value:Real;
-
-
-PROCEDURE Banner;
-
- Begin
- Writeln('!==================================================!');
- Writeln('! The files to be repaired are assumed consist of !');
- Writeln('! blocks 512 bytes long. The repaired files consist!');
- Writeln('! of words. The names of files are supposed to be !');
- Writeln('! found from a separate file. !');
- Writeln('!==================================================!');
- End;
-
-
-
-PROCEDURE Initialize;
-
- Begin
- File_Id_Found:=False;
- Word_Pos:=0;
- End_Of_Block:=False;
- Bad_Pxl_File:=False;
- End;
-
-
-
-
-PROCEDURE Check_File_Id;
-
-VAR
-
-A:Integer;
-
- Begin
- If Abs(Word_Value)<2000.0 Then
- Begin
- A:=Round(Word_Value);
- If (A=1001) Or (A=1002) Then File_Id_Found:=True;
- End;
- End;
-
-
-
-PROCEDURE READ_NEXT_WORD;
-
-VAR
-
-I:Integer;
-
- Begin
- If Not End_Of_Block Then
- Begin
- For I:=0 To 3 Do One_Word[3-I]:=Last_Blocks[1023-((4*Word_Pos)+I)];
- Word_Pos:=Word_Pos+1;
- If Word_Pos>255 Then End_Of_Block:=True;
- End;
- End;
-
-
-
-
-PROCEDURE EVALUATE_NEXT_WORD;
-
- Begin
- Read_Next_Word;
- Word_Value:=One_Word[3]+256.0*(One_Word[2]+
- 256.0*(One_Word[1]+256.0*One_Word[0]));
-
- End;
-
-
-
-PROCEDURE Find_File_Id;
-
-Var
-
-K:Integer;
-
- Begin
- While (Not File_Id_Found) And (Not End_Of_Block) Do
- Begin
- Evaluate_Next_Word;
- Check_File_Id;
- End;
- If Not File_Id_Found Then
- Begin
- For K:=Length(Font_Name) To 30 Do Write('.');
- Writeln(' Bad Pxl File, File Not Repaired');
- Bad_Pxl_File:=True;
- End;
- End;
-
-
-
-PROCEDURE Rewrite_Pxl_File(Var Font_Name,File_Name:Name_Of_File);
-
-LABEL
-
-Report;
-
-VAR
-
-I,J,K,IOR:Integer;
-
- Begin
- Assign(Pxl_File,Font_Name);
- {$I-} Reset(Pxl_File) {$I+};
- IOR:=IOresult;
- If IOR<>0 Then Goto Report;
- Assign(New_Pxl_File,File_Name);
- Rewrite(New_Pxl_File);
- Seek(Pxl_File,0);
- For I:=0 To Filesize(Pxl_File)-3 Do
- Begin
- Read(Pxl_File,Block);
- For J:=0 To 127 Do
- Begin
- For K:=0 To 3 Do One_Word[K]:=Block[(4*J)+K];
- Write(New_Pxl_File,One_Word);
- End;
- End;
- Read(Pxl_File,Block);
- For I:=0 To 511 Do
- Last_Blocks[I]:=Block[I];
- Read(Pxl_File,Block);
- For I:=512 To 1023 Do
- Last_Blocks[I]:=Block[I-512];
- Find_File_ID;
- Word_Pos:=255-Word_Pos;
- If Not Bad_Pxl_File Then
- Begin
- For I:=0 To Word_Pos+1 Do
- Begin
- For K:=0 To 3 Do One_Word[K]:=Last_Blocks[(4*I)+K];
- Write(New_Pxl_File,One_Word);
- End;
- Report:Begin
- For I:=0 To 30-Length(Font_Name) Do Write('.');
- If IOR<>0 Then Writeln('File Not Found') Else
- Begin
- Writeln(New_File_Name);
- Close(New_Pxl_File);
- Close(Pxl_File);
- End;
- End;
- End;
- End;
-
-
-
-
- (*** M A I N P R O G R A M ***)
-BEGIN
-
- Banner;
- Writeln;
- Writeln('Give The Name Of File Containing The List Of Pxl Files: ');
- Readln(File_Name);
- Assign(Font_List_File,File_Name);
- {$I-} Reset(Font_List_File) {$I+};
- IOR:=IOresult;
- If IOR<>0 Then Goto Report;
- While Not Eof(Font_List_File) Do
- Begin
- Initialize;
- Font_Name:='';
- While Not Eoln(Font_List_File) Do
- Begin
- Read(Font_List_File,Ch);
- Font_Name:=Font_Name+Ch;
- End;
- Readln(Font_List_File);
- Write(Font_Name);
- New_File_Name:=Copy(Font_Name,1,Pos('.',Font_Name)-1)+'.rxl';
- Rewrite_Pxl_File(Font_Name,New_File_Name);
- End;
- Writeln;
- Report: Begin
- If IOR<>0 Then Writeln('File Not Found!') Else
- Begin
- Writeln('............Done!...........');
- Close(Font_List_File);
- End;
- End;
-END.