Source code, needed files and compiled exe can be downloaded here: FB Merry Christmas build 2020-12-21.zip
I don't know if it is working with Linux.
The 3d animation code is based on this:
Code: Select all
'Coded by UEZ build 2020-10-13
'Thanks To dodicat for some funtions I used from his code :-) and to Joshy for the ImageScale function. ^^
#Include "file.bi"
#Include "fbgfx.bi"
Using FB
#Define Map(Val, source_start, source_stop, dest_start, dest_stop) ((Val - source_start) * (dest_stop - dest_start) / (source_stop - source_start) + dest_start)
#Define Round(x) ((x + 0.5) Shr 0)
Const w = 1200, h = 800, w2 = w \ 2, h2 = h \ 2, pi = Acos(-1), pi2 = Acos(-1) / 2
Const radians = pi / 180, deg = 180 / pi
Union _Color
As Ulong argb
Type
As Ubyte b, g, r, a
End Type
End Union
Type vec3
As Single x, y, z
End Type
Dim Shared As Const vec3 eyepoint = Type(w2, h2, h)
Type vec6
As Boolean bTrunk, bRibbon
As Single x, y, z
As _Color col
End Type
'Taylor series
'Sum n = 0 To inf (-1)^n * x^(2n) / (2n)! = 1 - x^2 / 2! + x^4 / 4! -x^6 / 6! + ...
Function Cos_(x As Single) As Single
If x < 0 Then x = -x
While x >= 3.141592653589793 'pi
x -= 6.283185307179586 '2 * pi
Wend
Dim As Single xx = x * x
Return 1.0 - (xx / 2) * (1 - (xx / 12) * (1 - (xx / 30) * (1 - xx / 56))) 'approximation of Taylor serie
End Function
Function Sin_(x As Single) As Single
Return Cos_(x - 1.570796326794897) 'pi / 2
End Function
Sub Object3Dto2D(wa() As vec6, result() As vec6, angle As vec3, centre As vec3, rad As Single = 1.0, flag As Boolean = True) 'by dodicat
Dim As Single dx,dy,dz,ww
Dim As Single SinAX=Sin_(angle.x)
Dim As Single SinAY=Sin_(angle.y)
Dim As Single SinAZ=Sin_(angle.z)
Dim As Single CosAX=Cos_(angle.x)
Dim As Single CosAY=Cos_(angle.y)
Dim As Single CosAZ=Cos_(angle.z)
For z As Uinteger=Lbound(wa) To Ubound(wa)
dx=wa(z).x-centre.x
dy=wa(z).y-centre.y
dz=wa(z).z-centre.z
Result(z).x=rad*((Cosay*Cosaz)*dx+(-Cosax*Sinaz+Sinax*Sinay*Cosaz)*dy+(Sinax*Sinaz+Cosax*Sinay*Cosaz)*dz)+centre.x
result(z).y=rad*((Cosay*Sinaz)*dx+(Cosax*Cosaz+Sinax*Sinay*Sinaz)*dy+(-Sinax*Cosaz+Cosax*Sinay*Sinaz)*dz)+centre.y
result(z).z=rad*((-Sinay)*dx+(Sinax*Cosay)*dy+(Cosax*Cosay)*dz)+centre.z
If flag Then
ww = 1 + (result(z).z/eyepoint.z)
result(z).x = (result(z).x-eyepoint.x)/ww+eyepoint.x
result(z).y = (result(z).y-eyepoint.y)/ww+eyepoint.y
result(z).z = (result(z).z-eyepoint.z)/ww+eyepoint.z
Endif
result(z).bTrunk=wa(z).bTrunk
result(z).bRibbon=wa(z).bRibbon
result(z).col=wa(z).col
Next z
End Sub
Sub QsortZ(array() As vec6, begin As Integer, Finish As Uinteger) 'by dodicat
Dim As Integer i = begin, j = finish
Dim As vec6 X = array(((I + J) \ 2))
While I <= J
While array(I).z > X .z : I += 1 : Wend
While array(J).z < X .z : J -= 1 : Wend
If I <= J Then Swap array(I), array(J) : I += 1 : J -= 1
Wend
If J > begin Then QsortZ(array(), begin, J)
If I < Finish Then QsortZ(array(), I, Finish)
End Sub
Function Regulate(TargetFPS As Long, Byref fps As Long) As Long 'by dodicat
Static As Double timervalue, _lastsleeptime, t3, frames
Var t = Timer
frames += 1
If (t - t3) >= 1 Then t3 = t : fps = frames : frames = 0
Var sleeptime =_lastsleeptime + ((1 / TargetFPS) - t + timervalue) * 1000
If sleeptime < 1 Then sleeptime = 1
_lastsleeptime = sleeptime
timervalue = t
Return sleeptime
End Function
Screenres w, h, 32, 2, GFX_WINDOWED Or GFX_NO_SWITCH Or GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES
Screenset 1, 0
Dim As Ulong particles = 10000, i, j = 30, k, l, ub
Dim As Single ang, zoom = 1.0
Dim As Ulong iCounter = 0
Dim As vec6 aParticles(particles - 1), aResult(particles - 1)
Randomize
'Stamm
For i = 1 To 100
If Rnd() > 0.10 Then
aParticles(iCounter).x = w2 + Rnd() * 2 - 1
aParticles(iCounter).y = -250 + h2 + i * 4.5
aParticles(iCounter).z = Rnd() * 5 - 10
aParticles(iCounter).bTrunk = True
aParticles(iCounter).col.argb = Rgba(&h49 + Rnd() * 10 - 5, &h3D + Rnd() * 10 - 5, &h26 + Rnd() * 10 - 5, 255)
iCounter += 1
Endif
Next
Dim As Single parts = 7, angle
'Äste
For l = 1 To 34
angle = Rnd() * 360 * radians
For k = 1 To parts
angle += (360 / parts + Rnd() * 15 - 7.5) * radians
For i = 3 To Sqr(l * 10)
If Rnd() > 0.3333333 Then
aParticles(iCounter).x = w2 - (i)^1.70 * Cos(angle) + Rnd() * 6 - 3
aParticles(iCounter).z = (i)^1.70 * Sin(angle) + Rnd() * 6 - 3
aParticles(iCounter).y = -20 + aParticles(0).y + aParticles(iCounter).y + j + Rnd() * 8 - 4
aParticles(iCounter).col.argb = Rgba(&h25 + Rnd() * 10 - 5, &h41 + Rnd() * 10 - 5, &h17 + Rnd() * 10 - 5, &hF0)
iCounter += 1
Endif
Next
Next
j += 12
Next
angle = Rnd() * 360 * radians
For i = 1 To 400
aParticles(iCounter).x = w2 - (i)^0.825 * Cos(angle)
aParticles(iCounter).y = aParticles(0).y + i
aParticles(iCounter).z = (i)^0.825 * Sin(angle)
aParticles(iCounter).bRibbon = True
aParticles(iCounter).col.argb = Rgba(255, 0, 0, 255)
angle += (360 / 100) * radians
iCounter += 1
Next
Redim Preserve aParticles(iCounter - 1)
Redim Preserve aResult(iCounter - 1)
ub = Ubound(aParticles)
Dim As String sWintitle = "3D Christmas Tree coded by UEZ"
Windowtitle(sWintitle & " / " & Str(ub) & " pixels")
Dim As Ulong iFPS, s1, s2
Dim As Uinteger dh = h * 0.75
Dim As Double fTimer = Timer
Do
Line (0, 0) - (w, h), &hF0F0F0F0, BF
ang += .003
Object3Dto2D(aParticles(), aResult(), Type<vec3>(0, 2 * ang, 0), Type<vec3>(w2, h2, 0), zoom)
'Object3Dto2D(aParticles(), aResult(), Type<vec3>(pi / 2, 0, ang), Type<vec3>(w2, h2, 0), zoom) 'top view
Qsortz(aResult(), 0, ub)
For i = 0 To ub
If aResult(i).bTrunk Then
s1 = Map(aResult(i).y, -120, h2, 1, 10)
Circle (aResult(i).x, aResult(i).y), s1, aResult(i).col.argb,,,, F
Elseif aResult(i).bRibbon Then
s2 = map(aResult(i).z, -800, 0, 20, 10)
Line (aResult(i).x, aResult(i).y) - (aResult(i).x + s2, aResult(i).y + s2), aResult(i).col.argb, BF
aResult(i).col.a Shr= 1
aResult(i).col.r Shr= 1
aResult(i).col.g Shr= 1
aResult(i).col.b Shr= 1
Line (aResult(i).x, aResult(i).y) - (aResult(i).x + s2, aResult(i).y + s2), aResult(i).col.argb, B
Else
s2 = map(aResult(i).z, -800, 0, 20, 10)
Circle (aResult(i).x, aResult(i).y), s2, aResult(i).col.argb,,,, F
aResult(i).col.a Shr= 2
aResult(i).col.r Shr= 1
aResult(i).col.g Shr= 1
aResult(i).col.b Shr= 1
Circle (aResult(i).x, aResult(i).y), s2, aResult(i).col.argb
Endif
Next
Draw String(1, 1), iFPS & " fps", &hFF000000
Flip
Sleep(Regulate(60, iFPS), 1)
Loop Until Len(Inkey())
PS: if you have additional ideas which I can add to the scene, please let me know.