{ GEMHEADR.PAS (16 March 1993) (Borland Pascal 7.0, real) }
program GEMHeader;
{==============================================================================
   This program requires the name of a file containing a screen font in GEM
format.  The name may be specified as a command-line argument; if it isn't, the
program prompts for the name.
   The program loads the font and reports the information contained in its
header.
   The output of the program may be redirected.
==============================================================================}
uses CRT;

type

  TGEMFontHeader = record
    FontID: word;
    PointSize: word;
    FontName: array[0..31] of char;
    LowASCII: word;
    HighASCII: word;
    Top, Ascent, Half, Descent, Bottom: integer;
    WidestCharacterWidth: word;
    WidestCellWidth: word;
    LeftOffset: integer;
    RightOffset: integer;
    Thickness: word;
    UnderscoreThickness: word;
    LightTextMask: word;
    ItalicTextMask: word;
    Flags: word;
    HorizontalOffsetTableOffset: longint;
    CharacterOffsetTableOffset: longint;
    FontDataOffset: longint;
    SpanWidth: word;
    Height: word;
    NextFontOffset: longint
  end;
  PGEMFontHeader = ^TGEMFontHeader;

var

  RedirectedOutput: text;
  FontFileName: string;
  FontFile: file;
  FontHeader: TGEMFontHeader;
  Hyphens: string[79];
{*****************************************************************************}
const
  HexadecimalDigit: array[0..15] of Char = '0123456789ABCDEF';
function HexByte(var B): string;
var
  BValue: Byte absolute B;
  S: string[2];
begin { HexByte }
  S[1] := HexadecimalDigit[BValue shr 4];
  S[2] := HexadecimalDigit[BValue and $0F];
  S[0] := #2;
  HexByte := S
end; { HexByte }
{*****************************************************************************}
function HexWord(var W): string;
var
  WValue: Word absolute W;
  HighPart, LowPart: Byte;
begin { HexWord }
  HighPart := Hi(WValue);
  LowPart := Lo(WValue);
  HexWord := HexByte(HighPart)+HexByte(LowPart)
end; { HexWord }
{*****************************************************************************}
begin { GEMHeader }
  Assign(RedirectedOutput,'');
  Rewrite(RedirectedOutput);

  if ParamCount = 0
    then begin
      Write('Enter the name of the GEM font file: ');
      Readln(FontFileName)
    end
    else FontFileName := ParamStr(1);
  FileMode := 0;  { so a read-only file can be processed }
  Assign(FontFile,FontFileName);
  Reset(FontFile,1);

  BlockRead(FontFile,FontHeader,SizeOf(TGEMFontHeader));
  Close(FontFile);

  FillChar(Hyphens[1],79,'-');
  Hyphens[0] := Chr(79);
  Writeln(RedirectedOutput,Hyphens);

  Writeln(RedirectedOutput,  'File name ................. ',FontFileName);
  with FontHeader do begin
    Writeln(RedirectedOutput,'Font ID ................... ',FontID);
    Writeln(RedirectedOutput,'Font name ................. ',FontName);
    Writeln(RedirectedOutput,'Point size ................ ',PointSize);
    Writeln(RedirectedOutput,'Low ASCII ................. ',LowASCII);
    Writeln(RedirectedOutput,'High ASCII ................ ',HighASCII);
    Writeln(RedirectedOutput,'Top ....................... ',Top);
    Writeln(RedirectedOutput,'Ascent .................... ',Ascent);
    Writeln(RedirectedOutput,'Half ...................... ',Half);
    Writeln(RedirectedOutput,'Descent ................... ',Descent);
    Writeln(RedirectedOutput,'Bottom .................... ',Bottom);
    Writeln(RedirectedOutput,'Maximum character width ... ',WidestCharacterWidth);
    Writeln(RedirectedOutput,'Maximum cell width ........ ',WidestCellWidth);
    Writeln(RedirectedOutput,'Italic left offset ........ ',LeftOffset);
    Writeln(RedirectedOutput,'Italic right offset ....... ',RightOffset);
    Writeln(RedirectedOutput,'Bold thickness ............ ',Thickness);
    Writeln(RedirectedOutput,'Underscore thickness ...... ',UnderscoreThickness);
    Writeln(RedirectedOutput,'Light text mask ........... ',HexWord(LightTextMask),' hex');
    Writeln(RedirectedOutput,'Italic text mask .......... ',HexWord(ItalicTextMask),' hex');
    Writeln(RedirectedOutput,'Flags ..................... ',HexWord(Flags),' hex');
    Writeln(RedirectedOutput,'Font data row bytes ....... ',SpanWidth);
    Writeln(RedirectedOutput,'Font data rows ............ ',Height)
  end; { with ... }
  Close(RedirectedOutput)
end. { GEMHeader }
