AspirinJunkie sehr gut. 4 Augen sehen mehr als 2. ![]()
In der Tat habe ich es übersehen, dass die kostenintensive Berechnung des Kreises noch optimierbar ist, wenn ich die Konstante cyy * iW innerhalb der For xx Schleife herausnehme.
Auch 255 / BallSize ist eine Konstante die nicht in der Hauptschleife jedesmal berechnet werden muss!
Das mit "2 * BallSize" wird nur einmal durchlaufen und macht sich nicht bemerkbar, aber wäre dies in einer permanenten Schleife, dann könnte man die Bitshift Operation wählen.
Mit diesen zwei Optimierungen konnte ich auf meiner Kiste ca. 10 FPS herausholen! ![]()
Den Richtungsvektor bei Kollision mit den Rändern von *-1 auf -vx/-vy zu stellen, macht sich nicht bemerkbar, da nur die Anzahl der Zellen aufgerufen wird, aber auch eine Optimierungsmöglichkeit.
So sieht der Code nach dem Update aus:
'Coded by UEZ build 2020-04-20
#Include "fbgfx.bi"
Using FB
Const iW = 640, iH = 480
Dim Shared As Ulong Ptr pScrn
Function _ASM_Sqr(n As Single) As Single
Asm
rsqrtss xmm0, [n]
mulss xmm0, [n]
movss [Function], xmm0
End Asm
End Function
Function _Sqrt1(n As Single) As Single
Dim As Integer highest = 1, sqrt_highest = 1
While highest < n
highest Shl= 2
sqrt_highest Shl= 1
Wend
n /= highest
Dim As Single result
result = (n / 4) + 1
result = (result / 2) + (n / (result * 2))
result = (result / 2) + (n / (result * 2))
Return result * sqrt_highest
End Function
Function _Sqrt2(n As Single) As Single 'only 32 bit compatible
Dim As Integer i = Cvi(n)
i = &h1FB90000 + (i Shr 1)
Dim As Single y = Cvs(i)
Return (y + n / y) / 2
End Function
Function _Sqrt25(n As Single) As Single
Dim As ULong i = *Cptr(Ulong Ptr, @n)
i = &h1FB90000 + (i Shr 1)
Dim As Single y = *Cptr(Single Ptr, @i)
Return (y + n / y) / 2
End Function
'http://www.codeproject.com/Articles/69941/Best-Square-Root-Method-Algorithm-Function-Precisi
Function _Sqrt3(x As Single) As Single 'only 32bit
Dim As ULong y = *Cptr(Ulong Ptr, @x), s
s = y And &h80000000
y And= &h7FFFFFFF
y += 127 Shl 23
y Shr= 1
y Or= s
Return *Cptr(Single Ptr, @y)
End Function
Sub _Circle(x As Short, y As Short, r As Short, c As Ulong)
Dim As Short r2 = r * r, cx, cy, cyy, px1, px2, xx
Dim As Ulong py
For cy = -r to r
cx = _ASM_Sqr(r2 - cy * cy) + 0.5
cyy = cy + y : cyy = Iif(cyy < 0, 0, Iif(cyy > iH - 1, iH - 1, cyy))
px1 = x - cx : px1 = Iif(px1 < 0, 0, Iif(px1 > iW - 1, iW - 1, px1))
px2 = x + cx : px2 = Iif(px2 < 0, 0, Iif(px2 > iW - 1, iW - 1, px2))
py = cyy * iW
For xx = px1 To px2'fill circle
pScrn[py + xx] = c
Next
Next
End Sub
Screenres iW, iH, 32, 2, GFX_WINDOWED Or GFX_NO_SWITCH Or GFX_ALWAYS_ON_TOP' Or GFX_ALPHA_PRIMITIVES
ScreenSet 1, 0
Windowtitle("Atomic Cell World v0.3 by UEZ")
pScrn = Screenptr()
Type tPoint
As Single x, y, vx, vy, s
As Ubyte r, g, b
End Type
Dim As Ubyte AmountBalls = 50, BallSize = 100, i, BS = BallSize Shr 1
Dim As Single j, c, d, cc = 255 / BallSize, fSpeed = 2 'BallSize / 255
Dim As tPoint Points(AmountBalls - 1)
Dim As Ulong iFPS
Randomize Timer, 2
For i = 0 To AmountBalls - 1
Points(i).x = BallSize + Rnd() * (iW - 2 * BallSize - 1)
Points(i).y = BallSize + Rnd() * (iH - 2 * BallSize - 1)
Points(i).vx = Rnd() - 0.5
Points(i).vy = Rnd() - 0.5
Points(i).r = Rnd() * 255 'Iif(Rnd() > 0.50, 1, 0)
Points(i).g = 0 'Iif(Rnd() > 0.50, 1, 0)
Points(i).b = 0 'Iif(Rnd() > 0.50, 1, 0)
Next
Dim As Ushort cfps = 0
Dim As Single fTimer = Timer
Do
'Cls
'Line (0, 0)-(iW - 1, iH - 1), &hFF101010, BF
Line (1, 1)-(70, 10), &hFF000000, BF
For j = 1 To BallSize Step fSpeed
c = j * cc
d = (BallSize - j)
For i = 0 To AmountBalls - 1
'Circle(Points(i).x, Points(i).y), d, c Shl 8, , , , F
'_Circle(Points(i).x, Points(i).y, d, Rgb(Iif(Points(i).r, c, 0), Iif(Points(i).g, c, 0), Iif(Points(i).b, c, 0))) 'different color
_Circle(Points(i).x, Points(i).y, d, c Shl 8) 'static color
Next
Next
For i = 0 To AmountBalls - 1
Points(i).x += Points(i).vx
Points(i).y += Points(i).vy
If Points(i).x < BS Or Points(i).x > (iW - BS) Then Points(i).vx = -Points(i).vx
If Points(i).y < BS Or Points(i).y > (iH - BS) Then Points(i).vy = -Points(i).vy
Next
Draw String(1, 1), iFPS & " fps", Rgb(&hFF, &hFF, &hFF)
Flip
cfps += 1
If Timer - fTimer > 0.99 Then
iFPS = cfps
cfps = 0
fTimer = Timer
End If
Sleep(1)
Loop Until Len(Inkey())
Alles anzeigen
Könnt ihr auch den Unterschied auf eurem PC sehen? Auf meinem Rechner ist die FPS von ca. 30 auf ca. 40 FPS geklettert.