Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Kreis Kollision Test
| Uploader: |  Eternal_Pain |
| Datum/Zeit: | 02.03.2015 07:30:19 |
'QUELLE: https://www.spieleprogrammierer.de/wiki/2D-Kollisionserkennung#Kollision_zwischen_zwei_Kreisen
'' Kollision zwischen zwei Kreisen
'' Wenn die Distanz zwischen den Mittelpunkten zweier Kreise kleiner ist als die Summe ihrer Radien,
'' so liegt eine Kollision vor. Also benötigen wir zum Prüfen der Kollision die Positionen und
'' Radien der beiden Kreise. Dabei rechnen wir mit Hilfe des Satz des Pythagoras die Distanz zwischen
'' den beiden Kreisen aus und prüfen zum Schluss, ob diese kleiner ist als die Summe beider Radien.
Function RadKol(byval x1 as Integer, byval y1 as Integer, byval r1 as Integer = 0, byval x2 as Integer, byval y2 as Integer, byval r2 as Integer = 0) as Integer
Static Dist as Integer
Dist = int(sqr(((x1-x2)*(x1-x2))+((y1-y2)*(y1-y2))))
If Dist < (r1+r2) Then Return -1 '' TRUE
Return 0 '' FALSE
End Function
''MAIN test.bas
Randomize Timer
Screenres 640,480,32
Dim as Integer ax,ay,ar '' Kreis A
Dim as Integer bx,by,br '' Kreis B
'' Zufaellige Startwerte
ax = rnd*640 : ay = rnd*480 : ar = (rnd*25) +1
bx = rnd*640 : by = rnd*480 : br = (rnd*25) +1
If ax-ar < 0 Then ax = 0 + ar
If ax+ar > 639 Then ax = 639 - ar
If ay-ar < 0 Then ay = 0 + ar
If ay+ar > 479 Then ay = 479 - ar
If bx-br < 0 Then bx = 0 + br
If bx+br > 639 Then bx = 639 - br
If by-br < 0 Then by = 0 + br
If by+br > 479 Then by = 479 - br
Dim as Integer axd, ayd '' Bewegungsrichtung Kreis A
Dim as Integer bxd, byd '' Bewegungsrichtung Kreis B
'' Zufaellige Startwerte
''axd und ayd dürfen nicht zur selben zeit 0 sein (sonst findet keine bewegung statt)
Do
axd = (rnd*2) - 1 : ayd = (rnd*2) -1 '' -1,0,1
Loop while (axd = 0 and ayd = 0)
''bxd und byd dürfen nicht zur selben zeit 0 sein (sonst findet keine bewegung statt)
Do
bxd = (rnd*2) - 1 : byd = (rnd*2) -1 '' -1,0,1
Loop while (bxd = 0 and byd = 0)
Do
Screenlock
cls
Circle (ax,ay),ar,&h808080,,,,F
Circle (bx,by),br,&hFF1010,,,,F
Screenunlock
ax += axd : ay += ayd
bx += bxd : by += byd
If RadKol(ax,ay,ar,bx,by,br) Then ''Kolission zwischen beiden Kreisen
If axd <> 0 Then axd *= -1 Else axd = (rnd*2) -1
If ayd <> 0 Then ayd *= -1 Else ayd = (rnd*2) -1
If bxd <> 0 Then bxd *= -1 Else bxd = (rnd*2) -1
If byd <> 0 Then byd *= -1 Else byd = (rnd*2) -1
End If
If ax+ar>639 orelse ax-ar<0 orelse ay+ar>479 orelse ay-ar<0 Then ''Kreis A kollidiert mit Rand
If ax-ar< 0 orelse ax+ar>639 Then axd *= -1 Else axd = (rnd*2) -1
If ay-ar< 0 orelse ay+ar>479 Then ayd *= -1 Else ayd = (rnd*2) -1 '' -1,0,1
End If
If bx+br>639 orelse bx-br<0 orelse by+br>479 orelse by-br<0 Then ''Kreis B kollidiert mit Rand
If bx-br< 0 orelse bx+br>639 Then bxd *= -1 Else bxd = (rnd*2) -1
If by-br< 0 orelse by+br>479 Then byd *= -1 Else byd = (rnd*2) -1 '' -1,0,1
End If
sleep 1
Loop UNTIL multikey(&h01) '' ESC