Power-Programmierung/CD1.mdf/pascal/library/dos/murutil/look.pas

Pascal/Delphi Source File | 1988-09-26 | 14.4 KB | 587 lines

PROGRAM LOOK;

{$N- Don't use the numeric coprocessor.}

{  "LOOK at a file."    Version:  26 September 1988.

   Syntax:  LOOK filename.ext [/NX]

   This program displays a file,  20 lines at a time.   The  "/NX"  flag
   suppresses tab expansion.  The user may move through the file,  print
   the currently displayed page or quit by  using  the  following  keys:

         Up Arrow -- Go up (towards the beginning) one line.
         Dn Arrow -- Go down (towards the end) one line.
         PgUp     -- Go up one page of 20 lines.
         ^PgUp    -- Go up ten pages (200 lines).
         PgDn     -- Go down one page of 20 lines.
         ^PgDn    -- Go down ten pages (200) lines.
         Home     -- Go to the beginning of the file.
         End      -- Go to the end of the file.
         ESC      -- Quit.
         ^C       -- Quit.

   Note:  The maximum number of lines that can be stored for display  is
   set by MAXLINE.

   Updated for Turbo Pascal Version 4.0 by H.M.M. on 24 November 1987.

                                NOTICE

       Copyright 1987, Harry M. Murphy.

       A general license is hereby  granted  for  non-commercial
       use,  copying and free exchange of this  program  without
       payment of any royalties,  provided that  this  copyright
       notice is not altered nor deleted.   All other rights are
       reserved.   This program is supplied as-is and the author
       hereby disclaims all warranties,  expressed  or  implied,
       including any and all warranties of  merchantability  and
       any and all warranties of suitability  for  any  purpose.
       Use of this program in  any  way  whatsoever  constitutes
       acceptance of the terms of this license.

       Harry M. Murphy, Consultant
       3912 Hilton Avenue, NE
       Albuquerque, NM  87110  }

USES
  CRT,
  DOS;

CONST
  BUFSIZE = 2048;       { Input buffer size, in bytes.     }
  LENSPEC = 65;         { Maximum input file spec length.  }
  LINELEN = 74;         { Line length.                     }
  MAXLINE = 5000;       { Maximum number of lines to read. }
  SP      = ' ';        { Space code.                      }

TYPE
  FILESPEC = STRING[LENSPEC];
  TEXTLINE = STRING[LINELEN];
  LINEP    = ^TEXTLINE;

VAR
  DONE       : BOOLEAN;      { Done flag.                    }
  INP        : TEXT;         { Input file.                   }
  INPBUFF    : ARRAY[1..BUFSIZE] OF CHAR; {Input file buffer.}
  INPNAME    : FILESPEC;     { Input file name.              }
  L0         : -1..MAXLINE;  { Previous value of L1.         }
  L1         : 1..MAXLINE;   { Starting line to display.     }
  LPA        : ARRAY [1..MAXLINE] OF LINEP; { Pointer array. }
  NLINE      : 0..MAXLINE;   { Number of lines in file.      }
  NTAB       : INTEGER;      { Tab expansion count.          }
  PRINT      : BOOLEAN;      { Print display page flag.      }
  PRN        : TEXT;         { Printer device file.          }
  PRNOUT     : BOOLEAN;      { Printer has been used flag.   }
  TABX       : BOOLEAN;      { Tab expansion flag.           }

{ -------------------------------- }

PROCEDURE BEEP(FREQ,DUR: INTEGER);

{  This procedure outputs a "beep" signal of FREQ Hz and DUR milli-
   seconds. }

BEGIN
  SOUND(FREQ);
  DELAY(DUR);
  NOSOUND
END { Procedure BEEP };

{ -------------------------------- }

PROCEDURE CURSOROFF;

{  This Turbo Pascal V4.0 procedure turns the cursor display off.

   Note:  USES DOS;

   Procedure by Harry M. Murphy  --  January 1988.  }

VAR
  REGS : REGISTERS;

BEGIN
  REGS.AX := $0100;
  REGS.CX := $2000;
  INTR($10,REGS)
END  { Procedure CURSOROFF };

{ -------------------------------- }

PROCEDURE CURSORON;

{  This Turbo Pascal v4.0 procedure turns the cursor display on.

   Note:  USES DOS;

   Procedure by Harry M. Murphy  --  January 1988.  }

VAR
  REGS : REGISTERS;

BEGIN
  REGS.AX := $0100;
  IF MEM[0:$0449] = 7
    THEN
      REGS.CX := $0C0D
    ELSE
      REGS.CX := $0607;
  INTR($10,REGS)
END  { Procedure CURSORON };

{ -------------------------------- }

FUNCTION MIN0(I,J: INTEGER): INTEGER;

{ This function returns the minimum of (I,J). }

BEGIN
  IF I <= J
    THEN
      MIN0 := I
    ELSE
      MIN0 := J
END { Function MIN0 };

{ -------------------------------- }

PROCEDURE CLOSEWINDOW;

{  This procedure restores the normal window and cursor, clears the
   screen and leaves the cursor at line 24.  }

BEGIN
  WINDOW(1,1,80,25);
  CURSORON;
  GOTOXY(1,24);
  CLREOL
END  { Procedure CLOSEWINDOW };

{ -------------------------------- }

PROCEDURE GETCOMMAND;

{  This procedure accepts and processes keyboard commands.

   For a list of valid commands, see the comments at the beginning of
   this program.  }

VAR
  CHORD    : 0..255;
  KEYPAD   : BOOLEAN;
  SCANCODE : SET OF BYTE;
  SINGLE   : BOOLEAN;

BEGIN
  SCANCODE := [71,72,73,79,80,81,118,132];
  REPEAT
    WHILE NOT KEYPRESSED DO;  { Wait for a key to be pressed. }
    CHORD := ORD(READKEY);
    KEYPAD := KEYPRESSED;
    IF KEYPAD                 { Check for a keypad command.   }
      THEN
        CHORD := ORD(READKEY);
    IF CHORD IN SCANCODE
      THEN
        CASE CHORD OF
          { Home}
          71: L1 := 1;
          { UArr}
          72: IF L1 > 1
                         THEN
                           L1 := PRED(L1)
                         ELSE
                           BEEP(512,50);
          { PgUp}
          73: IF L1 > 20
                         THEN
                           L1 := L1-20
                          ELSE
                            BEGIN
                              BEEP(512,50);
                              L1 := 1
                            END;
          { End }
          79: IF NLINE > 19
                         THEN
                           L1 := NLINE-19
                         ELSE
                           L1 := 1;
          { DArr}
          80: IF L1 < (NLINE-19)
                         THEN
                           L1 := SUCC(L1)
                         ELSE
                           BEEP(512,50);
          { PgDn}
          81: IF L1 < (NLINE-19)
                         THEN
                           L1 := L1+20
                         ELSE
                           BEEP(512,50);
          {^PgDn}
          118: IF L1 < (NLINE-199)
                         THEN
                           L1 := L1+200
                         ELSE
                           IF NLINE > 19
                             THEN
                               L1 := NLINE-19
                             ELSE
                               L1 := 1;
          {^PgUp}
          132: IF L1 > 200
                         THEN
                           L1 := L1-200
                         ELSE
                           L1 := 1
        END { CASE };
    SINGLE := (CHORD IN [3,27,42]) AND (NOT KEYPAD);
    KEYPAD := KEYPAD AND (CHORD IN SCANCODE)
  UNTIL SINGLE OR KEYPAD;
  DONE := CHORD IN [3,27];
  PRINT := (CHORD = 42)
END { Procedure GETCOMMAND };

{ -------------------------------- }

PROCEDURE GETLINE(VAR LINE: TEXTLINE);

{  This procedure reads the next line from the input file.  Tab codes
   are expanded to the equivalent number of blanks.

   Routine by Harry M. Murphy,  11 October 1987.  }

CONST
  TAB = #9;

VAR
  CH    : CHAR;
  LL,LN : 0..LINELEN;

BEGIN
  IF TABX
    THEN
      BEGIN
        LL := 0;
        WHILE NOT EOLN(INP) AND (LL < LINELEN) DO
          BEGIN
            READ(INP,CH);
            IF CH = TAB
              THEN
                BEGIN
                  NTAB := SUCC(NTAB);
                  LN := MIN0((LL DIV 8)*8+8,LINELEN);
                  REPEAT
                    LL := SUCC(LL);
                    LINE[LL] := SP
                  UNTIL LL = LN
                END
              ELSE
                BEGIN
                  LL := SUCC(LL);
                  LINE[LL] := CH
                END
          END;
        READLN(INP)
      END
    ELSE
      BEGIN
        READLN(INP,LINE);
        LL := LENGTH(LINE)
      END;
  LINE[0] := CHR(0);
  WHILE LINE[LL] = SP DO LL := PRED(LL);
  LINE[0] := CHR(LL)
END { Procedure GETLINE };

{ -------------------------------- }

PROCEDURE GETPARAMS;

{  This Turbo Pascal procedure gets the input file name and [optionally]
   the /NX "suppress tab expansion" option from the command line.

   Procedure by Harry M. Murphy,  11 October 1987.  }

CONST
  SYNTAX = 'Syntax for LOOK is:  LOOK filename.ext [/NX]';

VAR
  OPT : STRING[3];

BEGIN { Procedure GETPARAMS }
  IF (PARAMCOUNT = 0)
    THEN
      BEGIN
        WRITELN(SYNTAX);
        HALT
      END;
  INPNAME := PARAMSTR(1);
  ASSIGN(INP,INPNAME);
  SETTEXTBUF(INP,INPBUFF,BUFSIZE);
  {$I-} RESET(INP) {$I+};
  IF IORESULT <> 0
    THEN
      BEGIN
        WRITELN('ERROR!  Can''t open file ',INPNAME,'!');
        HALT
      END;
  IF PARAMCOUNT >= 2
    THEN
      BEGIN
        OPT := PARAMSTR(2);
        TABX := NOT (OPT = '/NX')
      END
    ELSE
      TABX := TRUE
END { Procedure GETPARAMS };

{ -------------------------------- }

PROCEDURE GETTEXT;

{  This procedure reads up to MAXLINE lines of text from the input
   file.  }

VAR
  LINE : TEXTLINE;

BEGIN
  WRITELN('LOOK reading ',INPNAME,' now . . .');
  NLINE := 0;
  NTAB := 0;
  WHILE (NOT EOF(INP)) AND (NLINE < MAXLINE) DO
    BEGIN
      GETLINE(LINE);
      NLINE := SUCC(NLINE);
      NEW(LPA[NLINE]);
      LPA[NLINE]^ := LINE
    END;
  IF NTAB > 0
    THEN
      BEGIN
        WRITELN(NTAB:6,' tab codes expanded.');
        BEEP(512,50);
        DELAY(1000)
      END;
  IF NLINE < MAXLINE
    THEN
      BEGIN
        NLINE := SUCC(NLINE);
        NEW(LPA[NLINE]);
        LPA[NLINE]^ := '<<<<<   E N D   O F   F I L E   >>>>>'
      END
    ELSE
      IF NOT EOF(INP)
        THEN
          BEGIN
            HIGHVIDEO;
            WRITELN('BUFFER FULL!');
            WRITELN('More than ',MAXLINE,' lines in the file.');
            WRITELN('Some text will not be displayed.');
            NORMVIDEO;
            BEEP(440,250);
            DELAY(5000)
          END;
  CLOSE(INP)
END { Procedure GETTEXT };

{ -------------------------------- }

PROCEDURE OPENWINDOW;

{  This procedure turns the cursor off and opens the display window.  }

CONST
  ASTR = '^C or Esc quits.   ';
  BSTR = ', PgUp, ^PgUp, PgDn, ^PgDn, Home or End scans.  * prints.';

VAR
  BAR : STRING[80];
  I   : 0..80;

BEGIN
  CLRSCR;
  CURSOROFF;
  GOTOXY((80-LENGTH(INPNAME)) DIV 2,1);
  WRITE(INPNAME);
  GOTOXY(70,1);
  WRITELN(NLINE-1:4,' lines');
  BAR[0] := CHR(80);
  BAR[1] := CHR(218);
  BAR[80] := CHR(191);
  FOR I := 2 TO 79 DO BAR[I] := CHR(196);
  WRITE(BAR);
  FOR I:=3 TO 23 DO
    BEGIN
      GOTOXY(1,I);
      WRITE(CHR(179));
      GOTOXY(80,I);
      WRITE(CHR(179))
    END;
  BAR[1] := CHR(192);
  BAR[80] := CHR(217);
  GOTOXY(1,23);
  WRITE(BAR);
  GOTOXY(1,24);
  BAR := ASTR+CHR(24)+', '+CHR(25)+BSTR;
  TEXTCOLOR(0);
  TEXTBACKGROUND(6);
  WRITE(BAR);
  WINDOW(3,3,79,22);
  TEXTCOLOR(7);
  TEXTBACKGROUND(0)
END { Procedure OPENWINDOW };

{ -------------------------------- }

PROCEDURE PRINTPAGE;

{  This procedure prints the currently displayed page. }

VAR
  L    : 1..MAXLINE;
  LMAX : INTEGER;

BEGIN
  IF PRINT
    THEN
      BEGIN
        IF NOT PRNOUT
          THEN
            BEGIN
              ASSIGN(PRN,'PRN');
              REWRITE(PRN);
              WRITELN(PRN,'File: ',INPNAME);
              PRNOUT := TRUE
            END;
        L := L1;
        LMAX := MIN0(L+20,NLINE);
        WRITELN(PRN,'Lines ',L1,' to ',LMAX,':');
        WRITELN(PRN);
        WHILE L <= LMAX DO
          BEGIN
            WRITELN(PRN,LPA[L]^);
            L := SUCC(L)
          END;
        WRITELN(PRN);
        PRINT := FALSE
      END
END { Procedure PRINTPAGE };

{ -------------------------------- }

PROCEDURE SHOWPAGE;

{  This procedure displays the current page. }

VAR
  I : 1..20;
  L : INTEGER;

BEGIN
  IF L1 < 1 THEN L1 := 1;
  IF L0 <> L1
    THEN
      BEGIN
        IF L0 = PRED(L1)
          THEN
            BEGIN             {Down Arrow}
              GOTOXY(77,20);
              WRITELN;
              GOTOXY(1,20);
              CLREOL;
              L := L1+19;
              IF L <= NLINE THEN WRITE(LPA[L]^)
            END
          ELSE
            IF L0 = SUCC(L1)
              THEN
                BEGIN         {Up Arrow}
                  GOTOXY(1,1);
                  INSLINE;
                  WRITE(LPA[L1]^)
                END
              ELSE
                BEGIN
                  L := L1;
                  FOR I := 1 TO 20 DO
                    BEGIN     {Page Up, Page Down, Home & End}
                      GOTOXY(1,I);
                      CLREOL;
                      IF L <= NLINE THEN WRITE(LPA[L]^);
                      L := SUCC(L)
                    END
                END;
        WINDOW(1,1,80,25);
        GOTOXY(1,1);
        WRITE('            ');
        GOTOXY(1,1);
        WRITE(SP,L1,SP,CHR(26),SP,MIN0(L1+19,NLINE-1));
        WINDOW(3,3,79,22);
        GOTOXY(77,20);
        L0 := L1
      END
END { Procedure SHOWPAGE };

{ -------------------------------- }

PROCEDURE UPPARMS;

{  This procedure scans the parameter string in the program's command
   tail at offset 0080H and converts all characters to upper case.

   Procedure by Harry M. Murphy,  22 November 1987.
   Updated to Turbo Pascal V4.0 by H.M.M. on 28 November 1987. }

CONST
    CT   = $0080;

VAR
    L,LP : 0..127;
    PSPS : WORD;

BEGIN
  PSPS := PREFIXSEG;
  LP := MEM[PSPS:CT];
  IF LP > 0
    THEN
      FOR L := 1 TO LP DO
        IF MEM[PSPS:L+CT] IN [97..122]
          THEN
            MEM[PSPS:L+CT] := MEM[PSPS:L+CT] XOR $20
END { Procedure UPPARMS };

{ -------------------------------- }

BEGIN { Program LOOK }
  UPPARMS;
  GETPARAMS;
  GETTEXT;
  CHECKBREAK := FALSE;
  OPENWINDOW;
  L0 := -1;
  L1 := 1;
  PRNOUT := FALSE;
  PRINT := FALSE;
  DONE := FALSE;
  REPEAT
    IF PRINT
      THEN
        PRINTPAGE
      ELSE
        SHOWPAGE;
    GETCOMMAND
  UNTIL DONE;
  IF PRNOUT
    THEN
      BEGIN
        WRITELN(PRN,#12);
        CLOSE(PRN)
      END;
  CLOSEWINDOW
END.