Author Topic: Function for detecting if point is in line  (Read 202 times)

Petr

  • Sr. Member
  • ****
  • Posts: 380
Function for detecting if point is in line
« on: September 12, 2017, 12:42:13 pm »
Hi. I write something and then is comming this problem. How detect points in line? I write this function. Return 1 if point is in line or 0 if point is not in line.  Detect density is set to 0.01, you can rewrite it.

Code: [Select]
'colission detection INLINE
SCREEN _NEWIMAGE(640, 480, 256)

LINE (100, 100)-(300, 153), 15


'use: CDL (Colission Detection in Line)    (tested point (if is in line) X, tested point Y, Start line X, Start line Y, End line X, End line Y. Uses vectors, BUT MATH is not my hobby!

DO WHILE _KEYHIT <> 27
    LOCATE 1, 1: PRINT CDL(x, y, 100, 100, 300, 153)
    DO WHILE _MOUSEINPUT
        x = _MOUSEX
        y = _MOUSEY
    LOOP
LOOP




FUNCTION CDL (testX, testY, SourceX1, SourceY1, SourceX2, SourceY2)
    VectorX = SourceX2 - SourceX1
    VectorY = SourceY2 - SourceY1
    ta = (-testX + SourceX1) / -VectorX
    tb = (-testY + SourceY1) / -VectorY

    PRINT CSNG(ta), CSNG(tb)
    IF testX > SourceX1 AND testX < SourceX2 AND testY > SourceY1 AND testY < SourceY2 AND ABS(ta - tb) < .01 OR testX > SourceX1 AND testX < SourceX2 AND testY > SourceY1 AND testY < SourceY2 AND ABS(tb - ta) < .01 THEN CDL = 1 ELSE CDL = 0
    'detection range is here set to 0.01 from line. Rewrite this yourself for density setting.

END FUNCTION


this is upgraded version, works in all range (it does not matter if the starting coordinates are lower than the final coordinates)


Code: [Select]
FUNCTION CDL (testX, testY, SourceX1, SourceY1, SourceX2, SourceY2)
'IF SourceX1 = SourceX2 OR SourceY1 = SourceY2 THEN BEEP: PRINT "Invalid values. Source X1 and X2 or Source Y1 and Y2 can not be the same value. ": EXIT SUB
sen = 0.02
VectorX = SourceX2 - SourceX1
VectorY = SourceY2 - SourceY1
ta = (-testX + SourceX1) / -VectorX
tb = (-testY + SourceY1) / -VectorY
IF SourceX1 >= SourceX2 AND SourceY1 >= SourceY2 OR SourceX1 < SourceX2 AND SourceY1 < SourceY2 THEN
    IF testX >= SourceX1 AND testX <= SourceX2 AND testY >= SourceY1 AND testY <= SourceY2 AND ABS(ta - tb) < sen OR testX >= SourceX1 AND testX <= SourceX2 AND testY >= SourceY1 AND testY <= SourceY2 AND ABS(tb - ta) < sen THEN CDL = 1 ELSE CDL = 0
END IF
IF SourceX1 < SourceX2 AND SourceY1 > SourceY2 THEN
    IF testX >= SourceX1 AND testX <= SourceX2 AND testY >= SourceY2 AND testY <= SourceY1 AND ABS(ta - tb) < sen OR testX >= SourceX1 AND testX <= SourceX2 AND testY >= SourceY2 AND testY <= SourceY1 AND ABS(tb - ta) < sen THEN CDL = 1 ELSE CDL = 0
END IF
IF SourceX1 > SourceX2 AND SourceY1 < SourceY2 THEN
    IF testX >= SourceX2 AND testX <= SourceX1 AND testY >= SourceY1 AND testY <= SourceY2 AND ABS(ta - tb) < sen OR testX >= SourceX2 AND testX <= SourceX1 AND testY >= SourceY1 AND testY <= SourceY2 AND ABS(tb - ta) < sen THEN CDL = 1 ELSE CDL = 0
END IF
END FUNCTION


« Last Edit: September 13, 2017, 11:28:37 am by Petr »
Coding is relax.

bplus

  • Jr. Member
  • **
  • Posts: 94
  • B = B + _
Re: Function for detecting if point is in line
« Reply #1 on: September 13, 2017, 01:24:12 pm »
Hi Petr,

I had fun with this, detecting when a ball hits a line but does not work when radius = 0
Code: [Select]
'Rain Drain.bas started 2017-09-13
'translated from
'Rain Drain.bas  SmallBASIC 0.12.9 [B+=MGA] 2017-04-26

_DEFINE A-Z AS SINGLE
RANDOMIZE TIMER
CONST xmax = 1100
CONST ymax = 700

SCREEN _NEWIMAGE(xmax, ymax, 32)
_TITLE "Rain Drain by bplus,    spacebar for new arrangement,    esc to quit"

TYPE ball
    x AS INTEGER
    y AS INTEGER
    speed AS INTEGER
    r AS INTEGER
    c AS LONG
END TYPE

TYPE bLine
    x1 AS INTEGER
    y1 AS INTEGER
    x2 AS INTEGER
    y2 AS INTEGER
    a AS DOUBLE
END TYPE

WHILE 1
    balls = 150
    REDIM b(balls) AS ball
    FOR i = 1 TO balls
        b(i).x = rand%(0, xmax)
        b(i).y = rand%(0, ymax)
        b(i).speed = 1
        b(i).r = rand%(1, 6)
        b(i).c = _RGB(0, rand%(200, 255), rand%(200, 255))
    NEXT

    m = 10
    nbl = 25
    REDIM bl(nbl) AS bLine
    FOR i = 1 TO nbl
        d = rand%(50, 200)
        bl(i).x1 = rand%(m, xmax - d - m)
        bl(i).y1 = i * ymax / nbl - 10
        bl(i).a = RND * _PI(1 / 32) - _PI(1 / 64)
        bl(i).x2 = bl(i).x1 + d * COS(bl(i).a)
        bl(i).y2 = bl(i).y1 + d * SIN(bl(i).a)
    NEXT

    WHILE 1
        CLS
        IF 32 = _KEYHIT THEN
            EXIT WHILE
        ELSEIF 27 = _KEYHIT THEN
            END
        END IF
        FOR j = 1 TO balls
            IF b(j).y - b(j).r > ymax OR b(j).x + b(j).r < 0 OR b(j).x - b(j).r > xmax THEN
                b(j).x = rand%(0, xmax): b(j).y = 0
            END IF
            COLOR b(j).c
            fcirc b(j).x, b(j).y, b(j).r
            testx = b(j).x + b(j).speed * COS(_PI(.5))
            testy = b(j).y + b(j).speed * SIN(_PI(.5))
            cFlag = 0
            FOR i = 1 TO nbl
                COLOR _RGB(255, 0, 0)
                lien bl(i).x1, bl(i).y1, bl(i).x2, bl(i).y2
                IF cFlag = 0 THEN
                    IF hitLine(testx, testy, b(j).r, bl(i).x1, bl(i).y1, bl(i).x2, bl(i).y2) THEN
                        bx1 = b(j).x + b(j).speed * COS(bl(i).a)
                        bx2 = b(j).x + b(j).speed * COS(_PI(1) - bl(i).a)
                        by1 = yy(bx1, bl(i).x1, bl(i).y1, bl(i).x2, bl(i).y2) - b(j).r - 1
                        by2 = yy(bx2, bl(i).x1, bl(i).y1, bl(i).x2, bl(i).y2) - b(j).r - 1
                        IF by1 = (-9999 - b(j).r - 1) OR by2 = (-9999 - b(j).r - 1) THEN
                            cFlag = 0: EXIT FOR
                        END IF
                        IF by1 >= by2 THEN b(j).y = by1: b(j).x = bx1 ELSE b(j).y = by2: b(j).x = bx2
                        cFlag = 1
                    END IF
                END IF
            NEXT
            IF cFlag = 0 THEN b(j).x = testx: b(j).y = testy
        NEXT
        _DISPLAY
    WEND
WEND

SUB lien (x1, y1, x2, y2)
    LINE (x1, y1)-(x2, y2)
END SUB

FUNCTION hitLine (x, y, r, xx1, yy1, xx2, yy2)
    x1 = xx1: y1 = yy1: x2 = xx2: y2 = yy2
    IF x1 > x2 THEN SWAP x1, x2: SWAP y1, y2
    IF x < x1 OR x > x2 THEN hitLine = 0: EXIT SUB
    IF ((y2 - y1) / (x2 - x1)) * (x - x1) + y1 - r < y AND y < ((y2 - y1) / (x2 - x1)) * (x - x1) + y1 + r THEN
        hitLine = 1
    ELSE
        hitLine = 0
    END IF
END FUNCTION

FUNCTION yy (x, xx1, yy1, xx2, yy2)
    'copy parameters that are changed
    x1 = xx1: y1 = yy1: x2 = xx2: y2 = yy2
    IF x1 > x2 THEN SWAP x1, x2: SWAP y1, y2
    IF x1 <= x AND x <= x2 THEN
        yy = ((y2 - y1) / (x2 - x1)) * (x - x1) + y1
    ELSE
        yy = -9999
    END IF
END FUNCTION

FUNCTION rand% (lo%, hi%)
    rand% = (RND * (hi% - lo% + 1)) \ 1 + lo%
END FUNCTION

FUNCTION rdir% ()
    IF RND < .5 THEN rdir% = -1 ELSE rdir% = 1
END FUNCTION

'Steve McNeil's  copied from his forum   note: Radius is too common a name
SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
    DIM subRadius AS LONG, RadiusError AS LONG
    DIM X AS LONG, Y AS LONG

    subRadius = ABS(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0

    IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB

    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    LINE (CX - X, CY)-(CX + X, CY), , BF

    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
    WEND
END SUB


Mal-2

  • Jr. Member
  • **
  • Posts: 61
Re: Function for detecting if point is in line
« Reply #2 on: September 13, 2017, 02:06:29 pm »
Of course radius 0 does not work. It's like neutrinos rarely hitting anything -- the cross-section is too small, or zero in this case. Use of a tiny value much smaller than a pixel should be indistinguishable to an observer.
Please excuse my spaghetti code. Music is my real job, mal-2.bandcamp.com and whitemice.bandcamp.com (though I also write).
When Chuck Norris throws an exception, it is always fatal.

codeguy

  • Hero Member
  • *****
  • Posts: 3945
  • what the h3ll did i name that code?
    • stuff at dkm
Re: Function for detecting if point is in line
« Reply #3 on: September 13, 2017, 10:52:39 pm »
That was a fun demo of mal-2's algorithm, bplus.

Petr

  • Sr. Member
  • ****
  • Posts: 380
Re: Function for detecting if point is in line
« Reply #4 on: September 14, 2017, 12:44:25 am »
Codeguy and Mal 2 - Mal 2 you are writing the same alghoritm?

Bplus - Nice demo!  ;D
Coding is relax.

Ashish

  • Sr. Member
  • ****
  • Posts: 478
  • Eat.... Sleep.... CODE.... Repeat.....
Re: Function for detecting if point is in line
« Reply #5 on: September 14, 2017, 04:38:10 am »
Nice work. :)
if (Me.Success) {Me.Improve();} else {Me.TryAgain();}

aKFrameWork - http://bit.ly/aKFrameWork
p5js.bas - http://bit.ly/p5jsbas
Menu System - http://bit.ly/guiMenuBar

OpenGL Demos - http://bit.ly/openGLdemos

bplus

  • Jr. Member
  • **
  • Posts: 94
  • B = B + _
Re: Function for detecting if point is in line
« Reply #6 on: September 14, 2017, 09:18:01 am »
Hi all,

I have played around with numbers in my demo and found that you could make r as small as you like (withing range of single) and as long as you keep the speed 1 smidgen smaller the balls will be stopped on the lines, otherwise you would get the Neutrino effect.

In the other direction, I increased the radius to ridiculous amounts and saw balls climbing lines  close together (even though they are supposed to be falling) AND ball Attractors, loops that eat up all the balls and stop them from recirculating, radius = 50 +

Petr

  • Sr. Member
  • ****
  • Posts: 380
Re: Function for detecting if point is in line
« Reply #7 on: September 14, 2017, 01:11:27 pm »
 ;D Bplus, i write program that use my function. And because programming muss be relax, i write this so, as it is. IS  NOT only collision detect.... :-D

Code: [Select]
W = 800
H = 600
SCREEN _NEWIMAGE(W, H, 256)

TYPE lines
    x AS SINGLE
    y AS SINGLE
    x2 AS SINGLE
    y2 AS SINGLE
    mX AS _BYTE
    mY AS _BYTE
    color AS _BYTE
END TYPE
DIM lines(15) AS lines
DIM Q(15) AS lines
mX = 1
mY = 1
FOR lineGenerator = 1 TO 15
    X = RND * W
    Y = RND * H
    SizeX = RND * 70
    SizeY = RND * 85
    lines(lineGenerator).mX = 1
    lines(lineGenerator).mY = 1
    lines(lineGenerator).x = X
    lines(lineGenerator).y = Y
    lines(lineGenerator).x2 = X + SizeX
    lines(lineGenerator).y2 = Y + SizeY
    r: colorRND = RND * 255: IF colorRND < 70 OR colorRND > 150 THEN GOTO r
    lines(lineGenerator).color = colorRND
    Q(lineGenerator).x = 1 + RND * W
    Q(lineGenerator).y = 1 + RND * H
    Qsix = RND * 25
    Qsiy = RND * 20 + 1
    Q(lineGenerator).x2 = Q(lineGenerator).x + Qsix
    Q(lineGenerator).y2 = Q(lineGenerator).y + Qsiy
    Q(lineGenerator).color = RND * 255
    Q(lineGenerator).mX = 1
    Q(lineGenerator).mY = 1
    LINE (X, Y)-(X + SizeX, Y + SizeY), lines(lineGenerator).color
NEXT
lim = 25
starttime = TIMER
PCOPY _DISPLAY, 1
DO WHILE _KEYHIT <> 27
    _LIMIT lim


    PCOPY 1, _DISPLAY
    FOR L = 1 TO 15
        FOR M = 1 TO 15
            TX1 = CDL(Q(L).x, Q(L).y, lines(M).x, lines(M).y, lines(M).x2, lines(M).y2)
            TX2 = CDL(Q(L).x2, Q(L).y2, lines(M).x, lines(M).y, lines(M).x2, lines(M).y2)
            TX3 = CDL(Q(L).x2, Q(L).y, lines(M).x, lines(M).y, lines(M).x2, lines(M).y2)
            TX4 = CDL(Q(L).x, Q(L).y2, lines(M).x, lines(M).y, lines(M).x2, lines(M).y2)
            IF TX1 = 1 OR TX2 = 1 OR TX3 = 1 OR TX4 = 1 THEN Q(L).mX = Q(L).mX * -1: Q(L).mY = Q(L).mY * -1: SOUND 300, .1

            DO WHILE _MOUSEINPUT
                moX = _MOUSEX: moY = _MOUSEY: Bu1 = _MOUSEBUTTON(1)
            LOOP
            endtime = TIMER - starttime
            IF moX > Q(M).x AND moX < Q(M).x2 AND moY > Q(M).y AND moY < Q(M).y2 AND Q(M).color <> 0 AND Bu1 = -1 THEN
                SOUND 750, .1: Bu1 = 0
                Q(M).color = 0: Q(M).mX = 0: Q(M).mY = 0
                lim = lim + 20: died = died + 1

            END IF

        NEXT M
        IF Q(L).x > W - 1 OR Q(L).x < 1 THEN Q(L).mX = Q(L).mX * -1: SOUND 255, .1: IF Q(L).mX > 0 THEN Q(L).mX = Q(L).mX + (RND / 10) ELSE Q(L).mX = Q(L).mX - (RND / 10)
        IF Q(L).y > H OR Q(L).y < 1 THEN Q(L).mY = Q(L).mY * -1: SOUND 655, .1: IF Q(L).mY > 0 THEN Q(L).mY = Q(L).mY + (RND / 10) ELSE Q(L).mY = Q(L).mY - (RND / 10)
        Q(L).x = Q(L).x + Q(L).mX: Q(L).y = Q(L).y + Q(L).mY: Q(L).x2 = Q(L).x2 + Q(L).mX: Q(L).y2 = Q(L).y2 + Q(L).mY
        LINE (SIN(rot) * 10 + Q(L).x, COS(rot) * 10 + Q(L).y)-(SIN(rot) * 1 + Q(L).x2, COS(rot) * 5 + RND + Q(L).y2), Q(L).color, BF
        rot = rot + .01
        LOCATE 1, 1: PRINT "Died: "; died; " / 15"; TAB(40); "Time: "; endtime
    NEXT L
    '                                                         80: 10 chars to left. One character = 8 x 16 pixels.
    IF died = 15 THEN CLS: COLOR 125: _PRINTSTRING ((W / 2) - 80 - (8 * LEN(STR$(endtime))), H / 2), "Game over. Your time: " + STR$(endtime): END
    _DISPLAY

LOOP
FUNCTION CDL (testX, testY, SourceX1, SourceY1, SourceX2, SourceY2)
IF SourceX1 = SourceX2 OR SourceY1 = SourceY2 THEN BEEP: PRINT "Invalid values. Source X1 and X2 or Source Y1 and Y2 can not be the same value. ": EXIT SUB
sen = 0.25
VectorX = SourceX2 - SourceX1
VectorY = SourceY2 - SourceY1
ta = (-testX + SourceX1) / -VectorX
tb = (-testY + SourceY1) / -VectorY
IF SourceX1 >= SourceX2 AND SourceY1 >= SourceY2 OR SourceX1 < SourceX2 AND SourceY1 < SourceY2 THEN
    IF testX >= SourceX1 AND testX <= SourceX2 AND testY >= SourceY1 AND testY <= SourceY2 AND ABS(ta - tb) < sen OR testX >= SourceX1 AND testX <= SourceX2 AND testY >= SourceY1 AND testY <= SourceY2 AND ABS(tb - ta) < sen THEN CDL = 1 ELSE CDL = 0
END IF
IF SourceX1 < SourceX2 AND SourceY1 > SourceY2 THEN
    IF testX >= SourceX1 AND testX <= SourceX2 AND testY >= SourceY2 AND testY <= SourceY1 AND ABS(ta - tb) < sen OR testX >= SourceX1 AND testX <= SourceX2 AND testY >= SourceY2 AND testY <= SourceY1 AND ABS(tb - ta) < sen THEN CDL = 1 ELSE CDL = 0
END IF
IF SourceX1 > SourceX2 AND SourceY1 < SourceY2 THEN
    IF testX >= SourceX2 AND testX <= SourceX1 AND testY >= SourceY1 AND testY <= SourceY2 AND ABS(ta - tb) < sen OR testX >= SourceX2 AND testX <= SourceX1 AND testY >= SourceY1 AND testY <= SourceY2 AND ABS(tb - ta) < sen THEN CDL = 1 ELSE CDL = 0
END IF
END FUNCTION


Coding is relax.

bplus

  • Jr. Member
  • **
  • Posts: 94
  • B = B + _
Re: Function for detecting if point is in line
« Reply #8 on: September 14, 2017, 01:20:50 pm »
Hey Petr,

Are you from the Beat Generation?  :D

I am reminded of bongos.

Petr

  • Sr. Member
  • ****
  • Posts: 380
Re: Function for detecting if point is in line
« Reply #9 on: September 14, 2017, 01:38:17 pm »
Hello. Yeah, I love these games. Like here: https://www.youtube.com/watch?v=D-THUXZ1aE4
Coding is relax.

Petr

  • Sr. Member
  • ****
  • Posts: 380
Re: Function for detecting if point is in line
« Reply #10 on: September 15, 2017, 05:39:15 am »
Upgraded previous code - in this time also boxes detecting own vertexes. + new sound  ;D

Code: [Select]
W = 800
H = 600
SCREEN _NEWIMAGE(W, H, 256)

TYPE lines
    x AS SINGLE
    y AS SINGLE
    x2 AS SINGLE
    y2 AS SINGLE
    mX AS _BYTE
    mY AS _BYTE
    color AS _BYTE
    li AS _BYTE
END TYPE
DIM lines(15) AS lines
DIM Q(15) AS lines
mX = 1
mY = 1
FOR lineGenerator = 1 TO 15
    X = RND * W
    Y = RND * H
    SizeX = RND * 70
    SizeY = RND * 85
    lines(lineGenerator).mX = 1
    lines(lineGenerator).mY = 1
    lines(lineGenerator).x = X
    lines(lineGenerator).y = Y
    lines(lineGenerator).x2 = X + SizeX
    lines(lineGenerator).y2 = Y + SizeY
    r: colorRND = RND * 255: IF colorRND < 70 OR colorRND > 150 THEN GOTO r
    lines(lineGenerator).color = colorRND
    Q(lineGenerator).x = 1 + RND * W
    Q(lineGenerator).y = 1 + RND * H
    Qsix = RND * 25
    Qsiy = RND * 20 + 1
    Q(lineGenerator).x2 = Q(lineGenerator).x + Qsix
    Q(lineGenerator).y2 = Q(lineGenerator).y + Qsiy
    Q(lineGenerator).color = RND * 255
    Q(lineGenerator).mX = 1
    Q(lineGenerator).mY = 1
    LINE (X, Y)-(X + SizeX, Y + SizeY), lines(lineGenerator).color
NEXT
lim = 25
starttime = TIMER
PCOPY _DISPLAY, 1
DO WHILE _KEYHIT <> 27
    _LIMIT lim


    PCOPY 1, _DISPLAY
    FOR L = 1 TO 15
        FOR M = 1 TO 15
            TX1 = CDL(Q(L).x, Q(L).y, lines(M).x, lines(M).y, lines(M).x2, lines(M).y2)
            TX2 = CDL(Q(L).x2, Q(L).y2, lines(M).x, lines(M).y, lines(M).x2, lines(M).y2)
            TX3 = CDL(Q(L).x2, Q(L).y, lines(M).x, lines(M).y, lines(M).x2, lines(M).y2)
            TX4 = CDL(Q(L).x, Q(L).y2, lines(M).x, lines(M).y, lines(M).x2, lines(M).y2)
            IF TX1 = 1 OR TX2 = 1 OR TX3 = 1 OR TX4 = 1 THEN Q(L).mX = Q(L).mX * -1: Q(L).mY = Q(L).mY * -1: SOUND 300, .1

            DO WHILE _MOUSEINPUT
                moX = _MOUSEX: moY = _MOUSEY: Bu1 = _MOUSEBUTTON(1)
            LOOP
            endtime = TIMER - starttime
            IF moX > Q(M).x AND moX < Q(M).x2 AND moY > Q(M).y AND moY < Q(M).y2 AND Q(M).color <> 0 AND Bu1 = -1 THEN
                PLAY "a33f22c18e55g43": Bu1 = 0
                d& = die&(Q(M).x, Q(M).y, Q(M).x2, Q(M).y2)
                Q(M).color = 0: Q(M).mX = 0: Q(M).mY = 0
                PCOPY 1, _DISPLAY
                _PUTIMAGE (Q(M).x, Q(M).y), d&, 0
                PCOPY _DISPLAY, 1
                _FREEIMAGE d&
                Q(M).li = 1
                lim = lim + 20: died = died + 1

            END IF

        NEXT M
        IF Q(L).x > W - 1 OR Q(L).x < 1 THEN Q(L).mX = Q(L).mX * -1: SOUND 255, .1: IF Q(L).mX > 0 THEN Q(L).mX = Q(L).mX + (RND / 10) ELSE Q(L).mX = Q(L).mX - (RND / 10)
        IF Q(L).y > H OR Q(L).y < 1 THEN Q(L).mY = Q(L).mY * -1: SOUND 655, .1: IF Q(L).mY > 0 THEN Q(L).mY = Q(L).mY + (RND / 10) ELSE Q(L).mY = Q(L).mY - (RND / 10)
        Q(L).x = Q(L).x + Q(L).mX: Q(L).y = Q(L).y + Q(L).mY: Q(L).x2 = Q(L).x2 + Q(L).mX: Q(L).y2 = Q(L).y2 + Q(L).mY



        Xv1 = SIN(rot) * 10 + Q(L).x: Yv1 = COS(rot) * 10 + Q(L).y: Xv2 = SIN(rot) * 1 + Q(L).x2: Yv2 = COS(rot) * 5 + RND + Q(L).y2
        IF Q(L).li = 0 THEN LINE (Xv1, Yv1)-(Xv2, Yv2), Q(L).color, BF
        FOR mezi = 1 TO 15
            IF mezi <> L THEN
                Pa = CDL(Q(L).x, Q(L).y, Q(mezi).x, Q(mezi).y, Q(mezi).x2, Q(mezi).y2)
                Pb = CDL(Q(L).x2, Q(L).y, Q(mezi).x, Q(mezi).y, Q(mezi).x2, Q(mezi).y2)
                Pc = CDL(Q(L).x, Q(L).y2, Q(mezi).x, Q(mezi).y, Q(mezi).x2, Q(mezi).y2)
                Pd = CDL(Q(L).x2, Q(L).y2, Q(mezi).x, Q(mezi).y, Q(mezi).x2, Q(mezi).y2)
                IF Pa = 1 OR Pb = 1 OR Pc = 1 OR Pd = 1 THEN Q(L).mX = Q(L).mX * -.9: Q(L).mY = Q(L).mY * -.9: SOUND 500, .1
            END IF
        NEXT mezi

        rot = rot + .01
        LOCATE 1, 1: PRINT "Died: "; died; " / 15"; TAB(40); "Time: "; endtime
    NEXT L

    IF died = 15 THEN
        CLS
        FOR a = 90 TO 300
            SOUND a, .1
            SOUND 8 * a, .1
        NEXT a
        FOR a = 300 TO 90 STEP -1
            SOUND a, .1
            SOUND 8 * a, .1
        NEXT a
        COLOR 125: _PRINTSTRING ((W / 2) - 80 - (8 * LEN(STR$(endtime))), H / 2), "Game over. Your time: " + STR$(endtime): END
    END IF
    _DISPLAY

LOOP






FUNCTION CDL (testX, testY, SourceX1, SourceY1, SourceX2, SourceY2)
IF SourceX1 = SourceX2 OR SourceY1 = SourceY2 THEN BEEP: PRINT "Invalid values. Source X1 and X2 or Source Y1 and Y2 can not be the same value. ": EXIT SUB
sen = 0.25
VectorX = SourceX2 - SourceX1
VectorY = SourceY2 - SourceY1
ta = (-testX + SourceX1) / -VectorX
tb = (-testY + SourceY1) / -VectorY
IF SourceX1 >= SourceX2 AND SourceY1 >= SourceY2 OR SourceX1 < SourceX2 AND SourceY1 < SourceY2 THEN
    IF testX >= SourceX1 AND testX <= SourceX2 AND testY >= SourceY1 AND testY <= SourceY2 AND ABS(ta - tb) < sen OR testX >= SourceX1 AND testX <= SourceX2 AND testY >= SourceY1 AND testY <= SourceY2 AND ABS(tb - ta) < sen THEN CDL = 1 ELSE CDL = 0
END IF
IF SourceX1 < SourceX2 AND SourceY1 > SourceY2 THEN
    IF testX >= SourceX1 AND testX <= SourceX2 AND testY >= SourceY2 AND testY <= SourceY1 AND ABS(ta - tb) < sen OR testX >= SourceX1 AND testX <= SourceX2 AND testY >= SourceY2 AND testY <= SourceY1 AND ABS(tb - ta) < sen THEN CDL = 1 ELSE CDL = 0
END IF
IF SourceX1 > SourceX2 AND SourceY1 < SourceY2 THEN
    IF testX >= SourceX2 AND testX <= SourceX1 AND testY >= SourceY1 AND testY <= SourceY2 AND ABS(ta - tb) < sen OR testX >= SourceX2 AND testX <= SourceX1 AND testY >= SourceY1 AND testY <= SourceY2 AND ABS(tb - ta) < sen THEN CDL = 1 ELSE CDL = 0
END IF
END FUNCTION


FUNCTION die& (x AS SINGLE, y AS SINGLE, x2 AS SINGLE, y2 AS SINGLE)
IF x2 < x THEN SWAP x2, x
IF y2 < y THEN SWAP y2, y
die& = _NEWIMAGE(x2 - x, y2 - y, 256)
FOR xd = 0 TO x2 - x
    FOR yd = 0 TO y2 - y
        _DEST die&
        LINE (xd, yd)-(xd + 1, yd + 1), 255 - (xd * yd), B
NEXT yd, xd
_DEST 0
END FUNCTION


Coding is relax.

Mal-2

  • Jr. Member
  • **
  • Posts: 61
Re: Function for detecting if point is in line
« Reply #11 on: September 15, 2017, 06:48:00 am »
Codeguy and Mal 2 - Mal 2 you are writing the same alghoritm?

Bplus - Nice demo!  ;D

Yeah, I don't know why I'm being credited for writing anything because I haven't. I only commented on the fact that a collision cross-section of 0 is going to have major problems (it would have to be exactly dead-on to register as a collision, and floating point is almost never exactly dead-on) while a small but distinctly non-zero value will "quantum tunnel" far less frequently. Bump the radius up until the tunneling goes away consistently, but not so high that the user can tell that objects aren't actually touching when they react.

It's a philosophy based on real-universe physics, which with a little work could be converted to an algorithm, but it isn't one yet.
Please excuse my spaghetti code. Music is my real job, mal-2.bandcamp.com and whitemice.bandcamp.com (though I also write).
When Chuck Norris throws an exception, it is always fatal.

bplus

  • Jr. Member
  • **
  • Posts: 94
  • B = B + _
Re: Function for detecting if point is in line
« Reply #12 on: September 17, 2017, 02:26:04 pm »
...

SMcNeill

  • Moderator
  • Hero Member
  • *****
  • Posts: 6071
Re: Function for detecting if point is in line
« Reply #13 on: September 17, 2017, 03:12:47 pm »
Codeguy and Mal 2 - Mal 2 you are writing the same alghoritm?

Bplus - Nice demo!  ;D

Yeah, I don't know why I'm being credited for writing anything because I haven't. I only commented on the fact that a collision cross-section of 0 is going to have major problems (it would have to be exactly dead-on to register as a collision, and floating point is almost never exactly dead-on) while a small but distinctly non-zero value will "quantum tunnel" far less frequently. Bump the radius up until the tunneling goes away consistently, but not so high that the user can tell that objects aren't actually touching when they react.

It's a philosophy based on real-universe physics, which with a little work could be converted to an algorithm, but it isn't one yet.

Only thing is, screen coordinates are integer values, not floating points.  Just try and PSET(100.2, 67.7) and see what happens.   I don't think you have to worry about collisions falling through the fractions and being lost.  ;)

Where an issue might arise with 0-radius (single point pixel) detection is with diagonal lines.

..../
.../.
../..
./...
/....

Like in the above,  if a ball goes from (1,4) to (2,5), there's no collision.  It moved the diagional and avoided the pixels where the line is drawn.

Solution here is to check (radius + 1) for collision, or else make all lines more than a single pixel wide.

...//
..//.
.//..
//...
/....

Double wide line here makes it impossible for single pixel "balls" to avoid collision, no matter which direction they're traveling from.  ;)
« Last Edit: September 17, 2017, 03:23:37 pm by SMcNeill »
http://bit.ly/TextImage -- Library of QB64 code to manipulate text and images, as a BM library.

http://bit.ly/Color32 -- A set of color CONST for use in 32 bit mode, as a BI library.