{ Example program to bounce a hardware sprite in the shape of a racing car }
{ around a borderless window on a custom screen.                           }
{ For details of the compiler and linker command lines see Appendix D      }

PROGRAM sprite( output );

INCLUDE 'intuition/intuition.h';
INCLUDE 'graphics/sprite.h';

CONST
 INTUITION_REV = 29; GRAPHICS_REV  =  29;
 NEXT_SPRITE   = -1; NO_SPRITES    =  -1; 
 DEFAULT_PEN   = -1; SPRITEH       =  16;

 { The following four constants define the rectangle around which }
 { the racing car is bounced. Note that the x scale is halved to  }
 { deal with the two-line increments used by interlaced displays  }

 XMIN = 0; XMAX = 304; YMIN = 0; YMAX = 184;

TYPE
 { The following type allows the pointer to be 'cast' as either }
 { a general pointer (as returned by ADDR) or as a pointer to a }
 { ViewPort (as required by ChangeSprite and SetRGB4)           }

 av = PACKED RECORD
       CASE BOOLEAN OF
        TRUE  : (aptr : APTR);
        FALSE : (vptr : ViewPortPtrType)
      END;

VAR
 scrn         : ScreenPtrType;
 newscrn      : NewScreenPtrType;
 wind         : WindowPtrType;
 newwind      : NewWindowPtrType;
 moves        ,
 newx, newy   ,
 xmove, ymove : INTEGER;
 sprite_id    : WORD;
 car          : SimpleSpritePtrType;
 car_data     : PACKED ARRAY[1..36] OF WORD;
 avrecord     : av;
 bounce       : BOOLEAN;

INCLUDE 'exec/libraries';      { For OpenLibrary }
INCLUDE 'graphics/routines';   { For WaitTOF } 
INCLUDE 'graphics/sprite';     { For Change/Free/Get/MoveSprite }
INCLUDE 'graphics/view';       { For SetRGB4 }
INCLUDE 'intuition/screens';   { For Close/OpenScreen, ShowTitle }
INCLUDE 'intuition/windows';   { For OpenWindow }
INCLUDE 'libraries/intuition'; { For Get/SetIntuitionBase }
INCLUDE 'libraries/gfx';       { For Get/SetGfxBase }



PROCEDURE UnableToAccess( name : STRING );
BEGIN
 WRITELN( 'Unable to access ', name );
 HALT( 10 )
END;



PROCEDURE OpenLibs;
VAR
 libname : STRING;
BEGIN
 { Open the Intuition library for the Intuition routines }

 libname := 'intuition.library';
 SetIntuitionBase( OpenLibrary( libname, INTUITION_REV ) );
 IF GetIntuitionBase = NIL
 THEN UnableToAccess( libname );

 { Open the Graphics library for the Graphics routines }

 libname := 'graphics.library';
 SetGfxBase( OpenLibrary( libname, GRAPHICS_REV ) );
 IF GetGfxBase = NIL
 THEN UnableToAccess( libname );
END;



{ Convert a number 0..65535 into -32768..32767 This allows }
{ a number 32768..65535 to be assigned to a Pascal WORD    }

FUNCTION u2s( x : INTEGER ) : WORD;
BEGIN
 IF x > 32767
 THEN u2s := x - 65536
 ELSE u2s := x
END;



PROCEDURE init_sprite;
VAR
 regbase : INTEGER;
BEGIN
 {$R- } 
 car_data[ 1] := 0; car_data[ 2] := 0; 

                        { Red and blue }
 car_data[ 3] :=      $B0000000100000001;
 car_data[ 5] :=      $B0000000111111111;
 car_data[ 7] :=      $B0000000001000100;
 car_data[ 9] :=      $B0000000011111100;
 car_data[11] :=      $B0000111111111111;
 car_data[13] :=      $B0000111111111111;
 car_data[15] :=      $B0000111111111111;
 car_data[17] :=      $B0000111111111111;
 car_data[19] :=      $B0000001111110000;
 car_data[21] :=      $B0000011111100000;
 car_data[23] :=      $B0000011111100000;
 car_data[25] :=      $B0000011111000000;
 car_data[27] := u2s( $B1110111111110000 );
 car_data[29] := u2s( $B1111111111110000 );
 car_data[31] := u2s( $B1111111111110000 );
 car_data[33] := u2s( $B1110000001110000 );

                         { Blue only }
 car_data[ 4] :=      $B0000000000000000; 
 car_data[ 6] :=      $B0000000000000000; 
 car_data[ 8] :=      $B0000000000000000; 
 car_data[10] :=      $B0000000000000000; 
 car_data[12] :=      $B0000111000000111;
 car_data[14] :=      $B0000111011100111;
 car_data[16] :=      $B0000110011100111;
 car_data[18] :=      $B0000110000000111;
 car_data[20] :=      $B0000000111000000;
 car_data[22] :=      $B0000000101000000;
 car_data[24] :=      $B0000000000000000;
 car_data[26] :=      $B0000000000000000;
 car_data[28] := u2s( $B1110000001110000 );
 car_data[30] := u2s( $B1110011001110000 );
 car_data[32] := u2s( $B1110000001110000 );
 car_data[34] := u2s( $B1110000001110000 );

 car_data[35] := 0; car_data[36] := 0;
 {$R+}

 NEW( car );
 sprite_id := GetSprite( car, NEXT_SPRITE );

 { Get Colour Registers for this sprite }

 CASE sprite_id OF
  0, 1       : regbase := 16;
  2, 3       : regbase := 20;
  4, 5       : regbase := 24;
  6, 7       : regbase := 28;
  NO_SPRITES : UnableToAccess( 'sprite' );
 END;

 { Set some colours in the sprites registers }

 avrecord.aptr := ADDR( scrn^.View_Port );
 SetRGB4( avrecord.vptr, regbase + 1, 12,  3,  8 );
 SetRGB4( avrecord.vptr, regbase + 2, 13, 13, 13 );
 SetRGB4( avrecord.vptr, regbase + 3,  4,  4, 15 );

 WITH car^ DO
 BEGIN
  x := 0; y := 0; height := SPRITEH
 END
END;



BEGIN
 OpenLibs;

 NEW( newscrn );
 WITH newscrn^ DO
 BEGIN
  LeftEdge := 0; TopEdge := 0; Width := 640; Height := 200;
  Depth := 3; DetailPen := DEFAULT_PEN; BlockPen := DEFAULT_PEN;
  ViewModes := u2s( HIRES ); Type := CUSTOMSCREEN; Font := NIL;
  DefaultTitle := NIL; Gadgets := NIL; CustomBitMap := NIL;
 END;

 scrn := OpenScreen( newscrn );
 IF scrn = NIL
 THEN UnableToAccess( 'screen' );

 ShowTitle( scrn, 0 );       { Hide the screen's title bar }

 NEW( newwind );
 WITH newwind^ DO
 BEGIN
  LeftEdge := 0; TopEdge := 0; Width := 640; Height := 200;
  DetailPen := DEFAULT_PEN; BlockPen := DEFAULT_PEN; Title := NIL; 
  Flags := ACTIVATE | SMART_REFRESH | BORDERLESS | BACKDROP; 
  Type := CUSTOMSCREEN; Screen := scrn; 
  BitMap := NIL; FirstGadget := NIL; CheckMark := NIL; 
 END;

 wind := OpenWindow( newwind );
 IF wind = NIL
 THEN UnableToAccess( 'Window' );

 init_sprite;

 avrecord.aptr := ADDR( scrn^.View_Port );
 ChangeSprite( avrecord.vptr, car, ADDR( car_data ) );

 MoveSprite( NIL, car, 100, 100 );

 xmove := 1; ymove := 1; moves := 0;

 REPEAT
  REPEAT
   newx := car^.x + xmove; bounce := newx > XMAX;

   IF bounce
   THEN xmove := -xmove
   ELSE
    IF newx < XMIN THEN
    BEGIN
     xmove := -xmove; bounce := TRUE
    END;
  UNTIL NOT bounce;

  REPEAT
   newy := car^.y + ymove; bounce := newy > YMAX;

   IF bounce
   THEN ymove := -ymove
   ELSE
    IF newy < YMIN THEN
    BEGIN
     ymove := -ymove; bounce := TRUE
    END;
  UNTIL NOT bounce;

  MoveSprite( NIL, car, newx, newy );
  WaitTOF;
  moves := moves + 1;
 UNTIL moves = 1000; 

 FreeSprite( sprite_id );
 CloseScreen( scrn )
END.