home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / log.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  11KB  |  283 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. StampElems
  4. Alloc
  5. 12 Dec 95
  6. Syntax10b.Scn.Fnt
  7. Syntax12i.Scn.Fnt
  8. MODULE Log;    (* ww 13 Oct 93, shml 
  9.     IMPORT SYSTEM, Oberon, MenuViewers, TextFrames, Texts, Display, Fonts, Files, Modules;
  10.     CONST
  11.         Menu = "System.Close System.Grow Log.Pin Log.Clear Edit.Search Edit.Locate ";
  12.         LogMenuText = "Log.Menu.Text";
  13.         Enter = 0AX;    (* LF key *)
  14.         task: Oberon.Task;
  15.         pin, lastLen: LONGINT;
  16.         w, whex: Texts.Writer;
  17.         defParc: TextFrames.Parc;
  18.         xeHandle: Display.Handler;
  19. (*from XLog
  20.         hexAlpha : ARRAY 17 OF CHAR;
  21.     PROCEDURE OpenMenu(VAR mf: TextFrames.Frame; name, menuFile, defaultMenu: ARRAY OF CHAR);
  22.         VAR buf: Texts.Buffer; t: Texts.Text;
  23.     BEGIN
  24.         IF Files.Old(menuFile) = NIL THEN mf := TextFrames.NewMenu(name, defaultMenu)
  25.         ELSE
  26.             mf := TextFrames.NewMenu(name, "");
  27.             NEW(t); Texts.Open(t, menuFile);
  28.             NEW(buf); Texts.OpenBuf(buf); Texts.Save(t, 0, t.len, buf); Texts.Append(mf.text, buf)
  29.         END
  30.     END OpenMenu;
  31.     PROCEDURE GetXEHandler;
  32.         VAR save, par: Oberon.ParList; res: INTEGER;
  33.     BEGIN
  34.         save := Oberon.Par;
  35.         NEW(par); NEW(par.frame); par.frame.X := 0; par.frame.Y := 0; par.pos := -210566;    (* magic *)
  36.         Oberon.Call("XE.GetHandler", par, FALSE, res);
  37.         IF res = 0 THEN xeHandle := Oberon.Par.frame.handle
  38.         ELSE xeHandle := TextFrames.Handle
  39.         END;
  40.         Oberon.Par := save
  41.     END GetXEHandler;
  42. (* output primitives *)
  43.     PROCEDURE Int*(x: LONGINT);
  44.     BEGIN Texts.Write(w, " "); Texts.WriteInt(w, x, 0); Texts.Append(Oberon.Log, w.buf)
  45.     END Int;
  46. (* from XLog
  47.     PROCEDURE IntFix*(i, n: LONGINT);
  48.     BEGIN
  49.         Texts.WriteInt(w, i, n);  Texts.Append(Oberon.Log, w.buf)
  50.     END IntFix;
  51.     PROCEDURE Hex*(x: LONGINT);
  52.     BEGIN Texts.WriteHex(w, x); Texts.Append(Oberon.Log, w.buf)
  53.     END Hex;
  54. (* from XLog
  55.     PROCEDURE HexFix* (x : LONGINT; l : INTEGER);
  56.         VAR buffer : ARRAY 64 OF CHAR; i : INTEGER;
  57.     BEGIN
  58.         i := 63;
  59.         WHILE (i >=  0) & (l > 0) DO
  60.             buffer[i] := hexAlpha[x MOD 16];
  61.             x := x DIV 16;
  62.             DEC (l); DEC (i);
  63.         END;
  64.         WHILE i < 63 DO
  65.             INC (i);
  66.             Texts.Write (w, buffer[i]);
  67.         END;
  68.         Texts.Append(Oberon.Log, w.buf)
  69.     END HexFix;
  70.     PROCEDURE RealFix*(x: REAL; n, k: INTEGER);
  71.     BEGIN
  72.         Texts.WriteRealFix(w, x, n, k);  Texts.Append(Oberon.Log, w.buf)
  73.     END RealFix;
  74.     PROCEDURE Real*(x: LONGREAL);
  75.     BEGIN Texts.WriteLongReal(w, x, 24); Texts.Append(Oberon.Log, w.buf)
  76.     END Real;
  77.     PROCEDURE Ch*(ch: CHAR);
  78.     BEGIN Texts.Write(w, ch); Texts.Append(Oberon.Log, w.buf)
  79.     END Ch;
  80.     PROCEDURE Str*(s: ARRAY OF CHAR);
  81.     BEGIN Texts.WriteString(w, s); Texts.Append(Oberon.Log, w.buf)
  82.     END Str;
  83.     PROCEDURE Bool*(b: BOOLEAN);
  84.     BEGIN
  85.         IF b THEN Texts.WriteString(w, " TRUE") ELSE Texts.WriteString(w, " FALSE") END;
  86.         Texts.Append(Oberon.Log, w.buf)
  87.     END Bool;
  88.     PROCEDURE Set*(s: SET);
  89.         VAR i, j: INTEGER;
  90.     BEGIN Texts.WriteString(w, " {"); i := 0;
  91.         WHILE s # {} DO
  92.             IF i IN s THEN j := i; Texts.WriteInt(w, i, 0);
  93.                 REPEAT EXCL(s, i); INC(i) UNTIL (s = {}) OR ~(i IN s);
  94.                 IF i > j + 1 THEN
  95.                     IF i > j + 2 THEN Texts.WriteString(w, "..") ELSE Texts.Write(w, ",") END;
  96.                     Texts.WriteInt(w, i - 1, 0)
  97.                 END;
  98.                 IF s # {} THEN Texts.Write(w, ",") END
  99.             END;
  100.             INC(i)
  101.         END;
  102.         Texts.Write(w, "}"); Texts.Append(Oberon.Log, w.buf)
  103.     END Set;
  104.     PROCEDURE Date*(t, d: LONGINT);
  105.     BEGIN Texts.WriteDate(w, t, d); Texts.Append(Oberon.Log, w.buf)
  106.     END Date;
  107.     PROCEDURE Elem*(e: Texts.Elem);
  108.         VAR msg: Texts.CopyMsg;
  109.     BEGIN msg.e := NIL; e.handle(e, msg);
  110.         Texts.WriteElem(w, msg.e); Texts.Append(Oberon.Log, w.buf)
  111.     END Elem;
  112.     PROCEDURE Ln*;
  113.     BEGIN Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf)
  114.     END Ln;
  115.     PROCEDURE DumpRange*(VAR a: ARRAY OF SYSTEM.BYTE; beg, len: LONGINT);
  116.         VAR end: LONGINT; l, h: INTEGER; ch: CHAR;
  117.     BEGIN end := beg + len; beg := beg;
  118.         IF end > LEN(a) THEN end := LEN(a) END;
  119.         WHILE beg < end DO h := ORD(SYSTEM.VAL(CHAR, a[beg])) DIV 16; l := ORD(SYSTEM.VAL(CHAR, a[beg])) MOD 16;
  120.             IF h > 9 THEN Texts.Write(whex, CHR(h - 10 + ORD("A"))) ELSE Texts.Write(whex, CHR(h + ORD("0"))) END;
  121.             IF l > 9 THEN Texts.Write(whex, CHR(l - 10 + ORD("A"))) ELSE Texts.Write(whex, CHR(l + ORD("0"))) END;
  122.             Texts.WriteString(whex, "  "); ch := SYSTEM.VAL(CHAR, a[beg]);
  123.             IF (ch < " ") OR (ch > 7EX) THEN Texts.Write(w, "-") ELSE Texts.Write(w, ch) END;
  124.             INC(beg);
  125.             IF beg MOD 8 = 0 THEN
  126.                 Texts.WriteLn(w); Texts.Append(Oberon.Log, whex.buf); Texts.Append(Oberon.Log, w.buf)
  127.             ELSIF beg MOD 4 = 0 THEN Texts.WriteString(whex, "  ")
  128.             END
  129.         END;
  130.         IF beg MOD 8 # 0 THEN Texts.WriteLn(w);
  131.             IF beg MOD 8 < 4 THEN Texts.WriteString(whex, "  ") END;
  132.             REPEAT Texts.WriteString(whex, "    "); INC(beg) UNTIL beg MOD 8 = 0
  133.         END;
  134.         Texts.Append(Oberon.Log, whex.buf); Texts.Append(Oberon.Log, w.buf)
  135.     END DumpRange;
  136.     PROCEDURE Dump*(VAR a: ARRAY OF SYSTEM.BYTE);
  137.     BEGIN DumpRange(a, 0, LEN(a))
  138.     END Dump;
  139. (*from XLog
  140.     PROCEDURE PutCh*(txt: ARRAY OF CHAR; ch: CHAR);
  141.     BEGIN
  142.         Texts.WriteString(w, txt);  Texts.Write(w, " "); Texts.Write(w, ch);  Texts.WriteLn(w);
  143.         Texts.Append(Oberon.Log, w.buf)
  144.     END PutCh;
  145.     PROCEDURE PutStr*(txt1, txt2: ARRAY OF CHAR);
  146.     BEGIN
  147.         Texts.WriteString(w, txt1);  Texts.Write(w, " ");  Texts.WriteString(w, txt2);  Texts.WriteLn(w);  
  148.         Texts.Append(Oberon.Log, w.buf)
  149.     END PutStr;
  150.     PROCEDURE PutInt*(txt: ARRAY OF CHAR; i: LONGINT);
  151.     BEGIN
  152.         Texts.WriteString(w, txt);  Texts.WriteInt(w, i, 1);  Texts.WriteLn(w);  
  153.         Texts.Append(Oberon.Log, w.buf)
  154.     END PutInt;
  155.     PROCEDURE PutHex*(txt: ARRAY OF CHAR; n: LONGINT);
  156.         VAR buffer : ARRAY 64 OF CHAR; i, l : INTEGER;
  157.     BEGIN
  158.         Texts.WriteString(w, txt); 
  159.         i := 63; l := 8;
  160.         WHILE (i >=  0) & (l > 0) DO
  161.             buffer[i] := hexAlpha[n MOD 16];
  162.             n := n DIV 16;
  163.             DEC (l); DEC (i);
  164.         END;
  165.         WHILE i < 63 DO
  166.             INC (i);
  167.             Texts.Write (w, buffer[i]);
  168.         END;
  169.         Texts.WriteLn(w);  
  170.         Texts.Append(Oberon.Log, w.buf)
  171.     END PutHex;
  172.     PROCEDURE PutReal*(txt: ARRAY OF CHAR; x: REAL);
  173.     BEGIN
  174.         CheckViewer; 
  175.         Texts.WriteString(w, txt);  Texts.WriteReal(w, x, 15);  Texts.WriteLn(w);
  176.         Texts.Append(Oberon.Log, w.buf)
  177.     END PutReal;
  178.     PROCEDURE PutBool*(txt: ARRAY OF CHAR; b: BOOLEAN);
  179.     BEGIN
  180.         CheckViewer; 
  181.         Texts.WriteString(w, txt);
  182.         IF b THEN Texts.WriteString(w, " TRUE")  ELSE Texts.WriteString(w, " FALSE")  END;        
  183.         Texts.WriteLn(w);
  184.         Texts.Append(Oberon.Log, w.buf)
  185.     END PutBool;
  186. (* viewers *)
  187.     PROCEDURE Update*(frame: TextFrames.Frame; VAR m: TextFrames.UpdateMsg);
  188.         VAR r: Texts.Reader; prev, last: LONGINT; ch: CHAR;
  189.     BEGIN xeHandle(frame, m); (*<<TextFrames.Handle(frame, m);*)
  190.         IF (m.id = TextFrames.insert) & (m.end = frame.text.len) & (frame.H > 0) THEN
  191.             last := TextFrames.Pos(frame, MAX(INTEGER), frame.Y);
  192.             IF last < frame.text.len - 1 THEN Oberon.RemoveMarks(frame.X, frame.Y, frame.W, frame.H);
  193.                 TextFrames.RemoveSelection(frame); TextFrames.RemoveCaret(frame);
  194.                 REPEAT prev := frame.org;
  195.                     IF last + 2 < m.beg THEN TextFrames.Show(frame, m.beg)
  196.                     ELSE Texts.OpenReader(r, frame.text, frame.org);
  197.                         REPEAT Texts.Read(r, ch) UNTIL r.eot OR (ch = 0DX);
  198.                         TextFrames.Show(frame, Texts.Pos(r))
  199.                     END;
  200.                     last := TextFrames.Pos(frame, MAX(INTEGER), frame.Y)
  201.                 UNTIL (last >= frame.text.len-1) OR (prev = frame.org)
  202.             END
  203.         END
  204.     END Update;
  205.     PROCEDURE Handler*(frame: Display.Frame; VAR m: Display.FrameMsg);    (*<<*)
  206.         VAR s: Texts.Scanner; par: Oberon.ParList; res: INTEGER;
  207.     BEGIN
  208.         WITH frame: TextFrames.Frame DO
  209.             IF m IS TextFrames.UpdateMsg THEN
  210.                 WITH m: TextFrames.UpdateMsg DO
  211.                     IF m.text = frame.text THEN Update(frame, m) END
  212.                 END
  213.             ELSIF m IS Oberon.InputMsg THEN
  214.                 WITH m: Oberon.InputMsg DO
  215.                     IF (m.id = Oberon.consume) & frame.hasCar & (m.ch = Enter) THEN    (* execute command at beg of line *)
  216.                         Texts.OpenScanner(s, frame.text, frame.carloc.org); Texts.Scan(s);
  217.                         IF s.class = Texts.Name THEN
  218.                             NEW(par); par.frame := frame; par.text := frame.text; par.pos := Texts.Pos(s)-1;
  219.                             Oberon.Call(s.s, par, FALSE, res);
  220.                             IF res > 0 THEN
  221.                                 Str("Call error: "); Str(Modules.importing);
  222.                                 IF res = 1 THEN Str(" not found")
  223.                                 ELSIF res = 2 THEN Str(" not an obj-file")
  224.                                 ELSIF res = 3 THEN Str(" imports "); Str(Modules.imported); Str(" with bad key")
  225.                                 ELSIF res = 4 THEN Str(" corrupted obj file")
  226.                                 ELSIF res = 6 THEN Str(" has too many imports")
  227.                                 ELSIF res = 7 THEN Str(" not enough space")
  228.                                 END
  229.                             ELSIF res < 0 THEN Str(s.s); Str(" not found")
  230.                             END;
  231.                             IF res # 0 THEN Ln END
  232.                         END
  233.                     ELSE xeHandle(frame, m)
  234.                     END
  235.                 END
  236.             ELSE xeHandle(frame, m)
  237.             END
  238.         END
  239.     END Handler;
  240.     PROCEDURE Open*;
  241.         VAR x, y: INTEGER; beg: LONGINT; v: MenuViewers.Viewer; mf, cf: TextFrames.Frame;
  242.     BEGIN
  243.         IF Oberon.Log.len > pin THEN beg := pin ELSE beg := 0 END;
  244.         Oberon.AllocateSystemViewer(Oberon.Mouse.X, x, y);
  245.         OpenMenu(mf, "Log", LogMenuText, Menu);    (*<<*)
  246.         cf := TextFrames.NewText(Oberon.Log, beg); cf.handle := Handler;
  247.         v := MenuViewers.New(mf, cf, TextFrames.menuH, x, y)
  248.     END Open;
  249.     PROCEDURE Pin*;
  250.         VAR frame: TextFrames.Frame;
  251.     BEGIN frame := Oberon.Par.vwr.dsc.next(TextFrames.Frame);
  252.         IF (Oberon.Log.len > pin) & (frame.text = Oberon.Log) THEN
  253.             Oberon.RemoveMarks(frame.X, frame.Y, frame.W, frame.H);
  254.             TextFrames.RemoveSelection(frame); TextFrames.RemoveCaret(frame);
  255.             TextFrames.Show(frame, pin)
  256.         END
  257.     END Pin;
  258.     PROCEDURE SetPin;
  259.         VAR pos: LONGINT;
  260.     BEGIN pos := Oberon.Log.len;
  261.         IF pos # lastLen THEN
  262.             pin := lastLen; lastLen := pos;
  263.             (*<<scrollMsg.id := Texts.insert; scrollMsg.beg := pin; scrollMsg.end := pos; Viewers.Broadcast(scrollMsg)    (*<<*)*)
  264.         END
  265.     END SetPin;
  266.     PROCEDURE Clear*;
  267.     BEGIN
  268.         Texts.Delete( Oberon.Log, 0,Oberon.Log^.len); pin := 0; lastLen := 0; Elem(defParc);
  269.         Texts.Write(w, CHR(13)); Texts.Append(Oberon.Log, w.buf)
  270.     END Clear;
  271.     PROCEDURE InitParc;
  272.         VAR width: LONGINT; msg: Texts.CopyMsg;
  273.     BEGIN msg.e := NIL; TextFrames.defParc.handle(TextFrames.defParc, msg); defParc := msg.e(TextFrames.Parc);
  274.         width := Display.Width - Oberon.SystemTrack(Display.Left) - TextFrames.left - TextFrames.right - 2;
  275.         defParc.width := width * TextFrames.Unit; Elem(defParc)
  276.     END InitParc;
  277. BEGIN Texts.OpenWriter(w); Texts.OpenWriter(whex); Texts.SetFont (whex, Fonts.This("Courier10.Scn.Fnt"));
  278.     NEW(task); task.handle := SetPin; task.safe:= FALSE; task.time := -1; Oberon.Install(task);
  279.     pin := 0; lastLen := 0; InitParc; GetXEHandler
  280.     (*from XLog
  281.             hexAlpha := "0123456789ABCDEF";
  282. END Log.
  283.