(* Demoprogramm zur animierten Darstellung von Hardwaresprites in Modula2 *)

MODULE Programm;
						
FROM Arts      IMPORT TermProcedure;	
FROM SYSTEM    IMPORT ADR, INLINE, WORD;
FROM Dos       IMPORT Delay;
FROM Exec      IMPORT AllocMem, FreeMem, MemReqSet, MemReqs, CopyMem;
FROM Intuition IMPORT NewScreen, ScreenPtr, OpenScreen,
		      CloseScreen, customScreen;
FROM Graphics  IMPORT ViewPortPtr, SimpleSpritePtr, ViewModeSet, SetRGB4,
		      sprites, GetSprite, MoveSprite, FreeSprite, ChangeSprite,
		      RastPortPtr, Move, Draw, SetAPen;

TYPE VAR
 MyScreen	:NewScreen;
 sp		:ScreenPtr;
 vp		:ViewPortPtr;
 rp		:RastPortPtr;
 SpPtr1		:SimpleSpritePtr;
 SprNr1		:INTEGER;
 XPos,YPos	:INTEGER;
 i, count	:INTEGER;
 Y2Pos		:ARRAY [0.. 12] OF INTEGER;

(*### Hier beginnen die vom Movie-Maker Professional erzeugten Daten ###*)

(* 1:06:15:000:F09:7C9:DEF *)

VAR
 ImgPtr : ARRAY [0.. 05] OF POINTER TO WORD;
 Img    : ARRAY [0.. 05],[0.. 33] OF WORD;

CONST HOEHE=15; ANZAHL=06;

PROCEDURE DefImg;
BEGIN
 (* Sprite0 *)
 Img[ 0][ 0]:=0; Img[ 0][ 1]:=0;
 Img[ 0][ 2]:=007C0H; Img[ 0][ 3]:=00600H;
 Img[ 0][ 4]:=01FF0H; Img[ 0][ 5]:=00E30H;
 Img[ 0][ 6]:=03FF8H; Img[ 0][ 7]:=031C0H;
 Img[ 0][ 8]:=07FFCH; Img[ 0][ 9]:=071C4H;
 Img[ 0][10]:=07FFCH; Img[ 0][11]:=071C4H;
 Img[ 0][12]:=08FFEH; Img[ 0][13]:=0FE38H;
 Img[ 0][14]:=08FFEH; Img[ 0][15]:=0FE38H;
 Img[ 0][16]:=08FFEH; Img[ 0][17]:=0FE38H;
 Img[ 0][18]:=0FFFEH; Img[ 0][19]:=071C6H;
 Img[ 0][20]:=0FFFEH; Img[ 0][21]:=071C6H;
 Img[ 0][22]:=07FFCH; Img[ 0][23]:=071C4H;
 Img[ 0][24]:=07FFCH; Img[ 0][25]:=00E38H;
 Img[ 0][26]:=03FF8H; Img[ 0][27]:=00E38H;
 Img[ 0][28]:=01FF0H; Img[ 0][29]:=00E30H;
 Img[ 0][30]:=007C0H; Img[ 0][31]:=001C0H;
 Img[ 0][32]:=0; Img[ 0][33]:=0;
 (* Sprite1 *)
 Img[ 1][ 0]:=0; Img[ 1][ 1]:=0;
 Img[ 1][ 2]:=007C0H; Img[ 1][ 3]:=00380H;
 Img[ 1][ 4]:=01FF0H; Img[ 1][ 5]:=00380H;
 Img[ 1][ 6]:=03FF8H; Img[ 1][ 7]:=01C70H;
 Img[ 1][ 8]:=07FFCH; Img[ 1][ 9]:=01C70H;
 Img[ 1][10]:=07FFCH; Img[ 1][11]:=01C70H;
 Img[ 1][12]:=0E3FEH; Img[ 1][13]:=0FF8EH;
 Img[ 1][14]:=0E3FEH; Img[ 1][15]:=0FF8EH;
 Img[ 1][16]:=0E3FEH; Img[ 1][17]:=0FF8EH;
 Img[ 1][18]:=0FFFEH; Img[ 1][19]:=01C70H;
 Img[ 1][20]:=0FFFEH; Img[ 1][21]:=01C70H;
 Img[ 1][22]:=07FFCH; Img[ 1][23]:=01C70H;
 Img[ 1][24]:=07FFCH; Img[ 1][25]:=0638CH;
 Img[ 1][26]:=03FF8H; Img[ 1][27]:=02388H;
 Img[ 1][28]:=01FF0H; Img[ 1][29]:=00380H;
 Img[ 1][30]:=007C0H; Img[ 1][31]:=00440H;
 Img[ 1][32]:=0; Img[ 1][33]:=0;
 (* Sprite2 *)
 Img[ 2][ 0]:=0; Img[ 2][ 1]:=0;
 Img[ 2][ 2]:=007C0H; Img[ 2][ 3]:=000C0H;
 Img[ 2][ 4]:=01FF0H; Img[ 2][ 5]:=018E0H;
 Img[ 2][ 6]:=03FF8H; Img[ 2][ 7]:=00718H;
 Img[ 2][ 8]:=07FFCH; Img[ 2][ 9]:=0471CH;
 Img[ 2][10]:=07FFCH; Img[ 2][11]:=0471CH;
 Img[ 2][12]:=0F8FEH; Img[ 2][13]:=03FE2H;
 Img[ 2][14]:=0F8FEH; Img[ 2][15]:=03FE2H;
 Img[ 2][16]:=0F8FEH; Img[ 2][17]:=03FE2H;
 Img[ 2][18]:=0FFFEH; Img[ 2][19]:=0C71CH;
 Img[ 2][20]:=0FFFEH; Img[ 2][21]:=0C71CH;
 Img[ 2][22]:=07FFCH; Img[ 2][23]:=0471CH;
 Img[ 2][24]:=07FFCH; Img[ 2][25]:=038E0H;
 Img[ 2][26]:=03FF8H; Img[ 2][27]:=038E0H;
 Img[ 2][28]:=01FF0H; Img[ 2][29]:=018E0H;
 Img[ 2][30]:=007C0H; Img[ 2][31]:=00700H;
 Img[ 2][32]:=0; Img[ 2][33]:=0;
 (* Sprite3 *)
 Img[ 3][ 0]:=0; Img[ 3][ 1]:=0;
 Img[ 3][ 2]:=007C0H; Img[ 3][ 3]:=00600H;
 Img[ 3][ 4]:=01FF0H; Img[ 3][ 5]:=00E30H;
 Img[ 3][ 6]:=03FF8H; Img[ 3][ 7]:=031C0H;
 Img[ 3][ 8]:=07FFCH; Img[ 3][ 9]:=071C4H;
 Img[ 3][10]:=07FFCH; Img[ 3][11]:=071C4H;
 Img[ 3][12]:=0FE3EH; Img[ 3][13]:=08FF8H;
 Img[ 3][14]:=0FE3EH; Img[ 3][15]:=08FF8H;
 Img[ 3][16]:=0FE3EH; Img[ 3][17]:=08FF8H;
 Img[ 3][18]:=0FFFEH; Img[ 3][19]:=071C6H;
 Img[ 3][20]:=0FFFEH; Img[ 3][21]:=071C6H;
 Img[ 3][22]:=07FFCH; Img[ 3][23]:=071C4H;
 Img[ 3][24]:=07FFCH; Img[ 3][25]:=00E38H;
 Img[ 3][26]:=03FF8H; Img[ 3][27]:=00E38H;
 Img[ 3][28]:=01FF0H; Img[ 3][29]:=00E30H;
 Img[ 3][30]:=007C0H; Img[ 3][31]:=001C0H;
 Img[ 3][32]:=0; Img[ 3][33]:=0;
 (* Sprite4 *)
 Img[ 4][ 0]:=0; Img[ 4][ 1]:=0;
 Img[ 4][ 2]:=007C0H; Img[ 4][ 3]:=00380H;
 Img[ 4][ 4]:=01FF0H; Img[ 4][ 5]:=00380H;
 Img[ 4][ 6]:=03FF8H; Img[ 4][ 7]:=01C70H;
 Img[ 4][ 8]:=07FFCH; Img[ 4][ 9]:=01C70H;
 Img[ 4][10]:=07FFCH; Img[ 4][11]:=01C70H;
 Img[ 4][12]:=0FF8EH; Img[ 4][13]:=0E3FEH;
 Img[ 4][14]:=0FF8EH; Img[ 4][15]:=0E3FEH;
 Img[ 4][16]:=0FF8EH; Img[ 4][17]:=0E3FEH;
 Img[ 4][18]:=0FFFEH; Img[ 4][19]:=01C70H;
 Img[ 4][20]:=0FFFEH; Img[ 4][21]:=01C70H;
 Img[ 4][22]:=07FFCH; Img[ 4][23]:=01C70H;
 Img[ 4][24]:=07FFCH; Img[ 4][25]:=0638CH;
 Img[ 4][26]:=03FF8H; Img[ 4][27]:=02388H;
 Img[ 4][28]:=01FF0H; Img[ 4][29]:=00380H;
 Img[ 4][30]:=007C0H; Img[ 4][31]:=00440H;
 Img[ 4][32]:=0; Img[ 4][33]:=0;
 (* Sprite5 *)
 Img[ 5][ 0]:=0; Img[ 5][ 1]:=0;
 Img[ 5][ 2]:=007C0H; Img[ 5][ 3]:=000C0H;
 Img[ 5][ 4]:=01FF0H; Img[ 5][ 5]:=018E0H;
 Img[ 5][ 6]:=03FF8H; Img[ 5][ 7]:=00718H;
 Img[ 5][ 8]:=07FFCH; Img[ 5][ 9]:=0471CH;
 Img[ 5][10]:=07FFCH; Img[ 5][11]:=0471CH;
 Img[ 5][12]:=0FFE2H; Img[ 5][13]:=038FEH;
 Img[ 5][14]:=0FFE2H; Img[ 5][15]:=038FEH;
 Img[ 5][16]:=0FFE2H; Img[ 5][17]:=038FEH;
 Img[ 5][18]:=0FFFEH; Img[ 5][19]:=0C71CH;
 Img[ 5][20]:=0FFFEH; Img[ 5][21]:=0C71CH;
 Img[ 5][22]:=07FFCH; Img[ 5][23]:=0471CH;
 Img[ 5][24]:=07FFCH; Img[ 5][25]:=038E0H;
 Img[ 5][26]:=03FF8H; Img[ 5][27]:=038E0H;
 Img[ 5][28]:=01FF0H; Img[ 5][29]:=018E0H;
 Img[ 5][30]:=007C0H; Img[ 5][31]:=00700H;
 Img[ 5][32]:=0; Img[ 5][33]:=0;
END DefImg;

(*### Hier enden die vom Movie-Maker Professional erzeugten Daten ###*)

(*----- Unterprogramm das zum Beenden des Hauptprogramms aufgerufen wird *)
    
PROCEDURE CleanUp;
BEGIN
 FreeSprite(SprNr1);
 FreeMem(SpPtr1, SIZE(SpPtr1^));
 FOR i:=0 TO ANZAHL-1 DO
  FreeMem(ImgPtr[i], 4*HOEHE+8);
 END;
 IF sp<>NIL THEN CloseScreen(sp) END;
END CleanUp;
 
(*----- Hier beginnt das Hauptprogramm -----*)

BEGIN
 TermProcedure(CleanUp);

 (* Spritedaten definieren *)

 DefImg();

 (* Sprite-Daten ins Chip-Memory kopieren *)

 FOR i:=0 TO ANZAHL-1 DO
  ImgPtr[i] := AllocMem(4*HOEHE+8, MemReqSet{chip, memClear});
  CopyMem(ADR(Img[i][0]), ImgPtr[i], 4*HOEHE+8);
 END;

 (* Neuen Screen öffnen *)

 WITH MyScreen DO
  leftEdge:=0; topEdge:=0; width:=320; height:=256; depth:=2;
  detailPen:=0; blockPen:=1;
  viewModes:=ViewModeSet{sprites}; type:=customScreen;
  font:=NIL; defaultTitle:=ADR("Spritedemo Modula II");
  gadgets:=NIL; customBitMap:=NIL;
 END;
 sp:=OpenScreen(MyScreen);
 rp:=ADR(sp^.rastPort);
 SetAPen(rp, 1);
 Move(rp, 0, 75); Draw(rp, 319, 75);

 (* SimpleSprite-Struktur initialisieren *)

 SpPtr1 := AllocMem(SIZE(SpPtr1^), MemReqSet{memClear});
 WITH SpPtr1^ DO				
  posctldata:=ImgPtr[0];
  height:=HOEHE;
  x:=0; y:=0;
  num:=2;
 END;
     
 IF sp#NIL THEN

  (* Farben des Sprites definieren *)

  vp:=ADR(sp^.viewPort);
  SetRGB4(vp, 21, 0FH, 00H, 09H);
  SetRGB4(vp, 22, 07H, 0CH, 09H);
  SetRGB4(vp, 23, 0DH, 0EH, 0FH);
  SprNr1:=GetSprite(SpPtr1, 2);

  (* Y-Positionen definieren (Ball springt) *)

  Y2Pos[0]:=0;
  Y2Pos[1]:=1;
  Y2Pos[2]:=2;
  Y2Pos[3]:=3;
  Y2Pos[4]:=2;
  Y2Pos[5]:=1;
  Y2Pos[6]:=0;
  Y2Pos[7]:=1;
  Y2Pos[8]:=2;
  Y2Pos[9]:=3;
  Y2Pos[10]:=2;
  Y2Pos[11]:=1;

  (* Sprite über den Bildschirm bewegen *)

  XPos:=10; YPos:=60; count:=0;
  REPEAT
   XPos:=XPos+2;
   MoveSprite(vp, SpPtr1, XPos, YPos-4*Y2Pos[count]);
   ChangeSprite(vp, SpPtr1, ImgPtr[count]);
   Delay(5);
   count:=count+1;
   IF count>ANZAHL-1 THEN count:=0; END;
  UNTIL XPos>300;
 END;
END Programm.