(* Include File of Procedures *************************************)
(* System Disk Utility,  v. 0922pm, thu, 18.Sep.86, Glen Ellis *)



(* procedure *******************************************************)
(* Say File List,     v. 0126pm, mon, 01.Sept.86, Glen Ellis       *)

procedure pSayFileList;

begin
   writeln;
   FOR x := 1 to SysInSourceMax do
   begin
      writeln('SysInSource[',x,'] = ', SysInSource[x] );
   end;
   writeln;
end;


(* procedure **************************************************)
(* System Parse .inc, v. 0555am, sat, 13.Sep.86, Glen Ellis   *)

procedure pSysParse( pFILE : Thestr ; var PgmMod : string2 ;
var PgmModStrL, PgmModStrR : string2 );

(* SysInFilename contains the real SourceFileName *)
(* parse for ?TYP
(*   OutLine(.TXT) /  dBASE(.CMD.PRG) / Pascal(.PAS.INC.PRO.FUN)
(* default to .$$$ (which is written normally any way)
(* set SysMode flag to (null) or (OL) or (TP) or (DB)
(*---------------------------------------------------------*)

(* pFILE    = pFILEName to be parsed for .TYP mode
(* Mode     = flag for system use
(* ModStrL  = prefix for comment line
(* ModStrR  = Suffix for comment line
*)

var
i  : nbr;
uTYPArray : array[0..12] of string4;
uTYPe     : string4;
uLine     : THEstr;

begin (* proc *)
   
   PgmMod := '  ';
   PgmModStrL  := '  ';
   PgmModStrR  := '  ';
   
   (* OutLine *)
   uTYPArray[0] := '.TXT';
   
   (* dBASE *)
   uTYPArray[1] := '.CMD';
   uTYPArray[2] := '.PRG';
   
   (* Turbo Pascal *)
   uTYPArray[3] := '.PAS';
   uTYPArray[4] := '.INC';
   uTYPArray[5] := '.FUN';
   uTYPArray[6] := '.PRO';
   uTYPArray[7] := '.BOX';
   
   IF length(pFILE) = 0 then
   begin
      writeln('No FileName Entered');
      pAlarm;
      pKeyPressed;
   end;
   
   pUpCase(pFILE);    (* parse for filename *)
   x  := pos('.',pFILE);
   IF x < 4 then
   begin
      pFILE := '.###';
      x := 1;
   end;
   uTYPe := copy(pFILE,x,4);
   
   (* ? force caps for compare ? *)
   uLine := uTYPe;
   pUpCase(uLine);
   
   (*------*)
   (* OutLine , general catch-all *)
   
   begin
      IF uTYPe =  uTYPArray[0] then
      begin
         PgmMod := 'OL';
         PgmModStrL  := '* ';
         PgmModStrR  := ' *';
      end;
   end;
   
   
   for x := 1 to 2 do
   begin
      (* dBASE *)
      IF uTYPe =  uTYPArray[x] then
      begin
         PgmMod := 'DB';
         PgmModStrL  := '* ';
         PgmModStrR  := ' *';
      end;
   end;
   
   (* Turbo Pascal *)
   for x := 3 to 7 do
   begin
      IF uTYPe =  uTYPArray[x] then
      begin
         PgmMod := 'TP';
         PgmModStrL := '(*';
         PgmModStrR := '*)';
      end;
   end;
   
end; (* proc *)


(* procedure ************************************************************)
(* Input/Output Error Checking, v. 0800am, mon, 15.Sept.86, Glen Ellis  *)

procedure pIOCheck( var IOcheck : lgc );

(* develop no halt for trying to read non-existent file *)
(* need skip read loop, continue program if no file found *)

var
Ch : Char;
IOReadErr : lgc;

begin (* proc *)
   
   IOVal := IOresult;
   IOErr := (IOVal <> 0);
   
   (* GotoXY(1,23); ClrEol; *)
   
   IF IOErr then
   begin
      
      Write(Chr(7));
      writeln('---------------------');
      writeln(' procedure I/O Check ');
      writeln('---------------------');
      
      (*    pAlarm; (* SysUtl.inc *)
      
      CASE IOVal of
         
         $01  :  Write('File does not exist');
         $02  :  Write('File not open for input');
         $03  :  Write('File not open for output');
         $04  :  Write('File not open');
         $05  :  Write('Can''t read from this file');
         $06  :  Write('Can''t write to this file');
         $10  :  Write('Error in numeric format');
         $20  :  Write('Operation not allowed on a logical device');
         $21  :  Write('Not allowed in direct mode');
         $22  :  Write('Assign to standard files not allowed');
         $90  :  Write('Record length mismatch');
         $91  :  Write('Seek beyond end of file');
         $96  :  Write('Strange undefined IO error, not in manual !');
         $99  :  Write('Unexpected end of file');
         $F0  :  Write('Disk write error');
         $F1  :  Write('Directory is full');
         $F2  :  Write('File size overflow');
         $FF  :  Write('File disappeared')
         else      Write('Unknown I/O error:  ',IOVal:3)
      end; (* case *)
      
      writeln;
      
      (* fatal type error *)
      IF IOval = $01 then
      begin       (* if no read file, then skip read loop *)
         IOcheck := false ;
         IF SysPgmTrace then
         begin
            writeln('IOcheck = ',IOcheck,' : IOval = ',IOval,chr(7));
            delay(1000);
         end;
      end;
      
      (* not fatal type error *)
      IF IOval > $01 then  (**)
      begin
         (* no function for non-fatal errors *)
         IF SysPgmTrace then
         begin
            IF KeyPressed Then
            begin
               Repeat
                  Read(Kbd,Ch)
               Until Not KeyPressed;
               writeln('User Interrupt allowed ');
               Write(^M,'Terminate (Y/N)? ');
               Read(Kbd,Ch);
               IF UpCase(Ch)='Y' Then
               begin
                  WriteLn('Y');
                  (* Write(SysOutFile,'User Terminated on pIOcheck error');*)
                  Close(SysOutFile);
                  Halt;
               end
               Else Write(^M,'                ',^M);
            end; (* keypressed *)
         end; (* SysPgmTrace *)
      end; (* IOval *)
   end; (* IOerr *)
end; (* proc *)


(* procedure ****************************************************)
(* Start System Files,   v. 0752pm, thu, 18.Sep.86, Glen Ellis *)

procedure pSysStartFiles( var IOcheck : lgc );

(* borrows system global vars *)
(* SysFile 0,1,2, SysIOcheck flag*)

var
x : integer;

begin (* proc *)
   
   (* position of .typ *)
   x := pos('.',SysInFileName);
   
   (* file.BAK *)
   SysFile0 := copy(SysInFileName,1,x);
   SysFile0 := concat(SysFile0,'BAK');
   
   (* file.CMD *)
   SysFile1 := SysInFileName;
   
   (* file.$$$ *)
   SysFile2 := copy(SysInFileName,1,x);
   SysFile2 := concat(SysFile2,'$$$');
   
   IF SysUserTrace then
   begin
      pSaySysFiles;   (* SysUtl.inc *)
      IF SysPgmTrace then delay(1000);
   end;
   
   IF SysUserTrace then writeln('Assign Read-File  = ',SysFile1);
   ASSIGN( SysInFile, SysFile1 );
   
   IF SysUserTrace then writeln('Reset   Read      = ',SysFile1);
   (*$I-*); RESET( SysInFile ); (*$I+*);
   pIOcheck( IOcheck );
   
   IF IOcheck  then (* able to read from Source file *)
   begin
      
      IF SysUserTrace then writeln('Assign Write-File = ',SysFile2);
      ASSIGN( SysOutFile, SysFile2 );
      
      IF SysUserTrace then writeln('ReWrite  Write    = ',SysFile2);
      (*$I-*); REWRITE( SysOutFile ); (*$I+*);
      pIOcheck( IOcheck );
      
   end; (* IOcheck *)
   
end; (* proc *)



(* Procedure *********************************************************)
(* Rename System Files,  v. 0830pm, wed, 17.Sep.86, Glen Ellis *)

procedure pSysReName( var IOcheck : lgc );

begin (* proc *)
   
   (* borrows system global vars *)
   
   (* purpose:
   (* rename the outfile.$$$ to Sourcefile.CMD
   (* so operation of program is invisible to user
   
   (* test for infile.bak prior to erase/rename
   
   (* SysFile0 is Source.BAK *)
   (* SysFile1 is Source.CMD *)
   (* SysFile2 is Source.$$$ *)
   
   IF SysUserTrace then writeln('--- Rename Files ---');
   
   ASSIGN( SysInfile, SysFile0 ); (* test for presence of file.BAK *)
   (*$I-*); RESET( SysInFile ); (*$I+*);
   pIOcheck( IOcheck );
   (* if not file.BAK, then simply continue *)
   
   (* handled by pIOcheck() *);
   (* IOval   := IOresult ; *)
   (* IOerr   := (IOval <> 0); *)
   
   IF not IOerr then
   begin
      IF SysUserTrace then writeln('--- Erase ',SysFile0,' ---');
      (*$I-*); ERASE( SysInFile ); (*$I+*);
      pIOcheck( IOcheck );
   end;
   
   IF SysUserTrace then
   writeln('--- Rename ',SysFile1, ' to ',SysFile0,' ---');
   
   
   ASSIGN(SysInFile,SysFile1); (* open Source.CMD *)
   (*$I-*); RENAME( SysInFile, SysFile0 ); (*$I+*);
   (* rename Source.CMD to Source.BAK *)
   (*$I-*); CLOSE( SysInFile ); (*$I+*);
   pIOcheck( IOcheck );  (* close  Source.BAK *)
   
   IF SysUserTrace then
   writeln('--- Rename ',SysFile2,' to ',SysFile1,' ---');
   
   ASSIGN( SysOutfile, SysFile2 );
   (*$I-*); RENAME( SysOutFile, SysFile1 ); (*$I+*);
   pIOcheck( IOcheck );
   (*$I-*); CLOSE( SysInFile ); (*$I+*);
   pIOcheck( IOcheck );
   (*$I-*); CLOSE( SysOutFile ); (*$I+*);
   pIOcheck( IOcheck );
   
   IF SysUserTrace then writeln('--- Close Files ---');
   
end; (* proc *)

(*---------------------------------------------------------*)
(*:B:0*)
(*:B:0*)
(*:B:0*)
(*:B:0*)