Demo Overlapping "Sprites" using: PaintPicture

[(X)]

D2D's lil' bro

It took me a while to notice the PaintPicture command (~3 years back).  It seemed superfluous, just another convoluted way to get and put graphics on the screen.  Boy!  Was I ever wrong!  Though Direct2D is the 'Bad Boy' of the graphics 'hood, PaintPicture is definitely the "little brother that can still throw a few punches".

This 'Looney Tunes' demo shows that it is possible to use PaintPicture to overlap several images onto a background image (stored in a hidden form) then copy the result over to the main window.  We are essentially using a mask to punch a hole in the background then pasting the image to cover the hole, several times over at different positions.

I would say Direct2D still offers better performance and options (transparency, rotation etc) but the PaintPicture results are quite reasonable.

"Meep-Meep"

'#################################################################################
'
' DISCLAIMER:   THIS CODE IS OFFERED AS IS FOR EDUCATIONAL PURPOSES.
'               YOU ARE FREE TO USE, COPY AND DISTRIBUTE.
'               THE USE OF THIS CODE IS AT YOUR OWN RISK.
'               I ACCEPT NO LIABILITY NOR MAKE ANY CLAIM OF
'               CORRECTNESS OR SUITABILITY IN PART OR IN WHOLE.
'
'#################################################################################
'
' FILENAME      Demo Overlapping Sprites.G32
'
' DESCRIPTION   A demo of overlapping sprites using PaintPicture.
'
' AUTHOR        (X)
' EMAIL         [e-mail]
' WEBSITE       https://gfabasic32.blogspot.com/
' FORUM         https://gb32.proboards.com/
' STARTED       2023-08-21
' UPDATED       <ISO date>
'
'
'$ManifestOff
$Library "GfaWinX"
$Library "UpdateRT"
UpdateRuntime

Mode Date "-"

LoadForm frm1 Top
LoadForm frm2 Hidden
frm1.SetFocus

Do : Sleep 10 : DoEvents : P_Paint : Until frm1 Is Nothing



Dim i
For i = 0 To 2
 Set pic(i) = Nothing
Next i

Mci "play meep from 1"

If Not IsNothing(frm2) frm2.Close


Sub frm1_Load
 Mci "close all"
 FileCopy ":meep" To "meep.mp3"
 FileCopy ":meep2" To "meep2.mp3"
 Mci "open meep.mp3 alias meep"
 Mci "open meep2.mp3 alias meep2"
 
 With frm1
   .AutoRedraw = 2
   '.BackColor = 0 'RGB(255, 255, 255)
   .PaintPicture LoadPicture(":BG"), 0, 0
 EndWith
 
 Global Enum BGD, IMG, MSK
 Global pic(0 To 2) As Picture
 Set pic(BGD) = LoadPicture(":BG")
 Global bw! = HimetsToPixelX(pic(BGD).Width)
 Global bh! = HimetsToPixelY(pic(BGD).Height)
 frm1.Width = PixelsToTwipX(bw)
 frm1.Height = PixelsToTwipY(bh)
 
 Set pic(IMG) = LoadPicture(":RR")
 Set pic(MSK) = LoadPicture(":RR_Mask")
 
 Global w! = HimetsToPixelX(pic(IMG).Width)
 Global h! = HimetsToPixelY(pic(IMG).Height)
 
Sub P_Paint
 Try
   Static ready? = True
   If ready?
     ready = False
     Static t0# = Timer
     Static t# = 0
     Dim Cur_Timer# = Timer
     Dim dt# = Cur_Timer# - t0
     t0 = Cur_Timer#
     t += dt
     Dim fw! = frm1.ScaleWidth
     Dim fh! = frm1.ScaleHeight
     Dim cfw! = fw / 2
     Dim cfh! = fh / 2
     
     Dim xo! = 50 * Cos(2 * PI * t / 5)
     Dim yo! =  5 * Sin(2 * PI * t / 2)
     Dim px! = cfw + 0.5 * cfw * Cos(2 * PI * t / 20) - w / 2
     Dim py! = 0.5 * fh
     
     Dim x! = px, y! = py
     Static bx! = 0
     bx -= MouseX * 3 * dt
     
     °Debug dt#
     
     frm2.PaintPicture pic(BGD), bx,      0, bw, bh
     frm2.PaintPicture pic(BGD), bx + bw, 0, bw, bh
     If (bx <= -bw)  bx += bw
     
     'DoEvents
     
     // Sprite 1
     P(x, y)
     
     // Sprite 2
     x = px + xo
     y = py + yo
     P(x, y)
     
     // Sprite 3
     x = px - xo
     y = py - yo
     P(x, y)
     
     frm1.PaintPicture frm2.Image, 0, 0
     
     ready = True
   EndIf
   
 Catch
   Trace Err$
 EndCatch
 
Proc P(x#, y#)
 frm2.PaintPicture pic(MSK), _
   x, y, w, h, _
   0, 0, w, h, SRCAND      //  If OpCode is used all units are pixels
 
 frm2.PaintPicture pic(IMG), _
   x, y, w, h, _
   0, 0, w, h, SRCPAINT    //  If OpCode is used all units are pixels
 
 'DoEvents
 
EndProc

Sub frm2_Load
 With frm2
   .AutoRedraw = 2
   .Left   = frm1.Left
   .Top    = frm1.Top
   .Width  = frm1.Width
   .Height = frm1.Height
 EndWith
 
Sub frm1_MouseDown(Button&, Shift&, x!, y!)
 If x > frm1.ScaleWidth / 2
   Mci "play meep2 from 1"
 Else
   Mci "play meep from 1"
 EndIf  



Attachments:

Demo Overlapping Sprites.G32 (108.68 KB)

[Roger Cabo]

What happen if you simply copy the whole screen at once at start in the paint sub?

On my system it's freaking fast because I use DDR4 3600 and a new 5600mhz CPU.

[(X)]

Aug 21, 2023 19:51:31 GMT 1 Roger Cabo said:

What happen if you simply copy the whole screen at once at start in the paint sub?

On my system it's freaking fast because I use DDR4 3600 and a new 5600mhz CPU.

Perhaps: Wile E. Coyote catches the Road Runner?

[(X)]

This version now can side scroll left and right, has better timing calculation and cleans up the mp3 files left on the disk.

Demo Overlapping Sprites 2.G32 (108.84 KB)

[larrybtoys]

I get an Array Bounds Exceeded error when running this program.

[(X)]

That's odd.  It works fine here if I download and run in the download dir and also from my dev dir.

Is your GFA version up to date?

[scalion]

Not a gfa-version problem, it's just a problem of asynchronous painting (pic not dimed) and after error files not deleted add new error.

i wrote some little modification to workarround it :

Demo Overlapping Sprites 2-b.G32 (109.01 KB)

Lol, now my wife hate me, "meep meep !" ended up annoying him.

[larrybtoys]

This one runs great and is very fast and smooth. I will study the code. Thanks

[(X)]

Great feedback!

Posted by larrybtoys
14 hours ago
I get an Array Bounds Exceeded error when running this program.

I wonder if the error goes away if we call DoEvent before the P_Paint to give GFA a chance to do a little "house keeping" before using the P_Paint procedure.

Instead of this:

Proc P_Main
 LoadForm frm1 Top
 LoadForm frm2 Hidden
 frm1.SetFocus
 
 Do
   P_Paint
   Sleep 10
   DoEvents
 Until frm1 Is Nothing
 
EndProc

Try this:
Proc P_Main
 LoadForm frm1 Top
 LoadForm frm2 Hidden
 frm1.SetFocus
 
 Do
   DoEvents
   P_Paint
   Sleep 10

 Until frm1 Is Nothing
 
EndProc

[(X)]

Version 3 has 20 sprites that are sorted for depth and scaled down for distance.

Also better handling of app close for exec and runtime. (sound effect would not play in exec before)

'#################################################################################
'
' DISCLAIMER:   THIS CODE IS OFFERED AS IS FOR EDUCATIONAL PURPOSES.
'               YOU ARE FREE TO USE, COPY AND DISTRIBUTE.
'               THE USE OF THIS CODE IS AT YOUR OWN RISK.
'               I ACCEPT NO LIABILITY NOR MAKE ANY CLAIM OF
'               CORRECTNESS OR SUITABILITY IN PART OR IN WHOLE.
'
'#################################################################################
'
' FILENAME      Demo Overlapping Sprites.G32
'
' DESCRIPTION   A demo of overlapping sprites using PaintPicture.
'
' AUTHOR        (X)
' EMAIL         [e-mail]
' WEBSITE       https://gfabasic32.blogspot.com/
' FORUM         https://gb32.proboards.com/
' STARTED       2023-08-21
' UPDATED       <ISO date>
'
'
'$ManifestOff
$Library "GfaWinX"
$Library "UpdateRT"
UpdateRuntime

Mode Date "-"

P_Main

Proc P_Main
 LoadForm frm1 Top Hidden Center
 LoadForm frm2 Hidden
 frm1.SetFocus
 frm1.Show
 Static Quit? = False
 Static n%
 Do
   DoEvents
   Sleep 10
   P_Paint
   KeyTest n%
   If (Byte(n%) == VK_ESCAPE) Quit? = True
 Until Quit? Or IsNothing(frm1)
 P_Close
 
EndProc

Proc P_Close
 Dim i
 For i = 0 To 2
   Trace i
   Set pic(i) = Nothing
 Next i
 
 P_Closing_Meep
 
 If Not IsNothing(frm1) frm1.Close
 If Not IsNothing(frm2) frm2.Close
EndProc

Proc P_Closing_Meep
 Mci "play meep from 1 notify"
 If _EAX = 0      //simple error check
   Do
     DoEvents
   Loop Until _Mess = $3b9
 EndIf
 Mci "close all"
 
EndProc



Sub frm1_Load
 Mci "close all"
 
 FileCopy ":meep" To "meep.mp3"
 Mci "open meep.mp3 alias meep"
 DeleteFile "meep.mp3"
 
 FileCopy ":meep2" To "meep2.mp3"
 Mci "open meep2.mp3 alias meep2"
 DeleteFile "meep2.mp3"
 
 Global Const HALFTONE As Long = 4
 With frm1
   .AutoRedraw = 1
   .Caption = App.Name & ", ESC to QUIT"
   .PaintPicture LoadPicture(":BG"), 0, 0
   ~SetStretchBltMode(.hDC, HALFTONE)
   ~SetStretchBltMode(.hDC2, HALFTONE)
 EndWith
 
 Global Enum BGD, IMG, MSK
 Global pic(0 To 2) As Picture
 
 Set pic(BGD) = LoadPicture(":BG")
 
 Global bw! = HimetsToPixelX(pic(BGD).Width)
 Global bh! = HimetsToPixelY(pic(BGD).Height)
 
 frm1.Width = PixelsToTwipX(bw)
 frm1.Height = PixelsToTwipY(bh)
 
 Set pic(IMG) = LoadPicture(":RR")
 Set pic(MSK) = LoadPicture(":RR_Mask")
 
 Global sw! = HimetsToPixelX(pic(IMG).Width)
 Global sh! = HimetsToPixelY(pic(IMG).Height)
 
EndSub

Sub P_Paint
 Try
   Static Ready? = True
   If Ready?
     Ready? = False
     Static t0# = Timer
     Static t# = 0
     Dim Cur_Timer# = Timer
     Dim dt# = Cur_Timer# - t0
     t0 = Cur_Timer#
     t += dt
     Dim fw! = frm1.ScaleWidth
     Dim fh! = frm1.ScaleHeight
     Dim cfw! = fw / 2
     Dim cfh! = fh / 2
     
     Static bx! = 0
     Dim v = 3 * (MouseX - (bw / 2))
     bx -= v * dt
     
     If (bx <= -bw)
       bx += bw
     Else
       bx -= bw
     EndIf
     
     frm2.PaintPicture pic(BGD), bx,      0, bw, bh
     frm2.PaintPicture pic(BGD), bx + bw, 0, bw, bh
     
     Dim xo! = 50 * Cos(2 * PI * t / 5)
     Dim yo! =  5 * Sin(2 * PI * t / 2)
     
     Dim i!, n!, a_offset!, a!, sx!, sy!, Level(0 To 19)
     For i = 0 To 19
       n = i / 19
       a_offset = n * 2 * PI
       a = (0.1 * 2 * PI * t)
       sx! = cfw + 0.5 * cfw * Cos(a_offset + a) - sw / 2
       sy! = 0.05 * Sin(a_offset + a)
       // Sprite i
       Level(i) = sy
     Next i
     QSort Level()
     
     'Debug
     For i = 0 To 19
       'Debug Level(i)
       n = i / 19
       a_offset = n * 2 * PI
       a = (0.1 * 2 * PI * t)
       sx! = cfw + 0.5 * cfw * Cos(a_offset + a) - sw / 2
       sy! = 1.25 * cfh  + Level(i)
       // Sprite i
       P(sx, sy, sw, sh, n)
     Next i
     
     frm1.PaintPicture frm2.Image, 0, 0
     
     Ready? = True
   EndIf
   
 Catch
   Trace Err$
 EndCatch
EndSub

Proc P(x!, y!, w!, h!, n!)
 frm2.PaintPicture pic(MSK), _
   x, y, n * w, n * h, _
   0, 0, w, h, SRCAND      //  If OpCode is used all units are pixels
 
 frm2.PaintPicture pic(IMG), _
   x, y, n * w, n * h, _
   0, 0, w, h, SRCPAINT    //  If OpCode is used all units are pixels
 
EndProc

Sub frm2_Load
 With frm2
   .AutoRedraw = 1
   .Left   = frm1.Left
   .Top    = frm1.Top
   .Width  = frm1.Width
   .Height = frm1.Height
   ~SetStretchBltMode(.hDC, HALFTONE)
   ~SetStretchBltMode(.hDC2, HALFTONE)
 EndWith
EndSub

Sub frm1_MouseDown(Button&, Shift&, x!, y!)
 If x > frm1.ScaleWidth / 2
   Mci "play meep2 from 1"
 Else
   Mci "play meep from 1"
 EndIf
EndSub


Attachments:

Demo Overlapping Sprites 3.G32 (109.7 KB)

[larrybtoys]

Version 3 is great. I need to figure out how to apply this to my games.