ftp.barnyard.co.uk/2015.02.ftp.barnyard.co.uk.tar/ftp.barnyard.co.uk/cpm/walnut-creek-CDROM/CPM/TURBOM2/FDUMP.LBR/FDUMP.MZD/FDUMP.MOD

Text File | 2000-06-30 | 5KB | 218 lines

(*********************************************************************)
(* Stand alone program to dump a file to the screen and/or printer   *)
(* Written By Ed Jackson, GIlroy, CA.  Released to the Public Domain *)
(* With the only restriction that this notice cannot be removed.     *)
(* July 1987                                                         *)
(*********************************************************************)

MODULE Fdump;
FROM Terminal IMPORT ClearScreen, Highlight;
FROM Texts    IMPORT ReadString, ReadLine, ReadLn, WriteLn, OpenText,
                     CloseText, CreateText, console, TEXT, WriteCard,
                     WriteString, TextFile, ReadChar, WriteChar, input,
                     SetCol, haltOnControlC, EOT;
FROM ComLine  IMPORT commandLine, PromptFor;
FROM Strings  IMPORT CAPS;
FROM Files    IMPORT GetName, FILE, Open, Close, EOF, ReadBytes;
FROM SYSTEM   IMPORT ADR, WORD, BYTE;

(*  GLOBAL CONSTANTS  *)
CONST
  PageSize         = 50;   (*  Number of lines printed on page  *)
  FormFeed         = 14C;  (*  Printer Top of Form              *)

PROCEDURE GetIOFiles (VAR f      : FILE;
                      VAR o      : TEXT;
                      VAR name   : ARRAY OF CHAR;
                      VAR outdev : ARRAY OF CHAR);

VAR
  ok           : BOOLEAN;

BEGIN
ClearScreen;
WriteLn (console);
REPEAT
  PromptFor ('Enter Input File Name: ', name);
  ok := Open (f, name);
  UNTIL ok;

PromptFor ('Enter Output Device [DUM:/LST:/FileName]: ', outdev);
CAPS (outdev);
IF outdev <> 'DUM:' THEN
  CreateText (o, outdev);
  END;
END GetIOFiles;

PROCEDURE WriteTitle (o : TEXT;
                      p : CARDINAL;
              t : ARRAY OF CHAR);

BEGIN
IF p <> 1 THEN
  WriteLn (o);
  END;

WriteLn (o);
WriteLn (o);
SetCol (o, 8);
WriteString (o, t);
SetCol (o, 71);
WriteString (o, 'Page');
WriteCard (o, p, 4);
WriteLn (o);
WriteLn (o);
END WriteTitle;

PROCEDURE WriteHex (o  : TEXT;
            i  : CHAR);

VAR Hex : ARRAY [0..15] OF CHAR;

BEGIN
Hex := '0123456789ABCDEF';
WriteChar (o, Hex [ORD (i) DIV 16]);
WriteChar (o, Hex [ORD (i) MOD 16]);
WriteChar (o, ' ');
END WriteHex;

PROCEDURE GoToIt (in   : FILE;
                  o    : TEXT;
                  s    : BOOLEAN;
                  p    : CARDINAL;        (*  Page number  *)
                  t    : ARRAY OF CHAR);  (*  Input File Name for Title  *)

VAR
  i, j, k, l, n,
  r             : CARDINAL;
  line          : ARRAY [0..80] OF CHAR;
  buf           : ARRAY [0..127] OF CHAR;

BEGIN
l := 1;
r := 0;

WHILE NOT EOF (in) DO
  n := ReadBytes (in, ADR (buf), 128);

  IF (l = 1) THEN
    WriteTitle (console, p, t);
    IF s THEN
      WriteTitle (o, p, t);
      END;
    END;

  WriteLn (console); INC (l, 2);
  WriteString (console, 'Record #');
  WriteCard (console, r, 4);
  WriteLn (console);

  IF s THEN
    WriteLn (o);
    SetCol (o, 8);
    WriteString (o, 'Record #');
    WriteCard (o, r, 4);
    WriteLn (o);
    END;


  FOR i := 0 TO 7 DO
    IF s THEN
      SetCol (o, 8);
      END;
    FOR j := 0 TO 15 DO
      k := i * 16 + j;
      IF k <= n THEN
        WriteHex (console, buf [k]);
        IF s THEN
          WriteHex (o, buf [k]);
          END;
        IF j = 7 THEN
          WriteChar (console, ' ');
          IF s THEN
            WriteChar (o, ' ');
            END;
          END;
        END;
      END;

    SetCol (console, 62);
    IF s THEN
      SetCol (o, 63)
      END;

    FOR j := 0 TO 15 DO
      k := i * 16 + j;

      IF k <= n THEN
        IF (buf [k] >= '!') AND (buf [k] <= '_') THEN
          WriteChar (console, buf [k]);
          IF s THEN
            WriteChar (o, buf [k]);
            END;
        ELSE
          WriteChar (console, '.');
          IF s THEN
            WriteChar (o, '.');
            END;
          END;

        IF j = 7 THEN
          WriteChar (console, ' ');
          END;
        END;
      END;

    WriteLn (console);
    IF s THEN
      WriteLn (o);
      END;

    INC (l);
    END;

  IF l > PageSize THEN
    INC (p);
    l := 1;
    WriteChar (console, FormFeed);
    IF s THEN
      WriteChar (o, FormFeed);
      END;
    END;
  INC (r);
  END;

END GoToIt;

PROCEDURE MAIN;

VAR
  FileIn           : FILE;
  FileOut          : TEXT;
  PrintSw          : BOOLEAN;
  Title, Name      : ARRAY [0..15] OF CHAR;
  Char             : CHAR;
  PageNum          : CARDINAL;

BEGIN
GetIOFiles (FileIn, FileOut, Title, Name);
PageNum := 1;
PrintSw := Name <> 'DUM:';

IF Name = 'LST:' THEN
  WriteLn (console);
  WriteString (console, 'Make Printer Ready... Press "Return" to continue. ');
  ReadChar (input, Char);
  END;

GoToIt (FileIn, FileOut, PrintSw, PageNum, Title);

Close (FileIn);
CloseText (FileOut);
END MAIN;


BEGIN
MAIN;
END Fdump.