{$S40,P+}
PROGRAM FRUTILTY ;

{ Program:     FRUTILTY.PAS (File Restore Utility)
   By:          Phillip R. Poulos, M.D.
   Rev:         1.20, 6/88
}

{$I auxsubs.pas}

  CONST
    {$I gemconst.pas}
    {$I frutilty.i}         { resource file definition }
    max_option = 30 ;       { Maximum number of options in one dialog }
    chunk = 10240 ;         { size to be copy at one time }
    HIDE = TRUE;            { just name them for the ease of reading }
    NOHIDE = FALSE;
    console=2 ;         {console device}
    bell=7 ;
    BEG_Mctrl = 3 ;     {Mouse Control constants to try to stop MENU foulups}
    END_Mctrl = 2 ;

  TYPE
    opt_range = 1..max_option ;
    opt_array = PACKED ARRAY [ opt_range ] OF Boolean ;
    buf_type = PACKED ARRAY [1..chunk] OF BYTE ;
    time_buf = ARRAY[1..2] OF Integer ;
    C_Path_Type = PACKED ARRAY [1..80] OF CHAR ;
    Str3 = String[3] ;           {a short string to follow drive requests}
    DTA = PACKED RECORD          {DTA record format for GEMDOS stuff}
        rsvd   : PACKED ARRAY[0..19] OF BYTE ;
        rsvd2  : BYTE ;
        attrib : BYTE ;
        time   : Integer ;
        date   : Integer ;
        size   : Long_Integer ;
        name   : C_Path_Type ;
      END ;
    Object = RECORD             {GEM Object record definition}
        ob_next    : Integer ;
        ob_head    : Integer ;
        ob_tail    : Integer ;
        ob_type    : Integer ;
        ob_flags   : Integer ;
        ob_state   : Integer ;
        ob_spec    : Long_Integer ;
        ob_x       : Integer ;
        ob_y       : Integer ;
        ob_width   : Integer ;
        ob_height  : Integer ;
      END ;
    Tree = ARRAY[0..100] OF Object ; {Yes, a Tree is an array of OBJECTS}
    Dialog_Ptr = ^Tree ; {The correct and USEFUL redefinition of a Dialog Ptr}
    
    {$I gemtype.pas}

  VAR
    Date,
    rez  : integer ;                { screen resolution }
    menu : Menu_Ptr ;
    info_x, ScreenX,           {holding places for dialog box sizes}
    info_y, ScreenY,
    info_w, ScreenW,
    info_h, ScreenH,
    PAx, PBx, PUx, StopX,
    PAy, PBy, PUy, StopY,
    PAw, PBw, PUw, StopW,
    PAh, PBh, PUh, StopH,
    dummy : integer ;
    cmp_opts : opt_array ;
    PendingDrive : Str3 ;
    temp_path : Str255 ;
    OnAfterDate,
    def_path,
    des_path,
    src_path : Path_Name ;
    Prog_Dial,
    info_dial : Dialog_Ptr ;
    OldDTA_Ptr,
    DriveMap : Long_Integer ;
  {$I gemsubs.pas}
  

PROCEDURE Obj_Size( dial : dialog_ptr ; Root : integer ;
  VAR x, y, w, h: integer ) ;   {Returns an OBJECT's size; however boxes}
  EXTERNAL ;                    {are frequently sized too SMALL by GEM}


PROCEDURE Obj_Draw( dial : dialog_ptr ; start,depth,x,y,w,h:integer) ;
  EXTERNAL;                {Needed to draw only a part of a Object Tree}


PROCEDURE FORM_DIAL(flag,x_sm,y_sm,w_sm,h_sm,x_lg,y_lg,w_lg,
                   h_lg:integer) ;
  EXTERNAL;         {Standard AES form_dial routine}


PROCEDURE Grow_Shrink( cmd, small_x, small_y, small_w, small_h,
                        big_x, big_y, big_w, big_h : integer ) ;
  VAR
    int_in   : Int_In_Parms ;
    int_out  : Int_Out_Parms ;
    addr_in  : Addr_In_Parms ;
    addr_out : Addr_Out_Parms ;
  BEGIN
    int_in[0] := small_x ;
    int_in[1] := small_y ;
    int_in[2] := small_w ;
    int_in[3] := small_h ;
    int_in[4] := big_x ;
    int_in[5] := big_y ;
    int_in[6] := big_w ;
    int_in[7] := big_h ;
    AES_Call( cmd, int_in, int_out, addr_in, addr_out ) ;
    END ;


PROCEDURE Grow_Box( s_x, s_y, s_w, s_h,
                      b_x, b_y, b_w, b_h : integer ) ;
  BEGIN
      Grow_Shrink( 73, s_x, s_y, s_w, s_h, b_x, b_y, b_w, b_h ) ;
    END ;


PROCEDURE Shrink_Box( big_x, big_y, big_w, big_h,
                        small_x, small_y, small_w, small_h : integer ) ;
  BEGIN
    Grow_Shrink( 74, small_x, small_y, small_w, small_h,
              big_x, big_y, big_w, big_h ) ;
  END ;


PROCEDURE WIND_Update ( ctrl : Integer ) ; {Use this call for MOUSE control}
VAR
  int_in   : Int_In_Parms ;
  int_out  : Int_Out_Parms ;
  addr_in  : Addr_In_Parms ;
  addr_out : Addr_Out_Parms ;
BEGIN
  int_in[0] := ctrl ;
  AES_Call( 107, int_in, int_out, addr_in, addr_out ) ;
END ;


FUNCTION Dsetdrv( drive : INTEGER ) : Long_INTEGER ; { Set Default Drive }
  GEMDOS($0E) ;

FUNCTION Dgetdrv : integer ; {Get Default Drive}
  GEMDOS( $19 ) ;

FUNCTION FCreate( VAR fname : C_Path_Type ; mode : INTEGER ) : INTEGER ;
  GEMDOS( $3C ) ;       {GEMDOS create file routine}

FUNCTION Mkdir( VAR Folder : C_Path_Type) : Integer ;
  GEMDOS( $39 ) ;               {Make a new directory or folder}
  
FUNCTION FOpen( VAR fname : C_Path_Type ; mode : INTEGER ) : INTEGER ;
  GEMDOS( $3D ) ;       {GEMDOS file open routine}

PROCEDURE FClose( fhandle : INTEGER ) ;
  GEMDOS( $3E ) ;      {GEMDOS file close routine}

FUNCTION FRead( fhandle : INTEGER ; n_bytes : Long_INTEGER ;
                 VAR buf : buf_type ) : Long_Integer ;
  GEMDOS( $3F ) ;      {GEMDOS file read routine}

FUNCTION FWrite( fhandle : INTEGER ; n_bytes : Long_INTEGER ;
                 VAR buf : buf_type ) : Long_Integer ;
  GEMDOS( $40 ) ;      {GEMDOS file write routine}

PROCEDURE FDelete( VAR fname : C_Path_Type ) ; {Really another function}
  GEMDOS( $41 ) ;      {GEMDOS file delete routine}
  
FUNCTION FSeek( move : Long_Integer ; fhandle, mode : Integer ) : Long_Integer ;
  GEMDOS( $42 ) ;

PROCEDURE Dgetpath( VAR path_buf : C_Path_Type ; drive : integer ) ;
  GEMDOS( $47 ) ;       {Get current file path}
  
FUNCTION Dsetpath( VAR path_buf : C_Path_Type ) : Integer ;
  GEMDOS( $3B ) ;       {Set new default path}

FUNCTION SFirst( VAR fn : C_Path_Type ; attribute : Integer ) : Integer ;
  GEMDOS( $4E ) ;       {Get first file name match in current directory}

FUNCTION SNext : Integer ; {Get NEXT file name match in current path}
  GEMDOS( $4F ) ;  
  
FUNCTION Chmod( VAR Fname : C_Path_Type ; mode, attribute : Integer ) : Integer ;
  GEMDOS( $43 ) ;       {Change attributes of file - used to make write}
                        {enabled}
                        
PROCEDURE SetDTA( VAR DTA_Buf : DTA ) ;
  GEMDOS( $1A ) ;       {Set up our own DTA area for GEMDOS to use}
  
FUNCTION GetDTA : Long_Integer ;
  GEMDOS( $2F ) ;       {Get address of current DTA area }
  
PROCEDURE ResetDTA ( DTA_Ptr : Long_Integer) ;
  GEMDOS( $1A ) ;       {Reset address of DTA area back to what GEM had}
  
PROCEDURE FDaTime( VAR buf : time_buf ; handle, flag : Integer ) ;
  GEMDOS( $57 ) ;       {Get or Set File Date/Time Stamp}

FUNCTION get_rez : integer ;
  XBIOS( 4 ) ;          {Get resolution of current screen}

FUNCTION bconstat( dec : integer ) : Boolean ;
  BIOS( 1 ) ;           {Get status of input device}

PROCEDURE bconin( dev : integer ) ;     { Really a function! }
  BIOS( 2 ) ;           {Get character from input device}

PROCEDURE bconout( dev, c : integer ) ;
  BIOS( 3 ) ;           {Send character to output device}


PROCEDURE P_To_CPath( VAR P_Path : Path_Name ; VAR C_Path : C_Path_Type ) ;
{ convert Pascal string to C string, the built-in routines only work for
   long string }
VAR
  len,
  i     : INTEGER;
BEGIN
  len := Length( p_path ) ;
  FOR i := 1 TO len DO c_path[i] := p_path[i] ;
  c_path[ len + 1 ] := chr(0) ;
END ;


PROCEDURE C_To_PPath( VAR C_Path : C_Path_Type ; VAR P_Path : Path_Name ) ;
{ convert C string to Pascal string }
VAR
  i     : INTEGER;
BEGIN
  i := 1 ;
  While (C_Path[i] <> CHR(0)) AND (C_Path[i] <> ' ') AND ( i <= 80 ) DO BEGIN
    P_Path[i] := C_Path[i] ;
    i := i + 1 ;
  END ;
  P_Path[0] := Chr( i - 1 ) ;
END ;


PROCEDURE Read_Error( err : Integer ; VAR err_str : Str255 ) ;
BEGIN
  CASE err OF
    -1  : err_str := 'TOS system error' ;
    -2  : err_str := 'Drive not ready' ;
    -3  : err_str := 'Unknown error' ;
    -4  : err_str := 'CRC error' ;
    -5  : err_str := 'Bad request' ;
    -6  : err_str := 'Drive seek error' ;
    -7  : err_str := 'Unknown media' ;
    -8  : err_str := 'Drive sector not found' ;
    -9  : err_str := 'No paper' ;
    -10 : err_str := 'Drive write fault' ;
    -11 : err_str := 'Drive read fault' ;
    -12 : err_str := 'General error' ;
    -13 : err_str := 'Drive write protect' ;
    -14 : err_str := 'Drive media change' ;
    -15 : err_str := 'Unknown device' ;
    -16 : err_str := 'Bad sectors on format' ;
    -17 : err_str := 'Disk change' ;
    -18 : err_str := 'Disk Full' ;
    -31 : err_str := 'Cannot create folder ' ;
    -32 : err_str := 'Invalid function number' ;
    -33 : err_str := 'File not found' ;
    -34 : err_str := 'Path not found' ;
    -35 : err_str := 'Too many open files' ;
    -36 : err_str := 'Access not possible' ;
    -37 : err_str := 'Cannot copy file to self' ;
    -38 : err_str := 'Destination path not found'  ;
    -39 : err_str := 'Insufficient memory' ;
    -40 : err_str := 'Invalid memory block address' ;
    -46 : err_str := 'Invalid drive' ;
    -49 : err_str := 'No more files' ;
    -64 : err_str := 'Range error' ;
    -65 : err_str := 'Internal error' ;
    -66 : err_str := 'Invalid program load format' ;
    -67 : err_str := 'Setblock failure ' ;
    OTHERWISE : WriteV( err_str, 'I/O error #', err ) ;
  END ;
END ;      

 
PROCEDURE IO_Error( err : Integer ) ;
{Display I/O error in alert box}
VAR err_str : Str255 ;
BEGIN
  IF err <> 0 THEN
    BEGIN
      Read_Error( err, err_str ) ;
      err_str := Concat( '[3][ |', err_str, '][ OK ]' ) ;
      bconout( console, bell ) ;
      err := Do_Alert( err_str, 1 ) ;
    END ;
END ;


FUNCTION Error_Choice( err : Integer ) : Integer ;
{Display I/O error in alert box, but give choice of skipping over error}
VAR err_str : Str255 ;
BEGIN
  IF err <> 0 THEN
    BEGIN
      Read_Error( err, err_str ) ;
      err_str := Concat( '[3][ |', err_str, '][SKIP|RETRY|CANCEL]' ) ;
      bconout( console, bell ) ;
      Error_Choice := Do_Alert( err_str, 1 ) ;
    END ;
END ;




PROCEDURE Strip_Filename( VAR Pth, fn : Path_Name ) ;
{Strip_Filename - Remove the File Name/Extension from a Path_Name variable.}
{also process input path to remove redundant characters}
  VAR
    i : integer ;
    done : boolean ;
  BEGIN
    i := Length( pth ) ;
    fn := '' ;
    IF i=0 THEN done := TRUE
    ELSE done := FALSE ;
    WHILE NOT done DO
      BEGIN
        IF i < 1 THEN
          BEGIN
            fn := pth ;
            pth := '' ;
            done := TRUE ;
          END  
        ELSE IF pth[i] = '\' THEN
          BEGIN
            IF (pth[i-1]='\') AND (i>1) THEN
              BEGIN
                Delete( pth, i, 1 ) ;
                i := i - 1 ;
              END
            ELSE
              BEGIN    
                fn := Copy( pth, i+1, length(pth)-i ) ;
                pth[0] := chr(i) ;
                done := TRUE ;
              END ;  
          END  
        ELSE IF pth[i] = ':' THEN
          BEGIN
            fn := Copy( pth, i+1, length(pth)-i ) ;
            pth[0] := chr(i) ;
            done := TRUE ;
          END  
        ELSE
          i := i - 1 ;
      END ;
    i := Length(pth) ;
    IF i>1 THEN
      REPEAT
        IF (pth[i]='\') AND (pth[i-1]='\') THEN Delete( pth, i, 1 ) ;
        i := i - 1 ;
      UNTIL i<2 ;  
  END ;
  

PROCEDURE Strip_Extension( VAR fn, ext : Path_Name ) ;
{ Strip_Extension - Copy the extension from a Path_Name variable. }
  VAR
    i : integer ;
    done : boolean ;
  BEGIN
    ext := '' ;
    i := length( fn ) ;
    done := false ;
    WHILE NOT done DO
      BEGIN
        IF i < 1 THEN
          done := TRUE
        ELSE IF (fn[i] = ':') OR (fn[i] = '\') THEN
          done := TRUE
        ELSE IF fn[i] = '.' THEN
          BEGIN
            ext := Copy( fn, i+1, Length(fn)-i ) ;
            done := TRUE ;
          END
        ELSE
          i := i - 1 ;
      END ;
  END ;


PROCEDURE SetupFName( VAR Src, Des : Path_Name ) ;
{Set up filename.ext in string to be displayed in dialog box}
VAR i,
    j : Integer ;
BEGIN
  des := '            ' ;
  i := 1 ;
  j := 1 ;
  IF Length(Src)>0 THEN
    BEGIN
      REPEAT
        Des[j] := Src[i] ;
        i := i + 1 ;
        j := j + 1 ;
      UNTIL (Src[i]='.') OR (i>Length(Src)) ;
      i := i + 1 ;
      IF i <= Length(Src) THEN
        BEGIN
          j := 9 ;
          REPEAT
            Des[j] := Src[i] ;
            i := i + 1 ;
            j := j + 1 ;
          UNTIL i>Length(Src) ;
        END ;
      IF j>8 THEN des[0] := Chr(j-1) ;  
    END ;
END ;          


PROCEDURE Wait(waittime : Long_Integer);
{ just wait for  n seconds. Note that TOS clock is in 2 second interval }
VAR
  starttime : Long_Integer;
BEGIN
  starttime := Clock;
  WHILE ((Clock - starttime) < waittime ) DO
    ;
END;


{$P-}

PROCEDURE Info_Msg( msg : String ) ;
{Display title in BOX next to File Selector Box}
VAR lines : Integer ;
BEGIN
  Find_Dialog(LOCATION, info_dial);
  Set_DText( info_dial, INFONAME, msg, System_Font, TE_CENTER ) ;
  Obj_Size( info_dial, ROOT, info_x, info_y, info_w, info_h ) ;
  IF rez = 1 THEN lines := 2
  ELSE lines := 6 ;
  info_y := (3 * 8 * rez) + lines ;
  info_dial^[0].ob_y := info_y ;   {Change y position of parent object after}
  info_w := info_w + 10 ;          {object sized, then widen out clip}
  info_h := info_h + 10 ;          {rectangle before display}
  Obj_Draw( info_dial, ROOT, max_depth, info_x, info_y, info_w, info_h ) ;
END ;

{$P=}


PROCEDURE EraseInfo ;
{Erase INfo_Msg box}
BEGIN
  Form_Dial( 3, 0, 0, 0, 0, info_x, info_y, info_w, info_h ) ;
END ;  


PROCEDURE ShowInfo(index : INTEGER; hide : BOOLEAN) ;
{Displays beginning information about program}
VAR
  x, y, w, h    : Integer ;
  dia_obj       : Dialog_Ptr;
BEGIN 
  Find_Dialog(index, dia_obj);
  Center_Dialog(dia_obj);
  Obj_Size(dia_obj, Root, x, y, w, h ) ;
  x := x - 5 ;
  y := y - 5 ;
  w := w + 10 ;
  h := h + 10 ;
  IF hide THEN
    BEGIN
      Shrink_Box( ScreenX, ScreenY, ScreenW, ScreenH, x, y, w, h ) ;
      Show_Dialog(dia_obj, Root);          { no interaction }
      Wait(2);                             { 2 seconds later close down }
      Form_Dial(3, 0, 0, 0, 0, x, y, w, h);  { close the box }
      Shrink_Box( x, y, w, h, 3*8, 0, 4*8, rez*8 ) ;
    END
  ELSE
    BEGIN
      Grow_Box( 3*8, 0, 4*8, rez*8, x, y, w, h ) ;
      dummy := Do_Dialog(dia_obj, 0); 
      End_Dialog(dia_obj);
      Shrink_Box( x, y, w, h, 3*8, 0, 4*8, rez*8 ) ;
      Obj_Setstate(dia_obj, dummy, NORMAL, FALSE);
    END ;  
END;


PROCEDURE Set_Defaults ;
{ initialize some variables }
VAR
  DriveID : Integer ;
  opt : opt_range ;
  path : C_Path_Type ;
  p_path : Path_Name ;
BEGIN
  Work_Rect( 0, ScreenX, ScreenY, ScreenW, ScreenH ) ; {Get working screen size}
  FOR opt := 1 TO max_option DO     {Set up cmp_opts boolean array}
    BEGIN
      IF opt IN [ DEFADD, DEFCOPY, DEFCARRY, MCONFIRM, MCHIMES ] THEN
        cmp_opts[ opt ] := TRUE ;
      IF opt IN [ DEFREP, DEFONAFT, DEFNOSYS ] THEN
        cmp_opts[ opt ] := FALSE ;
    END ;
  src_path := '\*.*' ;     {set source and destination paths}
  des_path := 'A:\' ;
  DriveID := Dgetdrv ;
  des_path[1] := chr( ord('A') + DriveID ) ;
  Dgetpath( path, 0 ) ;      { Get default path } ;
  C_To_PPath(path, p_path);
  def_path := concat( 'A:', p_path, '\' ) ;
  def_path[1] := chr( ord('A') + DriveID ) ;
  OnAfterDate := '' ;
END ;


PROCEDURE DrawObject( dial : Dialog_Ptr ; index, font : Integer ;
  str : Str255 ) ;
{Draw a string in dialog box}  
VAR x, y, w, h : Integer ;
BEGIN
  Set_DText( dial, index, str, font, TE_CENTER ) ;
  Obj_Size( dial, index, x, y, w, h ) ;
  Obj_Draw( dial, index, index, x, y, w, h ) ;
END ;


PROCEDURE FindIndex( str : Str3 ; VAR Index1, Index2 : Integer ) ;
{With passed string set appropriate tree indices for use later on}
BEGIN
  CASE str[1] OF
    'A': BEGIN
           Index1 := PADRIVE ;
           Index2 := PANEXT ;
          END ;  
    'B': BEGIN
           Index1 := PBDRIVE ;
           Index2 := PBNEXT ;
          END ;  
    OTHERWISE : BEGIN
                  Index1 := PUDRIVE ;
                  Index2 := PUNEXT ;
                END ;
  END ;
END ;


PROCEDURE UpdateList( key : Integer ) ;
{The new drive ID letter is passed - this routine determines if it is}
{valid, then stores the letter, and corrects the dialog display as necessary}
VAR
    cont    : Boolean ;
    Index1,
    Index2  : Integer ;
    Drive   : Str3 ;
BEGIN
  cont := TRUE ;
  IF Length(PendingDrive)>0 THEN
    BEGIN
      FOR Index1 := 1 TO Length(PendingDrive) DO
        IF PendingDrive[Index1] = Chr( key ) THEN cont := FALSE ;
    END ;    
  IF (Length(PendingDrive) < 3) AND cont THEN
    BEGIN
      Drive[1] := Chr( key ) ;
      Drive[0] := Chr(1) ;
      PendingDrive := Concat( PendingDrive, Drive ) ;
      FindIndex( Drive, Index1, Index2 ) ;
      Set_DText( Prog_Dial, Index1, DRIVE, System_Font, TE_CENTER ) ;
      Obj_SetState( Prog_Dial, Index1, NORMAL, TRUE ) ;
      IF Length(PendingDrive) = 1 THEN
        DrawObject( Prog_Dial, Index2, Small_Font, 'NEXT SOURCE DRIVE' )
      ELSE IF (Drive[1]<'C') OR (PendingDrive[1]<'C') THEN
         DrawObject( Prog_dial, Index2, Small_Font, '  PENDING DRIVE  ' ) ;
    END ;
END ;           


FUNCTION AskDrive( VAR key : Integer ) : Boolean ;
{Ask for Drive letter routine - copying stops when routine started}
VAR i,
    x, BoxX,
    y, BoxY,
    w, BoxW,
    h, BoxH,
    button : Integer ;
    dial : Dialog_Ptr ;
BEGIN
  Find_Dialog( DRIVE, dial ) ;
  Center_Dialog( dial ) ;
  Obj_Size( dial, ROOT, x, y, w, h ) ;
  x := x - 5 ;
  y := y - 5 ;
  w := w + 10 ;
  h := h + 10 ;
  FOR i := ADRIVE TO PDRIVE DO
    BEGIN
      IF (ShR(DriveMap,(i-ADRIVE))&$0001) = 1 THEN
        BEGIN
          Obj_SetFlags( dial, i, SELECTABLE|EXIT_BTN ) ;
          Obj_SetState( dial, i, SHADOWED, FALSE ) ;
        END
      ELSE
        BEGIN
          Obj_SetFlags( dial, i, NONE ) ;
          Obj_SetState( dial, i, DISABLED|SHADOWED, FALSE ) ;
        END ;
    END ;
  Obj_SetState( dial, DRIVECAN, NORMAL, FALSE ) ;
  BoxX := PUx ;
  BoxY := PUy ;
  BoxW := PUw ;
  BoxH := PUh ;
  Grow_Box( BoxX, BoxY, BoxW, BoxH, x, y, w, h ) ;
  button := Do_Dialog( dial, 0 ) ;
  IF button <> DRIVECAN THEN
    BEGIN
      CASE button OF
        ADRIVE : BEGIN 
                   BoxX := PAx ;
                   BoxY := PAy ;
                   BoxW := PAw ;
                   BoxH := PAh ;
                 END ;
        BDRIVE : BEGIN           
                   BoxX := PBx ;
                   BoxY := PBy ;
                   BoxW := PBw ;
                   BoxH := PBh ;
                 END ;
      END ;           
      AskDrive := TRUE ;
      key := button - ADRIVE + Ord('A') ;
    END
  ELSE AskDrive := FALSE ;
  Obj_Draw( Prog_Dial, ROOT, max_depth, x, y, w, h ) ;
  Shrink_Box( x, y, w, h, BoxX, BoxY, BoxW, BoxH ) ;
END ;         


FUNCTION TEvent( ticks : Integer ) : Boolean ;
{Timer Event routine - waiting for button or keyboard events with fixed}
{timer set; dialog box displays are updated by this routine}
VAR
    done : Boolean ;
    what_key,
    event,
    mx,
    my : Integer ;
    msg : Message_Buffer ;
BEGIN
  done := FALSE ;
  event := Get_Event( E_KEYBOARD|E_TIMER|E_BUTTON,
                      1, 1, 1, ticks,
                      FALSE, 0, 0, 0, 0,
                      FALSE, 0, 0, 0, 0,
                      msg, what_key, dummy, dummy, mx, my, dummy ) ;
  IF event&E_KEYBOARD <> 0 THEN
    BEGIN
      IF what_key=$6100 THEN
        BEGIN
          done := TRUE ;
          Obj_SetState( Prog_Dial, PSTOPBTN, SELECTED, TRUE ) ;
        END
      ELSE
        BEGIN
          what_key := what_key & $00FF ;
          IF what_key>$60 THEN what_key := what_key - $20 ;
          IF ((what_key>$40) AND (what_key<$51)) OR (what_key=$3F) THEN
            CASE Chr(what_key) OF
              '?'       : IF AskDrive( mx ) THEN UpdateList( mx ) ;
              'A','B'   : UpdateList( what_key ) ;
              OTHERWISE : IF (ShR(DriveMap,(what_key-$41))&$0001)=1 THEN
                            UpdateList( what_Key ) ;
            END ;
        END ;
    END
  ELSE IF event&E_BUTTON <> 0 THEN
    BEGIN
      IF (mx>=PAx) AND (mx<=PAx+PAw) AND (my>PAy) AND (my<PAy+PAh) THEN
        UpdateList( Ord('A') )
      ELSE  IF (mx>=PUx) AND (mx<=PUx+PUw) AND (my>PUy) AND (my<PUy+PUh) THEN
        BEGIN
          IF AskDrive( what_key ) THEN UpdateList( what_key ) ;
        END  
      ELSE  IF (mx>=PBx) AND (mx<=PBx+PBw) AND (my>PBy) AND (my<PBy+PBh) THEN
        UpdateList( Ord('B') )
      ELSE  IF (mx>=StopX) AND (mx<=StopX+StopW) AND (my>StopY)
        AND (my<StopY+StopH) THEN
        BEGIN
          done := TRUE ;
          Obj_SetState( Prog_Dial, PSTOPBTN, SELECTED, TRUE ) ;
        END ;
    END ;
  TEvent := done ;
END ;                          


FUNCTION Chdir( VAR PPath : Path_Name; ShowError : Boolean ) : Boolean ;
{Change current default pathway }
VAR 
   errstr : Str255 ;
   CPath : C_Path_Type ;
   driveID,
   i : Integer ;
BEGIN
  driveID := Ord(PPath[1]) - Ord('A') ;
  IF ((ShR(Dsetdrv(driveID),driveID)&$0001)<>1) THEN
    BEGIN
      IF ShowError THEN IO_Error( -15 ) ;
      Chdir := FALSE ;
    END
  ELSE
    BEGIN    
      FOR i := 3 TO Length( PPath ) DO CPath[i-2] := PPath[i] ;
      CPath[i-2] := Chr(0) ;
      i := Dsetpath( CPath ) ;
      IF i=0 THEN Chdir := TRUE
      ELSE
        BEGIN
          IF ShowError THEN IO_Error( i ) ;
          Chdir := FALSE ;
        END ;
    END ;    
END ; 


FUNCTION SetSkip( VAR FileDisplay : Path_Name ) : Boolean ;
BEGIN   
  Obj_SetState( Prog_Dial, PFILENME, DISABLED, TRUE ) ;
  DrawObject( Prog_Dial, PFILENME, System_Font, FileDisplay ) ;
  SetSkip := TRUE ;
END ;  


FUNCTION Copy_Files( src_file, des_file: Path_Name ;
  VAR FileDisplay : Path_Name ) : Boolean ;
{ a generic routine to copy file }
{The success of the operation is returned}
VAR
  i,
  infile,                      { file handle for input file }
  outfile       : INTEGER ;    { file handle for output file }
  w_bytes,
  n_bytes       : Long_INTEGER ; { number of bytes for read/write }
  skip,
  cont,
  write_error   : BOOLEAN ;
  Fname         : Path_Name ;
  COutFile,
  CInFile       : C_Path_Type ;
  buf           : buf_type ;
  tbuf          : time_buf ;
  LocalDTA      : DTA ;
BEGIN
  IF src_file=des_file THEN
    BEGIN
      IO_Error( -37 ) ;
      Copy_Files := FALSE ;
    END
  ELSE
    BEGIN
      skip := FALSE ;   
      write_error := FALSE ;
      P_To_CPath(src_file, CInFile) ;      { convert to C string }
      REPEAT
        cont := FALSE ;
        infile := FOpen( CInFile, 0 ) ;      { open file to read }
        IF infile >= 0 THEN cont := TRUE
        ELSE
          BEGIN
            CASE Error_Choice( infile ) OF
              1 : skip := SetSkip( FileDisplay ) ;
              2 : ;
              3 : write_error := TRUE ;
            END ;
          END ;   
      UNTIL cont OR write_error OR skip ;  
      IF cont THEN
        BEGIN              { open success }
          P_To_CPath( des_file, COutFile ) ;
          REPEAT
            cont := FALSE ;
            outfile := FCreate( COutFile, 0 ) ; { open a file regardless }
            IF outfile >= 0 THEN cont := TRUE    {of its existence}
            ELSE
              BEGIN
                CASE Error_Choice( outfile ) OF
                  1 : skip := SetSkip( FileDisplay ) ;
                  2 : ;
                  3 : write_error := TRUE ;
                END ;
              END ;   
          UNTIL cont OR write_error OR skip ;  
          IF cont THEN
            BEGIN           { open success }
              REPEAT
                n_bytes := FRead( infile, chunk, buf ) ;
                IF n_bytes > 0 THEN
                  BEGIN        { we read something }
                    w_bytes := FWrite( outfile, n_bytes, buf ) ;
                    IF w_bytes <> n_bytes THEN
                      BEGIN
                        write_error := TRUE ;        { write error }
                        IF w_bytes < 0 THEN IO_Error( w_bytes )
                        ELSE IO_Error( -18 ) ;   {Presume it is a disk full}
                      END ;                      {error}
                  END { read }
                ELSE IF n_bytes < 0 THEN
                  BEGIN
                    CASE Error_Choice( n_bytes ) OF
                      1 : skip := SetSkip( FileDisplay ) ;
                      2 : BEGIN
                            FClose( outfile ) ;
                            REPEAT
                            cont := FALSE ;
                            outfile := FCreate( COutFile, 0 ) ;
                            IF outfile >= 0 THEN cont := TRUE
                            ELSE
                              BEGIN
                                CASE Error_Choice( outfile ) OF
                                  1 : skip := SetSkip( FileDisplay ) ;
                                  2 : ;
                                  3 : write_error := TRUE ;
                                END ;
                              END ;   
                            UNTIL cont OR write_error OR skip ;  
                            IF cont THEN
                              REPEAT
                                cont := FALSE ;
                                w_bytes := FSeek( 0, infile, 0 ) ;
                                IF w_bytes >= 0 THEN cont := TRUE
                                ELSE
                                  BEGIN
                                    CASE Error_Choice( w_bytes ) OF
                                      1 : skip := SetSkip( FileDisplay ) ;
                                      2 : ;
                                      3 : write_error := TRUE ;
                                    END ;
                                  END ;   
                              UNTIL cont OR write_error OR skip ;
                          END ;  
                      3 : write_error := TRUE ;
                    END ;
                    IF skip OR write_error THEN cont := FALSE ;
                  END ;
                IF cont AND (NOT write_error) AND (NOT skip) THEN
                  BEGIN
                    write_error := TEvent( 0 ) ;
                    cont := NOT write_error ;
                  END ;  
                IF NOT cont THEN
                  BEGIN
                    FClose( outfile ) ;
                    Strip_Filename( des_file, Fname ) ;
                    cont := Chdir( des_file, FALSE ) ;
                    IF cont THEN
                      BEGIN
                        P_To_CPath( Fname, CInFile ) ;
                        FDelete( CInFile ) ;
                      END ;
                  END ;
              UNTIL ((n_bytes = 0) OR write_error OR skip) ;
              IF (NOT write_error) AND (NOT skip) AND (cmp_opts[DEFCOPY]) THEN
                BEGIN
                  FDaTime( tbuf, infile, 0 ) ;
                  FClose( outfile ) ;
                  outfile := FOpen( COutFile, 2 ) ;
                  FDaTime( tbuf, outfile, 1 ) ;
                END ;  
              FClose( outfile ) ;
            END ;
          FClose( infile ) ;
        END ;
      IF (cmp_opts[ DEFCARRY ]) AND (NOT write_error) AND (NOT skip) THEN
        BEGIN
          SetDTA( LocalDTA ) ;
          Strip_Filename( src_file, Fname ) ;
          write_error := NOT Chdir( src_file, TRUE ) ;
          IF NOT write_error THEN
            BEGIN
              P_To_CPath( Fname, CInFile ) ;
              infile := SFirst( CInFile, $37 ) ;
            END ;
          IF (NOT write_error) AND (infile=0) THEN
            BEGIN
              Strip_Filename( des_file, Fname ) ;
              write_error := NOT Chdir( des_file, TRUE ) ;
              IF NOT write_error THEN
                BEGIN
                  P_To_CPath( Fname, COutFile ) ;
                  i := Chmod( COutFile, 1, LocalDTA.attrib ) ;
                  IF i < 0 THEN
                    BEGIN
                      IO_Error( i ) ;
                      write_error := TRUE ;
                    END ;
                END ;
            END ;
        END ;    
      IF skip THEN Copy_Files := TRUE
      ELSE Copy_Files := NOT write_error ;
    END ;  
END ;



PROCEDURE Read_Options( Fname : Path_name ; ShowError : Boolean ) ;
{ read options from the .INF file }
VAR
  f : text ;
  temp : integer ;
  opt : opt_range ;
BEGIN
  IO_Check( false ) ;
  reset( f, Fname ) ;
  IO_Check( TRUE ) ;
  temp := IO_Result ;
  IF temp = 0 THEN
    BEGIN
      FOR opt := 1 TO max_option DO
        IF opt IN [ DEFADD, DEFREP, DEFONAFT, DEFNOSYS,
                    DEFCARRY, DEFCOPY, MCONFIRM, MCHIMES ] THEN
          BEGIN
            readln( f, temp ) ;
            cmp_opts[ opt ] := temp <> 0 ;
          END ;
      readln( f, src_path ) ;
      readln( f, des_path ) ;
      readln( f, OnAfterDate ) ;
      close( f ) ;
      Menu_Check( menu, MCONFIRM, cmp_opts[ MCONFIRM ] ) ;
      Menu_Check( menu, MCHIMES, cmp_opts[ MCHIMES ] ) ;
    END
  ELSE IF ShowError THEN IO_Error( temp ) ;
END ;


PROCEDURE Load_Options ;
{Load new option file from path given}
VAR
  NewPath,
  NewFile : Path_Name ;
  continue : Boolean ;
BEGIN
  Info_Msg('Load file name?') ;
  NewFile := 'FRUTILTY.INF' ;
  NewPath := Concat( def_path, '*.INF' ) ;
  continue := Get_In_File( NewPath, NewFile ) ;
  EraseInfo ;
  IF continue AND (length(NewFile) <> 0) THEN
    BEGIN
      NewPath := NewFile ;
      Strip_Filename( NewPath, NewFile ) ;
      continue := Chdir( NewPath, TRUE ) ;
      IF continue THEN
        BEGIN
          Read_Options( NewFile, TRUE ) ;
          continue := Chdir( def_path, FALSE ) ;
        END ;  
    END ;
END ;
        

PROCEDURE Save_Options ;
{ sace options to the .INF file }
VAR
  NewPath,
  NewFile : Path_Name ;
  f : text ;
  opt : opt_range ;
  continue : Boolean ;
BEGIN
  Info_Msg('Save file name?') ;
  NewFile := 'FRUTILTY.INF' ;
  NewPath := Concat( def_path, '*.INF' ) ;
  continue := Get_In_File( NewPath, NewFile ) ;
  EraseInfo ;
  IF continue AND (length(NewFile) <> 0) THEN
    BEGIN
      NewPath := NewFile ;
      Strip_Filename( NewPath, NewFile ) ;
      continue := Chdir( NewPath, TRUE ) ;
     IF continue THEN
        BEGIN
          IO_Check( false ) ;
          rewrite( f, NewFile ) ;
          IO_Check( TRUE ) ;
          IF (IO_Result <> 0) THEN IO_Error( IO_Result )
          ELSE
            BEGIN
              Set_Mouse( M_BEE ) ;   
              FOR opt := 1 TO max_option DO
                IF opt IN [ DEFADD, DEFREP, DEFONAFT, DEFNOSYS,
                  DEFCARRY, DEFCOPY, MCONFIRM, MCHIMES ]
                 THEN writeln( f, ord( cmp_opts[opt] ):1 ) ;
              writeln( f, src_path ) ;
              writeln( f, des_path ) ;
              writeln( f, OnAfterDate ) ;
              close( f ) ;
              Set_Mouse( M_ARROW ) ;
            END ;
          continue := Chdir( def_path, FALSE ) ;  
        END
    END        
END ;


PROCEDURE Capitalize( VAR path : Path_Name ) ;
{Captialize a given Pathway Name for aesthetics}
VAR
   i : Integer ;
BEGIN
  i := 0 ;
  WHILE i<Length(path) DO
    BEGIN
      i := i + 1 ;
      IF path[i] IN ['a'..'z'] THEN path[i] := Chr( Ord(path[i])-$20 ) ;
    END ;
END ; 


PROCEDURE FixPaths( VAR src_path, des_path, fname : Path_Name ) ;
BEGIN
  Strip_Filename( src_path, fname ) ;
  IF src_path<>'' THEN
    BEGIN
      IF Length(src_path)<3 THEN src_path := ''
      ELSE IF src_path[2]=':' THEN Delete( src_path, 1, 2 ) ;
    END ;
  IF fname='' THEN fname := '*.*' ;
  IF src_path='' THEN src_path := '\' ;
  src_path := Concat( src_path, fname ) ;
  IF src_path[1]<>'\' THEN src_path := Concat( '\', src_path ) ;
  Capitalize( src_path ) ;
  Strip_Filename( des_path, fname ) ;
  IF Length(des_path)<2 THEN des_path := ''
  ELSE IF des_path[2]<>':' THEN des_path := '' ;
  IF Length(des_path)=2 THEN des_path := Concat( des_path, '\' ) ;
  IF Length(fname)>0 THEN des_path := Concat( des_path, fname, '\' ) ;
  Capitalize( des_path ) ;
END ;


PROCEDURE Set_Definitions ;
{Display definitions dialog box, and set accordingly}
VAR
  bigX,
  bigY,
  bigW,
  bigH : Integer ;
  dial : Dialog_Ptr ;
  button : integer ;
  opt : opt_range ;
  NewPath,
  NewFile,
  fname : Path_Name ;
BEGIN
  Find_Dialog( DEFINITN, dial ) ;
  Center_Dialog( dial ) ;
  Obj_Size( dial, ROOT, bigX, bigY, bigW, bigH ) ;
  FOR opt := 1 TO max_option DO
    IF opt IN [ DEFADD, DEFREP, DEFONAFT, DEFNOSYS, DEFCARRY, DEFCOPY ] THEN
      Obj_SetState( dial, opt, SHADOWED, FALSE ) ;
  FOR opt := 1 TO max_option DO
    IF opt IN [ DEFADD, DEFREP, DEFONAFT, DEFNOSYS, DEFCARRY, DEFCOPY ] THEN
      IF cmp_opts[ opt ] THEN Obj_SetState( dial, opt,
        SELECTED|SHADOWED, FALSE ) ;
  Set_DText( dial, DEFSOURC, src_path, System_Font, TE_LEFT ) ;
  Set_DText( dial, DEFDEST, des_path, System_Font, TE_LEFT ) ;
  Set_DText( dial, DEFONAFT, OnAfterDate, System_Font, TE_LEFT ) ;
  IF OnAfterDate='' THEN
    BEGIN
      Obj_SetState( dial, DEFONAFT, SHADOWED, FALSE ) ;
    END ;
  Grow_Box( 19*8, 0, 7*8, rez*8, bigX, bigY, bigW, bigH ) ;
  button := Do_Dialog( dial, DEFDEST ) ;
  WHILE (button<>DEFOKAY) and (button<>DEFCANC) DO
    BEGIN
      End_Dialog( dial ) ;
      Obj_SetState( dial, button, NORMAL, FALSE ) ;
      IF button=SOURCE THEN
        BEGIN
          button := DEFSOURC ;
          Info_Msg( 'Source path?' ) ;
          Get_DEdit( dial, DEFSOURC, temp_path ) ;
          NewPath := temp_path ;
          Strip_Filename( NewPath, NewFile ) ;
        END  
      ELSE 
        BEGIN
          button := DEFDEST ;
          Info_Msg( 'Destination?') ;
          Get_DEdit( dial, DEFDEST, temp_path ) ;
          NewPath := temp_path ;
          NewFile := '' ;
        END ;
      IF Get_In_File( NewPath, NewFile ) THEN
        BEGIN
          Strip_Filename( NewPath, fname ) ;
          FixPaths( NewFile, NewPath, fname ) ;
          IF button = DEFSOURC THEN 
            Set_DText( dial, DEFSOURC, NewFile, System_Font, TE_LEFT )
          ELSE Set_DText( dial, DEFDEST, NewPath, System_Font, TE_LEFT ) ;
        END ;  
      EraseInfo ;
      button := Do_Dialog( dial, button ) ;
    END ;  
  End_Dialog( dial ) ;
  Shrink_Box( bigX, bigY, bigW, bigH, 19*8, 0, 7*8, rez*8 ) ;
  Obj_SetState( dial, button, NORMAL, FALSE ) ;
  IF button = DEFOKAY THEN
    BEGIN
      FOR opt := 1 TO max_option DO
        IF opt IN [ DEFADD, DEFREP, DEFONAFT, DEFNOSYS, DEFCARRY, DEFCOPY] THEN
          cmp_opts[ opt ] := Obj_State( dial, opt )=SELECTED|SHADOWED ;
      Get_DEdit( dial, DEFSOURC, temp_path ) ;
      src_path := temp_path ;
      Get_DEdit( dial, DEFDEST, temp_path ) ;
      des_path := temp_path ;
      FixPaths( src_path, des_path, fname ) ;
      Get_DEdit( dial, DEFONAFT, temp_path ) ;
      IF Length(temp_path)<6 THEN temp_path := '' ;
      IF temp_path='' THEN cmp_opts[ DEFONAFT ] := FALSE ;
      OnAfterDate := temp_path ;
    END ;
END ;


PROCEDURE DisplayPath( str : Str255 ) ;
{Will diaply current restore path in PROGRESS dialog box}
BEGIN
  IF Length(str)>40 THEN Delete( str, 1, (Length(str)-40) ) ;
  DrawObject( Prog_Dial, PPATH, System_Font, str ) ;
END ;


FUNCTION CreateFolder( ToPath : Path_name ; Cname : C_Path_Type ) : Boolean ;
{Create folder in designated device if folder does not already exist}
VAR
   LocalDTA  : DTA ;
   i : Integer ;
   cont : Boolean ;
BEGIN   
  SetDTA( LocalDTA ) ;
  cont := Chdir( ToPath, TRUE ) ;
  IF cont THEN
    BEGIN
      i := SFirst( Cname, $37 ) ;
      IF i<>0 THEN
        BEGIN
          i := Mkdir( Cname ) ;
          IF i<>0 THEN
            BEGIN
              IO_Error( i ) ;
              cont := FALSE ;
            END ;
         END
      ELSE IF LocalDTA.attrib<>$10 THEN
        BEGIN
          IO_Error( -31 ) ;
          cont := FALSE ;
        END ;
    END ;
  CreateFolder := cont ;
END ;    


FUNCTION MoveFiles( VAR FromPath, ToPath, Fname : Path_Name ) : Boolean ;
{Move Files, or rather, copy directory routine... This routine searches}
{through each folder, calling itself recursively to copy all files as}
{defined by DEFINITN's dialog box}
VAR
    fhandle,
    MoreFiles,
    i             : Integer ;
    From_DTA,
    To_DTA        : DTA ;
    Cname         : C_Path_Type ;
    okay,
    cont          : Boolean ;
    ext,
    FileDisplay,
    CopyFrom,
    CopyTo,
    Folder        : Path_Name ;
    tbuf          : time_buf ;
BEGIN
  DisplayPath( ToPath ) ;
  cont := Chdir( FromPath, TRUE ) ;
  P_To_CPath( Fname, Cname ) ;
  SetDTA( From_DTA ) ;
  MoreFiles := SFirst( Cname, $37 ) ;
  IF cont THEN cont := NOT TEvent( 0 ) ;
  WHILE (MoreFiles=0) AND cont DO
    BEGIN
      IF (From_DTA.attrib=$10) THEN
        BEGIN
          IF (From_DTA.name[1]<>'.') AND (Fname='*.*') THEN
            BEGIN
              cont := CreateFolder( ToPath, From_DTA.name ) ;
              IF cont THEN
                BEGIN
                  C_To_PPath( From_DTA.name, Folder ) ;
                  FromPath := Concat( FromPath, Folder, '\' ) ;
                  ToPath := Concat( ToPath, Folder, '\' ) ;
                  cont := MoveFiles( FromPath, ToPath, Fname ) ;
                END ;
              IF cont THEN
                BEGIN
                  FromPath[0] := Chr( Ord(FromPath[0])-1 ) ;
                  Strip_Filename( FromPath, Folder ) ;
                  cont := Chdir( FromPath, TRUE ) ;
                  ToPath[0] := Chr( Ord(ToPath[0])-1 ) ;
                  Strip_Filename( ToPath, Folder ) ;
                  DisplayPath( ToPath ) ;
                END ;
            END ;
        END    
      ELSE
        BEGIN
          C_To_PPath( From_DTA.name, Folder ) ;
          SetupFname( Folder, FileDisplay ) ;
          okay := TRUE ;
          IF cmp_opts[ DEFADD ] THEN
            BEGIN
              SetDTA( To_DTA ) ;
              cont := Chdir( ToPath, TRUE ) ;
              IF cont THEN
                BEGIN
                  IF SFirst(From_DTA.name, $37)=0 THEN
                    BEGIN
                      okay := FALSE ;
                      Obj_SetState( Prog_Dial, PFILENME, DISABLED, TRUE ) ;
                      DrawObject( Prog_Dial, PFILENME, System_Font, FileDisplay ) ;
                    END ;
                END ;
              SetDTA( From_DTA ) ;
              IF cont THEN cont := Chdir( FromPath, TRUE ) ;
            END ;
          IF (cmp_opts[ DEFNOSYS ]) AND okay AND cont THEN
            BEGIN
              Strip_Extension( Folder, ext ) ;
              Capitalize( ext ) ;
              IF (ext = 'SYS') OR ((From_DTA.attrib&$04)=$04) THEN
                BEGIN
                  okay := FALSE ;
                  Obj_SetState( Prog_Dial, PFILENME, DISABLED, TRUE ) ;
                  DrawObject( Prog_Dial, PFILENME, System_Font, FileDisplay ) ;
                END ;
            END ;
          IF (cmp_opts[ DEFONAFT ]) AND okay AND cont THEN
            BEGIN
              fhandle := FOpen( From_DTA.name, 0 ) ;
              IF fhandle < 0 THEN
                BEGIN
                  IO_Error( fhandle ) ;
                  cont := FALSE ;
                END
              ELSE FDaTime( tbuf, fhandle, 0 ) ;
              FClose( fhandle ) ;
              IF cont THEN
                BEGIN
                  IF tbuf[2] < Date THEN
                    BEGIN
                      okay := FALSE ;
                      Obj_SetState( Prog_Dial, PFILENME, DISABLED, TRUE ) ;
                      DrawObject( Prog_Dial, PFILENME, System_Font, FileDisplay ) ;
                    END ;
                END ;    
            END ;          
          IF okay AND cont THEN
            BEGIN
              Obj_SetState( Prog_Dial, PFILENME, NORMAL, TRUE ) ;
              DrawObject( Prog_Dial, PFILENME, System_Font, FileDisplay ) ;
              CopyFrom := Concat( FromPath, Folder ) ;
              CopyTo := Concat( ToPath, Folder ) ;
              cont := Copy_Files( CopyFrom, CopyTo, FileDisplay ) ;
            END ;
        END ;
      IF cont THEN cont := Chdir( FromPath, TRUE ) ;
      IF cont THEN
        BEGIN
          SetDTA( From_DTA ) ; 
          MoreFiles := SNext ;
          cont := NOT TEvent( 0 ) ;
        END ;
    END ;
  MoveFiles := cont ;  
END ;


FUNCTION AskBefore( VAR ActiveDrive : Str3 ) : Integer ;
VAR  index,
     x, y, w, h : Integer ;
BEGIN
  CASE ActiveDrive[1] OF
    'A' : index := PABOX ;
    'B' : index := PBBOX ;
    OTHERWISE : index := PUBOX ;
  END ;
  Obj_Size( Prog_Dial, index, x, y, w, h ) ;
  temp_path := '[2][ |Do you wish to continue the|' ;
  temp_path := Concat( temp_path, 'RESTORE from drive "', ActiveDrive ) ;
  temp_path := Concat( temp_path, '"?][OKAY|SKIP|CANCEL]' ) ;
  Grow_Box( x, y, w, h, 21*8, 9*8*rez, 38*8, 8*8*rez ) ;
  index := Do_Alert( temp_path, 1 ) ;
  CASE index OF
    1 : Obj_Size( Prog_Dial, PACTBOX, x, y, w, h ) ;
    2 : ;
    3 : Obj_Size( Prog_Dial, ROOT, x, y, w, h ) ;
  END ;
  IF index = 3 THEN Grow_Box( 21*8, 9*8*rez, 38*8, 8*8*rez, x, y, w, h )
  ELSE Shrink_Box( 21*8, 9*8*rez, 38*8, 8*8*rez, x, y, w, h ) ;
  AskBefore := index ;
END ;               
                                        
              

{$P-}    

PROCEDURE Restore ;
{The actual restore dialog box routine, that set's up the dialog box}
{and starts to MoveFiles recursive routine}
VAR DriveID,
    year,
    month,
    day,
    i,
    bigX,
    bigY,
    bigW,
    bigH,
    choice,
    Index1,
    Index2      : Integer ;
    BeginningCheck,
    okay,
    done        : Boolean ;
    SubString,
    NextDrive,
    ActiveDrive : Str3 ;
    Fname,
    ToPath,
    SendPath    : Path_Name ;
    Cname       : C_Path_Type ;
BEGIN
  DriveID := Dgetdrv ;
  DriveMap := Dsetdrv( DriveID ) ;  {get current drive map}
  Find_Dialog( PROGRESS, Prog_Dial ) ;
  Center_Dialog( Prog_Dial ) ;
  Obj_Size( Prog_Dial, ROOT, bigX, bigY, bigW, bigH ) ;
  IF rez = 1 THEN Prog_Dial^[0].ob_spec := $21143
  ELSE Prog_Dial^[0].ob_spec := $21123 ;
  bigX := bigX - 5 ;
  bigY := bigY - 5 ;
  bigW := bigW + 10 ;
  bigH := bigH + 10 ;
  Obj_Size( Prog_Dial, PABOX, PAx, PAy, PAw, PAh ) ;
  Obj_Size( Prog_Dial, PBBOX, PBx, PBy, PBw, PBh ) ;
  Obj_Size( Prog_Dial, PUBOX, PUx, PUy, PUw, PUh ) ;
  Obj_Size( Prog_Dial, PSTOPBTN, StopX, StopY, StopW, StopH ) ;
  Set_Dtext( Prog_Dial, PUDRIVE, '?', System_Font, TE_CENTER ) ;
  Set_Dtext( Prog_Dial, PANEXT, ' DRIVE NOT READY ', Small_Font, TE_CENTER ) ;
  Set_Dtext( Prog_Dial, PUNEXT, ' DRIVE NOT READY ', Small_Font, TE_CENTER ) ;
  Set_Dtext( Prog_Dial, PBNEXT, ' DRIVE NOT READY ', Small_Font, TE_CENTER ) ;
  Set_Dtext( Prog_Dial, PACTIVE, '-', System_Font, TE_CENTER ) ;
  Set_DText( Prog_Dial, PPATH, '', System_Font, TE_CENTER ) ;
  Set_DText( Prog_Dial, PFILENME, '', System_Font, TE_CENTER ) ;
  Obj_SetState( Prog_Dial, PADRIVE, DISABLED, FALSE ) ;
  Obj_SetState( Prog_Dial, PUDRIVE, DISABLED, FALSE ) ;
  Obj_SetState( Prog_Dial, PBDRIVE, DISABLED, FALSE ) ;
  Obj_SetState( Prog_Dial, PSTOPBTN, NORMAL, FALSE ) ;
  PendingDrive := '' ;
  IF cmp_opts[ DEFONAFT ] THEN
    BEGIN
      SubString := Copy( OnAfterDate, 1, 2 ) ;
      ReadV( SubString, month ) ;
      SubString := Copy( OnAfterDate, 3, 2 ) ;
      ReadV( SubString, day ) ;
      SubString := Copy( OnAfterDate, 5, 2 ) ;
      ReadV( SubString, year ) ;
      year := year - 80 ;
      Date := ShL(year,9)|ShL(month,5)|day ;
    END ;      
  WHILE bconstat( console ) DO bconin( console ) ;
  choice := 1 ;
  Grow_Box( 9*8, 0, 8*8, rez*8, bigX, bigY, bigW, bigH ) ;
  Show_Dialog( Prog_Dial, ROOT ) ;
  IF Length( des_path ) < 3 THEN
    BEGIN
      done := TRUE ;
      IO_Error( -37 ) ;
    END
  ELSE done := FALSE ;
  BeginningCheck := TRUE ;
  WHILE NOT done DO
    BEGIN
      IF PendingDrive='' THEN done := TEvent( 750 ) ;
      IF NOT done THEN
        BEGIN
          IF PendingDrive='' THEN
            BEGIN
              IF cmp_opts[ MCHIMES ] THEN bconout( console, bell ) ;
            END  
          ELSE
            BEGIN
              IF BeginningCheck THEN
                BEGIN
                  BeginningCheck := FALSE ;
                  ToPath := Copy( des_path, 1, 3 ) ;
                  Index1 := Length( des_path ) ;
                  IF Index1 > 3 THEN
                    BEGIN
                      i := 3 ;
                      WHILE (NOT done) AND (i<Index1) DO
                        BEGIN
                          SendPath := '' ;
                          i := i + 1 ;
                          REPEAT
                            SendPath := Concat( SendPath, des_path[i] ) ;
                            i := i + 1 ;
                          UNTIL (des_path[i]='\') OR (i>Index1) ;
                          P_To_CPath( SendPath, Cname ) ;
                          done := NOT CreateFolder( ToPath, Cname ) ;
                          IF NOT done THEN
                            ToPath := Concat( ToPath, SendPath, '\' ) ;
                        END ;
                    END ;
                END ;
              IF NOT done THEN
                BEGIN            
                  ActiveDrive[1] := PendingDrive[1] ;
                  ActiveDrive[0] := Chr(1) ;
                  Delete( PendingDrive, 1, 1 ) ;
                  IF cmp_opts[ MCONFIRM ] THEN choice := AskBefore( ActiveDrive )
                  ELSE choice := 1 ;
                  FindIndex( ActiveDrive, Index1, Index2 ) ;
                  IF Index1=PUDRIVE THEN
                    BEGIN
                      okay := TRUE ;
                      i := 0 ;
                      WHILE (i<Length(PendingDrive)) AND okay DO
                        BEGIN
                          i := i + 1 ;
                          IF PendingDrive[i] > 'B' THEN okay := FALSE ;
                        END ;  
                      IF okay THEN
                        BEGIN
                          Set_DText( Prog_Dial, Index1, '?', System_Font,
                            TE_CENTER ) ;
                          Obj_SetState( Prog_Dial, Index1, DISABLED, TRUE ) ;
                          DrawObject( Prog_Dial, Index2, Small_Font,
                            ' DRIVE NOT READY ' ) ;
                        END    
                      ELSE
                        BEGIN
                          NextDrive[1] := PendingDrive[i] ;
                          NextDrive[0] := Chr(1) ;
                          DrawObject( Prog_Dial, PUDRIVE, System_Font,
                            NextDrive ) ;
                          IF i>1 THEN DrawObject( Prog_Dial, PUNEXT, Small_Font,
                            '  Pending Drive  ' ) ;
                        END ;
                    END
                  ELSE 
                    BEGIN
                      Obj_SetState( Prog_Dial, Index1, DISABLED, TRUE ) ;
                      DrawObject( Prog_Dial, Index2, Small_Font,
                        ' DRIVE NOT READY ' ) ;
                    END ;    
                  IF Length(PendingDrive)>0 THEN
                    BEGIN
                      FindIndex( PendingDrive, Index1, Index2 ) ;
                      DrawObject( Prog_Dial, Index2, Small_Font,
                        'NEXT SOURCE DRIVE' ) ;
                    END ;
                END ;
              IF choice = 3 THEN done := TRUE
              ELSE IF (choice = 1) AND (NOT done) THEN
                BEGIN      
                  DrawObject( Prog_Dial, PACTIVE, System_Font, ActiveDrive ) ;
                  SendPath := Concat( ActiveDrive, ':', src_path ) ;
                  Strip_Filename( SendPath, Fname ) ;
                  done := NOT Chdir( SendPath, TRUE ) ;
                  IF done THEN done := FALSE
                  ELSE
                    BEGIN
                      ToPath := des_path ;
                      done := NOT MoveFiles( SendPath, ToPath, Fname ) ;
                    END ;
                  DrawObject( Prog_Dial, PACTIVE, System_Font, '-' ) ;
                  DrawObject( Prog_Dial, PPATH, System_Font, '' ) ;
                  Obj_SetState( Prog_Dial, PFILENME, NORMAL, FALSE ) ;
                  DrawObject( Prog_Dial, PFILENME, System_Font, '' ) ;
                END ;
            END ;    
        END ;
    END ;
  done := Chdir( def_path, FALSE ) ;
  End_Dialog( Prog_Dial ) ;
  Shrink_Box( bigX, bigY, bigW, bigH, 9*8, 0, 8*8, rez*8 ) ;
END ;

{$P=}

PROCEDURE Chimes ;
{This routine aill ask whether you want to hear the reminding chimes}
VAR readjust,
    choice : Integer ;
BEGIN
  IF cmp_opts[ MCHIMES ] THEN readjust := 0
  ELSE readjust := 1 ;
  Grow_Box( 19*8, 0, 7*8, rez*8, (22+readjust)*8, 9*8*rez,
    (34-readjust)*8, 8*8*rez ) ;
  IF cmp_opts[ MCHIMES ] THEN
    BEGIN
      temp_path := '[2][ |Do you wish to DISABLE|the warning chimes?][ Yes | No ]' ;
      choice := Do_Alert( temp_path, 1 ) ;
      IF choice = 1 THEN
        BEGIN
          cmp_opts[ MCHIMES] := FALSE ;
          Menu_Check( menu, MCHIMES, FALSE ) ;
        END ;  
    END
  ELSE
    BEGIN
      temp_path := '[2][ |Do you wish to ENABLE|the warning chimes?][ Yes | No ]' ;
      choice := Do_Alert( temp_path, 1 ) ;
      IF choice = 1 THEN
        BEGIN
          cmp_opts[ MCHIMES] := TRUE ;
          Menu_Check( menu, MCHIMES, TRUE ) ;
        END ;  
    END ;
  Shrink_Box( (22+readjust)*8, 9*8*rez, (34-readjust)*8, 8*8*rez,
    19*8, 0, 7*8, rez*8 ) ;
END ;    
                     

FUNCTION Do_Menu( title, item : integer ) : boolean ;
VAR
   done : boolean ;
BEGIN
  done := false ;
  Wind_Update( BEG_Mctrl ) ; {After the menu selection, stop other menus}
  CASE item OF               {from popping down and ruining our screen!}
    MINFO     : ShowInfo( CONTINFO, NOHIDE );
    MCONFIRM  : BEGIN
                  cmp_opts[ MCONFIRM ] := NOT cmp_opts[ MCONFIRM ] ;
                  Menu_Check( menu, MCONFIRM, cmp_opts[ MCONFIRM ] ) ;
                  IF cmp_opts[ MCONFIRM ] THEN bconout( console, bell ) ;
                END ;  
    MCHIMES   : Chimes ;
    MSAVE     : Save_Options ;
    MLOAD     : Load_Options ;
    MDEF      : Set_Definitions ;
    MRESTORE  : Restore ;
    MQUIT     : done := TRUE ;
  END ;
  Menu_Normal( menu, title ) ;
  Do_Menu := done ;
  Wind_Update( END_Mctrl ) ;
END ;


  {The next set of routines mimics menu selections with keyboard presses}    
PROCEDURE PrepChimes ;
BEGIN
  Menu_Hilight( menu, MOPTIONS ) ;
  Chimes ;
  Menu_Normal( menu, MOPTIONS ) ;
END ;  

PROCEDURE PrepConfirm ;
BEGIN
  IF NOT cmp_opts[ MCONFIRM ] THEN bconout( console, bell ) ;
  Menu_Hilight( menu, MOPTIONS ) ;
  cmp_opts[ MCONFIRM ] := NOT cmp_opts[ MCONFIRM ] ;
  Menu_Check( menu, MCONFIRM, cmp_opts[ MCONFIRM ] ) ;
  Menu_Normal( menu, MOPTIONS ) ;
END ;  

PROCEDURE PrepDefinitions;
BEGIN
  Menu_Hilight( menu, MOPTIONS ) ;
  Set_Definitions ;
  Menu_Normal( menu, MOPTIONS ) ;
END ;  

PROCEDURE PrepLoad ;
BEGIN
  Menu_Hilight( menu, MOPTIONS ) ;
  Load_Options ;
  Menu_Normal( menu, MOPTIONS ) ;
END ;  

PROCEDURE PrepRestore ;
BEGIN
  Menu_Hilight( menu, MCOMMAND ) ;
  Restore ;
  Menu_Normal( menu, MCOMMAND ) ;
END ;  

PROCEDURE PrepSave ;
BEGIN
  Menu_Hilight( menu, MOPTIONS ) ;
  Save_Options ;
  Menu_Normal( menu, MOPTIONS ) ;
END ;  


PROCEDURE Event_Loop ;
{The main Event Loop routine, handling menu requests and keyboard presses}
VAR
  what_key,
  which : integer ;
  done : boolean ;
  msg : Message_Buffer ;
BEGIN
  done := FALSE ;
  REPEAT
    which := Get_Event( E_keyboard|E_Message, 0, 0, 0, 0,
                false, 0, 0, 0, 0, false, 0, 0, 0, 0,
                msg, what_key, dummy, dummy, dummy, dummy, dummy ) ;
    IF which & E_Message <> 0 THEN
      BEGIN
       IF msg[0]=MN_Selected THEN done := Do_Menu( msg[3], msg[4] ) ;
      END 
    ELSE IF which & E_Keyboard <> 0 THEN
      BEGIN
        Wind_Update( Beg_Mctrl ) ;
        IF what_key = $6100 THEN done := TRUE
        ELSE IF (what_key = $2E03) OR (what_key = $2E00) THEN PrepConfirm
        ELSE IF (what_key = $2004) OR (what_key = $2000) THEN PrepDefinitions  
        ELSE IF (what_key = $260C) OR (what_key = $2600) THEN PrepLoad  
        ELSE IF (what_key = $1312) OR (what_key = $1300) THEN PrepRestore
        ELSE IF (what_key = $1F13) OR (what_key = $1F00) THEN PrepSave
        ELSE IF (what_key = $1117) OR (what_key = $1100) THEN PrepChimes ;
        Wind_Update( End_Mctrl ) ;
      END ;    
  UNTIL done ;
  Grow_Box( 9*8, 0, 8*8, rez*8, ScreenX, ScreenY, ScreenW, ScreenH ) ;
END ;


FUNCTION Low_Resolution : boolean ;
BEGIN
  rez := get_rez ;                { need to remember screen resolution }
  Low_Resolution := (rez = 0) ;
END ;


{ main }
BEGIN
  IF Init_Gem <> -1 THEN
    BEGIN
      IF NOT Load_Resource( 'frutilty.rsc' ) THEN
        dummy := Do_Alert( '[3][ |FRUTILTY.RSC not found!][ SORRY! ]', 0 )
      ELSE IF Low_Resolution THEN
        BEGIN
          temp_path := '[3][ |You must use medium or|high resolution to use|';
          temp_path := ConCat(temp_path, 'the File Restore Utility!][ Cancel ]');
          dummy := Do_Alert(temp_path, 0);
        END
      ELSE
        BEGIN
          Set_Defaults ;
          OldDTA_Ptr := GetDTA ;  {save old DTA pointer, to reset later on}
          Find_Menu( FRMENU, menu ) ;
          Read_Options( 'FRUTILTY.INF', FALSE ) ;
          Draw_Menu( menu ) ;
          Init_Mouse ;
          ShowInfo( BEGINFO, HIDE ) ;
          Event_Loop ;
          Erase_Menu( menu ) ;
          ResetDTA( OldDTA_Ptr ) ;
        END ;
      Exit_Gem ;
    END ;
END .