Topspeed_JPI/TS/GRAPHIX/GRFXDEMO.MOD

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

FROM Storage IMPORT ALLOCATE,DEALLOCATE;
IMPORT GrConst;
IMPORT Meta;
IMPORT GrFonts;
IMPORT GrPorts;
IMPORT GrQry;
IMPORT Terminal;
IMPORT Strings;
IMPORT Storage;
IMPORT SYSTEM;


VAR
  FontPtr: SYSTEM.ADDRESS;
  CommPort,GrafixCard:INTEGER;
  BufSize: CARDINAL;

  PROCEDURE Conclude(); FORWARD;


  PROCEDURE WaitForKey();
    VAR
      LastKey : CHAR;
    BEGIN
      Terminal.Read(LastKey) ;
      IF CAP(LastKey) = 'Q' THEN
        Conclude();
      END;
    END WaitForKey;

  PROCEDURE ClearGraphicsScreen();
    VAR
      scrnR : GrConst.rect;
    BEGIN
      Meta.ScreenRect(scrnR);
        (* Get the screen limits *)
      Meta.EraseRect(scrnR);
        (* Erase the screen *)
    END ClearGraphicsScreen;

(*
  PROCEDURE FileLoad( FileName: ARRAY OF CHAR;
      VAR DataAreaAdr: SYSTEM.ADDRESS; VAR BufSize:
      CARDINAL ): Terminal.ErrorMessage;
    VAR
      Handle: CARDINAL;
      name:ARRAY[0..79] OF CHAR;
      Err: Terminal.ErrorMessage;
    BEGIN
      M2Strings.Assign(FileName,name);
      Err:=HandleIO.FindFile(Handle,name, 'PATH');
      IF Err= Terminal.NoError THEN
        BufSize:=VAL(CARDINAL,HandleIO.FileLength(Handle));
        Storage.ALLOCATE( DataAreaAdr, BufSize );
        Err:=HandleIO.BlockRead(Handle, DataAreaAdr, BufSize);
        IF Err # Terminal.NoError THEN
          Err:=HandleIO.CloseHandle(Handle);
          RETURN Err;
        END;
      ELSE
        Conclude();
      END;
      RETURN Terminal.NoError;
    END FileLoad;
 *)

  PROCEDURE Explain( msg: ARRAY OF CHAR );
    BEGIN
      ClearGraphicsScreen;
      Meta.MoveTo( 20, 170 );
      Meta.DrawString( msg );
      Meta.MoveTo( 20, 190 );
      Meta.DrawString( 'Press any key to continue.');
      WaitForKey();
    END Explain;


  PROCEDURE Sample01();
    (* MoveTo/LineTo Example *)
    BEGIN
      Explain( 'First we draw a simple line.' );
      Meta.MoveTo(50,50);
        (* draw a line from *)
      Meta.LineTo(200,200);
        (* (50,50) to (200,200). *)
      WaitForKey();
    END Sample01;


  PROCEDURE Sample02();
    (* MoveTo/LineTo Example *)
    VAR
      tR : GrConst.rect;
      tmpImage: ADDRESS;
      imPara, imBytes : CARDINAL;
    BEGIN
      Explain(
'MetaWINDOW can read an image from the screen and display it elsewhere.');
      ClearGraphicsScreen();

      Meta.MoveTo(50,50);
      Meta.DrawString('*Image*');
      Meta.SetRect(tR, 45,40,115,55);
      Meta.FrameRect(tR);
      imPara := Meta.ImagePara(tR);
      IF (imPara > 2047) THEN
        Terminal.WriteString('Image too large');
        RETURN;
      END;
      imBytes := imPara*16;
      ALLOCATE(tmpImage,imBytes);
      Meta.ReadImage (tR, tmpImage);
        (* Read the image *)
      Meta.OffsetRect(tR,48,50);
        (* Write it back at *)
      Meta.WriteImage(tR, tmpImage);
        (* a different location. *)
      Meta.MoveTo( 20, 190);
      Meta.DrawString( 'Press any key to continue');
      DEALLOCATE(tmpImage,imBytes);
      WaitForKey();
    END Sample02;


  PROCEDURE Sample03();

    PROCEDURE LoadAndWrite( FileName: ARRAY OF CHAR; x, y: CARDINAL;
        message: ARRAY OF CHAR );
      VAR
        BufSize: CARDINAL;
      BEGIN
     (*   pfontrec := NIL;
        Terminal.PrintMessage( FileLoad( FileName,
                                         pfontrec,
                                         BufSize ) );
        Meta.SetFont( pfontrec ); *)
        BufSize:=Meta.LoadFont(FileName);
        Meta.MoveTo( x, y );
        Meta.DrawString(message);
      END LoadAndWrite;

    BEGIN
      Explain( 'MetaWINDOW supports a wide variety of fonts.' );

      ClearGraphicsScreen();

      Meta.TextSize(14,14);
          (* Set text size for stroked font, ROMANSIM.FNT *)
      Meta.TextFace(GrConst.cProportional);

      LoadAndWrite( 'SYSTEM01.FNT', 10, 50,  'Text output using SYSTEM01.FNT' );
      LoadAndWrite( 'SYSTEM08.FNT', 10, 60,  'Text output using SYSTEM08.FNT' );
      LoadAndWrite( 'SYSTEM11.FNT', 10, 80,  'SYSTEM11.FNT' );
      LoadAndWrite( 'SYSTEM16.FNT', 10,100,  'Text output using SYSTEM16.FNT' );
      LoadAndWrite( 'SYSTEM24.FNT', 10,130,  'Text output using SYSTEM24.FNT' );
      LoadAndWrite( 'SYSTEM32.FNT', 10,170,  'Text output using SYSTEM32.FNT' );
      LoadAndWrite( 'SYSTEM35.FNT', 10,210,  'SYSTEM35.FNT' );
      LoadAndWrite( 'SYSTEM48.FNT', 10,260,  'System48.Fnt' );
      LoadAndWrite( 'SYSTEM72.FNT', 10,320,  'System72.Fnt' );
      LoadAndWrite( 'ROMANSIM.FNT', 300,100, 'Text output using ROMANSIM.FNT' );
      LoadAndWrite( 'SYSTEM16.FNT', 300,320,  'Press any key to continue.' );

      WaitForKey();
    END Sample03;


  PROCEDURE Sample05();
    VAR
      SrcBitMap(*, DstBitMap*): GrPorts.adsBMap;
        (* pointer to default bitmap *)
      thePort: GrPorts.adsPort;
        (* pointer to default port *)
      dstR, srcR : GrConst.rect;
    BEGIN
      Explain( 'MetaWINDOW can even enlarge a graphic image.' );
      ClearGraphicsScreen();

      Meta.GetPort(thePort);
        (* Get default port address *)
      SrcBitMap := thePort^.portBMap;
        (* Get default bmap address *)
      Meta.MoveTo(50,50);
      Meta.DrawString('ZoomBits');
      Meta.SetRect(srcR, 45,40,115,55);
      Meta.FrameRect(srcR);
      Meta.SetRect(dstR,50,100,595,195);
      Meta.FrameRect(dstR);
      Meta.ZoomBits( SrcBitMap, SrcBitMap, srcR, dstR, dstR, 0 );

      Meta.MoveTo( 20, 220 );
      Meta.DrawString( 'Press any key to continue');

      WaitForKey();
    END Sample05;


  PROCEDURE Sample17();
    BEGIN
      Explain( "MetaWINDOW's fonts allow superscript and subscript." );
      Meta.MoveTo (75,50);
      Meta.DrawString('MetaWINDOW');
      Meta.MoveTo (Meta.QueryX(),Meta.QueryY()-5);
      Meta.DrawString('tm');
        (* superscript 'tm' *)
      WaitForKey();
    END Sample17;


  PROCEDURE Sample20();

    VAR
      i,J, ImPara, ImBytes : INTEGER;
      ImagePtr : ADDRESS;
      scrnR, tR : GrConst.rect;

    PROCEDURE OpenWindow(VAR R:GrConst.rect; Title:ARRAY OF CHAR);
      VAR
        LocalRect:GrConst.rect;
      BEGIN
        ImPara := Meta.ImagePara(R);
        IF (ImPara > 2047) THEN
          Meta.SetDisplay(GrConst.TextPg0);
          Terminal.WriteString('Image too large');
          Terminal.WriteLn;
          HALT;
        END;
        ImBytes := ImPara*16;
        IF NOT Storage.Available(ImBytes) THEN
          Meta.SetDisplay(GrConst.TextPg0);
          Terminal.WriteString('Insufficient memory');
          Terminal.WriteLn;
          HALT;
        END;
        Storage.ALLOCATE(ImagePtr,ImBytes);
        Meta.ReadImage(R,ImagePtr);
          (* Save the window area *)
        Meta.FillRect(R,1);
          (* Clear the window *)
        Meta.PenMode(GrConst.zNANDz);
          (* Outline the window *)
        Meta.FrameRect(R);
        Meta.SetRect(LocalRect, R.Xmin,R.Ymin,R.Xmax,R.Ymin+14);
        Meta.FillRect(LocalRect,0);
          (* Display title block *)
        Meta.MoveTo(LocalRect.Xmin+5,LocalRect.Ymin+10);
        Meta.DrawString(Title);
      END OpenWindow;

      PROCEDURE CloseWindow(VAR R:GrConst.rect);
      BEGIN
        Meta.RasterOp(GrConst.zREPz);
        Meta.WriteImage(R,ImagePtr);
          (* Restore the window area *)
        Storage.DEALLOCATE(ImagePtr,ImBytes);
      END CloseWindow;

    BEGIN
      Explain(
          'MetaWINDOW makes it easy to create desktop-style applications.');
      Meta.ScreenRect(scrnR);
        (* Get the screen limits *)
      Meta.FillRect(scrnR,3);
      Meta.SetRect(tR, 75,75,250,150);
      i:=( Meta.FileLoad( 'SYSTEM08.FNT', FontPtr, BufSize ) );
     IF i#0 THEN Conclude(); RETURN
     END;
     Meta.SetFont( FontPtr );
      FOR J:=1 TO 3 DO
         Meta.MoveTo( 20, 190);
         Meta.DrawString( 'Press any key to show menu  ');
         WaitForKey();
         OpenWindow (tR,'Menu Title');
         Meta.MoveTo( 20, 190);
         Meta.DrawString( 'Press any key to remove menu');
         WaitForKey();
         CloseWindow(tR);
         Meta.OffsetRect(tR, 150,20)
      END;
      Meta.MoveTo( 20, 190);
      Meta.DrawString( 'Press any key to continue   ');
      WaitForKey();
    END Sample20;


  PROCEDURE Sample11();
    VAR
      X, Y, Button : INTEGER;
      scrnR : GrConst.rect;
    BEGIN
      ClearGraphicsScreen();
      Terminal.WriteString(' Mouse-A-Sketch without tracking: ');
      Terminal.WriteLn;
      Terminal.WriteString('-  left mouse button draws lines,');
      Terminal.WriteLn;
      Terminal.WriteString('-  right mouse button erases screen,');
      Terminal.WriteLn;
      Terminal.WriteString('-  left & right together ends program.');
      Terminal.WriteLn;
      Terminal.WriteString('       (Press any key to start) ');
      Terminal.WriteLn;
      WaitForKey();
      Meta.InitMouse(CommPort);
      Meta.ScaleMouse(24,16);
      Meta.ScreenRect(scrnR);
        (* Get the screen limits *)
      Meta.EraseRect(scrnR);
        (* Erase the screen *)
      Meta.FrameRect(scrnR);
      X:=100;
      Y:=100;
      Button:=0;

      REPEAT
        REPEAT
          Meta.ReadMouse(X,Y,Button)
        UNTIL Button>=0;
        IF Button=GrConst.swLeft THEN Meta.LineTo(X,Y)
          (* Draw line *)
        ELSIF Button=GrConst.swRight THEN
          Meta.EraseRect(scrnR);
          Meta.FrameRect(scrnR)
        ELSE Meta.MoveTo (X,Y) END;
      UNTIL Button=(GrConst.swLeft+GrConst.swRight);
      Meta.StopMouse;

    END Sample11;


  PROCEDURE Sample19();

    VAR
      X, Y, XOld, YOld, Switch : INTEGER;
      scrnR : GrConst.rect;

    PROCEDURE DrawCursor (CX,CY:INTEGER);
      BEGIN
        Meta.RasterOp(GrConst.zXORz);
        Meta.MoveTo (scrnR.Xmin,CY);
        Meta.LineTo (scrnR.Xmax,CY);
        Meta.MoveTo (CX,scrnR.Ymin);
        Meta.LineTo (CX,scrnR.Ymax);
      END DrawCursor;

    BEGIN
      Meta.ScreenRect(scrnR);
        (* Get the screen limits *)
      Meta.EraseRect(scrnR);
        (* Erase the screen *)
      Meta.InitMouse(CommPort);
      X:=100; Y:=100; XOld:=100; YOld:=100;
      DrawCursor(X,Y);
        (* Put the cursor on the screen *)
      REPEAT
        REPEAT
          Meta.ReadMouse(X,Y,Switch);
        UNTIL Switch>=0;
        DrawCursor(XOld,YOld);
          (* erase old cursor *)
        DrawCursor(X,Y);
          (* draw cursor in new position*)
        XOld:=X;
        YOld:=Y;
      UNTIL Switch>0;
        (* until switch is pressed *)
      Meta.StopMouse;
    END Sample19;


  PROCEDURE Sample21();
    VAR
      X, Y, Level, Button : INTEGER;
      scrnR : GrConst.rect;
    BEGIN
      Meta.ScreenRect(scrnR);
        (* Get the screen limits *)
      Meta.EraseRect(scrnR);
        (* Erase the screen *)
      Terminal.WriteString(' Mouse-A-Sketch with Auto-Tracking');
      Terminal.WriteLn;
      Terminal.WriteString('-  left mouse button draws lines,');
      Terminal.WriteLn;
      Terminal.WriteString('-  right mouse button erases screen,');
      Terminal.WriteLn;
      Terminal.WriteString('-  left & right together ends program.');
      Terminal.WriteLn;
      Terminal.WriteString('       (Press any key to start) ');
      Terminal.WriteLn;
      WaitForKey();
      Meta.InitMouse(CommPort);
      Meta.ScaleMouse(24,16);
      Meta.EraseRect(scrnR);
        (* Erase the screen *)
      Meta.FrameRect(scrnR);
      X:=100;
      Y:=100;
      Button:=0;
      Meta.TrackCursor(TRUE);
      Meta.ShowCursor;
      Meta.LimitMouse(scrnR.Xmin,scrnR.Ymin,scrnR.Xmax,scrnR.Ymax);
          (* Keep mouse on screen *)
      REPEAT
        REPEAT
          Meta.QueryCursor(X,Y,Level,Button);
        UNTIL Button>=0;
        IF Button=GrConst.swLeft THEN
          Meta.HideCursor;
          Meta.LineTo(X,Y);
          Meta.ShowCursor;
        ELSIF Button=GrConst.swRight THEN
          Meta.HideCursor;
          Meta.EraseRect(scrnR);
          Meta.FrameRect(scrnR);
          Meta.ShowCursor;
        ELSE  Meta.MoveTo(X,Y); END;
      UNTIL Button=(GrConst.swLeft+GrConst.swRight);
      Meta.ProtectRect(scrnR);
      Meta.MoveTo(10,20);
      Meta.DrawString( '          AUTO-CURSOR TRACKING');
      Meta.MoveTo(10,35);
      Meta.DrawString( 'Notice how the cursor continues to track');
      Meta.MoveTo(10,50);
      Meta.DrawString( 'even while off computing or awaiting input.');
      Meta.MoveTo(10,65);
      Meta.DrawString( '       (Press any key to continue)');
      Meta.ProtectOff;
      WaitForKey();
      Meta.StopMouse;
    END Sample21;

  PROCEDURE Sample22;
    VAR
      X, XOld, Y, YOld, Button : INTEGER;
      scrnR : GrConst.rect;
    BEGIN
      Meta.InitMouse(CommPort);
      Meta.ScaleMouse(24,16);
      Meta.ScreenRect(scrnR);
        (* Get the screen limits *)
      Meta.EraseRect(scrnR);
        (* Erase the screen *)
      Meta.FrameRect(scrnR);
      Meta.PenMode(GrConst.zXORz);
      X:=100;
      Y:=100;
      XOld:=100;
      YOld:=100;
      Meta.MoveTo(100,100);
      Meta.LineTo(X,Y);
      Meta.LineTo(500,100);
      Meta.MoveCursor(X,Y);
      Meta.ShowCursor;
      REPEAT
        REPEAT
          Meta.ReadMouse(X,Y,Button);
        UNTIL Button>=0;
        Meta.HideCursor;
        Meta.MoveTo(100,100);
        Meta.LineTo(XOld,YOld);
        Meta.LineTo(500,100);
        Meta.MoveTo(100,100);
        Meta.LineTo(X,Y);
        Meta.LineTo(500,100);
        Meta.MoveCursor(X,Y);
        Meta.ShowCursor;
        XOld:=X; YOld:=Y;
      UNTIL Button=GrConst.swLeft;
      WaitForKey();
      Meta.StopMouse;
    END Sample22;


  PROCEDURE Hilbert();

    VAR
      penColr : CARDINAL;
      vR: GrConst.rect;
      x, y, x0, y0, h, h0, ox, oy, i : INTEGER;
      ch : CHAR;

    PROCEDURE Plt();
      BEGIN
        Meta.MoveTo(ox, oy);
        Meta.LineTo(x, y);
        penColr := (penColr+1) MOD 15;
        Meta.PenColor(penColr);
        ox := x;
        oy := y;
      END Plt;


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



    PROCEDURE a(i : INTEGER);
      BEGIN
        IF i>0 THEN
          d(i-1);
          DEC(x, CARDINAL(h));
          Plt();
          a(i-1);
          DEC(y, CARDINAL(h));
          Plt();
          a(i-1);
          INC(x, CARDINAL(h));
          Plt();
          b(i-1);
        END;
      END a;

    PROCEDURE b(i : INTEGER);
      BEGIN
        IF i>0 THEN
          c(i-1);
          INC(y, CARDINAL(h));
          Plt();
          b(i-1);
          INC(x, CARDINAL(h));
          Plt();
          b(i-1);
          DEC(y, CARDINAL(h));
          Plt();
          a(i-1);
        END;
      END b;

    PROCEDURE c(i : INTEGER);
      BEGIN
        IF i>0 THEN
          b(i-1);
          INC(x, CARDINAL(h));
          Plt();
          c(i-1);
          INC(y, CARDINAL(h));
          Plt();
          c(i-1);
          DEC(x, CARDINAL(h));
          Plt();
          d(i-1);
        END;
      END c;

    PROCEDURE d(i : INTEGER);
      BEGIN
        IF i>0 THEN
          a(i-1);
          DEC(y, CARDINAL(h));
          Plt();
          d(i-1);
          DEC(x, CARDINAL(h));
          Plt();
          d(i-1);
          INC(y, CARDINAL(h));
          Plt();
          c(i-1);
        END;
      END d;

    BEGIN
      ClearGraphicsScreen();
      Meta.SetRect(vR, 0, 0, 256, 256);
      Meta.VirtualRect(vR);
      h0 := 256;
      i := 0;
      h := h0;
      x0 := h DIV 2;
      y0 := x0;
      REPEAT
        INC(i);
        h := h DIV 2;
        INC(x0, CARDINAL(h DIV 2));
        INC(y0, CARDINAL(h DIV 2));
        x := x0;
        y := y0;
        ox := x0;
        oy := y0;
        a(i);
      UNTIL (h<8);
      WaitForKey();
    END Hilbert;


  PROCEDURE Conclude();
    BEGIN
      Hilbert();
      Meta.SetDisplay(GrConst.TextPg0);
        (* Switch to alpha mode *)
      Meta.ClearText();
        (* Clear the text screen *)
(*
      MetaErrStatus.WriteErrorStatus();
*)
      Terminal.WriteLn;
      Terminal.WriteLn;
      Terminal.WriteString(
        'The Modula-2 interface to MetaWINDOW is available exclusively from' );
      Terminal.WriteLn;
      Terminal.WriteLn;
      Terminal.WriteLn;
      Terminal.WriteString('  PMI');
      Terminal.WriteLn;
      Terminal.WriteString( '  3279 North Nicolet Drive' );
      Terminal.WriteLn;
      Terminal.WriteString( '  Green Bay WI 54311' );
      Terminal.WriteLn;
      Terminal.WriteLn;
      Terminal.WriteLn;
      Terminal.WriteString( '  P.O. Box 8402' );
      Terminal.WriteLn;
      Terminal.WriteString( '  Green Bay WI 54308' );
      Terminal.WriteLn;
      Terminal.WriteLn;
      Terminal.WriteLn;
      Terminal.WriteString( '  tel: (414) 468-6040' );
      Terminal.WriteLn;
      Terminal.WriteString(  '  fax: (414) 465-0464' );
      Terminal.WriteLn;
      Terminal.WriteLn;
      Terminal.WriteLn;
      WaitForKey();
      Meta.ClearText();
      HALT;
    END Conclude;


VAR
  MouseFound: BOOLEAN;
  tmpc: INTEGER;
  i,argc: CARDINAL;


BEGIN
  GrQry.GrQuery(GrafixCard, CommPort);

  i := Meta.InitGrafix(-GrafixCard);

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

  MouseFound := CommPort = GrConst.MsDriver;

    (* Have MetaWINDOW figure out what the Grphics card and mouse
     * driver are.  Global GrQry.GrafixCard and GrQry.CommPort variables will
	 * be updated as side-effects.
	 *)
  IF GrafixCard=0 THEN
    (* MetaWINDOW not installed *)
    RETURN;
  END;

  Meta.SetDisplay(GrConst.GrafPg0);
    (* Switch to graphics page 0 *)
  tmpc:=Meta.LoadFont('SYSTEM16.FNT');
 (* Terminal.PrintMessage( FileLoad( 'SYSTEM16.FNT', FontPtr, BufSize ) );
    (* MetaWINDOW tries to load this font file by default, but it's
       not very smart about where to look for it.  FileLoad is smarter,
       so we open it explicitly. *)
  Meta.SetFont( FontPtr );
   *)
  Explain(
"A brief demonstration of MetaWINDOW graphics for JPI's TopSpeed Modula-2." );

  Sample01();

  Sample02();
  Sample03();
  Sample17();
  Sample05();
  Sample20();

    (*Rest of GrfxDemo requires a mouse.*)

  IF MouseFound THEN
    Explain(
      'Remainder of demo requires a mouse.  Press Q if mouse not installed.' );
    Sample11();
    Sample19();
    Sample21();
    Sample22();
  ELSE
    Explain( 'Remainder of demo requires a mouse.  No mouse located.' );
  END;
  Conclude();
END GrfxDemo.