ð#Syntax10.Scn.FntÕÕMODULE FramesTest; IMPORT Input, Fonts, TextFrames, MenuViewers, Oberon, Printer, Display1, Frames; CONST smooth = TRUE; Version = "FramesTest - gri 15.7.92"; Menu = "System.Close System.Copy System.Grow"; ML = 2; MM = 1; MR = 0; w = 512; h = 256; dscale = 200; seed0 = 731; TYPE Frame = POINTER TO FrameDesc; FrameDesc = RECORD (Frames.GraphicFrameDesc) END; VAR font: Fonts.Font; seed: LONGINT; PROCEDURE RndCol(): INTEGER; VAR c: INTEGER; BEGIN seed := (seed + 33)*61 MOD 991; c := SHORT(seed MOD 16); IF c = 0 THEN c := Frames.invert END; RETURN c END RndCol; PROCEDURE (F: Frame) Copy* (): Frames.Frame; VAR CopyOfF: Frame; BEGIN NEW(CopyOfF); CopyOfF.Open(F.handle, F.port, F.X0, F.Y0, F.scale); RETURN CopyOfF END Copy; PROCEDURE (F: Frame) TrackMouse* (VAR X, Y: INTEGER; VAR keySum: SET); VAR keys: SET; x, y: INTEGER; BEGIN IF keySum = {MM} THEN IF smooth THEN x := X; y := Y; LOOP Input.Mouse(keys, X, Y); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y); IF keys = {} THEN EXIT END; keySum := keySum + keys; IF (X # x) OR (Y # y) THEN F.MoveOrigin(X-x, Y-y); x := X; y := Y END END ELSE x := X; y := Y; F.TrackMouse^(X, Y, keySum); F.MoveOrigin(X-x, Y-y) END ELSIF keySum = {ML} THEN IF F.scale > Frames.DisplayUnit DIV 10 THEN F.Open(F.handle, F.port, F.X0, F.Y0, F.scale-dscale); F.Restore(F.X, F.Y, F.W, F.H); F.TrackMouse^(X, Y, keySum) END ELSIF keySum = {MR} THEN IF F.scale < 10*Frames.DisplayUnit THEN F.Open(F.handle, F.port, F.X0, F.Y0, F.scale+dscale); F.Restore(F.X, F.Y, F.W, F.H); F.TrackMouse^(X, Y, keySum) END ELSE F.TrackMouse^(X, Y, keySum) END END TrackMouse; PROCEDURE Palette (F: Frame; X, Y: LONGINT); VAR i: INTEGER; BEGIN i := 0; WHILE Display1.ThisPattern(i) # 0 DO F.Block(X + i*100, Y, 90, h, Frames.NewColor(RndCol(), i)); F.Block(X + i*100, Y + 10, 90, 10, Frames.NewColor(RndCol(), i)); INC(i) END END Palette; PROCEDURE Dots (F: Frame; X, Y: LONGINT); VAR i: INTEGER; x, y: INTEGER; BEGIN i := 0; x := 0; y := 0; WHILE i < 128 DO F.Dot(X + x, Y + y, RndCol()); x := (x + 13) MOD w; y := (y + 47) MOD h; INC(i) END END Dots; PROCEDURE Chars (F: Frame; X, Y: LONGINT); VAR i: INTEGER; x, y: INTEGER; BEGIN i := 0; x := 0; y := 0; WHILE i < 32 DO F.Char(X + x, Y + y, RndCol(), font, CHR(ORD("A") + i)); x := (x + 13) MOD w; y := (y + 47) MOD h; INC(i) END END Chars; PROCEDURE Strings (F: Frame; X, Y: LONGINT); VAR i: INTEGER; x, y: INTEGER; s: ARRAY 32 OF CHAR; BEGIN i := 0; x := 0; y := 0; s := "*** Hello World ***"; WHILE i < 12 DO F.String(X + x, Y + y, RndCol(), font, s); x := (x + 23) MOD w; y := (y + 47) MOD h; INC(i) END END Strings; PROCEDURE Lines (F: Frame; X, Y: LONGINT); VAR x0, y0: LONGINT; i: INTEGER; BEGIN x0 := X + (w DIV 4); y0 := Y + (h DIV 2); i := 0; WHILE i < 4 DO F.Line(x0, y0, x0 + (w DIV 4), y0 + i*32, 0, RndCol()); F.Line(x0, y0, x0 + (w DIV 4), y0 - i*32, 0, RndCol()); F.Line(x0, y0, x0 - (w DIV 4), y0 + i*32, 0, RndCol()); F.Line(x0, y0, x0 - (w DIV 4), y0 - i*32, 0, RndCol()); F.Line(x0, y0, x0 + i*32, y0 + (h DIV 2), 0, RndCol()); F.Line(x0, y0, x0 + i*32, y0 - (h DIV 2), 0, RndCol()); F.Line(x0, y0, x0 - i*32, y0 + (h DIV 2), 0, RndCol()); F.Line(x0, y0, x0 - i*32, y0 - (h DIV 2), 0, RndCol()); INC(i) END; x0 := X + (w*3 DIV 4); y0 := Y + (h DIV 2); i := 0; WHILE i < 4 DO F.Line(x0, y0, x0 + (w DIV 4), y0 + i*32, i*2, RndCol()); F.Line(x0, y0, x0 + (w DIV 4), y0 - i*32, i*2, RndCol()); F.Line(x0, y0, x0 - (w DIV 4), y0 + i*32, i*2, RndCol()); F.Line(x0, y0, x0 - (w DIV 4), y0 - i*32, i*2, RndCol()); F.Line(x0, y0, x0 + i*32, y0 + (h DIV 2), i*2, RndCol()); F.Line(x0, y0, x0 + i*32, y0 - (h DIV 2), i*2, RndCol()); F.Line(x0, y0, x0 - i*32, y0 + (h DIV 2), i*2, RndCol()); F.Line(x0, y0, x0 - i*32, y0 - (h DIV 2), i*2, RndCol()); INC(i) END END Lines; PROCEDURE Rects (F: Frame; X, Y: LONGINT); VAR i: INTEGER; x, y, w1, h1: INTEGER; BEGIN i := 0; x := 0; y := 0; w1 := w DIV 8; h1 := h DIV 8; WHILE i < 24 DO F.Rect(X + x, Y + y, w1, h1, i, Frames.NewColor(RndCol(), i)); x := (x + 13) MOD w; y := (y + 47) MOD h; w1 := (w1 + 7) MOD (w DIV 4); h1 := (h1 + 11) MOD (h DIV 4); INC(i) END END Rects; PROCEDURE Quadrangles (F: Frame; X, Y: LONGINT); VAR x1, y1, x2, y2, x3, y3, x4, y4: INTEGER; BEGIN x1 := 0; y1 := 0; x2 := 0; y2 := 0; x3 := w DIV 4; y3 := h; x4 := 0; y4 := h; F.Quadrangle(X + x1, Y + y1, X + x2, Y + y2, X + x3, Y + y3, X + x4, Y + y4, RndCol()); x1 := 10; y1 := 0; x2 := w*3 DIV 4 - 10; y2 := 0; x3 := w DIV 4 + 10; y3 := h; x4 := w-10; y4 := h; F.Quadrangle(X + x1, Y + y1, X + x2, Y + y2, X + x3, Y + y3, X + x4, Y + y4, Frames.NewColor(RndCol(), 2)); x1 := w*3 DIV 4; y1 := 0; x2 := w; y2 := 0; x3 := w; y3 := h; x4 := w; y4 := h; F.Quadrangle(X + x1, Y + y1, X + x2, Y + y2, X + x3, Y + y3, X + x4, Y + y4, RndCol()) END Quadrangles; PROCEDURE Circles1 (F: Frame; X, Y: LONGINT); VAR x0, y0: LONGINT; i: INTEGER; BEGIN x0 := X + (w DIV 4); y0 := Y + (h DIV 2); i := 0; WHILE i < 8 DO F.Ellipse(x0, y0, i*16, i*16, 0, RndCol()); INC(i) END; x0 := X + (w*3 DIV 4); y0 := Y + (h DIV 2); i := 0; WHILE i < 8 DO F.Ellipse(x0, y0, i*16, i*16, i, RndCol()); INC(i) END END Circles1; PROCEDURE Circles2 (F: Frame; X, Y: LONGINT); VAR x0, y0: LONGINT; i: INTEGER; BEGIN x0 := X + (w DIV 4); y0 := Y + (h DIV 2); i := 7; F.Ellipse(x0, y0, i*16, i*16, w, RndCol()); x0 := X + (w*3 DIV 4); y0 := Y + (h DIV 2); i := 8; WHILE i > 0 DO DEC(i); F.Ellipse(x0, y0, i*16, i*16, w, Frames.NewColor(RndCol(), i)) END END Circles2; PROCEDURE Ellipses1 (F: Frame; X, Y: LONGINT); VAR x0, y0: LONGINT; i: INTEGER; BEGIN x0 := X + (w DIV 4); y0 := Y + (h DIV 2); i := 0; WHILE i < 8 DO F.Ellipse(x0, y0, i*16, i*10, 0, RndCol()); INC(i) END; x0 := X + (w*3 DIV 4); y0 := Y + (h DIV 2); i := 0; WHILE i < 8 DO F.Ellipse(x0, y0, i*16, i*10, i, RndCol()); INC(i) END END Ellipses1; PROCEDURE Ellipses2 (F: Frame; X, Y: LONGINT); VAR x0, y0: LONGINT; i: INTEGER; BEGIN x0 := X + (w DIV 4); y0 := Y + (h DIV 2); i := 7; F.Ellipse(x0, y0, i*16, i*10, w, RndCol()); x0 := X + (w*3 DIV 4); y0 := Y + (h DIV 2); i := 8; WHILE i > 0 DO DEC(i); F.Ellipse(x0, y0, i*16, i*10, w, Frames.NewColor(RndCol(), i)) END END Ellipses2; PROCEDURE (F: Frame) Restore (X, Y, W, H: INTEGER); BEGIN seed := seed0; F.Restore^(X, Y, W, H); Palette(F, 0*w, 0*h); Dots(F, 0*w, 3*h); Chars(F, 1*w, 3*h); Strings(F, 1*w, 2*h); Lines(F, 2*w, 3*h); Rects(F, 2*w, 2*h); Quadrangles(F, 0*w, 2*h); Circles1(F, 1*w, 1*h); Circles2(F, 0*w, 1*h); Ellipses1(F, 2*w, 1*h); Ellipses2(F, 2*w, 0*h) END Restore; PROCEDURE Open*; VAR F: Frame; V: MenuViewers.Viewer; x, y: INTEGER; BEGIN NEW(F); F.Open(Frames.Handle, NIL, 0, -800, Frames.DisplayUnit); Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y); V := MenuViewers.New(TextFrames.NewMenu(Version, Menu), F, TextFrames.menuH, x, y) END Open; BEGIN font := Fonts.This("Syntax16.Scn.Fnt") END FramesTest.