Topspeed_JPI/TS/GRAPHIX/TPATTERN.MOD

(******************************************************************************)
(*                              TPATTERN.MOD                                  *)
(*                                                                            *)
(*    MetaWINDOW HOWTO: program series.  Demonstrates patterns and shapes.    *)
(* Transcribed from TPATTERN.C METAGRAPHICS SOFTWARE CORPORATION (c) 1987-1989*)
(*                                                                            *)
(*  PSW 10/31/90 02:44am                                                      *)
(******************************************************************************)

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

  IMPORT GrConst;
  IMPORT GrPorts;
  IMPORT Meta;
  IMPORT GrQry;
  IMPORT IO;

  FROM GrConst IMPORT rect, point, polyHead;

  VAR
    GrafixCard,
    CommPort: INTEGER;
    sR,R:     rect;
    ScrnXmax,
    ScrnYmax,
    x,y,z,
    dx,dy,
    dxx,dyy,
    h,i,j,k,
    clr,pat,
    object:   INTEGER;
    p_pts:    ARRAY[0..6] OF point;    (* The polygon point series *)
    p_hdr:    polyHead;                (* the polygon header array *)


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;

  IO.WrStr('TPATTERN - Color and pattern display');
  IO.WrLn; IO.WrLn;
  IO.WrStr('What object to use ?');
  IO.WrLn;
  IO.WrStr(' 1) Rectangles');
  IO.WrLn;
  IO.WrStr(' 2) RoundRectangles');
  IO.WrLn;
  IO.WrStr(' 3) Ovals');
  IO.WrLn;
  IO.WrStr(' 4) Arcs');
  IO.WrLn;
  IO.WrStr(' 5) Polygons [ ]');
  IO.WrChar(CHR(8));
  IO.WrChar(CHR(8));

  object := IO.RdInt();

  IF (object < 1) OR (object > 5) THEN
    GrQry.GrQuit('Illegal object!', 1);
  END;

  Meta.SetDisplay(GrConst.GrafPg0);
  Meta.ScreenRect(sR);
  Meta.EraseRect(sR);
  Meta.RasterOp(GrConst.zREPz);
  ScrnXmax := sR.Xmax;
  ScrnYmax := sR.Ymax;

(* set up the  polygon header array *)
  p_hdr.polyBgn  := 0;
  p_hdr.polyEnd  := 6;
  p_hdr.polyRect := sR;

  dx  := (ScrnXmax+1) DIV 8;
  dy  := (ScrnYmax+1) DIV 4;
  dxx := dx DIV 5;
  dyy := dy DIV 6;

  clr := Meta.QueryColors();
  k   := clr - 1;

  FOR h := 0 TO 15 DO
    INC(k, 31);
    pat := 0;
    y   := 0;

    FOR i := 0 TO 3 DO  (* 4 down *)
      x := 0;
      FOR j := 0 TO 7 DO (* 8 across *)
        Meta.SetRect(R, x, y, x+(dx-dxx), y+(dy-dyy));
        Meta.BackColor(k); Meta.PenColor(clr-k);

        CASE object OF
        | 1:
          Meta.FillRect(R, pat);
          Meta.FrameRect(R);
        | 2:
          Meta.FillRoundRect(R, dxx, dyy, pat);
          Meta.FrameRoundRect(R, dxx, dyy);
        | 3:
          Meta.FillOval(R, pat);
          Meta.FrameOval(R);
        | 4:
          Meta.FillArc(R, pat*80, 450, pat);
          Meta.FrameArc(R, pat*80, 450);
        | 5:
          z := 0;

          p_pts[z].X := x;
          p_pts[z].Y := y;
          INC(z);

          p_pts[z].X := x + ((dx-dxx) DIV 2);
          p_pts[z].Y := y + (dy-dyy);
          INC(z);

          p_pts[z].X := x + (dx-dxx);
          p_pts[z].Y := y;
          INC(z);

          p_pts[z].X := x + (dx-dxx);
          p_pts[z].Y := y + (dy-dyy);
          INC(z);

          p_pts[z].X := x + ((dx-dxx) DIV 2);
          p_pts[z].Y := y;
          INC(z);

          p_pts[z].X := x;
          p_pts[z].Y := y + (dy-dyy);
          INC(z);

          p_pts[z].X := x;
          p_pts[z].Y := y;

          Meta.FillPoly(1, ADR(p_hdr), ADR(p_pts), pat)
        END;

        INC(x, dx);
        INC(pat);
        INC(k)
      END;

      INC(y, dy)
    END
  END;

  GrQry.GrQuit('', 0)
END TPattern.