Topspeed_JPI/TS/GRAPHIX/TESTTRAK.MOD

(******************************************************************************)
(*                              TESTTRAK.MOD                                  *)
(*                                                                            *)
(*                    MetaWINDOW graphics test program                        *)
(* Transcribed from TESTTRAK.C METAGRAPHICS SOFTWARE CORPORATION (c) 1987-1989*)
(*                                                                            *)
(*  PSW 10/31/90 02:44am                                                      *)
(******************************************************************************)

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

  IMPORT GrQry;
  IMPORT GrConst;
  IMPORT GrPorts;
  IMPORT Meta;
  IMPORT Str;
  IMPORT Lib;
  IMPORT IO;

  FROM Storage IMPORT ALLOCATE, DEALLOCATE;

  FROM GrConst IMPORT rect, point, event, cursor, dirRec, mapArray;
  FROM GrPorts IMPORT adsPort;
  FROM GrFonts IMPORT adsFont;


  CONST
    sec       = 18;
    COLOR     = 11;

  VAR
    GrafixCard,
    CommPort:   INTEGER;
    buf, buf1,
    Msg1, Msg2: ARRAY [0..79] OF CHAR;
    x, y,
    ox, oy,
    i, j,
    evCnt,
    max_clr,
    clr,
    px, py,
    maxgig:     INTEGER;
    a, b:       ARRAY [0..15] OF INTEGER;
    bol, bol1:  BOOLEAN;
    evnt:       event;
    R1, sR:     rect;
    pt:         point;
    scrMask,
    csrMask:    cursor;
    OK:         BOOLEAN;
    thePort:    adsPort;   (* pointer to default MetaWINDOW port     *)
    bm:         mapArray;


(*
** assumes event queing is enabled. call with # of
** "ticks" to wait; ie appx 18 ticks per second
** occur. Also use for "time outs".
*)

  PROCEDURE mwDelay(time: INTEGER);
    VAR
      b:    BOOLEAN;
      i:    INTEGER;
      evnt: event;
  BEGIN
    b := Meta.PeekEvent(0, evnt);
    i := evnt.Time;

    REPEAT
      b := Meta.PeekEvent(0, evnt)
    UNTIL (evnt.Time - i >= time);
  END mwDelay;

(*** Display the active keys ***)

  PROCEDURE DispOpt();
  BEGIN
    Meta.RasterOp(GrConst.zXORz);
    Meta.MoveTo(px*2, py*22);
    Meta.DrawString('- Active keys - [w]hirl-a-gig, [c]lear screen');
    Meta.MoveTo(px*2, py*23);
    Meta.DrawString('[f]lip origin, [t]racking on/off.');
    Meta.MoveTo(px*2, py*24);
    Meta.DrawString('mouse: lft=draw, rt=plot');
    Meta.RasterOp(GrConst.zREPz);
  END DispOpt;

(*** do some keen patterns ***)

  PROCEDURE DispPatt();
    VAR
      i: INTEGER;
  BEGIN
    Meta.SetRect(R1, 0, 0, sR.Xmax, sR.Ymax);
    x := R1.Xmax DIV 32; y := R1.Ymax DIV 32;

    FOR i := 0 TO 15 DO
      Meta.PenColor(i);
      Meta.BackColor(15-i);
      Meta.FillRect(R1, i+16);
      Meta.FrameRect(R1);
      Meta.InsetRect(R1, x, y);
    END;
  END DispPatt;

(*** Load the specified font. ***)

  PROCEDURE LoadFont(VAR fontName: ARRAY OF CHAR);
    VAR
      Dir:      dirRec;
      qErr,
      loadErr:  INTEGER;
      path:     ARRAY[0..80] OF CHAR;
      fontBuf:  adsFont;
  BEGIN
    Str.Copy(path, fontName);
    loadErr := -1;                             (* Preempt Error *)
    qErr    := Meta.FileQuery(path, Dir, 1);

    IF (qErr # 1) THEN
      (* No font file in default dir, try environment variable *)
      Lib.EnvironmentFind("METAPATH", path);

      IF (path[0] # CHR(0)) THEN
        (* found the env parm, try using the path listed there *)

        IF (path[Str.Length(path)] # '\') THEN
          (* If no trailing slash, add one *)
          Str.Append(path, '\');
        END;

        Str.Append(path, fontName);
        qErr := Meta.FileQuery(path, Dir, 1);
      END;
    END;

    IF (qErr = 1) THEN
      (* we got our file *)
      ALLOCATE(ADDRESS(fontBuf), VAL(CARDINAL, Dir.fileSize + 1));

      IF (fontBuf # NIL) THEN
        (* We got our memory *)
        loadErr := Meta.FileLoad(path, ADDRESS(fontBuf), VAL(CARDINAL, Dir.fileSize+1));
        IF loadErr <= 0 THEN
          DEALLOCATE(ADDRESS(fontBuf), VAL(CARDINAL, Dir.fileSize + 1));
        END;
        Meta.SetFont(ADDRESS(fontBuf));
      END;
    END;

    IF (loadErr > 0) THEN
      (* clear out system load error *)
      qErr := Meta.QueryError();
    ELSE
      (* beep if font load probs *)
      IO.WrChar(CHR(7));
      Str.Copy(fontName, 'Using internal SYSTEM08.FNT');
    END;
  END LoadFont;


  PROCEDURE Insert(VAR S1: ARRAY OF CHAR; S2: ARRAY OF CHAR; Pos, Width: CARDINAL);
    VAR
      L1, L2, i: CARDINAL;
  BEGIN
    L1 := Str.Length(S1);
    L2 := Str.Length(S2);

    IF (Pos + Width) > L1 THEN
      RETURN
    END;

    IF L2 > Width THEN
      RETURN
    END;

    FOR i := 0 TO L2 DO
      S1[Pos + i] := S2[i];
    END;

    FOR i := Pos + L2 TO Pos + Width DO
      S1[i] := ' ';
    END;
  END Insert;


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;

  Meta.ScreenRect(sR);
  Meta.SetDisplay(GrConst.GrafPg0);
  max_clr := Meta.QueryColors();
  px := sR.Xmax DIV 80;
  py := sR.Ymax DIV 25;
  Meta.SetRect(R1, px*60, py*18, px*70, py*22);
  Meta.PenColor(COLOR);
  Meta.FillRect(sR, 1);
  Meta.PenColor(GrConst.White);

  Meta.GetPort(thePort);
  i := thePort^.portBMap^.devClass;

  IF (thePort^.portBMap^.pixPlanes > 1) THEN
    i := INTEGER(BITSET(i) * BITSET(0FFF8H))
  END;

  Str.Copy(buf1, 'SYSTEM');
  Str.IntToStr(LONGINT(i), buf, 10, OK);
  Str.Append(buf1, buf);
  Str.Append(buf1, '.FNT');

  LoadFont(buf1);

  Meta.MoveTo(px, py);
  Meta.DrawString(buf1);

(* Init the whirlagig *)
  Meta.PenSize(1, 1);
  maxgig := 39;

  x := px * 10;
  y := py * 8;
  j := py;

  FOR i := 0 TO 15 DO
    a[i] := x - px * 5;
    b[i] := j;
    j    := j + py;
  END;

(* Create a user-defined cursor to be a triangle *)

  scrMask.curWidth    := 16;    scrMask.curHeight   := 16;
  scrMask.curAlign    := 0;     scrMask.curRowBytes := 2;
  scrMask.curBits     := 1;     scrMask.curPlanes   := 1;
  scrMask.curData[0]  := 000H;  scrMask.curData[1]  := 000H;
  scrMask.curData[2]  := 000H;  scrMask.curData[3]  := 000H;
  scrMask.curData[4]  := 000H;  scrMask.curData[5]  := 000H;
  scrMask.curData[6]  := 000H;  scrMask.curData[7]  := 000H;
  scrMask.curData[8]  := 000H;  scrMask.curData[9]  := 000H;
  scrMask.curData[10] := 000H;  scrMask.curData[11] := 000H;
  scrMask.curData[12] := 000H;  scrMask.curData[13] := 000H;
  scrMask.curData[14] := 001H;  scrMask.curData[15] := 000H;
  scrMask.curData[16] := 003H;  scrMask.curData[17] := 080H;
  scrMask.curData[18] := 007H;  scrMask.curData[19] := 0C0H;
  scrMask.curData[20] := 00FH;  scrMask.curData[21] := 0E0H;
  scrMask.curData[22] := 01FH;  scrMask.curData[23] := 0F0H;
  scrMask.curData[24] := 03FH;  scrMask.curData[25] := 0F8H;
  scrMask.curData[26] := 07FH;  scrMask.curData[27] := 0FCH;
  scrMask.curData[28] := 000H;  scrMask.curData[29] := 000H;
  scrMask.curData[30] := 000H;  scrMask.curData[31] := 000H;

  csrMask.curWidth    := 16;    csrMask.curHeight   := 16;
  csrMask.curAlign    := 0;     csrMask.curRowBytes := 2;
  csrMask.curBits     := 1;     csrMask.curPlanes   := 1;
  csrMask.curData[0]  := 000H;  csrMask.curData[1]  := 000H;
  csrMask.curData[2]  := 000H;  csrMask.curData[3]  := 000H;
  csrMask.curData[4]  := 000H;  csrMask.curData[5]  := 000H;
  csrMask.curData[6]  := 000H;  csrMask.curData[7]  := 000H;
  csrMask.curData[8]  := 000H;  csrMask.curData[9]  := 000H;
  csrMask.curData[10] := 000H;  csrMask.curData[11] := 000H;
  csrMask.curData[12] := 001H;  csrMask.curData[13] := 000H;
  csrMask.curData[14] := 002H;  csrMask.curData[15] := 080H;
  csrMask.curData[16] := 004H;  csrMask.curData[17] := 040H;
  csrMask.curData[18] := 008H;  csrMask.curData[19] := 020H;
  csrMask.curData[20] := 010H;  csrMask.curData[21] := 010H;
  csrMask.curData[22] := 020H;  csrMask.curData[23] := 008H;
  csrMask.curData[24] := 040H;  csrMask.curData[25] := 004H;
  csrMask.curData[26] := 080H;  csrMask.curData[27] := 002H;
  csrMask.curData[28] := 0FFH;  csrMask.curData[29] := 0FEH;
  csrMask.curData[30] := 000H;  csrMask.curData[31] := 000H;

  Meta.DefineCursor(2, 8, 8, scrMask, csrMask);


(* Now turn on mouse and event queue stuff *)
  Meta.InitMouse(CommPort);

  Meta.ScaleMouse (sR.Xmax DIV 40, sR.Ymax DIV 40);

  ox := 100;
  x  := 100;
  oy := 100;
  y  := 100;

  Meta.MoveCursor(x, y);

  FOR i := 0 TO 7 DO
     bm[i] := i;
  END;

  bm[4] := 0;   (* arrow *)
  bm[5] := 2;   (* new pointy thing *)
  Meta.CursorMap(bm);
  bol  := TRUE;
  bol1 := TRUE;

(* Enable mouse autotracking & event queue*)

  Meta.TrackCursor(bol);
  Meta.ShowCursor();
  Meta.EventQueue(TRUE);

(* flush event queue *)
  WHILE Meta.KeyEvent(FALSE, evnt) DO
    ;
  END;

  DispOpt();
  Meta.LimitMouse(sR.Xmin-20, sR.Ymin-20, sR.Xmax+20, sR.Ymax+20);
  clr   := 0;
  evCnt := 0;

  Meta.RasterOp(GrConst.zREPz);

(* Init messages *)
  Str.Copy(Msg1, 'event=    ascii=    scan=    state=      x=     y=     time=      ');
  Str.Copy(Msg2, 'x=     y=     sw=    time=       ');


  REPEAT
    Meta.QueryCursor(pt.X, pt.Y, i, j);

    IF Meta.KeyEvent(FALSE, evnt) THEN
      CASE evnt.ASCII OF
      | 't':  (* t will flip tracking on/off *)
        bol := NOT(bol);
        Meta.TrackCursor(bol);
      | 'c':    (* clears screen *)
        Meta.HideCursor();
        Meta.PenColor(COLOR);
        Meta.FillRect(sR, 1);
        Meta.PenColor(GrConst.White);
        DispOpt();
        Meta.ShowCursor();
      | 'f':   (* f will flip port origin *)
          Meta.HideCursor();
          bol1 := NOT(bol1);
          Meta.PortOrigin(bol1);
          Meta.PenColor(COLOR);
          Meta.FillRect(sR, 1);
          Meta.PenColor(GrConst.White);
          DispOpt();
          Meta.ShowCursor();
       | 'w':   (* w for the whilagig *)
          Meta.HideCursor();
          Meta.RasterOp (GrConst.zXORz);
          FOR i := 0 TO maxgig DO
            FOR j := 0 TO 15 DO
              Meta.MoveTo (pt.X, pt.Y);
              Meta.LineTo (a[j], b[j]);
            END
          END;
          Meta.RasterOp(GrConst.zREPz);
          Meta.ShowCursor();
      END;

      INC(evCnt);
      Str.IntToStr(LONGINT(evCnt), buf, 10, OK);
      Insert(Msg1, buf, 6, 2);
      Str.IntToStr(LONGINT(evnt.ASCII), buf, 16, OK);
      Insert(Msg1, buf, 16, 2);
      Str.IntToStr(LONGINT(evnt.ScanCode), buf, 16, OK);
      Insert(Msg1, buf, 25, 2);
      Str.IntToStr(LONGINT(evnt.State), buf, 16, OK);
      Insert(Msg1, buf, 35, 4);
      Str.IntToStr(LONGINT(evnt.CursorX), buf, 10, OK);
      Insert(Msg1, buf, 43, 3);
      Str.IntToStr(LONGINT(evnt.CursorY), buf, 10, OK);
      Insert(Msg1, buf, 50, 3);
      Str.IntToStr(LONGINT(evnt.Time), buf, 10, OK);
      Insert(Msg1, buf, 60, 5);
      Meta.MoveTo(px*6, py*2);
      Meta.DrawString(Msg1);

    ELSIF (evnt.Time MOD 8) = 0  THEN
      Meta.ProtectRect(R1);
      Meta.PenColor(clr);
      Meta.FillRect(R1, 1);
      Meta.ProtectOff();
      INC(clr);

      IF (clr > max_clr) THEN
        clr := 0
      END;
    END;

(*** etch-a-sketch ***)

    IF j = (GrConst.swRight + GrConst.swLeft) THEN
      Meta.PenColor(GrConst.Black);
      Meta.HideCursor();
      Meta.MoveTo(ox, oy);
      Meta.LineTo(pt.X, pt.Y);
      Meta.ShowCursor();
    ELSE
      IF INTEGER(BITSET(j) * BITSET(GrConst.swLeft)) # 0 THEN
        Meta.PenColor(GrConst.Black);
        Meta.HideCursor();
        Meta.MoveTo(ox, oy);
        Meta.LineTo(pt.X, pt.Y);
        Meta.ShowCursor();
      END;
      ox := pt.X;
      oy := pt.Y;
    END;

    Meta.PenColor(GrConst.White);


    Str.IntToStr(LONGINT(evnt.CursorX), buf, 10, OK);
    Insert(Msg2, buf, 2, 3);
    Str.IntToStr(LONGINT(evnt.CursorY), buf, 10, OK);
    Insert(Msg2, buf, 9, 3);
    Str.IntToStr(LONGINT(j), buf, 10, OK);
    Insert(Msg2, buf, 17, 2);
    Str.IntToStr(LONGINT(evnt.Time), buf, 10, OK);
    Insert(Msg2, buf, 26, 6);
    Meta.MoveTo(px*6, py*4);
    Meta.DrawString(Msg2);

    IF  Meta.PtInRect(pt, R1) THEN
       Meta.DrawString(" pt IS in rect  ");
    ELSE
       Meta.DrawString(" pt NOT in rect ");
    END;

    Meta.RasterOp(GrConst.zXORz);
    Meta.MoveTo(px*79, py*4);
    Meta.LineTo(px*79, py*20);
    Meta.RasterOp(GrConst.zREPz);
  UNTIL ((pt.X <= -20) AND ((evnt.ASCII # CHR(3)) AND (evnt.ScanCode # BYTE(02EH))));

  Meta.TrackCursor(FALSE);
  Meta.HideCursor();

  Meta.BackColor(COLOR);

(* Scroll a rectangle into screen *)

  Meta.RasterOp(GrConst.zXORz);
  Meta.FrameRect(R1);
  Meta.RasterOp(GrConst.zREPz);

  FOR i := 0 TO 30 DO
    Meta.ScrollRect(R1, 0, -4);
    Meta.OffsetRect(R1, 0, -4);
  END;

  FOR i := 0 TO 40 DO
    Meta.ScrollRect(R1, 8, 0);
    Meta.OffsetRect(R1, 8, 0);
  END;

  mwDelay(sec);

(* pretty patterns to end with *)
  DispPatt();
  mwDelay(sec*3);

  GrQry.GrQuit('', 0);

END Testtrak.