UNIT ListPlus;

  { S. Ockers 2/18/93   last update 3/17/94                        }
  { Usefull routines for menu type applications                    }

  {$F+}   { necessary to get function key hook to work }

INTERFACE

USES Crt,Dos;

TYPE str11 = String[11];
     str25 = String[25];
     str80 = String[80];
     str255 = String[255];
     ByteArray = ARRAY[0..0] OF Byte;
     FKeyProc = PROCEDURE(place:integer);

CONST
  BxFg : Integer = White;    { Box around list, foreground }
  BxBg : Integer = Cyan;     { Box around list, background }
  FilFg : Byte = YELLOW;     { Filled area foreground color }
  FilBg : Byte = BLUE;       { Filled area background color }
  FilCh : Char = #32;        { Character used for menu background }
  TitFg : Byte = WHITE;      { Foreground color of title area }
  TitBg : Byte = RED;        { Background color of title area }
  HiFg : Byte = WHITE;       { Forground color of highlight }
  HiBg : Byte = MAGENTA;     { Background color of highlight }
  ShFg : Byte = LIGHTGRAY;   { Foreground color of SHADOW }
  ShBg : Byte = BLACK;       { Background color of SHADOW }
  PtrFg : Byte = LIGHTRED;   { Color of menu pointers and letter highlight }
  PrFg  : Byte = YELLOW;     { Prompt foreground color }
  Msghigh : Integer = 0;     { Height of message window }
  Msgwide : Integer = 0;     { Width of message window }
  SelOset : Byte = 4;        { Offset of selection text from left edge }
  TimeUnits : Byte = 3;      { # of time units to return }
  FKeyCh = #187;             { Function key which calls passed procedure }
  DirSelect : Str11 = '*.*'; { Directory selection mask }
  SelectStr : Str25 = '';     { Letter selection string }
  REALONLY  : Boolean = FALSE;  { Input limited to real # chars }
  INTONLY   : Boolean = FALSE;  { Input limited to 0-9 & - }
  ESCAPED   : Boolean = FALSE;  { Tells if the Esc key was pressed }
  FULLDATE  : Boolean = TRUE;   { Return an extended version of date? }
  LTRSELECT : Boolean = FALSE;   { Allow letter selection in lists? }
  ALPHASELECT : Boolean = FALSE; { Allow alphabet selection in lists? }
  ALLOWPICK : Boolean = FALSE;  { Allow pick list }
  Centered  : Boolean = FALSE;  { Center lines in message window }
  Shadowed  : Boolean = TRUE;   { Draw shadow with messages? }
  OldWait : LongInt = 0;        { Used to check rollover in wait routine }
  NewWait : LongInt = 0;        { value to look for in wait routine }
  Waittime : LongInt = 0;       { last time detected in CheckWait }
  { ************* some constants used to describe various keys }
  LARR  = #203;                 { Left Arrow }
  RARR  = #205;                 { Right Arrow }
  UARR  = #200;                 { Up Arrow }
  DARR  = #208;                 { Down Arrow }
  ESC   = #27;                  { Escape Key }
  BACKSP = #8;                  { Backspace Key }
  DEL = #211;                   { Delete Key }
  INS = #210;                   { Insert Key }
  ENTER = #13;                  { Enter Key }
  HOME  = #199;                 { Home Key }
  ENDKEY = #207;                { End Key }
  PGUP   = #201;                { Page Up Key }
  PGDN   = #209;                { Page Down Key }
  { and some used to describe mouse movements }
  MUP    = #128;                { Mouse moved up }
  MDOWN  = #129;                { Mouse moved down }
  MLEFT  = #130;                { Mouse moved left }
  MRIGHT = #131;                { Mouse moved right }
  MRIGHTB = #132;               { Mouse right button pressed }
  MLEFTB = #133;                { Mouse left button pressed }

 VAR Display : ^ByteArray;
     PickRay : ARRAY[0..31] OF BYTE;
     moused : Boolean;

 PROCEDURE WriteAt(col,row,fg,bg:Byte;S:Str80);
 PROCEDURE FastWrite(col,row,attr : Byte ;S:Str80);
 PROCEDURE WriteCenter(row,fg,bg:Byte;S:Str80);
 PROCEDURE WriteBetween(x1,x2,row,fg,bg : Byte; S : Str80);
 PROCEDURE PlainWrite(col,row : Byte ;S:Str80);
 FUNCTION Replicate(nbr:Byte;ch:Char) : Str80;
 PROCEDURE ClearLine(nbr,attr : Byte );
 PROCEDURE BtmLine( s : Str80);
 PROCEDURE Attrib(col,row,nbr,attr:Byte);
 FUNCTION GetKey : Char;
 PROCEDURE FlushKey;
 PROCEDURE Box (left, top, right, bottom, BxFg, BxBg, style : Integer);
 PROCEDURE Fill(left,top,right,bottom,attr,fchar : Byte);
 PROCEDURE FBox (left, top, right, bottom, BxFg, BxBg, style : Integer);
 PROCEDURE Button(x1,y1,x2,y2,hishad,lowshad,centbut : Integer);
 PROCEDURE cursOff;
 PROCEDURE cursOn;
 FUNCTION NowTime : str11;
 FUNCTION WaitUp : Boolean;
 PROCEDURE SetWait( sec : Integer);
 FUNCTION Date : Str80;
 PROCEDURE Msg(msgx,msgy,MsgFg,MsgBg,Filch:Integer;txt:String);
 PROCEDURE MsgBx(x,y,Fg,Bg,BxFg,BxBg,Style: Integer; txt:String);
 PROCEDURE MsgButton(x,y,hi,lo,cent,txtFg :Integer; txt:String);
 PROCEDURE TempMsg(x,y,Fg,Bg,Fil,count:Integer;txt:Str80);
 PROCEDURE TempMsgBx(x,y,Fg,Bg,BxFg,BxBg,Fil,count:Integer;txt:Str80);
 FUNCTION IntToStr(I : LongInt; places : Byte) : Str80;
 FUNCTION RealToStr(r : real; width, decp: ShortInt) : Str80;
 PROCEDURE Uhuh;
 FUNCTION ReadStr(x,y,RdFg,RdBg,leng : Integer; prompt,instr : Str80) : Str80;
 FUNCTION ReadYN(x,y,YNFg,YNBg : Integer; prompt : Str80) : Boolean;
 PROCEDURE ReadReal(x,y,RRFg,RRBg,leng : Integer; prompt : Str80 ;
                             VAR strt : Real; lo,hi : Real) ;
 PROCEDURE ReadInt(x,y,RIFg,RIBg,leng : Integer; prompt : Str80 ;
                             VAR strt : Integer; lo,hi : Integer);
 PROCEDURE DrawShadow(x1,y1,x2,y2 : Byte);
 FUNCTION Showlist(ListX,ListY,ListW,ListH,Titlesize : Byte; VAR listray;
                 maxrow : Byte; HelpProc : FKeyProc) : Byte;
 PROCEDURE Dummy(dumdum : Integer);
 FUNCTION ShowDirectory : Str80;
 FUNCTION DirChoice(path:pathstr):pathstr;

IMPLEMENTATION

VAR
  reg : registers;

{**********************************************************************}
  { Fast Screen writing procedures - no snow control }

  { Write a string (S) at col,row using fg and bg colors. }

  PROCEDURE WriteAt(col,row,fg,bg : Byte ;S:Str80);
  VAR j : Byte;
      start : Word;
      attr : Byte;
  BEGIN
      start := Pred(row)*160+2*Pred(col);
      attr := 16*bg+fg ;
      FOR j:= 1 TO Length(S) DO
        BEGIN
          Display^[start] := ord(S[j]);
          Inc(start);
          Display^[start] := attr;
          Inc(start);
        END;
  END;  { WriteAt }

{**********************************************************************}

  { Write a string (S) at col,row using attribute, attr. }

  PROCEDURE FastWrite(col,row,attr : Byte ;S:Str80);
  VAR j : Byte;
      start : Word;
  BEGIN
      start := Pred(row)*160+2*Pred(col);
      FOR j:= 1 TO Length(S) DO
        BEGIN
          Display^[start] := ord(S[j]);
          Inc(start);
          Display^[start] := attr;
          Inc(start);
        END;
  END;  { FastWrite }

{**********************************************************************}
  { Write a string(S) centered in row using colors fg & bg. }

  PROCEDURE WriteCenter(row,fg,bg:Byte;S:Str80);
    VAR start : Byte;
    BEGIN
      start := 40 - Length(S) DIV 2;
      WriteAt(start,row,fg,bg,S);
    END;  { WriteCenter }

{**********************************************************************}
  { Write a string (S) centered between x1 and x2 at row }

  PROCEDURE WriteBetween(x1,x2,row,fg,bg : Byte; S : Str80);
    BEGIN
      WriteAt(x1+(x2-x1-Length(S)) DIV 2,row,fg,bg,S);
    END;  { WriteBetween }

{**********************************************************************}
  { Write a string (S) at col,row using default text colors }

  PROCEDURE PlainWrite(col,row : Byte ;S:Str80);
  VAR j : Byte;
      start : Word;
  BEGIN
      start := Pred(row)*160+2*Pred(col);
      FOR j:= 1 TO Length(S) DO
        BEGIN
          Display^[start] := ord(S[j]);
          Inc(start);
          Display^[start] := Textattr;
          Inc(start);
        END;
  END;  { PlainWrite }

{**********************************************************************}
  { Change the attribute of nbr characters starting at col,row }

  PROCEDURE Attrib(col,row,nbr,attr : Byte);
  VAR j : Byte;
      start : Word;
  BEGIN
      start := Pred(row)*160+2*Pred(col)+1;
      FOR j:= 0 TO Pred(nbr) DO
        BEGIN
          Display^[start] := attr;
          Inc(start,2);
        END;
  END;

{**********************************************************************}
  { Return a string nbr long of characters ch. }

  FUNCTION Replicate(nbr:Byte;ch:Char) : Str80;
    VAR temp : Str80;
    BEGIN
      IF nbr = 0 THEN temp :=''
      ELSE BEGIN
        IF nbr >80 THEN nbr:=1;
        FillChar(temp,nbr+1,ch);
        temp[0]:=Chr(nbr)
      END;  { Else }
      Replicate := temp;
    END;  { Replicate }

{**********************************************************************}
    { Clear line nbr using attribute attr }

   PROCEDURE ClearLine(nbr,attr : Byte );
     BEGIN
       WriteAt(1,nbr,attr MOD 16,attr DIV 16,Replicate(80,' '));
     END;   { ClearLine }

{**********************************************************************}
  { Put prompt message at bottom line of screen. }

  PROCEDURE BtmLine( s : Str80);
    BEGIN
      ClearLine(25,Black);
      FastWrite(1,25,White,s);
    END;  { BtmLine }

{**********************************************************************}
   { Get a key from the keyboard add 128 to special keys }

  FUNCTION GetKey : Char;
    CONST mvXp = 340;   { pos mouse movement x dir before detection }
          mvXm = 300;   { likewise minus x }
          mvYp = 113;   { likewise pos y }
          mvYm = 93;    { likewise minus y }
    VAR ch : Char;
       but : Byte;
      col,row : Word;
      PROCEDURE Akey;  { Procedure to use when no mouse present }
        BEGIN
          ch := ReadKey;
          IF ch = #0 THEN BEGIN
            ch := ReadKey;
            ch := Chr( Ord(ch) + 128 );
          END;  { If }
          GetKey := ch;
        END;    { Akey }
    BEGIN
      IF NOT Moused THEN BEGIN Akey; Exit END;
      but:=0; col:=319; row:=103;
      reg.ax := 4;        { set mouse cursor to center of screen }
      reg.cx := 319;
      reg.dx := 103;
      Intr($33,reg);
      REPEAT
        reg.ax := 3;
        Intr($33,reg);      { get mouse status }
        col := reg.cx;     { get the initial positions }
        row := reg.dx;
        but := reg.bx
      UNTIL KeyPressed OR (col > mvXp) OR (col < mvXm) OR
                    (row > mvYp) OR (row < mvYm) OR (but <> 0);
      IF KeyPressed THEN  Akey
      ELSE
        BEGIN
          REPEAT  { wait for mouse button release }
            reg.ax := 3;
            Intr($33,reg);      { get mouse status }
          UNTIL reg.bx = 0;
          IF (but AND 1) = 1 THEN BEGIN GetKey := MLEFTB; Exit; END;
          IF (but AND 2) = 2 THEN BEGIN GetKey := MRIGHTB; Exit; END;
          IF row > mvYp THEN GetKey := MDOWN;
          IF row < mvYm THEN GetKey := MUP;
          IF col > mvXp THEN GetKey := MRIGHT;
          IF col < mvXm THEN GetKey := MLEFT;
        END;  { Else }
    END;  { GetKey }

{**********************************************************************}
        { Flush keyboard buffer }

  PROCEDURE FlushKey;
  BEGIN
    reg.ah := 1;                               { check for keystroke }
    Intr ($16,reg);
    IF (reg.flags AND $0040) = 0 THEN      { if chars in buffer }
      REPEAT
        reg.ah := 0;                       { char is ready to go, read it }
        Intr ($16, reg);
        reg.ah := 1;                       { check for another }
        Intr ($16, reg);
      UNTIL (reg.flags AND $0040) <> 0;
  END;  { FlushKey }

{**********************************************************************}
   { Draw a box using indicated corners ans style : 1-single line  }
   { 2-double,3-single top dbl sides, 4- dbl top single sides,     }
   { 0 - don't draw box. Any other - use IBM char set. }

  PROCEDURE Box (left, top, right, bottom, BxFg, BxBg, style : Integer);

  CONST border : ARRAY[1..4,0..5] OF Char =
           (( #196,#179,#218,#191,#217,#192),
            (#205,#186,#201,#187,#188,#200),
            (#196,#186,#214,#183,#189,#211),
            (#205,#179,#213,#184,#190,#212));
  VAR r, c : Byte;

  BEGIN
    IF left = 0 THEN BEGIN   { autocentering, width = right }
           left := (80 - right) DIV 2;  right := left + right;  END;
    IF top = 0 THEN BEGIN    { autocentering, height = bottom }
           top := (25 - bottom) DIV 2;  bottom := top + bottom;  END;
    IF style <> 0 THEN BEGIN
      { Draw horizontals }
      IF style IN [1..4] THEN
        WriteAt(left,top,BxFg,BxBg,
             Replicate(right-left,border[style,0]))
      ELSE
        WriteAt(left,top,BxFg,BxBg,
             Replicate(right-left,Chr(style)));
      IF style IN [1..4] THEN
        WriteAt(left,bottom,BxFg,BxBg,
             Replicate(right-left,border[style,0]))
      ELSE
         WriteAt(left,bottom,BxFg,BxBg,
             Replicate(right-left,Chr(style)));
      { Draw verticals }
      FOR r := (top+1) TO bottom DO BEGIN
        IF style in [1..4] THEN
          BEGIN
            WriteAt(left,r,BxFg,BxBg,border[style,1]);
            WriteAt(right,r,BxFg,BxBg,border[style,1]);
          END
        ELSE
          BEGIN
            WriteAt(left,r,BxFg,BxBg,Chr(style));
            WriteAt(right,r,BxFg,BxBg,Chr(style));
          END;  { Else }
      END;  { For r }
        { Draw Corners }
      IF style in [1..4] THEN
        BEGIN
          WriteAt(left,top,BxFg,BxBg,border[style,2]);
          WriteAt(right,top,BxFg,BxBg,border[style,3]);
          WriteAt(left,bottom,BxFg,BxBg,border[style,5]);
          WriteAt(right,bottom,BxFg,BxBg,border[style,4]);
        END
      ELSE
        BEGIN
          WriteAt(left,top,BxFg,BxBg,Chr(style));
          WriteAt(right,top,BxFg,BxBg,Chr(style));
          WriteAt(left,bottom,BxFg,BxBg,Chr(style));
          WriteAt(right,bottom,BxFg,BxBg,Chr(style));
        END;
   END;  { If style <> 0 }
  END;   { Box }

{**********************************************************************}
   { Fill an area give by corners with an attribute given by }
   { attr.  If fchar > 0 then filled with that character else just attr. }

PROCEDURE Fill(left,top,right,bottom,attr,fchar : Byte);
  VAR j,leng : Byte;
  BEGIN
    leng := Succ(right-left);
    FOR j:=0 TO (bottom-top) DO
      BEGIN
        IF fchar > 0 THEN
          WriteAt(left,top+j,FilFg,FilBg,Replicate(Succ(right-left),Chr(fchar)));
        Attrib(left,top+j,leng,attr);
      END;   { Do }
  END;

{**********************************************************************}
    { As Box but center filled with Bx colors }
    { If style > 4 then box filled with style char. else blank }

PROCEDURE FBox (left, top, right, bottom, BxFg, BxBg, style : Integer);
  BEGIN
    Box (left, top, right, bottom, BxFg, BxBg, style);
    IF style > 4 THEN
    Fill(Succ(left),Succ(top),Pred(right),Pred(bottom),
            16*BxBg+BxFg,style)
    ELSE
    Fill(Succ(left),Succ(top),Pred(right),Pred(bottom),
            16*BxBg+BxFg,32);
  END;   { FBox }

{**********************************************************************}
   { Draw a button with corners x1,y1 and x2,y2 }
  PROCEDURE Button(x1,y1,x2,y2,hishad,lowshad,centbut : Integer);
    VAR j : Word;
    BEGIN
           Fill(x1,y1,x2,y2,16 * CENTBUT,32);  { Clear out area }
           FOR j := y1 TO y2 DO
             BEGIN
               FastWrite(x1,j,HISHAD,#219);  { left edge }
               FastWrite(x2,j,LOWSHAD,#219);  { right edge }
             END;  { For }
           Fastwrite(Succ(x1),y1,HISHAD + 16 * CENTBUT,Replicate(Pred(x2-x1),#223));
           Fastwrite(Succ(x1),y2,LOWSHAD + 16 * CENTBUT,Replicate(Pred(x2-x1),#220));
     END;  { Button }

{**********************************************************************}
        { Turns off hardware cursor }

PROCEDURE CursOff;
  BEGIN
    reg.ah := 3;                                        { get cursor shape }
    reg.bh := 0;                              { NOTE: works in page 0 only }
    Intr (16,reg);
    reg.ch := reg.ch OR $20;                               { turn on bit 5 }
    reg.ah := 1;
    Intr (16, reg);                                            { tell BIOS }
  END;  { cursOff }
{**********************************************************************}
        { Turns hardware cursor back on }

  PROCEDURE CursOn;
  BEGIN                                                  { As above except }
    reg.ah := 3;
    reg.bh := 0;
    Intr (16,reg);
    reg.ch := reg.ch AND $DF;                             { turn off bit 5 }
    reg.ah := 1;
    Intr (16, reg);
  END;  { cursOn }
{**********************************************************************}
   { Return a string giving the current time. Global Constant TimeUnits }
   { determines how much of the time is returned.                       }

  FUNCTION NowTime : str11;
  VAR hr,min,sec,hsec : Word;
      temp : String[2];
      timestr : str11;
  LABEL OutTime;
    BEGIN
      GetTime(hr,min,sec,hsec);
      Str(hr,timestr); IF TimeUnits = 1 THEN GOTO OutTime;
      Str(min,temp); timestr := timestr+':'+temp;
      IF TimeUnits = 2 THEN GOTO OutTime;
      Str(sec,temp); timestr := timestr+':'+temp;
      IF TimeUnits = 3 THEN GOTO OutTime;
      Str(hsec,temp); timestr := timestr+':'+temp;
      OutTime:
      NowTime := timestr;
    END;  { NowTime }


{************************************************************************}

   FUNCTION WaitUp : Boolean;  { check if timeout has occured }
   BEGIN
     waittime := MemL[$40:$6C];
     IF (waittime < NewWait) AND (waittime >= OldWait) THEN WaitUp := FALSE
       ELSE WaitUp := TRUE;
   END;  { WaitUp }

{************************************************************************}

   PROCEDURE SetWait( sec : Integer); { set WaitTime to value at end of wait }
   { times are in 18ths of a second }
   BEGIN           { NOTE: doesn't work over midnight }
     OldWait := MemL[$40:$6C];     { used to check rollover }
     NewWait := OldWait + sec * 18;     { value to be looking for }
   END;  { SetWait }

{************************************************************************}
  { Return a string containing the date.  The global constant FULLDATE }
  { determines whether an extended version of the date is returned.    }

  FUNCTION Date : Str80;
    CONST wkdays : ARRAY[1..7] OF Str11 = (' Monday ',' Tuesday ',
        ' Wednesday ',' Thursday ',' Friday ',' Saturday ',' Sunday ');
          months : ARRAY[1..12] OF Str11 = ('January ','February ','March ',
          'April ','May ','June ','July ','August ','September ',
          'October ','November ','December ');
    VAR yr,mo,da,daofwk : Word;
    BEGIN
      GetDate(yr,mo,da,daofwk);
      IF NOT FULLDATE THEN
        Date := IntToStr(mo,1)+'/'+IntToStr(da,1)+'/'+IntToStr(yr,1)
      ELSE Date := wkdays[daofwk]+months[mo]+IntToStr(da,1)+' ,'+IntToStr(yr,1);
  END;   { Date }

{************************************************************************}
   { Put a message in a blank box with upper left corner msgx,msgy }
   { with colors MsgFg,MsgBg. There is one blank line above and below the }
   { message. 0's give autocentering. Globals Msghigh & Msgwide updated. }
   { Lines of the message txt are separated by ~'s.  }

  PROCEDURE Msg(msgx,msgy,MsgFg,MsgBg,Filch:Integer;txt:String);
    VAR
        temp : String;
        j,posit,delta : Integer;
    BEGIN
      temp := txt;
      Msghigh := 1;    { determine # lines and width of box }
      posit := Pos('~',temp);
      IF (posit = 0) THEN Msgwide := Length(txt)+1   { If just one line }
        Else Msgwide := 1;
      REPEAT          { determine widest line }
        posit := Pos('~',temp);
        IF posit > Msgwide THEN Msgwide := posit;
        Delete(temp,1,posit);
        Inc(Msghigh);
      UNTIL posit = 0;
      IF Length(temp) > Msgwide THEN Msgwide := Length(temp)+1; { last big? }
      IF msgx = 0 THEN msgx := 39 - MsgWide DIV 2;   { autocentering }
      IF msgy = 0 THEN msgy := 12 - Msghigh DIV 2;
      Fill(msgx,msgy,msgx+Msgwide,msgy+Msghigh,MsgFg+16*MsgBg,Filch);
      temp := txt;                    {  Write in lines }
      j := Succ(msgy);  delta := 0;
      REPEAT
        posit := Pos('~',temp);
        IF Centered THEN  { if message centered the figure offset }
            IF posit = 0 THEN delta := (MsgWide - Length(temp)) DIV 2
            ELSE
              delta := (MsgWide - posit) DIV 2;
        IF posit = 0 THEN
          WriteAT(Succ(msgx)+delta,j,MsgFg,MsgBg,temp)   { write last line }
          ELSE                                     { write out line }
            WriteAT(Succ(msgx)+delta,j,MsgFg,MsgBg,Copy(temp,1,Pred(posit)));
        Delete(temp,1,posit);
        Inc(j);
      UNTIL posit = 0;
      IF Shadowed THEN DrawShadow(msgx,msgy,msgx+Msgwide,msgy+Msghigh);
    END;  { Msg }

{**********************************************************************}
    { Display message in a box ( as Msg with a box around it ) }

    PROCEDURE MsgBx(x,y,Fg,Bg,BxFg,BxBg,Style: Integer; txt:String);
      BEGIN
        Msg(x,y,Fg,Bg,32,txt);
        IF x = 0 THEN x := 39 - MsgWide DIV 2;   { autocentering }
        IF y = 0 THEN y := 12 - Msghigh DIV 2;
        Box(Pred(x),Pred(y),Succ(x)+msgwide,Succ(y)+msghigh,BxFg,BxBg,Style);
        IF Shadowed THEN
           DrawShadow(Pred(x),Pred(y),Succ(x)+msgwide,Succ(y)+msghigh);
      END;   { MsgBx }

{**********************************************************************}
    { Display Button with message in middle }

    PROCEDURE MsgButton(x,y,hi,lo,cent,txtFg :Integer; txt:String);
      BEGIN
        Msg(x,y,0,0,32,txt);  { necessary to set height & width }
        IF x = 0 THEN x := 39 - MsgWide DIV 2;   { autocentering }
        IF y = 0 THEN y := 12 - Msghigh DIV 2;
        Button(Pred(x),Pred(y),Succ(x)+MsgWide,Succ(y)+MsgHigh,hi,lo,cent);
        Msg(x,y,txtFg,cent,32,txt);
      END;   { MsgButton }

{************************************************************************}
   { Put a message in the center of the screen until a key pressed or }
   { a timeout of count seconds elapses . If count = 0, just key }
   { press is recognized.  Msgx or msgy = 0 give autocentering. }

  PROCEDURE TempMsg(x,y,Fg,Bg,Fil,count:Integer;txt:Str80);
    VAR
        saveptr : ^ByteArray;
        timed : Boolean;
    BEGIN
      IF count = 0 THEN timed := FALSE
         ELSE  timed := TRUE;
      count := count * 1000;  { change from seconds to milliseconds }
      GetMem(SavePtr,4000);          { memory to save screen }
      Move(Display^,SavePtr^,4000);  { save screen }
      Msg(x,y,Fg,Bg,Fil,txt);
      REPEAT
        IF timed THEN Dec(count);
        Delay(1);
      UNTIL (count < 0)  OR KeyPressed;
      Move(SavePtr^,Display^,4000);  { restore screen }
      FreeMem(SavePtr,4000);         { return memory }
    END;  { TempMsg }

{************************************************************************}
   { As TempMsg but with box around message window }

  PROCEDURE TempMsgBx(x,y,Fg,Bg,BxFg,BxBg,Fil,count:Integer;txt:Str80);
    VAR
        saveptr : ^ByteArray;
        timed : Boolean;
    BEGIN
      IF count = 0 THEN timed := FALSE
         ELSE  timed := TRUE;
      count := count * 1000;  { change from seconds to milliseconds }
      GetMem(SavePtr,4000);          { memory to save screen }
      Move(Display^,SavePtr^,4000);  { save screen }
      MsgBx(x,y,Fg,Bg,BxFg,BxBg,Fil,txt);
      REPEAT
        IF timed THEN Dec(count);
        Delay(1);
      UNTIL (count < 0)  OR KeyPressed;
      Move(SavePtr^,Display^,4000);  { restore screen }
      FreeMem(SavePtr,4000);         { return memory }
    END;  { TempMsgBx }

{**********************************************************************}
    { Convert an integer into a string }

  FUNCTION IntToStr(I : LongInt; places : Byte) : Str80;
    VAR temp : String[11];
        len : Byte;
    BEGIN
      Str(i,temp);  len := Length(temp);
      IF len < places THEN
         temp := Replicate(places - len, #32) + temp;
      IntToStr := temp;
    END;  { Int_To_Str }

{**********************************************************************}
    { Convert a real # to a String with width and decp decimal places. }

  FUNCTION RealToStr(r : real; width ,decp: ShortInt) : Str80;
    VAR temp : Str25;
    BEGIN
      Str(r:width:decp,temp);
      REPEAT
        IF temp[1] = ' ' THEN Delete(temp,1,1);
      UNTIL temp[1] <> ' ';
      RealToStr := temp;
    END;  { RealToStr }

{**********************************************************************}
    { Produces an Uhuh Sound }

    PROCEDURE Uhuh;
      VAR j : Byte;
      BEGIN
        FOR j:=1 TO 2 DO
          BEGIN
            Sound(50); Delay(100); NoSound; Delay(50);
          END;
      END;   { Uhuh }

{**********************************************************************}
   { Input a string of length leng, preceded by prompt, initally }
   { set to instr. If the first character input is not a cursor  }
   { movement character the string is first cleared }

  FUNCTION ReadStr(x,y,RdFg,RdBg,leng : Integer; prompt,instr : Str80) : Str80;
  VAR startin,endin,cursor,regattr,curattr : Byte;
      ch : Char;
      workstr : Str80;
      firstchar : Boolean;
      saveptr : ^ByteArray;

    PROCEDURE UpDate;
      BEGIN
        IF firstchar THEN BEGIN
          workstr := ''; cursor := startin;
          WriteAt(cursor,y,FilFg,FilBg,Replicate(leng,'.')); END;
        IF cursor < endin THEN BEGIN
          WriteAt(cursor,y,FilFg,FilBg,ch);
          Inc(cursor); Attrib(cursor,y,1,curattr);
          workstr:=workstr+ch;
        END
        ELSE IF cursor = endin THEN BEGIN
          WriteAt(cursor,y,HiFg,HiBg,ch);
          workstr[0] := Chr(leng);
          workstr[leng] := ch;
        END;  { Else }
        firstchar := FALSE;
      END;    { UpDate }

  BEGIN
    IF x=0 THEN x := (80 - leng - Length(prompt) - Length(instr)) DIV 2;
    IF y=0 THEN y := 13;         { auto centering }
    startin := x + Length(Prompt); endin := Pred(startin + leng);
    cursor := startin + Length(instr);   regattr := PrFg+16*FilBg;
    curattr := HiFg + 16*HiBg;  firstchar := TRUE; ESCAPED := FALSE;
    GetMem(SavePtr,4000);          { memory to save screen }
    Move(Display^,SavePtr^,4000);  { save screen }
    IF cursor > endin THEN BEGIN
        instr[0] := Chr(Ord(instr[0])-Pred(cursor-endin));
        cursor := endin;
    END;
    workstr := instr;
    WriteAt(x,y,PrFg,FilBg,prompt + Replicate(leng,'.'));
    WriteAt(startin,y,FilFg,FilBg,instr);
    Attrib(cursor,y,1,curattr);
    Box(Pred(x),Pred(y),RdFg,RdBg,Succ(endin),Succ(y),2);
    DrawShadow(Pred(x),Pred(y),Succ(endin),Succ(y));
    REPEAT
      ch := GetKey;
      CASE ch OF
     LARR,DEL,BACKSP : IF cursor > startin THEN BEGIN
                      IF cursor = endin THEN BEGIN
                         WriteAt(cursor,y,PrFg,FilBg,'.');
                         Delete(workstr,Length(workstr),1);
                      END
                      ELSE
                        Attrib(cursor,y,1,regattr);
                      Dec(cursor);
                      WriteAt(cursor,y,HiFg,HiBg,'.');
                      Delete(workstr,Length(workstr),1);
                      firstchar := FALSE;
                    END
                    ELSE write(#7);
        #24       :  BEGIN                { Ctrl-X }
                       WriteAt(startin,y,PrFg,FilBg,Replicate(leng,'.'));
                       workstr := '';
                       cursor := startin;
                       Attrib(cursor,y,1,curattr);
                     END;
        #32..#125 : BEGIN                  { a normal character }
                     IF NOT REALONLY AND not INTONLY THEN
                        Update
                     ELSE IF REALONLY
                      AND (ch IN ['-','.','0'..'9','E','e'])
                       THEN Update
                       ELSE IF INTONLY AND (ch IN ['-','0'..'9']) THEN
                         UpDate
                         ELSE Uhuh;
                    END;
        ENTER,ESC   : ; { to prevent Uhuh when entered }
        ELSE Uhuh;
       END;  { Case }
    UNTIL ch IN [#13,#27];
    IF ch = ESC THEN ESCAPED := TRUE;
    IF ch = ENTER THEN ReadStr := workstr
    ELSE ReadStr := instr;
    Move(SavePtr^,Display^,4000);  { restore screen }
    FreeMem(SavePtr,4000);         { return memory }
  END;  { ReadStr }


{**********************************************************************}
   { Get a yes or no response to prompt. Yes returns TRUE }

   FUNCTION ReadYN(x,y,YNFg,YNBg : Integer; prompt : Str80) : Boolean;
     VAR ch : Char;
     BEGIN
       IF x = 0 THEN x := (78-Length(prompt)) DIV 2;
       IF y = 0 THEN y := 13;
       Fbox(Pred(x),Pred(y),x + Length(prompt),Succ(y),YNFg,YNBg,2);
       WriteAt(x,y,Black,Cyan,prompt);
       REPEAT
         ch := GetKey;
         CASE UpCase(ch) OF
           'Y' : ReadYN := TRUE;
           'N',ESC : ReadYN := FALSE;
         END;  { Case }
       UNTIL UpCase(ch) IN ['Y','N',ESC];
     END;  { ReadYN }

{**********************************************************************}
   { Input a real number between values lo and hi.  Default is }
   { strt.  Prompt may precede input at column  x, row y.      }

  PROCEDURE ReadReal(x,y,RRFg,RRBg,leng : Integer; prompt : Str80 ;
                             VAR strt : Real; lo,hi : Real) ;
    VAR errcode : Integer;
        tempstr,savestr : Str11;
    LABEL GetOut;
    BEGIN
      REALONLY := TRUE;
      REPEAT
        savestr := RealToStr(strt,20,2);
        tempstr := ReadStr(x,y,RRFg,RRBg,leng,prompt,savestr);
        IF tempstr = savestr THEN Goto GetOut;
        Val(tempstr,strt,errcode);
        IF (strt>hi) OR (strt<lo) THEN
          TempMsg(0,0,Yellow,Red,32,3,'Value must be between '+ RealToStr(lo,20,2)+
                    ' and '+ RealToStr(hi,20,2));
        IF errcode > 0 THEN
          TempMsg(0,0,Yellow,Red,32,3,'Error! Please Re-Enter ');
      UNTIL (strt <= hi) AND (strt >= lo) AND (errcode=0);
      GetOut:
      REALONLY := FALSE;
    END;  { ReadReal }

{**********************************************************************}
   { As for real # except integer instead }

  PROCEDURE ReadInt(x,y,RIFg,RIBg,leng : Integer; prompt : Str80 ;
                             VAR strt : Integer; lo,hi : Integer);
    VAR errcode : Integer;
        tempstr,savestr : Str11;
    LABEL GetOut;
    BEGIN
      INTONLY := TRUE;
      REPEAT
        savestr := IntToStr(strt,1);
        tempstr := ReadStr(x,y,RIFg,RIBg,leng,prompt,savestr);
        IF tempstr = savestr THEN  Goto GetOut;
        Val(tempstr,strt,errcode);
        IF (strt > hi) OR (strt < lo) THEN
          TempMsg(0,0,Yellow,Red,32,3,'Value must be between '+ IntToStr(lo,1)+
                    ' and '+ IntToStr(hi,1));
        IF errcode > 0 THEN
          TempMsg(0,0,Yellow,Red,32,3,'Error! Please Re-Enter ');
      UNTIL (strt <= hi) AND (strt >= lo) AND (errcode=0);
      GetOut:
      INTONLY := FALSE;
    END;  { ReadInt }

{**********************************************************************}
      { Draw a shadow outside boxed area }

    PROCEDURE DrawShadow(x1,y1,x2,y2 : Byte);
     VAR MnuShAtt,j : Byte;
     BEGIN                { SHADOW for BOXED menu }
       MnuShAtt := ShFg + 16 * ShBg;
       Attrib(Succ(x1),Succ(y2),Succ(x2-x1),MnuShAtt);
       FOR j:=Succ(y1) TO y2 DO
               Attrib(Succ(x2),j,1,MnuShAtt);
     END;  { Shadow }

{**********************************************************************}
   { The following function presents a scrolling list and returns  }
   { the number of the item selected.  It is passed the upper left }
   { coordinates and the width and height of the list window.  It  }
   { is also passed a pointer to the list and its size. A zero in  }
   { ListX, ListY or ListW causes centering }

  FUNCTION Showlist(ListX,ListY,ListW,ListH,Titlesize : Byte; VAR listray;
                 maxrow : Byte; HelpProc : FKeyProc) : Byte;
    VAR tempray : ARRAY[0..0] OF Str80 ABSOLUTE listray;
      ch : Char;
      toprow,currow,attrsave,j,k : Byte;
      changed : Boolean;
      blanks : Str25;
      ltrpos : Array[1..25] OF Byte;  { position of letter to hilite }
      saveptr : ^ByteArray;

    LABEL OutOfList;

    PROCEDURE UpdateList;
      VAR          j : Byte;
      BEGIN
        FOR j:=0 TO Pred(ListH)-titlesize DO
        BEGIN
          IF j+toprow<Succ(maxrow) THEN   { write selection line }
            WriteAt(ListX,ListY+j+titlesize,FilFg,FilBg,
                Replicate(seloset,' ')+tempray[toprow+j]+
                Replicate(ListW-Length(tempray[toprow+j])
                -seloset,' '))
          ELSE                                      { or a blank line }
            WriteAt(ListX,ListY+j+titlesize,FilFg,FilBg,Replicate(ListW,' '));
          IF currow-toprow = j THEN  BEGIN
               Attrib(ListX,ListY+j+titlesize,ListW,HiFg+16*HiBg);  { currow hilite }
               WriteAt(Listx+1,ListY+j+titlesize,PtrFg,HiBg,#16);   { points right }
               WriteAt(Listx+ListW-2,ListY+j+titlesize,PtrFg,HiBg,#17);   { left }
          END;  { If }
          IF LTRSELECT AND (toprow-titlesize+j < 25) AND
               (ltrpos[toprow-titlesize+Succ(j)] <> 0) THEN
            Attrib(ListX+Pred(seloset)+ltrpos[toprow-titlesize+Succ(j)],
                                     ListY+j+titlesize,1,PtrFg+16*FilBg);
          IF ALLOWPICK THEN BEGIN
            k := toprow+j-titlesize;
            IF (PickRay[k DIV 8] AND (1 SHL ( k MOD 8 ))) > 0 THEN
               WriteAt(Listx+2,ListY+j+titlesize,FilFg,FilBg,#251);
          END;  { If }
        END;  { For }
        IF (currow=titlesize) OR (currow=maxrow) THEN
        Box(Pred(ListX),Pred(ListY),ListX+ListW,ListY+ListH,BxFg,BxBg,1);
        IF toprow>titlesize THEN
                     WriteAt(ListX+ListW,ListY,BxFg,BxBg,#24); { up arrow }
        IF toprow+ListH<maxrow THEN
                  WriteAt(ListX+ListW,Pred(ListY+ListH),BxFg,BxBg,#25);
      END;   { UpdateList }

  BEGIN    { Proc ShowList }
    toprow := titlesize;  currow := titlesize;
    FillChar(PickRay,SizeOf(PickRay),0);
    FOR j:=1 TO 25 DO
      IF j > Length(SelectStr) THEN
        ltrpos[j] := 0
      ELSE
        ltrpos[j] := Pos(SelectStr[j],tempray[j+Pred(titlesize)]);
    IF ListW = 0 THEN
      BEGIN
        IF titlesize > 0 THEN
          FOR j := 0 TO Pred(titlesize) DO
            IF Length(tempray[j]) > ListW THEN
               ListW := Length(tempray[j]);
        FOR j := titlesize TO maxrow DO
          IF Length(tempray[j])+2*seloset > ListW THEN
               ListW := Length(tempray[j])+2*seloset;
      END;  { If ListW = 0 }
    IF ListX = 0 THEN ListX := 40 - ListW DIV 2;
    IF ListY = 0 THEN ListY := 12 - ListH DIV 2;
    IF titlesize > 0 THEN
      FOR j:= 0 TO Pred(titlesize) DO
        CASE tempray[j,1] OF
          '^' : BEGIN      { center title line }
                  blanks := Replicate((ListW-Length(tempray[j])) DIV 2,' ');
                  Delete(tempray[j],1,1);
                  tempray[j] := blanks + tempray[j];
                END;
          '&' : BEGIN      { duplicate character across width }
                  Delete(tempray[j],1,1);
                  tempray[j] := Replicate(ListW,tempray[j,1]);
                END;
        END;     { Case }
    attrsave := TextAttr;
    GetMem(SavePtr,4000);          { memory to save screen }
    Move(Display^,SavePtr^,4000);  { save screen }
    DrawShadow(Pred(ListX),Pred(ListY),ListX+ListW,ListY+ListH);
    IF titlesize > 0 THEN
      FOR j:= 0 TO Pred(titlesize) DO
         WriteAt(ListX,ListY+j,TitFg,TitBg,tempray[j]+
             Replicate(ListW-Length(tempray[j]),' '));
    UpDateList;
    toprow := titlesize;
    REPEAT
      ch := GetKey;
      IF ch = FKeyCh THEN HelpProc(Succ(currow-titlesize));
      changed := FALSE;
      CASE ch OF
        #208,#129 : IF currow < maxrow THEN BEGIN
                       Inc (currow);
                       changed := TRUE;  END;
        #200,#128 : IF currow> titlesize THEN  BEGIN
                       Dec (currow);
                       changed := TRUE; END;
        #32       : IF ALLOWPICK THEN
                      BEGIN        { Flip appropriate bit }
                        k := currow-titlesize;
                        j := k DIV 8;
                        PickRay[j] := PickRay[j] XOR (1 SHL (k MOD 8));
                        changed := TRUE;
                      END;
      END;
      IF changed THEN     { Only update when change has been made }
        BEGIN
          IF currow > Pred(toprow+ListH-titlesize) THEN Inc(toprow);
          IF currow < toprow THEN Dec(toprow);
          UpDateList;
        END;
      IF ALPHASELECT THEN
        FOR j := titlesize TO maxrow DO  { Check first letter choosing }
          IF Upcase(tempray[j,1])=UpCase(ch) THEN
            BEGIN
              toprow := j;  currow := j; UpdateList;
            END;  { If }
      IF LTRSELECT THEN
        FOR j := 1 TO Length(SelectStr) DO
          IF UpCase(SelectStr[j]) = UpCase(ch) THEN
            BEGIN
              k := Pred(j)+titlesize;
              currow := k;
              IF (k<toprow) OR (k>toprow+Pred(ListH)-titlesize) THEN
                         toprow := k;
              UpdateList;
            END;  { If }
    UNTIL ch IN [#27,#13,#132,#133];
    IF ch IN [#27,#132] THEN ShowList := 0
    ELSE
      ShowList := Succ(currow-titlesize);
    OutOfList:
    TextAttr := attrsave;
    Move(SavePtr^,Display^,4000);  { restore screen }
    FreeMem(SavePtr,4000);         { return memory }
  END;  {  ShowList }

{**********************************************************************}
    { This is a dummy procedure used in calling ShowList when you }
    { don't need a procedure hooked in.                           }
    PROCEDURE Dummy(dumdum : Integer);
      BEGIN
      END; { Dummy }

{**********************************************************************}
  { This function displays a filelist of the current directory and }
  { returns the filname selected }

  FUNCTION ShowDirectory : Str80;
    VAR fileStuff : SearchRec;
      filelist : ARRAY[0..100] OF Str80;
      j,choice,attrsave : Byte;
      unpacked : DateTime;
      saveptr : ^ ByteArray;
  BEGIN
    filelist[0] := ' Directory of : '+DirSelect;
    attrsave := TextAttr;
    GetMem(saveptr,4000);          { memory to 2nd save screen }
    Move(Display^,saveptr^,4000);  { save screen }
    j:=1; ESCAPED := FALSE;
    FindFirst(DirSelect,AnyFile,fileStuff);
    WHILE DosError = 0 DO
      WITH FileStuff DO
      BEGIN
        UnPackTime(time,unpacked);
        IF (Attr AND 16) = 16 THEN
          filelist[j] := '['+name+']  '+ Replicate(30-Length(name),' ') +
          IntToStr(unpacked.month,1)+ '/'+IntToStr(unpacked.day,1)+'/'+
          IntToStr(unpacked.year,1)
        ELSE
          filelist[j] := name + Replicate(20-Length(name),' ')+
          ' (' + IntToStr(size,1) + ')  '+ Replicate(8-Length(IntToStr(size,1)),' ')+
        IntToStr(unpacked.month,1)+'/'+IntToStr(unpacked.day,1)+'/'+
        IntToStr(unpacked.year,1);
        Inc(j);
        FindNext(fileStuff);
      END;   { DO }
    choice := ShowList(0,0,60,6,1,filelist,j-1,Dummy);
    IF choice = 0 THEN BEGIN ESCAPED := TRUE;  ShowDirectory := ''; END
    ELSE
      ShowDirectory := Copy(filelist[choice],1,
                                Pred(Pos(' ',filelist[choice])));
    TextAttr := attrsave;
    Move(saveptr^,Display^,4000);  { restore screen }
    FreeMem(saveptr,4000);         { return memory }
  END;  { ShowDirectory }

{**********************************************************************}
  { Get a directory selection }

  FUNCTION DirChoice(path:pathstr):pathstr;

  TYPE     postype = (drive,sub,fname);

  CONST ltedge : ARRAY[drive..fname] OF Word = ( 18, 31, 48 );
        cursize : ARRAY[drive..fname] OF Word = ( 7, 12, 16 );

  VAR DirInfo : SearchRec;
    FileRay : ARRAY[1..100] OF String[12];
    SubRay : ARRAY[1..20] OF String[8];
    j,attr,attrsave : Word;
    ch : Char;
    moved : Boolean;
    pos :  postype;
    tot,line,curs : ARRAY[drive..fname] OF Word;
    s : pathstr;
    dir : DirStr;
    name : NameStr;
    ext : ExtStr;
    saveptr : ^ ByteArray;

  LABEL NewPath,Getout;
    BEGIN    { dirchoice }
      attrsave := TextAttr;
      GetMem(saveptr,4000);          { memory to 2nd save screen }
      Move(Display^,saveptr^,4000);  { save screen }
      dirchoice := '';
      escaped := FALSE;
      GetDir(0,s);
      tot[drive] := 0;
      WHILE IoResult = 0 DO   { determine total # drives }
        BEGIN
          Inc(tot[drive]);
          {$I-}    ChDir(Chr(tot[drive]+64)+':');   {$I+}
        END;
      Dec(tot[drive]);  { starts at 0 }
      ChDir(s);  { back to inital path }
      Newpath:
      pos := fname;
      FOR j := 1 TO 100 DO    { zero out filename array }
        FileRay[j] := '';
      FOR j := 1 TO 20 DO     { zero out subdirchoice array }
        SubRay[j] := '';
      tot[fname] := 0; tot[sub] := 0;
      FindFirst('*.*',AnyFile,DirInfo);
      WHILE DosError = 0 DO
        BEGIN
         IF DirInfo.attr = 16 THEN
             BEGIN
               Inc(tot[sub]); SubRay[tot[sub]] := DirInfo.Name;
               IF DirInfo.Name = '..' THEN SubRay[tot[sub]] := '<Parent>';
               IF DirInfo.Name = '.' THEN Dec(tot[sub]);  { don't list this }
             END;
         FindNext(DirInfo);
        END;      { While }
      FindFirst(path,AnyFile,DirInfo);
      WHILE DosError = 0 DO
        BEGIN
         IF DirInfo.attr <> 16 THEN
           BEGIN
             Inc(tot[fname]); FileRay[tot[fname]] := DirInfo.Name;
           END;
         FindNext(DirInfo);
        END;      { While }
       attr := White+16 * Blue;
       line[fname] := 1;  curs[fname] := 0;
       line[sub] := 1; curs[sub] := 0;
       line[drive] := 1; curs[drive] := 0;
       moved := TRUE;
       FBox(14,6,66,21,White,Blue,2);
       DrawShadow(14,6,66,21);
       Fastwrite(14,10,attr,
                '‚€€€ Drive €€€å€ Subdirectory €å€€€€€ Filename €€€€€¦');
       FastWrite(28,21,attr,#207);
       FastWrite(45,21,attr,#207);
       FBox(15,7,65,9,White,Cyan,32);
       FastWrite(35,7,White+16*Cyan,'DIRECTORY');
       FastWrite(18,8,Black+16*Cyan,'Mask: '+path);
       FastWrite(48,9,Black+16*Cyan,#17#217 + ' Select');
       BtmLine('Select a file using arrow keys and Enter.');
       GetDir(0,s); FastWrite(18,9,Black+16*Cyan,'Path: '+s);
       attr := Black+16 * LightGray;
       REPEAT
         IF moved THEN
           BEGIN
            FBox(15,11,65,20,Black,LightGray,32);
            FOR j := 11 TO 20 DO      { Vertical Lines }
              BEGIN
                FastWrite(28,j,White+16*Blue,#179);
                FastWrite(45,j,White+16*Blue,#179);
              END;
            FOR j := 1 TO 10 DO
               IF line[drive]+j <= Succ(tot[drive]) THEN
                 Fastwrite(ltedge[drive] +2,10+j,attr,'['+Chr(j+64)+']');
            FOR j := 1 TO 10 DO
                     FastWrite(ltedge[sub] +2,10+j,attr,SubRay[Pred(line[sub]+j)]);
            FOR j := 1 TO 10 DO
               IF line[fname] + j <  100 THEN
                   FastWrite(ltedge[fname] +2,10+j,attr,Fileray[Pred(line[fname]+j)]);
             IF tot[fname] = 0 THEN BEGIN
                 FastWrite(ltedge[fname] +5,13,attr,'No Files');
                 FastWrite(ltedge[fname] +6,14,attr,'Found');
               END;  { If }
             Attrib(ltedge[pos],11+curs[pos],cursize[pos],yellow+16*magenta);
             moved := FALSE;
           END;  { If moved }
         ch := GetKey;
         CASE ch OF
           ENTER,MLEFTB :  CASE pos OF
                    drive : BEGIN
                               ChDir(Chr(curs[drive]+65)+':');
                               Goto NewPath;
                            END;
                      sub : BEGIN
                              GetDir(0,s);
                              FSplit(s,dir,name,ext);
                              IF SubRay[line[sub]+curs[sub]] = '<Parent>'
                                THEN ChDir('..')
                               ELSE
                                 ChDir(FExpand(SubRay[line[sub]+curs[sub]]));
                              Goto NewPath;
                            END;
                     fname : BEGIN
                               GetDir(0,s);
                               FSplit(s,dir,name,ext);
                               dirchoice := FExpand(
                                        FileRay[line[fname] + curs[fname]]);
                               Goto GetOut;
                             END;
                  END;  { Case }
           LARR,MLEFT : BEGIN          { left arrow }
                    Dec(pos); IF pos < drive THEN pos := fname;
                    moved := TRUE;
                  END;
           RARR,MRIGHT : BEGIN          { right arrow }
                    Inc(pos); IF pos > fname THEN pos := drive;
                    moved := TRUE;
                  END;

           DARR,MDOWN : IF (curs[pos] < 9) AND (line[pos]+curs[pos] < tot[pos]) THEN         { DnArr }
                   BEGIN
                     Attrib(ltedge[pos],11+curs[pos],cursize[pos],Black+16 * LightGray);
                     Inc(curs[pos]);
                     Attrib(ltedge[pos],11+curs[pos],cursize[pos],yellow+16 * magenta);
                   END  { If fline }
                   ELSE IF (line[pos] + 9 < 100)
                              AND (line[pos]+curs[pos] < tot[pos]) THEN
                     BEGIN
                       Inc(line[pos]);
                       moved := true;
                     END;
           UARR,MUP : IF curs[pos] > 0 THEN         { UpArr }
                   BEGIN
                     Attrib(ltedge[pos],11+curs[pos],cursize[pos],Black+16*LightGray);
                     Dec(curs[pos]);
                     Attrib(ltedge[pos],11+curs[pos],cursize[pos],yellow+16*magenta);
                   END  { If fline }
                   ELSE IF line[pos] > 1  THEN
                     BEGIN
                       Dec(line[pos]);
                       moved := true;
                     END;
          END;  { Case }
       UNTIL ch IN [ESC , MRIGHTB];
       Escaped := TRUE;
       GetOut:
       TextAttr := attrsave;
       Move(saveptr^,Display^,4000);  { restore screen }
       FreeMem(saveptr,4000);         { return memory }
    END; { DirChoice }

{**********************************************************************}
{ The initilization section of this unit detects if a mouse is }
{ present and sets up a pointer ( display ) to the video screen }

BEGIN
  moused := FALSE;
  IF MemW[$0000:$00CC] <> 0 THEN
    BEGIN
      reg.ax := 0;
      Intr($33,reg);
      IF reg.ax <> 0 THEN moused := TRUE;
    END;  { IF }
  IF LastMode = 7 THEN
    Display := Ptr($B000, 0)
  ELSE Display := Ptr($B800, 0);
END.