diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /fonts/apl/clean.pas |
Initial commit
Diffstat (limited to 'fonts/apl/clean.pas')
-rw-r--r-- | fonts/apl/clean.pas | 226 |
1 files changed, 226 insertions, 0 deletions
diff --git a/fonts/apl/clean.pas b/fonts/apl/clean.pas new file mode 100644 index 0000000000..611d434fe5 --- /dev/null +++ b/fonts/apl/clean.pas @@ -0,0 +1,226 @@ + +%============================================================================ +% 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. |