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

     $RCSfile: VSprite.mod $
  Description: Port of vsprite.c

   Created by: fjc (Frank Copeland)
    $Revision: 1.2 $
      $Author: fjc $
        $Date: 1995/07/02 16:59:37 $

  Copyright © 1995, Frank Copeland.
  This example program is part of Oberon-A.
  See Oberon-A.doc for conditions of use and distribution.

  Log entries are at the end of the file.

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

<* STANDARD- *>

MODULE VSprite;

IMPORT
  SYS := SYSTEM, Kernel, Errors, e := Exec, i := Intuition,
  gfx := Graphics, d := Dos, at := AnimTools, s := Sets;

(*------------------------------------*)

CONST
  VersionTag = "$VER: VSprite 1.2 (2.6.95)\r\n";
  VersionStr = "VSprite 1.2 (2.6.95)";
  CopyrightStr = "Copyright © 1995 Frank Copeland";

(*------------------------------------*)

VAR

  returnCode : LONGINT;

CONST

  gelSize = 4;

(* VSprite data - there are two sets that are alternated between. *)
(* note that this data is always displayed as low resolution      *)

CONST

  vspriteDataStr1 =
    "\x7F\xFE\x80\xFF"
    "\x7C\x3E\x80\x3F"
    "\x7C\x3E\x80\x3F"
    "\x7F\xFE\x80\xFF"
    "\x00\x00\x00\x00";

  vspriteDataStr2 =
    "\x7F\xFE\xFF\x01"
    "\x7C\x3E\xFC\x01"
    "\x7C\x3E\xFC\x01"
    "\x7F\xFE\xFF\x01"
    "\x00\x00\x00\x00";

TYPE

  VSpriteDataArray = ARRAY 10 OF INTEGER;
  VSpriteDataPtr = POINTER [2] TO VSpriteDataArray;

VAR

  vspriteData1, vspriteData2 : VSpriteDataPtr;
  mySpriteColors, mySpriteAltColors : ARRAY 3 OF INTEGER;
  myNewVSprite : at.NewVSprite;
  myNewWindow : i.NewWindow;

  myVSprite : gfx.VSpritePtr;
  myGInfo : gfx.GelsInfoPtr;
  win : i.WindowPtr;
  myRPort : gfx.RastPort;


(* ---------------------------------- *)

(* Basic VSprite display subroutine *)

PROCEDURE DrawGList ( win : i.WindowPtr; myRPort : gfx.RastPortPtr );
BEGIN (* DrawGList *)
  gfx.SortGList (myRPort);
  gfx.DrawGList (myRPort, i.ViewPortAddress (win));
  i.RethinkDisplay ()
END DrawGList;


PROCEDURE* Cleanup (VAR rc : LONGINT);

BEGIN (* Cleanup *)
  IF myVSprite # NIL THEN
    gfx.RemVSprite (myVSprite);
    at.FreeVSprite (myVSprite);
    myVSprite := NIL
  END;
  IF myGInfo # NIL THEN
    DrawGList (win, SYS.ADR (myRPort));
    at.CleanupGelSys (myGInfo, SYS.ADR (myRPort))
  END;
  IF win # NIL THEN
    i.CloseWindow (win);
    win := NIL
  END;
  IF returnCode <= d.fail THEN
    rc := returnCode
  END
END Cleanup;

(*------------------------------------*)
PROCEDURE Init ();

BEGIN (* Init *)
  Kernel.SetCleanup (Cleanup);

  Kernel.Allocate (vspriteData1, SIZE (VSpriteDataArray), {e.chip});
  ASSERT (vspriteData1 # NIL);
  SYS.MOVE
    (SYS.ADR (vspriteDataStr1), vspriteData1, SIZE (VSpriteDataArray));
  Kernel.Allocate (vspriteData2, SIZE (VSpriteDataArray), {e.chip});
  ASSERT (vspriteData2 # NIL);
  SYS.MOVE
    (SYS.ADR (vspriteDataStr2), vspriteData2, SIZE (VSpriteDataArray));

  mySpriteColors [0] := 00000H; mySpriteAltColors [0] := 0000FH;
  mySpriteColors [1] := 000F0H; mySpriteAltColors [1] := 00F00H;
  mySpriteColors [2] := 00F00H; mySpriteAltColors [2] := 00FF0H;

  (* information for the new VSprite *)
  myNewVSprite.image := vspriteData1;
  myNewVSprite.colorSet := SYS.ADR (mySpriteColors);
  myNewVSprite.wordWidth := 1;
  myNewVSprite.lineHeight := gelSize;
  myNewVSprite.imageDepth := 2;
  myNewVSprite.x := 160; myNewVSprite.y := 100;
  myNewVSprite.flags := {gfx.vSprite};
  myNewVSprite.hitMask := {gfx.borderHit};

  myNewWindow.leftEdge := 80; myNewWindow.topEdge := 20;
  myNewWindow.width := 400; myNewWindow.height := 150;
  myNewWindow.detailPen := -1; myNewWindow.blockPen := -1;
  myNewWindow.idcmpFlags := {i.closeWindow, i.intuiTicks};
  myNewWindow.flags :=
    {i.activate, i.windowClose, i.windowDepth, i.rmbTrap, i.windowDrag};
  myNewWindow.title := SYS.ADR (VersionStr);
  myNewWindow.type := {i.wbenchScreen};
END Init;


(* Collision routine for vsprite hitting border.  Note that when the    *)
(* collision is VSprite to VSprite (or Bob to Bob, Bob to AnimOb, etc), *)
(* then the paramters are both pointers to a VSprite.                   *)

PROCEDURE* BorderCheck ( borderflags : s.SET32; hitVSprite : gfx.VSpritePtr );

<*$ < StackChk- DeallocPars- SaveRegs+ *>
BEGIN (* BorderCheck *)
  Kernel.GetDataSegment;
  IF 3 IN borderflags THEN
    hitVSprite.sprColors := SYS.ADR (mySpriteAltColors);
    hitVSprite.vUserExt := -80;
  END;
  IF 2 IN borderflags THEN
    hitVSprite.sprColors := SYS.ADR (mySpriteColors);
    hitVSprite.vUserExt := 40;
  END;
END BorderCheck;
<*$ > *>


(* Process window and dynamically change vsprite. Get messages. Go away  *)
(* on i.closeWindow.  Update and redisplay vsprite on i.IntuiTicks. Wait *)
(* for more messages.                                                    *)

PROCEDURE ProcessWindow
  ( win       : i.WindowPtr;
    myRPort   : gfx.RastPortPtr;
    myVSprite : gfx.VSpritePtr );

  VAR msg : i.IntuiMessagePtr; sigs : s.SET32;

BEGIN (* ProcessWindow *)
  LOOP
    sigs := e.Wait ({win.userPort.sigBit});
    LOOP
      msg := SYS.VAL (i.IntuiMessagePtr, e.GetMsg (win.userPort));
      IF msg = NIL THEN EXIT END;
      (* Only i.closeWindow and i.intuiTicks are active *)
      IF msg.class = {i.closeWindow} THEN
        e.ReplyMsg (msg);
        RETURN
      END;
      (* Must be an i.intuiTicks: change x and y values on the fly. Note
      ** offset by  window left and top edge--sprite relative to the
      ** screen, not window. Divide the mouseY in half to adjust for lores
      ** movement increments on a hires screen.
      *)
      myVSprite.x := win.leftEdge + msg.mouseX + myVSprite.vUserExt;
      myVSprite.y := win.topEdge + (msg.mouseY DIV 2) + 1;
      e.ReplyMsg (msg)
    END; (* LOOP *)
    (* Got a message, change image data on the fly *)
    IF myVSprite.imageData = vspriteData1 THEN
      myVSprite.imageData := vspriteData2
    ELSE
      myVSprite.imageData := vspriteData1
    END;
    gfx.SortGList (myRPort);
    gfx.DoCollision (myRPort);
    DrawGList (win, myRPort)
  END; (* LOOP *)
END ProcessWindow;


(* Working with the VSprite. Setup the GEL system and get a new      *)
(* VSprite (MakeVSprite()). Add VSprite to the system and display.   *)
(* Use the vsprite. When done, remove VSprite and update the display *)
(* without the VSprite. Cleanup everything.                          *)

PROCEDURE DoVSprite ( win : i.WindowPtr; myRPort : gfx.RastPortPtr );

BEGIN (* DoVSprite *)
  myGInfo := at.SetupGelSys (myRPort, -4);
  IF myGInfo = NIL THEN
    returnCode := d.warn
  ELSE
    myVSprite := at.MakeVSprite (myNewVSprite);
    IF myVSprite = NIL THEN
      returnCode := d.warn
    ELSE
      myVSprite.vUserExt := 40;
      gfx.AddVSprite (myVSprite, myRPort);
      DrawGList (win, myRPort);
      gfx.SetCollision
        ( gfx.borderHit, SYS.VAL (e.PROC, BorderCheck), myRPort.gelsInfo );
      ProcessWindow (win, myRPort, myVSprite);
    END;
  END;
END DoVSprite;


(* Example VSprite program. First open up the libraries and a window. *)

PROCEDURE Main ();

BEGIN (* Main *)
  returnCode := d.ok;
  ASSERT (gfx.base.libNode.version > 36, d.fail);
  ASSERT (i.base.libNode.version > 36, d.fail);
  win := i.OpenWindow (myNewWindow);
  ASSERT (win # NIL, d.warn);
  gfx.InitRastPort (myRPort);
  myRPort := win.wScreen.rastPort; (* Copy the structure *)
  DoVSprite (win, SYS.ADR (myRPort))
END Main;

BEGIN (* VSprite *)
  Errors.Init;
  Init ();
  Main ();
END VSprite.