Oberon/V2/Rectangles

MODULE Rectangles; (*NW 25.2.90 / 1.2.92*)
 IMPORT Display, Files, Input, Printer, Texts, Oberon, Graphics, GraphicFrames;
 TYPE Rectangle* = POINTER TO RectDesc;
 RectDesc* = RECORD (Graphics.ObjectDesc)
 lw*, vers*: INTEGER
 END ;
 VAR method*: Graphics.Method;
 shade: INTEGER;
 PROCEDURE New*;
 VAR r: Rectangle;
 BEGIN NEW(r); r.do := method; Graphics.new := r
 END New;
 PROCEDURE* Copy(src, dst: Graphics.Object);
 BEGIN dst(Rectangle)^ := src(Rectangle)^
 END Copy;
 PROCEDURE mark(col, x, y: INTEGER);
 BEGIN Display.ReplConst(col, x-4, y, 4, 4, 0)
 END mark;
 PROCEDURE* Draw(obj: Graphics.Object; VAR M: Graphics.Msg);
 VAR x, y, w, h, lw, col: INTEGER; s: SET; f: GraphicFrames.Frame;
 PROCEDURE draw(col: INTEGER);
 BEGIN
 IF 0 IN s THEN Display.ReplConst(col, x, y, w, lw, 0) END ;
 IF 1 IN s THEN Display.ReplConst(col, x+w-lw, y, lw, h, 0) END ;
 IF 2 IN s THEN Display.ReplConst(col, x, y+h-lw, w, lw, 0) END ;
 IF 3 IN s THEN Display.ReplConst(col, x, y, lw, h, 0) END
 END draw;
 BEGIN
 WITH M: GraphicFrames.DrawMsg DO
 x := obj.x + M.x; y := obj.y + M.y; w := obj.w; h := obj.h; f := M.f;
 lw := obj(Rectangle).lw; s := {0..3};
 ELSIF x &lt; f.X THEN DEC(w, f.X-x); x := f.X; EXCL(s, 3)
 END ;
 ELSIF x+w &gt; f.X1 THEN w := f.X1-x; EXCL(s, 1)
 END ;
 ELSIF y &lt; f.Y THEN DEC(h, f.Y-y); y := f.Y; EXCL(s, 0)
 END ;
 ELSIF y+h &gt; f.Y1 THEN h := f.Y1-y; EXCL(s, 2)
 END ;
 IF s # {} THEN
 IF M.col = Display.black THEN col := obj.col ELSE col := M.col END ;
 IF M.mode = 0 THEN
 draw(col);
 IF obj.selected THEN mark(Display.white, x+w-lw, y+lw) END ;
 IF obj(Rectangle).vers # 0 THEN
 Display.ReplPattern(col, Display.grey0, x, y, w, h, 1)
 END
 ELSIF M.mode = 1 THEN mark(Display.white, x+w-lw, y+lw)
 ELSIF M.mode = 2 THEN mark(Display.black, x+w-lw, y+lw)
 ELSIF obj(Rectangle).vers = 0 THEN
 draw(Display.black); mark(Display.black, x+w-lw, y+lw)
 ELSE Display.ReplConst(Display.black, x, y, w, h, 0)
 END
 END
 END
 END Draw;
 PROCEDURE* Selectable(obj: Graphics.Object; x, y: INTEGER): BOOLEAN;
 BEGIN
 RETURN (obj.x + obj.w - 4 &lt;= x) &amp; (x &lt;= obj.x + obj.w) &amp; (obj.y &lt;= y) &amp; (y &lt;= obj.y + 4)
 END Selectable;
 PROCEDURE* Handle(obj: Graphics.Object; VAR M: Graphics.Msg);
 VAR x0, y0, x1, y1, dx, dy: INTEGER; k: SET;
 BEGIN
 IF M IS Graphics.WidMsg THEN obj(Rectangle).lw := M(Graphics.WidMsg).w
 ELSIF M IS Graphics.ColorMsg THEN obj.col := M(Graphics.ColorMsg).col
 ELSIF M IS GraphicFrames.CtrlMsg THEN
 WITH M: GraphicFrames.CtrlMsg DO
 WITH obj: Rectangle DO
 M.res := 1; x0 := obj.x + obj.w + M.f.x; y0 := obj.y + M.f.y;
 mark(Display.white, x0 - obj.lw, y0 + obj.lw);
 REPEAT Input.Mouse(k, x1, y1);
 DEC(x1, (x1-M.f.x) MOD 4); DEC(y1, (y1-M.f.y) MOD 4);
 Oberon.DrawCursor(Oberon.Mouse, GraphicFrames.Crosshair, x1, y1)
 UNTIL k = {};
 mark(Display.black, x0 - obj.lw, y0 + obj.lw);
 IF (x0 - obj.w &lt; x1) &amp; (y1 &lt; y0+ obj.h) THEN
 GraphicFrames.EraseObj(M.f, obj);
 dx := x1 - x0; dy := y1 - y0;
 INC(obj.y, dy); INC(obj.w, dx); DEC(obj.h, dy);
 GraphicFrames.DrawObj(M.f, obj)
 END
 END
 END
 END
 END Handle;
 
 PROCEDURE* Read(obj: Graphics.Object; VAR R: Files.Rider; VAR C: Graphics.Context);
 VAR w, v, len: SHORTINT;
 BEGIN Files.Read(R, len); Files.Read(R, w); Files.Read(R, v);
 obj(Rectangle).lw := w; obj(Rectangle).vers := v
 END Read;
 PROCEDURE* Write(obj: Graphics.Object; cno: SHORTINT;
 VAR W: Files.Rider; VAR C: Graphics.Context);
 BEGIN Graphics.WriteObj(W, cno, obj); Files.Write(W, 2);
 Files.Write(W, SHORT(obj(Rectangle).lw)); Files.Write(W, SHORT(obj(Rectangle).vers))
 END Write;
 PROCEDURE* Print(obj: Graphics.Object; x, y: INTEGER);
 VAR w, h, lw, s: INTEGER;
 BEGIN INC(x, obj.x * 4); INC(y, obj.y * 4); w := obj.w * 4; h := obj.h * 4;
 lw := obj(Rectangle).lw * 2; s := obj(Rectangle).vers;
 Printer.ReplConst(x, y, w, lw);
 Printer.ReplConst(x+w-lw, y, lw, h);
 Printer.ReplConst(x, y+h-lw, w, lw);
 Printer.ReplConst(x, y, lw, h);
 IF s &gt; 0 THEN Printer.ReplPattern(x, y, w, h, s) END
 END Print;
 PROCEDURE Make*; (*command*)
 VAR x0, x1, y0, y1: INTEGER;
 R: Rectangle;
 G: GraphicFrames.Frame;
 BEGIN G := GraphicFrames.Focus();
 IF (G # NIL) &amp; (G.mark.next # NIL) THEN
 GraphicFrames.Deselect(G);
 x0 := G.mark.x; y0 := G.mark.y; x1 := G.mark.next.x; y1 := G.mark.next.y;
 NEW(R); R.col := Oberon.CurCol;
 R.w := ABS(x1-x0); R.h := ABS(y1-y0);
 IF x1 &lt; x0 THEN x0 := x1 END ;
 IF y1 &lt; y0 THEN y0 := y1 END ;
 R.x := x0 - G.x; R.y := y0 - G.y;
 R.lw := Graphics.width; R.vers := shade; R.do := method;
 Graphics.Add(G.graph, R);
 GraphicFrames.Defocus(G); GraphicFrames.DrawObj(G, R)
 END
 END Make;
 PROCEDURE SetShade*;
 VAR S: Texts.Scanner;
 BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
 IF S.class = Texts.Int THEN shade := SHORT(S.i) END
 END SetShade;
 BEGIN shade := 0; NEW(method);
 method.module := "Rectangles"; method.allocator := "New";
 method.new := New; method.copy := Copy; method.draw := Draw;
 method.selectable := Selectable; method.handle := Handle;
 method.read := Read; method.write := Write; method.print := Print
 END Rectangles.