MODULE SpriteDemo2 ;

(* Demonstration of a simple sprite


Version 0.00a 08-Dec-86  Martin Fisher, Modula-2 Software Ltd.
                Converted from original in ROM kernel manual.
*)


FROM SYSTEM IMPORT BYTE, ADR, ADDRESS, ASH, NULL, TSIZE, WORD ;
FROM Colors IMPORT ColorTablePtr, ColorTable, ColorMapPtr, ColorMap, 
                   FreeColorMap, GetColorMap, SetRGB4 ;
FROM Copper IMPORT FreeCprList, FreeCopList ; 
FROM DOSProcessHandler IMPORT Exit ;
FROM GraphicsBase IMPORT GfxBasePtr ;
FROM GraphicsLibrary IMPORT GraphicsBase, GraphicsName, BitMap, BltClear, 
                            InitBitMap, PlanePtr ;
FROM Libraries IMPORT OpenLibrary, CloseLibrary ;
FROM Rasters IMPORT RasInfoPtr, RasInfo, AllocRaster, FreeRaster, InitRastPort;
FROM Sprites IMPORT GetSprite, FreeSprite, MoveSprite, SimpleSprite, 
                    ChangeSprite ;
FROM Views  IMPORT View, ViewPtr, ViewPort, ViewPortPtr, Modes, ModeSet,
                   LoadView, FreeVPortCopLists, InitView, InitVPort, 
                   MakeVPort, MrgCop, WaitTOF ;



CONST
  depth=2 ;
  width=320;
  height=200 ;

VAR
  view : View ;
  viewPort, VP[0] : ViewPort ;
  cm : ColorMapPtr ;
  rasinfo : RasInfo ;
  bitmap : BitMap ;
  xmove,ymove : INTEGER ;
  oldView : ViewPtr ;
  colorTable : ARRAY [0..31] OF CARDINAL ;
  boxOffsets : ARRAY [0..2] OF CARDINAL ;
  colorPalette : ColorTablePtr ;
  spriteData : ARRAY [0..21] OF CARDINAL ;
  GfxBase : GfxBasePtr ;
  sprite  : SimpleSprite ;
  

PROCEDURE Setup ;
VAR i : CARDINAL ;
BEGIN
  spriteData[0]:=0      ; spriteData[1]:=0 ;  

  spriteData[2]:=0fc3H  ; spriteData[3]:=0 ;  
  spriteData[4]:=03ff3H ; spriteData[5]:=0 ;
  spriteData[6]:=030c3H ; spriteData[7]:=0 ;  
  spriteData[8]:=0      ; spriteData[9]:=3c03H ;  
  spriteData[10]:=0     ; spriteData[11]:=3fc3H ;  
  spriteData[12]:=0     ; spriteData[13]:=03c3H ;
  spriteData[14]:=0c033H; spriteData[15]:=0c033H ;  
  spriteData[16]:=0ffc0H; spriteData[17]:=0ffc0H ;  
  spriteData[18]:=03f03H; spriteData[19]:=03f03H ;

  spriteData[20]:=0     ; spriteData[21]:=0 ;  


  colorTable[0] := 0 ; 
  colorTable[1] := 0f00H ; 
  colorTable[2] := 00f0H ; 
  colorTable[3] := 000fH ; 
  FOR i := 4 TO 31 DO
    colorTable[i] := 0 
  END ;
  boxOffsets[0]:=802 ;  
  boxOffsets[1]:=2010 ;  
  boxOffsets[0]:=3218
END Setup ;


PROCEDURE FreeMemory ;
VAR
  i : CARDINAL ;
BEGIN
  FOR i:=0 TO depth-1 DO
    IF bitmap.Planes[i]#NULL THEN 
      FreeRaster(bitmap.Planes[i],width,height)
    END 
  END ;
  IF cm#NULL THEN FreeColorMap(cm) END ;
  FreeVPortCopLists(ADR(viewPort)) ;
  FreeCprList(view.LOFCprList^) 
END FreeMemory;


PROCEDURE DemoView ;
VAR i : CARDINAL ;
BEGIN
  GfxBase:=GfxBasePtr(OpenLibrary(GraphicsName,0)) ;
  IF GfxBase=NULL THEN Exit(100) END ;
  oldView:=GfxBase^.ActiView ;
  GraphicsBase:=ADDRESS(GfxBase) ;
  InitView(ADR(view)) ;
  InitVPort(ADR(viewPort)) ;
  view.viewPort := ADR(viewPort) ;
  InitBitMap(bitmap,depth,width,height) ;
  rasinfo.bitMap := ADR(bitmap) ;
  rasinfo.rxOffset := 0 ;
  rasinfo.ryOffset := 0 ;
  rasinfo.next := NULL ;
  
  viewPort.dWidth :=width ;
  viewPort.dHeight := height ;
  viewPort.rasInfo := ADR(rasinfo) ;
  
  cm:=GetColorMap(32) ;
  IF cm=NULL THEN
    FreeMemory() ;
    Exit(100)
  END ;
  colorPalette := cm^.colorTable ;
  FOR i:=0 TO 31 DO
    colorPalette^[i]:=colorTable[i] ;
  END ;
  viewPort.colorMap := ADDRESS(cm) ;
  viewPort.modes := ModeSet{Sprites} ;
  
  FOR i:=0 TO depth-1 DO 
    bitmap.Planes[i]:=PlanePtr(AllocRaster(width,height)) ;
    IF bitmap.Planes[i]=NULL THEN Exit(LONGCARD(-1000)) END ;
    BltClear(bitmap.Planes[i],LONGCARD(height)*10000H+
             (LONGCARD(width)+7) DIV 8,{1}) ;
 END ;

 MakeVPort(ADR(view),ADR(viewPort)) ;
 MrgCop(ADR(view)) ;
 LoadView(ADR(view)) 
END DemoView;


PROCEDURE DrawFilledBox(fillcolor, plane : CARDINAL ; displayMem : ADDRESS) ;
VAR
  value : BYTE ;
  d : POINTER TO BYTE  ;
  i,j : CARDINAL ;
BEGIN
  d := displayMem ;
  FOR j := 0 TO 99 DO 
    IF CARDINAL(BITSET(fillcolor)*BITSET(ASH(1,plane)))#0 THEN
      value := BYTE(255) 
    ELSE
      value := BYTE(0) 
    END;
    FOR i:=0 TO 19 DO
      d^:=value ;
      INC(d) 
    END ;
    (*$T-*)
    INC(d,bitmap.BytesPerRow-20) 
    (*$T=*)
  END 
END DrawFilledBox ;
      
     
PROCEDURE Boxes ;
VAR
  n, k : CARDINAL ;
  d    : ADDRESS ;
BEGIN
  FOR n:=1 TO 3 DO 
    FOR k:=0 TO 1 DO
      d:=bitmap.Planes[k]+ADDRESS(LONGCARD(boxOffsets[n-1])) ;
      DrawFilledBox(n,k,d) 
    END
  END
END Boxes ;


PROCEDURE ShowSprite ;
VAR 
  sp : INTEGER ;
  k : CARDINAL ;
  n,i,xmove,ymove : INTEGER ;
  
BEGIN
  sp := GetSprite(sprite,-1) ;
  IF sp=-1 THEN RETURN END ;
  sprite.x := 0 ;
  sprite.y := 0 ;
  sprite.height := 9 ;
  k:=CARDINAL(BITSET(sp)*BITSET(6))*2+16 ;
  SetRGB4(ADR(viewPort),k+1,12,3,8) ;
  SetRGB4(ADR(viewPort),k+2,13,13,13) ;
  SetRGB4(ADR(viewPort),k+3,4,4,15) ;
  ChangeSprite(ADR(viewPort),sprite,ADR(spriteData)) ;
  MoveSprite(ADR(VP), sprite,30,0) ;
  xmove := 1 ; ymove := 1 ;
  FOR n:= 0 TO 3 DO
    FOR i:=0 TO 184 DO
      MoveSprite(ADR(VP),sprite,CARDINAL(INTEGER(sprite.x)+xmove),
                 CARDINAL(INTEGER(sprite.y)+ymove)) ;
      WaitTOF ;
    END ;
    xmove := -xmove ;
    ymove := -ymove 
  END ;
  FreeSprite(sp) 
END ShowSprite ;


BEGIN
  Setup ;
  DemoView ;
  Boxes ;
  ShowSprite ;
  LoadView(oldView) ;
  FreeMemory ;
  CloseLibrary(GraphicsBase) 


END SpriteDemo2.