home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / v24.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  7KB  |  208 lines
  1. Syntax20b.Scn.Fnt
  2. ParcElems
  3. Alloc
  4. Syntax24b.Scn.Fnt
  5. Syntax10.Scn.Fnt
  6. Syntax10b.Scn.Fnt
  7. FoldElems
  8. Syntax10.Scn.Fnt
  9. Syntax10b.Scn.Fnt
  10.     PROCEDURE StartV24*;
  11.         VAR text: Texts.Text; beg, end, time: LONGINT; s: Texts.Scanner;
  12.     BEGIN Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
  13.         IF (s.class = Texts.Char) & (s.c = "^") & (s.line = 0) THEN Oberon.GetSelection(text, beg, end, time);
  14.             IF time > 0 THEN Texts.OpenScanner(s, text, beg); Texts.Scan(s) END
  15.         END;
  16.         LOOP
  17.             IF (s.line = 0) & (s.class = Texts.Name) THEN
  18.                 IF s.s = "even" THEN MR1 := CHR(ORD(MR1) DIV 32 * 32 + 0 + ORD(MR1) MOD 4)
  19.                 ELSIF s.s = "odd" THEN MR1 := CHR(ORD(MR1) DIV 32 * 32 + 4 + ORD(MR1) MOD 4)
  20.                 ELSIF s.s = "none" THEN MR1 := CHR(ORD(MR1) DIV 32 * 32 + 16 + ORD(MR1) MOD 4)
  21.                 ELSIF s.s = "XON" THEN XOFF := 1X
  22.                 ELSIF s.s = "XOFF" THEN XOFF := 0X
  23.                 END
  24.             ELSIF (s.line = 0) & (s.class = Texts.Int) THEN
  25.                 IF s.i = 1 THEN MR2 := 7X
  26.                 ELSIF s.i = 2 THEN MR2 := 0FX
  27.                 ELSIF s.i = 7 THEN MR1 := CHR(ORD(MR1) DIV 4 * 4 + 2)
  28.                 ELSIF s.i = 8 THEN MR1 := CHR(ORD(MR1) DIV 4 * 4 + 3)
  29.                 ELSIF s.i = 1200 THEN CSR := 66X
  30.                 ELSIF s.i = 2400 THEN CSR := 88X
  31.                 ELSIF s.i = 4800 THEN CSR := 99X
  32.                 ELSIF s.i = 9600 THEN CSR := 0BBX
  33.                 ELSIF s.i = 19200 THEN CSR := 0CCX
  34.                 END
  35.             ELSE EXIT
  36.             END;
  37.             Texts.Scan(s)
  38.         END;
  39.         V24.Stop; V24.Send(XOFF); (* flow control *)
  40.         V24.Start(CSR, MR1, MR2)
  41.     END StartV24;
  42. (* AMIGA *)
  43. MODULE V24; (* RD 31 Dec 95 *)
  44. (* Buffers Recieve, but not Send *)
  45. (* This MODULE always uses the default parameters selected by the Serial Preferences Tool *)
  46. IMPORT SYSTEM, E:=AmigaExec, S:=AmigaSerial, Amiga, O:=Console;
  47. CONST
  48.     BuffSize = 1024;
  49.     IOExtSerPointer = POINTER TO S.IOExtSer;
  50.     SerOpen: BOOLEAN;
  51.     SerMP: E.MsgPortPtr;
  52.     SerIOPtr: E.MessagePtr;
  53.     Error: SHORTINT;
  54.     Buffer: ARRAY BuffSize OF CHAR;
  55.     BuffEnd, BuffPos: INTEGER;
  56. (* Close Serial Device *)
  57. PROCEDURE CloseDevice;
  58. BEGIN
  59.     IF SerOpen THEN
  60.         E.CloseDevice(SerIOPtr)
  61.     END;
  62.     IF SerIOPtr#0 THEN
  63.         E.DeleteIORequest(SerIOPtr)
  64.     END;
  65.     IF SerMP#0 THEN
  66.         E.DeleteMsgPort(SerMP)
  67.     END;
  68.     SerOpen:=FALSE; SerMP:=0; SerIOPtr:=0
  69. END CloseDevice;
  70. (* Open Serial Device *)
  71. PROCEDURE OpenDevice;
  72. BEGIN
  73.     SerMP:=E.CreateMsgPort();
  74.     IF SerMP#0 THEN
  75.         SerIOPtr:=E.CreateIORequest(SerMP, SIZE(S.IOExtSer));
  76.         IF SerIOPtr#0 THEN
  77.             Error:=E.OpenDevice(S.serialName, 0, SerIOPtr, {});
  78.             IF Error=0 THEN SerOpen:=TRUE END
  79.         END
  80.     END;
  81.     IF ~SerOpen THEN CloseDevice() END
  82. END OpenDevice;
  83. (* Get # of available Chars and fill Buffer, if possible *)
  84. PROCEDURE GetAvail();
  85.         IOSerPointer: IOExtSerPointer;
  86.         NrChars: LONGINT;
  87.         r: SHORTINT;
  88. BEGIN
  89.     IOSerPointer:=SYSTEM.VAL(IOExtSerPointer, SerIOPtr);  (* Get # of available Chars *)
  90.     IOSerPointer.command:=S.query;
  91.     r:=E.DoIO(SerIOPtr);
  92.     NrChars:=IOSerPointer.actual;
  93.     IF NrChars=0 THEN                (* No Char available *)
  94.         BuffPos:=0; BuffEnd:=0
  95.     ELSE
  96.         IF NrChars>BuffSize THEN NrChars:=BuffSize END;    (* Read available Chars *)
  97.         IOSerPointer:=SYSTEM.VAL(IOExtSerPointer, SerIOPtr);
  98.         IOSerPointer.command:=E.read;
  99.         IOSerPointer.length:=NrChars;
  100.         IOSerPointer.data:=SYSTEM.ADR(Buffer);
  101.         r:=E.DoIO(SerIOPtr);
  102.         IF r=0 THEN
  103.             BuffPos:=0; BuffEnd:=SHORT(NrChars)
  104.         END
  105. END GetAvail;
  106. (* Start the Serial Device *)
  107. PROCEDURE Start*(baud: INTEGER; data, stop: SHORTINT; parity, even: BOOLEAN);
  108. BEGIN
  109.     IF ~SerOpen THEN OpenDevice() END;
  110.     BuffEnd:=0; BuffPos:=0
  111. END Start;
  112. (* Return # of available Chars *)
  113. PROCEDURE Available*(): INTEGER;
  114. BEGIN
  115.     IF SerOpen THEN
  116.         IF BuffPos>=BuffEnd THEN GetAvail() END;
  117.         RETURN BuffEnd-BuffPos
  118.     ELSE
  119.         RETURN 0
  120. END Available;
  121. (* Recive on Char, first try Buffer, if empty, use GetAvail *)
  122. PROCEDURE Receive*(VAR x: CHAR);
  123.         IOSerPointer: IOExtSerPointer;
  124.         r: SHORTINT;
  125. BEGIN
  126.     IF SerOpen THEN
  127.         IF BuffPos<BuffEnd THEN        (* Char in Buffer, RETURN it *)
  128.             x:=Buffer[BuffPos];
  129.             INC(BuffPos)
  130.         ELSE
  131.             GetAvail();                        (* Try to fill Buffer again *)
  132.             IF BuffPos<BuffEnd THEN        (* RETURN new CHAR *)
  133.                 x:=Buffer[BuffPos];
  134.                 INC(BuffPos)
  135.             ELSE                                (* READ 1 Char from Device *)
  136.                 IOSerPointer:=SYSTEM.VAL(IOExtSerPointer, SerIOPtr);
  137.                 IOSerPointer.command:=E.read;
  138.                 IOSerPointer.length:=1;
  139.                 IOSerPointer.data:=SYSTEM.ADR(x);
  140.                 r:=E.DoIO(SerIOPtr)
  141.             END
  142.         END
  143.     ELSE
  144.         x:=CHR(0)
  145. END Receive;
  146. (* Send one Char, not buffered *)
  147. PROCEDURE Send*(x: CHAR);
  148.         IOSerPointer: IOExtSerPointer;
  149.         r: SHORTINT;
  150. BEGIN
  151.     IF SerOpen THEN
  152.         IOSerPointer:=SYSTEM.VAL(IOExtSerPointer, SerIOPtr);
  153.         IOSerPointer.command:=E.write;
  154.         IOSerPointer.length:=1;
  155.         IOSerPointer.data:=SYSTEM.ADR(x);
  156.         r:=E.DoIO(SerIOPtr)
  157. END Send;
  158. (* Break Serial Device *)
  159. PROCEDURE Break*;
  160.     VAR l: LONGINT; i: SHORTINT;
  161. BEGIN
  162.     IF SerOpen THEN
  163.         IF ~E.CheckIO(SerIOPtr) THEN
  164.             l:=E.AbortIO(SerIOPtr)
  165.         END;
  166.         (*i:=E.WaitIO(SerIOPtr);*)
  167.     END;
  168.     CloseDevice()
  169. END Break;
  170. (* Stop Serial Device *)
  171. PROCEDURE Stop*;
  172.     VAR i: SHORTINT;
  173. BEGIN
  174.     IF Open THEN
  175.         i:=E.WaitIO(SerIOPtr)
  176.     END;
  177.     CloseDevice()
  178.     Break()
  179. END Stop;
  180. (* Open Serial Device *)
  181. PROCEDURE Open*;
  182. BEGIN
  183.     IF ~SerOpen THEN
  184.         Start(19200, 8, 1, FALSE, TRUE);
  185.         IF ~SerOpen THEN
  186.             O.Str("Can not open Serial Device"); O.Ln;
  187.         END;
  188.     END;
  189. END Open;
  190. (*StartV24*)
  191. (* All PROCEDURES setting Serial-Parameters do nothink *)
  192. PROCEDURE FlowCntlOff*;
  193. BEGIN
  194. END FlowCntlOff;
  195. PROCEDURE FlowCntlXOn*;
  196. BEGIN
  197. END FlowCntlXOn;
  198. PROCEDURE FlowCntlCTS*;
  199. BEGIN
  200. END FlowCntlCTS;
  201. PROCEDURE FlowCntlDTR*;
  202. BEGIN
  203. END FlowCntlDTR;
  204. BEGIN
  205.     SerOpen:=FALSE; SerMP:=0; SerIOPtr:=0; BuffPos:=0; BuffEnd:=0;
  206.     Amiga.TermProcedure(Break)
  207. END V24.
  208.