(* GDIR.PAS -- show directory of a GEOS disk image
** 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 Gdir;

USES geos, global, errors, coding, d64, dir;

CONST
 DosTypeName: 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
 image_name, pattern: STRING;
 use_dir: ARRAY [0..9] OF BOOLEAN;
 use_all_dir: BOOLEAN;
 PageMask: WORD;

PROCEDURE usage;
BEGIN
 WriteLn('GDIR  Version 0.3',country,'  View the directory of a GEOS disk image');
 WriteLn('Copyright (c) 1995,1996 Jochen Metzinger ');
 WriteLn;
 WriteLn(short_usage);
 WriteLn;
 WriteLn('  image       disk image');
 WriteLn('  filename    file name selector');
 WriteLn('    /1 .. /9    directory page 1 .. 9');
 WriteLn('    /B          border directory');
 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: INTEGER; par: STRING;
BEGIN
 short_usage := 'GDIR [/?] image [filename] [options]';
 image_name := '';
 pattern := '';
 FOR i := 0 TO 9 DO
  use_dir[i] := FALSE;
 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;
      '0'..'9': use_dir[ORD(par[j])-ORD('0')] := TRUE;
      'B': use_dir[0] := TRUE;
      'G': SetCoding(ge_coding);
      'E': SetCoding(uk_coding);
      ELSE FATAL('unknown option '+par);
     END; (* case *)
   END
  ELSE IF image_name = '' THEN
   image_name := AddExt(par, '.D64')
  ELSE IF pattern = '' THEN
   BEGIN
    j := Pos('*',par);
    IF j > 0 THEN Delete(par,j+1,$FF);
    pattern := Copy(par,1,16);
   END
  ELSE
   FATAL('too many arguments');
 END; (* for *)
 IF image_name = '' THEN usage;
 IF pattern = '' THEN pattern := '*';
 d64_open(image_name);
 short_usage := '';
 InitDir;
 use_all_dir := TRUE;
 FOR i := 0 TO 9 DO
  IF use_dir[i] THEN
   use_all_dir := FALSE;
 IF IsGeosDisk THEN
  PageMask := $FFFF
 ELSE
  PageMask := $0000;
END; (* init *)

FUNCTION Space(b: INTEGER): STRING;
 VAR s: STRING;
BEGIN
 s := '';
 WHILE b > 0 DO BEGIN
  s := s + ' ';
  Dec(b);
 END;  (* while *)
 Space := s;
END; (* Space *)

PROCEDURE WriteDirRec(d: DirRec);
 VAR fn: STRING;
BEGIN
 WITH d DO BEGIN
  Write(size:3);
  IF dostype AND $80 <> 0 THEN Write(' ') ELSE Write('*');
  fn := TransStr(DirFileName(d));
  Write('"',fn,'"',Space(16-Length(fn)));
  IF dostype AND $40 <> 0 THEN Write('<') ELSE Write(' ');
  Write(DosTypeName[dostype AND $07]);
  IF dostype AND $07 = 4 THEN BEGIN
   Write(' [',struct:3,']'); (* record size *)
   EXIT;
  END; (* if *)
  IF geostype = 0 THEN
   EXIT;
  IF geostype > 15
   THEN Write(' [??',HexStr(geostype,2))
   ELSE Write(' [',GeosTypeName[geostype]);
  IF struct = 0 THEN
   Write(' SEQ ')
  ELSE IF struct = 1 THEN
   Write(' VLIR')
  ELSE
   Write(' ??',HexStr(struct,2));
  Write(' '+long2str(1900+year,-4)+'-'+long2str(month,-2));
  Write('-'+long2str(day,-2));
  Write(' '+long2str(hour,-2)+':'+long2str(minute,-2)+']');
 END; (* with *)
END; (* WriteDirRec *)

FUNCTION IsInPage(page: INTEGER): BOOLEAN;
BEGIN
 IsInPage := TRUE;
 IF use_all_dir THEN EXIT;
 IsInPage := FALSE;
 IF (page < 0) OR (page > 9) THEN EXIT;
 IsInPage := use_dir[page];
END; (* IsInPage *)

FUNCTION LIKE(fn, pt: STRING): BOOLEAN;
 VAR i: INTEGER;
BEGIN
 LIKE := FALSE;
 FOR i := 1 TO Length(pt) DO BEGIN
  IF pt[i] = '*' THEN BEGIN
   LIKE := TRUE;
   EXIT;
  END; (* if *)
  IF Length(fn) < i THEN
   EXIT;
  IF pt[i] <> '?' THEN
   IF pt[i] <> fn[i] THEN
    EXIT;
 END; (* for *)
 LIKE := (Length(fn) = Length(pt));
END; (* LIKE *)

PROCEDURE OutputDir;
 VAR dr: DirRec; page0, page: WORD;
BEGIN (* OutputDir *)
 DiskName := TransStr(DiskName);
 DiskID := TransStr(DiskID);
 DiskOS := TransStr(DiskOS);
 Write('  0 "',DiskName,'"',Space(17-Length(DiskName)));
 WriteLn(DiskID,'  ',DiskOS,'  <',image_name,'>');
 page0 := PageMask;
 RewindDir;
 WHILE ReadDir(dr, page) DO 
  IF dr.dostype <> 0 THEN BEGIN
   page := page AND PageMask;
   IF IsInPage(page) THEN
    IF LIKE(TransStr(DirFileName(dr)), pattern) THEN BEGIN
     IF page <> page0 THEN BEGIN
      WriteLn('----- page ',page:2,' -----------------------------------------');
      page0 := page;
     END; (* if *)
     WriteDirRec(dr);
     WriteLn;
    END; (* if *)
  END; (* if *)
 IF IsGeosDisk THEN
  WriteLn('--------------------------------------------------------');
 WriteLn(FreeBlocks:3,' blocks free');
END; (* OutputDir *)

BEGIN
 Init;
 OutputDir;
 d64_close;
END. (* Gdir *)