Code: Select all
'coded by UEZ build 2018-01-04, thanks to
' - eukalyptus for the ASM Sin / Cos functions
' - dodicat for Bresenham type line function
' - srvaldez for porting the fast_sin / fast_cos from 'https://www.gamedev.net/forums/topic/621589-extremely-fast-sin-approximation/
#include "fbgfx.bi"
#include "windows.bi"
Using FB
Const as Boolean bAlternativLineDraw = True 'if true then Bresenham type line function will be used
Const As ULong iW = 1200, iH = 800, iWh = iW \ 2, iHh = iH \ 2
Const As Single fPi = ACos(-1), fRad = fPi / 180
Dim Shared As Single x1, y1, z1, x2, y2, z2, fZoom = 1.5
'needed for fast_sin / fast_cos
Const as Double __PI = 3.14159265358979323846264338327950288, _
__PI2 = 1.5707963267948966192313216916397514421, _
__INVPI = 0.31830988618379067153776752674502872, _
__A = 0.00735246819687011731341356165096815, _
__B = -0.16528911397014738207016302002888890, _
__C = 0.99969198629596757779830113868360584
Const as ubyte iLineWidth = 2
Type screendata
As Integer w, h, depth, pitch
As Any Pointer row
End Type
#macro plotthick
For x As long = 0 To iLineWidth - 1
For y As long = 0 To 1
If sd.depth = 8 Then ppset8 ((x1 + x), (y1 + y), col)
If sd.depth = 16 Then ppset16((x1 + x), (y1 + y), col)
If sd.depth = 32 Then ppset32((x1 + x), (y1 + y), col)
Next y
Next x
#endmacro
#macro plotthin
If sd.depth = 8 Then ppset8((x1), (y1), col)
If sd.depth = 16 Then ppset16((x1), (y1), col)
If sd.depth = 32 Then ppset32((x1), (y1), col)
#endmacro
Declare Function _ASM_Cos6th(fX As Double) As Double
Declare Function _ASM_Sin6th(fX As Double) As Double
Declare function fast_round(byval x as double) as long
Declare function fast_sin(byval x as double) as double
Declare function fast_cos(byval x as double) as double
Declare Function _ASM_Sqr(n As Single) As Single
Declare Function Dist(x1 As Single, y1 As Single, x2 As Single, y2 As Single) As Single
Declare Sub _3Dto2D2(fX As Single, fY As Single, fZ As Single, fRotX As Single, fRotY As Single, fRotZ As Single, ByRef __fXPos As Single, ByRef __fYPos As Single, ByRef __fZPos As Single, fZDeepCorrection as Single = 1024.0)
Declare Sub DrawLine(sd As screendata, x1 As long, y1 As long, x2 As long, y2 As long, col As Ulong)
ScreenRes iW, iH, 24, 1, GFX_HIGH_PRIORITY Or GFX_NO_SWITCH
Dim As String sTitle = "3D Sine Wave v1.4 / FPS: "
WindowTitle sTitle
Dim As screendata S
With S
Screeninfo .w, .h, .depth, , .pitch
.row = Screenptr
End With
Dim as ulong iDW, iDH
ScreenControl GET_DESKTOP_SIZE, iDW, iDH
Dim tWorkingArea As RECT
SystemParametersInfo(SPI_GETWORKAREA, null, @tWorkingArea, null)
ScreenControl SET_WINDOW_POS, (tWorkingArea.Right - iW) \ 2, (iDH - tWorkingArea.Bottom) \ 2
Color (, RGB(&h40, &h40, &h40))
Randomize(-1, 1)
Dim as ulong iPoints = 100
Dim As Single fEuler = 2.7182818284, fSpace = 5.0, fSpace2 = fSpace / 2, iPoints2 = iPoints / 2, _
fRotX = -360 + Rnd() * 720.0, fRotY = -360 + Rnd() * 720.0, fRotZ = -360 + Rnd() * 720.0, fPower = 40.0, _
fRx = -0.5 + Rnd() * 1.0, fRy = -0.5 + Rnd() * 1.0, fRz = -0.5 + Rnd() * 1.0, _
c = 0, x, y, fDistance, fPowerColor = 1.0
Dim As Single aCoords(iPoints ^ 2, 3)
Dim As UByte r, g, b
Dim As Integer iMWheel = 0
Dim as Boolean bRotate = True
Dim As ULong iFPS = 0
Dim evt As EVENT
Dim As Double t, fTimer = Timer
Do
screenlock
Cls
'generate grid coordinates
c = 0
For x = 0 To iPoints - 1
For y = 0 To iPoints - 1
aCoords(c, 0) = fSpace * x + fSpace2 - fSpace * iPoints2
aCoords(c, 1) = fSpace * y + fSpace2 - fSpace * iPoints2
fDistance = Dist(0, 0, aCoords(c, 0), aCoords(c, 1))
aCoords(c, 2) = fEuler ^ (-fDistance / 180) * _ASM_Sin6th((fDistance / 10) - t) * fPower 'generates the waves
c += 1
t += 0.0000075
Next
Next
'update calculated grid coordinates and draw grid to screen
For x = 0 To iPoints - 2
For y = 0 To iPoints - 2
r = (&h80 + aCoords(y + iPoints * x, 0) * fPowerColor)
g = (&h80 + aCoords(y + iPoints * x, 1) * fPowerColor)
b = (&h80 + aCoords(y + iPoints * x, 2) * fPowerColor)
_3Dto2D2(aCoords(y + iPoints * x, 0), aCoords(y + iPoints * x, 1), aCoords(y + iPoints * x, 2), fRotX, fRotY, fRotZ, x1, y1, z1)
_3Dto2D2(aCoords(y + iPoints * (x + 1), 0), aCoords(y + iPoints * (x + 1), 1), aCoords(y + iPoints * (x + 1), 2), fRotX, fRotY, fRotZ, x2, y2, z2)
If bAlternativLineDraw Then
DrawLine(s,iWh + x1 * fZoom, iHh + y1 * fZoom, iWh + x2 * fZoom, iHh + y2 * fZoom, RGB(r, g XOR r, b xor g))
Else
Line(iWh + x1 * fZoom, iHh + y1 * fZoom)-(iWh + x2 * fZoom, iHh + y2 * fZoom), RGB(r, g XOR r, b xor g)
End If
_3Dto2D2(aCoords((y + 1) + iPoints * x, 0), aCoords((y + 1) + iPoints * x, 1), aCoords((y + 1) + iPoints * x, 2), fRotX, fRotY, fRotZ, x2, y2, z2)
If bAlternativLineDraw Then
DrawLine(s, iWh + x1 * fZoom, iHh + y1 * fZoom, iWh + x2 * fZoom, iHh + y2 * fZoom, RGB(r, r XOR g, g xor b))
Else
Line(iWh + x1 * fZoom, iHh + y1 * fZoom)-(iWh + x2 * fZoom, iHh + y2 * fZoom), RGB(r, r XOR g, g xor b)
End If
Next
Next
'draw missing edge
For x = 0 To iPoints - 2
r = (&h80 + aCoords(y + iPoints * x, 0) * fPowerColor)
g = (&h80 + aCoords(y + iPoints * x, 1) * fPowerColor)
b = (&h80 + aCoords(y + iPoints * x, 2) * fPowerColor)
_3Dto2D2(aCoords(y + iPoints * x, 0), aCoords(y + iPoints * x, 1), aCoords(y + iPoints * x, 2), fRotX, fRotY, fRotZ, x1, y1, z1)
_3Dto2D2(aCoords(y + iPoints * (x + 1), 0), aCoords(y + iPoints * (x + 1), 1), aCoords(y + iPoints * (x + 1), 2), fRotX, fRotY, fRotZ, x2, y2, z2)
If bAlternativLineDraw Then
DrawLine(s, iWh + x1 * fZoom, iHh + y1 * fZoom, iWh + x2 * fZoom, iHh + y2 * fZoom, RGB(r, g XOR r, b xor g))
Else
Line(iWh + x1 * fZoom, iHh + y1 * fZoom)-(iWh + x2 * fZoom, iHh + y2 * fZoom), RGB(r, g XOR r, b xor g)
End If
Next
'draw other missing edge
For y = 0 To iPoints - 2
r = (&h80 + aCoords(y + iPoints * x, 0) * fPowerColor)
g = (&h80 + aCoords(y + iPoints * x, 1) * fPowerColor)
b = (&h80 + aCoords(y + iPoints * x, 2) * fPowerColor)
_3Dto2D2(aCoords(y + iPoints * x, 0), aCoords(y + iPoints * x, 1), aCoords(y + iPoints * x, 2), fRotX, fRotY, fRotZ, x1, y1, z1)
_3Dto2D2(aCoords((y + 1) + iPoints * x, 0), aCoords((y + 1) + iPoints * x, 1), aCoords((y + 1) + iPoints * x, 2), fRotX, fRotY, fRotZ, x2, y2, z2)
If bAlternativLineDraw Then
DrawLine(s, iWh + x1 * fZoom, iHh + y1 * fZoom, iWh + x2 * fZoom, iHh + y2 * fZoom, RGB(r, r XOR g, g xor b))
Else
Line(iWh + x1 * fZoom, iHh + y1 * fZoom)-(iWh + x2 * fZoom, iHh + y2 * fZoom), RGB(r, r XOR g, g xor b)
End If
Next
screenunlock
If bRotate Then
fRotX += fRx
fRotY += fRy
fRotZ += fRz
End If
If Timer - fTimer > 0.99 Then
WindowTitle sTitle & iFPS
iFPS = 0
fTimer = Timer
Else
iFPS += 1
EndIf
If (ScreenEvent(@evt)) Then
Select Case evt.type
Case EVENT_MOUSE_WHEEL
If evt.z > iMWheel Then
'up
fZoom += 0.25
If fZoom > 20 Then fZoom = 20
Else
'down
fZoom -= 0.25
If fZoom < 0.25 Then fZoom = 0.25
EndIf
iMWheel = evt.z
Case EVENT_MOUSE_BUTTON_PRESS
If evt.button = 1 Then
bRotate = False
End If
Case EVENT_MOUSE_BUTTON_RELEASE
If evt.button = 1 Then
bRotate = True
End If
End Select
EndIf
Sleep(1, 1)
Loop Until ((InKey = Chr(27)) Or (evt.Type = EVENT_WINDOW_CLOSE))
End
Function Dist(x1 As Single, y1 As Single, x2 As Single, y2 As Single) As Single
Return _ASM_Sqr((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2))
End Function
Sub _3Dto2D2(fX As Single, fY As Single, fZ As Single, _
fRotX As Single, fRotY As Single, fRotZ As Single, _
ByRef __fXPos As Single, ByRef __fYPos As Single, ByRef __fZPos As Single, fZDeepCorrection as Single = 1024.0)
Dim as Single _
fXr = fRotX * fRad, fYr = fRotY * fRad, fZr = fRotZ * fRad, _
fCosRotX = _ASM_Cos6th(fXr), fSinRotX = _ASM_Sin6th(fXr), _
fCosRotY = _ASM_Cos6th(fYr), fSinRotY = _ASM_Sin6th(fYr), _
fCosRotZ = _ASM_Cos6th(fZr), fSinRotZ = _ASM_Sin6th(fZr), _
f1 = fCosRotY * fX, _
f2 = fSinRotX * fY, _
f3 = fCosRotX * fZ, _
f4 = fCosRotX * fY, _
f5 = fSinRotX * fZ, _
f6 = f1 - fSinRotY * (f2 + f3), _
f7 = f4 - f5, _
fXPos = (fCosRotZ * f6 - fSinRotZ * (f7)), _
fYPos = (fSinRotZ * f6 + fCosRotZ * (f7)), _
fZPos = (fSinRotY * fX + fCosRotY * (f2 + f3)), _
fZPerspCorrection = 1 / (fZPos / fZDeepCorrection + 1)
__fXPos = fXPos * fZPerspCorrection
__fYPos = fYPos * fZPerspCorrection
__fZPos = fZPos
End Sub
Function _ASM_Sqr(n As Single) As Single
Asm
rsqrtss xmm0, [n]
mulss xmm0, [n]
movss [function], xmm0
End Asm
End Function
Function _ASM_Sin6th(fX As Double) As Double
Asm
jmp 0f
1: .double 683565275.57643158
2: .double -0.0000000061763971109087229
3: .double 6755399441055744.0
0:
movq xmm0, [fX]
mulsd xmm0, [1b]
addsd xmm0, [3b]
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, [2b]
movq [Function], xmm0
End Asm
End Function
Function _ASM_Cos6th(fX As Double) As Double
Asm
jmp 0f
1: .double 683565275.57643158
2: .double -0.0000000061763971109087229
3: .double 6755399441055744.0
0:
movq xmm0, [fX]
mulsd xmm0, [1b]
addsd xmm0, [3b]
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, [2b]
movq [Function], xmm0
End Asm
End Function
'https://www.gamedev.net/forums/topic/621589-extremely-fast-sin-approximation/
function fast_round(byval x as double) as long
dim MAGIC_ROUND as const double = 6755399441055744.0
union fast_trunc
d as double
type
lw as long
hw as long
end type
end union
dim fast_trunc as fast_trunc
fast_trunc.d = x
fast_trunc.d += MAGIC_ROUND
return fast_trunc.lw
end function
'https://www.gamedev.net/forums/topic/621589-extremely-fast-sin-approximation/
function fast_sin(byval x as double) as double 'compile with -gen gcc -Wc -O2
'dim __PI as const double = 3.14159265358979323846264338327950288
'dim __INVPI as const double = 0.31830988618379067153776752674502872
'dim __A as const double = 0.00735246819687011731341356165096815
'dim __B as const double = -0.16528911397014738207016302002888890
'dim __C as const double = 0.99969198629596757779830113868360584
dim k as long
dim x2 as double
k = fast_round(__INVPI * x)
x -= k * __PI
x2 = x * x
x = x * (__C + (x2 * (__B + (__A * x2))))
if k mod 2 then
x = -x
end if
return x
end function
function fast_cos(byval x as double) as double
'dim __PI as const double = 3.14159265358979323846264338327950288
'dim __PI2 as const double = 1.5707963267948966192313216916397514421
'dim __INVPI as const double = 0.31830988618379067153776752674502872
'dim __A as const double = 0.00735246819687011731341356165096815
'dim __B as const double = -0.16528911397014738207016302002888890
'dim __C as const double = 0.99969198629596757779830113868360584
dim k as long
dim x2 as double
x = __PI2 - x
k = fast_round(__INVPI * x)
x -= k * __PI
x2 = x * x
x = x * (__C + (x2 * (__B + (__A * x2))))
if k mod 2 then
x = -x
end if
return x
end function
Sub DrawLine(sd As screendata, x1 As long, y1 As long, x2 As long, y2 As long, col As Ulong) 'Bresenham type line function
#define ppset32(_x, _y, colour) *cptr(ulong ptr, sd.row + (_y) * sd.pitch + (_x) shl 2) = (colour)
#define ppset8(_x, _y, colour) *cptr(ubyte ptr, (sd.row + (_y) * sd.pitch + (_x))) = (colour)
#define ppset16(_x, _y, colour) *cptr(ushort ptr, (sd.row + (_y) * sd.pitch + (_x) shl 1)) = (colour)
#define onscreen ((x1) >= 0) And ((x1) < (sd.w - 1)) And ((y1) >= 0) And ((y1) < (sd.h - 1))
Var dx = Abs(x2 - x1), dy = Abs(y2 - y1), sx = Sgn(x2 - x1), sy = Sgn(y2 - y1)
dim as long e
If dx < dy Then
e = dx \ 2
Else
e = dy \ 2
End if
Do
If onscreen Then
plotthick
'plotthin
End If
If x1 = x2 Then
If y1 = y2 Then
Exit Do
ENd If
ENd If
If dx > dy Then
x1 += sx
e -= dy
If e < 0 Then
e += dx
y1 += sy
ENd if
Else
y1 += sy
e -= dx
If e < 0 Then
e += dy
x1 += sx
ENd if
End If
Loop
End Sub
* LMB to stop rotation
* MW to zoom grid
Edit: updated 3D to 2D function with Z deep correction to look more realistic.
Edi2: updated / added Sin / Cos functions and added Bresenham type line function