home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / turbopas / sfmsrc.arc / SFM.PAS next >
Pascal/Delphi Source File  |  1987-06-26  |  9KB  |  328 lines
  1. {                       Super File Manager
  2.  
  3.                         by David Steiner
  4.                            2035 J Apt. 6
  5.                            Lincoln, NE
  6.  
  7.                              SFM.PAS
  8. }
  9.  
  10. {$C-}  { Don't allow user breaks, speeds up screen. }
  11.  
  12. {$K-}  { Don't watch for heap/stack collisions, saves code space. }
  13.        {   Besides, we already watch for this ourselves.          }
  14.  
  15.  
  16. {$I sfmVARS.inc  }
  17. {$I sfmOTHER.inc }
  18. {$I sfmSCRN.inc  }
  19. {$I sfmDOS.inc   }
  20. {$I sfmFUNC.inc  }
  21.  
  22.  
  23. procedure InitVars;
  24. var
  25.   Regs : reg_T;
  26.   i    : integer;
  27. begin
  28.   Mark( HeapStart );
  29.  
  30.   Regs.AH := $30;              { DOS function $30 - Get DOS Version Number }
  31.   MsDos( Regs );
  32.   if Regs.AX = 0 then
  33.     AbortProgram( 'InitVars :',
  34.                   '',
  35.                   '   SFM does not support DOS versions prior to 2.0.',
  36.                   ''
  37.                 );
  38.  
  39.   ShowAll       := false;
  40.   HelpScreen[1] := false;
  41.   HelpScreen[2] := true;
  42.  
  43.   for i := 1 to 2 do
  44.   begin
  45.     Loaded[i]   := false;
  46.     Mask[i]     := '*.*';
  47.     ConvMask[i] := '???????????';
  48.   end;
  49.  
  50.   SavedPath := '.';
  51.   Drive[1] := GetCurDrive;
  52.   if not (GetCurDir( Drive[1], Path[1] ) = 0) then
  53.     Path[1] := char(64 + Drive[1]) + ':\';
  54.   SavedPath := Path[1];
  55.   DiskFree[1] := FreeDisk( Drive[1] );
  56.   LoadDir( 1 );
  57.   if not loaded[1] then
  58.     AbortProgram( 'InitVars : ',
  59.                   '',
  60.                   '   Couldn''t load current directory.',
  61.                   ''
  62.                  );
  63. end;
  64.  
  65.  
  66. function GoMenu2( w : integer ) : integer;
  67. begin
  68.   Wind( 3 );
  69.   clrscr;
  70.   writeln;
  71.   Disp( NATTR, ' Loading FAT for ' );
  72.   Disp( HATTR, copy( Path[w], 1, 2 ) );
  73.   writeln;
  74.   if ChangeCurDir( Path[w] ) <> 0 then
  75.     GoMenu2 := 1
  76.   else
  77.   begin
  78.     WriteScreen;
  79.     Menu2Window( w );
  80.     ShowAll := true;
  81.     fillchar( Marked[w], sizeof(MarkedArr_T), 0 );
  82.     LoadDir( w );                     { Reload dir and FAT just to make }
  83.     LoadFAT( DiskTable[w], FATptr );  {   sure it is current.           }
  84.     FATsaved := true;
  85.     GoMenu2 := 2;
  86.   end;
  87. end;
  88.  
  89.  
  90. function GoMenu1( w : integer ) : integer;
  91. var
  92.   menu : integer;
  93. begin
  94.   Wind( 3 );
  95.   clrscr;
  96.   writeln;
  97.   menu := 2;
  98.   if (Saved[w] and FATsaved) or NoSave[w] then
  99.     menu := 1
  100.   else
  101.   begin
  102.     Disp( NATTR, ' Directory was changed, exit without saving' );
  103.     if YorN( false ) then menu := 1;
  104.   end;
  105.   if menu = 1 then
  106.   begin
  107.     WriteScreen;
  108.     ShowAll := false;
  109.     HelpScreen[3-w] := true;
  110.     HelpWindow( w, 3-w );
  111.     if Saved[w] and FATsaved then
  112.       HomeKey( w )
  113.     else
  114.     begin
  115.       DiskFree[w] := FreeDisk( Drive[w] );
  116.       LoadDir( w );
  117.     end;
  118.   end;
  119.   GoMenu1 := menu;
  120. end;
  121.  
  122.  
  123. const
  124.   command : integer = 0;
  125.   Ncom    : array[1..2] of integer = ( 13,  9 );
  126.   ComStrt : array[1..2] of integer = (  4,  7 );
  127.   ComLin  : array[1..2] of integer = (  7,  5 );
  128.   ComWid  : array[1..2] of integer = ( 10, 14 );
  129.   ComName : array[1..2] of array[0..13] of string[10] =
  130.     ((
  131.       ' ClearAll ',' Copy   ',' CopyInfo ',' Rename ',' Set Mask ',' Tog Attr ',' Menu 2 ',
  132.       ' Mark All ',' Delete ',' Move     ',' Reload ',' Make Dir ',' ClearDsk ',' Quit   '
  133.      ),
  134.      (
  135.       ' Sort     ',' Rename ',' Undelete ',' DiskInfo ',' Menu 1 ',
  136.       ' VolLabel ',' Reload ',' Purge    ',' Pick Up  ',' Update ',
  137.       '','','',''
  138.     ));
  139.  
  140.  
  141. function GetCommand( var w : integer; menu : integer ) : integer;
  142. var
  143.   ch                         : char;
  144.   lastcom, lastlin, Fcommand : integer;
  145.  
  146.   procedure WriteCom( i, attr : integer );       { Local to GetCommand }
  147.   var
  148.     x, y : integer;
  149.   begin
  150.     x := ( i mod ComLin[menu]) * ComWid[menu];
  151.     y :=   i div ComLin[menu];
  152.     Display( X1+x+ComStrt[menu], Y1+y+1, attr, ComName[menu][i] );
  153.   end;
  154.  
  155. begin
  156.   Wind( 3 );
  157.   clrscr;
  158.   for lastcom := 0 to Ncom[menu] do
  159.     WriteCom( lastcom, NATTR );
  160.   lastcom  := command;
  161.   lastlin  := CurLin[w];
  162.   Fcommand := 0;
  163.   repeat
  164.     Wind( 3 );
  165.     if lastcom <> command then
  166.       WriteCom( lastcom, NATTR );
  167.     lastcom := command;
  168.     WriteCom( command, MATTR[menu] );
  169.     Wind( w );
  170.     if lastlin <> CurLin[w] then
  171.       Display( X1, Y1+lastlin-1, PATTR, '  ' );
  172.     lastlin := CurLin[w];
  173.     Display( X1, Y1+CurLin[w]-1, PATTR, ' '+PtrChar );
  174.     gotoxy( 1, CurLin[w] );
  175.     CursorON;
  176.     ch := Keyboard;
  177.     CursorOFF;
  178.     if funckey then
  179.     begin
  180.  
  181.       case ch of
  182.         #59..#64 : begin                         { Pass these function keys }
  183.                      Fcommand := ord( ch ) - 38; {   as codes 21 - 26       }
  184.                      ch := #13;                  {        for F1 - F6       }
  185.                    end;
  186.         #65      : if command = 0 then command := Ncom[menu]       { F7 }
  187.                    else command := command - 1;
  188.         #66      : if command = Ncom[menu] then command := 0       { F8 }
  189.                    else command := command + 1;
  190.         #67      : if menu = 2 then                                { F9 }
  191.                    begin
  192.                      Fcommand := 29;
  193.                      ch := #13;
  194.                    end
  195.                    else MarkEntry( w );
  196.         #83      : begin                                           { Del }
  197.                      Fcommand := 31;
  198.                      ch := #13;
  199.                    end;
  200.         #68      : UnMarkEntry( w );                               { F10 }
  201.         #71      : HomeKey( w );
  202.         #72      : UpKey( w );
  203.         #73      : PgUp( w );
  204.         #75      : if Loaded[1] and not HelpScreen[1] then w := 1; { <-- }
  205.         #77      : if Loaded[2] and not HelpScreen[2] then w := 2; { --> }
  206.         #79      : EndKey( w );
  207.         #80      : DownKey( w );
  208.         #81      : PgDown( w );
  209.       end;
  210.  
  211.     end
  212.     else
  213.     begin  { Shifted cursor keys just return regular number characters }
  214.  
  215.       case ch of
  216.         '7' : command := 0;
  217.         '1' : command := Ncom[menu];
  218.         '4' : if command = 0 then command := Ncom[menu]
  219.               else command := command - 1;
  220.         ' ',
  221.         '+',
  222.         '6' : if command = Ncom[menu] then command := 0
  223.               else command := command + 1;
  224.         '8',
  225.         '2' : if command < ComLin[menu] then command := command + ComLin[menu]
  226.               else command := command - ComLin[menu];
  227.       end;
  228.  
  229.     end;
  230.   until ch = #13;
  231.   if Fcommand = 0 then
  232.     GetCommand := command
  233.   else
  234.     GetCommand := Fcommand;
  235. end;
  236.  
  237.  
  238. procedure main;
  239. var
  240.   w, com, menu : integer;
  241.   done         : boolean;
  242. begin
  243.   w    := 1;
  244.   menu := 1;
  245.   done := false;
  246.   repeat
  247.     com := GetCommand( w, menu );
  248.     case menu of
  249.  
  250.       1 : case com of
  251.              0 : ClearMarks( w );            { These first codes are for }
  252.              1 : CopyMarked( w );            {   entries in the ComName  }
  253.              2 : CopyInfo( w );              {   array defined above.    }
  254.              3 : RenameEntry( w );
  255.              4 : SetMask( w );
  256.              5 : ToggleAttr( w );
  257.              6 : begin
  258.                    menu := GoMenu2( w );
  259.                    command := ComLin[menu]-1; { Set command to the Menu entry }
  260.                  end;
  261.              7 : MarkAll( w );
  262.              8 : DeleteMarked( w );
  263.              9 : RedirectMarked( w );
  264.             10 : ReloadDir( w, menu );
  265.             11 : MakeDir( w );
  266.             12 : ClearDisk( w );
  267.             13 : done := true;
  268.  
  269.             21 : HelpWindow( w, 1 );         { Function keys are represented }
  270.             22 : HelpWindow( w, 2 );         {   by numbers in the 20's      }
  271.             23 : GoDir( w, 1 );
  272.             24 : GoDir( w, 2 );
  273.             25 : if ChangePath( 1 ) then w := 1;
  274.             26 : if ChangePath( 2 ) then w := 2;
  275.  
  276.             31 : DeleteEntry( w );               { Special code for Del key }
  277.           end;
  278.  
  279.       2 : case com of
  280.              0 : Sort( w );                   { Code for ComName entry again }
  281.              1 : ChangeName( w );
  282.              2 : UndeleteEntry( w );
  283.              3 : TechInfo( w );
  284.              4 : begin
  285.                    menu := GoMenu1( w );
  286.                    command := ComLin[menu]-1;{ Set command to the Menu entry }
  287.                  end;
  288.              5 : VolLabel( w );
  289.              6 : ReloadDir( w, menu );
  290.              7 : Purge( w );
  291.              8 : MoveEntry( w );
  292.              9 : WriteDir( w );
  293.  
  294.             29 : MoveEntry( w );      { F9 - Only funtion key used by menu 2 }
  295.           end;
  296.  
  297.     end;
  298.   until done;
  299. end;
  300.  
  301.  
  302. begin
  303.   ErrorPtr := ofs( AbortOnError );    { Trap Turbo errors so we can turn off }
  304.   Int24ON;                            {   interrupt handlers before exiting. }
  305.   Int10ON;
  306.   CursorOFF;
  307.   SetCursorType;                    { Set default colors according to system }
  308.   Colors;
  309.   GetColor;
  310.   Colors;
  311.   WriteScreen;
  312.   InitVars;
  313.   WriteHelp1;
  314.  
  315.   Main;
  316.  
  317.   window( 1, 1, 80, 25 );
  318.   textcolor( LightGray );
  319.   textbackground( Black );
  320.   clrscr;
  321.   CursorON;
  322.   {$I-}
  323.   chdir( SavedPath );
  324.   {$I+}
  325.   Int10OFF;
  326.   Int24OFF;
  327. end.
  328.