(*************************** Hilbert curves ******************************)

(**************************************************************************

    MODUL
      Hilbert.mod

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

    NOTES
      OS 2.0+

    BUGS

    TODO

    EXAMPLES

    SEE ALSO

    INDEX

    HISTORY
      20-feb-95   Roland Jesse   created

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

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

MODULE Hilbert;

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

CONST
   n = 6; h0 = 256;
   VersionStr = "$VER: Hilbert 1.1 (20.2.95)";

VAR
   i, h, x, y, x0, y0 :  INTEGER;
   ch : LONGINT;                                  (* only for Prog-End... *)
   screen : I.ScreenPtr;

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


(*  EasyRequester at the end to wait for a user willing end... *)
PROCEDURE Done;
VAR
   es : I.EasyStruct;
   pushed : LONGINT;

BEGIN
   es.structSize := SIZE (I.EasyStruct);
   es.flags := {};
   es.title := SYS.ADR ("Hilberts Turm");
   es.textFormat := SYS.ADR ("Done.");
   es.gadgetFormat := SYS.ADR ("Bye");

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


(* opens the screen for drawing in it *)
PROCEDURE InitBlatt;
BEGIN
   screen := NIL;
   ASSERT (I.base.libNode.version >= 37, Dos.fail);
   screen := I.OpenScreenTagsA ( NIL,
      I.saTitle, SYS.ADR ("Hilbertcurves by =rj= in 1995"),
      U.end );
   ASSERT (screen # NIL, Dos.fail);
END InitBlatt;


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


(* Draw a line from the actual position to (x,y) *)
PROCEDURE Pinsel;
BEGIN
   gfx.Draw (SYS.ADR (screen.rastPort), x, y)
END Pinsel;


(* actual position := (x,y) *)
PROCEDURE PosPinsel;
BEGIN
   gfx.Move (SYS.ADR (screen.rastPort), x, y)
END PosPinsel;


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


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


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


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


(* main *)
BEGIN
   Kernel.InstallTrapHandler;                  (* Oh, I like this ... ;o) *)
   Kernel.SetCleanup (Cleanup);                          (* And this, too *)
   InitBlatt;
   i := 0; h := h0; x0 := h DIV 2; y0 := h DIV 2 + 11;
   REPEAT
      i := i+1; h := h DIV 2;
      x0 := x0 + (h DIV 2); y0 := y0 + (h DIV 2);
      x := x0; y := y0;
      PosPinsel; A(i)
   UNTIL i = n;
   Done;
END Hilbert.