(* CVT_INFO.PAS -- get information from a GEOS file
** Copyright (c) 1995,1996 Jochen Metzinger
**
** This program is free software; you can redistribute it and/or modify
** it under the terms of the GNU General Public License as published by
** the Free Software Foundation; either version 2, or (at your option)
** any later version.
**
** This program is distributed in the hope that it will be useful,
** but WITHOUT ANY WARRANTY; without even the implied warranty of
** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
** GNU General Public License for more details.
**
** You should have received a copy of the GNU General Public License
** along with this program; if not, write to the Free Software
** Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*)

PROGRAM cvt_info;

USES global, geos, coding, errors, cvt;

CONST
 FileTypName: ARRAY [$0..$7] OF STRING[3] =
  ('DEL', 'SEQ', 'PRG', 'USR',
   'REL', '?05', '?06', '?07');

 GeosTypeName: ARRAY [0..15] OF STRING[4] =
  ('C=64', 'BAS',  'ASM',  'DATA', 'SYS',
   'HELP', 'APPL', 'DOC',  'FONT', 'PRT',
   'IN',   'DISK', 'STRT', 'TMP',  'SELF',
   'MOUS');

VAR
 line: INTEGER;
 info: InfoRec;
 i: INTEGER;
 result: WORD;

PROCEDURE usage;
BEGIN
 WriteLn('CVT_INFO  Version 0.3',country,'  Show the info chain of a GEOS file');
 WriteLn('Copyright (c) 1995,1996 Jochen Metzinger ');
 WriteLn;
 WriteLn(short_usage);
 WriteLn;
 WriteLn('  filename    GEOS file');
 Write('    /G          german');
 IF default_code = ge_coding THEN Write(' [default]');
 WriteLn;
 Write('    /E          english');
 IF default_code = uk_coding THEN Write(' [default]');
 WriteLn;
 HALT(1);
END; (* usage *)

PROCEDURE Init;
 VAR i, j: WORD; par: STRING;
  in_name: STRING;
BEGIN
 short_usage := 'CVT_INFO [/?] filename [options]';
 in_name := '';
 IF ParamCount = 0 THEN
  usage;
 FOR i := 1 TO ParamCount DO BEGIN
  par := ParamStr(i);
  IF (par[1] = '/') OR (par[1] = '-') THEN
   BEGIN
    IF Length(par) = 1 THEN
     FATAL('unknown option '+par);
    FOR j := 2 TO Length(par) DO
     CASE UpCase(par[j]) OF
      '?', 'H': usage;
      'G': SetCoding(ge_coding);
      'E': SetCoding(uk_coding);
      ELSE FATAL('unknown option '+par);
     END; (* case *)
   END
  ELSE IF in_name = '' THEN
   in_name := AddExt(par, CVT_EXT)
  ELSE
   FATAL('too many arguments');
 END; (* for *)
 IF in_name = '' THEN usage;
 cvt_open(in_name);
 short_usage := '';
END; (* init *)

PROCEDURE NewLine;
 VAR i, j: BYTE;
  b0, b1, b: BYTE;
BEGIN
 WriteLn;
 i := 2*line;
 IF i <= 21 THEN BEGIN
  i := 3*i;
  FOR j := 0 TO 2 DO BEGIN
   b0 := info.icon[j+i];
   IF i <= 62-5
    THEN b1 := info.icon[j+i+3]
    ELSE b1 := 0;
   FOR b := 1 TO 8 DO BEGIN
    IF b0 AND $80 = 0 THEN
     IF b1 AND $80 = 0 THEN
      Write(' ')
     ELSE
      Write('Ü')
    ELSE
     IF b1 AND $80 = 0 THEN
      Write('ß')
     ELSE
      Write('Û');
    b0 := (b0 AND $7F) SHL 1;
    b1 := (b1 AND $7F) SHL 1;
   END; (* for *)
  END; (* for *)
  Write('  ');
 END; (* if *)
 Inc(line);
END;(* NewLine *)

BEGIN (* cvt_info *)
 Init;
 cvt.cvt_info(info);
 cvt_close;
 line := 0;
 NewLine;
 WITH info DO BEGIN
  Write('File: ', cvt_name,'  <',ParamStr(1),'>');
  NewLine;
  Write('Type: ',FileTypName[ftyp AND $07],',');
  IF gtyp > 15
   THEN Write('??',HexStr(gtyp,2),',')
   ELSE Write(GeosTypeName[gtyp],',');
  IF strk = 0 THEN
   Write('SEQ')
  ELSE IF strk = 1 THEN
   Write('VLIR')
  ELSE
   Write('??',HexStr(strk,2));
  NewLine;
  Write('Program: ',HexStr(prg_start,4),'-');
  Write(HexStr(prg_end,4),'  Start: ',HexStr(sys_addr,4));
  NewLine;
  NewLine;
  Write('Class      : ');
  i := 1;
  WHILE i <= 20 DO BEGIN
   IF class[i] = #0
    THEN i := 20
    ELSE Write(TransChr(class[i]));
   Inc(i);
  END; (* while *)
  NewLine;
  IF gtyp <> 8 THEN
   BEGIN (* no font *)
    Write('Disk/Author: ');
    i := 1;
    WHILE i <= 20 DO BEGIN
     IF disk[i] = #0
      THEN i := 20
      ELSE Write(TransChr(disk[i]));
     Inc(i);
    END; (* while *)
    NewLine;
    Write('Generator  : ');
    i := 1;
    WHILE i <= 20 DO BEGIN
     IF appl[i] = #0
      THEN i := 20
      ELSE Write(TransChr(appl[i]));
     Inc(i);
    END; (* while *)
    NewLine;
   END
  ELSE
   BEGIN (* font *)
    Write('FontID     : 0x',HexStr(w[128 DIV 2],4),'  ',w[64]);
    NewLine;
    Write('Sizes      :');
    i := 130 DIV 2;
    WHILE i <= 160 DIV 2 DO BEGIN
     IF w[i] = 0
      THEN i := 255
      ELSE Write(' ',w[i] AND $003F);
     Inc(i);
    END; (* while *)
    NewLine;
   END; (* else *)
  NewLine;
  Write('Intern     :');
  FOR i := 01 TO 12 DO Write(' ',HexStr(intern[i],2));
  NewLine;
  Write('            ');
  FOR i := 13 TO 23 DO Write(' ',HexStr(intern[i],2));
  WHILE line <= 11 DO NewLine;
  Write('Info text: ');
  i := 1;
  WHILE i <= 96 DO BEGIN
   IF text[i] = #0 THEN
    i := 96
   ELSE IF text[i] = #13 THEN
    WriteLn
   ELSE
    Write(TransChr(text[i]));
   Inc(i);
  END; (* while *)
  WriteLn;
 END; (* with *)
END. (* cvt_info *)