The beauty / magic of math (Vol. 1 - 19 build 2023-05-01)

[UEZ]

This is the sequel of The beauty / magic of math (28 examples) Vol. I

Download AiO with ~802 examples (7-Zip archive): The beauty - magic of math Vol. 1 - 19 build 2023-05-01.7z (2.78 mb with source code and Windows compiled executables)

The executable files can cause false positive alarms in lame AV apps.

All source codes only can be found also on my OneDrive.


Marimo:

Code: Select all

'Ported from https://www.dwitter.net/d/9776 by yonatan to FB by UEZ build 2020-11-25

#Include "fbgfx.bi"
#Include "crt/math.bi"
Using FB


Const f23 = 2 / 3, f13 = 1 / 3, f16 = 1 / 6

Function HUE2RGB(p As Single, q As Single, t As Single) As Single
	If t < 0 Then t += 1
	If t > 1 Then t -= 1
	If t < f16 Then Return p + (q - p) * 6 * t
	If t < 0.5 Then Return q
	If t < f23 Then Return p + (q - p) * (f23 - t) * 6
	Return p
End Function

Function HSL2RGB(H As Single, S As Single, L As Single, a As Ubyte = &hFF) As Ulong
	#Define Min(a, b)		(Iif(a < b, a, b))
	#Define Max(a, b)		(Iif(a > b, a, b))
	#Define to255(v)	(Max(0, Min(255, 256 * v)))
	Dim As Single r, g, b
	If S = 0 Then
		r = L : g = L : b = L
	Else
		Dim As Single p, q
		q = Iif(L < 0.5, L * (1 + S), L + S - L * S)
		p = 2 * L - q
		r = HUE2RGB(p, q, H + f13)
		g = HUE2RGB(p, q, H)
		b = HUE2RGB(p, q, H - f13)
	End If
	Return a Shl 24 Or to255(r) Shl 16 Or to255(g) Shl 8 Or to255(b) Shl 0
End Function


Randomize
Dim As Integer w = 1920 Shr 1, h = 1080 Shr 1, w2 = w Shr 1, h2 = h Shr 1

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &h0, &hFFFFFFFF
Cls

Dim As Double fTimer = Timer, t = 0.05

Dim As Single px, py
Dim As Long i

Function Calc(mode As Ubyte, i As Long, t As Double) As Single
	Select Case mode
		Case 1
			Return 130 + Sin(i) * fmod(i, 9) + Sin(i * i) * i ^ 0.4 * t
		Case 2
			Return 130 + Cos(i) * fmod(i, 9) + Cos(i * i) * i ^ 0.4 * t
	End Select
End Function

Do
	
	If t < 5 Then
		For i = 5e3 To 0 Step -1
			px = w2 - Calc(1, i, t)
			py = 100 + Calc(2, i, t) + t * t * 2
			Line (px, py) - (px + 1 / t, py + 1), HSL2RGB(0.2722222, 0.60, (t * 13 - Calc(2, i, t) / 8) / 100)
		Next
		t += 0.005
		Flip
		Sleep(1)
	Else
		Sleep(10)
	Endif
Loop Until Len(Inkey())

Binary Field:

Code: Select all

'Ported from https://www.dwitter.net/d/20122 by taupelink to FB by UEZ build 2020-11-27

#Include "fbgfx.bi"
#Include "crt/math.bi"
Using FB

Randomize
Dim As Integer sh = 1, w = 1920 Shr sh, h = 1080 Shr sh, k = 128 shr sh

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &hFF, &hFFFFFFFF

#Define Min(a, b)	(Iif(a < b, a, b))
#Define Max(a, b)	(Iif(a > b, a, b))

Dim As Double t = 0
Dim As Single px, py, x, y, r = Rnd(), f = 1
Dim As Long i

Do
	If t < 40 Then
		For i = 64 To 0 Step -1
			y = Rnd() * 9
			x = Rnd() * 16
			px = k * x
			py = k * y
			h = k * Cos(fmod(y, (Cos(x - x * x / 16) + Sin(y))) + fmod((x * 3), (1 + y / 6))) + i 
			f = i / t
			Line (px, py) - (px + f, py + f), Rgb(Min(Max(0, h), 255), Min(Max(0, h + i), 255), Min(Max(0, fmod(h, k)), 255)), BF
		Next
		t += 0.005
		Flip
	ELse
		Sleep(10)
	Endif
Loop Until Len(Inkey())

Symmetry:

Code: Select all

'Ported from https://www.dwitter.net/d/20585 by ntsutae to FB by UEZ build 2020-11-19

#Include "fbgfx.bi"
Using FB

Randomize

Const scale = 3.0, fPi3 = Acos(-1) / 3
Dim As Long w = 1920 Shr 1, h = 1080 Shr 1, w2 = w Shr 1, h2 = h Shr 1

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &h0, &hFFFFFFFF

Dim As ULong iFPS, cfps = 0
Dim As Single x, y, px, py
Dim As Long i, d
Dim As Double fTimer = Timer, t = 0

Do
	Cls
	x = w2
	y = h2
	For i = w To 0 Step -1
		d = Sin(i / 84 + t - Cos(i / 99 - t)) * 4
		d *= fPi3
		x += Cos(d)
		y += Sin(d)
		px = w - x
		py = h - y
		Line (x, y) - (x + 4, y + 4), &hFF000000, BF
		Line (px, py) - (px + 4, py + 4), &hFF000000, BF
	Next
	t += 0.01
	Draw String(4, h - 8), iFPS & " fps", &hFF00F000
	Flip	
	
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(1)
Loop Until Len(Inkey())

Wiggly boy:

Code: Select all

'Ported from https://www.dwitter.net/d/13148 by pavel to FB by UEZ build 2020-11-27

#Include "fbgfx.bi"
#Include "crt/math.bi"
Using FB

Randomize
Dim As Integer w = 1920 Shr 1, h = 1080 Shr 1, w2 = w Shr 1, h2 = h Shr 1

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &h0, &hFFFFFFFF

Dim As ULong iFPS, cfps = 0
Dim As Double fTimer = Timer, t = Rnd()

Dim As Single px, py, a, b, u, s, z
Dim As Long i, k, c

Do
	Cls
	a = 0 : b = 0 : u = 0
	For i = 0 To 99 * t
		u += fmod(i ^ 0.9, 1) - 0.5
		a += Cos(u) / 69
		s = 20 / z / z
		b += Sin(u) / 69
		z = 2 + Sin(a + t) * Sin(b)
		px = w2 + w2 * Cos(a + t) * Sin(b) / z
		py = h2 + w2 * Cos(b) / z
		'Line (px, py) - (px + s, py + s), &hA0000000, BF
		Circle (px, py), s, &h40000000,,,, F
	Next
	
	t += 0.01
	If t > 256 then t = 0
	
	Draw String(4, 4), iFPS & " fps", &hFF0000FF
	Flip
	
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(1)
Loop Until Len(Inkey())

Plasma2:

Code: Select all

'Ported from https://www.dwitter.net/d/5321 by hoplite to FB by UEZ build 2020-11-27

#Include "fbgfx.bi"
Using FB

#Define Min(a, b)	(Iif(a < b, a, b))
#Define Max(a, b)	(Iif(a > b, a, b))

Randomize
Dim Shared As Integer w, h, w2, h2
w = 1920 Shr 2 : h = 1080 Shr 2 : w2 = w Shr 1 : h2 = h Shr 1
Dim Shared As Ulong Ptr pScrn

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &h0, &hFF000000

Dim As ULong iFPS, cfps = 0
Dim As Double fTimer = Timer, t = 9

Dim As Single scale = 4
w /= scale : h /= scale

Dim As Single px, py
Dim As Long i, k

#Macro Col(t)
	Max(0, Min(255, (Sin(i / 9 + t) * Sin(k / 7) + Sin(k / 9 + t) * Sin(i / 7 - t)) * 256))
#Endmacro

Do
	For i = w - 1 To 0 Step -1
		For k = h - 1 To 0 Step -1
			px = i * scale
			py = k * scale
			Line (px, py) - (px + scale, py + scale), Rgb(Col(t), Col(t + 0.2), Col(t + 0.4)), BF
			'Pset (i, k), Rgb(Col(t), Col(t + 0.2), Col(t + 0.4))
		Next
	Next
	t += 0.016
	Draw String(4, 4), iFPS & " fps", &hFF00FF00
	Flip
	
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(1)
Loop Until Len(Inkey())

Octopus Ride:

Code: Select all

'Ported from https://www.dwitter.net/d/15172 by jylikangas to FB by UEZ build 2020-12-07

#Include "fbgfx.bi"
Using FB

#Define Min(a, b)		(Iif(a < b, a, b))
#Define Max(a, b)		(Iif(a > b, a, b))


type BImage
    as integer width, height, pitch
    as long ptr pixels
end type

'Super Fast Blur v1.1 by Mario Klingemann <http://incubator.quasimondo.com> adapted by counting_pine
sub SuperFastBlur(img as BImage, radius as integer)
    if radius < 1 then return
	
    dim as integer w = img.width
    dim as integer h = img.height
    dim as integer pitch = img.pitch: assert(pitch mod 4 = 0)
    dim as integer pitch4 = pitch\4
    dim as integer wm = w-1
    dim as integer hm = h-1
    dim as integer wh = w*h
    dim as integer div = radius*2+1
    dim as integer r(0 to wh-1)
    dim as integer g(0 to wh-1)
    dim as integer b(0 to wh-1)
    dim as integer rsum,gsum,bsum,x,y,i,p,p1,p2,yp,yi,yw
    dim as integer vmin(0 to max(w,h)-1)
    dim as integer vmax(0 to max(w,h)-1)
    dim as long ptr pix = img.pixels
    dim as integer dv(0 to 256*div-1)
    
    for i = 0 to 256*div-1
        dv(i) = i\div
    next i
    
    yw = 0: yi = 0
    
    for y = 0 to hm
        rsum = 0: gsum = 0: bsum = 0
        for i = -radius to radius
            p = pix[yw+min(wm,max(i,0))]
            rsum += (p and &hff0000) shr 16
            gsum += (p and &h00ff00) shr 8
            bsum += (p and &h0000ff)
        next i
        for x = 0 to wm
            r(yi) = dv(rsum)
            g(yi) = dv(gsum)
            b(yi) = dv(bsum)
            
            if y = 0 then
                vmin(x) = min(x + radius + 1, wm)
                vmax(x) = max(x - radius,      0)
            end if
            p1 = pix[yw+vmin(x)]
            p2 = pix[yw+vmax(x)]
            
            rsum += ((p1 and &hff0000)-(p2 and &hff0000)) shr 16
            gsum += ((p1 and &h00ff00)-(p2 and &h00ff00)) shr 8
            bsum += ((p1 and &h0000ff)-(p2 and &h0000ff))
            yi += 1
        next x
        yw+=pitch4
    next y
    
    for x = 0 to wm
        rsum = 0: gsum = 0: bsum = 0
        yp = -radius*w
        for i = -radius to radius
            yi = max(0, yp) + x
            rsum += r(yi)
            gsum += g(yi)
            bsum += b(yi)
            yp += w
        next i
        yi = x
        for y = 0 to hm
            pix[yi] = &hff000000 or (dv(rsum) shl 16) or (dv(gsum) shl 8) or dv(bsum)
            if x = 0 then
                vmin(y) = min(y + radius + 1, hm) * w
                vmax(y) = max(y - radius,      0) * w
            end if
            p1 = x + vmin(y)
            p2 = x + vmax(y)
            
            rsum += r(p1) - r(p2)
            gsum += g(p1) - g(p2)
            bsum += b(p1) - b(p2)
            
            yi += pitch4
        next y
    next x
end sub

Const pi = Acos(-1)
Randomize
Dim Shared As Integer w, h, w2, h2
w = 1920 Shr 2 : h = 1080 Shr 2 : w2 = w Shr 1 : h2 = h Shr 1
Dim Shared As Ulong Ptr pScrn

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &h0, &hFF000000
Cls

Dim As Any Ptr pImage = Imagecreate(w, h, 0, 32)
Dim As BImage pImage_blur
Imageinfo(pImage, pImage_blur.Width, pImage_blur.height, , pImage_blur.pitch, pImage_blur.pixels)

Dim As ULong iFPS, cfps = 0
Dim As Double fTimer = Timer, t = 0
Dim As Single sy, a, y, rx = w2, r = rx, ry = h * 0.8, px, py, tr, tg, tb
Dim As Long i, c, b


Do
	Line pImage, (0, 0) - (w, h), &h300C090A, BF
	r = rx
	For i = -5 To 6
		a = i * 111 + t
		y = ry * 0.5 + 20 * Cos(a)
		r += 120 * Sin(a)
		px = r + y / 3 * Sin(i / 2 + t * 5)
		py = y - 9 * Cos(a / 4)
		b = Max(0, Min(255, y))
		
		' sephia
		tr = 0.393 * b + 0.769 * b + 0.189 * b
		tg = 0.349 * b + 0.686 * b + 0.168 * b
		tb = 0.272 * b + 0.534 * b + 0.131 * b
		c = Rgba(255 Xor Min(255, tr), 255 Xor Min(255, tg), 255 Xor Min(255, tb), &h40) 'inverted color
		
		Line pImage, (px + y / 14, py) - (r, y), c 'Gondel
		Line pImage, (rx, ry) - (r, y), c
		Circle pImage, (px, py), y / 14, c, pi, 0,
		sy = ry + Cos(i / 4) * 6
		Line pImage, (rx, sy) - (rx + i * 7, sy + 8), c, BF
	Next
	t += 0.0125
	
	SuperFastBlur(pImage_blur, 1)
	Put (0, 0), pImage, Pset

	Draw String(4, 4), iFPS & " fps", &hFF00F000
	Flip
	
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(1)
Loop Until Len(Inkey())

Imagedestroy(pImage)

CHOO CHOO:

Code: Select all

'Ported from https://www.dwitter.net/d/7702 by jylikangas to FB by UEZ build 2020-11-27

#Include "fbgfx.bi"
#Include "crt/math.bi"
Using FB

Randomize
Dim Shared As Integer w, h, w2, h2
w = 1920 Shr 0 : h = 1080 Shr 0 : w2 = w Shr 1 : h2 = h Shr 1
Dim Shared As Ulong Ptr pScrn

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH  or GFX_FULLSCREEN
Screenset 1, 0
Color &h0, &hA0F5F5DC
Cls

Dim As ULong iFPS, cfps = 0
Dim As Double fTimer = Timer, t = Rnd()

Dim As Long i

Sub F(a As Single, o As Single, t As Double, m as ubyte = 0)
	Dim As Single z = Cos(a) + 1 + Iif((fmod(t, 6) < 3), 1, 0), _
				  x = w2 + Sin(a) * 290 - o / z, _
				  y = h2 + Cos(a * Int(fmod(t / 6, 4))) * 99 /  z
	o /= (z / 2)
	If m Then
		Line (x, y) - (x + o, y + o), &hF02B1B17, BF
	ELse
		Line (x, y) - (x + o, y + o), &h20000000, B
	end if
End Sub

Do
	Cls
	For i = 714 To 0 Step -1
		F(t + i / 714 + (i Shr 7)/9,-9, t, 1)
		F(i, 4, t)
	Next
	t += 0.01666
	Draw String(4, 4), iFPS & " fps", &hFF00F000
	Flip
	
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(1)
Loop Until Len(Inkey())

Tunnel Effect:

Code: Select all

'Ported from https://www.dwitter.net/d/1231 by iverjo to FB by UEZ build 2020-11-25

#Include "fbgfx.bi"
#Include "crt/math.bi"
Using FB

#Define Min(a, b)	(Iif(a < b, a, b))
#Define Max(a, b)	(Iif(a > b, a, b))

Randomize
Dim Shared As Integer w, h, w2, h2
w = 1920 Shr 1 : h = 1080 Shr 1 : w2 = w Shr 1 : h2 = h Shr 1
Dim Shared As Ulong Ptr pScrn

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &h0, &hFFFFFFFF

Dim As ULong iFPS, cfps = 0
Dim As Double fTimer = Timer, t = -1e9

Dim As Single s, j, r
Dim As Long i

Sub DrawThickLine(Byval x1 As Integer, Byval y1 As Integer, Byval x2 As Integer, Byval y2 As Integer, Byval size As Integer, Byval c As Uinteger) 'by dodicat
	If x1 = x2 And y1 = y2 Then
		Circle (x1, y1), size, c, , , , f
	Elseif Abs(x2 - x1) >= Abs(y2 - y1) Then
		Dim K As Single = (y2 - y1) / (x2 - x1)
		For I As Integer = x1 To x2 Step Sgn(x2 - x1)
		  Circle (I, K * (I - x1) + y1), size, c, , , , f
		Next I
	Else
		Dim L As Single = (x2 - x1) / (y2 - y1)
		For J As Integer = y1 To y2 Step Sgn(y2 - y1)
		  Circle (L * (J - y1) + x1, J), size, c, , , , f
		Next J
	End If
End Sub

Sub Arc(x As Single, y As Single, ro As Single, ri As Single, col As Ulong, thick As ULong = 8, a1 As Single, a2 As Single)
	For a As Single = a1 To a2 Step 0.01
		'Line (x + Sin(a) * ri, y + Cos(a) * ri) - (x + Sin(a) * ro, y + Cos(a) * ro), col
		DrawThickLine (x + Sin(a) * ri, y + Cos(a) * ri, x + Sin(a) * ro, y + Cos(a) * ro, thick, col)
	Next
End Sub

Do
	Cls
	For i = 9 To 2e3 Step 2
		s = 3 / fmod(9.1 - (t + i / 99), 9)
		j = i * 7 + Sin(i * 4 + t + Sin(t))
		r = Min(s * 49, w)
		Circle (w2, h2), r, &hFF000000, j, j + 0.6
		'Arc(w2, h2, r, r +  Min(s * s, 20), &hFF000000, Min(s * s, 10), j, j + 0.6)
		t += 0.00002
	Next
	If t > 9 Then t = 0
	Draw String(4, 4), iFPS & " fps", &hFFFF0000
	Flip
	
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(1)
Loop Until Len(Inkey())

Starfield:

Code: Select all

'Ported from https://www.dwitter.net/d/10991 by cantelope to FB by UEZ build 2020-11-24

#Include "fbgfx.bi"
#Include "crt/math.bi"

Using FB

Randomize
Dim As Integer w = 960, h = 600, w2 = w Shr 1, h2 = h Shr 1

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &hFF, &hFF000000
Cls

Dim As ULong iFPS, cfps = 0
Dim As Double fTimer = Timer, t = 0
Dim As Single z, x, y, s
Dim As Long i
Dim as ubyte c, a

#Define Map(Val, source_start, source_stop, dest_start, dest_stop)   ((Val - source_start) * (dest_stop - dest_start) / (source_stop - source_start) + dest_start)

Dim As Single mi = 100000, ma = -100000
Do
	Cls
	For i = 2e3 To 0 Step -1
		z = 7.5 - fmod(i * i * i / w + Sin(t / 4) * 24, 6)
		x = (4 - fmod(i / 9 + Cos(t / 4) * 24, 8)) / z * w
		y = (3 - fmod(i * i / w, 6)) / z * w
		s = 2 + 9 / z / z
		a = Map(z, 1.5, 7.5, 255, 4)
		c = Map(z, 1.5, 7.5, 255, 128)
		Line (x, y) - (x + s, y + s), Rgba(c, c, c, a), bf
		t += 0.0000025
	Next
	Draw String(4, 4), iFPS & " fps", &hFF00FF00
	Flip	
	
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(1)
Loop Until Len(Inkey())

Lit and Colored Sphere:

Code: Select all

'Ported from https://www.dwitter.net/d/7111 by yonatan to FB by UEZ build 2020-11-24

#Include "fbgfx.bi"
Using FB

#Define Min(a, b)	(Iif(a < b, a, b))
#Define Max(a, b)	(Iif(a > b, a, b))
#Define Map(Val, source_start, source_stop, dest_start, dest_stop)   ((Val - source_start) * (dest_stop - dest_start) / (source_stop - source_start) + dest_start)
	   
Const f23 = 2 / 3, f13 = 1 / 3, f16 = 1 / 6

Function HUE2RGB(p As Single, q As Single, t As Single) As Single
	If t < 0 Then t += 1
	If t > 1 Then t -= 1
	If t < f16 Then Return p + (q - p) * 6 * t
	If t < 0.5 Then Return q
	If t < f23 Then Return p + (q - p) * (f23 - t) * 6
	Return p
End Function

Function HSL2RGB(H As Single, S As Single, L As Single, a As Ubyte = &hFF) As Ulong
	#Define to255(v)	(Max(0, Min(255, 256 * v)))
	Dim As Single r, g, b
	If S = 0 Then
		r = L : g = L : b = L
	Else
		Dim As Single p, q
		q = Iif(L < 0.5, L * (1 + S), L + S - L * S)
		p = 2 * L - q
		r = HUE2RGB(p, q, H + f13)
		g = HUE2RGB(p, q, H)
		b = HUE2RGB(p, q, H - f13)
	End If
	Return a Shl 24 Or to255(r) Shl 16 Or to255(g) Shl 8 Or to255(b) Shl 0
End Function


Randomize
Dim As Integer w = 400, h = w

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0

Dim As ULong iFPS, cfps = 0
Dim As Double fTimer = Timer, t = 0

Dim As Single px, py, z, q, s = 4
Dim As Long x, y


Do
	For x = 99 To 0 Step -1
		For y = 99 To 0 Step -1
			q = x * x + y * y
			z = (9e3 - q) ^ -0.3
			Line (x * s, y * s) - ((x + 1) * s, (y + 1) * s), HSL2RGB(((t * 9 + (X * z) Xor (Y * z)) * 22) / 360, 0.50, (95 - Sqr(q)) / 100), BF
		Next
		t += 0.000025
	Next
	
	Draw String(4, h - 8), iFPS & " fps", &hFFF0F0F0
	Flip
	
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(1)
Loop Until Len(Inkey())

Infinity:

Code: Select all

'Ported from https://www.dwitter.net/d/16383 by username to FB by UEZ build 2020-11-21

#Include "fbgfx.bi"
#Include "crt/math.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)

Randomize
Dim As Integer w = 1920 Shr 1, h = 1080 Shr 1, w2 = w Shr 1, h2 = h Shr 1

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &h0, &hF0FFFFFF

Dim As ULong iFPS, cfps = 0
Dim As Single px, py, a, d, b
Dim As Long i, j
Dim As Double fTimer = Timer, t = 0

Do
	Cls
	For j = 1 To 10 Step 9
		For i = -45 To 45
			a = 2.7 ^ fmod(t / 2, 2.3)
			d = i * 20 * j * a + w2
			b = 5 - 5 / a / j
			Line (d, 0) - (d + b, h), Rgba(0, 0, 0, Map(b, 0, 5, 2, &hF0)), BF
			Line (0, d) - (w, d + b), Rgba(0, 0, 0, Map(b, 0, 5, 2, &hF0)), BF
		Next
	Next
	t += 0.01
	Draw String(4, 4), iFPS & " fps", &hFFF00000
	Flip
	
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(1)
Loop Until Len(Inkey())

The Enemy:

Code: Select all

'Ported from https://www.dwitter.net/d/17953 by tomxor to FB by UEZ build 2020-12-07

#Include "fbgfx.bi"
Using FB

#Define Min(a, b)	(Iif(a < b, a, b))
#Define Max(a, b)	(Iif(a > b, a, b))
#Define Map(Val, source_start, source_stop, dest_start, dest_stop)   ((Val - source_start) * (dest_stop - dest_start) / (source_stop - source_start) + dest_start)

type BImage
    as integer width, height, pitch
    as long ptr pixels
end type

'Super Fast Blur v1.1 by Mario Klingemann <http://incubator.quasimondo.com> adapted by counting_pine
sub SuperFastBlur(img as BImage, radius as integer)
    if radius < 1 then return
	
    dim as integer w = img.width
    dim as integer h = img.height
    dim as integer pitch = img.pitch: assert(pitch mod 4 = 0)
    dim as integer pitch4 = pitch\4
    dim as integer wm = w-1
    dim as integer hm = h-1
    dim as integer wh = w*h
    dim as integer div = radius*2+1
    dim as integer r(0 to wh-1)
    dim as integer g(0 to wh-1)
    dim as integer b(0 to wh-1)
    dim as integer rsum,gsum,bsum,x,y,i,p,p1,p2,yp,yi,yw
    dim as integer vmin(0 to max(w,h)-1)
    dim as integer vmax(0 to max(w,h)-1)
    dim as long ptr pix = img.pixels
    dim as integer dv(0 to 256*div-1)
    
    for i = 0 to 256*div-1
        dv(i) = i\div
    next i
    
    yw = 0: yi = 0
    
    for y = 0 to hm
        rsum = 0: gsum = 0: bsum = 0
        for i = -radius to radius
            p = pix[yw+min(wm,max(i,0))]
            rsum += (p and &hff0000) shr 16
            gsum += (p and &h00ff00) shr 8
            bsum += (p and &h0000ff)
        next i
        for x = 0 to wm
            r(yi) = dv(rsum)
            g(yi) = dv(gsum)
            b(yi) = dv(bsum)
            
            if y = 0 then
                vmin(x) = min(x + radius + 1, wm)
                vmax(x) = max(x - radius,      0)
            end if
            p1 = pix[yw+vmin(x)]
            p2 = pix[yw+vmax(x)]
            
            rsum += ((p1 and &hff0000)-(p2 and &hff0000)) shr 16
            gsum += ((p1 and &h00ff00)-(p2 and &h00ff00)) shr 8
            bsum += ((p1 and &h0000ff)-(p2 and &h0000ff))
            yi += 1
        next x
        yw+=pitch4
    next y
    
    for x = 0 to wm
        rsum = 0: gsum = 0: bsum = 0
        yp = -radius*w
        for i = -radius to radius
            yi = max(0, yp) + x
            rsum += r(yi)
            gsum += g(yi)
            bsum += b(yi)
            yp += w
        next i
        yi = x
        for y = 0 to hm
            pix[yi] = &hff000000 or (dv(rsum) shl 16) or (dv(gsum) shl 8) or dv(bsum)
            if x = 0 then
                vmin(y) = min(y + radius + 1, hm) * w
                vmax(y) = max(y - radius,      0) * w
            end if
            p1 = x + vmin(y)
            p2 = x + vmax(y)
            
            rsum += r(p1) - r(p2)
            gsum += g(p1) - g(p2)
            bsum += b(p1) - b(p2)
            
            yi += pitch4
        next y
    next x
end sub

Randomize
Dim Shared As Integer w, h, w2, h2
w = 1920 Shr 1 : h = 1080 Shr 1 : w2 = w Shr 1 : h2 = h Shr 1

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &hFFFFFF, &hFF000000

Dim As Any Ptr pImage = Imagecreate(w, h, 0, 32)
Dim As BImage pImage_blur
Imageinfo(pImage, pImage_blur.Width, pImage_blur.height, , pImage_blur.pitch, pImage_blur.pixels)

Dim As ULong iFPS, cfps = 0
Dim As Double fTimer = Timer, t = 0

Dim As Single px, py, pp, vv, scale = 6
Dim As Long i, m, v, p, c

Do
	Line pImage, (0, 0) - (w, h), &hFF000000, BF
	
	For i = 3e3 To 0 Step -1
		m = i And 1

		v = 16 - m * 2
		p = 5 * (Iif((i Mod 48) < 18, 1, 0))
		
		vv = (i ^ 0.5) + t - (t * m * 1.5)
		pp = (i ^ 0.7) + t
		
		px = (80 + m * 50 + p * Sin(pp) + v * Cos(vv)) * scale
		py = (40 + m * 20 + p * Cos(pp) + v * Sin(vv) * Cos((p = False) * i)) * scale
		c = 255 - Iif(m, Map(px, 59 * scale, 149 * scale, 0, 128), Map(py, 19 * scale, 78 * scale, 0, 128))		
		px -= 130
		py -= 60
		Line pImage, (px, py) - (px + 1, py + (0.7 - m * 0.5) * scale), Rgba(c, c, c, &h40), BF
		t += 0.000001
	Next
		
	SuperFastBlur(pImage_blur, 2)
	Put (0, 0), pImage, Pset
	
	Draw String(4, 4), iFPS & " fps", &hFF00F000
	Flip
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(1)
Loop Until Len(Inkey())

Imagedestroy(pImage)

Saturn:

Code: Select all

'Ported from https://www.dwitter.net/d/10534 by tomxor to FB by UEZ build 2020-11-01

#Include "fbgfx.bi"
#Include "crt/math.bi"

Using FB

Randomize
Dim As Integer w = 1920 Shr 1, h = 1080 Shr 1, w2 = w Shr 1, h2 = h Shr 1

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &hFF, &hFF000000

Dim As ULong iFPS, cfps = 0
Dim As Single px, py, m, n, s
Dim As Long i, p, d = 1 
Dim As Double fTimer = Timer, t = 80

Do
	Cls
	For i = 2499 To 0 Step -1
		p = i And 1
		n = t / 9 + i * i
		s = 3 - Cos(n) * 3
		m = t / Cos(t / i) + p * (t / 2 + fmod(i, t))
		px = w2 + m * Sin(n) * Cos((p = False) * i / t)
		py = h2 + m * Cos(n + p * 2)
		s = Abs(s)
		Line (px, py) - (px + s, py + s), Rgba(&hFF, &hFF, &hFF, s * 40), BF
		'Circle (px, py), s, &hF0FFFFFF,,,, F
		t += 0.0000025 * d
	Next
	If t > 100 Or t < 80 Then d *= -1
	Draw String(4, 4), iFPS & " fps", &hFF00F000
	Flip	
	
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(1)
Loop Until Len(Inkey())

Saturn2:

Code: Select all

'Ported from https://www.dwitter.net/d/17271 by tomxor to FB by UEZ build 2020-11-23

#Include "fbgfx.bi"

Using FB

Randomize
Dim As Integer w = 1920 Shr 0, h = 1080 Shr 0, w2 = w Shr 1, h2 = h Shr 1

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH Or GFX_FULLSCREEN
Screenset 1, 0
Color &hFFFFFF, &hFF000000

Dim As ULong iFPS, cfps = 0
Dim As Double fTimer = Timer, t = 0

Dim As Single px, py, sx, s, pi = Acos(-1), a, b, y
Dim As Long i, p, ps = w Shr 3 
Dim As Ubyte c, ac
Cls

For i = 1 To 1000
	Pset (w * Rnd(), h * Rnd()), Rgba(255, 255, 255, 128 * Rnd())
Next

	
Do
	If t < 0.15 Then
		a = pi
		b = pi
		For i = 1e4 To 0 Step -1
			p = i And 4
			s = ps + p * a * 35
			a += (((t * i / b) And 1) - a + b * Sin(a * pi)) / 2
			b += (-a * b + Cos(a * pi)) / 2
			y = b * pi + p * b * 9
			px = w2 + s * Sin(y) * Cos((p = False) * a * pi)
			py = h2 + s * Cos(y - p / 2)
			sx = 0.03 - Sin(y + p * 0.4) * 0.03
			c = (p = False) * 200
			ac = sx * 255
			Line (px, py) - (px + sx, py), Rgba(255, 255 - c / 2, 255 - c * 1.5, ac), BF
			t += 0.00000005
		Next
		't += 0.0005
		Flip
	Endif

	Sleep(10)
Loop Until Len(Inkey())

Birds:

Code: Select all

'Ported from https://www.dwitter.net/d/17888 by New_Core to FB by UEZ build 2020-11-22

#Include "fbgfx.bi"
Using FB

#Define Min(a, b)	(Iif(a < b, a, b))

Dim Shared As Integer w, h, w2, h2
w = 1920 Shr 1 : h = 1080 Shr 1 : w2 = w Shr 1 : h2 = h Shr 1

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &h0, &hFFFFFFFF

Dim As ULong iFPS, cfps = 0
Dim As Double fTimer = Timer, t = 0

Dim As Single px, py, v, z
Dim As Long i, j 


Do
	Cls
	For j = 9 To 0 Step -1
		For i = 60 To 0 Step -1
			v = i / 60
			z = 2 ^ Tan(t / 5 + j)
			px = w2 + j * z * 50 * Sin(j) + (99 * Sin(i * 22) * z)
			py = h2 + i * Sin(v) * Cos(v - t * 3 + j) * z
			Line (px, py) - (px + z * 2, py + z * 9 * Sin(i / 16 - 4) + 5), Rgba(0, 0, 0, 255 - Min(255, 4 * z)), BF
			t += 0.00005
		Next
	Next
	
	Draw String(4, 4), iFPS & " fps", &hFF00F000
	
	Flip
	
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(1)
Loop Until Len(Inkey())

Sierpinski Dance:

Code: Select all

'Ported from https://www.dwitter.net/d/18081 by pavel to FB by UEZ build 2020-11-21

#Include "fbgfx.bi"
Using FB

Randomize
Dim Shared As Integer w, h, w2, h2, f
w = 1920 Shr 1 : h = 1080 Shr 1 : w2 = w Shr 1 : h2 = h Shr 1 : f = 1e3 Shr 1

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &hFF, &hF0FFFFFF
Cls

Dim As ULong iFPS, cfps = 0
Dim Shared As Double fTimer, t
fTimer = Timer : t = 0


Sub Rec(x As Single, y As Single, d As Single)
	If d Shr 8 Then
		Dim As Single a = y - 4 * t, z = 2 + x * Sin(a), px, py
		px = w2 + f * x * Cos(a) / z
		py = h2 + f * y / z
		Line (px, py) - (px + 3, py + 3), &hA0000000, BF
	Else
		Rec(x + Cos(t    ) / d, y + Sin(t    ) / d, 2 * d)
		Rec(x + Cos(t + 2) / d, y + Sin(t + 2) / d, 2 * d)
		Rec(x + Cos(t + 4) / d, y + Sin(t + 4) / d, 2 * d)
	End If
End Sub

Do
	Cls
	Rec(0, 0, 2)
	t += 0.0075
	Draw String(4, 4), iFPS & " fps", &hFF00F000
	Flip
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(1)
Loop Until Len(Inkey())

Flare:

Code: Select all

'Ported from https://www.dwitter.net/d/18112 by pavel to FB by UEZ build 2020-11-20

#Include "fbgfx.bi"
#Include "crt/math.bi"
Using FB

#Define Min(a, b)	(Iif(a < b, a, b))
#Define Max(a, b)	(Iif(a > b, a, b))
#Define Map(Val, source_start, source_stop, dest_start, dest_stop)   ((Val - source_start) * (dest_stop - dest_start) / (source_stop - source_start) + dest_start)
	   
Const f23 = 2 / 3, f13 = 1 / 3, f16 = 1 / 6

Function HUE2RGB(p As Single, q As Single, t As Single) As Single
	If t < 0 Then t += 1
	If t > 1 Then t -= 1
	If t < f16 Then Return p + (q - p) * 6 * t
	If t < 0.5 Then Return q
	If t < f23 Then Return p + (q - p) * (f23 - t) * 6
	Return p
End Function

Function HSL2RGB(H As Single, S As Single, L As Single, a As Ubyte = &hFF) As Ulong
	#Define to255(v)	(Max(0, Min(255, 256 * v)))
	Dim As Single r, g, b
	If S = 0 Then
		r = L : g = L : b = L
	Else
		Dim As Single p, q
		q = Iif(L < 0.5, L * (1 + S), L + S - L * S)
		p = 2 * L - q
		r = HUE2RGB(p, q, H + f13)
		g = HUE2RGB(p, q, H)
		b = HUE2RGB(p, q, H - f13)
	End If
	Return a Shl 24 Or to255(r) Shl 16 Or to255(g) Shl 8 Or to255(b) Shl 0
End Function

Randomize
Dim As Integer w = 1920 Shr 0, h = 1080 Shr 0, w2 = w Shr 1, h2 = h Shr 1

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH Or GFX_NO_FRAME
Screenset 1, 0
Color &hFF, &hFF000000
Cls

Dim As ULong iFPS, cfps = 0
Dim As Double fTimer = Timer, t = 0
Dim As Single px, py, u(w - 1), Hue, Sat, Lum
Dim As Long i, tt = 32, d = 1

Do
	Cls
	For i = w - 1 To 0 Step -1
		px = i And -tt
		py = (i Mod tt) * tt
		Hue = (tt * t)
		Sat = 0.99
		u(i) = u(i) * 0.94 + tt / Hypot(i / tt - tt - Cos(3 * t) * 20, (i Mod tt) - 16 - Sin(4 * t) * 9)
		Lum = u(i) 'Shr 0
		Line (px, py) - (px + tt, py + tt), HSL2RGB(Hue / 360, Sat, Lum / 100), BF
	Next
	t += 0.0125 * d
	If t > 24 Or t < -17.5 Then d *= -1
	Draw String(4, 4), iFPS & " fps", &hFF00F000
	Flip
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(1)
Loop Until Len(Inkey())

WOW:

Code: Select all

'Ported from https://www.dwitter.net/d/19000 by katkip to FB by UEZ build 2020-11-20

#Include "fbgfx.bi"
Using FB

Randomize
Dim As Integer w = 1920 Shr 2 + 11, h = 1080 Shr 1

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &hFF, &hFF000000

Dim As Any Ptr pImageline = Imagecreate(w, 1, 0, 32)
Dim As ULong iFPS, cfps = 0
Dim As Integer x, y, yy1, yy2

Dim As Ulong Ptr pScrn = Screenptr()
Dim As Double fTimer = Timer, t = 0
Dim As Ubyte r, g, b

Function f(x As Single, y As Single, n As Integer = 0) As Integer
	If Sin(y - n / 2) > Cos(x) and n < 256 Then Return f(x * x - y, y * y - x, n + 3)
	Return n * 10
End Function

Do
	For x = w - 1 To 0 Step -1
		r = f(x / 13, t * 3, 3)
		g = f(x / 13, t * 3, 4)
		b = f(x / 13, t * 3, 5)
		Line pImageline, (x, 0) - (x, 0), Rgb(r, g, b), BF
		t += 0.000025
	Next
	Put (0, 0), pImageline, Pset
	
	For y = h - 1 To 1 Step -1
		yy1 = y * w
		yy2 = (y - 1) * w
		For x = w - 1 To 0 Step -1
			pScrn[yy1 + x] = pScrn[yy2 + x]
		Next
	Next

	Flip	
	
	cfps += 1
	If Timer - fTimer > 0.99 Then
		Windowtitle "WOW / FPS: " & iFPS 
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(10)
Loop Until Len(Inkey())

Imagedestroy(pImageline)

Fractal Zoom:

Code: Select all

'Ported from https://www.dwitter.net/d/18428 by tomxor to FB by UEZ build 2020-11-20

#Include "fbgfx.bi"
Using FB

Randomize
Dim As Integer w = 1920 Shr 2, h = 1080 Shr 2, w2 = w Shr 1, h2 = w2 * 9 \ 16

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &hFF, &hFF000000
Cls

#Define PixelSetScrn(_x, _y, colour)		*Cptr(Ulong Ptr, pScrn + (_y) * pitch + (_x) * imgData) = (colour)
Dim As Integer imgData, pitch
Dim As Any Ptr pScrn
ScreenInfo , , , imgData, pitch
pScrn = Screenptr()

Dim As ULong iFPS, cfps = 0
Dim As Double fTimer = Timer, t = 1, x, y, col
Dim As Long i, iterations = w * h2 * 2 - w
Dim As Ubyte c

Function Rec(x As Double, y As Double, n As Long) As Double
	If n > x and n > -1 Then Return Rec(x * x - y * y - 0.8, 2 * x * y + 0.2, n - 1)
	Return Sin(n / 9)
End Function

Do
	Cls
	For i = 0 To iterations
		x = i Mod w
		y = i \ w
		col = Rec((x - w2) / t ^ 8, (y - h2) / t ^ 8 - 0.703956, w)
		c = 255 - 255 * col
		'Line (x, y) - (x, y + col), Rgb(c, c, c)
		PixelSetScrn(Culng(x), Culng(y), Rgb(c, c, c))
	Next
	t += 0.001666666
	Draw String(4, 4), iFPS & " fps", &hFF00F000
	Flip
	If t > 30 Then t = 1
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(1)
Loop Until Len(Inkey())

Mountain Journey:

Code: Select all

'Ported from https://www.dwitter.net/d/20689 by yonatan to FB by UEZ build 2020-11-18

#Include "fbgfx.bi"
Using FB

#Define Min(a, b)	(Iif(a < b, a, b))
#Define Max(a, b)	(Iif(a > b, a, b))
#Define Map(Val, source_start, source_stop, dest_start, dest_stop)   ((Val - source_start) * (dest_stop - dest_start) / (source_stop - source_start) + dest_start)

Const f23 = 2 / 3, f13 = 1 / 3, f16 = 1 / 6

Function HUE2RGB(p As Single, q As Single, t As Single) As Single
	If t < 0 Then t += 1
	If t > 1 Then t -= 1
	If t < f16 Then Return p + (q - p) * 6 * t
	If t < 0.5 Then Return q
	If t < f23 Then Return p + (q - p) * (f23 - t) * 6
	Return p
End Function

Function HSL2RGB(H As Single, S As Single, L As Single, a As Ubyte = &hFF) As Ulong
	#Define to255(v)	(Max(0, Min(255, 256 * v)))
	Dim As Single r, g, b
	If S = 0 Then
		r = L : g = L : b = L
	Else
		Dim As Single p, q
		q = Iif(L < 0.5, L * (1 + S), L + S - L * S)
		p = 2 * L - q
		r = HUE2RGB(p, q, H + f13)
		g = HUE2RGB(p, q, H)
		b = HUE2RGB(p, q, H - f13)
	End If
	Return a Shl 24 Or to255(r) Shl 16 Or to255(g) Shl 8 Or to255(b) Shl 0
End Function

Randomize
Const scale = 4, ww = 150
Dim As Single w = ww * scale, h = Max(100, 100 * scale - 100)

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &hFFFFFF, &hC0000000
Dim As Uinteger iFPS, cfps = 0

Dim As Single px, py, a, n, k, y
Dim As Integer m, x, j, l = 30
Dim As Double fTimer = Timer, t = 0

Do
	Cls
	For m = l To 1 Step -1
		For x = 1 To ww
			a = 3
			For j = 0 To 5
				a += Sin(((t / m * ww + x) + 9 * Sin(m * k)) * k / 9) / k
				k = 2 ^ j
			Next
			y = a * (l - m - 1) / (2 + (Sin(t / 3) / 2))
			px = x * scale
			py = y * scale
			If py >= 0 then Line (px, py) - (px + scale - 1, Min(h, (y + ww) * scale)), HSL2RGB(0.666667, m * 0.03, Map(50 + Sin((1 - m / l) * 4) * 50, 0, 100, 0, 1), &hFF - m * scale), BF
		Next
	Next
	t += 0.0075
	Draw String(4, h - 8), iFPS & " fps", &hFF00F000
	Flip	
	
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(1)
Loop Until Len(Inkey())

Shell with Lights:

Code: Select all

'Ported from https://codegolf.dweet.net/a/280 by yonatan to FB by UEZ build 2020-11-04

#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 Min(a, b)	(Iif(a < b, a, b))
#Define Max(a, b)	(Iif(a > b, a, b))

Const f23 = 2 / 3, f13 = 1 / 3, f16 = 1 / 6

Function HUE2RGB(p As Single, q As Single, t As Single) As Single
	If t < 0 Then t += 1
	If t > 1 Then t -= 1
	If t < f16 Then Return p + (q - p) * 6 * t
	If t < 0.5 Then Return q
	If t < f23 Then Return p + (q - p) * (f23 - t) * 6
	Return p
End Function

Function HSL2RGB(H As Single, S As Single, L As Single, a As Ubyte = &hFF) As Ulong
	#Define to255(v)	(Max(0, Min(255, 256 * v)))
	Dim As Single r, g, b
	If S = 0 Then
		r = L : g = L : b = L
	Else
		Dim As Single p, q
		q = Iif(L < 0.5, L * (1 + S), L + S - L * S)
		p = 2 * L - q
		r = HUE2RGB(p, q, H + f13)
		g = HUE2RGB(p, q, H)
		b = HUE2RGB(p, q, H - f13)
	End If
	Return a Shl 24 Or to255(r) Shl 16 Or to255(g) Shl 8 Or to255(b) Shl 0
End Function

Randomize
Dim As Integer w = 1920 Shr 1, h = 1080 Shr 1, w2 = w Shr 1, h2 = h Shr 1
Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &hFF, &hFF000000
Cls

Dim As Single px, py, z, m
Dim As Long i
Dim As ULong iFPS, cfps = 0
Dim As Double fTimer = Timer, t = 0

Do
	Cls
	For i = 999 To 0 Step -1
		z = i^0.5
		m = i / 14
		px = Sin(t) * 199 + Sin(i) * m + w2 + Sin(z) * m + m * Sin(t) * 1.5
		py = Cos(t)^2 * 99 + Cos(i) * m + 200 + Cos(z) * m
		Line (px, py) - (px + z, py + z), HSL2RGB(0.08333333333, 0.35, ((Cos(9 + i - Sin(t)) + 1.5)^5) / 100), BF
		t += 0.00002
	Next

	Draw String(4, 4), iFPS & " fps", &hFF00F000
	Flip	
	
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(10)
Loop Until Len(Inkey())

Stargate:

Code: Select all

'Ported from https://www.dwitter.net/d/20584 by tomxor to FB by UEZ build 2020-11-18

#Include "fbgfx.bi"
#Include "crt/math.bi"
Using FB

Const fPI = Acos(-1), fPi2 = Acos(-1) * 2


#Define Min(a, b)	(Iif(a < b, a, b))
#Define Max(a, b)	(Iif(a > b, a, b))
#Define Map(Val, source_start, source_stop, dest_start, dest_stop)   ((Val - source_start) * (dest_stop - dest_start) / (source_stop - source_start) + dest_start)

Randomize
Dim As Integer w = 1920 Shr 3, h = 1080 Shr 3, w2 = w Shr 1, h2 = h Shr 1

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &hFFFFFF, &hFF404040

Const iRadius = 97, outterRingHalfRadius = iRadius / 2, innerRingHalfRadius = outterRingHalfRadius * 0.75, centerOfRing = (innerRingHalfRadius + outterRingHalfRadius) / 2, embosRepetitions = 9, _
	  iterations = outterRingHalfRadius * 2 * (outterRingHalfRadius * 2) - 1152

Dim As ULong iFPS, cfps = 0
Dim Shared As Single sx, sy, y, x, r,fmin_fy = -1.45 - ((iRadius / 100) - 1) * 1.25
Dim Shared As Long i, c, tx, ty
tx = w2 + (iRadius \ 2 - outterRingHalfRadius)
ty = h2 + (iRadius \ 2 - outterRingHalfRadius)

Dim Shared As Double fTimer, t
fTimer = Timer
t = 0

Function calculateWaves(n As Single) As Single
	t += 0.0000005
	If n > 0 Then Return Cos(y / 2 + x * y / outterRingHalfRadius + t * 9) * Cos(y / 4 - calculateWaves(n - 1) * 2) - r / 6
End Function

Do
	Cls
	For i = iterations To 0 Step - 1
		x = (i Mod iRadius) - outterRingHalfRadius
		y = (i / iRadius) - outterRingHalfRadius
		r = Sqr(x * x + y * y)
		If r > innerRingHalfRadius And r < outterRingHalfRadius Then
			If ((Cos(Atan2(x, y) * 9) * 20 - r) And 44) = 0 Then
				x += tx : y += ty
				Line (x, y) - (x + 1, y + 1), &hFF000000, BF
			Else
				sx = Iif(r < centerOfRing, y / outterRingHalfRadius, x / outterRingHalfRadius)
				c = Map(sx, -1, 1, 0, 255)
				x += tx : y += ty
				Line (x, y) - (x + sx, y + 1), Rgba(c, c, c, 255), BF
			End If
		Elseif r < innerRingHalfRadius Then
			sy = calculateWaves(3) / 5
			c = Map(sy, fmin_fy, 0.17, 0, 255)
			x += tx : y += ty
			Line (x, y) - (x + 1, y + sy), Rgba(c, c, c, 255), BF			
		End If
	Next
	Draw String(4, 4), iFPS & " fps", &hFF00F000
	Flip	
	
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(1)
Loop Until Len(Inkey())

Twisted Band:

Code: Select all

'Ported from https://codegolf.dweet.net/a/377 by cantelope to FB by UEZ build 2020-11-04

#Include "fbgfx.bi"
#Include "crt/math.bi"
Using FB

Randomize
Dim As Integer w = 1920 Shr 1, h = 1080 Shr 1, w2 = w Shr 1, h2 = h Shr 1
Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &hFF, &hFFFFFFFF
Cls

Dim As Single px, py, p, z, s, k = 2e3, ww = k Shr 2
Dim As Long i
Dim As ULong iFPS, cfps = 0
Dim As Double fTimer = Timer, t = 0

Do
	Cls
	For i = k To 0 Step -1
		p = i / 79.6 + Cos(t / 2) * 12 + IIf(i > 1e3, 3.1, 0)
		z = 3 + Cos(p)
		s = 250 / z / z
		px = ww + (fmodf(i, 1e3) - 500) / 120 / z * ww
		py = h2 + Sin(p) / z * ww
		'Line (px, py) - (px + s, py + s), &hFF000000, BF
		Line (px, py) - (px + s * 0.9, py + s * 0.9), &h10F0F0F0, BF
		Circle (px, py), s, &h80000000,,,, F 
		t += 0.00001
	Next

	Draw String(4, 4), iFPS & " fps", &hFF00F000
	Flip	
	
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(10)
Loop Until Len(Inkey())

Wormhole:

Code: Select all

'Ported from https://codegolf.dweet.net/a/246 by cantelope to FB by UEZ build 2020-10-23

#Include "fbgfx.bi"
#Include "crt/math.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 Min(a, b)	(Iif(a < b, a, b))
#Define Max(a, b)	(Iif(a > b, a, b))

Const f23 = 2 / 3, f13 = 1 / 3, f16 = 1 / 6

Function HUE2RGB(p As Single, q As Single, t As Single) As Single
	If t < 0 Then t += 1
	If t > 1 Then t -= 1
	If t < f16 Then Return p + (q - p) * 6 * t
	If t < 0.5 Then Return q
	If t < f23 Then Return p + (q - p) * (f23 - t) * 6
	Return p
End Function

Function HSL2RGB(H As Single, S As Single, L As Single, a As Ubyte = 255) As Ulong
	#Define to255(v)	(Max(0, Min(255, 256 * v)))
	Dim As Single r, g, b
	If S = 0 Then
		r = L : g = L : b = L
	Else
		Dim As Single p, q
		q = Iif(L < 0.5, L * (1 + S), L + S - L * S)
		p = 2 * L - q
		r = HUE2RGB(p, q, H + f13)
		g = HUE2RGB(p, q, H)
		b = HUE2RGB(p, q, H - f13)
	End If
	Return a Shl 24 Or to255(r) Shl 16 Or to255(g) Shl 8 Or to255(b) Shl 0
End Function

Randomize
Dim As Integer w = 1920 Shr 1, h = 1080 Shr 1, w2 = w Shr 1, h2 = h Shr 1

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &hFF, &hFF000000
Cls

Const PI = Acos(-1)
Dim As ULong iFPS, cfps = 0
Dim As Double fTimer = Timer, t = 0
Dim As Long sides = 16, depth = 35, i, m
Dim As Single px, py, nx, ny, v = PI * 2 / sides, s = PI * 2 / depth, e, d, f, g, q, qq, o, p, pp, r, x, y, z, zz, j

#Macro DrawLine(k)
	zz = Iif(z > 0.1, z, 0.1)
	If k Then 
		px = w2 + X / zz * w2
		py = h2 + Y / zz * w2
	Else
		nx = w2 + X / zz * w2
		ny = h2 + Y / zz * w2
		Line (px, py) - (nx, ny), HSL2RGB((360 / sides * i + q * 9), 0.10, (0.7 - 0.7 / depth * q), (0.57 + Sin(t * 2) * 0.43) * &hFF)
		px = nx
		py = ny
	End If
#Endmacro

Do
	Cls
	d = t / 2
	j = Sin(d) / 2
	f = j * 12
	e = t * 2
	g = Cos(e) * 1.5
	For m = depth To 0 Step -1
		For i = sides To 0 Step -1
			q = m - fmod(t * 6,  1)
			o = Sin(s * 2 * j * q + d) * 6 - f
			pp = Sin(s * 2 * j * (q + 1) + d) * 6 - f
			qq = Cos(s * 3 * j * q + e) * 1.5 - g
			r = Cos(s * 3 * j * (q + 1) + e) * 1.5 - g
			p = v*i
			x = Sin(p) + o
			y = Cos(p) + qq
			z = q
			DrawLine(1)
			p += v
			x = Sin(p) + o
			y = Cos(p) + qq
			z = q 
			DrawLine(0)
			x = Sin(p) + pp
			y = Cos(p) + r
			q +=1
			z = q
			DrawLine(0)
			p -= v
			x = Sin(p) + pp
			y = Cos(p) + r
			z = q
			DrawLine(0)
			t += 0.00001
		Next
	Next
	Draw String(4, 4), iFPS & " fps", &hFF00FF00
	Flip	
	
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(1)
Loop Until Len(Inkey())

Ribbon2:

Code: Select all

'Ported from https://codegolf.dweet.net/a/244 by cantelope to FB by UEZ build 2020-11-05

#Include "fbgfx.bi"
#Include "crt/math.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 Min(a, b)	(Iif(a < b, a, b))
#Define Max(a, b)	(Iif(a > b, a, b))

Const f23 = 2 / 3, f13 = 1 / 3, f16 = 1 / 6

Function HUE2RGB(p As Single, q As Single, t As Single) As Single
	If t < 0 Then t += 1
	If t > 1 Then t -= 1
	If t < f16 Then Return p + (q - p) * 6 * t
	If t < 0.5 Then Return q
	If t < f23 Then Return p + (q - p) * (f23 - t) * 6
	Return p
End Function

Function HSL2RGB(H As Single, S As Single, L As Single, a As Ubyte = 255) As Ulong
	#Define to255(v)	(Max(0, Min(255, 256 * v)))
	Dim As Single r, g, b
	If S = 0 Then
		r = L : g = L : b = L
	Else
		Dim As Single p, q
		q = Iif(L < 0.5, L * (1 + S), L + S - L * S)
		p = 2 * L - q
		r = HUE2RGB(p, q, H + f13)
		g = HUE2RGB(p, q, H)
		b = HUE2RGB(p, q, H - f13)
	End If
	Return a Shl 24 Or to255(r) Shl 16 Or to255(g) Shl 8 Or to255(b) Shl 0
End Function

Randomize
Dim As Integer w = 1200, h = 600, w2 = w Shr 1, h2 = h Shr 1

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &hFF, &h80000000
Cls

Dim As ULong iFPS, cfps = 0
Dim As Double fTimer = Timer, t = 0
Dim As Single s, g, b, p, z, px, py
Dim As Long i

Do
	Cls
	For i = w - 1 To 0 Step -1
		b = i - w
		g = b / w + t
		p = b / (180 + Sin(t) * 99) * (Iif(b < 0, -1, 1)) * Cos(g) + t * 4
		z = 1800 + Cos(p) * b
		s = 1e8 / z / z
		px = w2 + Sin(p) * b / z * w - s / 2
		py = h2 + Sin(g * 2) * 4e5 / z - s / 2
		Line (px, py) - (px + s, py + s), HSL2RGB(Map(fmodf(b / 4 + t * 299, 360), 0, 360, 0, 1), 0.99, Map(50 + Sin(b / 99 + t * 2) * 40, -40, 90, 0, 1), 25), bf
		t += 0.00001
	Next
	Draw String(4, 4), iFPS & " fps", &hFF00FF00
	Flip	
	
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(1)
Loop Until Len(Inkey())

Flying Ribbon:

Code: Select all

'Ported from https://codegolf.dweet.net/a/377 by cantelope to FB by UEZ build 2020-11-04

#Include "fbgfx.bi"
#Include "crt/math.bi"
Using FB

Function R1(a As Single, b As Single, t As Single) As Single
	Return Cos(t) * a - Sin(t) * b
End Function

Function R2(a As Single, b As Single, t As Single) As Single
	Return Sin(t) * a + Cos(t) * b
End Function

Randomize
Dim As Integer w = 1920 Shr 1, h = 1080 Shr 1, w2 = w Shr 1, h2 = h Shr 1
Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &hFF, &hFF244586
Cls

Dim As Single px, py, p, x, y, z, s, c1, c2
Dim As Long i, k = 2e3, ww = k Shr 2
Dim As ULong iFPS, cfps = 0
Dim As Double fTimer = Timer, t = 0

Do
	Cls
	For i = k To 0 Step -1
		p = i / 79.5
		c1 = Sin(p)
		c2 = 4 - fmodf(i / ww * 8 + t * 9, 8)
		x = R1(c1, c2, t)
		z = R2(c1, c2, t)
		c1 = Cos(p)
		y = R1(c1, z, t)
		z = R2(c1, z, t)
		z += 5
		s = ww / z / z
		px = ww + x / z * ww
		py = h2 + y / z * ww
		Line (px, py) - (px + s, py + s), &h20FFFFFF, BF
		t += 0.00001
	Next

	Draw String(4, 4), iFPS & " fps", &hFF00F000
	Flip	
	
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(10)
Loop Until Len(Inkey())

Raindrop on a Window:

Code: Select all

'Ported from https://www.dwitter.net/d/18471 by tomxor to FB by UEZ build 2020-11-03

#Include "fbgfx.bi"
#Include "crt/math.bi"

Using FB

#Define Min(a, b)	(Iif(a < b, a, b))
#Define Max(a, b)	(Iif(a > b, a, b))

Randomize
Dim As Integer w = 120, h = 76, size = 3

Screenres w * size, h * size, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &hFF, &h10000000

Dim As ULong iFPS, cfps = 0
Dim As Long i, c, sy
Dim As Single px, py, sx, x, y, r, d
Dim As Double fTimer = Timer, t = 0

Do
	'Cls
	For i = w * h - 1 To 0 Step -1
		x = (i Mod w) / 30 - 2
		y = i / w / 30
		r = x * x + (Sin(y - 8) - fmodf(t, 4) + 2)^2
		d = Iif(r > 0.2, 1, Cos(r * 5))
		px = (i Mod w)
		py = i \ w
		sx = 1 + Sin(7 * x / d)^5 * Sin(7 * y / d)^5
		sy = d / 2 + y / 4
		c = 127 * sx 'Max(0, Min(255, sx * 160))
		Line (px * size, py * size) - ((px + sx) * size, (py + sy) * size), Rgba(c, c, c, &h20), BF
		t += 0.000001
	Next

	Draw String(4, 4), iFPS & " fps", &hFFFF0000

	Flip	
	
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(10)
Loop Until Len(Inkey())

Death Star Trench:

Code: Select all

'Ported from https://www.dwitter.net/d/18759 by KilledByAPixel to FB by UEZ build 2020-11-02

#Include "fbgfx.bi"
#Include "crt/math.bi"
Using FB

Randomize
Dim As Integer w = 1920 Shr 1, h = 1080 Shr 1, w2 = w Shr 1, h2 = h Shr 1, w22 = w Shl 1

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &hFF, &hFF000000

Dim As ULong iFPS, cfps = 0
Dim As Long i, j, b, e, k = 801
Dim As Single m, r, v, px, py, sx, sy

#Define Min(a, b)	(Iif(a < b, a, b))
#Define Max(a, b)	(Iif(a > b, a, b))
Dim As Double fTimer = Timer, t = 0

Do
	Cls
	For i = k - 1 To 0 Step -1
		m = i + (t * 120) Xor k
		r = 1e7 / i / i
		e = m Mod 3
		b = Iif(i < 600, 1, 0)
		m *= m
		px = Iif(b, w - r / 2 - Iif(e, (e Shl 1) - 3, Sin(m)) * r / 0.8, w22 * Sin(i)) * 0.5
		py = Iif(b, k + r * (Iif(e <> 0, Cos(m), 1)), fmod(i * 13, k)) * 0.5
		r = Iif(b, r, fmod(i, 5)) * 0.5
		v = Min(255, Iif(b, i / 3 + Sin(m) * 29, Iif(i < k, k, 0)))
		If b Then
			Line (px, py) - (px + r, py + r), Rgba(v, v, v, 255), BF
		Else
			Circle (px, py), r, Rgba(v, v, v, &hF0),,,, F
		end if
		t += 0.0000075
	Next

	Draw String(4, 4), iFPS & " fps", &hFFFFFF80

	Flip	
	
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfp
		cfps = 0
		fTimer = Timer
	End If
	Sleep(10)
Loop Until Len(Inkey())

Download AiO with ~802 examples: The beauty - magic of math Vol. 1 - 12 build 2022-01-16.7z

[dafhi]

From both the code here and zip file, WOW and Fractal Zoom don't work.

zipped exe's work fine.

i like: WOW, Binary Field (!), CHOO CHOO, Mountain Journey (!), Saturn 2 (!!), Sierpensky Dance, Ribbon2, Rain drop

Mountain Journey reminds me of sub-pixel processing. More there than meets the eye.
Binary Field reminds me of a progressive-refinement project I did.
Saturn 2 is just plain nuts.

[UEZ]

From both the code here and zip file, WOW and Fractal Zoom don't work.

zipped exe's work fine.

i like: WOW, Binary Field (!), CHOO CHOO, Mountain Journey (!), Saturn 2 (!!), Sierpensky Dance, Ribbon2

Mountain Journey reminds me of sub-pixel processing. More there than meets the eye.
Binary Field reminds me of a progressive-refinement project I did.
Saturn 2 is just plain nuts.

Thanks for your feedback. I myself am also very surprised and amazed how you can conjure such effects with some lines of code. CHOO CHOO is one of my favorites...

It seems that both don't work with x64 version but should work with x86 version.
The issue is the recursion but yet I don't know why x64 fails.

Edit: I fixed both examples. Now it should run also properly when compiling it as x64 code.

[badidea]

'Octopus Ride' crashes here on 64-bit. You use Sizeof(pImage) and Sizeof(pImage_Blurred), this must be wrong. Both are 'any pointers' and their size depends on 32 vs 64 bit. Why not use 'ImageInfo' to get a pixel pointer?

'The Enemy' has the same problem.

'Raindrop on a Window' turns same black pixels white. This seems a bug to me.

All tested on linux 32 & 64-bit fbc. No other problems found.
My favorites: Flare, Twisted Band, Saturn2 and choo choo

[UEZ]

'Octopus Ride' crashes here on 64-bit. You use Sizeof(pImage) and Sizeof(pImage_Blurred), this must be wrong. Both are 'any pointers' and their size depends on 32 vs 64 bit. Why not use 'ImageInfo' to get a pixel pointer?

'The Enemy' has the same problem.

'Raindrop on a Window' turns same black pixels white. This seems a bug to me.

All tested on linux 32 & 64-bit fbc. No other problems found.
My favorites: Flare, Twisted Band, Saturn2 and choo choo

Thanks for your feedback. I fixed the issue for the blur code in x64 execution for the both examples.

[dodicat]

Thanks for these UEZ, and your Vol.1 also.
I like the Saturns.

[UEZ]

Did you get any issues with your AV software regarding the compiled executable files within the zip archive?

Apparently the AV manufacturers have updated their patterns again and flagged all the compiled exes as malicious.

All the executables are on my business laptop and probably I need to justify why I have plenty of alerts. Grrrrr :-(

Thanks for these UEZ, and your Vol.1 also.
I like the Saturns.

Your are welcome.

[UEZ]

Added volume III and IV. I'm too lazy to create two new topics with screenshots but it's worth a look. :-)

If you are interested check out post #1 to download AiO package (source code + compiled executables).

[dafhi]

cool! quick feedback .. an error with Tunnel2 GDI.. (vol 3)
Variable not declared, SmoothingModeAntiAlias8x4

[UEZ]

cool! quick feedback .. an error with Tunnel2 GDI.. (vol 3)
Variable not declared, SmoothingModeAntiAlias8x4

Thanks for your feedback.

Seems that gdiplus.bi for x86 is not up-to-date.

Just replace SmoothingModeAntiAlias8x4 with 4 and it should compile, too.

[dafhi]

so it was a problem on my end. i tried downloading new fb yesterday to server error .. got it now and it works. hooray for me!

[UEZ]

Added Vol. V, VI and VII. Check first post for AiO download link.

[srvaldez]

thank you UEZ :-)
beautiful

[UEZ]

thank you UEZ :-)

You are welcome. :-)

[dafhi]

a lot of great stuff in here .. right away I like fountain sprinkler from Vol IV