Collision Detection

[johnno56]

Simple question that may not have a simple answer.

Some languages have collision detection built in and some do not.

I would like to know what method do users of QB64 prefer to employ for sprite collision detection?

J

[johnno56]

I have whipped up a simple Bounding Box collision test.
I had to use 'help' to try and figure out mouse commands... lol

This would be ideal IF the sprites were either square or rectangular is shape (tiles) but no so much for irregular shaped sprites.

Code: QB64: [Select]

1. '
2. '   Collision - Test 1
3. '
4. '   Bounding Box
5. '
6. SCREEN _NEWIMAGE(640, 480, 32)
7. _TITLE ("Bounding Box Collision Detection")
8.  
9. box1top = 190
10. box1bottom = 290
11. box1left = 270
12. box1right = 370
13.  
14. collision = 0
15.  
16. DO: k$ = INKEY$
17.     DO WHILE _MOUSEINPUT
18.         CLS
19.         LINE (box1left, box1top)-(box1right, box1bottom), _RGB32(255, 255, 0), B
20.  
21.         box2left = _MOUSEX - 50
22.         box2top = _MOUSEY - 50
23.         box2right = box2left + 100
24.         box2bottom = box2top + 100
25.         LINE (box2left, box2top)-(box2right, box2bottom), _RGB32(255, 128, 0), B
26.  
27.         GOSUB collide
28.  
29.         IF collision = 1 THEN
30.             COLOR _RGB32(0, 128, 0)
31.             _PRINTSTRING (283, 230), "Collision"
32.         END IF
33.         _DISPLAY
34.     LOOP
35. LOOP UNTIL k$ = CHR$(27)
36.  
37. collide:
38. IF (box1bottom < box2top) OR (box1top > box2bottom) OR (box1left > box2right) OR (box1right < box2left) THEN
39.     collision = 0
40. ELSE
41.     collision = 1
42. END IF
43. RETURN
44.  

I can patch together a 'circular' system if needs be...

This 'Box' system works ok, but I would appreciate it someone could suggest a better system...

J

[Petr]

Hi Johnno56,

For collision detection, I use a method where I write the coordinate of the boundary of an object in the field, and then compare the coordinates, whether or not the penetration has occurred (before plotting). I'll send down the demo here. But first, I'm sending a slightly-repaired sample program from the IDE Help for the CIRCLE command:

Code: QB64: [Select]

1. 'collision detection    -  mouse in circle
2.  
3. SCREEN _NEWIMAGE(800, 600, 256)
4. DO
5.     WHILE _MOUSEINPUT: WEND
6.     CLS
7.     IF Circle_Collis(_MOUSEX, _MOUSEY, 60, 400, 300) THEN LOCATE 1, 1: PRINT "   Collision" ELSE LOCATE 1, 1: PRINT "No collision"
8.     CIRCLE (400, 300), 60
9.     _DISPLAY
10. LOOP
11.  
12.  
13. FUNCTION Circle_Collis (x AS LONG, y AS LONG, r AS LONG, cx AS LONG, cy AS LONG)
14.     xy& = ((x& - cx&) ^ 2) + ((y& - cy&) ^ 2) 'Pythagorean theorem
15.     IF r& ^ 2 >= xy& THEN Circle_Collis = 1 ELSE Circle_Collis = 0
16. END FUNCTION
17.  

[johnno56]

Cool. A much smaller version of the 'circle or radius' detection system. Basically checking the distance between the mouse pointer and the radius of the circle. Your listing seems to be more efficient that mine. Cool. Thanks for the assistance. Much appreciated.

J

[Petr]

Here is the promised example. Basically, it's all based on the fact that what you see on the screen does not match what you have on memory. For example, the game environment. You make the post on a monochrome background, and then you just watch the penetration of the points on the picture screen in the memory. I think the dinosaur demonstration shows it best:

Code: QB64: [Select]

1. 'very easy method based on color difference:
2.  
3. A& = _NEWIMAGE(100, 50, 256)
4. _DEST A&: PRINT "Secured"
5.  
6. SCREEN _NEWIMAGE(400, 300, 256)
7. _PUTIMAGE , A&
8.  
9. DO
10.     WHILE _MOUSEINPUT: WEND
11.     IF white(_MOUSEX, _MOUSEY) THEN LOCATE 1, 30: PRINT "   Collision detected" ELSE LOCATE 1, 30: PRINT "No collision detected"
12.     LOCATE 13, 1: PRINT "Press ESC for show MEM method"
13. LOOP UNTIL _KEYHIT = 27
14.  
15.  
16. DO
17.     WHILE _MOUSEINPUT: WEND
18.     IF MEM_White(_MOUSEX, _MOUSEY, 0) THEN LOCATE 1, 30: PRINT "   Collision detected" ELSE LOCATE 1, 30: PRINT "No collision detected"
19.     LOCATE 13, 1: PRINT "Press ESC for show virtual screen method"
20. LOOP UNTIL _KEYHIT = 27
21.  
22.  
23. 'but in practice objects use more than one color. For show you, hot to create it, use image:
24. _FREEIMAGE A& ' kill text image from memory
25. CLS
26. A& = _LOADIMAGE("rex.jpg", 32)
27. _SETALPHA 0, _RGB32(255, 255, 255) TO _RGB32(200, 200, 200), A& 'set white color as transparent. BUT! Trick is this: IF is used the same resolution for screen as is resolution picture, you need not
28. REDIM Border(0, 0) AS _BYTE '                                    recalculating coordinates, so you only show to source image (source in memory an on screen are now different)
29. SCREEN _NEWIMAGE(_WIDTH(A&), _HEIGHT(A&), 32)
30. _PUTIMAGE , _SCREENIMAGE '                                       first draw background image
31. _PUTIMAGE , A& '                                                 place image with set alpha channel (but A& contains again this colors and you can see to it ALONE using _SOURCE and _DEST)
32.  
33.  
34.  
35. DO
36.     WHILE _MOUSEINPUT: WEND
37.     IF DetectRex&(_MOUSEX, _MOUSEY, A&) THEN LOCATE 1, 30: PRINT "   Collision detected" ELSE LOCATE 1, 30: PRINT "No collision detected"
38.     LOCATE 40, 1: PRINT "Press ESC for show VIDEO collision detection"
39. LOOP UNTIL _KEYHIT = 27
40.  
41.  
42.  
43.  
44. ' last example is video collision detection. Its the same as in rex case, but for more pictures, so as source is on screen area.
45. LOCATE 1, 30: PRINT STRING$(40, " "): LOCATE 40, 1: PRINT STRING$(50, " ")
46. Horse& = _LOADIMAGE("horseU.jpg", 32)
47. TYPE FRAME ' this is coordinates TYPE (struct) for my "videoplayer" it write correct coordinates to array, none images
48.     Source AS LONG
49.     X_Start AS INTEGER
50.     Y_Start AS INTEGER
51.     X_End AS INTEGER
52.     Y_End AS INTEGER
53.     Index AS _UNSIGNED _BYTE
54. END TYPE
55.  
56. REDIM SHARED Horse(0) AS FRAME
57. VideoLoad Horse(), Horse&, 4, 3, 146, 95, 0, 0
58. DO
59.     WHILE _MOUSEINPUT: WEND
60.     LINE (10, 10)-(156, 105), _RGB32(0, 0, 0), BF
61.     VideoPlay Horse(), 10, 10, 1 'video is not zoomed, so is not need recalculating coordinates
62.     IF DetectHorse&(_MOUSEX, _MOUSEY) THEN LOCATE 1, 30: PRINT "   Mouse on horse" ELSE LOCATE 1, 30: PRINT "No mouse on horse"
63.     LOCATE 40, 1: PRINT "Press ESC for end."
64.     _LIMIT 30
65. LOOP UNTIL _KEYHIT = 27
66.  
67. PRINT "It is all..."
68. SLEEP 1
69. _FREEIMAGE A&
70. _FREEIMAGE Horse&
71. CLS
72. END
73.  
74.  
75.  
76.  
77.  
78.  
79.  
80. FUNCTION DetectHorse& (x AS INTEGER, y AS INTEGER)
81.     x = x + 10: y = y + 10 ' because Videoplay set it to start coordinates 10, 10
82.     IF x > 10 AND x < 156 AND y > 10 AND y < 105 THEN 'is mouse in video coordinates?
83.  
84.         DIM O AS _MEM
85.         O = _MEMIMAGE(0)
86.         _MEMGET O, O.OFFSET + IN4&(x, y), value&
87.         R = _RED32(value&)
88.         G = _GREEN32(value&)
89.         B = _BLUE32(value&)
90.         IF R <= 20 AND G <= 20 AND B <= 20 THEN DetectHorse& = 0 ELSE DetectHorse& = 1 ' > 200 because color > 200 is set as transparent with setalpha and are not visible. Its background rex picture.
91.         _MEMFREE O
92.     ELSE DetectHorse& = 0: EXIT FUNCTION
93.     END IF
94.  
95. END FUNCTION
96.  
97.  
98.  
99. SUB VideoPlay (array() AS FRAME, X AS INTEGER, Y AS INTEGER, Zoom AS SINGLE)
100.     '    IF array(0).Index + 1 > UBOUND(array) THEN array(0).Index = 0 ELSE array(0).Index = array(0).Index + 1
101.     Frame = array(0).Index
102.     PosXs = array(Frame).X_Start
103.     PosXe = array(Frame).X_End
104.     PosYs = array(Frame).Y_Start
105.     PosYe = array(Frame).Y_End
106.     ResX = PosXe - PosXs
107.     ResY = PosYe - PosYs
108.  
109.     S& = array(Frame).Source&
110.     IF array(0).Index + 1 > UBOUND(array) THEN array(0).Index = 0 ELSE array(0).Index = array(0).Index + 1
111.     _PUTIMAGE (X, Y)-(Zoom * (X + ResX), Zoom * (Y + ResY)), S&, 0, (PosXs, PosYs)-(PosXe, PosYe)
112.     _DISPLAY
113. END SUB
114.  
115.  
116.  
117. SUB VideoLoad (Array() AS FRAME, Source AS LONG, FramesX AS INTEGER, FramesY AS INTEGER, ResFrameX AS INTEGER, ResFrameY AS INTEGER, CorrX AS _BYTE, CorrY AS _BYTE)
118.     x = CorrX: y = CorrY
119.     FOR T = 0 TO FramesX * FramesY - 1
120.         REDIM _PRESERVE Array(T) AS FRAME
121.         IF x + ResFrameX + CorrX > _WIDTH(Source&) THEN x = CorrX: y = y + ResFrameY + CorrY
122.         '  IF Y + ResFrameY + CorrY > _HEIGHT(Source&) THEN EXIT SUB
123.         Array(T).Source = Source&
124.         Array(T).X_Start = x + CorrX
125.         Array(T).Y_Start = y + CorrY
126.         Array(T).X_End = x + ResFrameX + CorrX
127.         Array(T).Y_End = y + ResFrameY + CorrY
128.         x = x + ResFrameX + CorrX: 'IF X > _WIDTH(Source&) THEN X = CorrX: Y = Y + ResFrameY + CorrY
129.     NEXT T
130. END SUB
131.  
132. 'for perfect work you need picture with one color in background. Picture is in memory after load, so you can use it as source for collision detection.
133. 'let say, if you draw picture to background _RGB32(255,255,254), then human see no difference between this and _RGB32(255,255,255). But computer yes.
134.  
135. FUNCTION DetectRex& (x AS INTEGER, y AS INTEGER, source AS LONG) 'this function READ NOT SCREEN but loaded image!
136.     DIM O AS _MEM
137.     O = _MEMIMAGE(source&)
138.     _MEMGET O, O.OFFSET + IN4&(x, y), value&
139.     R = _RED32(value&)
140.     G = _GREEN32(value&)
141.     B = _BLUE32(value&)
142.     IF R >= 200 AND G >= 200 AND B >= 200 THEN DetectRex& = 0 ELSE DetectRex& = 1 ' > 200 because color > 200 is set as transparent with setalpha and are not visible. Its background rex picture.
143.     _MEMFREE O
144. END FUNCTION
145.  
146.  
147.  
148.  
149.  
150.  
151.  
152.  
153.  
154.  
155.  
156.  
157. 'there are two way how do it: slow, used POINT or fast, used MEM. First demo show you slow method:
158.  
159. FUNCTION white (x AS INTEGER, y AS INTEGER)
160.     IF x < 220 AND y < 75 THEN
161.         IF POINT(x, y) = 15 THEN white = 15 ELSE white = 0 '1 = true, is collision, zero = false for collision
162.     END IF
163. END FUNCTION
164.  
165. FUNCTION MEM_White (x AS INTEGER, y AS INTEGER, source AS LONG)
166.     DIM M AS _MEM, Value AS _UNSIGNED _BYTE 'FOR 256 colors only! (in 32 bites muss Value be LONG type)
167.     M = _MEMIMAGE(source)
168.     _MEMGET M, M.OFFSET + IN&(x, y), Value
169.     IF Value = 15 THEN MEM_White = 1 ELSE MEM_White = 0
170.     _MEMFREE M
171. END FUNCTION
172.  
173. FUNCTION IN& (x AS INTEGER, y AS INTEGER) 'for 256 color only! (in 32 bites you read not ONE, but FOUR BYTES)
174.     IN& = (y * _WIDTH) + x
175. END FUNCTION
176.  
177. FUNCTION IN4& (x AS INTEGER, y AS INTEGER) 'for 256 color only! (in 32 bites you read not ONE, but FOUR BYTES)
178.     IN4& = 4 * ((y * _WIDTH) + x)
179. END FUNCTION
180.  
181.  
182.  

[bplus]

Collision detection between circles pretty easy and quite useful but allot of images are rectangular and collision detection between two rectangles can be quite useful also.

Of course what Petr has (I think) collision detection of actual image is quite complex whew! nice...

Johnno, I took you excellent collision detection for 2 set rectangles and generalized it for rectangular images using top left x, y and the image width and height for a reusable procedure.

I also added notes where I thought your code might be improved and some Johnno style humor!:

Code: QB64: [Select]

1. _TITLE "Collision of Rectangular Images started by Johnno mod b+ 2018-06-10"
2. '^^^^^^^^^^^^^^^^^^^^^^^^ no () needed but must call before SCREEN line around the string title
3.  
4. '
5. '   Collision - Test 1  orig by johnno copied and mod b+ 2018-06-10
6. '
7. '   Bounding Box
8. '
9. ' 2018-06-10 mod by B+ change for x, y, w, h of images
10. ' by readjusting all the variables and use STEP for box drawing
11. ' Generalize the specific gosub routine from this one app so can reuse IN ANY APP using sprites / tiles / images
12.  
13. SCREEN _NEWIMAGE(800, 600, 32) '<<< something more standard center is 400, 300
14.  
15. ' sprites / tiles / images are typically referred to by their left top corner ie X, Y  and their width and height
16.  
17. 'lets do the height and width first
18. box1Width = 400 '<<< mod add this instead of  calculation of box1Right
19. box1Height = 100 '<<< mod add this instead of calculation of box1Bottom
20. 'now center box
21. box1Left = 400 - box1Width / 2 'same as box1X
22. 'box1Right = 370 '100 width
23. box1Top = 300 - box1Height / 2 'same as box1Y
24. ' box1Bottom = 290 '100 height
25.  
26. mouseboxWidth = 50 '<<< mod add these constants
27. mouseboxHeight = 40 '<<< mod add these constants
28.  
29. f& = _RGB32(255, 255, 255)
30. b& = _RGB32(0, 0, 0)
31.  
32. DIM hey$(10) 'hey if boxes could talk....
33. hey$(0) = "Hey!"
34. hey$(1) = "I beg your pardon."
35. hey$(2) = "Bang!"
36. hey$(3) = "Yikes!"
37. hey$(4) = "Ouch!"
38. hey$(5) = "Watch where you are going."
39.  
40. DO
41.     k$ = INKEY$
42.     WHILE _MOUSEINPUT: WEND '<<< this is all the loop needed for mouse input
43.     CLS
44.     LINE (box1Left, box1Top)-STEP(box1Width, box1Height), _RGB32(255, 255, 255), BF
45.  
46.     'box2left = _MOUSEX - 50
47.     'box2top = _MOUSEY - 50
48.     'box2right = box2left + 100
49.     'box2bottom = box2top + 100
50.  
51.     mouseboxX = _MOUSEX - mouseboxWidth / 2
52.     mouseboxY = _MOUSEY - mouseboxHeight / 2
53.     LINE (mouseboxX, mouseboxY)-STEP(mouseboxWidth, mouseboxHeight), _RGB32(255, 128, 0), BF '<<< use step with width and height
54.  
55.     'GOSUB collide   <<< generalize this to a call to a reuseable routine
56.  
57.     IF collision%(box1Left, box1Top, box1Width, box1Height, mouseboxX, mouseboxY, mouseboxWidth, mouseboxHeight) = 1 THEN
58.         COLOR _RGB32(130, 0, 85), _RGB32(255, 255, 255)
59.         r$ = hey$(INT(RND * 6))
60.         _PRINTSTRING (box1Left + (box1Width - LEN(r$) * 8) / 2, 292), r$
61.         COLOR f&, b&
62.         lim = 1
63.     ELSE
64.         lim = 50
65.     END IF
66.     _DISPLAY
67.     _LIMIT lim '<<< save the fan
68. LOOP UNTIL k$ = CHR$(27)
69.  
70. 'collide:
71. 'IF (box1bottom < box2top) OR (box1top > box2bottom) OR (box1left > box2right) OR (box1right < box2left) THEN
72. '    collision = 0
73. 'ELSE
74. '    collision = 1
75. 'END IF
76. 'RETURN
77.  
78. FUNCTION collision% (b1x, b1y, b1w, b1h, b2x, b2y, b2w, b2h)
79.     ' yes a type smaller than integer might be used
80.     ' x, y represent the box left most x and top most y
81.     ' w, h represent the box width and height which is the usual way sprites / tiles / images are described
82.     ' such that boxbottom = by + bh
83.     '        and boxright = bx + bw
84.     'so the specific gosub above is gerealized to a function procedure here!
85.     IF (b1y + b1h < b2y) OR (b1y > b2y + b2h) OR (b1x > b2x + b2w) OR (b1x + b1w < b2x) THEN
86.         collision% = 0
87.     ELSE
88.         collision% = 1
89.     END IF
90. END FUNCTION
91.  
92.  

[johnno56]

The coding looks some-what familiar... lol but I like your sense of humour... A little whacky but leaning towards absolute bug-nuts...

Quick question: You used "&" in a few of the variables, what are the advantages/disadvantages, of using or not using the ampersand?

ps: I kind of like using the "if" instead of branching off to a routine. I suppose the difference would be a slight improvement in efficiency. The routine is being access 'all the time' as the "If" is conditional. Cool

Nice example.

I would be curious to find out how to do a 'pixel perfect' collision system (or even polygon) and compare the performance effects... Do you know of such a system?

J

ps: Today (June 11th), for we in 'The Colonies', are enjoying a Public Holiday. Queen's Birthday. Even though her birthday was in April... lol.. Feet up; Relaxing; Coding as we speak... Bliss.

pps: "Save the fan"? Looks like a reference to "Skyhigh" to me... lol

[bplus]

Hi Johnno,

The & is for long integer type best used with _RGB32 color variables, use && if want alpha too ie _RBGA32().

I don't know if the collision function is more efficient than a gosub but it is easier to reuse in other apps. So now we have it ready to go with this fun code tester.

Pixel perfect collision??? maybe from what Petr has brought here today? I have to look into that.

Happy holidays or tell the queen happy birthday for me. ;D

"Save the fan", I meant don't over heat the CPU. Use a _LIMIT after _DISPLAY in loops to control the maximum number of loops to run per second.

[johnno56]

Cool. Thanks for the clarification.

I too will keep researching pixel perfect. Looking into Box2D but uncertain that any part of it can be coded for QB64. I think Box2D is written in C++. But some of those libraries could be handy... *sigh* A nice simple physics engine would be cool...

In regards to the Queen: Our families are not on speaking terms ever since our ancestors left the UK in 1852...

Concentration on coding is shot to pieces at the moment... Grandkids are visiting... Say no more...

J

[Petr]

I write today program which demonstrate better collision detection. After start it show you picture, press any key. Then it show you detected borders after then is running snow demo, that use this collision detection. No such any physics in. Source is commented.

Code: QB64: [Select]

1.  
2. TYPE Borders '                                          this is "struct" for array Borders. This array conatains borders between image and background. It is my first vesion for collision detection.
3.     X AS INTEGER
4.     Y AS INTEGER
5.     Clr AS LONG
6.     maxX AS INTEGER
7.     minX AS INTEGER
8.     MaxY AS INTEGER
9.     MinY AS INTEGER
10. END TYPE
11.  
12. imag& = _LOADIMAGE("z.jpg", 32) '                       load example picture (downloaded from google)
13. image& = filter&(imag&, 150, 150, 150, 255, 255, 255) ' this is exemplary function. Downgrade background colors in set range to set RGB32 value: First 3* 255 are RGB inputs, next 3*230 are RGB outputs
14. SCREEN image&: SLEEP '                                  'It depends a lot on the correct setting of this function if the source image does not contain clear boundaries for proper border detection.
15.  
16. REDIM S(0) AS Borders
17. _SOURCE image&
18.  
19. Border S(), image&, _RGB32(255, 255, 255) '            function based on ONE color in background. Write image borders to array, writed for 256 colors and or truecolor, but tested for truecolor only
20. '                                                      parameter in function is background color in source image
21. B_Output& = _NEWIMAGE(800, 600, 32)
22. SCREEN B_Output&
23. LOCATE 1, 30: PRINT "This is Border SUB output:" '    program show you detected and to array writed borders
24. FOR T = LBOUND(s) TO UBOUND(s)
25.     PSET (S(T).X, S(T).Y)
26. NEXT
27. LOCATE 22, 1: PRINT "press key"
28. SLEEP
29. PRINT "This is picture, for which are border created:"
30. _SETALPHA 0, _RGB32(255, 255, 255) TO _RGB32(240, 240, 240), image& 'set white as transparent, but as you can see, here is problem, if area in picture use the same color as tranpsarent
31. _PUTIMAGE (0, 0), image&
32. LOCATE 22, 1: PRINT "now you can see borders and image. It is not perfect, because picture contains not just"
33. LOCATE 23, 1: PRINT "_RGB32(255,255,255) White color but some different. Press key for test collision detect"
34. SLEEP
35. CLS '                                                                      and here is time to try it in program :-D
36.  
37. TYPE par '                                                                 struct for snow: X = axis X
38.     x AS INTEGER '                                                                          Y = axis Y
39.     y AS INTEGER '                                                                          MY is speed to get down
40.     mY AS _UNSIGNED _BYTE '                                                                 S is size
41.     S AS SINGLE '                                                                           Time = delay to restart particle
42.     time AS DOUBLE
43. END TYPE
44. CONST part = 100 '                                                       total particles for snow in use is 100
45. DIM SHARED particles(part) AS par
46.  
47. _PUTIMAGE (300, 200), image& '                                           set transparent picture to screen
48. PCOPY _DISPLAY, 1
49. DIM O AS _MEM
50. O = _MEMIMAGE(0) '                                                       O is pointer to memory area, where current screen (0) placed
51. wht& = _RGB32(255, 255, 255) '                                           white color
52. blk& = _RGB32(0, 0, 0) '                                                 black color
53. DO
54.  
55.     FOR a = 1 TO part '                                                  do for all snow particles
56.         IF particles(a).y < 1 OR particles(a).y > 580 THEN '             conditions prevents particles to go out from screen
57.             particles(a).x = 800 * RND + 1
58.             particles(a).y = 20 * RND + 1
59.             particles(a).mY = 1 + RND * 15
60.         END IF
61.         particles(a).S = particles(a).y / 60
62.         IF particles(a).y < 550 AND particles(a).y > 30 AND particles(a).x > 50 AND particles(a).x < 750 THEN 'conditions prevents MEMORY REGION OUT OF RANGE, because is _MEM used for better speed
63.             IF particles(a).mY > 0 THEN M_Circle particles(a).x, particles(a).y, particles(a).S, _RGB32(0, 0, 0), _RGB32(0, 0, 0), _DEST 'Circles created using _MEM
64.         END IF
65.  
66.         particles(a).y = particles(a).y + particles(a).mY
67.         IF Collis_Detect(particles(a).x, particles(a).y, S(), 300, 200) THEN particles(a).mY = 0 '                                                  if is collision detected, particle stay on place
68.  
69.         FOR T = 0 TO part
70.             IF ABS(particles(a).x - particles(T).x) < 10 AND ABS(particles(a).y - particles(T).y) < 10 AND particles(T).mY = 0 THEN
71.                 particles(a).mY = 0
72.             END IF
73.         NEXT T
74.         IF particles(a).time > 0 AND particles(a).time < TIMER THEN
75.             M_Circle particles(a).x, particles(a).y, particles(a).S, _RGB32(255, 255, 255), _RGB32(255, 255, 255), _DEST 'place after paticle draw black
76.             particles(a).x = RND * 750: particles(a).y = RND * 20: particles(a).time = 0: particles(a).mY = 1 + RND * 15 'after random time limit restart particle
77.         END IF
78.         IF particles(a).y < 550 AND particles(a).y > 30 AND particles(a).x > 50 AND particles(a).x < 750 THEN 'if is particle on screen position usable for MEM,
79.             IF particles(a).mY > 0 THEN M_Circle particles(a).x, particles(a).y, particles(a).S, _RGB32(128, 128, 128), _RGB32(255, 255, 255), _DEST ELSE M_Circle particles(a).x, particles(a).y, particles(a).S, _RGB32(255, 255, 255), _RGB32(255, 255, 255), _DEST: IF particles(a).time = 0 THEN particles(a).time = CDBL(TIMER + 1 + RND * 5) ' set time limit for restart particle
80.             particlesLong = UBOUND(particles) '                                                                so if is collision, My is set to zero, so particle is stoped and particle border then is white draw
81.         END IF
82.         _DISPLAY
83.     NEXT
84. LOOP UNTIL _KEYHIT = 27
85.  
86.  
87. FUNCTION Collis_Detect (Ex AS INTEGER, Ey AS INTEGER, s() AS Borders, x AS INTEGER, y AS INTEGER)
88.     SHARED particles() AS par
89.     'Ex and Ey are enemy coordinates, s is array contains picture border, x and y is who is picture placed / left uppon corner
90.     minX = s(0).minX 'can be used for quadric standard collision detection, this four values return picture X start, X end, Y start and Y end
91.     maxX = s(0).maxX
92.     minY = s(0).MinY
93.     maxY = s(0).MaxY
94.  
95.     FOR CD = LBOUND(s) TO UBOUND(s)
96.         i = i + 1
97.         IF i > part THEN i = 1
98.         '            IF s(CD).X + Ex = s(CD).X + x OR s(CD).Y + Ey = s(CD).Y + y THEN Collis_Detect = 1 ELSE Collis_Detect = 0
99.         IF ABS((s(CD).X + x) - Ex) < particles(i).S AND ABS((s(CD).Y + y) - Ey) < particles(i).S THEN Collis_Detect = 1: EXIT FUNCTION ELSE Collis_Detect = 0 'Here it read radius from particles.s
100.     NEXT '                                                                       its radius size and then if conditions are valid return 0 for no collis or 1 for collis. ABS is always positive output
101.     '                                                                            (  ABS (20 - 80) = 60  ) so i muss not driving with SGN sign for values
102. END FUNCTION
103.  
104.  
105.  
106.  
107. SUB Border (array() AS Borders, Source AS LONG, Background_Color AS _UNSIGNED LONG) 'own border detection sub
108.     _DEST Source&
109.     minX = _WIDTH(Source&)
110.     minY = _HEIGHT(Source&)
111.     DIM M AS _MEM '32 bytova promenna                                                                         '  MEM values are 32 BYTES long,
112.     M = _MEMIMAGE(Source&) '                                                                                     M is pointer to memory with image content
113.     SELECT CASE _PIXELSIZE(Source&) '                                                                           select if image is 256 colored, 8 bit (1 byte for pixel) or 32 bit colored (4 byte for pixel)
114.         CASE 0: END 'not writed for text mode yet                                                                0 is for text mode, then this screen contains cells 8 * 16 pixels, one cell has value one BYTE
115.         CASE 1: '    for 256 colors image
116.             REDIM Value AS _UNSIGNED _BYTE, OldValue AS _UNSIGNED _BYTE '                                       because i need read value directly from memory, muss set correct type first - basicaly are
117.             FOR y = 0 TO _HEIGHT(Source&) - 1 '                                                                 all varibles set to SINGLE (4 byte long)
118.                 FOR x = 0 TO _WIDTH(Source&) - 1
119.                     OldValue = Value
120.                     _MEMGET M, M.OFFSET + IN&(x, y), Value '                                                    is the same as POINT but very  more faster!  _MEMGET is as POINT for read color value,
121.                     '                                                                                           _MEMPUT is the same as POINT for writing color value. In use with mem muss be correct type and offset set.
122.                     IF Value = Background_Color AND OldValue <> Background_Color OR Value <> Background_Color AND OldValue = Background_Color THEN
123.                         GOSUB rozsah '                                                                          subprogram continuously compares values for MinX, MaxX, MinY and MaxY
124.                         i = i + 1
125.                         REDIM _PRESERVE array(i) AS Borders '                                                   this command increases the field value without losing the field contents // to i size
126.                         array(i).X = x
127.                         array(i).Y = y
128.                         array(i).Clr = Value
129.                     END IF
130.                     IF y > 0 THEN _MEMGET M, M.OFFSET + IN&(x, y - 1), Value '                                  condition for preveting MEMORY REGION OUT OF RANGE and read current color value on X, Y
131.                     IF Value = Background_Color AND OldValue <> Background_Color OR Value <> Background_Color AND OldValue = Background_Color THEN
132.                         i = i + 1 'This condition: If current color is the same as background and previous color is different than background or above, write this coordinates to array. Easy trick.
133.                         REDIM _PRESERVE array(i) AS Borders '                                                   this command increases the field value without losing the field contents // to i size
134.                         array(i).X = x
135.                         array(i).Y = y '                                                            program line 117 control colors in row, program line 126 control colors in column
136.                         array(i).Clr = Value
137.                     END IF
138.             NEXT x, y
139.  
140.         CASE 4: 'for 32 bit screen                                                                ' this block is the same for truecolor (4 byte blocks)
141.             REDIM Value4 AS LONG, OldValue4 AS LONG '                                               program lines 142 and 153 control and writing borders to array
142.             FOR y = 0 TO _HEIGHT(Source&) - 4
143.                 FOR x = 0 TO _WIDTH(Source&) - 4
144.                     OldValue4& = Value4&
145.                     _MEMGET M, M.OFFSET + IN&(x, y), Value4&
146.  
147.                     IF Value4& = Background_Color AND OldValue4& <> Background_Color OR Value4& <> Background_Color AND OldValue4& = Background_Color THEN
148.                         GOSUB rozsah
149.                         i = i + 1
150.                         REDIM _PRESERVE array(i) AS Borders
151.                         array(i).X = x
152.                         array(i).Y = y
153.                         array(i).Clr = Value4&
154.                     END IF
155.  
156.                     IF y > 0 THEN _MEMGET M, M.OFFSET + IN&(x, y - 1), Value4&
157.  
158.                     IF Value4& = Background_Color AND OldValue4& <> Background_Color OR Value4& <> Background_Color AND OldValue4& = Background_Color THEN
159.                         i = i + 1
160.                         REDIM _PRESERVE array(i) AS Borders
161.                         array(i).X = x
162.                         array(i).Y = y
163.                         array(i).Clr = Value4&
164.                     END IF
165.                     nic:
166.             NEXT x, y
167.     END SELECT
168.     _DEST 0
169.     array(0).minX = minX '                                                                           to zero position in array are writed image width and height for
170.     array(0).maxX = maxX '                                                                           possibillity quadric collision detection
171.     array(0).MinY = minY
172.     array(0).MaxY = maxY
173.  
174.     EXIT SUB
175.     rozsah:
176.     IF minX > x AND x > 0 THEN minX = x
177.     IF minY > y AND y > 0 THEN minY = y
178.     IF maxX < x THEN maxX = x
179.     IF maxY < y THEN maxY = y
180.     RETURN
181. END SUB
182.  
183. FUNCTION IN& (x AS INTEGER, y AS INTEGER)
184.     IN& = _PIXELSIZE(_SOURCE) * ((_WIDTH * y) + x) '                                                  function return offset for MEM functions. Copyed from Steve McNeill
185. END FUNCTION
186.  
187. FUNCTION filter& (image AS LONG, Ri, Gi, Bi, Ro, Go, Bo) '                                            Function has the task of making the background of the specified color and reducing the
188.     DIM f AS _MEM '                                                                                   background color unevenness to make the best possible image border detection
189.     f = _MEMIMAGE(image&)
190.     '   filter& = _MEMNEW(_WIDTH(image&) * _HEIGHT(image&) * _PIXELSIZE(image&)) '                    Here is one bug for developers. Uncomment and give C++ compilation error. I know why, so just for info. :-D With love :-D
191.     filter& = _NEWIMAGE(_WIDTH(image&), _HEIGHT(image&), 32)
192.     DIM GG AS _MEM
193.     GG = _MEMIMAGE(filter&)
194.     _SOURCE image&
195.     _DEST image& '                                                                                    next ask for developers. Comment DEST on this line and start it. You give HALF picture. Why?
196.     SELECT CASE _PIXELSIZE(image&)
197.         CASE 4
198.             DIM clr AS LONG
199.             choice& = _RGBA32(Ro, Go, Bo, 255)
200.             FOR y = 0 TO _HEIGHT(image&) - 4
201.                 FOR x = 0 TO _WIDTH(image&) - 4
202.                     _MEMGET f, f.OFFSET + IN&(x, y), clr&
203.                     R = _RED32(clr&)
204.                     G = _GREEN32(clr&)
205.                     B = _BLUE32(clr&)
206.                     A = _ALPHA32(clr&)
207.                     IF R > Ri AND G > Gi AND B > Bi AND A > 200 THEN _MEMPUT GG, GG.OFFSET + IN&(x, y), choice& ELSE _MEMPUT GG, GG.OFFSET + IN&(x, y), clr&
208.     NEXT x, y: END SELECT
209.  
210.     _MEMFREE f
211.     _MEMFREE GG
212.     _FREEIMAGE image&
213. END FUNCTION
214.  
215.  
216.  
217. SUB M_Circle (X AS INTEGER, Y AS INTEGER, Radius AS INTEGER, Circuit_Color AS LONG, Fill_Color AS LONG, Dest AS LONG) 'this is (very badly) sub for creating fill circles using MEM. Much better be
218.     DIM M AS _MEM '                                                                                                    SteveMCNeill LINE modification for it. MEM__Line i have already writed....
219.     M = _MEMIMAGE(Dest&)
220.     FOR rds = 0 TO Radius
221.         IF rds = Radius THEN clr& = Circuit_Color& ELSE clr& = Fill_Color&
222.         FOR cir = 0 TO 6.28 STEP .1
223.             _MEMPUT M, M.OFFSET + IN&(X + SIN(cir) * rds, Y + COS(cir) * rds), clr&
224.     NEXT cir, rds
225.     _MEMFREE M
226. END SUB
227.  

use attached picture, function filter& is set for this image (source code line 13)

[johnno56]

Cool... That seems to be a quite unique collision system. Nicely done!

J

[TempodiBasic]

Collision Detection
 a very important and difficult issue...

I must say these feedback...

Hi Johnno56
your first code makes a bug after pressing ESC key.... (IMHO for the absence of END between LOOP UNTIL and collide: )

Hi Petr
I find your method very interesting....
If i put the mouse pointer on the body of the horse at the position of the leg of the man I get a switching response Collision Horse/ NO Collision Horse....  maybe the issue can be in the way that the image in movement is built up.
See Images attached

[Petr]

Hi TempodiBasic,

it's okay, it works on that principle. I try to think of such a procedure so the computer does not burden too much. So far, I have been doing a speed test for DIM and MEM. The difference is small for a small volume of data, for large volumes but up to 50 percent. This is related to the fact that I am trying to find the fastest method (which I will be able to write with current knowledge). What I have forgotten is such an important little thing. It's a trifle without which we do not move. This function not only has to return the state that a collision has occurred. That is not enough. She must also return the value from where.

[codeguy]

QB64 is down or I'd recommend a look at collding text for rectangular detection and NSpace for polygonal.

[Unseen Machine]

Hi,

GDK has the best (basic) collision detection made so far. It uses Bounding Cirlces or Rectangles. The rectangle collision detection can even create autosized rectangles based on the image used and also rotate with the image rather than resizing! It doesnt support pixel perfect collisions yet as i've always found implementing that really slows down the program...best bet is scaled rectangles in my opinion.

If you wanna go another route then maybe look into SAT (Seperated Axis Therom) collision detection (implementing that has always foiled me!). I looked into porting Box2D a few years ago and that was even more of a mission! Also, im sure that the community could come up with something comparable without resorting to DECLARE LIBRARY!

Unseen