home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 10 / Fresh_Fish_10_2352.bin / new / dev / obero / oberon / projectoberonsrc / line.mod (.txt) < prev    next >
Oberon Text  |  1994-11-16  |  17KB  |  529 lines
  1. Syntax10.Scn.Fnt
  2. MODULE Line;  (*NW 24.3.89 / 12.11.94*)
  3.     IMPORT Files, V24, Viewers, Texts, TextFrames, MenuViewers, Oberon;
  4. (* packet types:
  5.     1 = data,  2 = data ack,
  6.     3 = open,  4 = open ack,
  7.     5 = close,  6 = close ack,
  8.     7 = abort *)
  9.     CONST PakSize = 256;
  10.         T0 = 1200;  (*timeout*)
  11.         ENQ = 40X; SND = 41X; REC = 42X; FDIR = 45X; NPW = 48X; DEL = 49X;
  12.         MDIR = 4AX; SML = 4BX; RML = 4CX; DML = 4DX;
  13.         ACK = 10X; NAK = 25X; NPR = 26X;
  14.         Menu = "^Edit.Menu.Text System.Close  System.Copy  System.Grow  Edit.Search  Edit.Replace  Edit.Store ";
  15.     VAR W, W1: Texts.Writer;
  16.         handler: Oberon.Task;
  17.         myR, myS: INTEGER;  (*receiver and sender sequence numbers*)
  18.         rx: INTEGER;  (*receiver buffer index*)
  19.         rbuf: ARRAY 260 OF CHAR;  (*receiver buffer*)
  20.     PROCEDURE Rec(VAR ch: CHAR);
  21.         VAR time: LONGINT; ch0: CHAR;
  22.     BEGIN time := Oberon.Time() + T0;
  23.         LOOP
  24.             IF V24.Available() > 0 THEN
  25.                 V24.Receive(ch0); ch := CHR(ORD(ch0) MOD 80H); EXIT
  26.             END ;
  27.             IF Oberon.Time() > time THEN ch := 1X; EXIT END
  28.         END
  29.     END Rec;
  30.     PROCEDURE SendPacket(typ, len: INTEGER; VAR data: ARRAY OF CHAR);
  31.         VAR i, u, x: INTEGER; cs: LONGINT;
  32.     BEGIN V24.Send("{"); cs := typ + 5; i := 0;
  33.         WHILE i < len DO
  34.             cs := (cs*5 + ORD(data[i])) MOD 32767; INC(i)
  35.         END ;
  36.         data[len] := CHR(cs); data[len+1] := CHR(cs DIV 100H); INC(len, 2);
  37.         V24.Send(CHR(typ MOD 64 + 33)); x := typ DIV 64; u := 1; i := 0;
  38.         WHILE i < len DO  (*encode*)
  39.             IF u = 0 THEN
  40.                 x := ORD(data[i]); V24.Send(CHR(x MOD 64 + 33)); x := x DIV 64; u := 1
  41.             ELSIF u = 1 THEN
  42.                 x := ORD(data[i])*4 + x; V24.Send(CHR(x MOD 64 + 33)); x := x DIV 64; u := 2
  43.             ELSIF u = 2 THEN
  44.                 x := ORD(data[i])*16 + x; V24.Send(CHR(x MOD 64 + 33)); V24.Send(CHR(x DIV 64 + 33)); u := 0
  45.             END ;
  46.             INC(i)
  47.         END ;
  48.         IF u > 0 THEN V24.Send(CHR(x MOD 64 + 33)) END ;
  49.         V24.Send(0DX)
  50.     END SendPacket;
  51.     PROCEDURE ReceivePacket(VAR typ, len: INTEGER);
  52.         VAR ch: CHAR;
  53.             i, j, u, x: INTEGER; cs: LONGINT;
  54.     BEGIN len := 0; typ := 0; rbuf[1] := 0X;
  55.         REPEAT Rec(ch) UNTIL ch > 0X;
  56.         IF ch = "}" THEN
  57.             Rec(ch); i := 0; u := 0;
  58.             WHILE (ch > 0DX) & (i < 260) DO
  59.                 IF u = 0 THEN
  60.                     x := ORD(ch) - 33; Rec(ch); x := (ORD(ch) - 33) * 64 + x;
  61.                     rbuf[i] := CHR(x); INC(i); x := x DIV 256; u := 2
  62.                 ELSIF u = 1 THEN
  63.                     x := (ORD(ch) - 33) * 4 + x; rbuf[i] := CHR(x); INC(i); u := 0
  64.                 ELSIF u = 2 THEN
  65.                     x := (ORD(ch) - 33) * 16 + x; rbuf[i] := CHR(x); INC(i); x := x DIV 256; u := 1
  66.                 END ;
  67.                 Rec(ch)
  68.             END ;
  69.             IF (ch = 0DX) & (i > 2) THEN
  70.                 DEC(i, 2); j := 0; cs := 1;
  71.                 WHILE j < i DO
  72.                     cs := (cs*5 + ORD(rbuf[j])) MOD 32767; INC(j)
  73.                 END ;
  74.                 IF (CHR(cs) = rbuf[i]) & (CHR(cs DIV 256) = rbuf[i+1]) THEN
  75.                     rx := 1; typ := ORD(rbuf[0]); len := i-1
  76.                 END
  77.             END
  78.         END
  79.     END ReceivePacket;
  80.     PROCEDURE Open1(len: INTEGER; VAR msg: ARRAY OF CHAR; VAR res: INTEGER);
  81.         VAR typ, plen, retries: INTEGER;
  82.     BEGIN retries := 3; myS := 0; myR := 0;
  83.         LOOP SendPacket(30H, len, msg); ReceivePacket(typ, plen);
  84.             IF typ DIV 10H = 4 THEN res := 0; EXIT END ;
  85.             IF typ DIV 10H = 7 THEN res := 2; EXIT END ;
  86.             DEC(retries);
  87.             IF retries = 0 THEN res := 1; EXIT END ;
  88.         END
  89.     END Open1;
  90.     PROCEDURE Send1(len: INTEGER; VAR buf: ARRAY OF CHAR; VAR res: INTEGER);
  91.         VAR retries, typ, plen: INTEGER;
  92.     BEGIN myS := 1 - myS; retries := 3;
  93.         SendPacket(myR*2+myS+14H, len, buf);
  94.         LOOP ReceivePacket(typ, plen);
  95.             IF typ <= 0 THEN (*error*) DEC(retries);
  96.                 IF retries = 0 THEN res := 1; EXIT END ;
  97.                 SendPacket(myR*2+myS+14H, len, buf)
  98.             ELSIF (typ DIV 10H = 2) & (typ DIV 2 MOD 2 = myS) THEN res := 0; EXIT
  99.             ELSIF typ DIV 10H = 7 THEN (*abort*) res := 2; EXIT
  100.             END
  101.         END
  102.     END Send1;
  103.     PROCEDURE Receive1(VAR len, res: INTEGER);
  104.         VAR typ: INTEGER;
  105.             dmy: ARRAY 4 OF CHAR;
  106.     BEGIN
  107.         LOOP ReceivePacket(typ, len);
  108.             IF typ <= 0 THEN (*error*) res := 1; EXIT
  109.             ELSIF typ DIV 10H = 1 THEN (*data*)
  110.                 IF typ MOD 2 # myR THEN
  111.                     myR := 1 - myR; SendPacket(myR*2+myS+20H, 0, dmy); res := 0; EXIT
  112.                 ELSE SendPacket(myR*2+myS+20H, 0, dmy)
  113.                 END
  114.             ELSIF typ DIV 10H = 7 THEN (*abort*) res := 3; EXIT
  115.             END
  116.         END
  117.     END Receive1;
  118.     PROCEDURE SendData(F: Files.File; VAR res: INTEGER);
  119.         VAR  k: INTEGER;
  120.             x: CHAR;
  121.             L: LONGINT;
  122.             R: Files.Rider;
  123.             buf: ARRAY PakSize+2 OF CHAR;
  124.     BEGIN Files.Set(R, F, 0); L := 0;
  125.         LOOP k := 0;
  126.             LOOP Files.Read(R, x);
  127.                 IF R.eof THEN EXIT END ;
  128.                 buf[k] := x; INC(k);
  129.                 IF k = PakSize THEN EXIT END
  130.             END ;
  131.             Send1(k, buf, res);
  132.             IF res # 0 THEN Texts.WriteString(W, " failed"); EXIT END ;
  133.             L := L + k;
  134.             Texts.Write(W, "."); Texts.Append(Oberon.Log, W.buf);
  135.             IF k < PakSize THEN EXIT END ;
  136.             Texts.Append(Oberon.Log, W.buf)
  137.         END ;
  138.         Texts.WriteInt(W, L, 7)
  139.     END SendData;
  140.     PROCEDURE SendText(T: Texts.Text; VAR res: INTEGER);
  141.         VAR  k, m: INTEGER;
  142.             L: LONGINT;
  143.             R: Texts.Reader;
  144.             buf: ARRAY PakSize+2 OF CHAR;
  145.     BEGIN Texts.OpenReader(R, T, 0); L := T.len;
  146.         LOOP k := 0;
  147.             IF L > PakSize THEN m := PakSize ELSE m := SHORT(L) END ;
  148.             WHILE k < m DO Texts.Read(R, buf[k]); INC(k) END ;
  149.             Send1(k, buf, res);
  150.             IF res # 0 THEN Texts.WriteString(W, " failed"); EXIT END ;
  151.             L := L - m;
  152.             Texts.Write(W, "."); Texts.Append(Oberon.Log, W.buf);
  153.             IF m < PakSize THEN EXIT END
  154.         END
  155.     END SendText;
  156.     PROCEDURE ReceiveData(F: Files.File; VAR res: INTEGER);
  157.         VAR k, len: INTEGER; L: LONGINT;
  158.             R: Files.Rider;
  159.     BEGIN Files.Set(R, F, 0); L := 0;
  160.         LOOP Receive1(len, res);
  161.             IF res = 0 THEN k := 0;
  162.                 WHILE k < len DO
  163.                     Files.Write(R, rbuf[rx]); INC(rx); INC(k)
  164.                 END ;
  165.                 L := L + k;
  166.                 Texts.Write(W, "."); Texts.Append(Oberon.Log, W.buf);
  167.                 IF len < 256 THEN EXIT END
  168.             ELSE Texts.WriteString(W, "  failed"); EXIT
  169.             END
  170.         END ;
  171.         Texts.WriteInt(W, L, 8)
  172.     END ReceiveData;
  173.     PROCEDURE ReceiveText(T: Texts.Text; VAR res: INTEGER);
  174.         VAR k, len: INTEGER;
  175.             L: LONGINT;
  176.     BEGIN L := 0;
  177.         LOOP Receive1(len, res);
  178.             IF res = 0 THEN k := 0;
  179.                 WHILE k < len DO Texts.Write(W1, rbuf[rx]); INC(rx); INC(k) END ;
  180.                 Texts.Append(T, W1.buf); L := L + k;
  181.                 Texts.Write(W, "."); Texts.Append(Oberon.Log, W.buf);
  182.                 IF len < 256 THEN EXIT END
  183.             ELSE Texts.WriteString(W, "  failed"); Texts.WriteLn(W);
  184.                 Texts.Append(Oberon.Log, W.buf); EXIT
  185.             END
  186.         END
  187.     END ReceiveText;
  188.     PROCEDURE reply(msg: INTEGER);
  189.     BEGIN
  190.         CASE msg OF
  191.               0:
  192.             | 1: Texts.WriteString(W, " no link")
  193.             | 2: Texts.WriteString(W, " no permission")
  194.             | 3: Texts.WriteString(W, " not done")
  195.             | 4: Texts.WriteString(W, " not found")
  196.             | 5: Texts.WriteString(W, " no response")
  197.             | 6: Texts.WriteString(W, " link open")
  198.             | 7: Texts.WriteString(W, " password set")
  199.             | 8: Texts.WriteString(W, " no recipient")
  200.         END ;
  201.         Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
  202.     END reply;
  203.     PROCEDURE AppendS(VAR s: ARRAY OF CHAR; VAR d: ARRAY OF CHAR; VAR k: INTEGER);
  204.         VAR i: INTEGER; ch: CHAR;
  205.     BEGIN i := 0;
  206.         REPEAT ch := s[i]; d[k] := ch; INC(i); INC(k) UNTIL ch = 0X
  207.     END AppendS;
  208.     PROCEDURE AppendW(s: LONGINT; VAR d: ARRAY OF CHAR; n: INTEGER; VAR k: INTEGER);
  209.         VAR i: INTEGER;
  210.     BEGIN i := 0;
  211.         REPEAT d[k] := CHR(s); s := s DIV 100H; INC(i); INC(k) UNTIL i = n
  212.     END AppendW;
  213.     (*------------------------ Commands -----------------------*)
  214.     PROCEDURE GetPar(VAR S: Texts.Scanner);
  215.     BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S)
  216.     END GetPar;
  217.     PROCEDURE OpenLink*;
  218.         VAR res: INTEGER;
  219.             msg: ARRAY 4 OF CHAR;
  220.     BEGIN msg[0] := ENQ; Open1(1, msg, res);
  221.         IF res = 0 THEN reply(6) ELSE reply(3) END
  222.     END OpenLink;
  223.     PROCEDURE SendFiles*;
  224.         VAR len, res, k: INTEGER;
  225.             S: Texts.Scanner;
  226.             F: Files.File;
  227.             name: ARRAY 32 OF CHAR;
  228.             buf: ARRAY 64 OF CHAR;
  229.     BEGIN GetPar(S);
  230.             LOOP
  231.                 IF S.class # Texts.Name THEN EXIT END ;
  232.                 Texts.WriteString(W, S.s); k := 0; AppendS(S.s, name, k);
  233.                 IF S.nextCh = ":" THEN (*prefix*)
  234.                     Texts.Scan(S); Texts.Scan(S);
  235.                     IF S.class = Texts.Name THEN
  236.                         name[k-1] := "."; AppendS(S.s, name, k);
  237.                         Texts.Write(W, ":"); Texts.WriteString(W, S.s)
  238.                     END
  239.                 END ;
  240.                 Texts.WriteString(W, " sending"); Texts.Append(Oberon.Log, W.buf);
  241.                 F := Files.Old(S.s);
  242.                 IF F # NIL THEN
  243.                     buf[0] := REC; k := 1;
  244.                     AppendS(Oberon.User, buf, k); AppendW(Oberon.Password, buf, 4, k);
  245.                     AppendS(name, buf, k); Open1(k, buf,