home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 3 / goldfish_volume_3.bin / files / dev / obero / oberon / projectoberonsrc / oberon.mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1994-11-16  |  11.2 KB  |  362 lines

  1. Syntax10.Scn.Fnt
  2. MODULE Oberon; (*JG 6.9.90 / 23.9.93 / 13.8.94*)
  3.     IMPORT Kernel, Modules, Input, Display, Fonts, Viewers, Texts;
  4.     CONST
  5.         (*message ids*)
  6.         consume* = 0; track* = 1;
  7.         defocus* = 0; neutralize* = 1; mark* = 2;
  8.         BasicCycle = 20;
  9.         ESC = 1BX; SETUP = 0A4X;
  10.     TYPE
  11.         Painter* = PROCEDURE (x, y: INTEGER);
  12.         Marker* = RECORD Fade*, Draw*: Painter END;
  13.         Cursor* = RECORD
  14.             marker*: Marker; on*: BOOLEAN; X*, Y*: INTEGER
  15.         END;
  16.         ParList* = POINTER TO ParRec;
  17.         ParRec* = RECORD
  18.             vwr*: Viewers.Viewer;
  19.             frame*: Display.Frame;
  20.             text*: Texts.Text;
  21.             pos*: LONGINT
  22.         END;
  23.         InputMsg* = RECORD (Display.FrameMsg)
  24.             id*: INTEGER;
  25.             keys*: SET;
  26.             X*, Y*: INTEGER;
  27.             ch*: CHAR;
  28.             fnt*: Fonts.Font;
  29.             col*, voff*: SHORTINT
  30.         END;
  31.         SelectionMsg* = RECORD (Display.FrameMsg)
  32.             time*: LONGINT;
  33.             text*: Texts.Text;
  34.             beg*, end*: LONGINT
  35.         END;
  36.         ControlMsg* = RECORD (Display.FrameMsg)
  37.             id*, X*, Y*: INTEGER
  38.         END;
  39.         CopyOverMsg* = RECORD (Display.FrameMsg)
  40.             text*: Texts.Text;
  41.             beg*, end*: LONGINT
  42.         END;
  43.         CopyMsg* = RECORD (Display.FrameMsg)
  44.             F*: Display.Frame
  45.         END;
  46.         Task* = POINTER TO TaskDesc;
  47.         Handler* = PROCEDURE;
  48.         TaskDesc* = RECORD
  49.             next: Task;
  50.             safe*: BOOLEAN;
  51.             time*: LONGINT;
  52.             handle*: Handler
  53.         END;
  54.         User*: ARRAY 8 OF CHAR;
  55.         Password*: LONGINT;
  56.         Arrow*, Star*: Marker;
  57.         Mouse*, Pointer*: Cursor;
  58.         FocusViewer*: Viewers.Viewer;
  59.         Log*: Texts.Text;
  60.         Par*: ParList; (*actual parameters*)
  61.         CurTask*, NextTask: Task;
  62.         CurFnt*: Fonts.Font; CurCol*, CurOff*: SHORTINT;
  63.         DW, DH, CL, H0, H1, H2, H3: INTEGER;
  64.         unitW: INTEGER;
  65.         ActCnt: INTEGER; (*action count for GC*)
  66.         Mod: Modules.Module;
  67.     (*user identification*)
  68.     PROCEDURE Code(VAR s: ARRAY OF CHAR): LONGINT;
  69.         VAR i: INTEGER; a, b, c: LONGINT;
  70.     BEGIN
  71.         a := 0; b := 0; i := 0;
  72.         WHILE s[i] # 0X DO
  73.             c := b; b := a; a := (c MOD 509 + 1) * 127 + ORD(s[i]);
  74.             INC(i)
  75.         END;
  76.         IF b >= 32768 THEN b := b - 65536 END;
  77.         RETURN b * 65536 + a
  78.     END Code;
  79.     PROCEDURE SetUser* (VAR user, password: ARRAY OF CHAR);
  80.     BEGIN COPY(user, User); Password := Code(password)
  81.     END SetUser;
  82.     (*clocks*)
  83.     PROCEDURE GetClock* (VAR t, d: LONGINT);
  84.     BEGIN Kernel.GetClock(t, d)
  85.     END GetClock;
  86.     PROCEDURE SetClock* (t, d: LONGINT);
  87.     BEGIN Kernel.SetClock(t, d)
  88.     END SetClock;
  89.     PROCEDURE Time* (): LONGINT;
  90.     BEGIN RETURN Input.Time()
  91.     END Time;
  92.     (*cursor handling*)
  93.     PROCEDURE FlipArrow (X, Y: INTEGER);
  94.     BEGIN
  95.         IF X < CL THEN
  96.             IF X > DW - 15 THEN X := DW - 15 END
  97.         ELSE
  98.             IF X > CL + DW - 15 THEN X := CL + DW - 15 END
  99.         END;
  100.         IF Y < 14 THEN Y := 14 ELSIF Y > DH THEN Y := DH END;
  101.         Display.CopyPattern(Display.white, Display.arrow, X, Y - 14, 2)
  102.     END FlipArrow;
  103.     PROCEDURE FlipStar (X, Y: INTEGER);
  104.     BEGIN
  105.         IF X < CL THEN
  106.             IF X < 7 THEN X := 7 ELSIF X > DW - 8 THEN X := DW - 8 END
  107.         ELSE
  108.             IF X < CL + 7 THEN X := CL + 7 ELSIF X > CL + DW - 8 THEN X := CL + DW - 8 END
  109.         END ;
  110.         IF Y < 7 THEN Y := 7 ELSIF Y > DH - 8 THEN Y := DH - 8 END;
  111.         Display.CopyPattern(Display.white, Display.star, X - 7, Y - 7, 2)
  112.     END FlipStar;
  113.     PROCEDURE OpenCursor* (VAR c: Cursor);
  114.     BEGIN c.on := FALSE; c.X := 0; c.Y := 0
  115.     END OpenCursor;
  116.     PROCEDURE FadeCursor* (VAR c: Cursor);
  117.     BEGIN IF c.on THEN c.marker.Fade(c.X, c.Y); c.on := FALSE END
  118.     END FadeCursor;
  119.     PROCEDURE DrawCursor* (VAR c: Cursor; VAR m: Marker; X, Y: INTEGER);
  120.     BEGIN
  121.         IF c.on & ((X # c.X) OR (Y # c.Y) OR (m.Draw # c.marker.Draw)) THEN
  122.             c.marker.Fade(c.X, c.Y); c.on := FALSE
  123.         END;
  124.         IF ~c.on THEN
  125.             m.Draw(X, Y); c.marker := m; c.X := X; c.Y := Y; c.on := TRUE
  126.         END
  127.     END DrawCursor;
  128.     (*display management*)
  129.     PROCEDURE RemoveMarks* (X, Y, W, H: INTEGER);
  130.     BEGIN
  131.         IF (Mouse.X > X - 16) & (Mouse.X < X + W + 16) & (Mouse.Y > Y - 16) & (Mouse.Y < Y + H + 16) THEN
  132.             FadeCursor(Mouse)
  133.         END;
  134.         IF (Pointer.X > X - 8) & (Pointer.X < X + W + 8) & (Pointer.Y > Y - 8) & (Pointer.Y < Y + H + 8) THEN
  135.             FadeCursor(Pointer)
  136.         END
  137.     END RemoveMarks;
  138.     PROCEDURE HandleFiller (V: Display.Frame; VAR M: Display.FrameMsg);
  139.     BEGIN
  140.         WITH V: Viewers.Viewer DO
  141.             IF M IS InputMsg THEN
  142.                 WITH M: InputMsg DO
  143.                     IF M.id = track THEN DrawCursor(Mouse, Arrow, M.X, M.Y) END
  144.                 END;
  145.             ELSIF M IS ControlMsg THEN
  146.                  WITH M: ControlMsg DO
  147.                      IF M.id = mark THEN DrawCursor(Pointer, Star, M.X, M.Y) END
  148.                  END
  149.             ELSIF M IS Viewers.ViewerMsg THEN
  150.                 WITH M: Viewers.ViewerMsg DO
  151.                     IF (M.id = Viewers.restore) & (V.W > 0) & (V.H > 0) THEN
  152.                         RemoveMarks(V.X, V.Y, V.W, V.H);
  153.                         Display.ReplConst(Display.black, V.X, V.Y, V.W, V.H, 0)
  154.                     ELSIF (M.id = Viewers.modify) & (M.Y < V.Y) THEN
  155.                         RemoveMarks(V.X, M.Y, V.W, V.Y - M.Y);
  156.                         Display.ReplConst(Display.black, V.X, M.Y, V.W, V.Y - M.Y, 0)
  157.                     END
  158.                 END
  159.             END
  160.         END
  161.     END HandleFiller;
  162.     PROCEDURE OpenDisplay* (UW, SW, H: INTEGER);
  163.         VAR Filler: Viewers.Viewer;
  164.     BEGIN
  165.          Input.SetMouseLimits(Viewers.curW + UW + SW, H);
  166.          Display.ReplConst(Display.black, Viewers.curW, 0, UW + SW, H, 0);
  167.          NEW(Filler); Filler.handle := HandleFiller;
  168.          Viewers.InitTrack(UW, H, Filler); (*init user track*)
  169.          NEW(Filler); Filler.handle := HandleFiller;
  170.          Viewers.InitTrack(SW, H, Filler) (*init system track*)
  171.     END OpenDisplay;
  172.     PROCEDURE DisplayWidth* (X: INTEGER): INTEGER;
  173.     BEGIN RETURN DW
  174.     END DisplayWidth;
  175.     PROCEDURE DisplayHeight* (X: INTEGER): INTEGER;
  176.     BEGIN RETURN DH
  177.     END DisplayHeight;
  178.     PROCEDURE OpenTrack* (X, W: INTEGER);
  179.         VAR Filler: Viewers.Viewer;
  180.     BEGIN
  181.         NEW(Filler); Filler.handle := HandleFiller;
  182.         Viewers.OpenTrack(X, W, Filler)
  183.     END OpenTrack;
  184.     PROCEDURE UserTrack* (X: INTEGER): INTEGER;
  185.     BEGIN RETURN X DIV DW * DW
  186.     END UserTrack;
  187.     PROCEDURE SystemTrack* (X: INTEGER): INTEGER;
  188.     BEGIN RETURN X DIV DW * DW + DW DIV 8 * 5
  189.     END SystemTrack;
  190.     PROCEDURE UY (X: INTEGER): INTEGER;
  191.         VAR fil, bot, alt, max: Display.Frame;
  192.     BEGIN
  193.         Viewers.Locate(X, 0, fil, bot, alt, max);
  194.         IF fil.H >= DH DIV 8 THEN RETURN DH END;
  195.         RETURN max.Y + max.H DIV 2
  196.     END UY;
  197.     PROCEDURE AllocateUserViewer* (DX: INTEGER; VAR X, Y: INTEGER);
  198.     BEGIN
  199.         IF Pointer.on THEN X := Pointer.X; Y := Pointer.Y
  200.         ELSE X := DX DIV DW * DW; Y := UY(X)
  201.         END
  202.     END AllocateUserViewer;
  203.     PROCEDURE SY (X: INTEGER): INTEGER;
  204.         VAR fil, bot, alt, max: Display.Frame;
  205.     BEGIN
  206.         Viewers.Locate(X, DH, fil, bot, alt, max);
  207.         IF fil.H >= DH DIV 8 THEN RETURN DH END;
  208.         IF max.H >= DH - H0 THEN RETURN max.Y + H3 END;
  209.         IF max.H >= H3 - H0 THEN RETURN max.Y + H2 END;
  210.         IF max.H >= H2 - H0 THEN RETURN max.Y + H1 END;
  211.         IF max # bot THEN RETURN max.Y + max.H DIV 2 END;
  212.         IF bot.H >= H1 THEN RETURN bot.H DIV 2 END;
  213.         RETURN alt.Y + alt.H DIV 2
  214.     END SY;
  215.     PROCEDURE AllocateSystemViewer* (DX: INTEGER; VAR X, Y: INTEGER);
  216.     BEGIN
  217.         IF Pointer.on THEN X := Pointer.X; Y := Pointer.Y
  218.         ELSE X := DX DIV DW * DW + DW DIV 8 * 5; Y := SY(X)
  219.         END
  220.     END AllocateSystemViewer;
  221.     PROCEDURE MarkedViewer* (): Viewers.Viewer;
  222.     BEGIN RETURN Viewers.This(Pointer.X, Pointer.Y)
  223.     END MarkedViewer;
  224.     PROCEDURE PassFocus* (V: Viewers.Viewer);
  225.         VAR M: ControlMsg;
  226.     BEGIN M.id := defocus; FocusViewer.handle(FocusViewer, M); FocusViewer := V
  227.     END PassFocus;
  228.     (*command interpretation*)
  229.     PROCEDURE Call* (name: ARRAY OF CHAR; par: ParList; new: BOOLEAN; VAR res: INTEGER);
  230.         VAR Mod: Modules.Module; P: Modules.Command; i, j: INTEGER;
  231.     BEGIN res := 1;
  232.         i := 0; j := 0;
  233.         WHILE name[j] # 0X DO
  234.             IF name[j] = "." THEN i := j END;
  235.             INC(j)
  236.         END;
  237.         IF i > 0 THEN
  238.             name[i] := 0X;
  239.             IF new THEN Modules.Free(name, FALSE) END;
  240.             Mod := Modules.ThisMod(name);
  241.             IF Modules.res = 0 THEN
  242.                 INC(i); j := i;
  243.                 WHILE name[j] # 0X DO name[j - i] := name[j]; INC(j) END;
  244.                 name[j - i] := 0X;
  245.                 P := Modules.ThisCommand(Mod, name);
  246.                 IF Modules.res = 0 THEN
  247.                     Par := par; Par.vwr := Viewers.This(par.frame.X, par.frame.Y); P; res := 0
  248.                 ELSE res := -1
  249.                 END
  250.             ELSE res := Modules.res
  251.             END
  252.         ELSE res := -1
  253.         END
  254.     END Call;
  255.     PROCEDURE GetSelection* (VAR text: Texts.Text; VAR beg, end, time: LONGINT);
  256.         VAR M: SelectionMsg;
  257.     BEGIN
  258.         M.time := -1; Viewers.Broadcast(M); time := M.time;
  259.         IF time >= 0 THEN text := M.text; beg := M.beg; end := M.end END
  260.     END GetSelection;
  261.     PROCEDURE GC;
  262.     BEGIN IF ActCnt <= 0 THEN Kernel.GC; ActCnt := BasicCycle END
  263.     END GC;
  264.     PROCEDURE Install* (T: Task);
  265.         VAR t: Task;
  266.     BEGIN t := NextTask;
  267.         WHILE (t.next # NextTask) & (t.next # T) DO t := t.next END;
  268.         IF t.next # T THEN T.next := t.next; t.next := T END
  269.     END Install;
  270.     PROCEDURE Remove* (T: Task);
  271.         VAR t: Task;
  272.     BEGIN t := NextTask;
  273.         WHILE (t.next # NextTask) & (t.next # T) DO t := t.next END;
  274.         IF t.next = T THEN t.next := T.next;
  275.             IF NextTask = T THEN NextTask := T.next END
  276.         END
  277.     END Remove;
  278.     PROCEDURE Collect* (count: INTEGER);
  279.     BEGIN ActCnt := count
  280.     END Collect;
  281.     PROCEDURE SetFont* (fnt: Fonts.Font);
  282.     BEGIN CurFnt := fnt
  283.     END SetFont;
  284.     PROCEDURE SetColor* (col: SHORTINT);
  285.     BEGIN CurCol := col
  286.     END SetColor;
  287.     PROCEDURE SetOffset* (voff: SHORTINT);
  288.     BEGIN CurOff := voff
  289.     END SetOffset;
  290.     PROCEDURE Loop*;
  291.         VAR V: Viewers.Viewer; M: InputMsg; N: ControlMsg;
  292.              prevX, prevY, X, Y: INTEGER; keys: SET; ch: CHAR;
  293.     BEGIN
  294.         IF (CurTask # NIL) & ~CurTask.safe THEN Remove(CurTask) END ;
  295.         LOOP
  296.             Input.Mouse(keys, X, Y);
  297.             IF Input.Available() > 0 THEN Input.Read(ch);
  298.                 IF ch < 0F0X THEN
  299.                     IF ch = ESC THEN
  300.                         N.id := neutralize; Viewers.Broadcast(N); FadeCursor(Pointer)
  301.                     ELSIF ch = SETUP THEN
  302.                         N.id := mark; N.X := X; N.Y := Y; V := Viewers.This(X, Y); V.handle(V, N)
  303.                     ELSE
  304.                         IF ch < " " THEN
  305.                             IF ch = 1X THEN ch := 83X (*
  306.                             ELSIF ch = 0FX THEN ch := 84X (*
  307.                             ELSIF ch = 15X THEN ch := 85X (*
  308.                             END
  309.                         ELSIF ch > "~" THEN
  310.                             IF ch = 81X THEN ch := 80X (*
  311.                             ELSIF ch = 8FX THEN ch := 81X (*
  312.                             ELSIF ch = 95X THEN ch := 82X (*
  313.                             END
  314.                         END;
  315.                         M.id := consume; M.ch := ch; M.fnt := CurFnt; M.col := CurCol; M.voff := CurOff;
  316.                         FocusViewer.handle(FocusViewer, M);
  317.                         DEC(ActCnt)
  318.                     END
  319.                 ELSIF ch = 0F1X THEN Display.SetMode(0, {})   (*on*)
  320.                 ELSIF ch = 0F2X THEN Display.SetMode(0, {0})  (*off*)
  321.                 ELSIF ch = 0F3X THEN Display.SetMode(0, {2})  (*inv*)
  322.                 ELSIF ch = 0F4X THEN Display.SetMode(0, {1})  (*alt*)
  323.                 END
  324.             ELSIF keys # {} THEN
  325.                 M.id := track; M.X := X; M.Y := Y; M.keys := keys;
  326.                 REPEAT
  327.                     V := Viewers.This(M.X, M.Y); V.handle(V, M);
  328.                     Input.Mouse(M.keys, M.X, M.Y)
  329.                 UNTIL M.keys = {};
  330.                 DEC(ActCnt)
  331.             ELSE
  332.                 IF (X # prevX) OR (Y # prevY) OR ~Mouse.on THEN
  333.                     M.id := track; M.X := X; M.Y := Y; M.keys := keys; V := Viewers.This(X, Y); V.handle(V, M);
  334.                     prevX := X; prevY := Y
  335.                 END;
  336.                 CurTask := NextTask; NextTask := CurTask.next;
  337.                 IF CurTask.time <= Input.Time() THEN CurTask.handle; CurTask := NIL END
  338.             END
  339.         END
  340.     END Loop;
  341. BEGIN User[0] := 0X;
  342.     Arrow.Fade := FlipArrow; Arrow.Draw := FlipArrow;
  343.     Star.Fade := FlipStar; Star.Draw := FlipStar;
  344.     OpenCursor(Mouse); OpenCursor(Pointer);
  345.     DW := Display.Width; DH := Display.Height; CL := Display.ColLeft;
  346.     H3 := DH - DH DIV 3;
  347.     H2 := H3 - H3 DIV 2;
  348.     H1 := DH DIV 5;
  349.     H0 := DH DIV 10;
  350.     unitW := DW DIV 8;
  351.     OpenDisplay(unitW * 5, unitW * 3, DH);
  352.     FocusViewer := Viewers.This(0, 0);
  353.     CurFnt := Fonts.Default;
  354.     CurCol := Display.white;
  355.     CurOff := 0;
  356.     Collect(BasicCycle);
  357.     NEW(NextTask); NextTask.handle := GC; NextTask.safe := TRUE; NextTask.time := 0;
  358.     NextTask.next := NextTask;
  359.     Display.SetMode(0, {});
  360.     Mod := Modules.ThisMod("System");
  361. END Oberon.
  362.