Sprite 13 - Dixon (All BASIC) - Modified

Category: Sprite Tutor Series

Date: 03-28-2012

Return to Index


 
'Compilable Example:
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim ALL
 
%MaxSprites=  10000   'number of sprites to create
%FrameDuration = 40   'time between updates in msec (timer trigger interval) 40 = 25fps
 
%vSmall = 1
%medium = 2
%large = 3
%numbers = 4
 
'should screen wrap left-right or up-down or both
%WrapX = 1  '1=sprite leaving side of screen will appear on other side automatically
%WrapY = 1  '1=sprite leaving top/bottom of screen will appear at bottom/top automatically
 
#Include "win32api.inc"
 
'All bitmaps to consist of a single bitmap split horizontally into frames for animation
 
Type Sprite
   Hnd      As Long         'handle to the bitmap string to use for this sprite
   xSize    As Long         'sprite size x
   ySize    As Long         'sprite size y
   xPos     As Long         'sprite position x
   yPos     As Long         'sprite position y
   xSpeed   As Long         'sprite x speed for simple motion
   ySpeed   As Long         'sprite y speed for simple motion
   Motion   As Long         'index of which SUB should be called to calculate complex motion. 0 = simple motion
   MaxFrame As Long         'number of frames for animation in this bitmap
   CurrentFrame   As Long   'start at frame 0
   AnimationTime  As Long   'The limit of AnimationCount before returning to zero and showing next frame
   AnimationCount As Long   'counter of time between updates of animation frames.
   Transparent    As Long   'which colour is transparent in this sprite
   Flags As Long            'bit0 = %PlotSprite, bit1 = %SpriteActive
End Type
 
   'Flags in Sprites
   %PlotSprite = 1     'the sprite is to be draw on the screen
   %SpriteActive = 2   'the sprite is to be updated, even if not drawn
 
   Global TimerHandle As Long
   Global hWindow As Long
   Global Sprites() AS Sprite
   Global ScreenWidth, ScreenHeight As Long
   Global SpriteStrings() AS String
   Global PlotFlag, QuitFlag As Long
   Global bmp,bmp2 AS String
   Global hPlotThread As Long
 
Function PBMain() As Long
   Local junk As Long
   Local nWidth, nHeight, nFile, r, num As Long
   Dim Sprites(%MaxSprites)
   Dim SpriteStrings(%MaxSprites)
   Local x As Long
   Local y,hFont, hBmp, col As Long
 
   ScreenWidth =  800 : ScreenHeight = 600
   Graphic Window "Sprite tests...press a key",0,0,ScreenWidth,ScreenHeight TO hWindow
 
   'a large animated sprite 140 x 140
   Graphic Bitmap New 6860,140 TO hBmp
   Graphic Attach  hBmp,0
   Graphic Clear %WHITE
   For x = 0 TO 49
      Graphic Ellipse  (x*140,0)-(x*140+140,140),%RED,%YELLOW '* (x-4.5)/9
      Graphic Pie  (x*140,0)-(x*140+140,140),x/49*2*3.142,(x+4)/49*2*3.142, %RED,%GREEN
      Graphic Set Pos (x*140+70,70)
      Graphic Print x
   Next
   Sprites(%large).hnd = %large
   Sprites(%large).xSize = 140
   Sprites(%large).ySize = 140
   Sprites(%large).xPos = 400
   Sprites(%large).yPos =100
   Sprites(%large).xSpeed =4
   Sprites(%large).ySpeed =1
   Sprites(%large).Motion =0
   Sprites(%large).MaxFrame = 49
   Sprites(%large).CurrentFrame = 0
   Sprites(%large).AnimationTime =10
   Sprites(%large).AnimationCount =0
   Sprites(%large).Flags =%PlotSprite Or %SpriteActive
   Sprites(%large).Transparent = &hffffff
 
   'Graphic Attach hWindow, 0
   'Graphic Copy hBMP, 0
   'Graphic WaitKey$
 
   Graphic Attach hBmp,0
   Graphic Get Bits TO SpriteStrings(%large)
   Graphic Bitmap End
   Graphic Detach
 
   For r = 0 TO 10
      Sprites(r).flags = 0 'don't plot these
   Next
 
   For r = 10 TO 14
      num = %large
      Sprites(r)=Sprites(num)
      Sprites(r).xpos=Rnd(0,ScreenWidth)
      Sprites(r).ypos=Rnd(0,ScreenHeight)
      Sprites(r).xSpeed=Rnd(-5,5)
      Sprites(r).ySpeed=Rnd(-5,5)
      Sprites(r).CurrentFrame = Rnd(0,Sprites(r).MaxFrame -1)
      Sprites(r).AnimationTime = 1
      Sprites(r).flags = %PlotSprite Or %SpriteActive
   Next
 
   PlotFlag = CreateEvent(ByVal 0,ByVal 1, ByVal 0, ByVal 0) 'default security,Manual Reset, Initially not-signalled, no name
   Thread Create PlotThread(junk) TO hPlotThread
   TimerHandle = timeSetEvent ( ByVal %FrameDuration, ByVal 0, CodePTR(TimerFunction), ByVal 0&, ByVal %TIME_PERIODIC)
 
   Graphic Attach hWindow,0    'wait for key press
   Graphic WaitKey$
 
   QuitFlag = 1             'force all threads to terminate
   timeKillEvent TimerHandle
   CloseHandle PlotFlag
 
   Sleep 100  'Give timer time to stop in case it triggers again after program ends' should wait and check it
End Function
 
Function TimerFunction ( ByVal uID As Long, ByVal uMsg As Long, _
      ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As LongAs Long
   'this is the routine that is run everytime the timer triggers
   #Register NONE
   Local WhichSprite As Long
   Static CalledBefore As Long
 
   Graphic Attach hWindow,0
 
   If Not CalledBefore Then
      CalledBefore = -1
      Graphic Get Bits TO bmp
      Bmp2=Bmp
   End If
 
   'do animation
   For WhichSprite = 1 TO %MaxSprites
      If (Sprites(WhichSprite).flags AND %SpriteActive) Then
         'update Sprite position
         Sprites(WhichSprite).yPos = Sprites(WhichSprite).yPos + Sprites(WhichSprite).ySpeed
         Sprites(WhichSprite).xPos = Sprites(WhichSprite).xPos + Sprites(WhichSprite).xSpeed
 
         If %WrapX Then
            If Sprites(WhichSprite).xPos > ScreenWidth Then
               Sprites(WhichSprite).xPos = Sprites(WhichSprite).xPos - ScreenWidth - Sprites(WhichSprite).xSize
            End If
            If Sprites(WhichSprite).xPos < - Sprites(WhichSprite).xSize Then
               Sprites(WhichSprite).xPos = Sprites(WhichSprite).xPos + ScreenWidth + Sprites(WhichSprite).xSize
            End If
         End If
 
         If %WrapY Then
            If Sprites(WhichSprite).yPos > ScreenHeight Then
               Sprites(WhichSprite).yPos = Sprites(WhichSprite).yPos - ScreenHeight - Sprites(WhichSprite).ySize
            End If
            If Sprites(WhichSprite).yPos < -Sprites(WhichSprite).ySize Then
               Sprites(WhichSprite).yPos = Sprites(WhichSprite).yPos + ScreenHeight + Sprites(WhichSprite).ySize
            End If
         End If
 
         Incr Sprites(WhichSprite).AnimationCount
 
         If Sprites(WhichSprite).AnimationCount = Sprites(WhichSprite).AnimationTime Then
            Sprites(WhichSprite).AnimationCount = 0
            Sprites(WhichSprite).CurrentFrame = (Sprites(WhichSprite).CurrentFrame + 1) Mod Sprites(WhichSprite).MaxFrame
         End If
      End If
   Next WhichSprite
 
   'Indicate to plot thread that there's been an update so it can start to plot
   SetEvent PlotFlag
 
   Graphic Detach
 
End Function
 
Thread Function PlotThread(ByVal junk As LongAs Long
   #Register NONE
   Local WhichSprite, x ,y, xLimit, yLimit, Transparent  As Long
   Local BmpStart, BMPStart1, BmpStart2, BmpStartX, BmpStartY, BMPbase, BMPoffset, LenBmp As Long
   Local SpriteStart, SpriteStartX, SpriteStartY, SpriteOffset, xSpriteTotWidth, SpriteBase As Long
   Local pSpriteOffset, pBmpOffset AS DWord PTR
   Local fps AS String
   Static frames As Long
   Static tm1 AS EXT
 
   Graphic Attach hWindow,0
   tm1 = Timer
 
   Do
      'wait until timer has triggered and updated sprite positions
      WaitForSingleObject PlotFlag, %INFINITE
 
      BmpStart = StrPTR(Bmp2) + 8
      '        BMPStart1 = StrPTR(Bmp) + 8
      '        BMPStart2 = StrPTR(Bmp2) + 8
      LenBmp =Len(bmp) - 8
      Bmp2 = bmp
      'This is a time consuming copy in a time sensitive place which can be done a little faster in ASM
 
      For WhichSprite = 1 TO %MaxSprites
         If (Sprites(WhichSprite).flags AND %PlotSprite) Then
            'copy the sprite into the correct location within Bmp2 which is then copied to the screen
 
            SpriteStart = StrPTR(SpriteStrings(Sprites(WhichSprite).hnd))+8
            xSpriteTotWidth = CVL(SpriteStrings(Sprites(WhichSprite).hnd),1)
 
            BmpStartX = MAX&(0,Sprites(WhichSprite).xPos)
            BmpStartY = MAX&(0,Sprites(WhichSprite).yPos)
            SpriteStartX = MAX&(0, - Sprites(WhichSprite).xPos) + Sprites(WhichSprite).xSize * Sprites(WhichSprite).CurrentFrame
            SpriteStartY = MAX&(0,-Sprites(WhichSprite).yPos)
            xLimit = (MIN&(Sprites(WhichSprite).xSize + Sprites(WhichSprite).xPos, Sprites(WhichSprite).xSize, ScreenWidth  - Sprites(WhichSprite).xPos) -1) *4
            yLimit = (MIN&(Sprites(WhichSprite).ySize + Sprites(WhichSprite).yPos, Sprites(WhichSprite).ySize, ScreenHeight - Sprites(WhichSprite).yPos) -1) *4
 
            If xLimit>0 AND yLimit>0 Then
               'sprite is at least partly on screen so copy it
               Transparent = Sprites(WhichSprite).Transparent
               BMPbase = BMPstart + 4 * BmpStartX + 4 * ScreenWidth * BmpStartY
               SpriteBase = SpriteStart + 4 * SpriteStartX + 4 *SpriteStartY * xSpriteTotWidth
 
               For y = 0 TO yLimit Step 4
                  BMPoffset =  BMPbase + y * ScreenWidth
                  SpriteOffset = SpriteBase +  y * xSpriteTotWidth
 
                  pSpriteOffset = SpriteOffset
                  pBmpOffset = BMPoffset
 
                  For x = 0 TO xLimit\4   'The x loop is time sensitive so do it in ASM
                     If @pSpriteOffset[x] <> Transparent Then
                        @pBmpOffset[x]= @pSpriteOffset[x]
                     End If
 
                  Next 'x
 
               Next 'y
 
            End If  'xLimit<0 and yLimit<0
 
         End If  'plotsprite
 
      Next  'WhichSprite
 
      Graphic Set Bits bmp2           'Write the entire new bitmap to the screen
 
      ResetEvent PlotFlag             'This prevents the plot being called when there's nothing to plot
 
      'print frames per second
      Incr frames
      If frames = 50 Then
         frames = 0
         fps = "fps="+Str$(Int(100*50/(Timer-tm1))/100)
         tm1=Timer
      End If
      Graphic Set Pos (1,1)
      Graphic Print fps
 
   Loop  Until QuitFlag
 
End Function
 
'gbs_00462
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm