MODULE Sierpinski; (*NW 15.1.2013*) IMPORT Display, Viewers, Oberon, MenuViewers, TextFrames; CONST Menu = "System.Close System.Copy System.Grow"; VAR x, y, d: INTEGER; A, B, C, D: PROCEDURE (i: INTEGER); PROCEDURE E; BEGIN Display.ReplConst(Display.white, x, y, d, 1, Display.paint); INC(x, d) END E; PROCEDURE N; BEGIN Display.ReplConst(Display.white, x, y, 1, d, Display.paint); INC(y, d) END N; PROCEDURE W; BEGIN DEC(x, d); Display.ReplConst(Display.white, x, y, d, 1, Display.paint) END W; PROCEDURE S; BEGIN DEC(y, d); Display.ReplConst(Display.white, x, y, 1, d, Display.paint) END S; PROCEDURE NE; VAR i: INTEGER; BEGIN i := d; REPEAT Display.Dot(Display.white, x, y, Display.paint); INC(x); INC(y); DEC(i) UNTIL i = 0 END NE; PROCEDURE NW; VAR i: INTEGER; BEGIN i := d; REPEAT Display.Dot(Display.white, x, y, Display.paint); DEC(x); INC(y); DEC(i) UNTIL i = 0 END NW; PROCEDURE SW; VAR i: INTEGER; BEGIN i := d; REPEAT Display.Dot(Display.white, x, y, Display.paint); DEC(x); DEC(y); DEC(i) UNTIL i = 0 END SW; PROCEDURE SE; VAR i: INTEGER; BEGIN i := d; REPEAT Display.Dot(Display.white, x, y, Display.paint); INC(x); DEC(y); DEC(i) UNTIL i = 0 END SE; PROCEDURE SA(i: INTEGER); BEGIN IF i > 0 THEN A(i-1); SE; B(i-1); E; E; D(i-1); NE; A(i-1) END END SA; PROCEDURE SB(i: INTEGER); BEGIN IF i > 0 THEN B(i-1); SW; C(i-1); S; S; A(i-1); SE; B(i-1) END END SB; PROCEDURE SC(i: INTEGER); BEGIN IF i > 0 THEN C(i-1); NW; D(i-1); W; W; B(i-1); SW; C(i-1) END END SC; PROCEDURE SD(i: INTEGER); BEGIN IF i > 0 THEN D(i-1); NE; A(i-1); N; N; C(i-1); NW; D(i-1) END END SD; PROCEDURE DrawSierpinski(F: Display.Frame); VAR k, n, w, x0, y0: INTEGER; BEGIN; k := 0; d := 4; IF F.W < F.H THEN w := F.W ELSE w := F.H END ; WHILE d*8 < w DO d := d*2; INC(k) END ; Display.ReplConst(Display.black, F.X, F.Y, F.W, F.H, Display.replace); x0 := F.W DIV 2; y0 := F.H DIV 2 + d; n := 0; WHILE n < k DO INC(n); DEC(x0, d); d := d DIV 2; INC(y0, d); x := F.X + x0; y := F.Y + y0; SA(n); SE; SB(n); SW; SC(n); NW; SD(n); NE END END DrawSierpinski; PROCEDURE Handler(F: Display.Frame; VAR M: Display.FrameMsg); VAR F1: Display.Frame; BEGIN IF M IS Oberon.InputMsg THEN IF M(Oberon.InputMsg).id = Oberon.track THEN Oberon.DrawMouseArrow(M(Oberon.InputMsg).X, M(Oberon.InputMsg).Y) END ELSIF M IS MenuViewers.ModifyMsg THEN F.Y := M(MenuViewers.ModifyMsg).Y; F.H := M(MenuViewers.ModifyMsg).H; DrawSierpinski(F) ELSIF M IS Oberon.ControlMsg THEN IF M(Oberon.ControlMsg).id = Oberon.neutralize THEN Oberon.RemoveMarks(F.X, F.Y, F.W, F.H) END ELSIF M IS Oberon.CopyMsg THEN NEW(F1); F1^ := F^; M(Oberon.CopyMsg).F := F1 END END Handler; PROCEDURE New(): Display.Frame; VAR F: Display.Frame; BEGIN NEW(F); F.handle := Handler; RETURN F END New; PROCEDURE Draw*; VAR V: Viewers.Viewer; X, Y: INTEGER; BEGIN Oberon.AllocateUserViewer(Oberon.Par.vwr.X, X, Y); V := MenuViewers.New(TextFrames.NewMenu("Sierpinski", Menu), New(), TextFrames.menuH, X, Y) END Draw; BEGIN A := SA; B := SB; C := SC; D := SD END Sierpinski.