A DKM dynamic logo using CodeGuy NSpace collision detection

[codeguy]

NSpace is a pretty good collision detection algorithm.

Code: [Select]

'* nspace5.bas
'$checking: off
CONST NXDivs% = 16
CONST NYDivs% = 16
CONST NZDivs% = 16
CONST ubst% = 2519
CONST NDimensions% = 2
CONST MaxObjectRadius% = 3
MaxFPS% = 64
DIM SHARED MinScreenX%, MaxScreenX%, MinScreenY%, MaxScreenY%, NxDivSize%, NyDivSize%
DIM SHARED cstart AS SINGLE, cend AS SINGLE, minx, maxx, miny, maxy
cstart = 0: cend = 6.2
REDIM SHARED PolysInRegion%(NXDivs%, NYDivs%, 0), counts%(NXDivs%, NYDivs%), MaxPolys%
REDIM SHARED SinTable!(0 TO ubst%), CosTable!(0 TO ubst%), PolysInRegion%(NXDivs%, NYDivs%, 0)
'***********
DIM SHARED text$
text$ = "     D.K.M  Productions"

DIM SHARED word(1 TO LEN(text$) * 8, 1 TO 16)

FOR i& = 0 TO ubst%
    SinTable!(i&) = SIN(2 * i& * 3.1415926535 / (ubst% + 1))
    CosTable!(i&) = COS(2 * i& * 3.1415926535 / (ubst% + 1))
NEXT
oscreen& = _SCREENIMAGE
MaxScreenX% = _WIDTH(oscreen&) / 2
MaxScreenY% = _HEIGHT(oscreen&) / 2
MaxScreenZ% = 0
_FREEIMAGE oscreen&
MinScreenX% = 0
MinScreenY% = 0
MinScreenZ% = 0
ModNxDivsSx% = (MaxScreenX% - MinScreenX%) MOD NXDivs%
ModNyDivsSy% = (MaxScreenY% - MinScreenY%) MOD NYDivs%
ModNzDivsSz% = (MaxScreenZ% - MinScreenZ%) MOD NZDivs%
NxDivSize% = ((MaxScreenX% - MinScreenX%) - ModNxDivSx%) / NXDivs%
NyDivSize% = ((MaxScreenY% - MinScreenY%) - ModNyDivSy%) / NYDivs%
NzDivSize% = ((MaxScreenZ% - MinScreenZ%) - ModNzDivSz%) / NZDivs%

TYPE Polygons
    x AS SINGLE
    y AS SINGLE
    z AS SINGLE
    mass AS SINGLE
    radius AS INTEGER
    speedx AS SINGLE
    speedy AS SINGLE
    speedz AS SINGLE
    COLOR AS INTEGER
    'mass AS SINGLE
    nsides AS INTEGER
    radius2 AS SINGLE
END TYPE
REDIM b(0 TO 1) AS Polygons
MaxPolys% = 127
DIM SHARED Polys(0 TO MaxPolys%) AS Polygons
SepX% = (MaxScreenX% - MinScreenX%) / (2 * MaxObjectRadius%)
accum% = MaxObjectRadius%
x% = MaxObjectRadius%
y% = MaxObjectRadius%
FOR i% = LBOUND(Polys) TO UBOUND(Polys)
    Polys(i%).nsides = SetRand(3, 5)
    Polys(i%).radius = MaxObjectRadius% '* SetRand%(0, MaxObjectRadius%)
    Polys(i%).x = x% '* SetRand(MinScreenX% + Polys(i%).radius, MaxScreenX% - Polys(i%).radius)
    Polys(i%).speedx = SetRand(0, MaxObjectRadius% / 2)
    Polys(i%).y = y% '* SetRand(MinScreenY% + Polys(i%).radius, MaxScreenY% - Polys(i%).radius)
    Polys(i%).z = SetRand(MinScreenZ% + Polys(i%).radius, MaxScreenZ% - Polys(i%).radius)
    Polys(i%).speedy = SetRand(0, MaxObjectRadius% / 2)
    Polys(i%).speedz = SetRand(0, MaxObjectRadius% / 2)
    Polys(i%).COLOR = SetRand(43, 127)
    Polys(i%).mass = Polys(i%).nsides \ 2 + 1
    IF x% > MaxScreenX% - MaxObjectRadius% THEN
        y% = y% + 2 * MaxObjectRadius%
        x% = MaxObjectRadius%
    ELSE
        x% = x% + 2 * MaxObjectRadius%
    END IF
    Polys(i%).radius2 = Polys(i%).radius ^ 2
NEXT
DIM logo AS Polygons
logo.z = 0
logo.speedx = 0
logo.speedy = 0
logo.speedz = 0
logo.mass = 1
GameScreen& = _NEWIMAGE(MaxScreenX%, MaxScreenY%, 256)
dimensionFlags% = 1
TempX% = (NDimensions% - 1)
BitSet% = 1
WHILE TempX% > 0
    dimensionFlags% = dimensionFlags% OR 2 ^ BitSet%
    BitSet% = BitSet% + 1
    TempX% = TempX% \ 2
WEND
SCREEN GameScreen&
logo.x = _WIDTH / 2
logo.y = _HEIGHT / 2
LOCATE 2, 1: PRINT text$;
analyse
DO
    '_AUTODISPLAY
    IF _MOUSEINPUT THEN
        PlayerX% = _MOUSEX
        PlayerY% = _MOUSEY
        lmb% = _MOUSEBUTTON(1)
        rmb% = _MOUSEBUTTON(2)
    END IF
    '* check to see if objects collide with each other
    DIM row AS INTEGER, cnt AS INTEGER
    DIM xrot AS INTEGER, yrot AS INTEGER, scale AS INTEGER

    xrot = 6: yrot = 6: scale = 4

    OUT &H3C8, 1: OUT &H3C9, 10: OUT &H3C9, 20: OUT &H3C9, 63

    time! = TIMER
    DO
        CLS
        row = 2
        Ltime! = TIMER
        DO

            DO
                'LINE (minx, miny)-(max, maxy), 0, BF
                minx = 32767
                miny = 32767
                FOR i = cstart TO cend STEP .04

                    x = (scale * 60 - (row * xrot)) * (COS(i))
                    IF x < minx THEN
                        minx = x
                    END IF
                    IF x > maxx THEN
                        maxx = x
                    END IF
                    y = (scale * 60 - (row * yrot)) * (SIN(i))
                    IF y < miny THEN
                        miny = y
                    END IF
                    IF y > maxy THEN
                        maxy = y
                    END IF
                    cnt = cnt + 1

                    IF word(cnt, row) > 0 THEN

                        CIRCLE (x / 2 + _WIDTH / 2, y / 2 + _HEIGHT / 2), scale, 1
                        PAINT STEP(0, 0), 1, 1

                    END IF

                    IF cnt = LEN(text$) * 8 THEN cnt = 0: EXIT DO

                NEXT
            LOOP

            row = row + 1

        LOOP UNTIL row = 16

        cend = cend + .1
        cstart = cstart + .1
        IF ABS(maxx) > ABS(maxy) THEN
            logo.radius = ABS(maxx) / 2
        ELSE
            logo.radius = ABS(maxy) / 2
        END IF
        logo.mass = 1
        logo.radius2 = logo.radius ^ 2
        IF -1 THEN
            FOR i% = LBOUND(polys) TO UBOUND(polys)
                IF Collision%(logo, Polys(i%), dimensionFlags%) THEN
                    IF (logo.x = Polys(i%).x) THEN
                        logo.speedx = (logo.radius / (scale ^ 2))
                        logo.speedy = 1
                    ELSE
                        slope! = (logo.y - Polys(i%).y) / (logo.x - Polys(i%).x)
                        IF Polys(i%).y >= logo.y THEN '* either going N or E (270-90)
                            IF Polys(i%).x >= logo.x THEN 'going east
                                Theta! = slope! * 90
                            ELSE 'going north
                                Theta! = 270 + slope! * 90
                            END IF
                        ELSE
                            IF Polys(i%).x >= logo.x THEN
                                Theta! = 90 + slope! * 90
                            ELSE
                                Theta! = 180 + 90 * slope!
                            END IF
                        END IF
                        logo.speedx = logo.radius / (scale ^ 2) * COS(Theta! * 3.14159 / 180)
                        logo.speedy = logo.radius / (scale ^ 2) * SIN(Theta! * 3.14159 / 180)
                    END IF
                    b(0) = logo
                    b(1) = Polys(i%)
                    CalcVelocities b(), 0, 1, dimensionFlags%
                    Polys(i%) = b(1)
                    Position Polys(i%), dimensionFlags%
                    '* DrawPoly Polys(i%)
                ELSE
                    Position Polys(i%), dimensionFlags%
                    IF 0 THEN
                        IF Polys(i%).x < _WIDTH / 2 - maxx / 2 THEN
                            DrawPoly Polys(i%)
                            'PAINT (Polys(i%).x, Polys(i%).y), Polys(i%).color
                        ELSEIF Polys(i%).x > maxx / 2 + _WIDTH / 2 THEN
                            DrawPoly Polys(i%)
                            'PAINT (Polys(i%).x, Polys(i%).y), Polys(i%).color
                        ELSE
                            m% = (m% + 1) MOD 2
                            IF m% THEN
                                Polys(i%).x = _WIDTH / 2 - maxx / 2 - 1
                            ELSE
                                Polys(i%).x = maxx / 2 + _WIDTH / 2 + 1
                            END IF
                        END IF
                    ELSE
                        DrawPoly Polys(i%)
                    END IF
                    GetPossibleIndexes i%, Polys(i%).x, Polys(i%).y, Polys(i%).radius, MinScreenX%, MaxScreenX%, MinScreenY%, MaxScreenY%
                    'CollidedWithPlayer% = Collision%(PlayerX%, PlayerY%, 100, Polys(i%).x, Polys(i%).y, Polys(i%).radius)
                    'IF CollidedWithPlayer% THEN
                    'END IF
                END IF
            NEXT
        END IF
        FOR ax% = 0 TO NXDivs%
            FOR ay% = 0 TO NYDivs%
                FOR xj% = 0 TO counts%(ax%, ay%) - 1
                    p1% = PolysInRegion%(ax%, ay%, xj%)
                    FOR aj% = xj% + 1 TO counts%(ax%, ay%) - 1
                        p2% = PolysInRegion%(ax%, ay%, aj%)
                        IF Collision%(Polys(p1%), Polys(p2%), dimensionFlags%) THEN
                            CalcVelocities Polys(), p1%, p2%, dimensionFlags%
                        END IF
                    NEXT

                NEXT
                counts%(ax%, ay%) = 0
            NEXT
        NEXT
        REDIM PolysInRegion%(NXDivs%, NYDivs%, 0)
        Dtime! = ABS(TIMER - Ltime!)
        IF ABS(Dtime! - 1 / MaxFPS%) > .010 THEN
            MaxPolys% = MaxPolys% + 1
            REDIM _PRESERVE Polys(MaxPolys%) AS Polygons
            Polys(MaxPolys%).nsides = SetRand(3, 5)
            Polys(MaxPolys%).radius = MaxObjectRadius% '* SetRand%(0, MaxObjectRadius%)
            IF MaxPolys% MOD 2 THEN
                Polys(MaxPolys%).x = SetRand(MinScreenX% + Polys(i%).radius, MinScreenX% + Polys(i%).radius)
                Polys(MaxPolys%).y = SetRand(MinScreenY% + Polys(i%).radius, MinScreenY% + Polys(i%).radius)
            ELSE
                Polys(MaxPolys%).x = SetRand(MaxScreenX% - Polys(i%).radius, MaxScreenX% - Polys(i%).radius)
                Polys(MaxPolys%).y = SetRand(MaxScreenY% - Polys(i%).radius, MaxScreenY% - Polys(i%).radius)
            END IF
            Polys(MaxPolys%).speedx = SetRand(0, MaxObjectRadius% / 2)

            Polys(MaxPolys%).z = SetRand(MinScreenZ% + Polys(i%).radius, MaxScreenZ% - Polys(i%).radius)
            Polys(MaxPolys%).speedy = SetRand(0, MaxObjectRadius% / 2)
            Polys(MaxPolys%).speedz = SetRand(0, MaxObjectRadius% / 2)
            Polys(MaxPolys%).COLOR = SetRand(43, 127)
            Polys(MaxPolys%).mass = Polys(i%).nsides \ 2 + 1
            Polys(i%).radius2 = Polys(i%).radius ^ 2
        ELSEIF ABS(Dtime! - 1 / MaxFPS%) < .010 THEN
            MaxPolys% = MaxPolys% - 100
            REDIM _PRESERVE Polys(MaxPolys%) AS Polygons
        END IF
        _DISPLAY
        _LIMIT 20
    LOOP UNTIL ABS(TIMER - time!) > .15
LOOP UNTIL INKEY$ > "" OR rmb%
SYSTEM

SUB Position (P AS Polygons, flags%)
    IF flags% AND 4 THEN
        IF P.z + P.speedz < MinScreenZ% THEN
            P.speedz = -P.speedz
        ELSEIF P.z + P.speedz > MaxScreenZ% THEN
            P.speedz = -P.speedz
        END IF
        P.z = P.z + P.speedz
    END IF

    IF flags% AND 2 THEN
        IF P.y + P.speedy < MinScreenY% THEN
            P.speedy = -P.speedy
        ELSEIF P.y + P.speedy > MaxScreenY% THEN
            P.speedy = -P.speedy
        END IF
        P.y = P.y + P.speedy
    END IF

    IF flags% AND 1 THEN
        IF P.x + P.speedx < MinScreenX% THEN
            P.speedx = -P.speedx
        ELSEIF P.x + P.speedx > MaxScreenX% THEN
            P.speedx = -P.speedx
        END IF
        P.x = P.x + P.speedx
    END IF

END SUB

FUNCTION Collision% (T1 AS Polygons, t2 AS Polygons, flags%)
    IF (flags% AND 4) THEN
        dx! = (T1.x - t2.x) ^ 2
        dy! = (T1.y - t2.y) ^ 2
        IF dx! + dy! > (T1.radius2 + t2.radius2) THEN
            Collision% = 0
        ELSE
            IF ABS(T1.z - t2.z) > (T1.radius + t2.radius) THEN
                Collision% = 0
            ELSE
                Collision% = -1
            END IF
        END IF
        EXIT FUNCTION
    END IF
    IF (flags% AND 2) THEN
        dx! = (T1.x - t2.x) ^ 2
        dy! = (T1.y - t2.y) ^ 2
        IF dx! + dy! > (T1.radius2 + t2.radius2) THEN
            Collision% = 0
        ELSE
            Collision% = -1
        END IF
        EXIT FUNCTION
    END IF
    IF flags% AND 1 THEN
        IF ABS(T1.x - t2.x) > T1.radius + t2.radius THEN
            Collision% = 0
        ELSE
            Collision% = -1
        END IF
        EXIT FUNCTION
    END IF
END FUNCTION

FUNCTION SetRand% (MinValue%, MaxValue%)
    SetRand% = MinValue% + RND * (MaxValue% - MinValue%)
END FUNCTION

SUB GetPossibleIndexes (PolyNumber%, x%, y%, radius%, MinSX%, MaxSX%, MinSY%, MaxSY%)
    IF radius% > 0 THEN
        oldix% = -1
        oldiy% = -1
        FOR i% = -radius% TO radius% STEP radius%
            SELECT CASE x%
                CASE MinSX% + radius% TO MaxSX% - radius%
                    SELECT CASE y%
                        CASE MinSY% + radius% TO MaxSY% - radius%
                            ax% = (x% + i%) \ NxDivSize%
                            ay% = (y% + i%) \ NyDivSize%
                            IF ax% <> oldix% OR ay% <> oldiy% THEN
                                IF counts%(ax%, ay%) > UBOUND(PolysInRegion%, 3) THEN
                                    REDIM _PRESERVE PolysInRegion%(NXDivs%, NYDivs%, counts%(ax%, ay%))
                                END IF
                                PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
                                counts%(ax%, ay%) = counts%(ax%, ay%) + 1
                                oldix% = ax%
                                oldiy% = ay%
                            END IF
                    END SELECT
            END SELECT
        NEXT
    ELSE
        ax% = (x%) \ NxDivSize%
        ay% = (y%) \ NyDivSize%
        PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
        counts%(ax%, ay%) = counts%(ax%, ay%) + 1
    END IF
END SUB

SUB CalcVelocities (b() AS Polygons, i&, j&, flags%)
    IF flags% AND 1 THEN
        temp1 = b(i&).speedx
        temp2 = b(j&).speedx
        totalMass = (b(i&).mass + b(j&).mass)
        b(i&).speedx = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
        b(j&).speedx = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
    ELSE
        EXIT SUB
    END IF
    IF flags% AND 2 THEN
        temp1 = b(i&).speedy
        temp2 = b(j&).speedy
        b(i&).speedy = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
        b(j&).speedy = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
    ELSE
        EXIT SUB
    END IF
    IF flags% AND 4 THEN
        temp1 = b(i&).speedz
        temp2 = b(j&).speedz
        b(i&).speedz = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
        b(j&).speedz = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
    ELSE
        EXIT SUB
    END IF
END SUB

SUB DrawPoly (T AS Polygons)
    IF T.nsides > 0 THEN
        IF T.radius > 0 THEN
            CircleStepDeg% = (ubst% + 1) / T.nsides
            Newx = T.x + T.radius * CosTable!(0)
            Newy = T.y + T.radius * SinTable!(0)
            angle% = 0
            fpx = Newx
            fpy = Newy
            angle% = CircleStepDeg%
            DO
                IF angle% > ubst% THEN
                    LINE (fpx, fpy)-(Newx, Newy), T.COLOR
                    EXIT DO
                ELSE
                    lastx = Newx
                    lasty = Newy
                    Newx = T.x + T.radius * CosTable!(angle%)
                    Newy = T.y + T.radius * SinTable!(angle%)
                    LINE (lastx, lasty)-(Newx, Newy), T.COLOR
                    angle% = angle% + CircleStepDeg%
                END IF
            LOOP
        ELSE
            PSET (T.x, T.y), T.COLOR
        END IF
    ELSE
        PSET (T.x, T.y), T.COLOR
    END IF
END SUB

SUB analyse
    COLOR 2: LOCATE 1, 1: PRINT text$

    DIM px AS INTEGER, py AS INTEGER, cnt AS INTEGER, ltrcnt AS INTEGER

    px = 1: py = 1

    DO

        word(px, py) = POINT(px, py)

        PSET (px, py), 1
        px = px + 1

        IF px = LEN(text$) * 8 THEN

            px = 1
            py = py + 1

        END IF

    LOOP UNTIL py = 16

END SUB


[johnno56]

THAT is impressive! Do you have any plans for its use?

[codeguy]

Well, I'd sort of like seeing it immortalized in The Librarian's collection or even better, included as a sample in future QB64 releases. It was for entertainment and my entry in a contest for the DigitalKnifeMonkeys site where I explained and demonstrated my NSpace collision detection algorithm in great detail, but understandably. I will see if that site is still alive. I have several simpler versions and benchmarks for speed/efficiency. They are meant to be demos too. Read about NSpace here:
https://digitalknifemonkeyproductions.webs.com/sourcecode.htm
Unless you are actively in need of an efficient C-D algo, it's more fun just as a demo.

[STxAxTIC]

Ey, you know what Sample entries look like. For a Toolbox entry, strip it down to the part you think is best and make a dead-simple demo of it. If Librarians have to do too much homework to assimilate any given code, it won't go there.

Otherwise this is a 2D graphics demo at best, category-wise. Juss sayin.

[codeguy]

Super Code from Digital Knife Monkey Productions
NSpace @ DKM
 

Steal freely.
NSpace Sub And Demo Code 3D Version

Code: [Select]

'NSpace3D.bas
TYPE RGBRec
    red AS _UNSIGNED _BYTE
    green AS _UNSIGNED _BYTE
    blue AS _UNSIGNED _BYTE
END TYPE

TYPE Coord
    x AS INTEGER
    y AS INTEGER
    z AS INTEGER
END TYPE

TYPE PointRec
    x AS SINGLE
    y AS SINGLE
    z AS SINGLE
    radius AS SINGLE
    colorsRGB AS RGBRec
    inc AS Coord
    precalcRGB AS LONG
    precalcdiameter AS LONG
END TYPE

TYPE Segment
    xseg AS _UNSIGNED _BYTE
    yseg AS _UNSIGNED _BYTE
    zseg AS _UNSIGNED _BYTE
    xsegsize AS _UNSIGNED _BYTE
    ysegsize AS _UNSIGNED _BYTE
    zsegsize AS _UNSIGNED _BYTE
END TYPE

TYPE ScreenRec
    begins AS Coord
    ends AS Coord
END TYPE

xscreen& = _SCREENIMAGE
SCREEN xscreen&
CLS
DIM GScrn AS ScreenRec
GScrn.begins.x = 1
GScrn.begins.y = 1
GScrn.begins.z = 1
GScrn.ends.x = _WIDTH(xscreen&)
GScrn.ends.y = _HEIGHT(xscreen&)
GScrn.ends.z = 1024

DIM a(8191) AS PointRec
DIM SegmentMetrics AS Segment
SegmentMetrics.xseg = 16
SegmentMetrics.xsegsize = (GScrn.ends.x - GScrn.begins.x + 1) / SegmentMetrics.xseg
SegmentMetrics.yseg = 16
SegmentMetrics.ysegsize = (GScrn.ends.y - GScrn.begins.y + 1) / SegmentMetrics.yseg
SegmentMetrics.zseg = 16
SegmentMetrics.zsegsize = (GScrn.ends.z - GScrn.begins.z + 1) / SegmentMetrics.zseg
REDIM NspaceObjects(SegmentMetrics.xseg, SegmentMetrics.yseg, SegmentMetrics.zseg, SizeOf(a()) / 4)
REDIM counts%(SegmentMetrics.xseg, SegmentMetrics.yseg, SegmentMetrics.zseg)
FOR i = LBOUND(a) TO UBOUND(a)
    a(i).radius = (RND * 2) OR 1
    a(i).precalcdiameter = a(i).radius * 2
    a(i).x = a(i).radius + RND * (GScrn.ends.x - a(i).radius)
    a(i).y = a(i).radius + RND * (GScrn.ends.y - a(i).radius)
    a(i).z = a(i).radius + RND * (GScrn.ends.z - a(i).radius)
    a(i).inc.x = (6 * (1 - RND * 2)) OR 1
    a(i).inc.y = (6 * (1 - RND * 2)) OR 1
    a(i).inc.z = (6 * (1 - RND * 2)) OR 1
    a(i).colorsRGB.red = INT(RND * 256)
    a(i).colorsRGB.green = INT(RND * 256)
    a(i).colorsRGB.blue = INT(RND * 256)
    a(i).precalcRGB = _RGB(a(i).colorsRGB.red, a(i).colorsRGB.green, a(i).colorsRGB.blue)
NEXT
frames& = 0
lastframe& = 0
Start! = TIMER(.001)
xstart! = Start!

DIM XLoop AS _UNSIGNED _BYTE
DIM YLoop AS _UNSIGNED _BYTE
DIM ZLoop AS _UNSIGNED _BYTE

DO
    CLS
    FOR i = LBOUND(a) TO UBOUND(a)
        IF a(i).x - a(i).radius + a(i).inc.x < GScrn.begins.x THEN
            a(i).inc.x = -a(i).inc.x
        ELSEIF a(i).x + a(i).radius + a(i).inc.x > GScrn.ends.x THEN
            a(i).inc.x = -a(i).inc.x
        END IF
        a(i).x = a(i).x + a(i).inc.x

        IF a(i).y - a(i).radius + a(i).inc.y < GScrn.begins.y THEN
            a(i).inc.y = -a(i).inc.y
        ELSEIF a(i).y + a(i).radius + a(i).inc.y > GScrn.ends.y THEN
            a(i).inc.y = -a(i).inc.y
        END IF
        a(i).y = a(i).y + a(i).inc.y

        IF a(i).z - a(i).radius + a(i).inc.z < GScrn.begins.z THEN
            a(i).inc.z = -a(i).inc.z
        ELSEIF a(i).z + a(i).radius + a(i).inc.z > GScrn.ends.z THEN
            a(i).inc.z = -a(i).inc.z
        END IF
        a(i).z = a(i).z + a(i).inc.z
        PSET (a(i).x, a(i).y), a(i).precalcRGB
    NEXT

    NSpace a(), SegmentMetrics, NspaceObjects(), counts%()
    FOR XLoop = 0 TO SegmentMetrics.xseg
        FOR YLoop = 0 TO SegmentMetrics.yseg
            FOR ZLoop = 0 TO SegmentMetrics.zseg
                FOR d% = 0 TO counts%(XLoop, YLoop, ZLoop) - 2
                    m& = NspaceObjects(XLoop, YLoop, ZLoop, d%)
                    FOR e% = d% + 1 TO counts%(XLoop, YLoop, ZLoop) - 1
                        n& = NspaceObjects(XLoop, YLoop, ZLoop, e%)
                        IF Collision%(a(m&), a(n&)) THEN
                            a(n&).inc.x = -a(m&).inc.x
                            a(n&).inc.y = -a(m&).inc.y
                            a(n&).inc.z = -a(m&).inc.z
                        END IF
                    NEXT
                NEXT
            NEXT
        NEXT
    NEXT

    REDIM counts%(SegmentMetrics.xseg, SegmentMetrics.yseg, SegmentMetrics.zseg)

    IF ABS(TIMER(.001) - Start!) < 2 THEN
        frames& = frames& + 1
    ELSE
        Start! = TIMER(.001)
        PRINT (frames& - lastframe&) / 2
        lastframe& = frames&
    END IF
    _DISPLAY
    d$ = INKEY$
LOOP UNTIL d$ > ""
finish! = TIMER(.001)
CLS
SCREEN 0
PRINT frames& / (finish! - xstart!)

SUB NSpace (a() AS PointRec, SegmentsXYZ AS Segment, NspaceObjects(), Counts%())
    DIM xbox, ybox, zbox AS _UNSIGNED _BYTE
    DIM oxseg, oyseg, ozseg AS _UNSIGNED _BYTE
    FOR m& = LBOUND(A) TO UBOUND(A)
        oxseg = a(m&).x \ SegmentsXYZ.xsegsize
        oyseg = a(m&).y \ SegmentsXYZ.ysegsize
        ozseg = a(m&).z \ SegmentsXYZ.zsegsize
        IF Counts%(oxseg, oyseg, ozseg) > UBOUND(NspaceObjects, 4) THEN
            REDIM _PRESERVE NspaceObjects(SegmentsXYZ.xseg, SegmentsXYZ.yseg, SegmentsXYZ.zseg, Counts%(oxseg, oyseg, ozseg))
            '* PRINT Counts%(oxseg, oyseg, ozseg)
        END IF
        dx% = Counts%(oxseg, oyseg, ozseg)
        NspaceObjects(oxseg, oyseg, ozseg, dx%) = m&
        Counts%(oxseg, oyseg, ozseg) = dx% + 1
        IF a(m&).radius THEN
            FOR u = -a(m&).radius TO a(m&).radius STEP a(m&).precalcdiameter
                xbox = (a(m&).x + u) \ SegmentsXYZ.xsegsize
                IF xbox >= 0 THEN
                    IF xbox <= SegmentsXYZ.xseg THEN
                        ybox = (a(m&).y + u) \ SegmentsXYZ.ysegsize
                        IF ybox >= 0 THEN
                            IF ybox <= SegmentsXYZ.yseg THEN
                                zbox = (a(m&).z + u) \ SegmentsXYZ.zsegsize
                                IF zbox >= 0 THEN
                                    IF zbox <= SegmentsXYZ.zseg THEN
                                        IF xbox <> oxseg OR ybox <> oyseg OR zbox <> ozseg THEN
                                            dx% = Counts%(xbox, ybox, zbox)
                                            NspaceObjects(xbox, ybox, zbox, dx%) = m&
                                            Counts%(xbox, ybox, zbox) = dx% + 1
                                        END IF
                                    END IF
                                END IF
                            END IF
                        END IF
                    END IF
                END IF
            NEXT
        END IF
    NEXT
END SUB

FUNCTION SizeOf% (a() AS PointRec)
    SizeOf% = UBOUND(a) - LBOUND(a) + 1
END FUNCTION

FUNCTION Collision% (a AS PointRec, b AS PointRec)
    Collision% = 0
    IF ABS(b.x - a.x) > a.radius + b.radius THEN
        EXIT SUB
    ELSE
        IF ABS(b.y - a.y) > a.radius + b.radius THEN
            EXIT SUB
        ELSE
            IF ABS(b.z - a.z) > a.radius + b.radius THEN
                EXIT SUB
            ELSE
                Collision% = -1
            END IF
        END IF
    END IF
END FUNCTION

This is how NSpace works
it divides a region (2-d) or volume(3-d) into arbitarily determined but equal size rectangular or cubic regions, placing objects according to their (x,y,z) coordinates in their respective regions. it is sort of similar to applying postman's sort to each object and placing it in what i call an informal tree structure, which is actually more like a linked list. it has the ability to determine very efficiently any objects close enough to each other that there may be a possible collision, even in surrounding regions, if necessary. what i have presented in this example is the 3-d version, which can very easily be adapted to ANY number of dimensions. Performance is also nearly linear, so even at 8192+ objects (pixels in this example), it is still able to run 40+ FPS (1366 * 768 * 32), 8192 objects, CPU@2.1 GHz (normal load).

N       FPS
512      72
1024     71
2048     63
4096     49
8192     40
12288    32 '** around cutoff for acceptable performance in video gaming
16384    24

as we can see from this the performance "curve" is nearly linear, far better than n log n and quadratic, which at 16384 objects would be unusable.But don't push your luck. 65536 items slows this to a crawl too. But then again, why would ya need that many anyway? For those with the ability to do so, this is probably convertible to a parallel algorithm. Can't do that YET in QB64!

Now Presenting the 2-d version of NSpace:

Code: [Select]

'*NSpace Sub And Demo Code (2-d)
'*NSpaceRoutine2D.bas
TYPE RGBRec
    red AS _UNSIGNED _BYTE
    green AS _UNSIGNED _BYTE
    blue AS _UNSIGNED _BYTE
END TYPE

TYPE Coord
    x AS INTEGER
    y AS INTEGER
END TYPE

TYPE PointRec
    x AS SINGLE
    y AS SINGLE
    radius AS SINGLE
    colorsRGB AS RGBRec
    inc AS Coord
    precalcRGB AS LONG
    precalcdiameter AS LONG
END TYPE

TYPE Segment
    xseg AS _UNSIGNED _BYTE
    yseg AS _UNSIGNED _BYTE
    xsegsize AS _UNSIGNED _BYTE
    ysegsize AS _UNSIGNED _BYTE
END TYPE

TYPE ScreenRec
    begins AS Coord
    ends AS Coord
END TYPE

xscreen& = _SCREENIMAGE
SCREEN xscreen&
CLS
DIM GScrn AS ScreenRec
GScrn.begins.x = 1
GScrn.begins.y = 1
GScrn.ends.x = _WIDTH(xscreen&)
GScrn.ends.y = _HEIGHT(xscreen&)
DIM a(8191) AS PointRec
DIM SegmentMetrics AS Segment
SegmentMetrics.xseg = 16
SegmentMetrics.xsegsize = (GScrn.ends.x - GScrn.begins.x + 1) / SegmentMetrics.xseg
SegmentMetrics.yseg = 16
SegmentMetrics.ysegsize = (GScrn.ends.y - GScrn.begins.y + 1) / SegmentMetrics.yseg
REDIM NspaceObjects(SegmentMetrics.xseg, SegmentMetrics.yseg, SizeOf(a()) / 4)
REDIM counts%(SegmentMetrics.xseg, SegmentMetrics.yseg)
FOR i = LBOUND(a) TO UBOUND(a)
    a(i).radius = (RND * 2) OR 1
    a(i).precalcdiameter = a(i).radius * 2
    a(i).x = a(i).radius + RND * (GScrn.ends.x - a(i).radius)
    a(i).y = a(i).radius + RND * (GScrn.ends.y - a(i).radius)
    a(i).inc.x = (6 * (1 - RND * 2)) OR 1
    a(i).inc.y = (6 * (1 - RND * 2)) OR 1
    a(i).colorsRGB.red = INT(RND * 256)
    a(i).colorsRGB.green = INT(RND * 256)
    a(i).colorsRGB.blue = INT(RND * 256)
    a(i).precalcRGB = _RGB(a(i).colorsRGB.red, a(i).colorsRGB.green, a(i).colorsRGB.blue)
NEXT
frames& = 0
lastframe& = 0
Start! = TIMER(.001)
xstart! = Start!

DIM XLoop AS _UNSIGNED _BYTE
DIM YLoop AS _UNSIGNED _BYTE

DO
    CLS
    FOR i = LBOUND(a) TO UBOUND(a)
        IF a(i).x - a(i).radius + a(i).inc.x < GScrn.begins.x THEN
            a(i).inc.x = -a(i).inc.x
        ELSEIF a(i).x + a(i).radius + a(i).inc.x > GScrn.ends.x THEN
            a(i).inc.x = -a(i).inc.x
        END IF
        a(i).x = a(i).x + a(i).inc.x

        IF a(i).y - a(i).radius + a(i).inc.y < GScrn.begins.y THEN
            a(i).inc.y = -a(i).inc.y
        ELSEIF a(i).y + a(i).radius + a(i).inc.y > GScrn.ends.y THEN
            a(i).inc.y = -a(i).inc.y
        END IF
        a(i).y = a(i).y + a(i).inc.y

        PSET (a(i).x, a(i).y), a(i).precalcRGB
    NEXT

    NSpace a(), SegmentMetrics, NspaceObjects(), counts%()
    FOR XLoop = 0 TO SegmentMetrics.xseg
        FOR YLoop = 0 TO SegmentMetrics.yseg
            FOR d% = 0 TO counts%(XLoop, YLoop) - 2
                m& = NspaceObjects(XLoop, YLoop, d%)
                FOR e% = d% + 1 TO counts%(XLoop, YLoop) - 1
                    n& = NspaceObjects(XLoop, YLoop, e%)
                    IF Collision%(a(m&), a(n&)) THEN
                        a(n&).inc.x = -a(m&).inc.x
                        a(n&).inc.y = -a(m&).inc.y
                    END IF
                NEXT
            NEXT
        NEXT
    NEXT

    REDIM counts%(SegmentMetrics.xseg, SegmentMetrics.yseg)

    IF ABS(TIMER(.001) - Start!) < 2 THEN
        frames& = frames& + 1
    ELSE
        Start! = TIMER(.001)
        PRINT (frames& - lastframe&) / 2
        lastframe& = frames&
    END IF
    _DISPLAY
    d$ = INKEY$
LOOP UNTIL d$ > ""
finish! = TIMER(.001)
CLS
SCREEN 0
PRINT frames& / (finish! - xstart!)

SUB NSpace (a() AS PointRec, SegmentsXYZ AS Segment, NspaceObjects(), Counts%())
    DIM xbox, ybox AS _UNSIGNED _BYTE
    DIM oxseg, oyseg AS _UNSIGNED _BYTE
    FOR m& = LBOUND(A) TO UBOUND(A)
        oxseg = a(m&).x \ SegmentsXYZ.xsegsize
        oyseg = a(m&).y \ SegmentsXYZ.ysegsize
        IF Counts%(oxseg, oyseg) > UBOUND(NspaceObjects, 3) THEN
            REDIM _PRESERVE NspaceObjects(SegmentsXYZ.xseg, SegmentsXYZ.yseg, Counts%(oxseg, oyseg))
            '* PRINT Counts%(oxseg, oyseg)
        END IF
        dx% = Counts%(oxseg, oyseg)
        NspaceObjects(oxseg, oyseg, dx%) = m&
        Counts%(oxseg, oyseg) = dx% + 1
        IF a(m&).radius THEN
            FOR u = -a(m&).radius TO a(m&).radius STEP a(m&).precalcdiameter
                xbox = (a(m&).x + u) \ SegmentsXYZ.xsegsize
                IF xbox >= 0 THEN
                    IF xbox <= SegmentsXYZ.xseg THEN
                        ybox = (a(m&).y + u) \ SegmentsXYZ.ysegsize
                        IF ybox >= 0 THEN
                            IF ybox <= SegmentsXYZ.yseg THEN
                                IF xbox <> oxseg OR ybox <> oyseg THEN
                                    dx% = Counts%(xbox, ybox)
                                    NspaceObjects(xbox, ybox, dx%) = m&
                                    Counts%(xbox, ybox) = dx% + 1
                                END IF
                            END IF
                        END IF
                    END IF
                END IF
            NEXT
        END IF
    NEXT
END SUB

FUNCTION SizeOf% (a() AS PointRec)
    SizeOf% = UBOUND(a) - LBOUND(a) + 1
END FUNCTION

FUNCTION Collision% (a AS PointRec, b AS PointRec)
    Collision% = 0
    IF ABS(b.x - a.x) > a.radius + b.radius THEN
        EXIT SUB
    ELSE
        IF ABS(b.y - a.y) > a.radius + b.radius THEN
            EXIT SUB
        END IF
    END IF
END FUNCTION
[code]

As you can see, this is not much different from the 3d version, except that all references and variables used for z-plane have been eliminated! ENJOY!

[codeguy]

Corrected both demos to display 0 errors in QB64 v1.4, eliminated unused UDT in NSpace() SUB, making only 3 parameters necessary. Best used when there are MANY objects colliding in a 2D or 3D field, like particle simulations.

[STxAxTIC]

Ok - but why are you you using particles to demonstrate collision detection? Or just tiny polygons in the other demo? We need something to actually be inspired by, man.

[codeguy]

It's a tool. The rendering choice is yours. You can render virtually any regular polygon you like any style you like. I kept it simple so people wouldn't be scared away by lots of effects code or too-technical explanations. What you see is all that's necessary to make it work, nothing more. The demos are simple for a reason.
BTW, 26 FPS at 16384 particles in real time in a 3D volume (on a decent i9 non-gaming laptop, no less) gives plenty of time for fewer objects and time to render AND collision detect them nicely in real time, no GET or PUT or even expensive GPU required to get usable speed, even on modest laptops.

[Unseen Machine]

WTF!!!!

I remember this (especially coding the moving letters bit!), and I'f i remember correctly we had several variants of it to! DarthWho would be very happy to see DKM revived! I never knew DKM website would still be up! Even has links to GDK that died years ago (Google Code anyone?)

But yeah, this is a kick ass collision detection routine...We need to make it a .bm

Unseen

[STxAxTIC]

I want to see this code do something real instead of just imagine things.... so - it really that hard? Show me one shape colliding with another shape in an interesting way and the issue is over. If you don't, well, the issue is also over.