Help with my wonky collision detection
Help with my wonky collision detection
Help with my wonky collision detection
Help with my wonky collision detection
Help with my wonky collision detection
Help with my wonky collision detection Help with my wonky collision detection Help with my wonky collision detection Help with my wonky collision detection Help with my wonky collision detection Help with my wonky collision detection Help with my wonky collision detection Help with my wonky collision detection
Help with my wonky collision detection Help with my wonky collision detection
Help with my wonky collision detection
Go Back  Xtreme Visual Basic Talk > > > Help with my wonky collision detection


Reply
 
Thread Tools Display Modes
  #1  
Old 07-27-2005, 06:27 PM
ThermalVampire ThermalVampire is offline
Newcomer
 
Join Date: Oct 2004
Posts: 14
Default Help with my wonky collision detection


Please help me.
This program is a rudimentry game in which a ship can be flown about the screen. The ship is loaded from an image with magenta used as transparent. It is BitBLT'd onto the screen sandwhiched between 2 other images used for back- and fore- grounds. Another image is supposed to dictate whether there is a barrier or not.

Sometimes my ship gets stuck, and the program stops responding, requiring a ctrl-break.
On inspection the program somehow gets into the main 'play' loop then checks for collisions, and keeps doing this ad infinitum. I do not understand how it can get back to the 'play' loop without moving the ship off of the obstacle, but somehow it does.

Code:
Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Declare Function GetPixel Lib "gdi32" _ (ByVal hdc As Long, ByVal x As Long, _ ByVal y As Long) As Long Private Declare Function BitBlt Lib "gdi32" _ (ByVal hDCDest As Long, ByVal XDest As Long, _ ByVal YDest As Long, ByVal nWidth As Long, _ ByVal nHeight As Long, ByVal hDCSrc As Long, _ ByVal XSrc As Long, ByVal YSrc As Long, _ ByVal dwRop As Long) As Long Private Declare Function CreateBitmap Lib "gdi32" _ (ByVal nWidth As Long, _ ByVal nHeight As Long, _ ByVal nPlanes As Long, _ ByVal nBitCount As Long, _ lpBits As Any) As Long Private Declare Function SetBkColor Lib "gdi32" _ (ByVal hdc As Long, _ ByVal crColor As Long) As Long Private Declare Function SelectObject Lib "gdi32" _ (ByVal hdc As Long, _ ByVal hObject As Long) As Long Private Declare Function CreateCompatibleBitmap Lib "gdi32" _ (ByVal hdc As Long, _ ByVal nWidth As Long, _ ByVal nHeight As Long) As Long Private Declare Function CreateCompatibleDC Lib "gdi32" _ (ByVal hdc As Long) As Long Private Declare Function DeleteDC Lib "gdi32" _ (ByVal hdc As Long) As Long Private Declare Function DeleteObject Lib "gdi32" _ (ByVal hObject As Long) As Long Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function GetTickCount Lib "kernel32" () As Long Public lf As Single Public tp As Single Public PI As Single Public angconst As Single Public BackBufferDC As Long Public hBackBuffer As Long Public vRet As Long Public playing As Boolean Public BackDropDC As Long Public ForeGroundDC As Long Public ObstacleMapDC As Long Dim keyflags(255) As Byte Dim obstacle(8) As Byte Public Sub loadworld() BackDropDC = LoadGraphicDC("C:\Documents and Settings\Iain D Kendall\Desktop\background3.jpg") ForeGroundDC = LoadGraphicDC("C:\Documents and Settings\Iain D Kendall\Desktop\fore.bmp") ObstacleMapDC = LoadGraphicDC("C:\Documents and Settings\Iain D Kendall\Desktop\obmap.bmp") End Sub Private Sub AreaDetect() obstacle(0) = 0 For y = 0 To Picture1.ScaleHeight - 1 For x = 0 To Picture1.ScaleWidth - 1 'check for black pixel on obstacle map image beneath area of ship sprite under_pix = GetPixel(ObstacleMapDC, x + lf, y + tp) If under_pix = 0 Then 'check that the black pixel isnt under a transparent part of ship sprite ship_pix = GetPixel(Picture1.hdc, x, y) If ship_pix <> 16711935 Then obstacle(0) = 1 'if there is a black pixel on obstacle map in the same postion as a nontransparent part of ship, then thre is an obstacle Exit For End If End If Next If obstacle(0) = 1 Then 'MsgBox "Collision" Exit For End If Next End Sub Private Sub default_control() 'accelerate If keyflags(38) = 1 Then lf = lf - (8 * Sin(2 * PI * Int(angconst) / 16)) tp = tp - (8 * Cos(2 * PI * Int(angconst) / 16)) 'check for obstacles AreaDetect 'if there is an obstacle, undo movement until there isnt If obstacle(0) = 1 Then Do Until obstacle(0) = 0 lf = lf + (8 * Sin(2 * PI * Int(angconst) / 16)) tp = tp + (8 * Cos(2 * PI * Int(angconst) / 16)) AreaDetect Loop End If End If 'turn anti-clockwise If keyflags(37) = 1 Then If keyflags(38) = 1 Then angconst = angconst + 0.5 'lower rate of turning when moving Else angconst = angconst + 1 End If If angconst >= 16 Then angconst = 0 End If Picture1.Picture = LoadPicture("c:\Module\" & Int(angconst) & ".bmp") 'check for obstacles AreaDetect If obstacle(0) = 1 Then Do Until obstacle(0) = 0 'turn it back clockwise If keyflags(38) = 1 Then angconst = angconst - 0.5 Else angconst = angconst - 1 End If If angconst < 0 Then angconst = 16 + angconst End If If angconst >= 16 Then angconst = 0 Picture1.Picture = LoadPicture("c:\Module\" & Int(angconst) & ".bmp") AreaDetect Loop End If End If 'turn clockwise If keyflags(39) = 1 Then If keyflags(38) = 1 Then angconst = angconst - 0.5 'lower rate of turning when moving Else angconst = angconst - 1 End If If angconst < 0 Then angconst = 16 + angconst End If If angconst >= 16 Then angconst = 0 Picture1.Picture = LoadPicture("c:\Module\" & Int(angconst) & ".bmp") 'check for obstacles AreaDetect If obstacle(0) = 1 Then Do Until obstacle(0) = 0 'turn it back anti-clockwise If keyflags(38) = 1 Then angconst = angconst + 0.5 Else angconst = angconst + 1 End If If angconst >= 16 Then angconst = 0 End If Picture1.Picture = LoadPicture("c:\Module\" & Int(angconst) & ".bmp") AreaDetect Loop End If End If 'If keyflags(40) = 1 Then 'docking 'End If End Sub Public Function LoadGraphicDC(sFileName As String) As Long 'rudimentary error handling On Error Resume Next 'temp variable to hold our DC address Dim LoadGraphicDCTEMP As Long 'create the DC address compatible with 'the DC of the screen LoadGraphicDCTEMP = CreateCompatibleDC(GetDC(0)) 'load the graphic file into the DC... SelectObject LoadGraphicDCTEMP, LoadPicture(sFileName) 'return the address of the file LoadGraphicDC = LoadGraphicDCTEMP End Function Private Sub play() Dim cur_time As Long Dim ship As RECT Dim foregrnd As RECT With ship .Left = 0 .Top = 0 .Right = Picture1.ScaleWidth - 1 .Bottom = Picture1.ScaleHeight - 1 End With With foregrnd .Left = 0 .Top = 0 .Right = Form1.ScaleWidth - 1 .Bottom = Form1.ScaleHeight - 1 End With loadworld BackBufferDC = CreateCompatibleDC(GetDC(0)) hBackBuffer = CreateCompatibleBitmap(GetDC(0), Form1.ScaleWidth, Form1.ScaleHeight) vRet = SelectObject(BackBufferDC, hBackBuffer) BitBlt BackBufferDC, 0, 0, Form1.ScaleWidth, _ Form1.ScaleHeight, 0, 0, 0, vbWhiteness Do Until playing = False cur_time = GetTickCount default_control 'redraw 'Fill with Black BitBlt BackBufferDC, 0, 0, Form1.ScaleWidth, Form1.ScaleHeight, _ 0, 0, 0, vbWhiteness 'Place Backdrop Image BitBlt BackBufferDC, 0, 0, Form1.ScaleWidth, Form1.ScaleHeight, _ BackDropDC, 0, 0, vbSrcCopy 'Place Player sprite TransparentBlt BackBufferDC, BackBufferDC, Picture1.hdc, _ ship, Int(lf), Int(tp), &HFF00FF 'Place Foreground Image TransparentBlt BackBufferDC, BackBufferDC, ForeGroundDC, _ foregrnd, 0, 0, &HFF00FF 'Update screen BitBlt Form1.hdc, 0, 0, Form1.ScaleWidth, Form1.ScaleHeight, _ BackBufferDC, 0, 0, vbSrcCopy 'Set framerate Do While GetTickCount - cur_time < 40 DoEvents Loop Loop End Sub
Attached Files
File Type: zip obmap.zip (222.6 KB, 5 views)
File Type: zip Module.zip (51.1 KB, 5 views)
Reply With Quote
  #2  
Old 07-27-2005, 06:28 PM
ThermalVampire ThermalVampire is offline
Newcomer
 
Join Date: Oct 2004
Posts: 14
Default

Code:
Private Sub TransparentBlt(OutDstDC As Long, _ DstDC As Long, _ SrcDC As Long, _ SrcRect As RECT, _ DstX As Integer, _ DstY As Integer, _ TransColor As Long) 'DstDC- Device context into which image must be 'drawn transparently 'OutDstDC- Device context into image is actually drawn, 'even though it is made transparent in terms of DstDC 'Src- Device context of source to be made transparent 'in color TransColor 'SrcRect- Rectangular region within SrcDC to be made 'transparent in terms of DstDC, and drawn to OutDstDC 'DstX, DstY - Coordinates in OutDstDC (and DstDC) 'where the transparent bitmap must go. In most 'cases, OutDstDC and DstDC will be the same Dim nRet As Long, W As Integer, H As Integer Dim MonoMaskDC As Long, hMonoMask As Long Dim MonoInvDC As Long, hMonoInv As Long Dim ResultDstDC As Long, hResultDst As Long Dim ResultSrcDC As Long, hResultSrc As Long Dim hPrevMask As Long, hPrevInv As Long Dim hPrevSrc As Long, hPrevDst As Long Dim OldBC As Long W = SrcRect.Right - SrcRect.Left + 1 H = SrcRect.Bottom - SrcRect.Top + 1 'create monochrome mask and inverse masks MonoMaskDC = CreateCompatibleDC(DstDC) MonoInvDC = CreateCompatibleDC(DstDC) hMonoMask = CreateBitmap(W, H, 1, 1, ByVal 0&) hMonoInv = CreateBitmap(W, H, 1, 1, ByVal 0&) hPrevMask = SelectObject(MonoMaskDC, hMonoMask) hPrevInv = SelectObject(MonoInvDC, hMonoInv) 'create keeper DCs and bitmaps ResultDstDC = CreateCompatibleDC(DstDC) ResultSrcDC = CreateCompatibleDC(DstDC) hResultDst = CreateCompatibleBitmap(DstDC, W, H) hResultSrc = CreateCompatibleBitmap(DstDC, W, H) hPrevDst = SelectObject(ResultDstDC, hResultDst) hPrevSrc = SelectObject(ResultSrcDC, hResultSrc) 'copy src to monochrome mask OldBC = SetBkColor(SrcDC, TransColor) nRet = BitBlt(MonoMaskDC, 0, 0, W, H, SrcDC, _ SrcRect.Left, SrcRect.Top, vbSrcCopy) TransColor = SetBkColor(SrcDC, OldBC) 'create inverse of mask nRet = BitBlt(MonoInvDC, 0, 0, W, H, _ MonoMaskDC, 0, 0, vbNotSrcCopy) 'get background nRet = BitBlt(ResultDstDC, 0, 0, W, H, _ DstDC, DstX, DstY, vbSrcCopy) 'AND with Monochrome mask nRet = BitBlt(ResultDstDC, 0, 0, W, H, _ MonoMaskDC, 0, 0, vbSrcAnd) 'get overlapper nRet = BitBlt(ResultSrcDC, 0, 0, W, H, SrcDC, _ SrcRect.Left, SrcRect.Top, vbSrcCopy) 'AND with inverse monochrome mask nRet = BitBlt(ResultSrcDC, 0, 0, W, H, _ MonoInvDC, 0, 0, vbSrcAnd) 'XOR these two nRet = BitBlt(ResultDstDC, 0, 0, W, H, _ ResultSrcDC, 0, 0, vbSrcInvert) 'output results nRet = BitBlt(OutDstDC, DstX, DstY, W, H, _ ResultDstDC, 0, 0, vbSrcCopy) 'clean up hMonoMask = SelectObject(MonoMaskDC, hPrevMask) DeleteObject hMonoMask hMonoInv = SelectObject(MonoInvDC, hPrevInv) DeleteObject hMonoInv hResultDst = SelectObject(ResultDstDC, hPrevDst) DeleteObject hResultDst hResultSrc = SelectObject(ResultSrcDC, hPrevSrc) DeleteObject hResultSrc DeleteDC MonoMaskDC DeleteDC MonoInvDC DeleteDC ResultDstDC DeleteDC ResultSrcDC End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyEscape Then Unload Me End Else keyflags(KeyCode) = 1 End If End Sub Private Sub Form_KeyPress(KeyAscii As Integer) End Sub Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer) keyflags(KeyCode) = 0 End Sub Private Sub Form_Load() Form1.Show Picture1.Picture = LoadPicture("c:\module\0.bmp") Picture1.Left = Form1.Width PI = 3.14159265 playing = True play End Sub Private Sub Form_Unload(Cancel As Integer) playing = False DeleteDC (BackBufferDC) DeleteObject (vRet) End End Sub
Reply With Quote
  #3  
Old 07-28-2005, 10:19 AM
StressedGeezer's Avatar
StressedGeezer StressedGeezer is offline
Junior Contributor
 
Join Date: Apr 2004
Location: Cambridge, England
Posts: 259
Default

I was gonna have a look at your project, but the zips only have graphics in them... and you are making it hard work for us by pasting your code like u did, instead of the project... What am I supposed to do, rebuild your project by hand, when it's already sitting your machine?... if you just zip up your project (without any executables inside - that's not allowed on the forum) and post that instead, I'll gladly download it and see if I can help. If the project's zip is larger than the site's 2Mb limit, that's OK, just zip the code and not the graphics (cos they are already up). But please, post zipped projects in future!
__________________
Geezer
Reply With Quote
  #4  
Old 07-28-2005, 10:34 AM
ThermalVampire ThermalVampire is offline
Newcomer
 
Join Date: Oct 2004
Posts: 14
Default

sorry, I did realise I had quite so much code...
Attached Files
File Type: zip Ship.zip (4.3 KB, 8 views)
Reply With Quote
  #5  
Old 07-28-2005, 10:37 AM
noi_max's Avatar
noi_maxHelp with my wonky collision detection noi_max is offline
Still asleep...

Retired Leader
* Expert *
 
Join Date: Nov 2003
Location: IronForge
Posts: 2,694
Default

I agree. Debugging would be easier if you posted the whole project in a zip file.

From what I can tell in your code, it looks like you are attempting to do pixel perfect collision detection. Pixel perfect is really slow compared to rectangle or circular detection. You may want to check for a rectangle collision of your objects first, then when the rectangular objects have collided then go for the pixel perfect part.

Also, depending on the graphics, you might not have to check every pixel. You might get by with checking every other pixel, or every 4 pixels or whatever fits your image size/background best. It's a little less accurate that way, but I don't think it would be very noticable.

Just some thoughts.

Edit: I see you posted your project. Must've been when I was writing my post
__________________
~ Jason

Use [vb][/vb] tags when posting code :) || Search the forum and MSDN|| Check out the Posting Guidelines
Reply With Quote
  #6  
Old 07-29-2005, 12:21 AM
StressedGeezer's Avatar
StressedGeezer StressedGeezer is offline
Junior Contributor
 
Join Date: Apr 2004
Location: Cambridge, England
Posts: 259
Default

Well, Noi_max, you did better than me - all I got when I ran the project was a black screen, I had to use Ctrl-Alt-Del to get back out
__________________
Geezer
Reply With Quote
  #7  
Old 07-29-2005, 06:05 AM
ThermalVampire ThermalVampire is offline
Newcomer
 
Join Date: Oct 2004
Posts: 14
Default

Esc should quit the program. You might have got a blank screen because the image file paths are stupidly hard coded maybe try changing those (they are in the 'loadworld' sub and in the 'default_control' sub).

Oh, and without the obstacle map, the whole scrren would be wall that the ship could never get off of, so that might lock the program up.

Last edited by ThermalVampire; 07-29-2005 at 06:11 AM.
Reply With Quote
  #8  
Old 07-29-2005, 07:31 AM
Mathijsken's Avatar
Mathijsken Mathijsken is offline
Contributor
 
Join Date: May 2003
Location: Oostkamp - Belgium
Posts: 730
Default

If Noi_Max assumptions are true then it is indeed better to do some sort of rule-out thing. Usually this comes down to basic collision detections such as rectangular, circular and linear coll. detection.

I have found another (quite fast) method using regions. You just make a region (comes down to a polygon, like a rectangle) for your ship and some for your obstacles. Now, the main advantage is that you can combine regions into one. So we combine all the obstacles and then have your shipped chekced against the combined region.

EDIT: forgot to tell you that this can be done with API's (see mentalis.org)

This methods is simple (and much faster) then the pixel-perfect one, but sometimes not as accurate (because of lines not being entirely the same as your objects border, but hey, that's no real prob right?)

Another thing that is dangerous about this method: GDI objects. If you forget to delete them, your program will crash because of an "Out Of Memory" error! So be carefull to clean up the mess after using those GDI objects.

collision stuff:
http://gpwiki.org/index.php/VB:Recta...sion_Detection

Mathijsken
__________________
Fear is the first step towards intolerance.
Reply With Quote
  #9  
Old 07-29-2005, 07:44 AM
ThermalVampire ThermalVampire is offline
Newcomer
 
Join Date: Oct 2004
Posts: 14
Default

I thinks Ive fixed my main error now. After noticing that was getting "wdwwdw" appearing at the cursor in my code when i ctrl-breaked the program, I realised that after colliding, conrol key stokes must be buffering, and then queueing up, causing a loop of move, collide, detect, correct, get next buffered auto-repeated keystroke, move, collide, detect.....
So when a collsion is detected, I have added a line that sets all movement control keyflags to 0. Seems to help.
I also took some of your advice, and dont check every pixel, only every second pixel on every other line (4 times faster in principle) - will only miss very narrow obstacles when the ship is very well aimed, so no big deal.

Thanks for all the advice, I'm sorry my above post is a total mess.

Last edited by ThermalVampire; 07-29-2005 at 07:53 AM.
Reply With Quote
  #10  
Old 07-31-2005, 01:58 AM
StressedGeezer's Avatar
StressedGeezer StressedGeezer is offline
Junior Contributor
 
Join Date: Apr 2004
Location: Cambridge, England
Posts: 259
Default

If u are getting text appearing in your code when you press keys during the game, it could easily be down to forgetting the DoEvents command - I had this problem lately, so maybe checking where / if the DeOevents is executed could help with that.
__________________
Geezer
Reply With Quote
  #11  
Old 07-31-2005, 06:50 PM
ThermalVampire ThermalVampire is offline
Newcomer
 
Join Date: Oct 2004
Posts: 14
Default

Yup, very good advice!
I thought I had this problem licked with the more efficient detection, and the proper setting of KeyFlags, then I tried a bigger sprite, and the problem came back - realised that DoEvents only occured if the game was running fast enough, and was skipped if too much was happening:

Code:
Do While GetTickCount - cur_time < 40 DoEvents Loop

So I simply made it:

Code:
DoEvents Do While GetTickCount - cur_time < 40 DoEvents Loop

Problems solved. Thanks all!
Reply With Quote
Reply


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is Off
HTML code is Off

Forum Jump

Advertisement:





Free Publications
The ASP.NET 2.0 Anthology
101 Essential Tips, Tricks & Hacks - Free 156 Page Preview. Learn the most practical features and best approaches for ASP.NET.
subscribe
Programmers Heaven C# School Book -Free 338 Page eBook
The Programmers Heaven C# School book covers the .NET framework and the C# language.
subscribe
Build Your Own ASP.NET 3.5 Web Site Using C# & VB, 3rd Edition - Free 219 Page Preview!
This comprehensive step-by-step guide will help get your database-driven ASP.NET web site up and running in no time..
subscribe
Help with my wonky collision detection
Help with my wonky collision detection
Help with my wonky collision detection Help with my wonky collision detection
Help with my wonky collision detection
Help with my wonky collision detection
Help with my wonky collision detection Help with my wonky collision detection Help with my wonky collision detection Help with my wonky collision detection Help with my wonky collision detection Help with my wonky collision detection Help with my wonky collision detection
Help with my wonky collision detection
Help with my wonky collision detection
 
Help with my wonky collision detection
Help with my wonky collision detection
 
-->