Power-Programmierung/CD1.mdf/pascal/library/dos/grafik/fs/fs.pas

Pascal/Delphi Source File | 1990-11-15 | 5.3 KB | 230 lines

{$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
{$M 1024,0,655360}

(*     This program may be distributed and modified freely,      *)
(*     only if done without commercial fee. tke 15-NOV-1990.     *)

Const  DataStart = $DB;
       HeaderEnd = $7F;

       FontNameOffset = $72;
       SizeOffset     = FontNameOffset+4;

       TmpName = '@@@FS@@@.FNT';


Var    F1, F2 : File Of Byte;

       B,B0,B1,B2,B3:Byte; I,Size:Word;

       Name : String;

Const  Header : Array [0..HeaderEnd] Of Byte = (

       Ord('P'),Ord('K'),                 {Somebody's initials at Borland :-)}

       $08,$08,                           {?}

       Ord('B'),                          {Text. Any length?}
       Ord('G'),
       Ord('I'),
       Ord(' '),
       Ord('S'),
       Ord('t'),
       Ord('r'),
       Ord('o'),
       Ord('k'),
       Ord('e'),
       Ord('d'),
       Ord(' '),
       Ord('F'),
       Ord('o'),
       Ord('n'),
       Ord('t'),
       Ord(' '),
       Ord('V'),
       Ord('1'),
       Ord('.'),
       Ord('1'),
       Ord(','),
       Ord(' '),
       Ord('1'),
       Ord('4'),
       Ord('-'),
       Ord('J'),
       Ord('u'),
       Ord('n'),
       Ord('-'),
       Ord('1'),
       Ord('9'),
       Ord('9'),
       Ord('0'),
       Ord('.'),
       $0D,$0A,                    {Cr + Lf}

       Ord('C'),
       Ord('o'),
       Ord('p'),
       Ord('y'),
       Ord('r'),
       Ord('i'),
       Ord('g'),
       Ord('h'),
       Ord('t'),
       Ord(' '),
       Ord('('),
       Ord('c'),
       Ord(')'),
       Ord(' '),
       Ord('1'),
       Ord('9'),
       Ord('9'),
       Ord('0'),
       Ord(','),
       Ord(' '),
       Ord('U'),
       Ord('n'),
       Ord('i'),
       Ord('v'),
       Ord('e'),
       Ord('r'),
       Ord('s'),
       Ord('i'),
       Ord('t'),
       Ord('y'),
       Ord(' '),
       Ord('o'),
       Ord('f'),
       Ord(' '),
       Ord('T'),
       Ord('u'),
       Ord('r'),
       Ord('k'),
       Ord('u'),
       Ord(','),
       Ord(' '),
       Ord('S'),
       Ord('p'),
       Ord('a'),
       Ord('c'),
       Ord('e'),
       Ord(' '),
       Ord('R'),
       Ord('e'),
       Ord('s'),
       Ord('e'),
       Ord('a'),
       Ord('r'),
       Ord('c'),
       Ord('h'),
       Ord(' '),
       Ord('L'),
       Ord('a'),
       Ord('b'),
       Ord('o'),
       Ord('r'),
       Ord('a'),
       Ord('t'),
       Ord('o'),
       Ord('r'),
       Ord('y'),
       Ord('.'),

       $0D,$0A,                    {Cr + Lf}

       $00,$1A,                    {End-of-Text}

       Succ(HeaderEnd), $00,       {Header size = 80h (WORD!)}

       $00,                        {Font name, 4 bytes. Offset for this}
       $00,                        {header text is $5C}
       $00,
       $00,

       $00, $00,                   {Data size = FileSize - Header size (WORD)}

       $01,                        {Major version number}
       $01,                        {Minor version number}
       $01,                        {Minimal major version number}
       $00,                        {Minimal major version number}

       {Fill unused with zero.}
       $00,$00,$00,$00);


Procedure Halt(S:String);
Begin
  Writeln(^M^J,'FS: ',S);
  System.Halt(1);
End;


Begin

  Write(^M^J,'FS: Borland FE, "Font Editor" font file signature fix-up utility V1.0, by tke.',^M^J,
             '    Copyright (c) 1990, Space Research Laboratory, University of Turku, Finland.',^M^J);

  Write(^M^J,'Enter font name (4 chars) [.CHR]: ');
  Readln(Name);

  If (Length(Name)<>4) Then Halt('Invalid file name, length must be 4 chars!');
  Name:=Name+'.CHR';

  Assign(F1,Name);
  ReSet(F1);
  If (IOresult<>0) Then Halt('Can''t open input file?');

  If (FileSize(F1)<=Succ(DataStart)) Then Halt('Truncated file?');

  {Check if the file is already converted}
  Read(F1,B0); Read(F1,B1); Read(F1,B2); Read(F1,B3);
  If (B0=Ord('P')) AND (B1=Ord('K')) AND (B2=$08) AND (B3=$08)
    Then Halt('Signature already fixed?');

  ReSet(F1);

  Assign(F2,TmpName);
  Reset(F2);
  If (IOresult=0) Then Halt('Temporary output file "'+TmpName+'" already exist?');

  ReWrite(F2);
  If (IOresult<>0) Then Halt('Can''t create temporary output file "'+TmpName+'" ?');

  Size := FileSize(F1) - Succ(DataStart);

  Header[FontNameOffset]   := Ord(UpCase(Name[1]));
  Header[FontNameOffset+1] := Ord(UpCase(Name[2]));
  Header[FontNameOffset+2] := Ord(UpCase(Name[3]));
  Header[FontNameOffset+3] := Ord(UpCase(Name[4]));

  Header[SizeOffset]   := Lo(Size);
  Header[SizeOffset+1] := Hi(Size);

  For B:=0 To HeaderEnd Do Begin
    Write(F2,Header[B]);
    If (IOresult<>0) Then Halt('Can''t write into output file "'+TmpName+'" ?');
  End;

  Write(^M^J,'Converting ... ');

  I:=0;
  While NOT EOF(F1) Do Begin
    Read(F1,B);
    If (IOresult<>0) Then Halt(^M+^J+'Can''t read from input file?');
    If (I>DataStart) Then Begin
      Write(F2,B);
      If (IOresult<>0) Then Halt(^M+^J+'Can''t write into output file "'+TmpName+'" ?');
    End;
    Inc(I);
  End;

  Close(F1);
  Close(F2);

  Writeln(Succ(HeaderEnd),' bytes header + ',Size,' bytes of data written.');

  Erase(F1);
  Rename(F2,Name);

End.