Author Topic: Collision Detection  (Read 445 times)

Offline johnno56

  • Live long and prosper.
Collision Detection
« on: June 10, 2018, 07: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.

Offline johnno56

  • Live long and prosper.
Re: Collision Detection
« Reply #1 on: June 10, 2018, 08: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 = 190
box1bottom = 290
box1left = 270
box1right = 370

collision = 0

DO: 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
    LOOP
LOOP 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
RETURN

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.

Re: Collision Detection
« Reply #2 on: June 10, 2018, 08: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 circle

SCREEN _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
    _DISPLAY
LOOP


FUNCTION 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 = 0
END FUNCTION
Coding is relax (At least sometimes)

Offline johnno56

  • Live long and prosper.
Re: Collision Detection
« Reply #3 on: June 10, 2018, 09: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.

Re: Collision Detection
« Reply #4 on: June 10, 2018, 11: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 = 27


DO
    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 memory
CLS
A& = _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 not
REDIM 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 _BYTE
END TYPE

REDIM SHARED Horse(0) AS FRAME
VideoLoad Horse(), Horse&, 4, 3, 146, 95, 0, 0
DO
    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 30
LOOP UNTIL _KEYHIT = 27

PRINT "It is all..."
SLEEP 1
_FREEIMAGE A&
_FREEIMAGE Horse&
CLS
END







FUNCTION 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 IF

END FUNCTION



SUB 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)
    _DISPLAY
END SUB



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)
    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 T
END 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 O
END 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 IF
END FUNCTION

FUNCTION 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 M
END FUNCTION

FUNCTION IN& (x AS INTEGER, y AS INTEGER) 'for 256 color only! (in 32 bites you read not ONE, but FOUR BYTES)
    IN& = (y * _WIDTH) + x
END FUNCTION

FUNCTION 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


Coding is relax (At least sometimes)

Offline bplus

  • B = B + geberation
Re: Collision Detection
« Reply #5 on: June 10, 2018, 12:13:26 PM »
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 / images

SCREEN _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 first
box1Width = 400 '<<< mod add this instead of  calculation of box1Right
box1Height = 100 '<<< mod add this instead of calculation of box1Bottom
'now center box
box1Left = 400 - box1Width / 2 'same as box1X
'box1Right = 370 '100 width
box1Top = 300 - box1Height / 2 'same as box1Y
' box1Bottom = 290 '100 height

mouseboxWidth = 50 '<<< mod add these constants
mouseboxHeight = 40 '<<< mod add these constants

f& = _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 fan
LOOP 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
'RETURN

FUNCTION 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 IF
END FUNCTION

« Last Edit: June 10, 2018, 12:23:04 PM by bplus »
B = B + ...

Offline johnno56

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

Offline bplus

  • B = B + geberation
Re: Collision Detection
« Reply #7 on: June 10, 2018, 09: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 + ...

Offline johnno56

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

Re: Collision Detection
« Reply #9 on: June 11, 2018, 04: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 INTEGER
END TYPE

imag& = _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 outputs
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.

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 image
B_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 borders
FOR T = LBOUND(s) TO UBOUND(s)
    PSET (S(T).X, S(T).Y)
NEXT
LOCATE 22, 1: PRINT "press key"
SLEEP
PRINT "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"
SLEEP
CLS '                                                                      and here is time to try it in program :-D

TYPE 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 DOUBLE
END TYPE
CONST part = 100 '                                                       total particles for snow in use is 100
DIM SHARED particles(part) AS par

_PUTIMAGE (300, 200), image& '                                           set transparent picture to screen
PCOPY _DISPLAY, 1
DIM O AS _MEM
O = _MEMIMAGE(0) '                                                       O is pointer to memory area, where current screen (0) placed
wht& = _RGB32(255, 255, 255) '                                           white color
blk& = _RGB32(0, 0, 0) '                                                 black color
DO

    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
    NEXT
LOOP UNTIL _KEYHIT = 27


FUNCTION 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 values
END FUNCTION




SUB 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
    RETURN
END SUB

FUNCTION IN& (x AS INTEGER, y AS INTEGER)
    IN& = _PIXELSIZE(_SOURCE) * ((_WIDTH * y) + x) '                                                  function return offset for MEM functions. Copyed from Steve McNeill
END FUNCTION

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
    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 FUNCTION



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
    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 M
END SUB

use attached picture, function filter& is set for this image (source code line 13)
Coding is relax (At least sometimes)

Offline johnno56

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

J
Logic is the beginning of wisdom.

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

Re: Collision Detection
« Reply #12 on: June 13, 2018, 10: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.
Coding is relax (At least sometimes)

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

Offline Unseen Machine

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