Code: Select all
'Coded by UEZ build 2023-03-30
#Include "fbgfx.bi"
#Include "crt/math.bi"
Using FB
'Perlin Noise by Joshy aka D.J. Peters
Type REAL As Single
#Define rAbs(x_) Iif( (x_) < 0, -(x_), (x_) )
Const As REAL rPI = Acos(-1)
Const As REAL rDeg2Rad = rPI / 180
Type PERLINNOISE
Declare Constructor
Declare Sub NoiseSeed(Byval seed As Double)
Declare Sub NoiseDetail(Byval lod As Integer)
Declare Sub NoiseDetail(Byval lod As Integer, Byval falloff As REAL)
Declare Function Noise1D(Byval x As REAL) As REAL
Declare Function Noise2D(Byval x As REAL,Byval y As REAL) As REAL
Declare Function Noise3D(Byval x As REAL,Byval y As REAL,Byval z As REAL) As REAL
Private:
Const As REAL SINCOS_PRECISION = 0.5
Const As Integer SINCOS_LENGTH = (360 / SINCOS_PRECISION)
Const As Integer PERLIN_YWRAPB = 4
Const As Integer PERLIN_YWRAP = 1 Shl PERLIN_YWRAPB
Const As Integer PERLIN_ZWRAPB = 8
Const As Integer PERLIN_ZWRAP = 1 Shl PERLIN_ZWRAPB
Const As Integer PERLIN_SIZE = 4095
Const As Integer PERLIN_TWOPI = SINCOS_LENGTH
Const As Integer PERLIN_PI = PERLIN_TWOPI Shr 1
As Integer perlin_octaves = 4 ' default To medium smooth
As REAL perlin_amp_falloff = 0.5 ' 50% reduction/octave
As REAL perlin_cosTable(SINCOS_LENGTH-1)
As REAL perlin(PERLIN_SIZE)
Declare Sub reInit
Declare Function noise_fsc(Byval i As REAL) As REAL
End Type
Constructor PERLINNOISE
For i As Integer = 0 To SINCOS_LENGTH - 1
perlin_cosTable(i) = Cos(i * rDEG2RAD * SINCOS_PRECISION)
Next
reInit
End Constructor
Sub PERLINNOISE.reInit
For i As Integer = 0 To PERLIN_SIZE
perlin(i) = Rnd()
Next
End Sub
Function PERLINNOISE.noise_fsc(Byval i As REAL) As REAL
Dim As Integer index = Int(i * PERLIN_PI)
Return 0.5 * (1.0 - perlin_cosTable(index Mod SINCOS_LENGTH))
End Function
Sub PERLINNOISE.noiseSeed(Byval seed As Double)
'Randomize(0) ' !!!
Randomize(seed) : reInit
End Sub
Sub PERLINNOISE.noiseDetail(Byval lod As Integer)
If (lod > 0) Then perlin_octaves = lod
End Sub
Sub PERLINNOISE.noiseDetail(Byval lod As Integer, Byval falloff As REAL)
If (lod > 0) Then perlin_octaves = lod
If (falloff > 0) Then perlin_amp_falloff = falloff
End Sub
Function PERLINNOISE.Noise1D(Byval x As REAL) As REAL
Return noise3D(x, 0, 0)
End Function
Function PERLINNOISE.Noise2D(Byval x As REAL, Byval y As REAL) As REAL
Return noise3D(x, y, 0)
End Function
Function PERLINNOISE.Noise3D(Byval x As REAL,Byval y As REAL,Byval z As REAL) As REAL
x = rAbs(x) : y = rAbs(y) : z = rAbs(z)
Dim As Integer xi = Int(x), yi = Int(y), zi = Int(z)
Dim As REAL xf = x - xi, yf = y - yi, zf = z - zi
Dim As REAL r, ampl = 0.5
For i As Integer = 0 To perlin_octaves - 1
Dim As Integer of= xi + (yi Shl PERLIN_YWRAPB) + (zi Shl PERLIN_ZWRAPB)
Dim As REAL rxf = noise_fsc(xf)
Dim As REAL ryf = noise_fsc(yf)
Dim As REAL n1 = perlin(of And PERLIN_SIZE)
n1 += rxf * (perlin((of + 1) And PERLIN_SIZE) - n1)
Dim As REAL n2 = perlin((of + PERLIN_YWRAP) And PERLIN_SIZE)
n2 += rxf * (perlin((of + PERLIN_YWRAP + 1) And PERLIN_SIZE) - n2)
n1 += ryf * (n2 - n1)
of += PERLIN_ZWRAP
n2 = perlin(of And PERLIN_SIZE)
n2 += rxf * (perlin((of + 1) And PERLIN_SIZE) - n2)
Dim As REAL n3 = perlin((of + PERLIN_YWRAP) And PERLIN_SIZE)
n3 += rxf * (perlin((of + PERLIN_YWRAP + 1) And PERLIN_SIZE) - n3)
n2 += ryf * (n3 - n2)
n1 += noise_fsc(zf) * (n2 - n1)
r += n1 * ampl
ampl *= perlin_amp_falloff
xi Shl = 1: xf *= 2
yi Shl = 1: yf *= 2
zi Shl = 1: zf *= 2
If (xf >= 1) Then xi += 1 : xf -= 1
If (yf >= 1) Then yi += 1 : yf -= 1
If (zf >= 1) Then zi += 1 : zf -= 1
Next
Return r
End Function
'End Perlin Noise
#Define _Alpha(iCol) ((iCol And &hFF000000) Shr 24)
#Define _Red(iCol) ((iCol And &h00FF0000) Shr 16)
#Define _Green(iCol) ((iCol And &h0000FF00) Shr 8)
#Define _Blue(iCol) ((iCol And &h000000FF))
Function ColBlend(col1 As Ulong, col2 As Ulong, blend As Single) As Ulong
Dim As Ubyte a1 = _Alpha(col1), a2 = _Alpha(col2), r1 = _Red(col1), r2 = _Red(col2), g1 = _Green(col1), g2 = _Green(col2), b1 = _Blue(col1), b2 = _Blue(col2)
Dim As Single bl = 1 - blend
Return Rgba(r1 * blend + r2 * bl, g1 * blend + g2 * bl, b1 * blend + b2 * bl, a1 * blend + a2 * bl)
End Function
Sub LineAA(x1 As Single, y1 As Single, x2 As Single, y2 As Single, thickness As Single = 1, col As Ulong, pImage As Any Ptr = 0)
Dim As Single dist, db, n, nn, px, py, sensX, sensY, th, dx, dy, CosAngle, SinAngle, Factor, w = x2 - x1, h = y2 - y1
If w >= 0 Then
sensX = 1
Else
sensX = -1
w = -w
Endif
If h >= 0 Then
sensY = 1
Else
sensY = -1
h =- h
Endif
th = thickness / 2
dist = Sqr(w * w + h * h)
CosAngle = w / dist
SinAngle = -Sin(Acos(CosAngle))
For n = -thickness To w + thickness
For nn=-thickness To h + thickness
dx =n * CosAngle - nn * SinAngle
dy = Abs(n * SinAngle + nn * CosAngle)
If dy <= th + 0.5 Then
Factor = 0.5 + th - dy
If Factor > 1 Then
Factor = 1
Endif
If dx > -1 And dx < dist + 1 Then
If dx < 0 Then
Factor *= 1 + dx
Elseif dx > dist Then
Factor *= (1 - dx + dist)
Endif
Else
Factor = 0
Endif
If Factor > 0 Then
If Factor < 1 Then
px = x1 + n * SensX : py = y1 + nn * SensY
Pset pImage, (px, py), ColBlend(col, Point (px, py, pImage), Factor)
Else
Pset pImage, (x1 + n * SensX, y1 + nn * SensY), col
Endif
Endif
Endif
Next
Next
End Sub
Const w = 1920 Shr 0
Const h = 1080 Shr 0
Const w2 = w Shr 1
Const h2 = h Shr 1
Screenres w, h, 32, 2, GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH Or GFX_NO_FRAME 'Or GFX_ALWAYS_ON_TOP 'Or GFX_FULLSCREEN
Screenset 1, 0
Color &hFF, &hE0000000
Randomize, 2
Dim As Ulong iFPS, cfps = 0
Dim As Double fTimer = Timer, tt
Dim Shared As PERLINNOISE Perlin
Sub Blitz3(x1 As Double, y1 As Double, rd As Long, d As Long = 0)
If rd < 1 Then Exit Sub
Dim As Double x2, y2
Select Case d
Case 0
x2 = x1 + Perlin.Noise1D(Rnd() * y1) * 50 - 24.5
y2 = y1 + Perlin.Noise1D(y1) * 20
Case 1
x2 = x1 - Perlin.Noise1D(Rnd() * y1) * 100
y2 = y1 + Perlin.Noise1D(y1) * 100
If Rnd() > 0.1 Then
Blitz3(x2, y2, rd - 8, 0)
Else
Blitz3(x2, y2, rd - 2, 0)
Endif
Case 2
x2 = x1 + Perlin.Noise1D(Rnd() * y1) * 100
y2 = y1 + Perlin.Noise1D(y1) * 100
If Rnd() > 0.1 Then
Blitz3(x2, y2, rd - 8, 0)
Else
Blitz3(x2, y2, rd - 2, 2)
Endif
End Select
LineAA(x1, y1, x2, y2, 1 + rd / 8, &h4000007F)
LineAA(x1, y1, x2, y2, 1 + rd / 24, &hA0FFFFF0)
If rd Mod 10 = 0 Then Circle (x1, y1), 200, &h0800007F,,,, F
If rd Mod 5 = 0 Then Flip 'speed
If Rnd() > 0.9925 Then Blitz3(x2, y2, rd - 10 - Rnd() * 50, 1)
If Rnd() > 0.9925 Then Blitz3(x2, y2, rd - 10 - Rnd() * 50, 2)
Blitz3(x2, y2, rd - 1)
End Sub
Blitz3(w2 + Rnd() * 10 - 5, Rnd() * 10, 128)
tt = Timer
Do
Cls
If Timer - tt > 1 Then
Blitz3(w2 + Rnd() * 10 - 5, Rnd() * 10, 128)
tt = Timer
End If
'Flip
'Draw String(4, 4), iFPS & " fps", &hFFFFFFFF
cfps += 1
If Timer - fTimer > 0.99 Then
iFPS = cfps
cfps = 0
fTimer = Timer
End If
Sleep (1)
Loop Until Len(Inkey())
Code: Select all
'Ported from https://www.dwitter.net/d/21790 by BackendForth To FB by UEZ build 2021-03-02
#Include "fbgfx.bi"
Using FB
Randomize
Dim As Integer w = 1920 Shr 0, h = 1080 Shr 0
Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH Or GFX_NO_FRAME 'Or GFX_FULLSCREEN
Screenset 1, 0
Color &hFFFF00, &h0F000000
Dim As Ulong iFPS, cfps = 0
Dim As Double fTimer = Timer
Dim As Integer i, s = 5
Dim As Single px, py, a
Do
'Cls
For i = 4999 To 0 Step -1
px = w * Rnd
py = h * Rnd
Line (px, py) - (px + 15, py + 15), &h30000000, BF
Next
a = Rnd * w
If Rnd < 0.04 Then
For i = h To 0 Step -1
Line (a, i) - (a + s, i + s), &hA0FFFFFF, BF
Line (a, i) - (a + s, i + s), &h300000FF, B
a += (Rnd - 0.5) * s
Next
Endif
Draw String(4, 4), iFPS & " fps", &hFFFFFFFF
Flip
cfps += 1
If Timer - fTimer > 0.99 Then
iFPS = cfps
cfps = 0
fTimer = Timer
End If
Sleep(1)
Loop Until Len(Inkey())