home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fresh Fish 10
/
Fresh_Fish_10_2352.bin
/
new
/
dev
/
obero
/
oberon-a
/
examples
/
libraries
/
graphics
/
simplesprite.mod
< prev
next >
Wrap
Text File
|
1995-07-02
|
4KB
|
138 lines
(*************************************************************************
$RCSfile: SimpleSprite.mod $
Description: Port of ssprite.c - Simple Sprite example
Created by: fjc (Frank Copeland)
$Revision: 1.1 $
$Author: fjc $
$Date: 1995/01/25 23:51:02 $
Copyright © 1994, 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 SimpleSprite;
IMPORT
SYS := SYSTEM, Kernel, e := Exec, gfx := Graphics, i := Intuition,
d := Dos, WbConsole;
CONST
VersionTag = "$VER: SimpleSprite 1.2 (23.1.95)\r\n";
VersionStr = "SimpleSprite 1.2 (23.1.95)\n";
CopyrightStr = "Copyright © 1994-1995 Frank Copeland";
(*------------------------------------*)
(* Real boring sprite data *)
TYPE
SpriteDataArray = ARRAY 22 OF INTEGER;
SpriteDataPtr = POINTER [2] TO SpriteDataArray;
VAR
spriteData : SpriteDataPtr;
CONST
SpriteDataStr =
"\x00\x00\x00\x00" (* position control *)
"\xFF\xFF\x00\x00" (* image data line 1, color 1 *)
"\xFF\xFF\x00\x00" (* image data line 2, color 1 *)
"\x00\x00\xFF\xFF" (* image data line 3, color 2 *)
"\x00\x00\xFF\xFF" (* image data line 4, color 2 *)
"\x00\x00\x00\x00" (* image data line 5, transparent *)
"\x00\x00\xFF\xFF" (* image data line 6, color 2 *)
"\x00\x00\xFF\xFF" (* image data line 7, color 2 *)
"\xFF\xFF\xFF\xFF" (* image data line 8, color 3 *)
"\xFF\xFF\xFF\xFF" (* image data line 9, color 3 *)
"\x00\x00\x00\x00" (* reserved, must init to 0 0 *)
;
(*------------------------------------*)
PROCEDURE Init ();
BEGIN (* Init *)
Kernel.Allocate (spriteData, SIZE (SpriteDataArray), {e.chip});
ASSERT (spriteData # NIL);
SYS.MOVE (SYS.ADR (SpriteDataStr), spriteData, SIZE (SpriteDataArray))
END Init;
(*------------------------------------*)
PROCEDURE Main ();
VAR
sprite : gfx.SimpleSprite;
viewport : gfx.ViewPortPtr;
spriteNum : INTEGER;
deltaMove, ktr1, ktr2, colorReg : INTEGER;
screen : i.ScreenPtr;
BEGIN (* Main *)
ASSERT (gfx.base.libNode.version >= 37, d.fail);
ASSERT (i.base.libNode.version >= 37, d.fail);
(* opened library, need a viewport to render a sprite over. *)
screen := i.OpenScreenTagsA (NIL, NIL);
ASSERT (screen # NIL, d.fail);
viewport := SYS.ADR (screen.viewPort);
spriteNum := gfx.GetSprite (sprite, 2);
IF spriteNum = -1 THEN
i.OldCloseScreen (screen);
HALT (d.warn)
ELSE
(* Calculate the correct base color register number, *)
(* set up the color registers. *)
colorReg := 16 + ((spriteNum MOD 7) * 2);
gfx.SetRGB4 (viewport, colorReg + 1, 12, 3, 8);
gfx.SetRGB4 (viewport, colorReg + 2, 13, 13, 13);
gfx.SetRGB4 (viewport, colorReg + 3, 4, 4, 15);
sprite.x := 0; (* initialize position and size info *)
sprite.y := 0; (* to match that shown in spriteData *)
sprite.height := 9; (* so system knows layout of data later. *)
(* install sprite data and move sprite to start position. *)
gfx.ChangeSprite (NIL, sprite, spriteData);
gfx.MoveSprite (NIL, sprite, 30 , 0);
(* move the sprite back and forth. *)
deltaMove := 1;
FOR ktr1 := 0 TO 5 DO
FOR ktr2 := 0 TO 99 DO
gfx.MoveSprite
(NIL, sprite, sprite.x + deltaMove, sprite.y + deltaMove);
gfx.WaitTOF (); (* one move per video frame *)
(* Show the effect of turning off sprite DMA *)
IF ktr2 = 40 THEN gfx.OffSprite() END;
IF ktr2 = 60 THEN gfx.OnSprite() END;
END;
deltaMove := -deltaMove
END;
(* NOTE: if you turn off the sprite at the wrong time (when it
** is being displayed), the sprite will appear as a vertical bar
** on the screen. To really get rid of the sprite, you must
** OffSprite while it is not displayed. This is hard in a
** multi-tasking system (the solution is not addressed in
** this program).
*)
gfx.OnSprite(); (* just to be sure *)
gfx.FreeSprite (spriteNum);
END;
i.OldCloseScreen (screen)
END Main;
BEGIN (* SimpleSprite *)
Init ();
Main ();
END SimpleSprite.