(* This file contains some useful procedures that
   you may wish to incorporate in your application(s) *)

PROCEDURE GetDrive() : SHORTCARD ;

(* Returns the currently selected drive *)
(* A=1,B=2,C=3 etc                      *)

VAR
  r  : SYSTEM.Registers;
BEGIN
  r.AH := 19H ;
  Lib.Dos(r);
  RETURN r.AL+1 ;
END GetDrive ;


PROCEDURE Exec ( command : ARRAY OF CHAR ;
                 params  : ARRAY OF CHAR ) ;

(*
   Executes a named program, using all free heap memory to do so.
   All memory allocation/deallocation is automatic.
   The program name should include the extension and full path

     eg
         Exec('\COM\ED.EXE','AFILE') ;

   The string params will be passed to the program as the
   'command line'.

*)
VAR
   memptr  : ADDRESS ;
   memsize : CARDINAL ;
   reply   : CARDINAL ;
BEGIN
   memsize := Storage.HeapAvail ( Storage.MainHeap )-8 ; (* 8 for MSDOS relocation *)
   Storage.HeapAllocate(Storage.MainHeap,memptr,memsize) ;
   reply := Lib.Execute(command,params,memptr,memsize) ;
   Storage.HeapDeallocate(Storage.MainHeap,memptr,memsize) ;
   IF reply <> 0 THEN
     Lib.FatalError('Failed to execute program ') ;
   END ;
END Exec ;

PROCEDURE EnvironmentFind ( name : ARRAY OF CHAR ;
                            VAR result : ARRAY OF CHAR ) ;
(* Find a string in the DOS environment *)
VAR
  n : CARDINAL ;
  pi : ARRAY[0..14] OF CHAR ;
  es : ARRAY[0..80] OF CHAR ;
  pp : Lib.CommandType;
BEGIN
  n := 0 ;
  LOOP
      pp := Lib.Environment(n) ;
      Str.Copy(es,pp^) ;
      IF es[0] = CHR(0) THEN
         result[0] := CHR(0) ;
         RETURN ;
      END ;
      Str.ItemS(pi,es,' =',0) ;
      IF Str.Match(pi,name) THEN
         Str.ItemS(result,es,' =',1) ;
         RETURN ;
      END ;
      INC(n) ;
  END ;
END EnvironmentFind ;

PROCEDURE ExecCmd ( command : ARRAY OF CHAR ) ;
(*
  Similar to Exec except the command is executed under a
  copy of COMMAND.COM, the DOS command interpreter. This means
  that the command can be exactly as typed from the normal DOS
  prompt, and may include 'built in' commands such as DIR, COPY etc.
  Again all memory de/allocation is automatic.
  examples:

     ExecCmd('dir /w');     (* do a 'wide' DOS directory *)
     ExecCmd('ed afile');   (* same as Exec example above *)

  ExecCmd is generally preferred over Exec for general use
  although it has two disadvantages
  1) There is slightly less memory available to run the command,
  2) COMMAND.COM must be re-loaded which is slightly slower.
*)

VAR
  path  : ARRAY[0..63 ] OF CHAR ;
  cline : ARRAY[0..128] OF CHAR ;

BEGIN
  EnvironmentFind('COMSPEC',path) ;
  Str.Concat(cline,'/C ',command) ;
  Exec(path,cline) ;
END ExecCmd ;

PROCEDURE GetTime ( VAR Hrs,Mins,Secs,Hsecs : CARDINAL ) ;
(*
   Returns the time as returned by DOS
   Hour : 0..23 ; Mins : 0..59 ; Seconds 0..59 ; Hsecs : 0..99
*)
VAR
  R : SYSTEM.Registers ;
BEGIN
  WITH R DO
    AH := 2CH ;
    Lib.Dos(R) ;
    Hrs   := CARDINAL(CH) ;
    Mins  := CARDINAL(CL) ;
    Secs  := CARDINAL(DH) ;
    Hsecs := CARDINAL(DL) ;
  END ;
END GetTime ;

PROCEDURE GetDate ( VAR Year,Month,Day : CARDINAL ;
                    VAR DayOfWeek : DayType ) ;
(*
   Returns the date as returned by DOS
   Year : 1980..2099 ; Month : 1..12 ; Day 1..31
*)
VAR
  R : SYSTEM.Registers ;
BEGIN
  WITH R DO
    AH := 2AH ;
    Lib.Dos(R) ;
    Year := CX ;
    Month := CARDINAL(DH) ;
    Day := CARDINAL(DL) ;
    DayOfWeek := DayType(AL) ;
  END ;
END GetDate ;

PROCEDURE WrDosError ( ErrorNo : SHORTCARD ) ;
(*
   Writes the text of DOS errors
   as described in MSDOS Version 3.0 Tech Reference.
*)
BEGIN
  CASE ErrorNo OF
      0  : IO.WrStr('OK');
    | 1  : IO.WrStr('Invalid function number');
    | 2  : IO.WrStr('File not found');
    | 3  : IO.WrStr('Path not found');
    | 4  : IO.WrStr('Too many open files (no handles left)');
    | 5  : IO.WrStr('Access denied');
    | 6  : IO.WrStr('Invalid handle');
    | 7  : IO.WrStr('Memory control blocks destroyed');
    | 8  : IO.WrStr('Insufficient memory');
    | 9  : IO.WrStr('Invalid memory block address');
    | 10 : IO.WrStr('Invalid environment');
    | 11 : IO.WrStr('Invalid format');
    | 12 : IO.WrStr('Invalid access code');
    | 13 : IO.WrStr('Invalid data');
    (*14 : Reserved *)
    | 15 : IO.WrStr('Invalid drive was specified');
    | 16 : IO.WrStr('Attempt to remove the current directory');
    | 17 : IO.WrStr('Not same device');
    | 18 : IO.WrStr('No more files');
    | 19 : IO.WrStr('Attempt to write on write-protected diskette');
    | 20 : IO.WrStr('Unknown unit');
    | 21 : IO.WrStr('Drive not ready');
    | 22 : IO.WrStr('Unknown command');
    | 23 : IO.WrStr('Data error (CRC)');
    | 24 : IO.WrStr('Bad request structure length');
    | 25 : IO.WrStr('Seek error');
    | 26 : IO.WrStr('Unknown media type');
    | 27 : IO.WrStr('Sector not found');
    | 28 : IO.WrStr('Printer out of paper');
    | 29 : IO.WrStr('Write fault');
    | 30 : IO.WrStr('Read fault');
    | 31 : IO.WrStr('General failure');
    | 32 : IO.WrStr('Sharing Violation');
    | 33 : IO.WrStr('Lock Violation');
    | 34 : IO.WrStr('Invalid disk change');
    | 35 : IO.WrStr('FCB unavailable');
    (*36..79 : Reserved *)
    | 80 : IO.WrStr('File exists');
    (*81 : Reserved *)
    | 82 : IO.WrStr('Cannot Make');
    | 83 : IO.WrStr('Fail on INT 24');
    | 0F0H:IO.WrStr('Disk Full (write failed)'); (* JPI internal *)
  ELSE
      IO.WrStr('Unknown DOS Error : ');IO.WrShtCard(ErrorNo,0);
  END ;
END WrDosError ;


PROCEDURE InputStr ( VAR S : ARRAY OF CHAR ) ;
(* Inputs a string, using Window module, allowing normal line editing *)
VAR
  ins     : BOOLEAN ;
  k       : CHAR ;
  x,y,p,l : CARDINAL ;
BEGIN
  x := Window.WhereX() ; y := Window.WhereY() ;
  p := MAX(CARDINAL) ;
  p := 0 ;
  ins := TRUE ; (* Insert mode *)
  LOOP
    l := Str.Length(S) ;
    IF p>l THEN p := l END ;
    IO.WrStr(S) ; Window.ClrEol ;
    Window.GotoXY(x+p,y) ;
    k := IO.RdCharDirect() ;
    IF k = 0C THEN  (* Extended character *)
      CASE IO.RdCharDirect() OF
      | CHR(75) : k := CHR(19) ;   (* LeftArr  -> ^S *)
      | CHR(77) : k := CHR(4)  ;   (* RightArr -> ^D *)
      | CHR(71) : k := CHR(1)  ;   (* Home     -> ^A *)
      | CHR(79) : k := CHR(6)  ;   (* End      -> ^F *)
      | CHR(83) : k := CHR(7)  ;   (* Del      -> ^G *)
      | CHR(82) : k := CHR(22) ;   (* Ins      -> ^V *)
      END ;
    END ;
    CASE k OF
    | ' '..'~' : IF ins    THEN Str.Insert(S,k,p) ;
                 ELSIF p=l THEN Str.Append(S,k) ;
                 ELSE S[p] := k ;
                 END ;
                 INC(p) ;
    | CHR(1)   : p := 0 ;                 (* Home    *)
    | CHR(6)   : p := l ;                 (* End     *)
    | CHR(19)  : IF p>0 THEN DEC(p) END ; (* Left    *)
    | CHR(4)   : IF p<l THEN INC(p) END ; (* Right   *)
    | CHR(7)   : IF p<l THEN              (* Del     *)
                   Str.Delete(S,p,1) ;
                 END ;
    | CHR(8)   : IF p>0 THEN              (* BackSpace *)
                   DEC(p) ; Str.Delete(S,p,1) ;
                 END ;
    | CHR(22)  : ins := NOT ins ;         (* Toggle Ins/Ovr *)
    | CHR(13)  : RETURN ;                 (* Enter *)
    END ;
    Window.GotoXY(x,y) ;
  END ;
END InputStr ;