home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 10 / Fresh_Fish_10_2352.bin / new / dev / obero / oberon-a / examples / libraries / graphics / vsprite.mod < prev    next >
Text File  |  1995-07-02  |  8KB  |  266 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: VSprite.mod $
  4.   Description: Port of vsprite.c
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.2 $
  8.       $Author: fjc $
  9.         $Date: 1995/07/02 16:59:37 $
  10.  
  11.   Copyright © 1995, Frank Copeland.
  12.   This example program is part of Oberon-A.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15.   Log entries are at the end of the file.
  16.  
  17. *************************************************************************)
  18.  
  19. <* STANDARD- *>
  20.  
  21. MODULE VSprite;
  22.  
  23. IMPORT
  24.   SYS := SYSTEM, Kernel, Errors, e := Exec, i := Intuition,
  25.   gfx := Graphics, d := Dos, at := AnimTools, s := Sets;
  26.  
  27. (*------------------------------------*)
  28.  
  29. CONST
  30.   VersionTag = "$VER: VSprite 1.2 (2.6.95)\r\n";
  31.   VersionStr = "VSprite 1.2 (2.6.95)";
  32.   CopyrightStr = "Copyright © 1995 Frank Copeland";
  33.  
  34. (*------------------------------------*)
  35.  
  36. VAR
  37.  
  38.   returnCode : LONGINT;
  39.  
  40. CONST
  41.  
  42.   gelSize = 4;
  43.  
  44. (* VSprite data - there are two sets that are alternated between. *)
  45. (* note that this data is always displayed as low resolution      *)
  46.  
  47. CONST
  48.  
  49.   vspriteDataStr1 =
  50.     "\x7F\xFE\x80\xFF"
  51.     "\x7C\x3E\x80\x3F"
  52.     "\x7C\x3E\x80\x3F"
  53.     "\x7F\xFE\x80\xFF"
  54.     "\x00\x00\x00\x00";
  55.  
  56.   vspriteDataStr2 =
  57.     "\x7F\xFE\xFF\x01"
  58.     "\x7C\x3E\xFC\x01"
  59.     "\x7C\x3E\xFC\x01"
  60.     "\x7F\xFE\xFF\x01"
  61.     "\x00\x00\x00\x00";
  62.  
  63. TYPE
  64.  
  65.   VSpriteDataArray = ARRAY 10 OF INTEGER;
  66.   VSpriteDataPtr = POINTER [2] TO VSpriteDataArray;
  67.  
  68. VAR
  69.  
  70.   vspriteData1, vspriteData2 : VSpriteDataPtr;
  71.   mySpriteColors, mySpriteAltColors : ARRAY 3 OF INTEGER;
  72.   myNewVSprite : at.NewVSprite;
  73.   myNewWindow : i.NewWindow;
  74.  
  75.   myVSprite : gfx.VSpritePtr;
  76.   myGInfo : gfx.GelsInfoPtr;
  77.   win : i.WindowPtr;
  78.   myRPort : gfx.RastPort;
  79.  
  80.  
  81. (* ---------------------------------- *)
  82.  
  83. (* Basic VSprite display subroutine *)
  84.  
  85. PROCEDURE DrawGList ( win : i.WindowPtr; myRPort : gfx.RastPortPtr );
  86. BEGIN (* DrawGList *)
  87.   gfx.SortGList (myRPort);
  88.   gfx.DrawGList (myRPort, i.ViewPortAddress (win));
  89.   i.RethinkDisplay ()
  90. END DrawGList;
  91.  
  92.  
  93. PROCEDURE* Cleanup (VAR rc : LONGINT);
  94.  
  95. BEGIN (* Cleanup *)
  96.   IF myVSprite # NIL THEN
  97.     gfx.RemVSprite (myVSprite);
  98.     at.FreeVSprite (myVSprite);
  99.     myVSprite := NIL
  100.   END;
  101.   IF myGInfo # NIL THEN
  102.     DrawGList (win, SYS.ADR (myRPort));
  103.     at.CleanupGelSys (myGInfo, SYS.ADR (myRPort))
  104.   END;
  105.   IF win # NIL THEN
  106.     i.CloseWindow (win);
  107.     win := NIL
  108.   END;
  109.   IF returnCode <= d.fail THEN
  110.     rc := returnCode
  111.   END
  112. END Cleanup;
  113.  
  114. (*------------------------------------*)
  115. PROCEDURE Init ();
  116.  
  117. BEGIN (* Init *)
  118.   Kernel.SetCleanup (Cleanup);
  119.  
  120.   Kernel.Allocate (vspriteData1, SIZE (VSpriteDataArray), {e.chip});
  121.   ASSERT (vspriteData1 # NIL);
  122.   SYS.MOVE
  123.     (SYS.ADR (vspriteDataStr1), vspriteData1, SIZE (VSpriteDataArray));
  124.   Kernel.Allocate (vspriteData2, SIZE (VSpriteDataArray), {e.chip});
  125.   ASSERT (vspriteData2 # NIL);
  126.   SYS.MOVE
  127.     (SYS.ADR (vspriteDataStr2), vspriteData2, SIZE (VSpriteDataArray));
  128.  
  129.   mySpriteColors [0] := 00000H; mySpriteAltColors [0] := 0000FH;
  130.   mySpriteColors [1] := 000F0H; mySpriteAltColors [1] := 00F00H;
  131.   mySpriteColors [2] := 00F00H; mySpriteAltColors [2] := 00FF0H;
  132.  
  133.   (* information for the new VSprite *)
  134.   myNewVSprite.image := vspriteData1;
  135.   myNewVSprite.colorSet := SYS.ADR (mySpriteColors);
  136.   myNewVSprite.wordWidth := 1;
  137.   myNewVSprite.lineHeight := gelSize;
  138.   myNewVSprite.imageDepth := 2;
  139.   myNewVSprite.x := 160; myNewVSprite.y := 100;
  140.   myNewVSprite.flags := {gfx.vSprite};
  141.   myNewVSprite.hitMask := {gfx.borderHit};
  142.  
  143.   myNewWindow.leftEdge := 80; myNewWindow.topEdge := 20;
  144.   myNewWindow.width := 400; myNewWindow.height := 150;
  145.   myNewWindow.detailPen := -1; myNewWindow.blockPen := -1;
  146.   myNewWindow.idcmpFlags := {i.closeWindow, i.intuiTicks};
  147.   myNewWindow.flags :=
  148.     {i.activate, i.windowClose, i.windowDepth, i.rmbTrap, i.windowDrag};
  149.   myNewWindow.title := SYS.ADR (VersionStr);
  150.   myNewWindow.type := {i.wbenchScreen};
  151. END Init;
  152.  
  153.  
  154. (* Collision routine for vsprite hitting border.  Note that when the    *)
  155. (* collision is VSprite to VSprite (or Bob to Bob, Bob to AnimOb, etc), *)
  156. (* then the paramters are both pointers to a VSprite.                   *)
  157.  
  158. PROCEDURE* BorderCheck ( borderflags : s.SET32; hitVSprite : gfx.VSpritePtr );
  159.  
  160. <*$ < StackChk- DeallocPars- SaveRegs+ *>
  161. BEGIN (* BorderCheck *)
  162.   Kernel.GetDataSegment;
  163.   IF 3 IN borderflags THEN
  164.     hitVSprite.sprColors := SYS.ADR (mySpriteAltColors);
  165.     hitVSprite.vUserExt := -80;
  166.   END;
  167.   IF 2 IN borderflags THEN
  168.     hitVSprite.sprColors := SYS.ADR (mySpriteColors);
  169.     hitVSprite.vUserExt := 40;
  170.   END;
  171. END BorderCheck;
  172. <*$ > *>
  173.  
  174.  
  175. (* Process window and dynamically change vsprite. Get messages. Go away  *)
  176. (* on i.closeWindow.  Update and redisplay vsprite on i.IntuiTicks. Wait *)
  177. (* for more messages.                                                    *)
  178.  
  179. PROCEDURE ProcessWindow
  180.   ( win       : i.WindowPtr;
  181.     myRPort   : gfx.RastPortPtr;
  182.     myVSprite : gfx.VSpritePtr );
  183.  
  184.   VAR msg : i.IntuiMessagePtr; sigs : s.SET32;
  185.  
  186. BEGIN (* ProcessWindow *)
  187.   LOOP
  188.     sigs := e.Wait ({win.userPort.sigBit});
  189.     LOOP
  190.       msg := SYS.VAL (i.IntuiMessagePtr, e.GetMsg (win.userPort));
  191.       IF msg = NIL THEN EXIT END;
  192.       (* Only i.closeWindow and i.intuiTicks are active *)
  193.       IF msg.class = {i.closeWindow} THEN
  194.         e.ReplyMsg (msg);
  195.         RETURN
  196.       END;
  197.       (* Must be an i.intuiTicks: change x and y values on the fly. Note
  198.       ** offset by  window left and top edge--sprite relative to the
  199.       ** screen, not window. Divide the mouseY in half to adjust for lores
  200.       ** movement increments on a hires screen.
  201.       *)
  202.       myVSprite.x := win.leftEdge + msg.mouseX + myVSprite.vUserExt;
  203.       myVSprite.y := win.topEdge + (msg.mouseY DIV 2) + 1;
  204.       e.ReplyMsg (msg)
  205.     END; (* LOOP *)
  206.     (* Got a message, change image data on the fly *)
  207.     IF myVSprite.imageData = vspriteData1 THEN
  208.       myVSprite.imageData := vspriteData2
  209.     ELSE
  210.       myVSprite.imageData := vspriteData1
  211.     END;
  212.     gfx.SortGList (myRPort);
  213.     gfx.DoCollision (myRPort);
  214.     DrawGList (win, myRPort)
  215.   END; (* LOOP *)
  216. END ProcessWindow;
  217.  
  218.  
  219. (* Working with the VSprite. Setup the GEL system and get a new      *)
  220. (* VSprite (MakeVSprite()). Add VSprite to the system and display.   *)
  221. (* Use the vsprite. When done, remove VSprite and update the display *)
  222. (* without the VSprite. Cleanup everything.                          *)
  223.  
  224. PROCEDURE DoVSprite ( win : i.WindowPtr; myRPort : gfx.RastPortPtr );
  225.  
  226. BEGIN (* DoVSprite *)
  227.   myGInfo := at.SetupGelSys (myRPort, -4);
  228.   IF myGInfo = NIL THEN
  229.     returnCode := d.warn
  230.   ELSE
  231.     myVSprite := at.MakeVSprite (myNewVSprite);
  232.     IF myVSprite = NIL THEN
  233.       returnCode := d.warn
  234.     ELSE
  235.       myVSprite.vUserExt := 40;
  236.       gfx.AddVSprite (myVSprite, myRPort);
  237.       DrawGList (win, myRPort);
  238.       gfx.SetCollision
  239.         ( gfx.borderHit, SYS.VAL (e.PROC, BorderCheck), myRPort.gelsInfo );
  240.       ProcessWindow (win, myRPort, myVSprite);
  241.     END;
  242.   END;
  243. END DoVSprite;
  244.  
  245.  
  246. (* Example VSprite program. First open up the libraries and a window. *)
  247.  
  248. PROCEDURE Main ();
  249.  
  250. BEGIN (* Main *)
  251.   returnCode := d.ok;
  252.   ASSERT (gfx.base.libNode.version > 36, d.fail);
  253.   ASSERT (i.base.libNode.version > 36, d.fail);
  254.   win := i.OpenWindow (myNewWindow);
  255.   ASSERT (win # NIL, d.warn);
  256.   gfx.InitRastPort (myRPort);
  257.   myRPort := win.wScreen.rastPort; (* Copy the structure *)
  258.   DoVSprite (win, SYS.ADR (myRPort))
  259. END Main;
  260.  
  261. BEGIN (* VSprite *)
  262.   Errors.Init;
  263.   Init ();
  264.   Main ();
  265. END VSprite.
  266.