ESyntax10.Scn.FntSyntax10i.Scn.Fnt~ #i H!    H. S3   H, S+ ~*7` > ` |  d E } o q V#WMODULE Frames; (* gri 20.9.91 / 16.7.92 *) IMPORT Input, Display, Display1, Printer, Fonts, Texts, Oberon, MenuViewers, MathL; CONST mm* = 36000; black* = 0; white* = 15; invert* = 255; (* colors *) Ceres3 = FALSE; TYPE GraphicPort* = POINTER TO GraphicPortDesc; GraphicPortDesc* = RECORD unit-: LONGINT; (* device unit *) X-, Y-, W-, H-: INTEGER; (* clipping rectangle *) X1, Y1: INTEGER (* X1 = X+W, Y1 = Y+H *) END; DisplayPort* = POINTER TO DisplayPortDesc; DisplayPortDesc* = RECORD (GraphicPortDesc) END; ColorPort* = POINTER TO ColorPortDesc; ColorPortDesc* = RECORD (GraphicPortDesc) END; PrinterPort* = POINTER TO PrinterPortDesc; PrinterPortDesc* = RECORD (GraphicPortDesc) END; Frame* = POINTER TO FrameDesc; FrameDesc* = RECORD (Display.FrameDesc) END; GraphicFrame* = POINTER TO GraphicFrameDesc; GraphicFrameDesc* = RECORD (FrameDesc) port-: GraphicPort; X0-, Y0-: INTEGER; (* origin *) scale-: LONGINT (* zooming *) END; VAR DisplayUnit-: LONGINT; PrinterUnit-: LONGINT; NoClipping: Display.FrameDesc; (* colors *) PROCEDURE NewColor* (col, patNo: INTEGER): INTEGER; BEGIN IF (patNo < 0) OR (Display1.ThisPattern(patNo) = 0) THEN patNo := 0 END; RETURN patNo*256 + col MOD 256 END NewColor; (* graphic ports *) PROCEDURE Intersect (P: GraphicPort; VAR X, Y, W, H: INTEGER); (* W <= 0 => intersection is empty *) BEGIN IF X < P.X THEN DEC(W, P.X-X); X := P.X END; IF X+W > P.X1 THEN W := P.X1-X END; IF W <= 0 THEN RETURN END; IF Y < P.Y THEN DEC(H, P.Y-Y); Y := P.Y END; IF Y+H > P.Y1 THEN H := P.Y1-Y END; IF H <= 0 THEN W := 0 END END Intersect; PROCEDURE SetPort (P: GraphicPort; X0, Y0, W0, H0, X, Y, W, H: INTEGER; unit: LONGINT); BEGIN P.unit := unit; P.X := X0; P.Y := Y0; P.W := W0; P.H := H0; P.X1 := X0+W0; P.Y1 := Y0+H0; Intersect(P, X, Y, W, H); P.X := X; P.Y := Y; P.W := W; P.H := H; P.X1 := X+W; P.Y1 := Y+H END SetPort; PROCEDURE NewPort* (X: INTEGER): GraphicPort; VAR P1: DisplayPort; P2: ColorPort; BEGIN IF X < Display.ColLeft THEN NEW(P1); RETURN P1 ELSE NEW(P2); RETURN P2 END END NewPort; PROCEDURE (P: GraphicPort) Open* (X, Y, W, H: INTEGER); BEGIN HALT(99) END Open; PROCEDURE (P: GraphicPort) Char* (X, Y, col: INTEGER; font: Fonts.Font; ch: CHAR); BEGIN HALT(99) END Char; PROCEDURE (P: GraphicPort) String* (X, Y, col: INTEGER; font: Fonts.Font; VAR s: ARRAY OF CHAR); BEGIN HALT(99) END String; PROCEDURE (P: GraphicPort) Dot* (X, Y, col: INTEGER); BEGIN HALT(99) END Dot; PROCEDURE (P: GraphicPort) Block* (X, Y, W, H, col, X0, Y0: INTEGER); BEGIN HALT(99) END Block; PROCEDURE (P: GraphicPort) HairLine* (X1, Y1, X2, Y2, col: INTEGER); BEGIN HALT(99) END HairLine; PROCEDURE (P: GraphicPort) HairEllipse* (X, Y, A, B, col: INTEGER); BEGIN HALT(99) END HairEllipse; PROCEDURE (P: GraphicPort) MoveBlock* (X, Y, W, H, dX, dY: INTEGER); BEGIN HALT(99) END MoveBlock; (* display ports *) PROCEDURE (P: DisplayPort) Open* (X, Y, W, H: INTEGER); BEGIN SetPort(P, Display.Left, Display.UBottom, Display.Width, Display.Bottom+Display.Height-Display.UBottom, X, Y, W, H, DisplayUnit) END Open; PROCEDURE (P: DisplayPort) Char* (X, Y, col: INTEGER; font: Fonts.Font; ch: CHAR); VAR dx, x0, y0, w0, h0, x, y, w, h, mode: INTEGER; pat: Display.Pattern; BEGIN Display.GetChar(font.raster, ch, dx, x0, y0, w0, h0, pat); INC(x0, X); INC(y0, Y); x := x0; y := y0; w := w0; h := h0; Intersect(P, x, y, w, h); IF w > 0 THEN col := col MOD 256; IF col = invert THEN col := Display.white; mode := Display.invert ELSE mode := Display.paint END; IF (w = w0) & (h = h0) THEN Display.CopyPattern(col, pat, x, y, mode) ELSE Display.CopyBlock(x, y, w, h, x-x0, y-y0-h0, Display.replace); Display.CopyPattern(col, pat, 0, -h0, mode); Display.CopyBlock(x-x0, y-y0-h0, w, h, x, y, Display.replace) END END END Char; PROCEDURE (P: DisplayPort) String* (X, Y, col: INTEGER; font: Fonts.Font; VAR s: ARRAY OF CHAR); VAR i, dx, x0, y0, w0, h0, x, y, w, h, mode: INTEGER; pat: Display.Pattern; BEGIN col := col MOD 256; IF col = invert THEN col := Display.white; mode := Display.invert ELSE mode := Display.paint END; i := 0; WHILE (s[i] # 0X) & (X < P.X1) DO (* assuming that allways x, dx >= 0 *) Display.GetChar(font.raster, s[i], dx, x0, y0, w0, h0, pat); INC(x0, X); INC(y0, Y); x := x0; y := y0; w := w0; h := h0; Intersect(P, x, y, w, h); IF w > 0 THEN IF (w = w0) & (h = h0) THEN Display.CopyPattern(col, pat, x, y, mode) ELSE Display.CopyBlock(x, y, w, h, x-x0, y-y0-h0, Display.replace); Display.CopyPattern(col, pat, 0, -h0, mode); Display.CopyBlock(x-x0, y-y0-h0, w, h, x, y, Display.replace) END END; INC(X, dx); INC(i) END END String; PROCEDURE (P: DisplayPort) Dot* (X, Y, col: INTEGER); BEGIN IF (P.X <= X) & (X < P.X1) & (P.Y <= Y) & (Y < P.Y1) THEN col := col MOD 256; IF col = invert THEN Display.Dot(white, X, Y, Display.invert) ELSE Display.Dot(col, X, Y, Display.replace) END END END Dot; PROCEDURE (P: DisplayPort) Block* (X, Y, W, H, col, X0, Y0: INTEGER); VAR patNo, mode: INTEGER; BEGIN Intersect(P, X, Y, W, H); IF W > 0 THEN patNo := col DIV 256; col := col MOD 256; IF col = invert THEN col := Display.white; mode := Display.invert ELSE mode := Display.replace END; IF patNo = 0 THEN Display.ReplConst(col, X, Y, W, H, mode) ELSE Display1.ReplPattern(NoClipping, col, Display1.ThisPattern(patNo), X, Y, W, H, mode, X0, Y0) END END END Block; (* PROCEDURE (P: DisplayPort) HairLine* (X1, Y1, X2, Y2, col: INTEGER); VAR x, y, dx, dy, d, inc, L, B, R, T, mode, Xmin, Xmax, Ymin, Ymax: INTEGER; BEGIN L := P.X; B := P.Y; R := P.X1; T := P.Y1; IF X1 < X2 THEN Xmin := X1; Xmax := X2 ELSE Xmin := X2; Xmax := X1 END; IF Y1 < Y2 THEN Ymin := Y1; Ymax := Y2 ELSE Ymin := Y2; Ymax := Y1 END; IF (L <= Xmax) & (Xmin < R) & (B <= Ymax) & (Ymin < T) THEN (* line may be visible *) col := col MOD 256; IF col = invert THEN col := Display.white; mode := Display.invert ELSE mode := Display.replace END; IF (L <= Xmin) & (Xmax < R) & (B <= Ymin) & (Ymax < T) THEN (* no clipping *) Display1.Line(NoClipping, col, X1, Y1, X2, Y2, mode) ELSE (* dot-wise clipping *) IF (Y2-Y1) < (X1-X2) THEN x := X1; X1 := X2; X2 := x; y := Y1; Y1 := Y2; Y2 := y END; dx := 2*(X2-X1); dy := 2*(Y2-Y1); x := X1; y := Y1; inc := 1; IF dy > dx THEN d := dy DIV 2; IF dx < 0 THEN inc := -1; dx := -dx END; WHILE y <= Y2 DO IF (L <= x) & (x < R) & (B <= y) & (y < T) THEN Display.Dot(col, x, y, mode) END; INC(y); DEC(d, dx); IF d < 0 THEN INC(d, dy); INC(x, inc) END END ELSE d := dx DIV 2; IF dy < 0 THEN inc := -1; dy := -dy END; WHILE x <= X2 DO IF (L <= x) & (x < R) & (B <= y) & (y < T) THEN Display.Dot(col, x, y, mode) END; INC(x); DEC(d, dy); IF d < 0 THEN INC(d, dx); INC(y, inc) END END END END END END HairLine; PROCEDURE (P: DisplayPort) HairEllipse* (X, Y, A, B, col: INTEGER); (* due to B. Stamm *) VAR x, y, L, Bt, R, T, mode: INTEGER; d, dx, dy, x2, y2, a, a2, a8, b, b2, b8: LONGINT; PROCEDURE Dot4(x1, x2, y1, y2, col, mode: INTEGER); BEGIN IF (L <= x1) & (x1 < R) THEN IF (Bt <= y1) & (y1 < T) THEN Display.Dot(col, x1, y1, mode) END; IF (Bt <= y2) & (y2 < T) THEN Display.Dot(col, x1, y2, mode) END; END; IF (L <= x2) & (x2 < R) THEN IF (Bt <= y1) & (y1 < T) THEN Display.Dot(col, x2, y1, mode) END; IF (Bt <= y2) & (y2 < T) THEN Display.Dot(col, x2, y2, mode) END; END END Dot4; BEGIN L := P.X; Bt := P.Y; R := P.X1; T := P.Y1; IF (L < X+A) & (X-A < R) & (Bt < Y+B) & (Y-B < T) THEN (* ellipse may be visible *) col := col MOD 256; IF col = invert THEN col := Display.white; mode := Display.invert ELSE mode := Display.replace END; IF (L <= X-A) & (X+A <= R) & (Bt <= Y-B) & (Y+B <= T) THEN (* no clipping *) Display1.Ellipse(NoClipping, col, X, Y, A, B, mode) ELSIF A = B THEN (* circle *) DEC(A); x := A; y := 0; dx := 8*(x-1); dy := 8*y+4; d := 1 - 4*A; WHILE x > y DO Dot4(X-x-1, X+x, Y-y-1, Y+y, col, mode); Dot4(X-y-1, X+y, Y-x-1, Y+x, col, mode); INC(d, dy); INC(dy, 8); INC(y); IF d >= 0 THEN DEC(d, dx); DEC(dx, 8); DEC(x) END END; IF x = y THEN Dot4(X-x-1, X+x, Y-y-1, Y+y, col, mode) END ELSIF (A > 0) & (B > 0) THEN (* ellipse *) DEC(A); DEC(B); a := A; a2 := a*a; a8 := 8*a2; b := B; b2 := b*b; b8 := 8*b2; x := A; y := 0; x2 := a*b2; y2 := 0; dx := b8*(a-1); dy := 4*a2; d := b2*(1- 4*a); WHILE y2 < x2 DO Dot4(X-x-1, X+x, Y-y-1, Y+y, col, mode); INC(d, dy); INC(dy, a8); INC(y); INC(y2, a2); IF d >= 0 THEN DEC(d, dx); DEC(dx, b8); DEC(x); DEC(x2, b2) END END; INC(d, 4*(x2+y2)-b2+a2); WHILE x >= 0 DO Dot4(X-x-1, X+x, Y-y-1, Y+y, col, mode); DEC(d, dx); DEC(dx, b8); DEC(x); IF d < 0 THEN INC(d, dy); INC(dy, a8); INC(y) END END END END END HairEllipse; *) PROCEDURE (P: DisplayPort) HairLine* (X1, Y1, X2, Y2, col: INTEGER); VAR mode: INTEGER; F: Display.FrameDesc; BEGIN col := col MOD 256; IF col = invert THEN col := Display.white; mode := Display.invert ELSE mode := Display.replace END; F.X := P.X; F.Y := P.Y; F.W := P.W; F.H := P.H; Display1.Line(F, col, X1, Y1, X2, Y2, mode) END HairLine; PROCEDURE (P: DisplayPort) HairEllipse* (X, Y, A, B, col: INTEGER); VAR mode: INTEGER; F: Display.FrameDesc; BEGIN col := col MOD 256; IF col = invert THEN col := Display.white; mode := Display.invert ELSE mode := Display.replace END; F.X := P.X; F.Y := P.Y; F.W := P.W; F.H := P.H; Display1.Ellipse(F, col, X, Y, A, B, mode) END HairEllipse; PROCEDURE (P: DisplayPort) MoveBlock* (X, Y, W, H, dX, dY: INTEGER); BEGIN Intersect(P, X, Y, W, H); IF W > 0 THEN INC(X, dX); INC(Y, dY); Intersect(P, X, Y, W, H); IF W > 0 THEN Display.CopyBlock(X-dX, Y-dY, W, H, X, Y, Display.replace) END END END MoveBlock; (* color ports *) PROCEDURE (P: ColorPort) Open* (X, Y, W, H: INTEGER); BEGIN IF Display.ColLeft = Display.Left THEN SetPort(P, Display.Left, Display.UBottom, Display.Width, Display.Bottom+Display.Height-Display.UBottom, X, Y, W, H, DisplayUnit) ELSE SetPort(P, Display.ColLeft, Display.Bottom, Display.Width, Display.Height, X, Y, W, H, DisplayUnit) END END Open; PROCEDURE (P: ColorPort) Char* (X, Y, col: INTEGER; font: Fonts.Font; ch: CHAR); VAR dx, x0, y0, w0, h0, x, y, w, h, mode: INTEGER; pat: Display.Pattern; BEGIN Display.GetChar(font.raster, ch, dx, x0, y0, w0, h0, pat); INC(x0, X); INC(y0, Y); x := x0; y := y0; w := w0; h := h0; Intersect(P, x, y, w, h); IF w > 0 THEN col := col MOD 256; IF col = invert THEN col := Display.white; mode := Display.invert ELSE mode := Display.paint END; IF (w = w0) & (h = h0) THEN Display.CopyPattern(col, pat, x, y, mode) ELSE Display.CopyBlock(x, y, w, h, x-x0, y-y0-h0, Display.replace); Display.CopyPattern(col, pat, 0, -h0, mode); Display.CopyBlock(x-x0, y-y0-h0, w, h, x, y, Display.replace) END END END Char; PROCEDURE (P: ColorPort) String* (X, Y, col: INTEGER; font: Fonts.Font; VAR s: ARRAY OF CHAR); VAR i, dx, x0, y0, w0, h0, x, y, w, h, mode: INTEGER; pat: Display.Pattern; BEGIN col := col MOD 256; IF col = invert THEN col := Display.white; mode := Display.invert ELSE mode := Display.paint END; i := 0; WHILE (s[i] # 0X) & (X < P.X1) DO (* assuming that allways x, dx >= 0 *) Display.GetChar(font.raster, s[i], dx, x0, y0, w0, h0, pat); INC(x0, X); INC(y0, Y); x := x0; y := y0; w := w0; h := h0; Intersect(P, x, y, w, h); IF w > 0 THEN IF (w = w0) & (h = h0) THEN Display.CopyPattern(col, pat, x, y, mode) ELSE Display.CopyBlock(x, y, w, h, x-x0, y-y0-h0, Display.replace); Display.CopyPattern(col, pat, 0, -h0, mode); Display.CopyBlock(x-x0, y-y0-h0, w, h, x, y, Display.replace) END END; INC(X, dx); INC(i) END END String; PROCEDURE (P: ColorPort) Dot* (X, Y, col: INTEGER); BEGIN IF (P.X <= X) & (X < P.X1) & (P.Y <= Y) & (Y < P.Y1) THEN col := col MOD 256; IF col = invert THEN Display.Dot(white, X, Y, Display.invert) ELSE Display.Dot(col, X, Y, Display.replace) END END END Dot; PROCEDURE (P: ColorPort) Block* (X, Y, W, H, col, X0, Y0: INTEGER); VAR patNo, mode: INTEGER; BEGIN Intersect(P, X, Y, W, H); IF W > 0 THEN patNo := col DIV 256; col := col MOD 256; IF col = invert THEN col := Display.white; mode := Display.invert ELSE mode := Display.replace END; IF patNo = 0 THEN Display.ReplConst(col, X, Y, W, H, mode) ELSE Display1.ReplPattern(NoClipping, col, Display1.ThisPattern(patNo), X, Y, W, H, mode, X0, Y0) END END END Block; (* PROCEDURE (P: ColorPort) HairLine* (X1, Y1, X2, Y2, col: INTEGER); VAR x, y, dx, dy, d, inc, L, B, R, T, mode, Xmin, Xmax, Ymin, Ymax: INTEGER; BEGIN L := P.X; B := P.Y; R := P.X1; T := P.Y1; IF X1 < X2 THEN Xmin := X1; Xmax := X2 ELSE Xmin := X2; Xmax := X1 END; IF Y1 < Y2 THEN Ymin := Y1; Ymax := Y2 ELSE Ymin := Y2; Ymax := Y1 END; IF (L <= Xmax) & (Xmin < R) & (B <= Ymax) & (Ymin < T) THEN (* line may be visible *) col := col MOD 256; IF col = invert THEN col := Display.white; mode := Display.invert ELSE mode := Display.replace END; IF (L <= Xmin) & (Xmax < R) & (B <= Ymin) & (Ymax < T) THEN (* no clipping *) Display1.Line(NoClipping, col, X1, Y1, X2, Y2, mode) ELSE (* dot-wise clipping *) IF (Y2-Y1) < (X1-X2) THEN x := X1; X1 := X2; X2 := x; y := Y1; Y1 := Y2; Y2 := y END; dx := 2*(X2-X1); dy := 2*(Y2-Y1); x := X1; y := Y1; inc := 1; IF dy > dx THEN d := dy DIV 2; IF dx < 0 THEN inc := -1; dx := -dx END; WHILE y <= Y2 DO IF (L <= x) & (x < R) & (B <= y) & (y < T) THEN Display.Dot(col, x, y, mode) END; INC(y); DEC(d, dx); IF d < 0 THEN INC(d, dy); INC(x, inc) END END ELSE d := dx DIV 2; IF dy < 0 THEN inc := -1; dy := -dy END; WHILE x <= X2 DO IF (L <= x) & (x < R) & (B <= y) & (y < T) THEN Display.Dot(col, x, y, mode) END; INC(x); DEC(d, dy); IF d < 0 THEN INC(d, dx); INC(y, inc) END END END END END END HairLine; PROCEDURE (P: ColorPort) HairEllipse* (X, Y, A, B, col: INTEGER); (* due to B. Stamm *) VAR x, y, L, Bt, R, T, mode: INTEGER; d, dx, dy, x2, y2, a, a2, a8, b, b2, b8: LONGINT; PROCEDURE Dot4(x1, x2, y1, y2, col, mode: INTEGER); BEGIN IF (L <= x1) & (x1 < R) THEN IF (Bt <= y1) & (y1 < T) THEN Display.Dot(col, x1, y1, mode) END; IF (Bt <= y2) & (y2 < T) THEN Display.Dot(col, x1, y2, mode) END; END; IF (L <= x2) & (x2 < R) THEN IF (Bt <= y1) & (y1 < T) THEN Display.Dot(col, x2, y1, mode) END; IF (Bt <= y2) & (y2 < T) THEN Display.Dot(col, x2, y2, mode) END; END END Dot4; BEGIN L := P.X; Bt := P.Y; R := P.X1; T := P.Y1; IF (L < X+A) & (X-A < R) & (Bt < Y+B) & (Y-B < T) THEN (* ellipse may be visible *) col := col MOD 256; IF col = invert THEN col := Display.white; mode := Display.invert ELSE mode := Display.replace END; IF (L <= X-A) & (X+A <= R) & (Bt <= Y-B) & (Y+B <= T) THEN (* no clipping *) Display1.Ellipse(NoClipping, col, X, Y, A, B, mode) ELSIF A = B THEN (* circle *) DEC(A); x := A; y := 0; dx := 8*(x-1); dy := 8*y+4; d := 1 - 4*A; WHILE x > y DO Dot4(X-x-1, X+x, Y-y-1, Y+y, col, mode); Dot4(X-y-1, X+y, Y-x-1, Y+x, col, mode); INC(d, dy); INC(dy, 8); INC(y); IF d >= 0 THEN DEC(d, dx); DEC(dx, 8); DEC(x) END END; IF x = y THEN Dot4(X-x-1, X+x, Y-y-1, Y+y, col, mode) END ELSIF (A > 0) & (B > 0) THEN (* ellipse *) DEC(A); DEC(B); a := A; a2 := a*a; a8 := 8*a2; b := B; b2 := b*b; b8 := 8*b2; x := A; y := 0; x2 := a*b2; y2 := 0; dx := b8*(a-1); dy := 4*a2; d := b2*(1- 4*a); WHILE y2 < x2 DO Dot4(X-x-1, X+x, Y-y-1, Y+y, col, mode); INC(d, dy); INC(dy, a8); INC(y); INC(y2, a2); IF d >= 0 THEN DEC(d, dx); DEC(dx, b8); DEC(x); DEC(x2, b2) END END; INC(d, 4*(x2+y2)-b2+a2); WHILE x >= 0 DO Dot4(X-x-1, X+x, Y-y-1, Y+y, col, mode); DEC(d, dx); DEC(dx, b8); DEC(x); IF d < 0 THEN INC(d, dy); INC(dy, a8); INC(y) END END END END END HairEllipse; *) PROCEDURE (P: ColorPort) HairLine* (X1, Y1, X2, Y2, col: INTEGER); VAR mode: INTEGER; F: Display.FrameDesc; BEGIN col := col MOD 256; IF col = invert THEN col := Display.white; mode := Display.invert ELSE mode := Display.replace END; F.X := P.X; F.Y := P.Y; F.W := P.W; F.H := P.H; Display1.Line(F, col, X1, Y1, X2, Y2, mode) END HairLine; PROCEDURE (P: ColorPort) HairEllipse* (X, Y, A, B, col: INTEGER); VAR mode: INTEGER; F: Display.FrameDesc; BEGIN col := col MOD 256; IF col = invert THEN col := Display.white; mode := Display.invert ELSE mode := Display.replace END; F.X := P.X; F.Y := P.Y; F.W := P.W; F.H := P.H; Display1.Ellipse(F, col, X, Y, A, B, mode) END HairEllipse; PROCEDURE (P: ColorPort) MoveBlock* (X, Y, W, H, dX, dY: INTEGER); BEGIN Intersect(P, X, Y, W, H); IF W > 0 THEN INC(X, dX); INC(Y, dY); Intersect(P, X, Y, W, H); IF W > 0 THEN Display.CopyBlock(X-dX, Y-dY, W, H, X, Y, Display.replace) END END END MoveBlock; (* printer ports *) PROCEDURE (P: PrinterPort) Open* (X, Y, W, H: INTEGER); BEGIN SetPort(P, 0, 0, 2200, 3300, X, Y, W, H, PrinterUnit) (* measured size of Pluto: W = 2311, H = 3425 *) END Open; PROCEDURE (P: PrinterPort) Char* (X, Y, col: INTEGER; font: Fonts.Font; ch: CHAR); VAR s: ARRAY 2 OF CHAR; BEGIN IF (P.X <= X) & (X < P.X1) & (P.Y <= Y) & (Y < P.Y1) THEN s[0] := ch; s[1] := 0X; Printer.String(X, Y, s, font.name) END END Char; PROCEDURE (P: PrinterPort) String* (X, Y, col: INTEGER; font: Fonts.Font; VAR s: ARRAY OF CHAR); BEGIN IF (P.X <= X) & (X < P.X1) & (P.Y <= Y) & (Y < P.Y1) THEN Printer.String(X, Y, s, font.name) END END String; PROCEDURE (P: PrinterPort) Dot* (X, Y, col: INTEGER); BEGIN IF (P.X <= X) & (X < P.X1) & (P.Y <= Y) & (Y < P.Y1) THEN Printer.ReplConst(X, Y, 1, 1) END END Dot; PROCEDURE (P: PrinterPort) Block* (X, Y, W, H, col, X0, Y0: INTEGER); BEGIN Intersect(P, X, Y, W, H); IF W > 0 THEN IF col DIV 256 = 0 THEN Printer.ReplConst(X, Y, W, H) ELSE Printer.ReplPattern(X, Y, W, H, col DIV 256) END END END Block; PROCEDURE (P: PrinterPort) HairLine* (X1, Y1, X2, Y2, col: INTEGER); BEGIN Printer.Line(X1, Y1, X2, Y2) END HairLine; PROCEDURE (P: PrinterPort) HairEllipse* (X, Y, A, B, col: INTEGER); BEGIN IF A = B THEN Printer.Circle(X, Y, A) ELSE Printer.Ellipse(X, Y, A, B) END END HairEllipse; (* frames *) PROCEDURE (F: Frame) Consume* (ch: CHAR; fnt: Fonts.Font; col, voff: SHORTINT); END Consume; PROCEDURE (F: Frame) TrackMouse* (VAR X, Y: INTEGER; VAR keySum: SET); END TrackMouse; PROCEDURE (F: Frame) Defocus*; END Defocus; PROCEDURE (F: Frame) Neutralize*; END Neutralize; PROCEDURE (F: Frame) GetSelection* (VAR text: Texts.Text; VAR beg, end, time: LONGINT); END GetSelection; PROCEDURE (F: Frame) CopyOver* (text: Texts.Text; beg, end: LONGINT); END CopyOver; PROCEDURE (F: Frame) Copy* (): Frame; BEGIN HALT(99) END Copy; PROCEDURE (F: Frame) Modify* (Y, H: INTEGER); BEGIN HALT(99) END Modify; PROCEDURE (F: Frame) Handle* (VAR msg: Display.FrameMsg); END Handle; PROCEDURE Handle* (F: Display.Frame; VAR msg: Display.FrameMsg); VAR X, Y: INTEGER; keys: SET; BEGIN WITH F: Frame DO IF msg IS Oberon.InputMsg THEN WITH msg: Oberon.InputMsg DO IF msg.id = Oberon.consume THEN F.Consume(msg.ch, msg.fnt, msg.col, msg.voff) ELSIF msg.id = Oberon.track THEN X := msg.X; Y := msg.Y; keys := msg.keys; F.TrackMouse(X, Y, keys); END END ELSIF msg IS Oberon.ControlMsg THEN WITH msg: Oberon.ControlMsg DO IF msg.id = Oberon.defocus THEN F.Defocus ELSIF msg.id = Oberon.neutralize THEN F.Neutralize END END ELSIF msg IS Oberon.SelectionMsg THEN WITH msg: Oberon.SelectionMsg DO F.GetSelection(msg.text, msg.beg, msg.end, msg.time) END ELSIF msg IS Oberon.CopyOverMsg THEN WITH msg: Oberon.CopyOverMsg DO F.CopyOver(msg.text, msg.beg, msg.end) END ELSIF msg IS Oberon.CopyMsg THEN msg(Oberon.CopyMsg).F := F.Copy() ELSIF msg IS MenuViewers.ModifyMsg THEN WITH msg: MenuViewers.ModifyMsg DO F.Modify(msg.Y, msg.H) END ELSE F.Handle(msg) END END END Handle; (* graphic frames *) PROCEDURE PollMouse; (* mouse polling ensures smooth mouse tracking on Ceres-3 *) VAR keys: SET; X, Y: INTEGER; BEGIN Input.Mouse(keys, X, Y) END PollMouse; PROCEDURE (F: GraphicFrame) Open* (handle: Display.Handler; port: GraphicPort; X0, Y0: INTEGER; scale: LONGINT); BEGIN F.handle := handle; F.port := port; F.X0 := X0; F.Y0 := Y0; IF scale = 0 THEN F.scale := 1 ELSE F.scale := scale END END Open; PROCEDURE (F: GraphicFrame) ToGlobal* (X, Y: INTEGER; VAR x, y: LONGINT); VAR unit: LONGINT; BEGIN IF F.scale < 0 THEN unit := -F.scale*F.port.unit; x := (X - F.X - F.X0)*unit; y := (Y - F.Y - F.H - F.Y0)*unit ELSE unit := F.port.unit; x := (X - F.X - F.X0)*unit DIV F.scale; y := (Y - F.Y - F.H - F.Y0)*unit DIV F.scale END END ToGlobal; PROCEDURE (F: GraphicFrame) ToLocal* (x, y: LONGINT; VAR X, Y: INTEGER); VAR unit: LONGINT; BEGIN IF F.scale < 0 THEN unit := -F.scale*F.port.unit; X := SHORT(F.X + F.X0 + x DIV unit); Y := SHORT(F.Y + F.H + F.Y0 + y DIV unit) ELSE unit := F.port.unit; X := SHORT(F.X + F.X0 + x*F.scale DIV unit); Y := SHORT(F.Y + F.H + F.Y0 + y*F.scale DIV unit) END END ToLocal; PROCEDURE (F: GraphicFrame) Place* (handle: Display.Handler; port: GraphicPort; x0, y0, scale: LONGINT); VAR X0, Y0: INTEGER; BEGIN F.X := port.X; F.Y := port.Y; F.W := port.W; F.H := port.H; F.Open(handle, port, 0, 0, scale); F.ToLocal(x0, y0, X0, Y0); F.Open(handle, port, F.X-X0, F.Y+F.H-Y0, scale) END Place; PROCEDURE (F: GraphicFrame) Char* (x, y: LONGINT; col: INTEGER; font: Fonts.Font; ch: CHAR); VAR X, Y: INTEGER; BEGIN IF F.scale >= 1 THEN F.ToLocal(x, y, X, Y); F.port.Char(X, Y, col, font, ch) END END Char; PROCEDURE (F: GraphicFrame) String* (x, y: LONGINT; col: INTEGER; font: Fonts.Font; VAR s: ARRAY OF CHAR); VAR X, Y: INTEGER; BEGIN IF F.scale >= 1 THEN F.ToLocal(x, y, X, Y); F.port.String(X, Y, col, font, s) END END String; PROCEDURE (F: GraphicFrame) Dot* (x, y: LONGINT; col: INTEGER); VAR X, Y: INTEGER; BEGIN F.ToLocal(x, y, X, Y); F.port.Dot(X, Y, col) END Dot; PROCEDURE (F: GraphicFrame) Block* (x, y, w, h: LONGINT; col: INTEGER); VAR X0, Y0, L, B, R, T: INTEGER; BEGIN IF Ceres3 THEN PollMouse END; F.ToLocal(0, 0, X0, Y0); F.ToLocal(x, y, L, B); F.ToLocal(x+w, y+h, R, T); F.port.Block(L, B, R-L, T-B, col, X0, Y0) END Block; PROCEDURE (F: GraphicFrame) Quadrangle* (x1, y1, x2, y2, x3, y3, x4, y4: LONGINT; col: INTEGER); (* due to B. Stamm *) TYPE LineParms = RECORD x, y, d, dx, dy, inx, iny, drawX, drawY: INTEGER END; VAR P: GraphicPort; left, right: LineParms; X0, Y0, X1, Y1, X2, Y2, X3, Y3, X4, Y4, X, Y, RHS2, RHS3, Xmin, Xmax, Ymin, Ymax: INTEGER; PROCEDURE MinMax(x1, x2, x3, x4: INTEGER; VAR min, max: INTEGER); BEGIN min := x1; max := x1; IF x2 < min THEN min := x2 ELSIF x2 > max THEN max := x2 END; IF x3 < min THEN min := x3 ELSIF x3 > max THEN max := x3 END; IF x4 < min THEN min := x4 ELSIF x4 > max THEN max := x4 END END MinMax; PROCEDURE InitLineParms(x1, y1, x2, y2: INTEGER; VAR p: LineParms); BEGIN p.x := x1; p.dx := x2-x1; IF p.dx > 0 THEN p.inx := 1 ELSIF p.dx < 0 THEN p.inx := -1; p.dx := -p.dx ELSE p.inx := 0 END; p.y := y1; p.dy := y2-y1; IF p.dy > 0 THEN p.iny := 1 ELSIF p.dy < 0 THEN p.iny := -1; p.dy := -p.dy ELSE p.iny := 0 END; p.d := p.dy - p.dx; p.dx := 2*p.dx; p.dy := 2*p.dy; END InitLineParms; PROCEDURE LineStep(VAR p: LineParms); (* H = (d(x, y) := (2*x - 2*x1 + 1)*dy - (2*y - 2*y1 + 1)*dx < 0) *) BEGIN WHILE p.d < 0 DO INC(p.x, p.inx); INC(p.d, p.dy) END; p.drawX := p.x; p.drawY := p.iny DIV 2 + p.y; DEC(p.d, p.dx); INC(p.y, p.iny); END LineStep; BEGIN IF Ceres3 THEN PollMouse END; P := F.port; F.ToLocal(x1, y1, X1, Y1); F.ToLocal(x2, y2, X2, Y2); F.ToLocal(x3, y3, X3, Y3); F.ToLocal(x4, y4, X4, Y4); MinMax(X1, X2, X3, X4, Xmin, Xmax); MinMax(Y1, Y2, Y3, Y4, Ymin, Ymax); IF (P.X < Xmax) & (Xmin < P.X1) & (P.Y < Ymax) & (Ymin < P.Y1) THEN (* quadrangle may be visible *) F.ToLocal(0, 0, X0, Y0); IF (Y1 > Y2) OR (Y1 = Y2) & (X1 > X2) THEN X := X1; X1 := X2; X2 := X; Y := Y1; Y1 := Y2; Y2 := Y END; IF (Y2 > Y3) OR (Y2 = Y3) & (X2 > X3) THEN X := X2; X2 := X3; X3 := X; Y := Y2; Y2 := Y3; Y3 := Y END; IF (Y3 > Y4) OR (Y3 = Y4) & (X3 > X4) THEN X := X3; X3 := X4; X4 := X; Y := Y3; Y3 := Y4; Y4 := Y END; IF (Y1 > Y2) OR (Y1 = Y2) & (X1 > X2) THEN X := X1; X1 := X2; X2 := X; Y := Y1; Y1 := Y2; Y2 := Y END; IF (Y2 > Y3) OR (Y2 = Y3) & (X2 > X3) THEN X := X2; X2 := X3; X3 := X; Y := Y2; Y2 := Y3; Y3 := Y END; IF (Y1 > Y2) OR (Y1 = Y2) & (X1 > X2) THEN X := X1; X1 := X2; X2 := X; Y := Y1; Y1 := Y2; Y2 := Y END; IF LONG(X2-X1)*LONG(Y4-Y1) > LONG(Y2-Y1)*LONG(X4-X1) THEN RHS2 := 2 ELSE RHS2 := 0 END; IF LONG(X3-X1)*LONG(Y4-Y1) > LONG(Y3-Y1)*LONG(X4-X1) THEN RHS3 := 1 ELSE RHS3 := 0 END; CASE RHS2 + RHS3 OF | 0: InitLineParms(X1, Y1, X2, Y2, left); InitLineParms(X1, Y1, X4, Y4, right); | 1: InitLineParms(X1, Y1, X2, Y2, left); InitLineParms(X1, Y1, X3, Y3, right); | 2: InitLineParms(X1, Y1, X3, Y3, left); InitLineParms(X1, Y1, X2, Y2, right); | 3: InitLineParms(X1, Y1, X4, Y4, left); InitLineParms(X1, Y1, X2, Y2, right); END; WHILE left.y # Y2 DO LineStep(left); LineStep(right); P.Block(left.drawX, left.drawY, right.drawX-left.drawX, 1, col, X0, Y0) END; CASE RHS2 + RHS3 OF | 0: InitLineParms(X2, Y2, X3, Y3, left); | 1: InitLineParms(X2, Y2, X4, Y4, left); | 2: InitLineParms(X2, Y2, X4, Y4, right); | 3: InitLineParms(X2, Y2, X3, Y3, right); END; WHILE left.y # Y3 DO LineStep(left); LineStep(right); P.Block(left.drawX, left.drawY, right.drawX-left.drawX, 1, col, X0, Y0) END; CASE RHS2 + RHS3 OF | 0, 2: InitLineParms(X3, Y3, X4, Y4, left); | 1, 3: InitLineParms(X3, Y3, X4, Y4, right); END; WHILE left.y # Y4 DO LineStep(left); LineStep(right); P.Block(left.drawX, left.drawY, right.drawX-left.drawX, 1, col, X0, Y0) END END END Quadrangle; PROCEDURE (F: GraphicFrame) Rect* (x, y, w, h, d: LONGINT; col: INTEGER); VAR X0, Y0, L, B, R, T, Li, Bi, Ri, Ti: INTEGER; P: GraphicPort; BEGIN IF Ceres3 THEN PollMouse END; P := F.port; F.ToLocal(x, y, L, B); F.ToLocal(x+w, y+h, R, T); IF (P.X < R) & (L < P.X1) & (P.Y < T) & (B < P.Y1) THEN (* rectangle may be visible *) IF d <= 0 THEN (* hair rectangle *) Li := L+1; Bi := B+1; Ri := R-1; Ti := T-1; col := col MOD 256; X0 := 0; Y0 := 0 (* ignore pattern *) ELSE (* thick rectangle *) F.ToLocal(0, 0, X0, Y0); F.ToLocal(x+d, y+d, Li, Bi); F.ToLocal(x+w-d, y+h-d, Ri, Ti) END; IF (Li < Ri) & (Bi < Ti) THEN P.Block(L, B, R-L, Bi-B, col, X0, Y0); P.Block(L, Ti, R-L, T-Ti, col, X0, Y0); P.Block(L, Bi, Li-L, Ti-Bi, col, X0, Y0); P.Block(Ri, Bi, R-Ri, Ti-Bi, col, X0, Y0) ELSE P.Block(L, B, R-L, T-B, col, X0, Y0) END END END Rect; PROCEDURE (F: GraphicFrame) Line* (x1, y1, x2, y2, d: LONGINT; col: INTEGER); VAR X1, Y1, X2, Y2: INTEGER; dx, dy, c: LONGREAL; u1, v1, u2, v2, u3, v3, u4, v4: LONGINT; BEGIN IF Ceres3 THEN PollMouse END; IF d <= 0 THEN F.ToLocal(x1, y1, X1, Y1); F.ToLocal(x2, y2, X2, Y2); F.port.HairLine(X1, Y1, X2, Y2, col) ELSE (* thick line *) dx := x2-x1; dy := y2-y1; c := 2 * MathL.sqrt(dx*dx + dy*dy); IF c > 0 THEN c := d/c; dx := dx*c; dy := dy*c; u1 := ENTIER(x1-dy); v1 := ENTIER(y1+dx); u2 := ENTIER(x1+dy); v2 := ENTIER(y1-dx); u3 := ENTIER(x2-dy); v3 := ENTIER(y2+dx); u4 := ENTIER(x2+dy); v4 := ENTIER(y2-dx); F.Quadrangle(u1, v1, u2, v2, u3, v3, u4, v4, col) END END END Line; PROCEDURE (F: GraphicFrame) Ellipse* (x, y, a, b, d: LONGINT; col: INTEGER); VAR X0, Y0, X1, Y1, X2, Y2, X1i, Y1i, X2i, Y2i, A, B, Ai, Bi: INTEGER; P: GraphicPort; line: ARRAY 4096 OF RECORD x1, x2, x3, x4: INTEGER END; PROCEDURE Line2(P: GraphicPort; x, y1, y2, w, h, col, X0, Y0: INTEGER); BEGIN P.Block(x, y1, w, h, col, X0, Y0); P.Block(x, y2, w, h, col, X0, Y0) END Line2; PROCEDURE Line2o(x, y1, y2, w, h: INTEGER); VAR yt: INTEGER; BEGIN yt := y1+h; IF y1 < 0 THEN y1 := 0 END; IF yt > LEN(line) THEN yt := LEN(line) END; WHILE y1 < yt DO line[y1].x1 := x; line[y1].x2 := x; line[y1].x3 := x; line[y1].x4 := x+w; INC(y1) END; yt := y2+h; IF y2 < 0 THEN y2 := 0 END; IF yt > LEN(line) THEN yt := LEN(line) END; WHILE y2 < yt DO line[y2].x1 := x; line[y2].x2 := x; line[y2].x3 := x; line[y2].x4 := x+w; INC(y2) END END Line2o; PROCEDURE Line2i(x, y1, y2, w, h: INTEGER); VAR yt: INTEGER; BEGIN yt := y1+h; IF y1 < 0 THEN y1 := 0 END; IF yt > LEN(line) THEN yt := LEN(line) END; WHILE y1 < yt DO line[y1].x2 := x; line[y1].x3 := x+w; INC(y1) END; yt := y2+h; IF y2 < 0 THEN y2 := 0 END; IF yt > LEN(line) THEN yt := LEN(line) END; WHILE y2 < yt DO line[y2].x2 := x; line[y2].x3 := x+w; INC(y2) END END Line2i; PROCEDURE ScanLines(P: GraphicPort; y, h, y0, col, X0, Y0: INTEGER); VAR yt, x1, x2, x3, x4: INTEGER; BEGIN yt := y+h; IF y < 0 THEN y := 0 END; IF yt > LEN(line) THEN yt := LEN(line) END; WHILE y < yt DO x1 := line[y].x1; x2 := line[y].x2; x3 := line[y].x3; x4 := line[y].x4; IF x2 < x3 THEN P.Block(x1, y0+y, x2-x1, 1, col, X0, Y0); P.Block(x3, y0+y, x4-x3, 1, col, X0, Y0) ELSE P.Block(x1, y0+y, x4-x1, 1, col, X0, Y0) END; INC(y) END END ScanLines; PROCEDURE ThickCircle(P: GraphicPort; X, Y, R, Ri, col, X0, Y0: INTEGER); VAR x, y, d, dx, dy, yb: INTEGER; BEGIN DEC(R); DEC(Ri); x := R; y := 0; dx := 8*(x-1); dy := 8*y+4; d := 1 - 4*R; yb := 0; IF Ri < 0 THEN (* filled circle *) WHILE x > y DO INC(d, dy); INC(dy, 8); INC(y); IF d >= 0 THEN Line2(P, X-x-1, Y-y, Y+yb, 2*(x+1), y-yb, col, X0, Y0); Line2(P, X-y, Y-x-1, Y+x, 2*y, 1, col, X0, Y0); DEC(d, dx); DEC(dx, 8); DEC(x); yb := y END END; IF x = y THEN INC(y); Line2(P, X-x-1, Y-y, Y+yb, 2*(x+1), y-yb, col, X0, Y0) END ELSE (* outer circle *) DEC(Y, P.Y); WHILE x > y DO INC(d, dy); INC(dy, 8); INC(y); IF d >= 0 THEN Line2o(X-x-1, Y-y, Y+yb, 2*(x+1), y-yb); Line2o(X-y, Y-x-1, Y+x, 2*y, 1); DEC(d, dx); DEC(dx, 8); DEC(x); yb := y END END; IF x = y THEN INC(y); Line2o(X-x-1, Y-y, Y+yb, 2*(x+1), y-yb) END; (* inner circle *) x := Ri; y := 0; dx := 8*(x-1); dy := 8*y+4; d := 1 - 4*Ri; yb := 0; WHILE x > y DO INC(d, dy); INC(dy, 8); INC(y); IF d >= 0 THEN Line2i(X-x-1, Y-y, Y+yb, 2*(x+1), y-yb); Line2i(X-y, Y-x-1, Y+x, 2*y, 1); DEC(d, dx); DEC(dx, 8); DEC(x); yb := y END END; IF x = y THEN INC(y); Line2i(X-x-1, Y-y, Y+yb, 2*(x+1), y-yb) END; (* drawing *) ScanLines(P, Y-R-1, 2*R+2, P.Y, col, X0, Y0) END END ThickCircle; PROCEDURE ThickEllipse(P: GraphicPort; X, Y, A, B, Ai, Bi, col, X0, Y0: INTEGER); VAR x, y, xb, yb: INTEGER; d, dx, dy, x2, y2, a, a2, a8, b, b2, b8: LONGINT; BEGIN IF (A > 0) & (B > 0) THEN DEC(A); DEC(Ai); DEC(B); DEC(Bi); a := A; a2 := a*a; a8 := 8*a2; b := B; b2 := b*b; b8 := 8*b2; x := A; y := 0; x2 := a*b2; y2 := 0; dx := b8*(a-1); dy := 4*a2; d := b2*(1- 4*a); yb := 0; IF (Ai < 0) OR (Bi < 0) THEN (* filled ellipse *) WHILE y2 < x2 DO INC(d, dy); INC(dy, a8); INC(y); INC(y2, a2); IF d >= 0 THEN Line2(P, X-x-1, Y-y, Y+yb, 2*(x+1), y-yb, col, X0, Y0); DEC(d, dx); DEC(dx, b8); DEC(x); DEC(x2, b2); yb := y END END; IF y > yb THEN Line2(P, X-x-1, Y-y-1, Y+yb, 2*(x+1), y-yb+1, col, X0, Y0) END; INC(d, 4*(x2+y2)-b2+a2); xb := x; WHILE x >= 0 DO DEC(d, dx); DEC(dx, b8); DEC(x); IF d < 0 THEN Line2(P, X-xb-1, Y-y-1, Y+y, 2*(xb+1), 1, col, X0, Y0); INC(d, dy); INC(dy, a8); INC(y); xb := x END END; IF x < xb THEN Line2(P, X-xb-1, Y-y-1, Y+y, 2*(xb+1), 1, col, X0, Y0) END ELSE (* outer ellipse *) DEC(Y, P.Y); WHILE y2 < x2 DO INC(d, dy); INC(dy, a8); INC(y); INC(y2, a2); IF d >= 0 THEN Line2o(X-x-1, Y-y, Y+yb, 2*(x+1), y-yb); DEC(d, dx); DEC(dx, b8); DEC(x); DEC(x2, b2); yb := y END END; IF y > yb THEN Line2o(X-x-1, Y-y-1, Y+yb, 2*(x+1), y-yb+1) END; INC(d, 4*(x2+y2)-b2+a2); xb := x; WHILE x >= 0 DO DEC(d, dx); DEC(dx, b8); DEC(x); IF d < 0 THEN Line2o(X-xb-1, Y-y-1, Y+y, 2*(xb+1), 1); INC(d, dy); INC(dy, a8); INC(y); xb := x END END; IF x < xb THEN Line2o(X-xb-1, Y-y-1, Y+y, 2*(xb+1), 1) END; (* inner ellipse *) a := Ai; a2 := a*a; a8 := 8*a2; b := Bi; b2 := b*b; b8 := 8*b2; x := Ai; y := 0; x2 := a*b2; y2 := 0; dx := b8*(a-1); dy := 4*a2; d := b2*(1- 4*a); yb := 0; WHILE y2 < x2 DO INC(d, dy); INC(dy, a8); INC(y); INC(y2, a2); IF d >= 0 THEN Line2i(X-x-1, Y-y, Y+yb, 2*(x+1), y-yb); DEC(d, dx); DEC(dx, b8); DEC(x); DEC(x2, b2); yb := y END END; IF y > yb THEN Line2i(X-x-1, Y-y-1, Y+yb, 2*(x+1), y-yb+1) END; INC(d, 4*(x2+y2)-b2+a2); xb := x; WHILE x >= 0 DO DEC(d, dx); DEC(dx, b8); DEC(x); IF d < 0 THEN Line2i(X-xb-1, Y-y-1, Y+y, 2*(xb+1), 1); INC(d, dy); INC(dy, a8); INC(y); xb := x END END; IF x < xb THEN Line2i(X-xb-1, Y-y-1, Y+y, 2*(xb+1), 1) END; (* drawing *) ScanLines(P, Y-B-1, 2*B+2, P.Y, col, X0, Y0) END END END ThickEllipse; BEGIN IF Ceres3 THEN PollMouse END; P := F.port; F.ToLocal(x-a, y-b, X1, Y1); F.ToLocal(x+a, y+b, X2, Y2); IF (P.X < X2) & (X1 < P.X1) & (P.Y < Y2) & (Y1 < P.Y1) THEN (* ellipse may be visible *) A := (X2-X1) DIV 2; B := (Y2-Y1) DIV 2; IF d <= 0 THEN P.HairEllipse(X1+A, Y1+B, A, B, col) ELSE (* thick ellipse *) F.ToLocal(0, 0, X0, Y0); F.ToLocal(x-a+d, y-b+d, X1i, Y1i); F.ToLocal(x+a-d, y+b-d, X2i, Y2i); Ai := (X2i-X1i) DIV 2; Bi := (Y2i-Y1i) DIV 2; IF (A = B) & (Ai = Bi) THEN ThickCircle(P, X1+A, Y1+B, A, Ai, col, X0, Y0) ELSE ThickEllipse(P, X1+A, Y1+B, A, B, Ai, Bi, col, X0, Y0) END END END END Ellipse; PROCEDURE (F: GraphicFrame) TrackMouse* (VAR X, Y: INTEGER; VAR keySum: SET); VAR keys: SET; BEGIN LOOP Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y); Input.Mouse(keys, X, Y); IF keys = {} THEN EXIT END; keySum := keySum + keys END END TrackMouse; PROCEDURE (F: GraphicFrame) Copy* (): Frame; VAR CopyOfF: GraphicFrame; BEGIN NEW(CopyOfF); CopyOfF.Open(F.handle, F.port, F.X0, F.Y0, F.scale); RETURN CopyOfF END Copy; PROCEDURE (F: GraphicFrame) Restore* (X, Y, W, H: INTEGER); BEGIN IF Ceres3 THEN PollMouse END; Oberon.RemoveMarks(X, Y, W, H); F.port.Open(X, Y, W, H); F.port.Block(X, Y, W, H, black, 0, 0) END Restore; PROCEDURE (F: GraphicFrame) MoveOrigin* (dX, dY: INTEGER); VAR x1, y1, x2, y2, w, h: INTEGER; BEGIN IF Ceres3 THEN PollMouse END; INC(F.X0, dX); INC(F.Y0, dY); IF dX < 0 THEN x1 := F.X-dX ELSE x1 := F.X END; x2 := x1+dX; w := F.W-ABS(dX); IF dY < 0 THEN y1 := F.Y-dY ELSE y1 := F.Y END; y2 := y1+dY; h := F.H-ABS(dY); IF (w > 0) & (h > 0) THEN Oberon.RemoveMarks(F.X, F.Y, F.W, F.H); F.port.Open(F.X, F.Y, F.W, F.H); F.port.MoveBlock(F.X, F.Y, F.W, F.H, dX, dY); IF dY > 0 THEN F.Restore(F.X, F.Y, F.W, dY) ELSIF dY < 0 THEN F.Restore(F.X, y2+h, F.W, -dY) END; IF dX > 0 THEN F.Restore(F.X, y2, dX, h) ELSIF dX < 0 THEN F.Restore(x2+w, y2, -dX, h) END ELSE F.Restore(F.X, F.Y, F.W, F.H) END END MoveOrigin; PROCEDURE (F: GraphicFrame) Modify* (Y, H: INTEGER); VAR dH: INTEGER; BEGIN dH := H-F.H; IF dH > 0 THEN (* extend *) IF F.H = 0 THEN F.Open(F.handle, NewPort(F.X), F.X0, F.Y0, F.scale) END; IF F.Y+F.H # Y+H THEN Display.CopyBlock(F.X, F.Y, F.W, F.H, F.X, Y+dH, Display.replace) END; F.Y := Y; F.H := H; F.Restore(F.X, F.Y, F.W, dH) ELSIF dH < 0 THEN (* reduce *) IF F.Y+F.H # Y+H THEN Display.CopyBlock(F.X, F.Y-dH, F.W, H, F.X, Y, Display.replace) END; F.Y := Y; F.H := H END END Modify; BEGIN DisplayUnit := Display.Unit; PrinterUnit := 3048; NoClipping.X := -2000; NoClipping.Y := -2000; NoClipping.W := 4000; NoClipping.H := 4000 (* new display1 cliprect *) END Frames.