Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#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 Long) As 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 Long) As 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
http://www.garybeene.com/sw/gbsnippets.htm