Code: Select all
#Include "fbgfx.bi"
Using FB
Declare Function _Sin6th(fX As Double) As Double
Declare Function _Cos6th(fX As Double) As Double
Declare Function createStars(n As UShort) As Boolean
Type tSHAPE
x As Single
y As Single
r As Single
speed As Single
accel As Single
angle As Single
End Type
Const As UInteger iW = 1200, iH = 800, iWh = iW \ 2, iHh = iH \ 2
Const As Single fPi = ACos(-1), fRAD = fPi / 180, fDEG = 180 / fPi
Dim Shared As Boolean bRandomize = TRUE
Dim Shared As UShort iHoleSize, iRotationDistance, iStarsPerLevel, iDrawDepth, iPos, c, ii
Dim Shared As Single r, fRotationStep, fRotationSpeed, fAccel, fAccel2, fLevelStarPos, fTargetAngle, mx, my, vx, vy
Dim As UByte grey
iHoleSize = 16
r = 0
iRotationDistance = 300
fRotationSpeed = 0.9
iStarsPerLevel = 128
fRotationStep = 8.0
iDrawDepth = iStarsPerLevel * 75
fAccel = 1.01
fAccel2 = 0.0015
fLevelStarPos = 0
iPos = 0
mx = 0
my = 0
Dim Shared aStars(0 To iDrawDepth + iStarsPerLevel) As tSHAPE
Dim As String sTitle = "Worm Tunnel Flight / "
ScreenRes iW, iH, 16,, GFX_HIGH_PRIORITY
Dim As ULong iFPS = 0, iLines = 0
Dim As Double fTimer
Dim evt As EVENT
fTimer = Timer
Do
ScreenLock
Cls
createStars(iStarsPerLevel)
r += fRotationSpeed
If r < 360 Then
mx = iWh
my = iHh
fTargetAngle = r * fRAD
mx += iRotationDistance * _Cos6th(fTargetAngle + Timer)
my += iRotationDistance * ( _Sin6th(fTargetAngle ) + _Cos6th(2 * fTargetAngle - Timer / 10) / 2)
Else
r = 0
EndIf
c = 0
While c < UBound(aStars)
If aStars(c).x <> 0 Then
vx = aStars(c).speed * _Cos6th(aStars(c).angle * fRAD)
vy = aStars(c).speed * _Sin6th(aStars(c).angle * fRAD)
grey = CUByte(c * iWh)
Line (aStars(c).x, aStars(c).y) - (aStars(c).x + vx, aStars(c).y + vy), RGB(grey, grey, grey)
iLines += 1
aStars(c).x += vx
aStars(c).y += vy
aStars(c).speed *= aStars(c).accel
aStars(c).accel += fAccel2
EndIf
c += 1
Wend
If iPos > iDrawDepth Then iPos = 0
ScreenUnlock
If Timer - fTimer > 0.99 Then
WindowTitle sTitle & "Lines: " & iLines & " / FPS: " & iFPS
iFPS = 0
iLines = 0
fTimer = Timer
Else
iFPS += 1
EndIf
If (ScreenEvent(@evt)) Then
Select Case evt.Type
Case SC_ESCAPE, EVENT_WINDOW_CLOSE
Exit Do
End Select
EndIf
Sleep(10)
Loop
Function createStars(n As UShort) As Boolean
If mx = 0 Then Return FALSE
For ii = 0 To n - 1
aStars(iPos).x = mx
aStars(iPos).y = my
aStars(iPos).r = 1.0
aStars(iPos).speed = 1.0
aStars(iPos).accel = fAccel
aStars(iPos).angle = IIf(bRandomize, Rnd() * 360, fLevelStarPos)
If bRandomize = FALSE Then fLevelStarPos += fRotationStep
vx = iHoleSize * _Cos6th(aStars(iPos).angle * fRAD)
vy = iHoleSize * _Sin6th(aStars(iPos).angle * fRAD)
aStars(iPos).x += vx
aStars(iPos).y += vy
iPos += 1
Next
Return TRUE
End Function
Function _Sin6th(fX As Double) As Double 'coded by Eukalyptus
Asm
jmp _Sin6th_Start
_Sin6th_Mul: .double 683565275.57643158
_Sin6th_Div: .double -0.0000000061763971109087229
_Sin6th_Rnd: .double 6755399441055744.0
_Sin6th_Start:
movq xmm0, [fX]
mulsd xmm0, [_Sin6th_Mul]
addsd xmm0, [_Sin6th_Rnd]
movd ebx, xmm0
lea eax, [ebx *2 + 0x80000000]
sar eax, 2
imul eax
sar ebx, 31
lea eax, [edx * 2 - 0x70000000]
lea ecx, [edx * 8 + edx - 0x24000000]
imul edx
xor ecx, ebx
lea eax, [edx * 8 + edx + 0x44A00000]
imul ecx
cvtsi2sd xmm0, edx
mulsd xmm0, [_Sin6th_Div]
movq [Function], xmm0
End Asm
End Function
Function _Cos6th(fX As Double) As Double 'coded by Eukalyptus
Asm
jmp _Cos6th_Start
_Cos6th_Mul: .double 683565275.57643158
_Cos6th_Div: .double -0.0000000061763971109087229
_Cos6th_Rnd: .double 6755399441055744.0
_Cos6th_Start:
movq xmm0, [fX]
mulsd xmm0, [_Cos6th_Mul]
addsd xmm0, [_Cos6th_Rnd]
movd ebx, xmm0
add ebx, 0x40000000 'SinToCos
lea eax, [ebx * 2 + 0x80000000]
sar eax, 2
imul eax
sar ebx, 31
lea eax, [edx * 2 - 0x70000000]
lea ecx, [edx * 8 + edx - 0x24000000]
imul edx
xor ecx, ebx
lea eax, [edx * 8 + edx + 0x44A00000]
imul ecx
cvtsi2sd xmm0, edx
mulsd xmm0, [_Cos6th_Div]
movq [Function], xmm0
End Asm
End Function