Topspeed_JPI/TS/GRAPHIX/HILBERT.MOD

(******************************************************************************)
(*                                HILBERT.MOD                                 *)
(*                                                                            *)
(*                    MetaWINDOW pretty graphics program                      *)
(* Transcribed from HILBERT.C METAGRAPHICS SOFTWARE CORPORATION (c) 1987-1989 *)
(*                                                                            *)
(*  PSW 06/28/91 08:30am                                                      *)
(******************************************************************************)

MODULE Hilbert;
(*
 *  Graphix
 *  Release 3.7
 *  (c) Copyright 1986-1992 PMI
 *  Green Bay, Wisconsin
 *  (414) 468-6040
 *  All rights reserved
 *
 *)

  IMPORT GrQry;
  IMPORT IO;
  IMPORT Lib;
  IMPORT GrConst;
  IMPORT Meta;

  VAR
    GrafixCard,
    CommPort,
    xa, ya,
    x,  y,
    ox, oy,
    i,  j,
    h,  h0,
    penColr,
    maxColr,
    cnt:        INTEGER;
    vR, R1, R2: GrConst.rect;

    PROCEDURE a(i: INTEGER); FORWARD;
    PROCEDURE b(i: INTEGER); FORWARD;
    PROCEDURE c(i: INTEGER); FORWARD;
    PROCEDURE d(i: INTEGER); FORWARD;


  PROCEDURE IncPen();
  BEGIN
    IF (maxColr > 1) THEN
      penColr := penColr + 1;
      IF (penColr > maxColr) THEN
         penColr := 1;
      END;

      Meta.PenColor(penColr);
    END
  END IncPen;

  PROCEDURE PlotRect();
  BEGIN
    IncPen();
    Meta.PaintOval(R1);
  END PlotRect;

  PROCEDURE Plt();
  BEGIN
    Meta.MoveTo(ox, oy);
    Meta.LineTo(x, y);
    IncPen();
    ox := x;
    oy := y;
  END Plt;

  PROCEDURE a(i: INTEGER);
  BEGIN
    IF (i > 0) THEN
      d(i-1); x := x-h; Plt();
      a(i-1); y := y-h; Plt();
      a(i-1); x := x+h; Plt();
      b(i-1);
    END
  END a;

  PROCEDURE b(i: INTEGER);
  BEGIN
    IF (i > 0) THEN
      c(i-1); y := y+h; Plt();
      b(i-1); x := x+h; Plt();
      b(i-1); y := y-h; Plt();
      a(i-1);
    END
  END b;


  PROCEDURE c(i: INTEGER);
  BEGIN
    IF (i > 0) THEN
      b(i-1); x := x+h; Plt();
      c(i-1); y := y+h; Plt();
      c(i-1); x := x-h; Plt();
      d(i-1);
    END;
  END c;

  PROCEDURE d(i: INTEGER);
  BEGIN
    IF (i > 0) THEN
      a(i-1); y := y-h; Plt();
      d(i-1); x := x-h; Plt();
      d(i-1); y := y+h; Plt();
      c(i-1);
    END;
  END d;

BEGIN
  (* init the system *)
  GrQry.GrQuery(GrafixCard, CommPort);

  i := Meta.InitGrafix(-GrafixCard);

  IF (i # 0) THEN
    (* Display reason for no go *)
    GrQry.GrInitErr(GrafixCard, CommPort, i);
  END;

  (* switch to graphics page *)
  Meta.SetDisplay(GrConst.GrafPg0);

  (* find number of colors supported *)
  maxColr := Meta.QueryColors();

  (* set virtual coordinate system *)
  Meta.SetRect(vR, 0, 0, 256, 256);
  Meta.VirtualRect(vR);

  LOOP
    IF (maxColr > 1) THEN
      Meta.RasterOp(GrConst.zREPz)
    ELSE
      Meta.RasterOp(GrConst.zXORz);
      Meta.PenColor(GrConst.White)
    END;

    (* do that hilbert thing *)
    Meta.EraseRect(vR);

    FOR cnt := 0 TO 4 DO
      i  := 0;
      h0 := 256;
      h  := h0;
      xa := h DIV 2;
      ya := xa;

      WHILE (h > 4) DO
        i  := i+1;
        h  := h DIV 2;
        xa := xa + (h DIV 2);
        ya := ya + (h DIV 2);
        x  := xa;
        y  := ya;
        ox := xa;
        oy := ya;
        a(i)
      END;

      (* stop if key pressed *)
      IF (IO.KeyPressed()) THEN
        EXIT
      END
    END;

    (* ye old bouncing box gizmo *)
    Meta.RasterOp(GrConst.zREPz);

    FOR cnt := 4 TO 0 BY -1 DO
      (* make a pseudorandom number *)
      i := INTEGER(Lib.RANDOM(30)) + 12;

      IF (cnt MOD 2) # 0 THEN
        xa := i DIV 2;
        ya := i DIV 3
      ELSE
        xa := i DIV 3;
        ya := i DIV 2
      END;

      Meta.SetRect(R1, 0, 0, i-6, i-6);

      FOR j := 256 TO 0 BY -1 DO
        PlotRect();
        IF ((R1.Xmax > vR.Xmax) OR (R1.Xmin < vR.Xmin)) THEN (* flip x delta *)
          xa := INTEGER(BITSET(xa) / BITSET(-1))
        END;
        IF ((R1.Ymax > vR.Ymax) OR (R1.Ymin < vR.Ymin)) THEN (* flip y delta *)
          ya := INTEGER(BITSET(ya) / BITSET(-1))
        END;
        Meta.OffsetRect(R1,xa,ya);

        IF (IO.KeyPressed()) THEN
          EXIT
        END
      END
    END;

    Meta.EraseRect(vR);      (* tunnel thing *)
    Meta.RasterOp(GrConst.zREPz);

    FOR cnt := 0 TO 16 DO
      Meta.SetRect(R1, 124,124,132,132);
      Meta.SetRect(R2, 124,124,132,132);
      Meta.PenColor(GrConst.White);

      FOR i := 0 TO 32 DO
        IncPen();
        Meta.FrameRect(R1);
        Meta.InsetRect(R1,-4,-4)
      END;
      Meta.PenColor(GrConst.Black);

      FOR i := 0 TO 32 DO
        Meta.FrameRect(R2);
        Meta.InsetRect(R2,-4,-4)
      END;

      IF IO.KeyPressed() THEN
        EXIT
      END
    END;

    Meta.PenColor(GrConst.White);
    IF (IO.KeyPressed()) THEN
      EXIT
    END
  END;  (* only exits from kbhit *)

  GrQry.GrQuit('', 0);
END Hilbert.