### Author Topic: Collision Detection  (Read 1267 times)

#### johnno56

• Live long and prosper.
##### Collision Detection
« on: June 10, 2018, 06:08:54 AM »
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
Logic is the beginning of wisdom.

#### johnno56

• Live long and prosper.
##### Re: Collision Detection
« Reply #1 on: June 10, 2018, 07:08:02 AM »
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: [Select]
`''   Collision - Test 1''   Bounding Box'SCREEN _NEWIMAGE(640, 480, 32)_TITLE ("Bounding Box Collision Detection")box1top = 190box1bottom = 290box1left = 270box1right = 370collision = 0DO: k\$ = INKEY\$    DO WHILE _MOUSEINPUT        CLS        LINE (box1left, box1top)-(box1right, box1bottom), _RGB32(255, 255, 0), B        box2left = _MOUSEX - 50        box2top = _MOUSEY - 50        box2right = box2left + 100        box2bottom = box2top + 100        LINE (box2left, box2top)-(box2right, box2bottom), _RGB32(255, 128, 0), B        GOSUB collide        IF collision = 1 THEN            COLOR _RGB32(0, 128, 0)            _PRINTSTRING (283, 230), "Collision"        END IF        _DISPLAY    LOOPLOOP UNTIL k\$ = CHR\$(27)collide:IF (box1bottom < box2top) OR (box1top > box2bottom) OR (box1left > box2right) OR (box1right < box2left) THEN    collision = 0ELSE    collision = 1END IFRETURN`
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
Logic is the beginning of wisdom.

#### Petr

• I am instructed.
##### Re: Collision Detection
« Reply #2 on: June 10, 2018, 07:42:00 AM »
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: [Select]
`'collision detection    -  mouse in circleSCREEN _NEWIMAGE(800, 600, 256)DO    WHILE _MOUSEINPUT: WEND    CLS    IF Circle_Collis(_MOUSEX, _MOUSEY, 60, 400, 300) THEN LOCATE 1, 1: PRINT "   Collision" ELSE LOCATE 1, 1: PRINT "No collision"    CIRCLE (400, 300), 60    _DISPLAYLOOPFUNCTION Circle_Collis (x AS LONG, y AS LONG, r AS LONG, cx AS LONG, cy AS LONG)    xy& = ((x& - cx&) ^ 2) + ((y& - cy&) ^ 2) 'Pythagorean theorem    IF r& ^ 2 >= xy& THEN Circle_Collis = 1 ELSE Circle_Collis = 0END FUNCTION`

#### johnno56

• Live long and prosper.
##### Re: Collision Detection
« Reply #3 on: June 10, 2018, 08:23:29 AM »
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
Logic is the beginning of wisdom.

#### Petr

• I am instructed.
##### Re: Collision Detection
« Reply #4 on: June 10, 2018, 10:49:57 AM »
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: [Select]
`'very easy method based on color difference:A& = _NEWIMAGE(100, 50, 256)_DEST A&: PRINT "Secured"SCREEN _NEWIMAGE(400, 300, 256)_PUTIMAGE , A&DO    WHILE _MOUSEINPUT: WEND    IF white(_MOUSEX, _MOUSEY) THEN LOCATE 1, 30: PRINT "   Collision detected" ELSE LOCATE 1, 30: PRINT "No collision detected"    LOCATE 13, 1: PRINT "Press ESC for show MEM method"LOOP UNTIL _KEYHIT = 27DO    WHILE _MOUSEINPUT: WEND    IF MEM_White(_MOUSEX, _MOUSEY, 0) THEN LOCATE 1, 30: PRINT "   Collision detected" ELSE LOCATE 1, 30: PRINT "No collision detected"    LOCATE 13, 1: PRINT "Press ESC for show virtual screen method"LOOP UNTIL _KEYHIT = 27'but in practice objects use more than one color. For show you, hot to create it, use image:_FREEIMAGE A& ' kill text image from memoryCLSA& = _LOADIMAGE("rex.jpg", 32)_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 notREDIM Border(0, 0) AS _BYTE '                                    recalculating coordinates, so you only show to source image (source in memory an on screen are now different)SCREEN _NEWIMAGE(_WIDTH(A&), _HEIGHT(A&), 32)_PUTIMAGE , _SCREENIMAGE '                                       first draw background image_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)DO    WHILE _MOUSEINPUT: WEND    IF DetectRex&(_MOUSEX, _MOUSEY, A&) THEN LOCATE 1, 30: PRINT "   Collision detected" ELSE LOCATE 1, 30: PRINT "No collision detected"    LOCATE 40, 1: PRINT "Press ESC for show VIDEO collision detection"LOOP UNTIL _KEYHIT = 27' last example is video collision detection. Its the same as in rex case, but for more pictures, so as source is on screen area.LOCATE 1, 30: PRINT STRING\$(40, " "): LOCATE 40, 1: PRINT STRING\$(50, " ")Horse& = _LOADIMAGE("horseU.jpg", 32)TYPE FRAME ' this is coordinates TYPE (struct) for my "videoplayer" it write correct coordinates to array, none images    Source AS LONG    X_Start AS INTEGER    Y_Start AS INTEGER    X_End AS INTEGER    Y_End AS INTEGER    Index AS _UNSIGNED _BYTEEND TYPEREDIM SHARED Horse(0) AS FRAMEVideoLoad Horse(), Horse&, 4, 3, 146, 95, 0, 0DO    WHILE _MOUSEINPUT: WEND    LINE (10, 10)-(156, 105), _RGB32(0, 0, 0), BF    VideoPlay Horse(), 10, 10, 1 'video is not zoomed, so is not need recalculating coordinates    IF DetectHorse&(_MOUSEX, _MOUSEY) THEN LOCATE 1, 30: PRINT "   Mouse on horse" ELSE LOCATE 1, 30: PRINT "No mouse on horse"    LOCATE 40, 1: PRINT "Press ESC for end."    _LIMIT 30LOOP UNTIL _KEYHIT = 27PRINT "It is all..."SLEEP 1_FREEIMAGE A&_FREEIMAGE Horse&CLSENDFUNCTION DetectHorse& (x AS INTEGER, y AS INTEGER)    x = x + 10: y = y + 10 ' because Videoplay set it to start coordinates 10, 10    IF x > 10 AND x < 156 AND y > 10 AND y < 105 THEN 'is mouse in video coordinates?        DIM O AS _MEM        O = _MEMIMAGE(0)        _MEMGET O, O.OFFSET + IN4&(x, y), value&        R = _RED32(value&)        G = _GREEN32(value&)        B = _BLUE32(value&)        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.        _MEMFREE O    ELSE DetectHorse& = 0: EXIT FUNCTION    END IFEND FUNCTIONSUB VideoPlay (array() AS FRAME, X AS INTEGER, Y AS INTEGER, Zoom AS SINGLE)    '    IF array(0).Index + 1 > UBOUND(array) THEN array(0).Index = 0 ELSE array(0).Index = array(0).Index + 1    Frame = array(0).Index    PosXs = array(Frame).X_Start    PosXe = array(Frame).X_End    PosYs = array(Frame).Y_Start    PosYe = array(Frame).Y_End    ResX = PosXe - PosXs    ResY = PosYe - PosYs    S& = array(Frame).Source&    IF array(0).Index + 1 > UBOUND(array) THEN array(0).Index = 0 ELSE array(0).Index = array(0).Index + 1    _PUTIMAGE (X, Y)-(Zoom * (X + ResX), Zoom * (Y + ResY)), S&, 0, (PosXs, PosYs)-(PosXe, PosYe)    _DISPLAYEND SUBSUB 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)    x = CorrX: y = CorrY    FOR T = 0 TO FramesX * FramesY - 1        REDIM _PRESERVE Array(T) AS FRAME        IF x + ResFrameX + CorrX > _WIDTH(Source&) THEN x = CorrX: y = y + ResFrameY + CorrY        '  IF Y + ResFrameY + CorrY > _HEIGHT(Source&) THEN EXIT SUB        Array(T).Source = Source&        Array(T).X_Start = x + CorrX        Array(T).Y_Start = y + CorrY        Array(T).X_End = x + ResFrameX + CorrX        Array(T).Y_End = y + ResFrameY + CorrY        x = x + ResFrameX + CorrX: 'IF X > _WIDTH(Source&) THEN X = CorrX: Y = Y + ResFrameY + CorrY    NEXT TEND SUB'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.'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.FUNCTION DetectRex& (x AS INTEGER, y AS INTEGER, source AS LONG) 'this function READ NOT SCREEN but loaded image!    DIM O AS _MEM    O = _MEMIMAGE(source&)    _MEMGET O, O.OFFSET + IN4&(x, y), value&    R = _RED32(value&)    G = _GREEN32(value&)    B = _BLUE32(value&)    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.    _MEMFREE OEND FUNCTION'there are two way how do it: slow, used POINT or fast, used MEM. First demo show you slow method:FUNCTION white (x AS INTEGER, y AS INTEGER)    IF x < 220 AND y < 75 THEN        IF POINT(x, y) = 15 THEN white = 15 ELSE white = 0 '1 = true, is collision, zero = false for collision    END IFEND FUNCTIONFUNCTION MEM_White (x AS INTEGER, y AS INTEGER, source AS LONG)    DIM M AS _MEM, Value AS _UNSIGNED _BYTE 'FOR 256 colors only! (in 32 bites muss Value be LONG type)    M = _MEMIMAGE(source)    _MEMGET M, M.OFFSET + IN&(x, y), Value    IF Value = 15 THEN MEM_White = 1 ELSE MEM_White = 0    _MEMFREE MEND FUNCTIONFUNCTION IN& (x AS INTEGER, y AS INTEGER) 'for 256 color only! (in 32 bites you read not ONE, but FOUR BYTES)    IN& = (y * _WIDTH) + xEND FUNCTIONFUNCTION IN4& (x AS INTEGER, y AS INTEGER) 'for 256 color only! (in 32 bites you read not ONE, but FOUR BYTES)    IN4& = 4 * ((y * _WIDTH) + x)END FUNCTION`

#### bplus

##### Re: Collision Detection
« Reply #5 on: June 10, 2018, 11:13:26 AM »
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: [Select]
`_TITLE "Collision of Rectangular Images started by Johnno mod b+ 2018-06-10"'^^^^^^^^^^^^^^^^^^^^^^^^ no () needed but must call before SCREEN line around the string title''   Collision - Test 1  orig by johnno copied and mod b+ 2018-06-10''   Bounding Box'' 2018-06-10 mod by B+ change for x, y, w, h of images' by readjusting all the variables and use STEP for box drawing' Generalize the specific gosub routine from this one app so can reuse IN ANY APP using sprites / tiles / imagesSCREEN _NEWIMAGE(800, 600, 32) '<<< something more standard center is 400, 300' sprites / tiles / images are typically referred to by their left top corner ie X, Y  and their width and height'lets do the height and width firstbox1Width = 400 '<<< mod add this instead of  calculation of box1Rightbox1Height = 100 '<<< mod add this instead of calculation of box1Bottom'now center boxbox1Left = 400 - box1Width / 2 'same as box1X'box1Right = 370 '100 widthbox1Top = 300 - box1Height / 2 'same as box1Y' box1Bottom = 290 '100 heightmouseboxWidth = 50 '<<< mod add these constantsmouseboxHeight = 40 '<<< mod add these constantsf& = _RGB32(255, 255, 255)b& = _RGB32(0, 0, 0)DIM hey\$(10) 'hey if boxes could talk....hey\$(0) = "Hey!"hey\$(1) = "I beg your pardon."hey\$(2) = "Bang!"hey\$(3) = "Yikes!"hey\$(4) = "Ouch!"hey\$(5) = "Watch where you are going."DO    k\$ = INKEY\$    WHILE _MOUSEINPUT: WEND '<<< this is all the loop needed for mouse input    CLS    LINE (box1Left, box1Top)-STEP(box1Width, box1Height), _RGB32(255, 255, 255), BF    'box2left = _MOUSEX - 50    'box2top = _MOUSEY - 50    'box2right = box2left + 100    'box2bottom = box2top + 100    mouseboxX = _MOUSEX - mouseboxWidth / 2    mouseboxY = _MOUSEY - mouseboxHeight / 2    LINE (mouseboxX, mouseboxY)-STEP(mouseboxWidth, mouseboxHeight), _RGB32(255, 128, 0), BF '<<< use step with width and height    'GOSUB collide   <<< generalize this to a call to a reuseable routine    IF collision%(box1Left, box1Top, box1Width, box1Height, mouseboxX, mouseboxY, mouseboxWidth, mouseboxHeight) = 1 THEN        COLOR _RGB32(130, 0, 85), _RGB32(255, 255, 255)        r\$ = hey\$(INT(RND * 6))        _PRINTSTRING (box1Left + (box1Width - LEN(r\$) * 8) / 2, 292), r\$        COLOR f&, b&        lim = 1    ELSE        lim = 50    END IF    _DISPLAY    _LIMIT lim '<<< save the fanLOOP UNTIL k\$ = CHR\$(27)'collide:'IF (box1bottom < box2top) OR (box1top > box2bottom) OR (box1left > box2right) OR (box1right < box2left) THEN'    collision = 0'ELSE'    collision = 1'END IF'RETURNFUNCTION collision% (b1x, b1y, b1w, b1h, b2x, b2y, b2w, b2h)    ' yes a type smaller than integer might be used    ' x, y represent the box left most x and top most y    ' w, h represent the box width and height which is the usual way sprites / tiles / images are described    ' such that boxbottom = by + bh    '        and boxright = bx + bw    'so the specific gosub above is gerealized to a function procedure here!    IF (b1y + b1h < b2y) OR (b1y > b2y + b2h) OR (b1x > b2x + b2w) OR (b1x + b1w < b2x) THEN        collision% = 0    ELSE        collision% = 1    END IFEND FUNCTION`
« Last Edit: June 10, 2018, 11:23:04 AM by bplus »
B = B + ...

#### johnno56

• Live long and prosper.
##### Re: Collision Detection
« Reply #6 on: June 10, 2018, 06:44:43 PM »
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
« Last Edit: June 10, 2018, 07:21:11 PM by johnno56 »
Logic is the beginning of wisdom.

#### bplus

##### Re: Collision Detection
« Reply #7 on: June 10, 2018, 08:59:13 PM »
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.
B = B + ...

#### johnno56

• Live long and prosper.
##### Re: Collision Detection
« Reply #8 on: June 11, 2018, 12:25:46 AM »
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

Logic is the beginning of wisdom.

#### Petr

• I am instructed.
##### Re: Collision Detection
« Reply #9 on: June 11, 2018, 03:39:44 PM »
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: [Select]
`TYPE Borders '                                          this is "struct" for array Borders. This array conatains borders between image and background. It is my first vesion for collision detection.    X AS INTEGER    Y AS INTEGER    Clr AS LONG    maxX AS INTEGER    minX AS INTEGER    MaxY AS INTEGER    MinY AS INTEGEREND TYPEimag& = _LOADIMAGE("z.jpg", 32) '                       load example picture (downloaded from google)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 outputsSCREEN 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.REDIM S(0) AS Borders_SOURCE image&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'                                                      parameter in function is background color in source imageB_Output& = _NEWIMAGE(800, 600, 32)SCREEN B_Output&LOCATE 1, 30: PRINT "This is Border SUB output:" '    program show you detected and to array writed bordersFOR T = LBOUND(s) TO UBOUND(s)    PSET (S(T).X, S(T).Y)NEXTLOCATE 22, 1: PRINT "press key"SLEEPPRINT "This is picture, for which are border created:"_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_PUTIMAGE (0, 0), image&LOCATE 22, 1: PRINT "now you can see borders and image. It is not perfect, because picture contains not just"LOCATE 23, 1: PRINT "_RGB32(255,255,255) White color but some different. Press key for test collision detect"SLEEPCLS '                                                                      and here is time to try it in program :-DTYPE par '                                                                 struct for snow: X = axis X    x AS INTEGER '                                                                          Y = axis Y    y AS INTEGER '                                                                          MY is speed to get down    mY AS _UNSIGNED _BYTE '                                                                 S is size    S AS SINGLE '                                                                           Time = delay to restart particle    time AS DOUBLEEND TYPECONST part = 100 '                                                       total particles for snow in use is 100DIM SHARED particles(part) AS par_PUTIMAGE (300, 200), image& '                                           set transparent picture to screenPCOPY _DISPLAY, 1DIM O AS _MEMO = _MEMIMAGE(0) '                                                       O is pointer to memory area, where current screen (0) placedwht& = _RGB32(255, 255, 255) '                                           white colorblk& = _RGB32(0, 0, 0) '                                                 black colorDO    FOR a = 1 TO part '                                                  do for all snow particles        IF particles(a).y < 1 OR particles(a).y > 580 THEN '             conditions prevents particles to go out from screen            particles(a).x = 800 * RND + 1            particles(a).y = 20 * RND + 1            particles(a).mY = 1 + RND * 15        END IF        particles(a).S = particles(a).y / 60        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            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        END IF        particles(a).y = particles(a).y + particles(a).mY        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        FOR T = 0 TO part            IF ABS(particles(a).x - particles(T).x) < 10 AND ABS(particles(a).y - particles(T).y) < 10 AND particles(T).mY = 0 THEN                particles(a).mY = 0            END IF        NEXT T        IF particles(a).time > 0 AND particles(a).time < TIMER THEN            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            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        END IF        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,            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            particlesLong = UBOUND(particles) '                                                                so if is collision, My is set to zero, so particle is stoped and particle border then is white draw        END IF        _DISPLAY    NEXTLOOP UNTIL _KEYHIT = 27FUNCTION Collis_Detect (Ex AS INTEGER, Ey AS INTEGER, s() AS Borders, x AS INTEGER, y AS INTEGER)    SHARED particles() AS par    'Ex and Ey are enemy coordinates, s is array contains picture border, x and y is who is picture placed / left uppon corner    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    maxX = s(0).maxX    minY = s(0).MinY    maxY = s(0).MaxY    FOR CD = LBOUND(s) TO UBOUND(s)        i = i + 1        IF i > part THEN i = 1        '            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        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    NEXT '                                                                       its radius size and then if conditions are valid return 0 for no collis or 1 for collis. ABS is always positive output    '                                                                            (  ABS (20 - 80) = 60  ) so i muss not driving with SGN sign for valuesEND FUNCTIONSUB Border (array() AS Borders, Source AS LONG, Background_Color AS _UNSIGNED LONG) 'own border detection sub    _DEST Source&    minX = _WIDTH(Source&)    minY = _HEIGHT(Source&)    DIM M AS _MEM '32 bytova promenna                                                                         '  MEM values are 32 BYTES long,    M = _MEMIMAGE(Source&) '                                                                                     M is pointer to memory with image content    SELECT CASE _PIXELSIZE(Source&) '                                                                           select if image is 256 colored, 8 bit (1 byte for pixel) or 32 bit colored (4 byte for pixel)        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        CASE 1: '    for 256 colors image            REDIM Value AS _UNSIGNED _BYTE, OldValue AS _UNSIGNED _BYTE '                                       because i need read value directly from memory, muss set correct type first - basicaly are            FOR y = 0 TO _HEIGHT(Source&) - 1 '                                                                 all varibles set to SINGLE (4 byte long)                FOR x = 0 TO _WIDTH(Source&) - 1                    OldValue = Value                    _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,                    '                                                                                           _MEMPUT is the same as POINT for writing color value. In use with mem muss be correct type and offset set.                    IF Value = Background_Color AND OldValue <> Background_Color OR Value <> Background_Color AND OldValue = Background_Color THEN                        GOSUB rozsah '                                                                          subprogram continuously compares values for MinX, MaxX, MinY and MaxY                        i = i + 1                        REDIM _PRESERVE array(i) AS Borders '                                                   this command increases the field value without losing the field contents // to i size                        array(i).X = x                        array(i).Y = y                        array(i).Clr = Value                    END IF                    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                    IF Value = Background_Color AND OldValue <> Background_Color OR Value <> Background_Color AND OldValue = Background_Color THEN                        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.                        REDIM _PRESERVE array(i) AS Borders '                                                   this command increases the field value without losing the field contents // to i size                        array(i).X = x                        array(i).Y = y '                                                            program line 117 control colors in row, program line 126 control colors in column                        array(i).Clr = Value                    END IF            NEXT x, y        CASE 4: 'for 32 bit screen                                                                ' this block is the same for truecolor (4 byte blocks)            REDIM Value4 AS LONG, OldValue4 AS LONG '                                               program lines 142 and 153 control and writing borders to array            FOR y = 0 TO _HEIGHT(Source&) - 4                FOR x = 0 TO _WIDTH(Source&) - 4                    OldValue4& = Value4&                    _MEMGET M, M.OFFSET + IN&(x, y), Value4&                    IF Value4& = Background_Color AND OldValue4& <> Background_Color OR Value4& <> Background_Color AND OldValue4& = Background_Color THEN                        GOSUB rozsah                        i = i + 1                        REDIM _PRESERVE array(i) AS Borders                        array(i).X = x                        array(i).Y = y                        array(i).Clr = Value4&                    END IF                    IF y > 0 THEN _MEMGET M, M.OFFSET + IN&(x, y - 1), Value4&                    IF Value4& = Background_Color AND OldValue4& <> Background_Color OR Value4& <> Background_Color AND OldValue4& = Background_Color THEN                        i = i + 1                        REDIM _PRESERVE array(i) AS Borders                        array(i).X = x                        array(i).Y = y                        array(i).Clr = Value4&                    END IF                    nic:            NEXT x, y    END SELECT    _DEST 0    array(0).minX = minX '                                                                           to zero position in array are writed image width and height for    array(0).maxX = maxX '                                                                           possibillity quadric collision detection    array(0).MinY = minY    array(0).MaxY = maxY    EXIT SUB    rozsah:    IF minX > x AND x > 0 THEN minX = x    IF minY > y AND y > 0 THEN minY = y    IF maxX < x THEN maxX = x    IF maxY < y THEN maxY = y    RETURNEND SUBFUNCTION IN& (x AS INTEGER, y AS INTEGER)    IN& = _PIXELSIZE(_SOURCE) * ((_WIDTH * y) + x) '                                                  function return offset for MEM functions. Copyed from Steve McNeillEND FUNCTIONFUNCTION 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    DIM f AS _MEM '                                                                                   background color unevenness to make the best possible image border detection    f = _MEMIMAGE(image&)    '   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    filter& = _NEWIMAGE(_WIDTH(image&), _HEIGHT(image&), 32)    DIM GG AS _MEM    GG = _MEMIMAGE(filter&)    _SOURCE image&    _DEST image& '                                                                                    next ask for developers. Comment DEST on this line and start it. You give HALF picture. Why?    SELECT CASE _PIXELSIZE(image&)        CASE 4            DIM clr AS LONG            choice& = _RGBA32(Ro, Go, Bo, 255)            FOR y = 0 TO _HEIGHT(image&) - 4                FOR x = 0 TO _WIDTH(image&) - 4                    _MEMGET f, f.OFFSET + IN&(x, y), clr&                    R = _RED32(clr&)                    G = _GREEN32(clr&)                    B = _BLUE32(clr&)                    A = _ALPHA32(clr&)                    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&    NEXT x, y: END SELECT    _MEMFREE f    _MEMFREE GG    _FREEIMAGE image&END FUNCTIONSUB 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    DIM M AS _MEM '                                                                                                    SteveMCNeill LINE modification for it. MEM__Line i have already writed....    M = _MEMIMAGE(Dest&)    FOR rds = 0 TO Radius        IF rds = Radius THEN clr& = Circuit_Color& ELSE clr& = Fill_Color&        FOR cir = 0 TO 6.28 STEP .1            _MEMPUT M, M.OFFSET + IN&(X + SIN(cir) * rds, Y + COS(cir) * rds), clr&    NEXT cir, rds    _MEMFREE MEND SUB`
use attached picture, function filter& is set for this image (source code line 13)

#### johnno56

• Live long and prosper.
##### Re: Collision Detection
« Reply #10 on: June 11, 2018, 05:40:54 PM »
Cool... That seems to be a quite unique collision system. Nicely done!

J
Logic is the beginning of wisdom.

#### TempodiBasic

##### Re: Collision Detection
« Reply #11 on: June 13, 2018, 09:09:56 AM »
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

• I am instructed.
##### Re: Collision Detection
« Reply #12 on: June 13, 2018, 09:41:01 AM »
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

##### Re: Collision Detection
« Reply #13 on: June 14, 2018, 06:01:13 PM »
QB64 is down or I'd recommend a look at collding text for rectangular detection and NSpace for polygonal.

#### Unseen Machine

• QB64 Elite
##### Re: Collision Detection
« Reply #14 on: June 23, 2018, 07:57:18 PM »
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