Power-Programmierung/CD1.mdf/pascal/library/dos/s_filema/source/sfmscrn.inc

Text File | 1987-06-12 | 36.6 KB | 1,407 lines

{                    Super File Manager

                        SFMSCRN.INC

                     by David Steiner
                        2035 J Apt. 6
                        Lincoln, NE
}

procedure SetCursorType;
  {
  Sets default colors, cursor shape according to mode
    and makes sure the current mode is 80 column text.
  }
var
  Regs : reg_T;
begin
  with Regs do
  begin
    AH := $0F;           { BIOS Video function $0F - Get Current Video Mode }
    Intr( $10, Regs );
    case AL of
      BW80,
       C80 : { Text mode OK };
      BW40 : TextMode( BW80 );    { Make sure we have an 80 column text mode }
       C40 : TextMode(  C80 );
       $07 : CursorNum := $0C0D;  { Set Monochrome cursor attribute, mode OK }
       else  TextMode( BW80 );    { Must be graphics, set to BW80 }
    end;
    Color := (AL in [C40,C80]);
  end;
end;

procedure CursorON;
var
  Regs : reg_T;
begin
  with Regs do
  begin
    AH := $01;                { BIOS Video function $01 - Set Cursor Shape }
    AL := $00;
    CX := CursorNum;
    Intr( $10, Regs );
  end;
end;

procedure CursorOFF;
var
  Regs : reg_T;
begin
  with Regs do
  begin
    AH := $01;                { BIOS Video function $01 - Set Cursor Shape }
    AL := $00;
    CX := $1000;
    Intr( $10, Regs );
  end;
end;

function Cstr( num : real; wid, dec : integer ) : str80;
  {
  Basically the same as Turbo's str procedure but is a function.
  }
var
  tstr : str80;
begin
  if wid <> 0 then
    str( num:wid:dec, tstr )
  else
    str( round( num ), tstr );
  Cstr := tstr;
end;

procedure AbortProgram( s1, s2, s3, s4 : str80 );
  {
  Basically allows an orderly exit from the program.  Was put in
    during the early stages of the program so I'd know where problems
    were.  Now it is just there for those few situations that SFM
    can't handle (e.g. a damaged FAT).
    Also required so that when an error does occur the interrupt
    handlers can be reset to their original values.
  }
begin
  textcolor( LightGray );
  textbackground( Black );
  window( 1, 1, 80, 25 );
  clrscr;
  gotoxy( 1, 7 );
  writeln( 'An error not handled by this program has occured.' );
  writeln;
  writeln( '   The information below gives the name of the procedure' );
  writeln( '   that decided to stop execution of the program and the' );
  writeln( '   error that caused termination.' );
  writeln;
  writeln( '   ', s1 );
  writeln( '   ', s2 );
  writeln( '   ', s3 );
  writeln( '   ', s4 );
  CursorON;
  Int24OFF;
  Int10OFF;
  {$I-}
  chdir( SavedPath );
  {$I+}
  Noise(  250, 200 );
  Noise(  500, 100 );
  Noise( 1000, 200 );
  Halt;
end;

procedure AbortOnError( ErrNum, ErrAddr : integer );
  {
  We trap these run-time errors so that we can shut off all
    of the interrupt handlers we created before exiting.
    If we don't do this they stay active while we are in
    the Turbo interactive editor environment.
  }
var
  tstr : str80;
begin
  release( HeapStart );
  tstr  := '';
  case Hi( ErrNum ) of
    0  : tstr := 'A User Break (^C)';
    1  : tstr := 'An I/O error';
    2  : tstr := 'A Run-Time error';
    3  : tstr := 'A Program error';
    else tstr := 'A type ' + Cstr( Lo( ErrNum ), 0, 0 ) + 'error';
  end;
  AbortProgram( 'AbortOnError:',
                '   ' + tstr + ' has occured.',
                '   Error Number: $' + copy(HexStr(Lo(ErrNum)),3,2),
                '        Address: $' + HexStr( ErrAddr ) );
end;

function MemoryAvail : real;
  {
  Return the amount of memory free as a real number of
    bytes, rather than an integer number of paragraphs.
    It also takes into account the Minimum amount of stack
    space defined in sfmVARS.inc.
  }
var
  MA : real;
begin
  MA := MaxAvail;
  if MA < 0 then MA := MA + 65536.0;
  MA := MA * 16.0;
  MA := MA - MinStack;
  MemoryAvail := MA;
end;

function KeyBoard : char;
  {
  Waits for a key to be pressed and sets the global variable
    funckey if it was an extended key code.
  }
var
  ch : char;
begin
  funckey := false;
  read( kbd, ch );
  if keypressed and (ch = #27) then
  begin
    read( kbd, ch );
    funckey := true;
  end;
  KeyBoard := ch;
end;

function KeyboardNorm : char;
  {
  Uses the Keyboard routine above but turns the cursor on
    first and won't pass on extended key codes.
  }
var
  ch : char;
begin
  CursorON;
  repeat
    ch := KeyBoard
  until not funckey;
  CursorOFF;
  KeyboardNorm := ch;
end;

function YorN( ans : boolean ) : boolean;
  {
  Function requests yes or no answers in a nice standardized way.
  }
const
  YN   : array[false..true] of string[3] = ( 'No', 'Yes' );
var
  ch   : char;
  x, y : integer;
begin
  Disp( NATTR, '? ' );
  x := wherex;
  y := wherey;
  repeat
    gotoxy( x, y );
    clreol;
    Disp( HATTR, YN[ans] );
    ch := KeyBoardNorm;
    case upcase(ch) of
      ' ',
      '+' : ans := not ans;
      'Y' : ans := true;
      'N' : ans := false;
    end;
  until ch = #13;
  YorN := ans;
end;

function Continue : boolean;
begin
  writeln;
  Disp( NATTR, ' Continue with next file' );
  Noise( 1000, 100 );
  Continue := YorN( false );
end;

function TryAgain : boolean;
begin
  writeln;
  Disp( NATTR, ' Try again' );
  Noise( 500, 100 );
  TryAgain := YorN( false );
end;

procedure wait;
  {
  Present press any key and a small beep to promp the user.
  }
var
  ch : char;
begin
  Disp( NATTR, 'PRESS ANY KEY' );
  Noise( 1000, 100 );
  CursorON;
  ch := KeyBoard;
  CursorOFF;
end;

function SelectFloppy( drv : integer ) : integer;
  {
  Selects either floppy drive A or B.
  }
var
  ch   : char;
  x, y : integer;
begin
  x := wherex;
  y := wherey;
  repeat
    gotoxy( x, y );
    clreol;
    Disp( HATTR, char( drv + 64 ) );
    ch := KeyboardNorm;
    case upcase(ch) of
      ' ',
      '+' : drv := 3 - drv;
      'A' : drv := 1;
      'B' : drv := 2;
    end;
  until ch in [#13,#27];
  if ch = #27 then
    SelectFloppy := 0
  else
    SelectFloppy := drv;
end;

function CharValid( ch : char ) : boolean;
  {
  Determines if a character is a valid DOS file name character.
  }
const
  ValChars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!@#$%^&()_-~{}"';
var
  val : boolean;
begin
  val := (not funckey) and ( pos( ch, ValChars) <> 0 );
  if not val then
    Noise( 1000, 10 );
  CharValid := val;
end;

function GetLine( maxlen : integer ) : str80;
  {
  A nice non-breakable input routine.
  }
var
  tstr : str80;
  ch   : char;
  len  : integer;
begin
  tstr := '';
  repeat
    ch  := KeyBoardNorm;
    len := ord( tstr[0] );
    case ch of
      #13 : {};
      #8  : if len > 0 then
            begin
              tstr := copy( tstr, 1, len - 1 );
              write( ch, ' ', ch );
            end;
      else if (len < maxlen) then
           begin
             tstr := tstr + ch;
             Disp( HATTR, ch );
           end
           else Noise( 500, 10 );
    end;
  until ch = #13;
  GetLine := tstr;
end;

Procedure WriteScreen;
  {
  Writes out boxes for windows once.  After that we just assume
    that nothing can mess up our pretty little screens.
    (Actually, I don't think much can)
  }
var
  i    : integer;
  tstr : str80;
begin
  window( 1, 1, 80, 25 );
  clrscr;
  fillchar( tstr, sizeof( str80 ), horzlin );
  tstr[ 0] := #80;
  tstr[ 1] := corn1;  tstr[40] := int1;  tstr[41] := int1; tstr[80] := corn2;
  Display( 1, 1, BNATTR, tstr );
  tstr[ 1] := tleft;  tstr[40] := int2;  tstr[41] := int2; tstr[80] := trght;
  Display( 1, 3, BNATTR, tstr );
  tstr[ 1] := corn3;  tstr[40] := int3;  tstr[41] := int3; tstr[80] := corn4;
  Display( 1, 21, BNATTR, tstr );
  fillchar( tstr[1], sizeof(str80)-1, ' ' );
  tstr[1]  := vertlin;   tstr[40] := vertlin;
  tstr[41] := vertlin;   tstr[80] := vertlin;
  Display( 1, 2, BNATTR, tstr );
  for i := 4 to 20 do
    Display( 1, i, BNATTR, tstr );
end;

procedure Colors;
  {
  Sets all the display colors according to the flag Color.
  }
begin
  case Color of
    true  : begin
              PATTR    := Yellow;
              NATTR    := White;
              HATTR    := LightRed;
              HATTR2   := LightMagenta;
              BNATTR   := Blue;
              BHATTR   := Blue * 16 + LightMagenta  {LightMagenta};
              MATTR[1] := (LightGray * 16) + Red;
              MATTR[2] := (Red       * 16) + White;
            end;
    false : begin
              PATTR    := White;
              NATTR    := LightGray;
              HATTR    := White;
              HATTR2   := White;
              BNATTR   := LightGray;
              BHATTR   := 16 * lightgray{White};
              MATTR[1] := LightGray * 16;
              MATTR[2] := LightGray * 16;
            end;
  end;
end;

function EntrySize( E : Entry_T ) : real;
  {
  Calculates the file size of the entry passed in.
  }
var
  i    : integer;
  word : array[0..1] of real;
begin
  for i := 0 to 1 do
  begin
    if E.Size[i] < 0 then word[i] := E.Size[i] + 65536.0
    else word[i] := E.Size[i];
  end;
  EntrySize := 65536.0 * word[1] + word[0];
end;

function EntryTime( E : Entry_T ) : str6;
  {
  Returns a five character time string;
    Time field is in the following word format
              [hhhhhmmmmmmsssss]
  }
var
  hrs, mins : str6;
begin
  str(  (E.Time            SHR 11):2, hrs );
  str( ((E.Time AND $07FF) SHR 5 ):2, mins );
  if mins[1] = ' ' then mins[1] := '0';
  EntryTime := hrs + ':' + mins;
end;

function EntryDate( E : Entry_T ) : str6;
  {
  Returns the date in a scrunched 6 character string;
    Date field is in the following word format
              [yyyyyyymmmmddddd]
  }
var
  i             : integer;
  temp, d, m, y : str6;
begin
  str( ((E.Date AND $01FF) SHR 5 ):2, m );
  str(  (E.Date AND $001F        ):2, d );
  str( ((E.Date SHR 9 )  +  1980 ):4, y );
  temp := m + d + y[3] + y[4];
  for i := 1 to 6 do
    if temp[i] = ' ' then temp[i] := '0';
  EntryDate := temp;
end;

function EntryAttr( E : Entry_T ) : str6;
  {
  Returns a 4 character string for the file's attributes or
    the »DEL string if it was deleted.
    The volume and directory attributes are left out since they
    will be represented by the (VOL) or <DIR> strings in place
    of a file size.
  }
const
  dstr = '»DEL';
var
  temp    : str6;
  i, mask : integer;
begin
  if E.Name[1] = DelChar then
    temp := dstr
  else
  begin
    mask := Abit;          { Mask corresponds to the bit associated with  }
    temp := 'ADVSHR';      {   attributes.  See the constants Abit - Rbit }
    for i := 1 to 6 do     {   defined in sfmVARS.inc                     }
    begin
      if (E.Attr AND mask) = 0 then
        temp[i] := ' ';
      mask := mask SHR 1;
    end;
    delete( temp, 2, 2 );  { Remove the V and D attribute characters }
  end;
  EntryAttr := temp;
end;

procedure WriteEntry( M : boolean; E : Entry_T );
  {
  Writes the entry specified at the current cursor postion.
  }
const
  dstr = '<DIR> ';
  vstr = '(VOL) ';
var
  tstr     : str80;
  i, attr  : integer;
  r        : real;
begin
  if M then attr := HATTR else attr := NATTR;
  if E.Name[1] = NulChar then
    Disp( attr, '  unused entry' )
  else
  begin
    tstr := '  ';
    move( E.Name[1], tstr[3], 11 );
    tstr[0] := #13;
    if tstr[3] = DelChar then tstr[3] := '?';
    if (E.Attr AND Vbit) = 0 then insert( ' ', tstr, 11 )
    else tstr := tstr + ' ';
    Disp( attr, tstr );
    r := EntrySize( E );
    if (r <= 500) then r := KiloByte;

    if (E.Attr AND Dbit) <> 0 then
      Disp( attr, dstr )
    else if (E.Attr AND Vbit) <> 0 then
      Disp( attr, vstr )
    else
      Disp( attr, Cstr( r / KiloByte,4,0 ) + 'K ' );

    Disp( attr, EntryDate(E)+' '+EntryTime(E)+' '+EntryAttr(E) );
  end;
  clreol;
end;

function ConvertName( E : Entry_T ) : str80;
  {
  Provides the name of an entry as a 12 character or less string.
  }
var
  tstr : str80;
  i    : integer;
begin
  move( E.Name, tstr[1], 11 );
  tstr[0] := #11;
  insert( '.', tstr, 9 );

  while (tstr[ord(tstr[0])] = ' ') do
    tstr[0] := char( ord(tstr[0]) - 1 );

  i := 8;
  while (tstr[i] = ' ') and (i <> 0) do
  begin
    delete( tstr, i, 1 );
    i := i - 1;
  end;

  if ( (E.Attr AND Vbit) <> 0 ) or ( tstr[ord(tstr[0])] = '.' ) then
    delete( tstr, pos( '.', tstr ), 1 );

  if tstr[1] = DelChar then
    tstr[1] := '?';

  ConvertName := tstr;
end;

function CheckMask( w, i : integer ) : boolean;
  {
  Checks the Entry[w][i] against the current mask string
    to determine if it should be displayed or not.
  }
var
  j     : integer;
  match : boolean;
begin
  match := true;
  j := 0;
  repeat
    j := j + 1;
    if ConvMask[w][j] <> '?' then
      if ConvMask[w][j] <> Entry[w][i].Name[j] then match := false;
  until (j=11) or not match;
  CheckMask := match;
end;

function NextEntry( w, i : integer ) : integer;
  {
  Given the current entry, NextEntry returns the next entry
    that is in the current mask.
  }
var
  found : boolean;
begin
  if i = MaxEntry[w] then
    NextEntry := 0
  else
  begin
    if ShowAll then
      NextEntry := i + 1
    else
    begin
      found := false;
      while (i < MaxEntry[w]) and not found do
      begin
        i := i + 1;
        found := not ( Entry[w][i].Name[1] in [DelChar,NulChar] ) and
                     ( ( Entry[w][i].Attr AND Vbit ) = 0 );
        if found then
          found := CheckMask( w, i );
      end;
      if found then NextEntry := i else NextEntry := 0;
    end;
  end;
end;

function LastEntry( w, i : integer ) : integer;
  {
  Same as NextEntry but in the other direction.
  }
var
  found : boolean;
begin
  if i = 1 then
    LastEntry := 0
  else
  begin
    if ShowAll then
      LastEntry := i - 1
    else
    begin
      found := false;
      while (i > 1) and not found do
      begin
        i := i - 1;
        found := not( Entry[w][i].Name[1] in [DelChar,NulChar] ) and
                    ( ( Entry[w][i].Attr AND Vbit) = 0 );
        if found then
          found := CheckMask( w, i );
      end;
      if found then LastEntry := i else LastEntry := 0;
    end;
  end;
end;

function TallySizes( w : integer ) : real;
  {
  Totals the sizes of all undeleted files in the directory.
    This is a byte count of their directory entry size, not
    the actual space used on disk.
  }
var
  total : real;
  i     : integer;
begin
  total := 0.0;
  for i := 1 to MaxEntry[w] do
    if not(Entry[w][i].Name[1] in [DelChar,NulChar]) then
      total := total + EntrySize( Entry[w][i] );
  TallySizes := total;
end;

procedure Wind( w : integer );
  {
  Sets the window constants and Turbo's window to one
    of the three windows used.
  }
begin
  case w of
    1 : begin X1 := 2;  X2 := 39;  Y1 := 4;  Y2 := 20;  end;
    2 : begin X1 := 42; X2 := 79;  Y1 := 4;  Y2 := 20;  end;
    3 : begin X1 := 2;  X2 := 79;  Y1 := 22; Y2 := 25;  end;
  end;
  window( X1, Y1, X2, Y2 );
end;

procedure WriteSizes( w : integer; flag : boolean );
  {
  Write the space used by the directory and the amount of free
    space on disk at the bottom of the window.
    If flag is false then redraw the line at the bottom of the window.
  }
var
  tstr : str80;
  i    : integer;
begin
  Wind( w );
  if not flag then
  begin
    fillchar( tstr[0], sizeof( str80 ), horzlin );
    tstr[0] := #38;
    Display( X1, Y2+1, BNATTR, tstr );
  end
  else
  begin
    Display( X1+1,  Y2+1, BNATTR, lbrk );
    Display( X1+17, Y2+1, BNATTR, rbrk );
    Display( X1+23, Y2+1, BNATTR, lbrk );
    Display( X1+36, Y2+1, BNATTR, rbrk );
    Display(X1+2 ,Y2+1,BHATTR,'DirSize ='+Cstr(DirSize[w]/KiloByte,5,0)+'K');
    Display(X1+24,Y2+1,BHATTR,'Free ='+Cstr(DiskFree[w]/KiloByte,5,0)+'K');
  end;
end;

procedure WriteMask( w : integer; flag : boolean );
  {
  Similar to WriteSizes but writes the mask at the top of the
    screen unless it happens to be '*.*'.
  }
var
  tstr : str80;
  i    : integer;
begin
  Wind( w );
  fillchar( tstr, sizeof(str80), horzlin );
  tstr[0] := #38;
  Display( X1, Y1-1, BNATTR, tstr );
  if flag then
  begin
    if ConvMask[w] <> '???????????' then
    begin
      Display( X1+1, Y1-1, BNATTR, lbrk );
      Display( X1+ord(Mask[w][0])+9, Y1-1, BNATTR, rbrk);
      Display( X1+2, Y1-1, BHATTR, 'Mask = ' + Mask[w] );
    end;
  end;
end;

procedure WriteWindow( w : integer );
  {
  Rewrites the window specified and calls the routines
    above to write the sizes and current mask.
  }
var
  tstr  : str80;
  x,i,j : integer;
begin
  Wind( w );
  fillchar( tstr, sizeof(str80), ' ' );
  tstr[0] := #38;
  Display( X1, Y1-2, HATTR2, tstr );
  if loaded[w] then
  begin
    tstr := Path[w];
    if ord( tstr[0] ) > 38 then tstr := copy( tstr, ord(tstr[0])-37, 38 );
    x := 19 - ( ord(tstr[0]) div 2 );
    Display( X1+x, Y1-2, HATTR2, tstr );
  end;
  if HelpScreen[w] or not loaded[w] then
  begin
    WriteMask( w, false );
    WriteSizes( w, false );
  end
  else
  begin
    WriteMask( w, not ShowAll );
    i := TopEntry[w];
    j := 1;
    while (i <> 0) and (j <= WindowLen) do
    begin
      gotoxy( 1, j );
      WriteEntry( Marked[w][i], Entry[w][i] );
      i := NextEntry( w, i );
      j := j + 1;
    end;
    for i := j to WindowLen do
    begin
      gotoxy( 1, i );
      clreol;
    end;
    WriteSizes( w, true );
    gotoxy( 1, CurLin[w] );
    Disp( PATTR, ' ' + PtrChar );
  end;
end;

procedure MarkAll( w : integer );
  {
  Mark all files except those that can't be marked.
    (e.g. directories or deleted files can't be marked)
  }
var
  i : integer;
begin
  i := NextEntry( w, 0 );
  repeat
    if (Entry[w][i].Attr AND Dbit) = 0 then
      Marked[w][i] := true
    else
      Marked[w][i] := false;
    i := NextEntry( w, i );
  until i = 0;
  WriteWindow( w );
end;

procedure ClearMarks( w : integer );
begin
  fillchar( Marked[w], sizeof(MarkedArr_T), 0 );
  WriteWindow( w );
end;

procedure MarkEntry( w : integer );
begin
  if CurEntry[w] <> 0 then
  begin
    if (Entry[w][CurEntry[w]].Attr AND Dbit) = 0 then
    begin
      Marked[w][CurEntry[w]] := true;
      gotoxy( 1, CurLin[w] );
      WriteEntry( true, Entry[w][CurEntry[w]] );
    end;
  end;
end;

procedure UnMarkEntry( w : integer );
begin
  if CurEntry[w] <> 0 then
  begin
    Marked[w][CurEntry[w]] := false;
    gotoxy( 1, CurLin[w] );
    WriteEntry( false, Entry[w][CurEntry[w]] );
  end;
end;

procedure HomeKey( w : integer );
begin
  CurLin[w] := 1;
  CurEntry[w] := NextEntry( w, 0 );
  TopEntry[w] := CurEntry[w];
  WriteWindow( w );
end;

procedure EndKey( w : integer );
var
  i, j : integer;
begin
  if CurEntry[w] <> 0 then
  begin
    j := 0;
    i := MaxEntry[w] + 1;
    TopEntry[w] := 0;
    CurEntry[w] := LastEntry( w, i );
    repeat
      i := LastEntry( w, i );
      if i <> 0 then
      begin
        TopEntry[w] := i;
        j := j + 1;
      end;
    until (j = WindowLen) or (i = 0);
    CurLin[w] := j;
    WriteWindow( w );
  end;
end;

procedure UpKey( w : integer );
var
  i : integer;
begin
  if CurEntry[w] <> 0 then
  begin
    i := LastEntry( w, CurEntry[w] );
    if i <> 0 then
    begin
      if CurLin[w] <> 1 then
        CurLin[w] := CurLin[w] - 1
      else
      begin
        TopEntry[w] := i;
        Display( X1, Y1, PATTR, '  ' );
        gotoxy( 1, 1 );
        insline;
        WriteEntry( Marked[w][i], Entry[w][i] );
      end;
      CurEntry[w] := i;
    end;
  end;
end;

procedure DownKey( w : integer );
var
  i : integer;
begin
  if CurEntry[w] <> 0 then
  begin
    i := NextEntry( w, CurEntry[w] );
    if i <> 0 then
    begin
      if CurLin[w] <> WindowLen then
        CurLin[w] := CurLin[w] + 1
      else
      begin
        TopEntry[w] := NextEntry( w, TopEntry[w] );
        gotoxy( 1, WindowLen );
        WriteEntry( Marked[w][CurEntry[w]], Entry[w][CurEntry[w]] );
        writeln;
        WriteEntry( Marked[w][i], Entry[w][i] );
      end;
      CurEntry[w] := i;
    end;
  end;
end;

procedure PgUp( w : integer );
var
  i, j : integer;
begin
  if CurEntry[w] <>  0 then
  begin
    j := 0;
    i := TopEntry[w];
    repeat
      i := LastEntry( w, i );
      if i <> 0 then
      begin
        j := j + 1;
        TopEntry[w] := i;
        CurEntry[w] := LastEntry( w, CurEntry[w] );
      end;
    until (i = 0) or (j = WindowLen);
    if i = 0 then HomeKey( w )
    else WriteWindow( w );
  end;
end;

procedure PgDown( w : integer );
var
  i, j : integer;
begin
  if CurEntry[w] <> 0 then
  begin
    i := CurEntry[w];
    j := 0;
    repeat
      i := NextEntry( w, i );
      if i <> 0 then
      begin
        j := j + 1;
        CurEntry[w] := i;
        TopEntry[w] := NextEntry( w, TopEntry[w] )
      end;
    until (j = WindowLen) or (i = 0);
    if i <> 0 then
    begin
      j := CurLin[w];
      while (j <> WindowLen) and (i <> 0) do
      begin
        j := j + 1;
        i := NextEntry( w, i );
      end;
    end;
    if i = 0 then EndKey( w )
    else WriteWindow( w );
  end;
end;

procedure MoveEntry( w : integer );
  {
  With this procedure we need to rewrite each of the screen control
    procedures since we aren't just moving the pointer, we're moving
    files around too.  For this reason there are several procedures
    local to MoveEntry with the same names as used from the main menus.
  }
var
  tEntry : Entry_T;
  i      : integer;

  procedure Exchange( i, j : integer );  { Local to MoveEntry }
  begin
    tEntry:= Entry[w][i];
    Entry[w][i] := Entry[w][j];
    Entry[w][j] := tEntry;
  end;

  procedure UpKey;                       { Local to MoveEntry }
  begin
    if CurEntry[w] >  1 then
    begin
      gotoxy( 1, CurLin[w] );
      WriteEntry( false, Entry[w][CurEntry[w]-1] );
      if CurLin[w] <> 1 then
        CurLin[w] := CurLin[w] - 1
      else
      begin
        insline;
        TopEntry[w] := TopEntry[w] - 1;
      end;
      gotoxy( 1, CurLin[w] );
      WriteEntry( true, Entry[w][CurEntry[w]] );
      Exchange( CurEntry[w], CurEntry[w]-1 );
      CurEntry[w] := CurEntry[w] - 1;
    end;
  end;

  procedure DownKey;                        { Local to MoveEntry }
  begin
    if CurEntry[w] < MaxEntry[w] then
    begin
      gotoxy( 1, CurLin[w] );
      WriteEntry( false, Entry[w][CurEntry[w]+1] );
      if CurLin[w] <> WindowLen then
        CurLin[w] := CurLin[w] + 1
      else
      begin
        writeln;
        TopEntry[w] := TopEntry[w] + 1;
      end;
      gotoxy( 1, CurLin[w] );
      WriteEntry( true, Entry[w][CurEntry[w]] );
      Exchange( CurEntry[w], CurEntry[w]+1 );
      CurEntry[w] := CurEntry[w] + 1;
    end;
  end;

  procedure MoveHome;                  { Local to MoveEntry }
  begin
    if CurEntry[w] > 1 then
    begin
      tEntry := Entry[w][CurEntry[w]];
      for i := CurEntry[w] downto 2 do
        Entry[w][i] := Entry[w][i-1];
      Entry[w][1] := tEntry;
      HomeKey( w );
      gotoxy( 1, CurLin[w] );
      WriteEntry( true, Entry[w][CurEntry[w]] );
    end;
  end;

  procedure MoveEnd;                { Local to MoveEntry }
  begin
    if CurEntry[w] < MaxEntry[w] then
    begin
      tEntry := Entry[w][CurEntry[w]];
      for i := CurEntry[w] to MaxEntry[w]-1 do
        Entry[w][i] := Entry[w][i+1];
      Entry[w][MaxEntry[w]] := tEntry;
      EndKey( w );
      gotoxy( 1, CurLin[w] );
      WriteEntry( true, Entry[w][CurEntry[w]] );
    end;
  end;

  procedure PgUp;                  { Local to MoveEntry }
  begin
    if CurEntry[w] <> 1 then
    begin
      if TopEntry[w] - WindowLen < 1 then
        MoveHome
      else
      begin
        tEntry := Entry[w][CurEntry[w]];
        for i := CurEntry[w] downto CurEntry[w] - WindowLen + 1 do
          Entry[w][i] := Entry[w][i-1];
        CurEntry[w] := CurEntry[w] - WindowLen;
        TopEntry[w] := TopEntry[w] - WindowLen;
        Entry[w][CurEntry[w]] := tEntry;
        WriteWindow( w );
        gotoxy( 1, CurLin[w] );
        WriteEntry( true, Entry[w][CurEntry[w]] );
      end;
    end;
  end;

  procedure PgDown;                 { Local to MoveEntry }
  begin
    if CurEntry[w] <> MaxEntry[w] then
    begin
      if TopEntry[w] + (2 * WindowLen) > MaxEntry[w] then
        MoveEnd
      else
      begin
        tEntry := Entry[w][CurEntry[w]];
        for i := CurEntry[w] to CurEntry[w]+WindowLen-1 do
          Entry[w][i] := Entry[w][i+1];
        CurEntry[w] := CurEntry[w] + WindowLen;
        TopEntry[w] := TopEntry[w] + WindowLen;
        Entry[w][CurEntry[w]] := tEntry;
        WriteWindow( w );
        gotoxy( 1, CurLin[w] );
        WriteEntry( true, Entry[w][CurEntry[w]] );
      end;
    end;
  end;

var                             { Actual start of MoveEntry }
  ch : char;
  tstr : str80;
begin
  if CurEntry[w] <> 0 then
  begin
    Wind( 3 );
    clrscr;
    writeln;
    tstr := ConvertName( Entry[w][CurEntry[w]] );
    Disp( NATTR, ' Moving file ' );
    Disp( HATTR, tstr );
    Disp( NATTR, ', press F10 when in position.' );
    Wind( w );
    gotoxy( 1, CurLin[w] );
    WriteEntry( true, Entry[w][CurEntry[w]] );
    repeat
      gotoxy( 1, CurLin[w] );
      Display( x1, y1+CurLin[w]-1, PATTR, ' '+PtrChar );
      CursorON;
      ch := Keyboard;
      CursorOFF;
      case ch of
        #72 : UpKey;
        #80 : DownKey;
        #73 : PgUp;
        #81 : PgDown;
        #71 : MoveHome;
        #79 : MoveEnd;
      end;
    until (funckey and (ch = #68)) or (ch = #13);  { Done when F10 is pressed }
    gotoxy( 1, CurLin[w] );
    WriteEntry( false, Entry[w][CurEntry[w]] );
    Saved[w] := false;
  end;
end;

procedure MaxFileMessage;
begin
  Wind( 3 );
  clrscr;
  writeln;
  Disp( NATTR, ' Warning: ' );
  Disp( HATTR, 'Directory exceeds file limit, menu 2 save option disabled' );
  writeln;
  gotoxy( 11, wherey );
  wait;
end;

procedure DupPathMessage;
begin
  writeln;
  Disp( NATTR, ' Error: ' );
  Disp( HATTR, 'Windows must have different paths.' );
  writeln;
  gotoxy( 9, wherey );
  wait;
end;

procedure GetColor;
  {
  Startup screen and prompt for Color override.  Why, you ask, do
    I allow the user to specify whether or not they have a color
    system when I have already read their hardware configuration?
    Well, because those poor souls with monochrome monitors and CGA
    cards wouldn't get a very good display if I didn't.
  }
var
  MA : real;
begin
  x1 := 10;
  y1 := 3;
  textbackground( Black );
  clrscr;
  window( x1, y1, 80, 25 );   { Use light text colors so they will show }
  gotoxy( 1, 1 );             {   on all systems.                       }
  textcolor( HATTR2 );
  writeln( '                 - Super File Manager '+ version +' -' );
  writeln;
  textcolor( NATTR );
  writeln( '                      David Steiner' );
  writeln( '                      2035 J Apt. 6' );
  writeln( '                      Lincoln, NE  68510' );
  writeln( '                      [phone]' );
  writeln( '                      June 1, 1987' );
  writeln;
  textcolor( PATTR );
  writeln( '   Capitol PC User Group 1987 Software Programming Contest' );
  textcolor( HATTR2 );
  writeln;
  writeln( 'Permission is granted for Capital PC and other not for profit' );
  writeln( 'organizations to publish the source and executable portions of' );
  writeln( 'this program.' );
  writeln;
  writeln;
  textcolor( NATTR );
  MA := MemoryAvail;
  write  ( '            Copy buffer =' + Cstr( MA, 7, 0 ) );
  writeln( ' bytes  ( ' + Cstr( MA/KiloByte, 0, 0 ) + 'K )' );
  writeln;
  writeln;
  textcolor( NATTR );
  write  ( '                Is this a color system' );
  color := YorN( color );
end;

procedure WriteHelp1;
  {
  Screen shown on right side when program started up.
  }
begin
  Wind( 2 );
  clrscr;
  Display( X1, Y1-2, HATTR2,'     - Super File Manager '+version+' -' );
{               |--------------------------------------|  }
  writeln;
  Disp( PATTR,  '          Standard Features:' );            writeln;
  writeln;
  Disp( NATTR,  '      Mark files to be managed' );          writeln;
  Disp( NATTR,  '       Copy, delete, rename...' );          writeln;
  Disp( NATTR,  '     Create, remove directories' );         writeln;
  writeln;
  Disp( PATTR,  '        Outstanding Features:' );           writeln;
  writeln;
  Disp( NATTR,  '     Mask files being displayed' );         writeln;
  Disp( NATTR,  '        Reorder directories' );             writeln;
  Disp( NATTR,  '     Move files without copying' );         writeln;
  Disp( NATTR,  '  Full memory usage for copy buffer' );     writeln;
  Disp( NATTR,  '   Change/clear disks during copy' );       writeln;
  writeln;
  Disp( HATTR2, '       ( Press F2 for help )' );
end;

procedure HelpWindow( var w : integer; helpw : integer );
  {
  Display help when asked for.  Uses enough logic to always
    open the window on the unused side even if the key for
    the other side was entered.
  }
begin
  HelpScreen[helpw] := not HelpScreen[helpw];
  if not HelpScreen[helpw] then
  begin
    if Loaded[helpw] then WriteWindow( helpw )
    else HelpScreen[helpw] := true;
  end
  else
  begin
    if not loaded[3-helpw] then     { If a window is not used then put help }
    begin                           {   there by default.                   }
      HelpScreen[helpw] := false;
      helpw := 3 - helpw;
      HelpScreen[helpw] := true;
    end
    else if HelpScreen[3-helpw] then
    begin
      HelpScreen[3-helpw] := false;
      WriteWindow( 3-helpw );
    end;
    if helpw = w then w := 3 - w;
  end;
  if HelpScreen[helpw] then
  begin
    WriteWindow( helpw );
    Display( x1, 2, HATTR2, '     - Super File Manager ' + version + ' -' );
    clrscr;
{                 |--------------------------------------|  }
    writeln;
    Disp( PATTR,  '               Help!!' );                 writeln;
    writeln;
    Disp( NATTR,  '     F1,F2: This help window' );          writeln;
    Disp( NATTR,  '     F3,F4: Load subdirectory' );         writeln;
    Disp( NATTR,  '     F5,F6: Load path entered' );         writeln;
    Disp( NATTR,  '     F7,F8: Select command ' );           writeln;
    Disp( NATTR,  '        F9: Mark file' );                 writeln;
    Disp( NATTR,  '       F10: Remove mark' );               writeln;
    Disp( NATTR,  '       Del: Delete file or directory' );  writeln;
    writeln;
    Disp( NATTR,  '   Cursor keys: Move file pointer' );     writeln;
    writeln;
    Disp( NATTR,  '  Shift-Cursor keys: Select command' );   writeln;
    writeln;
    Disp( NATTR,  '       RETURN: Execute command' );
  end;
end;

procedure Menu2Window( w : integer );
begin
  HelpScreen[3-w] := true;
  WriteWindow( 3-w );
  clrscr;
  Display( X1, Y1-2, HATTR2, '     - Advanced Functions Menu -' );
{               |--------------------------------------|  }
  writeln;
  Disp( NATTR,  ' Changes are not made directly to the' );      writeln;
  Disp( NATTR,  '  disk, you must Update any changes.' );       writeln;
  writeln;
  Disp( HATTR,  ' Do not change disks when using these' );      writeln;
  Disp( HATTR,  '  functions.  Updating the wrong one' );       writeln;
  Disp( HATTR,  '     may result in a loss of data.' );         writeln;
  writeln;
  Disp( NATTR,  '        F7,F8: Select command' );              writeln;
  Disp( NATTR,  '           F9: Pick up file' );                writeln;
  Disp( NATTR,  '          F10: Drop file' );                   writeln;
  writeln;
  Disp( NATTR,  '    Cursor keys: Move file pointer' );         writeln;
  Disp( NATTR,  '  Shift-Cursor keys: Select command' );        writeln;
  writeln;
  Disp( NATTR,  '        RETURN: Execute command' );            writeln;
end;

procedure CopyInfo( w : integer );
  {
  Show the amount of space required to store the marked
    files on any disks that we currently have information for.
  }
const
  fits : array[false..true] of str10 = (' Won''t Fit','  Will Fit');
var
  CLsize                : array[1..2] of integer;
  dsize, dskfr          : array[1..2] of real;
  size, tempsize, tempR : real;
  i, j, k               : integer;
  drivech               : char;
begin
  with DiskTable[w]^ do
    CLsize[w] := SECTORSIZE * (CLUSTERSIZE+1);
  dskfr[w] := DiskFree[w];

  drivech := #00;
  if loaded[3-w] and (Drive[w] <> Drive[3-w]) then
  begin
    drivech := Path[3-w][1];
    with DiskTable[3-w]^ do
      CLsize[3-w] := SECTORSIZE * (CLUSTERSIZE+1);
    dskfr[3-w] := DiskFree[3-w];
  end
  else
    CLsize[3-w] := CLsize[w];

  for j := 1 to 2 do dsize[j] := 0;
  k := 0;
  i := NextEntry( w, 0 );
  while (i <> 0) do
  begin
    if Marked[w][i] then
    begin
      k := k + 1;
      tempsize := EntrySize( Entry[w][i] );
      size := size + tempsize;
      for j := 1 to 2 do
      begin
        tempR := tempsize / CLsize[j];
        if frac( tempR ) <> 0.0 then tempR := trunc( tempR ) + 1
        else tempR := trunc( tempR );
        dsize[j] := dsize[j] + ( tempR * CLsize[j] );
      end;
    end;
    i := NextEntry( w, i );
  end;
  if k <> 0 then
  begin
    Wind( 3 );
    clrscr;
    Disp( NATTR, ' Total size of' );
    Disp( HATTR, Cstr( k, 3, 0 ) );
    Disp( NATTR, ' marked file(s)   =' + Cstr( size, 8, 0 ) + ' bytes' );
    writeln;
    Disp( NATTR, '    Disk space required ');
    i := wherex;
    Disp( NATTR, 'on drive ' + Path[w][1] + ' =' );
    Disp( HATTR, Cstr( dsize[w], 8, 0 ) + '         ('
               + Cstr( round(dsize[w] / KiloByte),5, 0 ) + 'K )' );
    Disp( NATTR, fits[ (dsize[w] <= dskfr[w]) ] );
    writeln;
    if drivech <> #00 then
    begin
      gotoxy( i, wherey );
      Disp( NATTR, 'on drive ' + drivech + ' =' );
      Disp( HATTR, Cstr( dsize[3-w], 8, 0 ) + '         ('
                 + Cstr( round(dsize[3-w] / KiloByte),5,0) + 'K )' );
      Disp( NATTR, fits[ (dsize[3-w] <= dskfr[3-w]) ] );
    end;
    writeln;
    gotoxy( 25, wherey );
    wait;
  end;
end;

procedure TechInfo( w : integer );
  {
  Show specific information about the current disk.
  }
var
  tstr  : str80;
  tempR : real;
  i     : integer;
begin
  WriteWindow( 3-w );
  clrscr;
  Display( x1, 2, HATTR2, '    - Disk Technical Information -' );
  {               |--------------------------------------|  }
  writeln;
  with DiskTable[w]^ do
  begin
    Disp( NATTR,  '           Bytes per sector = ' + Cstr(SECTORSIZE,0,0) );
    writeln;
    Disp( NATTR,  '        Sectors per cluster = ' + Cstr(CLUSTERSIZE+1,0,0) );
    writeln;
    Disp( NATTR,  '     Total clusters on disk = ' + Cstr(MAXCLUSTER-1,0,0) );
    writeln;
    writeln;
    tempR := 1.0 * SECTORSIZE * (CLUSTERSIZE+1) * (MAXCLUSTER-1);
    if tempR > KiloByte * KiloByte then
      tstr := Cstr( tempR / (KiloByte * KiloByte),0,0 ) + ' Meg'
    else
      tstr := Cstr( tempR / KiloByte,0,0 ) + 'K';
    Disp( PATTR,  ' Total disk storage (bytes) = ' + tstr );
    writeln;
    writeln;
    writeln;
    Disp( NATTR,  ' Sectors used by DOS bootstrap = '+Cstr(BOOTSIZE,0,0) );
    writeln;
    Disp( NATTR,  '          Number of FAT copies = '+Cstr(NFATS,0,0) );
    writeln;
    Disp( NATTR,  '          Sectors per FAT copy = '+Cstr(FATSIZE,0,0) );
    writeln;
    Disp( NATTR,  '   Max files in root directory = '+Cstr(ROOTENTRIES,0,0) );
    writeln;
    i := DATASECTOR - ROOTSECTOR;
    Disp( NATTR,  '      Sectors occupied by root = '+Cstr(i,0,0) );
    writeln;
    writeln;
    i := i + BOOTSIZE + NFATS * FATSIZE;
    Disp( PATTR,  '     Total sectors used by DOS = '+Cstr(i,0,0) );
    writeln;
    if (Drive[w] <> 1) and (DiskTable[w]^.DRIVE2 = 0) then
      tstr := 'a RAM DISK (format specifications not valid).'
    else
    begin
      case DiskTable[w]^.FATATTR of
        $FF : tstr := 'double sided, 8 sectored and has 40 tracks.';
        $FE : tstr := 'single sided, 8 sectored and has 40 tracks.';
        $FD : tstr := 'double sided, 9 sectored and has 40 tracks.';
        $FC : tstr := 'single sided, 9 sectored and has 40 tracks.';
        $FB : tstr := 'double sided, 8 sectored and has 80 tracks.';
        $F9 : tstr := 'double sided, 15 (or 9) sectored and has 80 tracks.';
        $F8 : tstr := 'a fixed disk (format specifications not shown).';
        else  tstr := 'an unknown type of device.';
      end;
    end;
    Wind( 3 );
    clrscr;
    writeln;
    Disp( NATTR, ' Drive ' + Path[w][1] + ' is ' + tstr );
  end;
  writeln;
  writeln;
  gotoxy( 20, wherey );
  wait;
  Menu2Window( w );
end;