QB64.org Forum
Active Forums => Programs => Topic started by: codeguy on June 03, 2020, 10:51:38 pm
-
NSpace is a pretty good collision detection algorithm.
'* 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
-
THAT is impressive! Do you have any plans for its use?
-
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 (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.
-
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.
-
Super Code from Digital Knife Monkey Productions
NSpace @ DKM
Steal freely.
NSpace Sub And Demo Code 3D Version
'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:
'*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!
-
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.
-
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.
-
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.
-
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
-
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.