home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / OB3.2D2.DMS / in.adf / Module / io.mod < prev    next >
Encoding:
Text File  |  1994-08-05  |  6.9 KB  |  304 lines
  1. (*-------------------------------------------------------------------------*)
  2. (*                                                                         *)
  3. (*  Amiga Oberon Library Module: io                   Date: 02-Nov-92      *)
  4. (*                                                                         *)
  5. (*   © 1992 by Fridtjof Siebert                                            *)
  6. (*                                                                         *)
  7. (*-------------------------------------------------------------------------*)
  8.  
  9. MODULE io;
  10.  
  11. (* $OvflChk- $RangeChk- $NilChk- $ReturnChk- $CaseChk- *)
  12.  
  13. IMPORT d * := Dos,
  14.        e * := Exec,
  15.               Icon,
  16.        wb  := Workbench,
  17.        ol  := OberonLib,
  18.        str := Strings,
  19.        s   := SYSTEM;
  20.  
  21. VAR
  22.   out*, in*: d.FileHandlePtr;
  23.   oldOut,oldIn: d.FileHandlePtr;
  24.   oldConTask: d.ProcessId;
  25.   Me*: d.ProcessPtr;
  26.   closeDelay*: LONGINT; (* Default = 50 <=> 1s *)
  27.  
  28. (*------  interne Variablen etc.: ------*)
  29.  
  30. CONST
  31.   eof = 1CX;
  32.  
  33. TYPE String = ARRAY 40 OF CHAR;
  34.  
  35. VAR
  36.   wbm: wb.WBStartupPtr;
  37.  
  38.   name: ARRAY 80 OF CHAR;
  39.   sptr: e.STRPTR;
  40.   MyIcon: wb.DiskObjectPtr;
  41.  
  42.   oldCurrentDir: d.FileLockPtr;
  43.  
  44.   ftemp: ARRAY 256 OF CHAR; (* schön lang! *)
  45.   helpstr: String;
  46.   os20: BOOLEAN;
  47.  
  48.  
  49. PROCEDURE * RFProc; (* $EntryExitCode- *)
  50. BEGIN
  51.   s.INLINE(016C0U,  (* MOVE.B D0,(A3)+ *)
  52.            04E75U); (* RTS             *)
  53. END RFProc;
  54.  
  55.  
  56. (*-------------------------------------------------------------------------*)
  57.  
  58.  
  59. PROCEDURE Write*(ch: CHAR);
  60. BEGIN s.SETREG(0,d.Write(out,ch,1)) END Write;
  61.  
  62.  
  63. PROCEDURE WriteLn*;
  64. BEGIN Write("\n") END WriteLn;
  65.  
  66.  
  67. PROCEDURE WriteString*(string: ARRAY OF CHAR); (* $CopyArrays- *)
  68. BEGIN s.SETREG(0,d.Write(out,string,str.Length(string))) END WriteString;
  69.  
  70.  
  71. PROCEDURE Tab*(n: INTEGER);
  72. VAR s: ARRAY 80 OF CHAR;
  73.     i: INTEGER;
  74. BEGIN
  75.   WHILE n>0 DO
  76.     i := 0;
  77.     REPEAT
  78.       s[i] := " ";
  79.       INC(i);
  80.     UNTIL (i=79) OR (i=n);
  81.     DEC(n,i);
  82.     s[i] := 0X;
  83.     WriteString(s);
  84.   END;
  85. END Tab;
  86.  
  87.  
  88. PROCEDURE Clear*();
  89. BEGIN Write("\f") END Clear;
  90.  
  91.  
  92. (*-------------------------------------------------------------------------*)
  93.  
  94.  
  95. PROCEDURE Format*(str: ARRAY OF CHAR; data:e.APTR); (* $CopyArrays- *)
  96. (* %% => %
  97.      links  führ.0   min.max Breite  longdata   dez|hex|string|char
  98.    %  [-]    [0]      [123 [.123] ]     [l]        (d|x|s|c)
  99.  
  100.    Char ist immer in WORD, auch bei Angabe 'l'!!!
  101.    String-Adresse ist immer LONG!!!
  102. *)
  103. (* niemals mehr als 255 Zeichen erzeugen! *)
  104. BEGIN
  105.   e.OldRawDoFmt(str,data,RFProc,s.ADR(ftemp));
  106.   WriteString(ftemp);
  107. END Format;
  108.  
  109.  
  110. (*-------------------------------------------------------------------------*)
  111.  
  112.  
  113. PROCEDURE WriteInt*(x: LONGINT; n: INTEGER);
  114. BEGIN
  115.   e.OldRawDoFmt('%%%dld',s.ADR(n),RFProc,s.ADR(helpstr));
  116.   Format(helpstr,s.ADR(x));
  117. END WriteInt;
  118.  
  119.  
  120. PROCEDURE WriteHex*(x: LONGINT; n: INTEGER);
  121. BEGIN
  122.   IF n>=0 THEN (* RawDoFmt spinnt etwas bei neg. Zahlen und führ. 0 *)
  123.     e.OldRawDoFmt('%%0%dlx',s.ADR(n),RFProc,s.ADR(helpstr));
  124.   ELSE
  125.     n:=-n;
  126.     e.OldRawDoFmt('%%-%dlx',s.ADR(n),RFProc,s.ADR(helpstr));
  127.   END;
  128.   Format(helpstr,s.ADR(x));
  129. END WriteHex;
  130.  
  131. (*-------------------------------------------------------------------------*)
  132.  
  133. PROCEDURE Read*(VAR ch: CHAR);
  134. BEGIN IF d.Read(in,ch,1)#1 THEN ch := eof END;
  135. END Read;
  136.  
  137. PROCEDURE ReadString*(VAR str: ARRAY OF CHAR);
  138. VAR i: INTEGER;
  139. BEGIN
  140.   i := 0;
  141.   REPEAT
  142.     Read(str[i]);
  143.     CASE str[i] OF "\n",eof,0X: str[i] := 0X; RETURN ELSE END;
  144.     INC(i);
  145.   UNTIL i=LEN(str);
  146. END ReadString;
  147.  
  148.  
  149. PROCEDURE ReadInt*(VAR x: LONGINT): BOOLEAN;
  150. VAR
  151.   ch: CHAR;
  152.   d: LONGINT;
  153.   neg: BOOLEAN;
  154.   str: String;
  155.   i: INTEGER;
  156. BEGIN
  157.   x := 0; i := 0;
  158.   ReadString(str);
  159.   neg := FALSE;
  160.   IF str[0]="-" THEN neg := TRUE; i := 1 END;
  161.   LOOP
  162.     ch := str[i];
  163.     CASE ch OF
  164.     0X: IF neg THEN x := -x END; RETURN TRUE |
  165.     "0".."9":
  166.       d := ORD(ch)-ORD("0");
  167.       IF (MAX(LONGINT)-d) DIV 10 >= x THEN x := 10*x+d ELSE EXIT END |
  168.     ELSE EXIT END;
  169.     INC(i);
  170.   END;
  171.   RETURN FALSE;
  172. END ReadInt;
  173.  
  174.  
  175. PROCEDURE ReadInteger*(VAR x: INTEGER): BOOLEAN;
  176. VAR
  177.   l: LONGINT;
  178. BEGIN
  179.   IF ReadInt(l) & (l>=MIN(INTEGER)) & (l<=MAX(INTEGER)) THEN
  180.     x := SHORT(l);
  181.     RETURN TRUE;
  182.   END;
  183.   RETURN FALSE;
  184. END ReadInteger;
  185.  
  186.  
  187. PROCEDURE ReadShortInt*(VAR x: SHORTINT): BOOLEAN;
  188. VAR
  189.   l: LONGINT;
  190. BEGIN
  191.   IF ReadInt(l) & (l>=MIN(SHORTINT)) & (l<=MAX(SHORTINT)) THEN
  192.     x := SHORT(SHORT(l));
  193.     RETURN TRUE;
  194.   END;
  195.   RETURN FALSE;
  196. END ReadShortInt;
  197.  
  198.  
  199. PROCEDURE ReadHex*(VAR x: LONGINT): BOOLEAN;
  200. VAR
  201.   ch: CHAR;
  202.   d: LONGINT;
  203.   str: String;
  204.   i: INTEGER;
  205. BEGIN
  206.   x := 0; i := 0;
  207.   ReadString(str);
  208.   LOOP
  209.     ch := CAP(str[i]);
  210.     CASE ch OF
  211.     0X:       RETURN TRUE |
  212.     "0".."9": DEC(ch,ORD("0")) |
  213.     "A".."F": DEC(ch,ORD("A")-10) |
  214.     ELSE EXIT END;
  215.     d := ORD(ch);
  216.     IF (MAX(LONGINT)-d) DIV 16 >= x THEN x := 16*x+d ELSE EXIT END;
  217.     INC(i);
  218.   END;
  219.   RETURN FALSE;
  220. END ReadHex;
  221.  
  222. (*-------------------------------------------------------------------------*)
  223.  
  224.  
  225. (* Synonyme für Read-Funktionen ohne Ergebnis, falsche Eingabe führt also
  226.    zu falschem Ergebnis: *)
  227.  
  228. PROCEDURE ReadIntOk      * {"io.ReadInt"     } (VAR x: LONGINT );
  229. PROCEDURE ReadIntegerOk  * {"io.ReadInteger" } (VAR x: INTEGER );
  230. PROCEDURE ReadShortIntOk * {"io.ReadShortInt"} (VAR x: SHORTINT);
  231. PROCEDURE ReadHexOk      * {"io.ReadHex"     } (VAR x: LONGINT );
  232.  
  233.  
  234. (*-------------------------------------------------------------------------*)
  235.  
  236.  
  237. BEGIN
  238.   os20 := d.dos.lib.version >= 37;
  239.  
  240.   Me := s.VAL(d.ProcessPtr,ol.Me);
  241.   closeDelay := 50;
  242.  
  243.   IF ol.wbStarted THEN
  244.  
  245.     wbm := ol.wbenchMsg;
  246.  
  247.     oldCurrentDir := Me.currentDir;
  248.     s.SETREG(0,d.CurrentDir(wbm.argList[0].lock));
  249.     MyIcon := Icon.GetDiskObject(wbm.argList[0].name^);
  250.     s.SETREG(0,d.CurrentDir(oldCurrentDir));
  251.  
  252.     IF MyIcon#NIL THEN
  253.       sptr := Icon.FindToolType(MyIcon.toolTypes,"WINDOW");
  254.       IF sptr#NIL THEN out := d.Open(sptr^,d.newFile) END;
  255.       Icon.FreeDiskObject(MyIcon);
  256.     END;
  257.  
  258.     IF out=NIL THEN
  259.       name := "CON:0/20/640/149/";
  260.       str.Append(name,wbm.argList[0].name^);
  261.       IF os20 THEN str.Append(name,"/AUTO/CLOSE") END;
  262.       out := d.Open(name,d.newFile);
  263.       IF out=NIL THEN HALT(20) END;
  264.     END;
  265.     IF os20 THEN
  266.       oldOut := d.SelectOutput(out);
  267.       oldConTask := d.SetConsoleTask (out.type);
  268.       in := d.Open("CONSOLE:", d.oldFile);
  269.     ELSE
  270.       oldConTask := Me.consoleTask;
  271.       Me.consoleTask := out.type;
  272.       in := d.Open("*",d.oldFile);
  273.     END;
  274.     IF in=NIL THEN HALT(20) END;
  275.     IF os20 THEN
  276.       oldIn  := d.SelectInput (in);
  277.     END;
  278.   ELSE
  279.  
  280.     out := d.Output();
  281.     in  := d.Input();
  282.  
  283.   END;
  284.  
  285. CLOSE
  286.  
  287.   IF ol.wbStarted & ((in # NIL) OR (out # NIL)) THEN
  288.     IF closeDelay>0 THEN d.Delay(closeDelay) END;
  289.     IF in # NIL THEN
  290.       IF os20 THEN oldIn := d.SelectInput (oldIn) END;
  291.       IF d.Close(in) THEN in := NIL END;
  292.     END;
  293.     IF out # NIL THEN
  294.       IF os20 THEN
  295.         IF d.SetConsoleTask (oldConTask) = NIL THEN END;
  296.         oldOut := d.SelectOutput(oldOut);
  297.       ELSE
  298.         Me.consoleTask := oldConTask;
  299.       END;
  300.       IF d.Close(out) THEN out := NIL END
  301.     END;
  302.   END;
  303. END io.
  304.