(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*  Amiga Oberon Library Module: io                   Date: 02-Nov-92      *)
(*                                                                         *)
(*   © 1992 by Fridtjof Siebert                                            *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

MODULE io;

(* $OvflChk- $RangeChk- $NilChk- $ReturnChk- $CaseChk- *)

IMPORT d * := Dos,
       e * := Exec,
              Icon,
       wb  := Workbench,
       ol  := OberonLib,
       str := Strings,
       s   := SYSTEM;

VAR
  out*, in*: d.FileHandlePtr;
  oldOut,oldIn: d.FileHandlePtr;
  Me*: d.ProcessPtr;
  closeDelay*: LONGINT; (* Default = 50 <=> 1s *)

(*------  interne Variablen etc.: ------*)

CONST
  eof = 1CX;

TYPE String = ARRAY 40 OF CHAR;

VAR
  wbm: wb.WBStartupPtr;

  name: ARRAY 80 OF CHAR;
  sptr: e.STRPTR;
  MyIcon: wb.DiskObjectPtr;

  oldCurrentDir: d.FileLockPtr;

  ftemp: ARRAY 256 OF CHAR; (* schön lang! *)
  helpstr: String;


PROCEDURE * RFProc; (* $EntryExitCode- *)
BEGIN
  s.INLINE(016C0U,  (* MOVE.B D0,(A3)+ *)
           04E75U); (* RTS             *)
END RFProc;


(*-------------------------------------------------------------------------*)


PROCEDURE Write*(ch: CHAR);
BEGIN s.SETREG(0,d.Write(out,ch,1)) END Write;


PROCEDURE WriteLn*;
BEGIN Write("\n") END WriteLn;


PROCEDURE WriteString*(string: ARRAY OF CHAR); (* $CopyArrays- *)
BEGIN s.SETREG(0,d.Write(out,string,str.Length(string))) END WriteString;


PROCEDURE Tab*(n: INTEGER);
VAR s: ARRAY 80 OF CHAR;
    i: INTEGER;
BEGIN
  WHILE n>0 DO
    i := 0;
    REPEAT
      s[i] := " ";
      INC(i);
    UNTIL (i=79) OR (i=n);
    DEC(n,i);
    s[i] := 0X;
    WriteString(s);
  END;
END Tab;


PROCEDURE Clear*();
BEGIN Write("\f") END Clear;


(*-------------------------------------------------------------------------*)


PROCEDURE Format*(str: ARRAY OF CHAR; data:e.APTR); (* $CopyArrays- *)
(* %% => %
     links  führ.0   min.max Breite  longdata   dez|hex|string|char
   %  [-]    [0]      [123 [.123] ]     [l]        (d|x|s|c)

   Char ist immer in WORD, auch bei Angabe 'l'!!!
   String-Adresse ist immer LONG!!!
*)
(* niemals mehr als 255 Zeichen erzeugen! *)
BEGIN
  e.OldRawDoFmt(str,data,RFProc,s.ADR(ftemp));
  WriteString(ftemp);
END Format;


(*-------------------------------------------------------------------------*)


PROCEDURE WriteInt*(x: LONGINT; n: INTEGER);
BEGIN
  e.OldRawDoFmt('%%%dld',s.ADR(n),RFProc,s.ADR(helpstr));
  Format(helpstr,s.ADR(x));
END WriteInt;


PROCEDURE WriteHex*(x: LONGINT; n: INTEGER);
BEGIN
  IF n>=0 THEN (* RawDoFmt spinnt etwas bei neg. Zahlen und führ. 0 *)
    e.OldRawDoFmt('%%0%dlx',s.ADR(n),RFProc,s.ADR(helpstr));
  ELSE
    n:=-n;
    e.OldRawDoFmt('%%-%dlx',s.ADR(n),RFProc,s.ADR(helpstr));
  END;
  Format(helpstr,s.ADR(x));
END WriteHex;

(*-------------------------------------------------------------------------*)

PROCEDURE Read*(VAR ch: CHAR);
BEGIN IF d.Read(in,ch,1)#1 THEN ch := eof END;
END Read;

PROCEDURE ReadString*(VAR str: ARRAY OF CHAR);
VAR i: INTEGER;
BEGIN
  i := 0;
  REPEAT
    Read(str[i]);
    CASE str[i] OF "\n",eof,0X: str[i] := 0X; RETURN ELSE END;
    INC(i);
  UNTIL i=LEN(str);
END ReadString;


PROCEDURE ReadInt*(VAR x: LONGINT): BOOLEAN;
VAR
  ch: CHAR;
  d: LONGINT;
  neg: BOOLEAN;
  str: String;
  i: INTEGER;
BEGIN
  x := 0; i := 0;
  ReadString(str);
  neg := FALSE;
  IF str[0]="-" THEN neg := TRUE; i := 1 END;
  LOOP
    ch := str[i];
    CASE ch OF
    0X: IF neg THEN x := -x END; RETURN TRUE |
    "0".."9":
      d := ORD(ch)-ORD("0");
      IF (MAX(LONGINT)-d) DIV 10 >= x THEN x := 10*x+d ELSE EXIT END |
    ELSE EXIT END;
    INC(i);
  END;
  RETURN FALSE;
END ReadInt;


PROCEDURE ReadInteger*(VAR x: INTEGER): BOOLEAN;
VAR
  l: LONGINT;
BEGIN
  IF ReadInt(l) & (l>=MIN(INTEGER)) & (l<=MAX(INTEGER)) THEN
    x := SHORT(l);
    RETURN TRUE;
  END;
  RETURN FALSE;
END ReadInteger;


PROCEDURE ReadShortInt*(VAR x: SHORTINT): BOOLEAN;
VAR
  l: LONGINT;
BEGIN
  IF ReadInt(l) & (l>=MIN(SHORTINT)) & (l<=MAX(SHORTINT)) THEN
    x := SHORT(SHORT(l));
    RETURN TRUE;
  END;
  RETURN FALSE;
END ReadShortInt;


PROCEDURE ReadHex*(VAR x: LONGINT): BOOLEAN;
VAR
  ch: CHAR;
  d: LONGINT;
  str: String;
  i: INTEGER;
BEGIN
  x := 0; i := 0;
  ReadString(str);
  LOOP
    ch := CAP(str[i]);
    CASE ch OF
    0X:       RETURN TRUE |
    "0".."9": DEC(ch,ORD("0")) |
    "A".."F": DEC(ch,ORD("A")-10) |
    ELSE EXIT END;
    d := ORD(ch);
    IF (MAX(LONGINT)-d) DIV 16 >= x THEN x := 16*x+d ELSE EXIT END;
    INC(i);
  END;
  RETURN FALSE;
END ReadHex;

(*-------------------------------------------------------------------------*)


(* Synonyme für Read-Funktionen ohne Ergebnis, falsche Eingabe führt also
   zu falschem Ergebnis: *)

PROCEDURE ReadIntOk      * {"io.ReadInt"     } (VAR x: LONGINT );
PROCEDURE ReadIntegerOk  * {"io.ReadInteger" } (VAR x: INTEGER );
PROCEDURE ReadShortIntOk * {"io.ReadShortInt"} (VAR x: SHORTINT);
PROCEDURE ReadHexOk      * {"io.ReadHex"     } (VAR x: LONGINT );


(*-------------------------------------------------------------------------*)


BEGIN

  Me := s.VAL(d.ProcessPtr,ol.Me);

  closeDelay := 50;

  IF ol.wbStarted THEN

    wbm := ol.wbenchMsg;

    oldCurrentDir := Me.currentDir;
    s.SETREG(0,d.CurrentDir(wbm.argList[0].lock));
    MyIcon := Icon.GetDiskObject(wbm.argList[0].name^);
    s.SETREG(0,d.CurrentDir(oldCurrentDir));

    IF MyIcon#NIL THEN
      sptr := Icon.FindToolType(MyIcon.toolTypes,"WINDOW");
      IF sptr#NIL THEN out := d.Open(sptr^,d.newFile) END;
      Icon.FreeDiskObject(MyIcon);
    END;

    IF out=NIL THEN
      name := "CON:0/20/640/149/";
      str.Append(name,wbm.argList[0].name^);
      IF d.dos.lib.version >= 37 THEN str.Append(name,"/AUTO/CLOSE") END;
      out := d.Open(name,d.newFile);
      IF out=NIL THEN HALT(20) END;
    END;
    in := out;
    IF d.dos.lib.version >= 37 THEN
      oldOut := d.SelectOutput(out);
      oldIn  := d.SelectInput (in);
    END;

  ELSE

    out := d.Output();
    in  := d.Input();

  END;

CLOSE

  IF ol.wbStarted & (out#NIL) THEN
    IF closeDelay>0 THEN d.Delay(closeDelay) END;
    IF d.dos.lib.version>=37 THEN
      oldOut := d.SelectOutput(oldOut);
      oldIn  := d.SelectInput (oldIn);
    END;
    d.OldClose(out);
  END;

END io.