IMPLEMENTATION MODULE DuTypefile;

(*$S-*)(*$T-*)(*$A+*)

(*
     Written by Greg Browne from ideas in duIII.c - many thanks to
     Chris Nicotra, Dave Jobusch, Ed Alford, and many others whose
     names I have not seen on the source files who have worked on
     the development and extension of that fine directory utility program.

   PURPOSE      A self-contained, IMPORTable pair of procedures to allow
                a screen display - or printer copy - in Hex or ASCII of
                any disk files.

   CHANGES      1/24/87         Built original.

*)

FROM SYSTEM             IMPORT  ADR;
FROM Strings            IMPORT  String,InitStringModule,Concat,Assign;
FROM DOSFiles           IMPORT  FileHandle,ModeOldFile,ModeNewFile,Close,
                                Open,Read,Write,Lock,Unlock,AccessRead,
                                FileLock;
FROM DOSLibrary         IMPORT  DOSName,DOSBase;
FROM Libraries          IMPORT  OpenLibrary,CloseLibrary;

(*COMMENTS*)

(* This module tries to open the DOSLibrary for use in case it is not open.
   IT DOES NOT CLOSE IT.  The user is left with that chore.             *)

(* All constants and variables are internal.  Nothing but PROCEDURES
   are available to the user.                                           *)

CONST
 lf = 12C;
 dot = ".";
 cr = 15C;
  expl = "q[33m<CR>q[2m = next line - q[33m<SPACE>q[2m = next page - q[33m<ESC>q[2m = abortq[0m";
  wipe  = "x                                                                           x";
  last ="q[33mEnd of File.  Press SPACE q[0m";

VAR
  HexCh         : ARRAY [0..16] OF CHAR;
  Disk,
  Display       : FileHandle;
  fp1,fp2,
  fp3,fp4       : CARDINAL;
  c             : CHAR;
  len,len2,
  i,
  top,
  linecount,
  nextout       : CARDINAL;
  Result        : LONGINT;
  DiskERR,
  PastEOF,
  KeepWaiting,
  OnScreen,
  Quit  : BOOLEAN;
  command       : ARRAY[0..79] OF CHAR;
  writebuffer   : ARRAY[0..80] OF CHAR;
  t2            : ARRAY[1..20] OF CHAR;
  inbuffer      : ARRAY[0..512] OF CHAR;


(* INTERNAL PROCEDURES - NOT IN .def FILE AND NOT IMPORTABLE *)


PROCEDURE MyOpen(VAR ufn:ARRAY OF CHAR):BOOLEAN;
VAR i:CARDINAL;lk:FileLock;
BEGIN
  linecount := 0;
  Disk := 0;
  Quit := FALSE;
  lk := Lock(ufn,AccessRead);
  IF (lk <> 0) THEN
    Unlock(lk);
    Disk := Open(ufn,ModeOldFile);
  END;
  IF Disk = 0 THEN
    RETURN FALSE
  ELSE
    IF OnScreen THEN
      Concat("RAW:0/0/640/200/Listing of: ",ufn,command);
    ELSE
      command := "PRT:"
    END;
    Display := Open(command,ModeNewFile);
    IF Display = 0 THEN
      Close(Disk);              (* if here - Disk is open *)
      RETURN FALSE
    ELSE
      Quit := FALSE;
      RETURN TRUE
    END
  END
END MyOpen;

(* write a string to 'f' - faster than multiple WriteChar's *)

PROCEDURE WriteString(f:FileHandle;VAR s:ARRAY OF CHAR);
VAR i:CARDINAL;
BEGIN
  i := 0;
  WHILE (i<=HIGH(s)) AND (s[i]<>0C) DO INC(i) END;
  Result := Write(f,ADR(s),LONGCARD(i));
END WriteString;

(* read (with wait) single character from 'f' (here it is keyboard) *)

PROCEDURE ReadChar(f:FileHandle;VAR c:CHAR);
BEGIN
  Result := Read(f,ADR(c),1);
  IF Result < 1 THEN c := 0C END
END ReadChar;

(* Press Space message and wait for continue-nextline-cancel *)

PROCEDURE Pause;
BEGIN
  IF OnScreen THEN
    linecount := 1;
    WriteString(Display,expl);
    KeepWaiting := TRUE;
    REPEAT
      ReadChar(Display,c);
      IF c = CHR(27) THEN
        Quit := TRUE;
      ELSIF c = CHR(13) THEN
        linecount := 21;
      END
    UNTIL (Quit) OR (c = 15C) OR (c = 40C);
    WriteString(Display,wipe);
  END;
END Pause;

(* End - press space message & wait for space *)

PROCEDURE Finish;
  BEGIN
    IF OnScreen THEN
      WriteString(Display,last);
      REPEAT ReadChar(Display,c) UNTIL (c = 40C);
    END;
  END Finish;

(* Closes the disk file and screen (or printer) - NOT DOS Library *)

PROCEDURE CloseTheFile;
BEGIN
  IF (Display <> 0) THEN Close(Display) END;
  IF (Disk <> 0) THEN Close(Disk) END;
END CloseTheFile;

(* internal procedure for the HexDisplay                                *)
(* Converts a character to a 3 byte (null terminated 3d byte) string    *)
(*  in hex format with leading '0'                                      *)

PROCEDURE ToHex(c:CHAR;VAR ch:ARRAY OF CHAR);
VAR v:CARDINAL;
BEGIN
  v := CARDINAL(ORD(c));
  ch[0] := HexCh[v DIV 16];
  ch[1] := HexCh[v MOD 16];
  ch[2] := 0C;
END ToHex;

(* kludge to quickly convert a 4 byte (artificial LONGCARD) thingy into
   an increasing file position - used 4 byte since very big files should
   really be taken into account - as if anyone is going to dump a file
   that long - oh, well, it will address it properly if they do         *)

PROCEDURE HexAddr(VAR ch:ARRAY OF CHAR);
VAR re:ARRAY[0..2] OF CHAR;
BEGIN
  IF fp1=256 THEN fp1 := 0; INC(fp2) END;       (* with any other       *)
  IF fp2=256 THEN fp2 := 0; INC(fp3) END;       (* necessary movement   *)
  IF fp3=256 THEN fp3 := 0; INC(fp4) END;
  IF fp4=256 THEN fp4 := 0 END;                 (*if THAT big, just roll*)
  ToHex(CHR(fp4),re);
  ch[0] := re[0];ch[1] := re[1];
  ToHex(CHR(fp3),re);
  ch[2] := re[0];ch[3] := re[1];
  ToHex(CHR(fp2),re);
  ch[4] := re[0];ch[5] := re[1];
  ToHex(CHR(fp1),re);
  ch[6] := re[0];ch[7] := re[1];
  INC(fp1,16);
END HexAddr;

(* FINALLY THE FIRST IMPORTABLE PROCEDURE       *)
(* SET ToScreen FALSE to go to PRT: device      *)

PROCEDURE DisplayASCII(VAR filnam:ARRAY OF CHAR;ToScreen:BOOLEAN);
BEGIN
  OnScreen := ToScreen;
  IF MyOpen(filnam) THEN
    REPEAT
      len := CARDINAL(Read(Disk,ADR(inbuffer),512));
      len2 := 0;
      WHILE (NOT Quit) AND (len2 < len) DO
        i := len2;
        WHILE (i < 511) AND (inbuffer[i] <> 12C) DO INC(i) END;
        Result := Write(Display,ADR(inbuffer[len2]),LONGCARD(i-len2+1));
        len2 := i + 1;
        INC(linecount);
        IF (linecount > 21) AND (inbuffer[i] = 12C) THEN Pause END;
      END;
    UNTIL (len <> 512) OR (Quit);
    Finish;
  END;  (* IF NOT Quit *)
  CloseTheFile;
END DisplayASCII;


PROCEDURE DisplayHex(VAR filnam:ARRAY OF CHAR;ToScreen:BOOLEAN);
VAR ad:ARRAY[0..7] OF CHAR;
BEGIN
  OnScreen := ToScreen;
  IF MyOpen(filnam) THEN
    fp1:=0;fp2:=0;fp3:=0;fp4:=0;
    REPEAT
      FOR i := 0 TO 70 DO writebuffer[i] := 40C END;
      top := CARDINAL(Read(Disk,ADR(t2),16));
      nextout := 10;
      IF top > 0 THEN
        FOR i := 1 TO top DO
          ToHex(t2[i],ad);
          writebuffer[nextout] := ad[0];
          writebuffer[nextout+1] := ad[1];
          INC(nextout,2);
          IF (i MOD 4)=0 THEN INC(nextout) END;
        END;
        nextout := 48;  (* 39 IF i MOD 8 is left in *)
        FOR i := 1 TO top DO
          IF (t2[i]>177C) OR (t2[i]<40C) THEN
            writebuffer[nextout] := dot
          ELSE
            writebuffer[nextout] := t2[i]
          END;
          INC(nextout);
        END;
        writebuffer[69] := lf;
        writebuffer[70] := 0C;
        HexAddr(ad);
        FOR i := 0 TO 7 DO writebuffer[i] := ad[i] END;
        Result := Write(Display,ADR(writebuffer),70);
        INC(linecount);
        IF (linecount > 21) THEN Pause END;
      END;
    UNTIL (top < 16) OR (Quit);
    Finish
  END;
  CloseTheFile
END DisplayHex;


(* Initialization items *)


BEGIN
  IF DOSBase = 0 THEN DOSBase := OpenLibrary(DOSName,0) END;
  IF DOSBase = 0 THEN HALT END; (* WHOOPS!!*)

  InitStringModule;

  HexCh  := "0123456789ABCDEF";

END DuTypefile.