{$C-}
{
   THE "STAYRES" code is here in a stripped-down version, without some
   of its explanatory comments and without the modification history.

  COMPILE with mAx and mIn both set to 300


The Hunter's Helper

Lane Ferris
4268 26th St
San Francisco,Ca. 94131
[ 70357,2716 ]

If you find this program useful, $15 would be appeciated to help in its
evolution and upkeep.

}
PROGRAM Resident_MAP;

  { * * * * * * * CONSTANTS * * * * * * * * * * * * * * * * * * * * * * }
CONST
  {      the next field is needed for the windo.inc routines }
  MaxWin = 2;                 { Max number of windows open at one time }
  Esc = #27;                  {character equivalent of Escape Key}
  Our_Char = 113;             {this is the scan code for Alt-F10}
  Ctrl_Home = #119;           {Control Home Scan Code          }
  Ctrl_End = #117;            {Control End Scan Code           }
  Quit_Key = Ctrl_Home;         {Quit and Release Memory}
  Kybrd_Int = $16;            {BIOS keyboard interrupt}

  {------------- T Y P E    D E C L A R A T I O N S ----------------------}
TYPE
  Regtype = RECORD Ax, Bx, Cx, Dx, Bp, Si, Di, Ds, Es, Flags : Integer END;
  HalfRegtype = RECORD Al, Ah, Bl, Bh, Cl, Ch, Dl, Dh : Byte END;
  filename_type = STRING[64];

  {-------------- T Y P E D   C O N S T A N T S --------------------------}
CONST
  {regs is defined as a typed constant to get it in the code segment}
  Regs : regtype = (Ax : 0; Bx : 0; Cx : 0; Dx : 0; Bp : 0; Si : 0; Di : 0; Ds : 0; Es : 0; Flags : 0);

  OurDseg : Integer = 0;      {Our Data Segment Value             }
  OurSseg : Integer = 0;      {Our Stack Segment Value            }
  DosSseg : Integer = 0;      {Dos Stack Segment Value            }
  Inuse : Boolean = False;    {Recursion flag                     }
  { The following two constants *MUST* remain in the IP:CS order        }
  { because StaySave uses them as a JMP target                          }
  DOS_IntIP : Integer = 0;    {Pointer to Original IP Int value   }
  DOS_IntCs : Integer = 0;    {Pointer to Original Cs Int value   }
  StackSize : Integer = 0;    {Current User/or Dos Stack word size}
  {-------------- V A R I A B L E S ----------------------------------------}
VAR
  SaveRegs : regtype;
  HalfRegs : halfregtype ABSOLUTE regs;
  Terminate_flag : Boolean;
  Keychr : Char;
  Old_Xpos, Old_Ypos : Integer;
  I : Integer;

  {-----------------------------------------------------------------------------}
  {                 W  I  N  D  O  W     R  O  U  T  I  N  E                    }
  {---------------------------------------------------------------------------- }

    {**********************************************************************}
  {                         W I N D O . I N C                            }
  {                                                                      }
  {**********************************************************************}
  {                 Kloned and Kludged by Lane Ferris                    }
  {                     -- The Hunters Helper --                         }
  {               Original Copyright 1984 by Michael A. Covington        }
  {               Extensive Modifications by Lynn Canning 9/25/85        }
  {                                          9107 Grandview Dr.          }
  {                                          Overland Park, Ks. 66212    }
  {                 1) Foreground and Background colors added.           }
  {                    NOTE:  Monochrome monitors are automatically set  }
  {                           to white on black.                         }
  {                 2) Multiple borders added.                           }
  {                 3) TimeDelay procedure added.                        }
  {               Requirements: IBM PC or close compatible.              }
  {----------------------------------------------------------------------}
  { To make a window on the screen, call the procedure                   }
  {      MkWin(x1,y1,x2,y2,FG,BG,BD);                                    }
  {   The x and y coordinates define the window placement and are the    }
  {   same as the Turbo Pascal Window coordinates.                       }
  {   The border parameters (BD) are 0 = No border                       }
  {                                  1 = Single line border              }
  {                                  2 = Double line border              }
  {   The foreground (FG) and background (BG) parameters are the same    }
  {   values as the corresponding Turbo Pascal values.                   }
  {                                                                      }
  { The maximum number of windows open at one time is set at five        }
  { (see MaxWin=5).  This may be set to greater values if necessary.     }
  {                                                                      }
  { After the window is made, you must write the text desired from the   }
  { calling program.  Note that the usable text area is actually 1       }
  { position smaller than the window coordinates to allow for the border.}
  { Hence, a window defined as 1,1,80,25 would actually be 2,2,79,24     }
  { after the border is created.  When writing to the window in your     }
  { calling program, the textcolor and backgroundcolor may be changed as }
  { desired by using the standard Turbo Pascal commands.                 }
  {                                                                      }
  { To return to the previous screen or window, call the procedure       }
  {      RmWin;                                                          }
  {                                                                      }
  { The TimeDelay procedure is involked from your calling program.  It   }
  { is similar to the Turbo Pascal DELAY except DELAY is based on clock  }
  { speed whereas TimeDelay is based on the actual clock.  This means    }
  { that the delay will be the same duration on all systems no matter    }
  { what the clock speed.                                                }
  { The procedure could be used for an error condition as follows:       }
  {     MkWin          - make an error message window                    }
  {     Writeln        - write error message to window                   }
  {     TimeDelay(5)   - leave window on screen 5 seconds                }
  {     RmWin          - remove error window                             }
  {     cont processing                                                  }
  {----------------------------------------------------------------------}

CONST

  InitDone : Boolean = False; { Initialization switch   }

  On = True;
  Off = False;
  VideoEnable = $08;          { Video Signal Enable Bit }
  Bright = 8;                 { Bright Text bit}
TYPE
  Imagetype = ARRAY[1..4000] OF Char; { Screen Image in the heap    }
  WinDimtype = RECORD
                 x1, y1, x2, y2 : Integer
               END;

  Screens = RECORD            { Save Screen Information     }
              Image : Imagetype; { Saved screen Image }
              Dim : WinDimtype; { Saved Window Dimensions }
              x, y : Integer; { Saved cursor position }
            END;


VAR

  Win :                       { Global variable package }
  RECORD
    Dim : WinDimtype;         { Current Window Dimensions }
    Depth : Integer;
    { MaxWin should be included in your program }
    { and it should be the number of windows saved }
    { at one time }
    { It should be in the const section of your program }
    Stack : ARRAY[1..MaxWin] OF ^Screens;

  END;

  Crtmode : Byte ABSOLUTE $0040 : $0049; {Crt Mode,Mono,Color,B&W..}
  Crtwidth : Byte ABSOLUTE $0040 : $004A; {Crt Mode Width, 40:80 .. }
  Monobuffer : Imagetype ABSOLUTE $B000 : $0000; {Monochrome Adapter Memory}
  Colorbuffer : Imagetype ABSOLUTE $B800 : $0000; {Color Adapter Memory     }
  CrtAdapter : Integer ABSOLUTE $0040 : $0063; { Current Display Adapter }
  VideoMode : Byte ABSOLUTE $0040 : $0065; { Video Port Mode byte    }
  Video_Buffer : Integer;     { Record the current Video}
  FG : Byte;                  {Foregound color value    }
  BG : Integer;               {Background color value   }
  BD : Integer;               {Border type Value 0..2   }
  Switch : Boolean;
  Delta,
  Xtemp, Ytemp : Integer;
  x, y : Integer;

  {------------------------------------------------------------------}
  {                     Delay for  X seconds                         }
  {------------------------------------------------------------------}

  PROCEDURE TimeDelay(hold : Integer);
  TYPE
    RegRec =                  { The data to pass to DOS }
    RECORD
      AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;
    END;
  VAR
    regs : regrec;
    ah, al, ch, cl, dh : Byte;
    sec : STRING[2];
    tmptime, result, secn, error, secn2, diff : Integer;

  BEGIN
    ah := $2c;                {Get Time-Of-Day from DOS}
    WITH regs DO              {Will give back Ch:hours }
      {Cl:minutes,Dh:seconds   }
      ax := ah SHL 8+al;      {Dl:hundreds             }
    Intr($21, regs);

    WITH regs DO
      Str(dx SHR 8:2, sec);   {Get seconds      }
    {with leading null}
    IF (sec[1] = ' ') THEN
      sec[1] := '0';
    Val(sec, secn, error);    {Conver seconds to integer}
    REPEAT                    { stay in this loop until the time }
      ah := $2c;              { has expired }
      WITH regs DO
        ax := ah SHL 8+al;
      Intr($21, regs);        {Get current time-of-day}

      WITH regs DO            {Normalize to Char}
        Str(dx SHR 8:2, sec);
      IF (sec[1] = ' ') THEN
        sec[1] := '0';
      Val(sec, secn2, error); {Convert seconds to integer}
      diff := secn2-secn;     {Number of elapsed seconds}
      IF diff < 0 THEN        { we just went over the minute }
        diff := diff+60;      { so add 60 seconds }
    UNTIL diff > hold;        { has our time expired yet }
  END;                        { procedure TimeDelay }

  {------------------------------------------------------------------}
  {          Get Absolute postion of Cursor into parameters x,y      }
  {------------------------------------------------------------------}
  PROCEDURE Get_Abs_Cursor(VAR x, y : Integer);
  VAR
    Active_Page : Byte ABSOLUTE $0040 : $0062; { Current Video Page Index}
    Crt_Pages : ARRAY[0..7] OF Integer ABSOLUTE $0040 : $0050;

  BEGIN

    X := Crt_Pages[active_page]; { Get Cursor Position       }
    Y := Hi(X)+1;             { Y get Row                 }
    X := Lo(X)+1;             { X gets Col position       }
  END;
  {------------------------------------------------------------------}
  {          Turn the Video On/Off to avoid Read/Write snow          }
  {------------------------------------------------------------------}
  PROCEDURE Video(Switch : Boolean);
  BEGIN
    IF (Switch = Off) THEN
      Port[CrtAdapter+4] := (VideoMode-VideoEnable)
    ELSE Port[CrtAdapter+4] := (VideoMode OR VideoEnable);
  END;
  {------------------------------------------------------------------}
  {     InitWin Saves the Current (whole) Screen                     }
  {------------------------------------------------------------------}
  PROCEDURE InitWin;
    { Records Initial Window Dimensions }
  BEGIN

    IF CrtMode = 7 THEN
      Video_Buffer := $B000   {Set Ptr to Monobuffer      }
    ELSE Video_Buffer := $B800; { or Color Buffer          }

    WITH Win.Dim DO
      BEGIN x1 := 1; y1 := 1; x2 := crtwidth; y2 := 25 END;
    Win.Depth := 0;
    InitDone := True;         { Show initialization Done }
  END;
  {------------------------------------------------------------------}
  {       BoxWin Draws a Box around the current Window               }
  {------------------------------------------------------------------}
  PROCEDURE BoxWin(x1, y1, x2, y2 : Integer; BD : Integer; FG : Byte; BG : Integer);

    { Draws a box, fills it with blanks, and makes it the current }
    { Window.  Dimensions given are for the box; actual Window is }
    { one unit smaller in each direction.                         }

  VAR
    x, y, I : Integer;
    TB, SID, TLC, TRC, BLC, BRC : Integer;

  BEGIN
    IF Crtmode = 7 THEN BEGIN
      FG := 7;
      BG := 0;
    END;
    Window(x1, y1, x2, y2);
    TextColor(FG);
    TextBackground(BG);

    IF BD = 1 THEN BEGIN
      TB := 196;              {Top Border}
      SID := 179;             {Side Border}
      TLC := 218;             {Top Left Corner}
      TRC := 191;             {Top Right Corner}
      BLC := 192;             {Bottom Left Corner}
      BRC := 217;             {Bottom Right Corner}
    END
    ELSE BEGIN
      TB := 205;
      SID := 186;
      TLC := 201;
      TRC := 187;
      BLC := 200;
      BRC := 188;
    END;

    IF BD <> 0 THEN BEGIN
      { Top }
      GoToXY(1, 1);           { Windo Origin        }
      Write(Chr(TLC));        { Top Left Corner     }
      FOR I := 2 TO x2-x1 DO  { Top Bar             }
        Write(Chr(TB));
      Write(Chr(TRC));        { Top Right Corner

                              { Sides  }
      FOR I := 2 TO y2-y1 DO
        BEGIN
          GoToXY(1, I);       { Left Side Bar       }
          Write(Chr(SID));
          GoToXY(x2-x1+1, I); { Right Side Bar      }
          Write(Chr(SID));
        END;

      { Bottom }
      GoToXY(1, y2-y1+1);     { Bottom Left Corner }
      Write(Chr(BLC));
      FOR I := 2 TO x2-x1 DO  { Bottom Bar         }
        Write(Chr(TB));

      { Make it the current Window }
      Window(x1+1, y1+1, x2-1, y2-1);
      Write(Chr(BRC));        { Bottom Right Corner }
    END; {If BD <> 0} ;

    GoToXY(1, 1);
    TextColor(FG MOD 16);     { Take Low nibble 0..15  }
    TextBackground(BG);       { Take High nibble  0..9 }
    ClrScr;
  END;
  {------------------------------------------------------------------}
  {       MkWin   Make a Window                                      }
  {------------------------------------------------------------------}
  PROCEDURE MkWin(x1, y1, x2, y2 : Integer; FG : Byte; BG : Integer; BD : Integer);
    { Create a removable Window }

  BEGIN

    IF (InitDone = False) THEN { Initialize if not done yet }
      InitWin;

    WITH Win DO Depth := Depth+1; { Increment Stack pointer }
    IF Win.Depth > maxWin THEN
      BEGIN
        WriteLn(^G, ' Windows nested too deep ');
        Halt
      END;
    {-------------------------------------}
    {       Save contents of screen       }
    {-------------------------------------}
    Video(Off);               { Turn off Video to avoid Snow  }

    WITH Win DO
      BEGIN
        New(Stack[Depth]);    { Allocate Current Screen to Heap }
        IF CrtMode = 7 THEN
          Stack[Depth]^.Image := monobuffer { set pointer to it      }
        ELSE
          Stack[Depth]^.Image := colorbuffer;
      END;

    Video(On);                { Turn the Video back on        }

    WITH Win DO
      BEGIN                   { Save Screen Dimentions        }
        Stack[Depth]^.Dim := Dim;
        Stack[Win.Depth]^.x := WhereX; { Save Cursor Position          }
        Stack[Win.Depth]^.y := WhereY;
      END;

    { Validate the Window Placement}
    IF (X2 > 80) THEN         { If off right of screen       }
      BEGIN
        Delta := (X2-80);     { Overflow off right margin    }
        X1 := X1-Delta;       { Move Left window edge        }
        X2 := X2-Delta;       { Move Right edge on 80        }
      END;
    IF (Y2 > 25) THEN         { If off bottom   screen       }
      BEGIN
        Delta := Y2-25;       { Overflow off right margin    }
        Y1 := Y1-Delta;       { Move Top edge up             }
        Y2 := Y2-Delta;       { Move Bottom  24              }
      END;
    { Create the Window New window }
    BoxWin(x1, y1, x2, y2, BD, FG, BG);
    Win.Dim.x1 := x1+1;
    Win.Dim.y1 := y1+1;       { Allow for margins }
    Win.Dim.x2 := x2-1;
    Win.Dim.y2 := y2-1;

  END;
  {------------------------------------------------------------------}
  {     Remove Window                                                }
  {------------------------------------------------------------------}
  { Remove the most recently created removable Window }
  { Restore screen contents, Window Dimensions, and   }
  { position of cursor.  }
  PROCEDURE RmWin;
  VAR
    Tempbyte : Byte;

  BEGIN
    Video(Off);

    WITH Win DO
      BEGIN                   { Restore next Screen       }
        IF crtmode = 7 THEN
          monobuffer := Stack[Depth]^.Image
        ELSE
          colorbuffer := Stack[Depth]^.Image;
        Dispose(Stack[Depth]); { Remove Screen from Heap   }

        Video(On);

        WITH Win DO           { Re-instate the Sub-Window }
          BEGIN               { Position the old cursor   }
            Dim := Stack[Depth]^.Dim;
            Window(Dim.x1, Dim.y1, Dim.x2, Dim.y2);
            GoToXY(Stack[Depth]^.x, Stack[Depth]^.y);
          END;

        Get_Abs_Cursor(x, y); { New Cursor Position       }
        Tempbyte :=           { Get old Cursor attributes }
        Mem[Video_Buffer:((x-1+(y-1)*80)*2)+1];

        TextColor(Tempbyte AND $0F); { Take Low nibble  0..15}
        TextBackground(Tempbyte DIV 16); { Take High nibble  0..9 }
        Depth := Depth-1
      END;
  END;
  {------------------------------------------------------------------}
  {------------------------------------------------------------------}


  {-----------------------------------------------------------------------------}
  {            S  T  A  Y  E  X  I  T                                           }
  {-----------------------------------------------------------------------------}

  PROCEDURE Stay_Xit;
    {-----------------------------------------------------------------------------}
    {  Stay_Xit Check Terminate Keys                                              }
    {                                                                             }
    {  Clean up the Program ,Free the Environment block, the program segment      }
    {  memory and return to Dos. Programs using this routine ,must be the         }
    {  last program in memory, else ,a hole will be left causing Dos              }
    {  to go GooGoo .                                                             }
    {-----------------------------------------------------------------------------}

  BEGIN                       { Block }
    Rmwin;
    WriteLn('Stay-Resident program Terminating');

    SaveRegs.Ax := $25 SHL 8+Kybrd_Int;
    SaveRegs.Ds := DOS_IntCS;
    SaveRegs.Dx := DOS_IntIP; { Reset the Keyboard interrupt addr }
    MsDos(SaveRegs);          { to its original value             }

    Saveregs.Ax := $49 SHL 8+0; { Free Allocated Block function}
    Saveregs.Es := MemW[CSeg:$2C]; { Free environment block       }
    MsDos(Saveregs);

    Saveregs.Ax := $49 SHL 8+0; { Free Allocated Block function}
    Saveregs.Es := CSeg;      { Free Program                 }
    MsDos(Saveregs);

    Intr($20, Regs);          { Return to Dos }

  END { StayXit } ;

  {----------------------------------------------------------------------}
  {            C a l l    O r i g i n a l    I n t e r r u p t           }
  {----------------------------------------------------------------------}
  PROCEDURE CallOriginalIntr(VAR RegAx : Integer);
    {Invoke the original DOS interrupt and  }
  BEGIN                       {Return the value in parameter          }
    INLINE(
      $B4/$00/                {Mov Ah,Read function                   }
      $9C/                    {Push Flags                             }
      $2E/$FF/$1E/DOS_IntIP/  {Call Far [DOS_IntIP]                   }
      $C4/$BE/RegAx/          {Les Di,KeyChr[Bp]                      }
      $AB                     {StosW          Stuff in new KeyChr     }
      );
  END;                        {CallOriginalIntr}
  {----------------------------------------------------------------------}
  {           K e y i n   :   R e a d  K e a b o a r d                   }
  {----------------------------------------------------------------------}
  FUNCTION Keyin : Char;      { Get a key from the Keyboard           }
  VAR Ch : Char;              { If extended key, fold above 127       }
  BEGIN                       {---------------------------------------}
    REPEAT UNTIL KeyPressed;
    Read(Kbd, Ch);
    IF (Ch = Esc) AND KeyPressed THEN
      BEGIN
        Read(Kbd, Ch);
        Ch := Char(Ord(Ch)+127);
      END;
    Keyin := Ch;
  END;                        {Keyin}
  {----------------------------------------------------------------------}
  {          B e e p   :  S o u n d  t h e  H o r n                      }
  {----------------------------------------------------------------------}
  PROCEDURE Beep(N : Integer); {------------------------------------------}
  BEGIN                       {  This routine sounds a tone of frequency }
    Sound(n);                 {  N for approximately 100 ms              }
    Delay(100);               {------------------------------------------}
    Sound(n DIV 2);
    Delay(100);
    NoSound;
  END {Beep} ;

  {*************************************************************************}
  {-------------------------------------------------------------------------}
  {            THE FOLLOWING ARE THE USER INCLUDE ROUTINES                  }
  {-------------------------------------------------------------------------}
  {*************************************************************************}

  procedure filedirectory;
  {simple sorted file directory}

CONST
  maxfiles = 128;             {max number of files searched in a given directory}
TYPE
  drivename = STRING[2];
  filename = STRING[13];
  pathname = STRING[64];
  darray = RECORD
             num : Integer;
             arr : ARRAY[1..maxfiles] OF filename;
           END;
  register = RECORD
               CASE Integer OF
                 1 : (ax, bx, cx, dx, bp, si, di, ds, es, flags : Integer);
                 2 : (al, ah, bl, bh, cl, ch, dl, dh : Byte);
             END;
  dtarec = RECORD
             dosnext : ARRAY[1..21] OF Byte;
             attr : Byte;
             ftime, fdate, flsize, fhsize : Integer;
             fullname : ARRAY[1..13] OF Char;
           END;

VAR
  reg : register;
  inpath : pathname;
  dta : dtarec;
  files : darray;
  filnum : Integer;
  lcount, olddtaseg,olddtaofs:integer;
  drivenum:byte;
  stop:boolean;

  FUNCTION stlocase(st : filename) : filename;
    {-convert a string to lowercase}
  VAR i : Integer;
  BEGIN
    FOR i := 1 TO Length(st) DO
      IF (st[i] >= 'A') AND (st[i] <= 'Z') THEN
        st[i] := Chr(Ord(st[i])+32);
    stlocase := st;
  END;                        {stlocase}

procedure storedta(var dtaseg,dtaofs:integer);
  {-return the old dta address}
begin
    reg.ah := $2F;
    MsDos(reg);
    dtaseg:=reg.es;
    dtaofs:=reg.bx;
end; {storedta}

  PROCEDURE setdta(dtaseg,dtaofs:integer);
    {-set new DTA address}
  BEGIN
    reg.ah := $1A;
    reg.ds := dtaseg;
    reg.dx := dtaofs;
    MsDos(reg);
  END;                        {setdta}

  PROCEDURE getfiles(VAR files : darray; VAR inpath : pathname);
    {-return the files in the files array}
  VAR
    name : filename;
    startpath : pathname;

    FUNCTION fileexists(VAR s : pathname; attr : Integer) : Boolean;
      {-determine whether a file exists with the specified attribute}
    BEGIN
      reg.ah := $4E;
      s[Length(s)+1] := #0;
      reg.ds := Seg(s);
      reg.dx := Ofs(s[1]);
      reg.cx := attr;
      MsDos(reg);
      fileexists := ((reg.flags AND 1) = 0) AND ((dta.attr AND 31) = attr);
    END;                      {fileexists}

    PROCEDURE expandpath(VAR start, outpath : pathname);
      {-add wildcards to path}
    CONST
      drivelets:string[26]='ABCDEFGHIJKLMNOPQRSTUVWXYZ';
    VAR
      ch : Char;
      colpos:byte;
    BEGIN
      colpos:=pos(':',start);
      if colpos=0 then
        drivenum:=0
      else
        drivenum:=pos(upcase(start[pred(colpos)]),drivelets);
      IF start = '' THEN BEGIN
        outpath := '*.*';
        Exit;
      END;
      ch := start[Length(start)];
      IF (ch = '\') OR (ch = ':') THEN BEGIN
        outpath := start+'*.*';
        Exit;
      END;
      IF fileexists(start, 16) THEN BEGIN
        outpath := start+'\*.*';
        Exit;
      END;
      outpath := start;
    END;                      {expandpath}

    PROCEDURE parsedta(VAR name : filename);
      {-return a name and extension from a DTA}
    VAR
      i : Byte;
    BEGIN
      i := 1;
      WHILE dta.fullname[i] <> #0 DO i := i+1;
      Move(dta.fullname, name[1], i-1);
      name[0] := Chr(i-1);
    END;                      {parsedta}

    FUNCTION getfirst(VAR startpath : pathname;
                      VAR name : filename) : Boolean;
      {-return true and a name if first file is found}
    VAR
      foundone : Boolean;
    BEGIN
      reg.ah := $4E;
      reg.ds := Seg(startpath);
      reg.dx := Ofs(startpath[1]);
      reg.cx := 17;
      MsDos(reg);
      foundone := ((reg.flags AND 1) = 0);
      IF foundone THEN
        {scan the DTA for the file name and extension}
        parsedta(name);
      getfirst := foundone;
    END;                      {getfirst}

    FUNCTION getnext(VAR name : filename) : Boolean;
      {-return true and a name if another file is found}
    VAR
      foundone : Boolean;
    BEGIN
      reg.ah := $4F;
      reg.ds := Seg(dta);
      reg.dx := Ofs(dta);
      MsDos(reg);
      foundone := ((reg.flags AND 1) = 0);
      IF foundone THEN
        {scan the DTA for the file name and extension}
        parsedta(name);
      getnext := foundone;
    END;                      {getnext}

  BEGIN
    expandpath(inpath, startpath);
    WITH files DO BEGIN
      startpath[Length(startpath)+1] := #0;
      num := 0;
      IF getfirst(startpath, name) THEN
        REPEAT
          IF name[1] <> '.' THEN BEGIN
            num := Succ(num);
            arr[num] := name;
            IF (dta.attr AND 16) <> 0 THEN arr[num] := arr[num]+'\';
          END;
        UNTIL (num = maxfiles) OR NOT(getnext(name));
    END;
  END;                        {getfiles}

  PROCEDURE sortfiles(VAR files : darray; l, r : Integer);
    {-sort via recursive quicksort}
  VAR
    i, j : Integer;
    part : filename;

    PROCEDURE Swap(i, j : Integer);
      {-swap the two referenced data elements}
    VAR
      t : filename;
    BEGIN
      WITH files DO BEGIN
        t := arr[i];
        arr[i] := arr[j];
        arr[j] := t;
      END;
    END;                      {swap}

  BEGIN

    IF l < r THEN WITH files DO BEGIN

      i := l;
      j := Succ(r);

      {get a random partitioning element}
      Swap(i, i+Random(j-i));
      part := arr[i];

      {swap elements until all less than partition are to left, etc}
      REPEAT
        REPEAT
          i := Succ(i);
        UNTIL (i > j) OR (arr[i] >= part);
        REPEAT
          j := Pred(j);
        UNTIL (arr[j] <= part);
        IF i < j THEN Swap(j, i);
      UNTIL i >= j;

      Swap(l, j);
      sortfiles(files, l, Pred(j));
      sortfiles(files, Succ(j), r);
    END;

  END;                        {sortfiles}

function bytesavailable(drivenum:byte):real;
begin
  reg.ah:=$36;
  reg.dl:=drivenum;
  msdos(reg);
  bytesavailable:=1.0*reg.bx*reg.ax*reg.cx;
end; {bytesavailable}

  PROCEDURE checkmore(VAR j : Integer;var stop:boolean);
    {-see if user wants to see more}
  VAR
    c : Char;
  BEGIN
    stop := False;
    Write('....more?  ');
    Read(Kbd, c);
    IF (c = ' ') OR (UpCase(c) = 'Y') THEN
      j := 1
    ELSE IF c = ^M THEN
      j := j-1
    ELSE
      stop := True;
    Write(Con, ^M); ClrEol;
  END;                        {checkmore}

BEGIN
  write('Enter directory mask: ');
  readln(inpath);
  storedta(olddtaseg,olddtaofs);
  setdta(seg(dta),ofs(dta));
  getfiles(files, inpath);
  sortfiles(files, 1, files.num);
  WriteLn;
  lcount:=1;
  filnum:=1;
  stop:=false;
  while (filnum<=files.num) and not(stop) do begin
    Write(stlocase(files.arr[filnum]), '':(15-Length(files.arr[filnum])));
    IF (filnum MOD 5) = 0 THEN begin
      WriteLn;
      lcount:=succ(lcount);
      if lcount>=12 then checkmore(lcount,stop);
    end;
    filnum:=succ(filnum);
  END;
  IF (files.num MOD 5) <> 0 THEN WriteLn;
  if not(stop) then writeln;
  write('bytes available: ',bytesavailable(drivenum):0:0);
  setdta(olddtaseg,olddtaofs);
END; {filedirectory}

  {----------------------------------------------------------------------}
  {        D   E  M  O                                                   }
  {----------------------------------------------------------------------}
  PROCEDURE Demo;             { Give Demonstration of Code        }
  VAR
    Trash : Char;
    attribyte,
    OldAttribute : Byte;
    Xcursor : Integer;
    Ycursor : Integer;

  BEGIN
    KeyChr := #0;             { Clear any residual krap    }
    MkWin(1, 5, 80, 20, white{Cyan}, Black, 2); { Make a Biiiiiiig window    }
    ClrScr;                   { Clear screen out           }
    filedirectory;
    { Make a little Window and hold for }
    { user to give us a goose..or whatever}
    GoToXY(Xcursor, Ycursor);
    mkwin(60,21,72,24,Cyan, Black, 2);
    GoToXY(1, 1);
    Write('Press a key . . .');

    WHILE (NOT KeyPressed);   { Pause until Key pressed }
    WHILE KeyPressed DO       { Get Ctrl-Home maybe     }
      Read(Kbd, KeyChr);      { Read the users Key      }
    RmWin;                    { Remove the Window       }
    IF KeyChr = Quit_Key THEN { If Terminate Key then   }
      Stay_Xit;               { remove ourself from  Memory }

    RmWin;                    { Remove the big window      }
  END;                        { Demo }


  {-------------------------------------------------------------------------}
  {              P R O C E S S   I N T E R R U P T                          }
  { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  PROCEDURE Process_Intr;

  BEGIN
    {This Inline routine will save the regs and Stack for Stay resident programs.
    It restores DS and SS from the previously saved integer constants "OurDseg"
    and "OurSSeg". This is important since Dos is not re-entrant and any attempt
    to use Interrupt I/O services will clobber the very stack on which the
    Resident Turbo program just saved its regs. Thus, on the final return, you
    and Toto will end up somewhere other than Kansas and without your Ruby Reds.
    }

    { author:      Lane Ferris
    - The Hunter's Helper -

    Distributed to the Public Domain for use without profit.
    Original Version 5.15.85
    }
    { On entry the Stack will already contain: }
    {  1) Sp for Dos                           }
    {  2) Bp for Dos                           }
    {  3) Ip for Dos                           }
    {  4) Cs for Dos                           }
    {  5) Flags for Dos                        }
    INLINE(

      { The following routine avoids the overhead of saving the DOS stack         }
      { when the INT 16 function was not for a character request. This happens    }
      { often (every four chars) as DOS checks on ^S/^Q/^C/Keypressed  ad.nausea  }

      $9C/                    {PushF         Save Flags             }
      $80/$FC/$00/            {Cmp Ah,00     If Char request,       }
      $75/$11/                {Jne  Skipit   Not for us.            }
      $2E/
      $FF/$1E/Dos_Intip/      {Call Far Cs:[Original$16]            }
      $9C/                    {PushF          Save Return Flags     }
      $80/$FC/Our_Char/       {Cmp   Ah,Cs:OurChar  Our Key?        }
      $74/$0E/                {Je GotIt       enter Staysave code   }
      $9D/                    {POPF           Restore $16 flags     }
      $5D/$5D/                {Pop BP/PopBP   Restore BP            }
      $CA/$02/$00/            {RetF 2   Return w/Key discard flags  }

      {Skipit}                {Jmp to Original Dos Intr $16         }
      $9D/                    {PopF  Restore the Flags              }
      $5D/$5D/                {Pop  Bp/Pop Bp else  Restore Bp &    }
      $2E/                    {     Jump to Original Dos Interrupt  }
      $FF/$2E/Dos_IntIP/      {Jmp Far Cs:[DOS_IntIp]               }

      { Move the current active registers to a save place}
      {GotIt}
      $9D/                    {Pop Saved Flags}
      $FA/                    {Cli         Stop all interrupts       }
      { Bp and Sp aready saved at Begin Stmt }
      $55/                    {Push   Bp  Save again for Regpak      }
      $BD/Regs/               {Mov    Bp,offset REGS address savearea}
      $2E/$89/$46/$00/        {CS:Mov [Bp+0],AX Save Users Registers }
      $2E/$89/$5E/$02/        {Cs:Mov [Bp+2],Bx}
      $2E/$89/$4E/$04/        {CS:Mov [Bp+4],CX}
      $2E/$89/$56/$06/        {CS:Mov [Bp+6],DX}
      $2E/$8F/$46/$08/        {Pop    Cs:[Bp+8] Fetch Bp from stack  }
      $2E/$89/$76/$0A/        {CS:Mov [Bp+A],SI}
      $2E/$89/$7E/$0C/        {CS:Mov [Bp+C],DI}
      $2E/$8C/$5E/$0E/        {CS:Mov [Bp+E],DS}
      $2E/$8C/$46/$10/        {CS:Mov [Bp+10],ES}
      $9C/                    {PUSHF  put Flags on stack to retrieve }
      $2E/$8F/$46/$12/        {POP Cs:[Bp+12]}

      { If Current SS := [OurSseg] or (Inuse = True), }
      { then dont overlay the previously saved stack. }
      { This program is being recursive.              }

      $2E/$80/$3E/Inuse/$01/  {Cmp  Cs:[Inuse],1   Inuse = True ?         }
      $74/$62/                {Je   ReCurin        Yes, -J-U-M-P-         }

      { Switch the SS:Sp reg pair over to ES:Si       }
      { Put Turbo's Stack pointers into SS:Sp         }

      $2E/$8C/$16/DosSSeg/    {Mov  Cs:DosSSeg,SS Save Dos Stack Segment    }
      $8C/$D6/                {Mov  Si,SS         Es gets Dos stack         }
      $8E/$C6/                {Mov  Es,Si                                   }
      $2E/$8E/$16/OurSSeg/    {Mov  SS,Cs:OurSSeg SS Gets our Stack segment }
      $2E/$8E/$1E/OurDseg/    {Mov  Ds,Cs:Our_Ds  DS Gets our Data Segment  }

      { If ES:Si (stack ptr) <>  OurSSeg  then        }
      { Sp := Virgin Turbo Stack pointer.             }
      { If Es:Si := OurSSeg, then this is a Read or   }
      { Write before Inuse was set True. Dont clobber }
      { the current setting of Turbo stack pointer.   }

      $2E/$3B/$36/OurSSeg/    {Cmp  Si,Cs:OurSSeg If SS := OurSSeg then     }
      $89/$E6/                {Mov  Si,Sp         dont clobber saved regs   }
      $74/$05/                {Je   $+5           else get virgin stack ptr }
      $3E/$8B/$36/$74/$01/    {Mov  Si,Ds:[174]   ..(cf. code at B2B 3.0x)  }
      $87/$F4/                {Xchg Sp,Si         Set new  Stack Pointer    }

      { Stack Dos/User interrupted pgm regs for Exit. }
      { These are the original interrupt process regs }
      { that must be returned on interrupt return     }

      $2E/$FF/$76/$00/        {Push [Bp+0]  Save Ax                         }
      $2E/$FF/$76/$02/        {Push [Bp+2]  Save Bx                         }
      $2E/$FF/$76/$04/        {Push [Bp+4]  Save Cx                         }
      $2E/$FF/$76/$06/        {Push [Bp+6]  Save Dx                         }
      {Push [Bp+8]  Save Bp                         }
      $2E/$FF/$76/$0A/        {Push [Bp+A]  Save Si                         }
      $2E/$FF/$76/$0C/        {Push [Bp+C]  Save Di                         }
      $2E/$FF/$76/$0E/        {Push [Bp+E]  Save Ds                         }
      $2E/$FF/$76/$10/        {Push [Bp+10] Save Es                         }

      { Now stack the lesser of current stack size or  }
      { 40 Words to our stack, to be re-stack on the   }
      { interrupted pgms stack on exit. This is done   }
      { to allow recursive entry into Dos/or other non }
      { re-entrant pgms.                               }

      $29/$C9/                {Sub  Cx,Cx  Find minimum of current stack    }
      $29/$F1/                {Sub  Cx,Si  size or 40 words to save.        }
      $D1/$E9/                {Shr  Cx,1   Stackbytes/2 for words.          }
      $83/$F9/$40/            {Cmp  Cx,+40 This keeps up from overrunning   }
      $7E/$03/                {Jle  $+3    the Stack Segment when it is less}
      $B9/$40/$00/            {Mov  Cx,40  than Dos stack size              }
      $2E/$89/$0E/StackSize/  {Mov  Cs:StackSize,Cx Save current stack size }
      {Restack:}
      $26/$FF/$34/            {Push Es:[Si] Our Stack := Dos Es:Si          }
      $46/$46/                {Inc  Si/Inc Si Get Next Dos Stack Word       }
      $E2/$F9/                {Loop to Restack                              }

      $56/                    {Push Si            Save bottom of Dos Stack  }
      $2E/$8C/$5E/$0E/        {Mov  Cs:[Bp+E],Ds  Set New Data Segmt in regs}
      {Recurin}               {                     Jump here if Recursion  }
      $FB                     {Sti Enable Interrupts                        }

      );


    { Check the Int 16 request function in Ah reg:  }
    {       0 = read character from Keyboard        }
    {       1 = check character available           }
    {       2 = check shift key values              }
    IF Halfregs.Ah = Ord(Our_Char) { Separate the tests so code    }
    THEN IF (NOT InUse) THEN  { performs efficiently.         }
      { Must be OUR key and not busy  }
      BEGIN                   { Demo }
        InUse := True;        { "dont clobber saved stack"}
        Demo;
        CallOriginalIntr(Regs.Ax); { Get input key for the users     }
        IF HalfRegs.Ah = Ord(Our_Char) THEN Beep(650);

        InUse := False;       { ok to restore interrupted stack }
      END;                    { Demo }

    {Version 3.31}
    { Inline Code to restore the stack and regs moved}
    { to the Turbo Resident Stack which allows       }
    { re-entrancy into Dos for I/O and  recursion    }
    { for Turbo Terminate & Stay Resident programs.  }

    { Author: Lane Ferris                                       }
    {         - The Hunter's Helper -                           }
    { Distributed to the Public Domain for use without profit.  }
    { Original Version 5.15.85                                  }
    {----------------------------------------------------------------------}
    {        Restore the Dos (or interrupted pgm) Regs and Stack           }
    {----------------------------------------------------------------------}
    { On entry the Stack will already contain: }
    {    Pointer to bottom of stack            }
    {    Bottom of Dos Stack Ptr               }
    {    StackSize words of saved pgm stack    }
    {    Dos Flags                             }
    {    Dos Code Segment                      }
    {    Dos Instruction Ptr                   }
    {    Dos Base Pointer                      }
    {    Dos Original Stack Ptr                }


    { Retrieve the Regpack registers as they were    }
    { stored for the Interrupt Entry.                }

    INLINE(
      $BD/Regs/               {Mov    Bp,offset REGS}
      $2E/$8B/$46/$00/        {CS:Mov Ax,[Bp+0]}
      $2E/$8B/$5E/$02/        {Cs:Mov Bx,[Bp+2]}
      $2E/$8B/$4E/$04/        {CS:Mov Cx,[Bp+4]}
      $2E/$8B/$56/$06/        {CS:Mov Dx,[Bp+6]}

      $2E/$8B/$76/$0A/        {CS:Mov Si,[Bp+A]}
      $2E/$8B/$7E/$0C/        {CS:Mov Di,[Bp+C]}
      $2E/$8E/$5E/$0E/        {CS:Mov DS,[Bp+E]}
      $2E/$8E/$46/$10/        {CS:Mov ES,[Bp+10]}
      $2E/$FF/$76/$12/        {Push Cs:[Bp+12]  }
      {PopF             }
      { The following code was added to avoid }
      { the 80286 Pop flag (POPF) bug which   }
      { enables interrupts while we are trying}
      { to POP  the stack on odd byte boundry }
      $EB/$01/                {JMP $+3 Skip over IRET   }
      $CF/                    {IRET    POP IP/CS/Flags  }
      $0E/                    {PUSH CS Make a return    }
      $E8/$FB/$FF/            {CALL CS:$-2 Pop the Flags}

      { If [Cs:InUse]:= True,  then dont restore the stack.}
      { This program is being recursive. Else restore  Dos }
      { Stack and Program Entry registers for final exit.  }

      $2E/$80/$3E/Inuse/$01/  {Cmp  byte ptr Cs:[Inuse],1                   }
      $74/$25/                {Je   ReCurOut   J-U-M-P                      }

      { Move "StackSize" words back to the interrupted pgms}
      { stack. The originals could have been clobber by our}
      { being recursive. (Especially true of DOS)          }

      $FA/                    { Cli      ; Stop all interrupts    }
      $5E/                    {Pop Si     Bottom of Dos Stack              }
      $2E/$8B/$0E/StackSize/  {Mov Cx,Cs:StackSize Saved Stack Words       }
      $2E/$8E/$06/DosSSeg/    {Mov ES,Cs:DosSSeg Get Dos StackSegment      }
      {Restack:}
      $4E/$4E/                {Dec Si/Dec Si     Backup Dos Stack          }
      $26/$8F/$04/            {Pop Es:[Si]       Dos Stack := Our Stack    }
      $E2/$F9/                {Loop to Restack                             }
      $89/$F5/                {Mov Bp,Si         Save Dos Sp across Pops   }

      {         - C - A - U - T - I - O - N -              }
      { Restore the original interrupted programs regs     }
      { except Ax. Ax usually contains status. It contains }
      { a scan code and key for Int 16. You may want to    }
      { rework this if using another interrupt.            }

      $07/                    {Pop  Es                                     }
      $1F/                    {Pop  Ds                                     }
      $5F/                    {Pop  Di                                     }
      $5E/                    {Pop  Si                                     }
      $5A/                    {Pop  Dx                                     }
      $59/                    {Pop  Cx                                     }
      $5B/                    {Pop  Bx                                     }
      $44/$44/                {Inc sp/Inc sp Thow old Ax value away        }

      $89/$EC/                {Mov  Sp,Bp         Setup Dos Stack Ptr     }
      $2E/$8E/$16/DosSSeg/    {Mov  SS,Cs:DosSSeg Give back Dos Stack     }

      {RecurOut}              {Clean up the Stack                }
      $5D/                    {Pop Bp     Throw away old dos Sp  }
      $BD/Regs/               {Mov Bp,offset REGS                }
      $2E/$FF/$76/$12/        {Push Cs:[Bp+12]  Flags from last  }
      {PopF             interrupt.       }
      { The following code was added to avoid  }
      { the 80286 Pop flag (POPF) bug which    }
      { enables interrupts while we are trying }
      { to POP  the stack on odd byte boundry  }

      $EB/$01/                {JMP $+3 Skip over IRET   }
      $CF/                    {IRET    POP IP/CS/Flags  }
      $0E/                    {PUSH CS Make a return    }
      $E8/$FB/$FF/            {CALL CS:$-2 Pop the Flags}

      $5D/                    {Pop Bp  Retrieve old BP        }
      $FB/                    {Sti     Enable interrupts      }
      $CA/$02/$00             {Ret Far 002 Thow old flags away}
      );


  END;                        {Process_Intr}

  {-------------------------------------------------------------------------}
  {                             M  A  I  N                                  }
  {-------------------------------------------------------------------------}
  { The main program installs the new interrupt routine }
  { and makes it permanently resident as the keyboard   }
  { interrupt.  The old keyboard interrupt is addressed }
  { through #60H, so it can still be used.              }
  {                                                     }
  { The following dos calls are used:                   }
  { Function 25 - Install interrupt address             }
  {               input al = int number,                }
  {               ds:dx = address to install            }
  { Function 35 - get interrupt address                 }
  {               input al = int number                 }
  {               output es:bx = address in interrupt   }
  { Function 31 - terminate and stay resident           }
  {               input dx = size of resident program   }
  {               obtained from the memory              }
  {               allocation block at [Cs:0 - $10 + 3]  }
  { Function 49 - Free Allocated Memory                 }
  {               input Es = Block Segment to free      }
  { Interrupt 20 - Return to invoking process           }
  {-----------------------------------------------------}
BEGIN                         {**main**}

  InUse := False;             { Turn off the Inuse flag in case we do a write}
  OurDseg := DSeg;            { Save the Data Segment Address for Interrupts }
  OurSseg := SSeg;            { Save our Stack Segment for Interrupts        }


  Terminate_Flag := False;    { Havent received a Kill key yet   }
  SaveRegs.Es := 00;          { Clear for Dos 3.0 bug            }
  { now install the interrupt routine}

  { Initialize Your Progam Here since you wont get }
  { control again until "Our_Char" is entered from }
  { the Keyboard.                                  }

  SaveRegs.Ax := $3500+Kybrd_Int;
  Intr($21, SaveRegs);        {get the address of keyboard interrupt }

  DOS_IntIp := SaveRegs.BX;   { Location of DOS Interrupt Ip }
  DOS_IntCs := SaveRegs.Es;   { Location of DOS Interrupt Cs }

  SaveRegs.Ax := $2500+Kybrd_Int;
  SaveRegs.Ds := CSeg;
  SaveRegs.Dx := Ofs(Process_Intr);
  Intr($21, SaveRegs);        { set the keyboard interrupt to point to
                              "Process-Intr" above}


  WriteLn(' Turbo Stay-Resident DIR program (3.33): Press Alt-F10');
  writeln(' Resident interface by Lane Ferris and Neil Rubenking');

  {****************************************************************************}
  {----------------------------------------------------------------------------}
  {               END OF INITALIZE PROGRAM CODE                                }
  {----------------------------------------------------------------------------}
  {****************************************************************************}
  { Now terminate and stay resident        }
  { The following Call utilizes the new    }
  { Terminate & Stay Resident function     }
  { by passing the Memory Control Block    }
  { allocation size set when Turbo prolog  }
  { issued Int 21/function 4A(shrink block)}
  { calculated from mInimum and mAximum op-}
  { tions menu. The MCB sits one paragraph }
  { above the PSP.                         }
  { Pass return code of zero    }
  SaveRegs.Ax := $3100;       { Terminate and Stay Resident }
  SaveRegs.Dx := MemW[CSeg-1:0003]; { Prog_Size from Allocation Blk}
  Intr($21, SaveRegs);

  { END OF RESIDENCY CODE }
END.