(************************** Sierpinski curves *****************************

    MODUL
      Sierpinski.mod

    DESCRIPTION
      Sierpinskicurves from "Algorithmen und Datenstrukturen" (N. Wirth)

    NOTES
      OS 2.0+

    BUGS

    TODO

    EXAMPLES

    SEE ALSO

    INDEX

    HISTORY
      23-feb-95   Roland Jesse   created

***************************************************************************)

<* STANDARD- *>             (* necessary for assignable cleanup procedure *)

MODULE Sierpinski;

IMPORT
   Dos, Kernel, gfx := Graphics, I := Intuition, SYS := SYSTEM, U := Utility;

CONST
   n = 5; h0 = 256;
   Version = "$VER: Sierpinski 1.2 (23.2.95)";

VAR
   i, h, x, y, x0, y0 : INTEGER;
   ch : LONGINT;
   screen : I.ScreenPtr;

PROCEDURE ^ A(i: INTEGER);
PROCEDURE ^ B(i: INTEGER);
PROCEDURE ^ C(i: INTEGER);
PROCEDURE ^ D(i: INTEGER);


(* EasyRequest at end of program *)
PROCEDURE Done;
VAR
   es : I.EasyStruct;
   pushed : LONGINT;
BEGIN
   es.structSize := SIZE (I.EasyStruct);
   es.flags := {};
   es.title := SYS.ADR ("Sierpinski");
   es.textFormat := SYS.ADR ("The brushing is over!");
   es.gadgetFormat := SYS.ADR ("Okidoki");

   pushed := I.EasyRequest ( NIL, SYS.ADR (es), NIL, NIL );
END Done;


PROCEDURE Init;
BEGIN
   screen := NIL;
   ASSERT (I.base.libNode.version >= 37, Dos.fail);
   screen := I.OpenScreenTagsA ( NIL,
      I.saTitle, SYS.ADR ("Sierpinskicurves by =rj= in 1995"),
      U.end );
   ASSERT (screen # NIL, Dos.fail);
END Init;

PROCEDURE* Cleanup(VAR rc : LONGINT);
BEGIN
   IF screen # NIL THEN
      I.OldCloseScreen (screen);
   END;
   Kernel.RemoveTrapHandler
END Cleanup;

PROCEDURE PosPinsel;
BEGIN
   gfx.Move (SYS.ADR (screen.rastPort), x, y)
END PosPinsel;

PROCEDURE Pinsel;
BEGIN
   gfx.Draw (SYS.ADR (screen.rastPort), x, y)
END Pinsel;

PROCEDURE A(i: INTEGER);
BEGIN
   IF i > 0 THEN
      A(i-1); x := x+h; y := y-h; Pinsel;
      B(i-1); x := x + 2 * h;     Pinsel;
      D(i-1); x := x+h; y := y+h; Pinsel;
      A(i-1);
   END
END A;

PROCEDURE B(i: INTEGER);
BEGIN
   IF i > 0 THEN
      B(i-1); x := x-h; y := y-h; Pinsel;
      C(i-1); y := y - 2 * h;     Pinsel;
      A(i-1); x := x+h; y := y-h; Pinsel;
      B(i-1)
   END
END B;

PROCEDURE C(i: INTEGER);
BEGIN
   IF i > 0 THEN
      C(i-1); x := x-h; y := y+h; Pinsel;
      D(i-1); x := x - 2 * h;     Pinsel;
      B(i-1); x := x-h; y := y-h; Pinsel;
      C(i-1);
   END
END C;

PROCEDURE D(i: INTEGER);
BEGIN
   IF i > 0 THEN
      D(i-1); x := x+h; y := y+h; Pinsel;
      A(i-1); y := y + 2 * h;     Pinsel;
      C(i-1); x := x-h; y := y+h; Pinsel;
      D(i-1);
   END
END D;

BEGIN (* main *)
   Kernel.InstallTrapHandler;
   Kernel.SetCleanup (Cleanup);
   Init;
   i := 0; h := h0 DIV 4; x0 := 2*h; y0 := 3*h + 11;
   REPEAT
      i := i+1; x0 := x0-h; h := h DIV 2; y0 := y0+h; x := x0; y := y0;
      PosPinsel;
      A(i); x := x+h; y := y-h; Pinsel;
      B(i); x := x-h; y := y-h; Pinsel;
      C(i); x := x-h; y := y+h; Pinsel;
      D(i); x := x+h; y := y+h; Pinsel;
   UNTIL i = n;
   Done;
END Sierpinski.