home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / demos / uudecoder.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  4KB  |  174 lines
  1. Syntax10.Scn.Fnt
  2. MODULE UUDecoder; (* ejz, 5.7.95 *)
  3.     IMPORT Files, Texts, Oberon;
  4.         encTable: ARRAY 64 OF CHAR;
  5.         decTable: ARRAY 97 OF INTEGER;
  6.         W: Texts.Writer;
  7.     PROCEDURE GetName*(T: Texts.Text; VAR beg: LONGINT; VAR name: ARRAY OF CHAR): BOOLEAN;
  8.         VAR S: Texts.Scanner;
  9.     BEGIN
  10.         Texts.OpenScanner(S, T, beg);
  11.         Texts.Scan(S);
  12.         WHILE ~S.eot & ((S.class # Texts.Name) OR (S.s # "begin")) DO
  13.             Texts.Scan(S)
  14.         END;
  15.         IF (S.class = Texts.Name) & (S.s = "begin") THEN
  16.             Texts.Scan(S);
  17.             IF S.class # Texts.Name THEN
  18.                 Texts.Scan(S)
  19.             END;
  20.             IF S.class = Texts.Name THEN
  21.                 beg := Texts.Pos(S);
  22.                 COPY(S.s, name);
  23.                 RETURN TRUE
  24.             END
  25.         END;
  26.         RETURN FALSE
  27.     END GetName;
  28.     PROCEDURE DecodeText*(T: Texts.Text; beg: LONGINT; F: Files.File): BOOLEAN;
  29.         VAR
  30.             R: Texts.Reader;
  31.             ch: CHAR;
  32.             bytes, chars, c0, c1, c2, c3: INTEGER;
  33.             Ri: Files.Rider;
  34.             ok: BOOLEAN;
  35.     BEGIN
  36.         Files.Set(Ri, F, 0);
  37.         ok := TRUE;
  38.         Texts.OpenReader(R, T, beg);
  39.         Texts.Read(R, ch);
  40.         REPEAT
  41.             WHILE ~R.eot & (ch <= " ") DO
  42.                 Texts.Read(R, ch)
  43.             END;
  44.             IF (ch >= CHR(32)) & (ch <= CHR(96)) THEN
  45.                 bytes := decTable[ORD(ch)];
  46.                 chars := bytes DIV 3;
  47.                 IF (bytes MOD 3) # 0 THEN
  48.                     INC(chars)
  49.                 END;
  50.                 Texts.Read(R, ch);
  51.                 WHILE ~R.eot & (chars > 0) & ok DO
  52.                     IF (ch >= CHR(32)) & (ch <= CHR(96)) THEN
  53.                         c0 := decTable[ORD(ch)]
  54.                     ELSE
  55.                         ok := FALSE
  56.                     END;
  57.                     Texts.Read(R, ch);
  58.                     IF (ch >= CHR(32)) & (ch <= CHR(96)) THEN
  59.                         c1 := decTable[ORD(ch)]
  60.                     ELSE
  61.                         ok := FALSE
  62.                     END;
  63.                     Texts.Read(R, ch);
  64.                     IF (ch >= CHR(32)) & (ch <= CHR(96)) THEN
  65.                         c2 := decTable[ORD(ch)]
  66.                     ELSE
  67.                         ok := FALSE
  68.                     END;
  69.                     Texts.Read(R, ch);
  70.                     IF (ch >= CHR(32)) & (ch <= CHR(96)) THEN
  71.                         c3 := decTable[ORD(ch)]
  72.                     ELSE
  73.                         ok := FALSE
  74.                     END;
  75.                     Files.Write(Ri, CHR(ASH(c0, 2)+ASH(c1, -4)));
  76.                     DEC(bytes);
  77.                     IF bytes > 0 THEN
  78.                         Files.Write(Ri, CHR(ASH(c1, 4)+ASH(c2, -2)));
  79.                         DEC(bytes);
  80.                         IF bytes > 0 THEN
  81.                             Files.Write(Ri, CHR(ASH(c2, 6)+c3));
  82.                             DEC(bytes)
  83.                         END
  84.                     END;
  85.                     DEC(chars);
  86.                     Texts.Read(R, ch)
  87.                 END;
  88.                 ok := chars <= 0
  89.             ELSE
  90.                 RETURN ch = "e"
  91.             END;
  92.         UNTIL R.eot OR ~ok;
  93.         RETURN ok
  94.     END DecodeText;
  95.     PROCEDURE Do(T: Texts.Text; beg: LONGINT);
  96.         VAR
  97.             name: ARRAY 32 OF CHAR;
  98.             F: Files.File;
  99.     BEGIN
  100.         IF GetName(T, beg, name) THEN
  101.             Texts.WriteString(W, name);
  102.             Texts.WriteString(W, " decoding ");
  103.             Texts.Append(Oberon.Log, W.buf);
  104.             F := Files.New(name);
  105.             IF DecodeText(T, beg, F) THEN
  106.                 Files.Register(F);
  107.                 Texts.WriteString(W, "done")
  108.             ELSE
  109.                 Texts.WriteString(W, "failed")
  110.             END
  111.         ELSE
  112.             Texts.WriteString(W, "begin not found")
  113.         END;
  114.         Texts.WriteLn(W);
  115.         Texts.Append(Oberon.Log, W.buf)
  116.     END Do;
  117.     PROCEDURE Decode*;
  118.         VAR
  119.             S: Texts.Scanner;
  120.             T: Texts.Text;
  121.             beg, end, time: LONGINT;
  122.     BEGIN
  123.         Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos);
  124.         Texts.Scan(S);
  125.         IF (S.class = Texts.Char) & (S.c ="@") THEN
  126.             T := NIL;
  127.             time := -1;
  128.             Oberon.GetSelection(T, beg, end, time);
  129.             IF T # NIL THEN
  130.                 Do(T, beg)
  131.             END
  132.         ELSIF (S.class = Texts.Name) & (S.s = "begin") THEN
  133.             Do(Oberon.Par.text, Oberon.Par.pos)
  134.         ELSE
  135.             NEW(T);
  136.             WHILE S.class IN {Texts.Name, Texts.String} DO
  137.                 Texts.Open(T, S.s);
  138.                 Do(T, 0);
  139.                 Texts.Scan(S)
  140.             END;
  141.             IF (S.class = Texts.Char) & (S.c ="^") THEN
  142.                 T := NIL;
  143.                 time := -1;
  144.                 Oberon.GetSelection(T, beg, end, time);
  145.                 IF T # NIL THEN
  146.                     Texts.OpenScanner(S, T, beg);
  147.                     WHILE S.class IN {Texts.Name, Texts.String} DO
  148.                         Texts.Open(T, S.s);
  149.                         Do(T, 0);
  150.                         Texts.Scan(S)
  151.                     END
  152.                 END
  153.             END
  154.         END
  155.     END Decode;
  156.     PROCEDURE InitUUTables();
  157.         VAR i: INTEGER;
  158.     BEGIN
  159.         FOR i := 0 TO 63 DO
  160.             encTable[i] := CHR(i+32)
  161.         END;
  162.         encTable[0] := CHR(96);
  163.         FOR i := 0 TO 96 DO
  164.             decTable[i] := 0
  165.         END;
  166.         FOR i := 0 TO 63 DO
  167.             decTable[ORD(encTable[i])] := i
  168.         END
  169.     END InitUUTables;
  170. BEGIN
  171.     Texts.OpenWriter(W);
  172.     InitUUTables() 
  173. END UUDecoder.
  174.