'===========================================================================
' Subject: MOVING TRANSPARENT SPRITE DEMO    Date: 01-21-97 (00:34)       
' Author:  Denis Boyles                      Code: QB, QBasic, PDS        
' Origin:  FidoNet QUIK_BAS Echo           Packet: GRAPHICS.ABC
'===========================================================================
'Here's the second demonstration program that I mentioned in the first
'message. The only thing to note is that I used a monochrome 2-color
'image for the sprite. While the sprite data is a bit different, the
'technique is the same. :)

'NCC1701D.BAS - :) a moving transparent sprite demo
'                  Public Domain by Denis Boyles

DECLARE SUB ReadSprite ()
DECLARE SUB ReadBits ()
DECLARE SUB DrawSprite (x%, y%, c%)
DECLARE SUB DrawStars ()
DECLARE SUB CalcCircle ()
DEFINT A-Z

CONST NumStars = 400
CONST FlyRad = 80

DIM SHARED sprite(16), bits(16), cosx(360), siny(360), oldimg(16, 16)

PRINT "Please Wait..."
ReadSprite
ReadBits
CalcCircle

SCREEN 13
DrawStars
LOCATE 12, 7
PRINT "USS Enterprise, NCC-1701-D"
ct = 0
DO
  GET (cosx(ct), siny(ct))-(cosx(ct) + 16, siny(ct) + 16), oldimg
  DrawSprite cosx(ct), siny(ct), 7
  WAIT &H3DA, 8
  PUT (cosx(ct), siny(ct)), oldimg, PSET
  IF ct = 359 THEN
    ct = 0
  ELSE
    ct = ct + 1
  END IF
LOOP WHILE INKEY$ = ""

SCREEN 0
WIDTH 80

'USS Enterprise, NCC-1701-D :) (b/w bitmap image)
DATA &H0000,&H07E0,&H0FF0,&H0FF0,&H1FF8,&H1FF8,&H1FF8,&H1FF8
DATA &H07E0,&H6186,&H6186,&H6186,&H7FFE,&H7FFE,&H63C6,&H0000

'16 bits lookup table
DATA &H0001,&H0002,&H0004,&H0008,&H0010,&H0020,&H0040,&H0080
DATA &H0100,&H0200,&H0400,&H0800,&H1000,&H2000,&H4000,&H8000

SUB CalcCircle
  FOR ct = 0 TO 359
    cosx(ct) = INT(COS(ct * (3.14 / 180)) * FlyRad + 160)
    siny(ct) = INT(SIN(ct * (3.14 / 180)) * FlyRad + 100)
  NEXT
END SUB

SUB DrawSprite (x, y, c)
  FOR yct = 0 TO 15
    FOR xct = 15 TO 0 STEP -1
      IF sprite(yct) AND bits(xct) THEN
        PSET (x + xct, y + yct), c
      END IF
    NEXT
  NEXT
END SUB

SUB DrawStars
  DIM StarColor(3): StarColor(0) = 7: StarColor(1) = 8: StarColor(2) = 15
  FOR ct = 1 TO NumStars
    PSET (INT(RND * 320), INT(RND * 200)), StarColor(INT(RND * 3))
  NEXT
END SUB

SUB ReadBits
  FOR ct = 0 TO 15
    READ bits(ct)
  NEXT
END SUB

SUB ReadSprite
  FOR ct = 0 TO 15
    READ sprite(ct)
  NEXT
END SUB