Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/MXLIST.ZIP/DMX_LIST.PAS

Pascal/Delphi Source File | 1993-01-04 | 9.8 KB | 357 lines

Unit DMX_LIST;

{$V-,I- }

(*
  All the "object-orientedness" is handled internally within this unit.
  There are two global procedure to be called by the main program.
  Each procedure uses a different object to do the work, and one is a
  descendant of the other.

  The text-files are temporarily stored on the heap while it is displayed.
  They are freed from the heap when the procedure is finished.

  These procedures use GETMEM and FREEMEM for heap manipulations.
 *)

interface


uses   Dos, Crt, DMX2, DMX_wind;



  procedure ViewTextWindow (Filename : pathstr;  Bor,Txt : word);

      { This procedure views a text-file in the currently defined window }


  procedure ViewHelpWindow (Filename : pathstr;  Help : char;
                            Y1,X1,Y2,X2, Bor,Txt : word);

      { This procedure differs from ViewTextWindow in two ways:

         1) The window size is determined by the parameters given.

         2) Only the lines of text which begin with the character equal
            to the HELP variable are displayed.  This allows more than
            one help-screen in each help-file.

       }



  { ─────────────────────────────────────────────────────────────────────── }


implementation


const  cr          =  #13;
       Esc         =  #27;
       F1          =  ';';

       lastline    =  999;  { This is the maximum number of text-lines that
                              can be displayed.  It should be increased if
                              you need to use larger files.
                             }


type   tableptr    = ^tabletype;
       tabletype   =  array [0..lastline] of ^string; {pointers to text-lines}

       TextViewer  =  object (DMXviewer)
                        ImageSize     : longint;  { accumulated data size }
                        table         : tableptr;

                        procedure Loader (Filename  : pathstr);
                                  virtual;
                        procedure RedoRuler (Gauge, Line : word);
                                  virtual;
                        function  DataAt (recnum : longint) : pointer;
                                  virtual;
                        destructor Done;
                      end;


       HelpViewer  =  object (TextViewer)
                        helpcode      : char;
                        procedure Loader (Filename  : pathstr);
                                  virtual;
                      end;



var    ReadWindow  :  TextViewer;
       HelpWindow  :  HelpViewer;
       marker      :  byte;  { just a place to point to }
       Key,ext     :  char;


  { ─────────────────────────────────────────────────────────────────────── }


procedure TextViewer.RedoRuler (Gauge, Line : word);
{ virtual method called after adjusting the upper or lower border }

{ You may have noticed that the line above the editing space will be doubled
  when it is no longer possible to scroll upwards.  The lower border behaves
  in a likewise fashion.
  This virtual procedure is normally unused, but is needed here to "clean-up"
  the edges of each border --which are just outside the window space.
  This procedure was not documented in the unregistered version, because it
  is rarely needed.

  GAUGE determines whether the ruler is be single or double width; and
  LINE determines which ruler is being displayed.

  This procedure is only called when the GAUGE changes }


var  L,R : char;
begin
  Line := Line + hi (WindMin);
  If Line <= succ (hi (WindMin)) then
    begin
    If Gauge = 1 then
      begin
      L := '╓';  R := '╖';  { ruler is single width }
      end
     else
      begin
      L := '╔';  R := '╗';  { ruler is double width }
      end;
    end
   else
    begin
    If Gauge = 1 then
      begin
      L := '╙';  R := '╜';  { ruler is single width }
      Screen ('[more '#25']', Line, lo (WindMax) - 7, bordercolor);
      end
     else
      begin
      L := '╚';  R := '╝';  { ruler is double width }
      end;
    end;
  Screen (L, Line, lo (WindMin),     bordercolor);
  Screen (R, Line, lo (WindMax) + 2, bordercolor);
end;


  { ─────────────────────────────────────────────────────────────────────── }


function  TextViewer.DataAt (recnum : longint) : pointer;
{ this virtual method pretends to retrieve the next record }
const  nix : char = #0;  { simulates a nul string }
begin
  If recnum >= recordlimit then
    DataAt := addr (nix)  { point to a nul string }
   else
    DataAt := Table^[recnum]
end;


  { ─────────────────────────────────────────────────────────────────────── }


procedure TextViewer.Loader (Filename : pathstr);
var  AStr   : string;
     Cover  : text;
begin
  Table       := nil;
  ImageSize   :=  0;

  GetMem (Table, sizeof (tabletype));
  recordlimit :=  0;
  AStr        := '';

  Assign (Cover, Filename);
  Reset (Cover);
  If IoResult <> 0 then
    begin
    GetMem (Table^[0], 21);  { string length + 1 }
    Table^[0]^  :=  'File not found.';

    recordlimit := 1;
    ImageSize   := ImageSize + recordsize;
    end
   else
    begin
    Repeat
      readln (Cover, AStr);
      If length (AStr) > succ (recordsize) then
        AStr [0] := chr (succ (recordsize));
      GetMem (Table^[recordlimit], length (AStr) + 1);
      Move (AStr, Table^[recordlimit]^, length (AStr) + 1);
      Inc (recordlimit);
      ImageSize := ImageSize + recordsize;
    Until (IoResult <> 0) or Eof (Cover) or (recordlimit = lastline);
    Close (Cover);
    end;

  OpenBuffer (marker, ImageSize);

end;  { TextViewer.Loader }


  { ─────────────────────────────────────────────────────────────────────── }


procedure HelpViewer.Loader (Filename : pathstr);
var  AStr   : string;
     Cover  : text;
begin
  Table       := nil;
  ImageSize   :=  0;

  GetMem (Table, sizeof (tabletype));
  recordlimit :=  0;
  AStr        := '';

  Assign (Cover, Filename);
  Reset (Cover);
  If IoResult <> 0 then
    begin
    AStr        :=  'File not found.';
    GetMem (Table^[0], length (AStr) + 1);
    Move (AStr, Table^[0]^, length (AStr) + 1);
    recordlimit := 1;
    ImageSize   := ImageSize + recordsize;
    end
   else
    begin
    Repeat
      readln (Cover, AStr);
      If (length (AStr) > 0)
        and
         (AStr [1] = helpcode)
       then
        begin
        Delete (AStr, 1,1);
        If length (AStr) > succ (recordsize) then
          AStr [0] := chr (succ (recordsize));
        GetMem (Table^[recordlimit], length (AStr) + 1);
        Move (AStr, Table^[recordlimit]^, length (AStr) + 1);
        Inc (recordlimit);
        ImageSize := ImageSize + recordsize;
        end;
    Until (IoResult <> 0) or Eof (Cover) or (recordlimit = lastline);
    Close (Cover);
    end;

  If recordlimit = 0 then
    begin
    AStr        :=  'Help is not available for this item.';
    GetMem (Table^[0], length (AStr) + 1);
    Move (AStr, Table^[0]^, length (AStr) + 1);
    recordlimit := 1;
    ImageSize   := ImageSize + recordsize;
    end;

  OpenBuffer (marker, ImageSize);

end;  { HelpViewer.Loader }


  { ─────────────────────────────────────────────────────────────────────── }


destructor TextViewer.Done;
var  i : word;
begin
  If Table <> nil then
    begin
    If recordlimit > 0 then
      For i := 0 to pred (recordlimit) do
        FreeMem (Table^[i], length (Table^[i]^) + 1);
    FreeMem (Table, sizeof (Table^));
    recordlimit := 0;
    end;
end;


  { ─────────────────────────────────────────────────────────────────────── }


procedure ViewTextWindow (Filename : pathstr;  Bor,Txt : word);
type  win   =  record  X,Y : byte;  end;
const Rfmt  :  string [80] = ' _______________________________________________________________________________';
var   TA    :  word;
      FMode :  word;
begin
  FMode    := FileMode;
  FileMode :=  0;  { just in case the file is marked ReadOnly }
  TA       := TextAttr;
  TextAttr := Txt;

  ClrScr;
  MkBorder (succ (hi (WindMin)), succ (lo (WindMin)),
            succ (hi (WindMax)), succ (lo (WindMax)), Bor);
  Inc (win (WindMin).X);
  Dec (win (WindMax).X);  { make the window thinner to avoid border }

  Rfmt [0] := chr (succ (lo (WindMax) - lo (WindMin)));
  ReadWindow.Init ('', Rfmt, 1,1, Bor,Txt,Txt);

  ReadWindow.Loader (Filename);

  ReadWindow.EditData (marker, Key,ext, [Esc],[]);

  ReadWindow.Done;

  Dec (win (WindMin).X);
  Inc (win (WindMax).X);  { fix window's width }

  FileMode := FMode;
  TextAttr := TA;
end;  { ViewTextWindow }


  { ─────────────────────────────────────────────────────────────────────── }


procedure ViewHelpWindow (Filename : pathstr;   Help : char;
                          Y1,X1,Y2,X2, Bor,Txt : word);
type  win   =  record  X,Y : byte;  end;
const Rfmt  :  string [80] = ' _______________________________________________________________________________';
var   FMode :  word;
begin
  SaveWindow;  { saves screen, color, and cursor positions }
  Window (X1,Y1,X2,Y2);

  HelpWindow.helpcode := Help;
  FMode    := FileMode;
  FileMode :=  0;  { just in case the file is marked ReadOnly }
  TextAttr := Txt;

  ClrScr;
  MkBorder (succ (hi (WindMin)), succ (lo (WindMin)),
            succ (hi (WindMax)), succ (lo (WindMax)), Bor);
  Inc (win (WindMin).X);
  Dec (win (WindMax).X);  { make the window thinner to avoid border }

  Rfmt [0] := chr (succ (lo (WindMax) - lo (WindMin)));
  HelpWindow.Init ('', Rfmt, 1,1, Bor,Txt,Txt);

  HelpWindow.Loader (Filename);

  HelpWindow.EditData (marker, Key,ext, [#13,Esc],[F1]);

  HelpWindow.Done;

  Dec (win (WindMin).X);
  Inc (win (WindMax).X);  { fix window's width }

  FileMode := FMode;

  RestoreWindow;
end;  { ViewHelpWindow }


  { ─────────────────────────────────────────────────────────────────────── }


End.