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 hGraph,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
Function PBMain() As Long
Local nWidth, nHeight, nFile, r, num As Long
Dim Sprites(%MaxSprites)
Dim SpriteStrings(%MaxSprites)
Desktop Get Client TO ScreenWidth, ScreenHeight
'set size to other than full screen here:
ScreenWidth = 800
ScreenHeight = 600
Graphic Bitmap New ScreenWidth,ScreenHeight TO hGraph
Graphic Window "Sprite tests...press a key",0,0,ScreenWidth,ScreenHeight TO hWindow
'draw the background graphic
Graphic Attach hGraph,0
'draw/load any image you like here as the background
Graphic Clear %WHITE
'copy the graphic to the visible window
Graphic Attach hWindow,0
Graphic Copy hGraph,0
Local x As Long
Local y,hFont, hBmp, col As Long
'a very small sprite
Graphic Bitmap New 3,3 TO hBmp
Graphic Attach hBmp,0
Graphic Clear %WHITE
Graphic Ellipse (0,0)-(3,3),%BLACK,%BLACK
Sprites(%vSmall).hnd = %vSmall
Sprites(%vSmall).xSize = 3
Sprites(%vSmall).ySize = 3
Sprites(%vSmall).xPos = 400
Sprites(%vSmall).yPos =100
Sprites(%vSmall).xSpeed =4
Sprites(%vSmall).ySpeed =1
Sprites(%vSmall).Motion =0
Sprites(%vSmall).MaxFrame = 1
Sprites(%vSmall).CurrentFrame = 0
Sprites(%vSmall).AnimationTime =0
Sprites(%vSmall).AnimationCount =0
Sprites(%vSmall).Flags =%PlotSprite Or %SpriteActive
Sprites(%vSmall).Transparent = &hffffff
Graphic Attach hBmp,0
Graphic Get Bits TO SpriteStrings(%vSmall)
Graphic Bitmap End
Graphic Detach
'a medium sized animated sprite 14 x 14
Graphic Bitmap New 686,14 TO hBmp
Graphic Attach hBmp,0
Graphic Clear %WHITE
For x = 0 TO 49
Graphic Ellipse (x*14,0)-(x*14+14,14),%RED,%YELLOW '* (x-4.5)/9
Graphic Pie (x*14,0)-(x*14+14,14),x/49*2*3.142,(x+20)/49*2*3.142, %RED,%GREEN
Graphic Set Pos (x*140+70,70)
Next
Sprites(%medium).hnd = %medium
Sprites(%medium).xSize = 14
Sprites(%medium).ySize = 14
Sprites(%medium).xPos = 400
Sprites(%medium).yPos =100
Sprites(%medium).xSpeed =4
Sprites(%medium).ySpeed =1
Sprites(%medium).Motion =0
Sprites(%medium).MaxFrame = 49
Sprites(%medium).CurrentFrame = 0
Sprites(%medium).AnimationTime =10
Sprites(%medium).AnimationCount =0
Sprites(%medium).Flags =%PlotSprite Or %SpriteActive
Sprites(%medium).Transparent = &hffffff
Graphic Attach hBmp,0
Graphic Get Bits TO SpriteStrings(%medium)
Graphic Bitmap End
Graphic Detach
'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 hBmp,0
Graphic Get Bits TO SpriteStrings(%large)
Graphic Bitmap End
Graphic Detach
'animated numbers 100 x 100
Graphic Bitmap New 1000,100 TO hBmp
Graphic Attach hBmp,0
Graphic Clear %WHITE
Font New "Courier New",100,1 TO hFont
Graphic Set Font hFont
For x = 0 TO 9
Graphic Color Rgb(x*Rnd(1,30),x*Rnd(1,30),x*Rnd(30)),%WHITE
Graphic Set Pos (x*100,-20)
Graphic Print Format$(x);
Next
Sprites(%numbers).hnd = %numbers
Sprites(%numbers).xSize = 100
Sprites(%numbers).ySize = 100
Sprites(%numbers).xPos = 400
Sprites(%numbers).yPos =100
Sprites(%numbers).xSpeed =4
Sprites(%numbers).ySpeed =1
Sprites(%numbers).Motion =0
Sprites(%numbers).MaxFrame = 10
Sprites(%numbers).CurrentFrame = 0
Sprites(%numbers).AnimationTime =10
Sprites(%numbers).AnimationCount =0
Sprites(%numbers).Flags =%PlotSprite Or %SpriteActive
Sprites(%numbers).Transparent = &hffffff
Graphic Attach hBmp,0
Graphic Get Bits TO SpriteStrings(%numbers)
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
'
Global hPlotThread As Long
Local junk As Long
Thread Create PlotThread(junk) TO hPlotThread
'start the main timer
'40=milliseconds between triggers, 0=maximum timer resolution, test=the routine to call
TimerHandle = timeSetEvent ( ByVal %FrameDuration, ByVal 0, CodePTR(TimerFunction), ByVal 0&, ByVal %TIME_PERIODIC)
'wait for key press
Graphic Attach hWindow,0
Graphic WaitKey$
For r = 10 TO '110
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
Graphic WaitKey$
For r = 10 TO 210
num = %numbers
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 = Rnd(1,10)
Sprites(r).flags = %PlotSprite Or %SpriteActive
Next
Graphic WaitKey$
For r = 10 TO 1010
num = %medium
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 = Rnd(1,10)
Sprites(r).flags = %PlotSprite Or %SpriteActive
Next
Graphic WaitKey$
For r = 10 TO %maxsprites
num = %vsmall
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
Graphic WaitKey$
For r = 10 TO '200
num = Rnd(%vsmall,%numbers)
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
For r = 201 TO %MaxSprites
Sprites(r).flags = 0
Next
Graphic WaitKey$
QuitFlag = 1 'force all threads to terminate
timeKillEvent TimerHandle
CloseHandle PlotFlag
Graphic Attach hGraph,0
Graphic Bitmap End
Graphic Attach hWindow,0
Graphic Bitmap End
'Give timer time to stop in case it triggers again after program ends' should wait and check it
Sleep 100
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
If Sprites(WhichSprite).xPos < - Sprites(WhichSprite).xSize Then Sprites(WhichSprite).xPos = Sprites(WhichSprite).xPos + ScreenWidth + Sprites(WhichSprite).xSize
End If
If %WrapY Then
If Sprites(WhichSprite).yPos > ScreenHeight Then Sprites(WhichSprite).yPos = Sprites(WhichSprite).yPos - ScreenHeight - Sprites(WhichSprite).ySize
If Sprites(WhichSprite).yPos < -Sprites(WhichSprite).ySize Then Sprites(WhichSprite).yPos = Sprites(WhichSprite).yPos + ScreenHeight + Sprites(WhichSprite).ySize
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
'Indicate to plot thread that there's been an update so it can start to plot
SetEvent PlotFlag
#If 0
'don't bother with collision detection, just rem it out for now
For x = 1 TO MIN&(220, %MaxSprites)
For y = x TO MIN&(220,%MaxSprites)
If x <> y Then
If Collision(x,y) Then
Sprites(x).xSpeed=Rnd(-20,20)
Sprites(x).ySpeed=Rnd(-20,20)
Sprites(y).xSpeed=Rnd(-20,20)
Sprites(y).ySpeed=Rnd(-20,20)
End If
End If
Next
Next
#EndIf
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
'Variables that can be deleted after testing:
Static Cnt As Long
Static Tot,k,k2 AS QUAD
Graphic Attach hWindow,0
Static frames As Long
Static tm1 AS EXT
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
ReStart:
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
Local pSpriteOffset, pBmpOffset AS DWord PTR
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
#If 0
!mov edx,Transparent 'the colour to be transparent for this sprite
!mov edi,BMPoffset 'point to right place in bitmap
!mov ecx,xLimit 'x pixel count, Count down to 0
!mov esi,SpriteOffset 'point to right place in sprite
#Align 16
lp2:
!prefetchnta [esi+ecx-128]
!prefetcht0 [edi+ecx-64]
!mov eax,[esi+ecx] 'eax = pixel from sprite
!cmp eax,edx 'is it to be transparent?
!je short skip 'yes, don't write it to screen
!mov [edi+ecx],eax 'write pixel to screen
skip:
!Sub ecx,4 'next x. 4 bytes per pixel
!js short xit 'if -ve then exit
!mov eax,[esi+ecx] 'eax = pixel from sprite
!cmp eax,edx 'is it to be transparent?
!je short skip1 'yes, don't write it to screen
!mov [edi+ecx],eax 'write pixel to screen
skip1:
!Sub ecx,4 'next x. 4 bytes per pixel
!js short xit 'if -ve then exit
!mov eax,[esi+ecx] 'eax = pixel from sprite
!cmp eax,edx 'is it to be transparent?
!je short skip2 'yes, don't write it to screen
!mov [edi+ecx],eax 'write pixel to screen
skip2:
!Sub ecx,4 'next x. 4 bytes per pixel
!js short xit 'if -ve then exit
!mov eax,[esi+ecx] 'eax = pixel from sprite
!cmp eax,edx 'is it to be transparent?
!je short skip3 'yes, don't write it to screen
!mov [edi+ecx],eax 'write pixel to screen
skip3:
!Sub ecx,4 'next x. 4 bytes per pixel
!jns short lp2 'if not -ve then loop back
#EndIf
xit:
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
Local fps AS String
'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_00461
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm