Posts: 3,548
Threads: 165
Joined: Apr 2022
Reputation:
172
04-29-2022, 02:12 PM
(This post was last modified: 04-29-2022, 02:14 PM by bplus.)
Vince is fine programmer with specially clean style of coding. Hate to see his work get buried (= lost) in Programs section, so I offered and he accepted a little place of his own. He has very nice graphics both 2D and 3D and a fan of FreeBasic and JustBasic (really?) or just being an independent program language type guy...
So vince thankyou, this thread is yours. (If you don't like the title let me know.)
b = b + ...
Posts: 256
Threads: 11
Joined: Apr 2022
Reputation:
29
Nice, this is great, thanks B+! And yes, especially JB! I suppose I'll start with the flag then sort through what I think is worth posting
USA Flag
Code: (Select All) deflng a-z
sw = 640
sh = 480
dim shared pi as double
pi = 4*atn(1)
screen _newimage(sw*2, sh, 32)
h = 300
w = 1.9*h
a = h/7
img = _newimage(w, h, 32)
_dest img
x0 = 0
y0 = 0
line (0, 0)-step(w, h),_rgb(255,255,255),bf
for i=0 to 6
line (0, i*h*2/13)-step(w, h/13),_rgb(255*0.698,255*0.132,255*0.203),bf
next
line (0, 0)-step(w*2/5, h*7/13),_rgb(255*0.234,255*0.233,255*0.430),bf
for i=0 to 4
for j=0 to 5
starf (j*2 + 1)*w*2/(5*12), (i*2 + 1)*h*7/130, h*4/(13*5*2), _rgb(255,255,255)
next
next
for i=1 to 4
for j=1 to 5
starf (j*2)*w*2/(5*12), (i*2)*h*7/130, h*4/(13*5*2), _rgb(255,255,255)
next
next
_dest 0
_putimage (sw/2 - w/2, sh/2 - h/2), img
_source img
x0 = sw/2 - w/2 + sw
y0 = sh/2 - h/2 '+ sh
dim t as double
dim z as double
dim xx as double, yy as double
dim dx as double, dy as double
do
t = t + 0.2
line (sw,0)-step(sw, sh),_rgb(0,0,0),bf
for y=0 to h + a*0.707 step 1
for x=0 to w + a*0.707 step 1
z = (0.1 + 0.4*(x/w))*a*sin(x/35 - y/70 - t) + 0.5*a
dz = 50*a*cos(x/35 - y/70 - t)/35
xx = x + z*0.707 - a*0.707
yy = y - z*0.707
if (int(xx) >=0 and int(xx) < w - 1 and int(yy) >= 0 and int(yy) < h - 1) then
tl = point(int(xx), int(yy))
tr = point(int(xx) + 1, int(yy))
bl = point(int(xx), int(yy) + 1)
br = point(int(xx) + 1, int(yy) + 1)
dx = xx - int(xx)
dy = yy - int(yy)
r = _round((1 - dy)*((1 - dx)* _red(tl) + dx* _red(tr)) + dy*((1 - dx)* _red(bl) + dx* _red(br)))
g = _round((1 - dy)*((1 - dx)*_green(tl) + dx*_green(tr)) + dy*((1 - dx)*_green(bl) + dx*_green(br)))
b = _round((1 - dy)*((1 - dx)* _blue(tl) + dx* _blue(tr)) + dy*((1 - dx)* _blue(bl) + dx* _blue(br)))
r = r + dz
g = g + dz
b = b + dz
if r<0 then r = 0
if r>255 then r = 255
if g<0 then g = 0
if g>255 then g = 255
if b<0 then b = 0
if b>255 then b = 255
pset (x0 + x, y0 - a*0.707 + y), _rgb(r,g,b)
end if
next
next
_display
_limit 50
loop until _keyhit = 27
sleep
system
sub starf(x, y, r, c)
pset (x + r*cos(pi/2), y - r*sin(pi/2)),c
for i = 0 to 5
xx = r*cos(i*4*pi/5 + pi/2)
yy = r*sin(i*4*pi/5 + pi/2)
line -(x + xx, y - yy),c
next
paint (x, y),c
for i = 0 to 5
xx = r*cos(i*4*pi/5 + pi/2)/2
yy = r*sin(i*4*pi/5 + pi/2)/2
paint (x + xx, y - yy),c
next
end sub
Posts: 256
Threads: 11
Joined: Apr 2022
Reputation:
29
Tessellating fish
Code: (Select All) defdbl a-z
dim shared pi, a1, a2, a, b, w1, w2, h
pi = 4*atn(1)
a1 = 14
a2 = 4
w = 30*7
w1 = w*5/7
w2 = w - w1
h = w*2/7
a = -h/a2/sin(pi*w/w1)
a = exp(log(a)/w)
b = a1*pi/w1/w2
sw = w*4 + w2
sh = h*8 + 114
screen _newimage(sw, sh, 32)
line (0,0)-(sw, sh),_rgb(255,255,255),bf
for i=-1 to 4
for j=-1 to 4
fish w2 + i*w, 50 + h*j*2, w, i and 1
fish sw - w2 - i*w, 50 + h*j*2 + h, -w, i and 1
next
next
sleep
system
function f(x, aa)
f = aa*(a^x)*sin(pi*x/w1)
end function
function g(x, v)
g = b*x*(x - v)
end function
sub fish(x0, y0, ww, u)
dim c1 as _unsigned long
dim c2 as _unsigned long
c1 = _rgb(200,200,200)
c2 = _rgb(255,255,255)
if u then swap c1, c2
w = abs(ww)
s = sgn(ww)
'background
color c1
for x=w to w1 step -1
line (x0 + s*(x - w), y0 - f(x, a2))-(x0 + s*(x - w), y0 - g(x - w, -w2))
next
for x=0 to w1
line (x0 + s*x, y0 - f(x, a2))-(x0 + s*x, y0 + h - f(w1 - x, a1))
next
for x=0 to w2
line (x0 + s*(w - x), y0 + h - g(-x, -w2))-(x0 + s*(w - x), y0 - f(w - x, a2))
next
for xx=0 to w1/3/7
if xx>0 and xx<w1/3/7 then
x = xx*3*7 + 3
ox = x0 + s*x
oy = y0 - f(x, a1)
oy2 = y0 + h - f(w1 - x, a2)
for zz=0 to 3*7 + 2
z = xx*3*7 + zz
line (ox, oy)-(x0 + s*z, y0 - f(z, a2))
line (ox, oy2)-(x0 + s*z, y0 + h - f(w1 - z, a1))
next
end if
next
color _rgb(0,0,0)
'closed shape
pset (x0, y0)
for x=0 to w
line -(x0 + s*x, y0 - f(x, a2))
next
for x=0 to w2
line -(x0 + s*(w - x), y0 + h - g(-x, -w2))
next
for x=0 to w1
line -(x0 + s*(w1 - x), y0 + h - f(x, a1))
next
for x=w to w1 step -1
line -(x0 + s*(x - w), y0 - f(x, a2))
next
for x=0 to w2
line -(x0 - s*(w2 - x), y0 - g(x, w2))
next
for x=0 to w1
line -(x0 + s*x, y0 - f(x, a1))
next
'flourish
circle (x0 + s*w1, y0 + 21), 3, c2
paint (x0 + s*w1, y0 + 21), c2
circle (x0 + s*w1, y0 + 21), 3
for xx=0 to w1/3/7
if xx=1 then
x = xx*3*7 + 3
pset (x0 + s*x, y0 - f(x, a1))
elseif xx>1 and xx<w1/3/7 - 1 then
x = xx*3*7
line -(x0 + s*x, y0 - f(x, a2))
x = x + 3
line -(x0 + s*x, y0 - f(x, a1))
end if
next
for xx=0 to w1/3/7
if xx=0 then
x = (xx + 1)*3*7 + 3
pset (x0 + s*x, y0 + h - f(w1 - x, a2))
elseif xx>0 and xx<w1/3/7 then
x = xx*3*7
line -(x0 + s*x, y0 + h - f(w1 - x, a1))
x = x + 3
line -(x0 + s*x, y0 + h - f(w1 - x, a2))
end if
next
for xx=1 to w2/8 - 1
x = w - xx*8
x2 = w - xx*6.5 - 7
line (x0 + s*(x - w), y0 - f(x, a2))-(x0 + s*(x2 + 2*7-w), y0 - f(x2, a2))
next
end sub
Posts: 3,548
Threads: 165
Joined: Apr 2022
Reputation:
172
Escher like
![[Image: image-2022-05-02-002530872.png]](https://i.ibb.co/3BWq1DP/image-2022-05-02-002530872.png)
b = b + ...
Posts: 256
Threads: 11
Joined: Apr 2022
Reputation:
29
A simple 3D example showing an animated plot of a hyperboloid. Demonstrates perspective projection and rotation, I often use this program as a reference when I want to plot a 3D shape
Code: (Select All) dim shared pi
pi = 4*atn(1)
const d = 700
const z0 = 2500
const sw = 640
const sh = 480
rr = 500
h = 1200
screen 12
do
for t=0 to h step 10
cls
hyperb rr, t, 0, 0
_display
_limit 100
next
for b=0 to 0.80*pi/2 step 0.008
cls
hyperb rr, h, b, 0
_display
_limit 100
next
_delay 0.5
for rot = 0 to 0.9*pi/2 step 0.01
cls
hyperb rr, h, 0.80*pi/2, rot
_display
_limit 100
next
_delay 0.5
for i=0 to 1 step 0.005
cls
hyperb rr, h, (1 - i)*0.80*pi/2, (1 - i)*0.9*pi/2
_display
_limit 100
next
for t=0 to h step 10
cls
hyperb rr, h-t, 0, 0
_display
_limit 100
next
loop
system
'radius, height, twist, rotate
sub hyperb (r, h, b, rot)
a = 0
x = r*cos(a - b)
z = r*sin(a - b)
y = -h/2 + 200
yy = y*cos(rot) - z*sin(rot)
zz = y*sin(rot) + z*cos(rot)
y = yy
z = zz
ox = x
oz = z
oy = y
x = r*cos(a + b)
z = r*sin(a + b)
y = h/2 + 200
yy = y*cos(rot) - z*sin(rot)
zz = y*sin(rot) + z*cos(rot)
y = yy
z = zz
oxx = x
oyy = y
ozz = z
for a = 2*pi/30 to 2*pi step 2*pi/30
x = r*cos(a - b)
z = r*sin(a - b)
y = -h/2 + 200
yy = y*cos(rot) - z*sin(rot)
zz = y*sin(rot) + z*cos(rot)
y = yy
z = zz
pset (sw/2 + ox*d/(oz + z0), sh/2 - 50 + oy*d/(oz + z0))
line -(sw/2 + x*d/( z + z0), sh/2 - 50 + y*d/( z + z0))
ox = x
oy = y
oz = z
x = r*cos(a + b)
z = r*sin(a + b)
y = h/2 + 200
yy = y*cos(rot) - z*sin(rot)
zz = y*sin(rot) + z*cos(rot)
y = yy
z = zz
line -(sw/2 + x*d/( z + z0), sh/2 - 50 + y*d/( z + z0))
line -(sw/2 + oxx*d/(ozz + z0), sh/2 - 50 + oyy*d/(ozz + z0))
oxx = x
oyy = y
ozz = z
next
end sub
Posts: 256
Threads: 11
Joined: Apr 2022
Reputation:
29
Sliding window FFT example
This program demonstrates some of the algorithms useful for audio or other signal processing and particularly for music visualizers. Shows the effects of a short-time Fourier transform with rectangular windowing, Gaussian windowing, as well as tone detection. Features my optimized SUB rfft, or the Fast Fourier Transform -- a fast algorithm for evaluating discrete Fourier transforms. This one is particularly optimized for purely real signals. The tone detector code is meant for detecting pure sine waves in noise to high precision with spectral interpolation -- this could be useful for something like a musical instrument tuner.
Code: (Select All) const sw = 2048
const sh = 600
dim shared pi as double
pi = 4*atn(1)
'declare sub rfft(xx_r(), xx_i(), x_r(), n)
dim x_r (sw-1), x_i (sw-1)
dim xx_r(sw-1), xx_i(sw-1)
dim st_x_r (512-1), st_x_i (512-1)
dim st_xx_r(512-1), st_xx_i(512-1)
dim st_x_r2 (sw-1), st_x_i2 (sw-1)
dim st_xx_r2(sw-1), st_xx_i2(sw-1)
dim t as double
'create signal consisting of three sinewaves in RND noise
for i=0 to sw/3-1
x_r(i) = 100*sin(2*pi*(sw*1000/44000)*i/sw) '+ (100*rnd - 50)
next
for i=sw/3 to 2*sw/3-1
x_r(i) = 100*sin(2*pi*(sw*2000/44000)*i/sw) '+ (100*rnd - 50)
next
for i=2*sw/3 to sw-1
x_r(i) = 100*sin(2*pi*(sw*8000/44000)*i/sw) '+ (100*rnd - 50)
next
screen _newimage(sw/2, sh, 32),,1,0
'plot signal
pset (0, sh/4 - x_r(0))
for i=0 to sw/2 - 1
line -(i, sh/4 - x_r(i*2)), _rgb(70,0,0)
next
line (0, sh/4)-step(sw,0), _rgb(255,0,0),,&h5555
color _rgb(255,0,0)
_printstring (0, 0), "2048 samples of three sine waves (1 kHz, 2 kHz, 8 kHz) in RND noise sampled at 44 kHz"
rfft xx_r(), xx_i(), x_r(), sw
'plot its fft
'pset (0, 70+3*sh/4 - 0.005*sqr(xx_r(0)*xx_r(0) + xx_i(0)*xx_i(0)) )
for i=0 to sw/2
pset (i*2, 70 + 3*sh/4), _rgb(70,70,0)
line -(i*2, 70+3*sh/4 - 0.005*sqr(xx_r(i)*xx_r(i) + xx_i(i)*xx_i(i)) ), _rgb(70,70,0)
next
line (0, 70+3*sh/4)-step(sw,0), _rgb(255,255,0),,&h5555
color _rgb(70,70,0)
_printstring (0, sh/2), "its entire FFT first half"
color _rgb(70,0,0)
_printstring (0, sh/2 + 16), "rectangular short time FFT"
color _rgb(0,70,0)
_printstring (0, sh/2 + 32), "gaussian short time FFT"
screen ,,0,0
pcopy 1,0
mx = 0
do
do
mx = _mousex
my = _mousey
mbl = _mousebutton(1)
mbr = _mousebutton(2)
mw = mw + _mousewheel
loop while _mouseinput
pcopy 1,0
'draw windows
if mx > sw/2-256 then mx = sw/2 - 256 - 1
if mx < 0 then mx = 0
'''rectangular window
line (mx,1)-step(256,sh/4 - 1),_rgb(255,0,0),b
'''gaussian window
z = (0 - mx - 128)/(128/2)
pset (mx, sh/4 - (sh/4)*exp(-z*z/2))
for i=0 to sw/2-1
z = (i - mx - 128)/(128/2)
line -(i, sh/4 - (sh/4)*exp(-z*z/2)),_rgb(0,255,0)
next
'take it's windowed short time FFT
for i=0 to 512-1
'rectangular window -- do nothing
st_x_r(i) = x_r(mx*2 + i)
next
for i=0 to sw - 1
'gaussian window -- smooth out the edges
z = (i - mx*2 - 256)/(128/2)
st_x_r2(i) = x_r(i)*exp(-z*z/2)
next
'''plot signal rectangular
pset (mx, sh/4 - st_x_r(0))
for i=0 to 256 -1
line -(mx + i, sh/4 - st_x_r(i*2)), _rgb(255,0,0)
next
line (0, sh/4)-step(sw,0), _rgb(255,0,0),,&h5555
'''plot signal gaussian
pset (0, sh/4 - st_x_r2(0))
for i=0 to sw/2 - 1
line -(i, sh/4 - st_x_r2(i*2)), _rgb(0,255,0)
next
line (0, sh/4)-step(sw,0), _rgb(255,0,0),,&h5555
rfft st_xx_r(), st_xx_i(), st_x_r(), 512
rfft st_xx_r2(), st_xx_i2(), st_x_r2(), sw
'plot its short time fft rectangular
pset (0, 70+3*sh/4 - 0.015*sqr(st_xx_r(0)*st_xx_r(0) + st_xx_i(0)*st_xx_i(0)) )
for i=0 to 128
'pset (i*8, 70 + 3*sh/4), _rgb(256,256,0)
line -(i*8, 70+3*sh/4 - 0.015*sqr(st_xx_r(i)*st_xx_r(i) + st_xx_i(i)*st_xx_i(i)) ), _rgb(256,0,0)
next
'''parabolic tone finder
dim max as double, d as double
max = 0
m = 0
for i=0 to 256
d = sqr(st_xx_r(i)*st_xx_r(i) + st_xx_i(i)*st_xx_i(i))
if d > max then
max = d
m = i
end if
next
dim c as double
dim u_r as double, u_i as double
dim v_r as double, v_i as double
u_r = st_xx_r(m - 1) - st_xx_r(m + 1)
u_i = st_xx_i(m - 1) - st_xx_i(m + 1)
v_r = 2*st_xx_r(m) - st_xx_r(m - 1) - st_xx_r(m + 1)
v_i = 2*st_xx_i(m) - st_xx_i(m - 1) - st_xx_i(m + 1)
c = (u_r*v_r + u_i*v_i)/(v_r*v_r + v_i*v_i)
color _rgb(70,70,0)
_printstring (sw/4, sh/2), "spectral parabolic interpolation tone detector"
color _rgb(255,0,0)
_printstring (sw/4, sh/2 + 16), "f_peak = "+str$((m + c)*44000/512)+" Hz"
i = m
pset ((i + c)*8, 70 + 3*sh/4), _rgb(256,256,0)
line -((i + c)*8, sh ), _rgb(256,0,0)
'plot its short time fft gaussian
pset (0, 70+3*sh/4 - 0.03*sqr(st_xx_r2(0)*st_xx_r2(0) + st_xx_i2(0)*st_xx_i2(0)) )
for i=0 to sw/2
'pset (i*8, 70 + 3*sh/4), _rgb(256,256,0)
line -(i*2, 70+3*sh/4 - 0.03*sqr(st_xx_r2(i)*st_xx_r2(i) + st_xx_i2(i)*st_xx_i2(i)) ), _rgb(0,256,0)
next
'''parabolic tone finder
max = 0
m = 0
for i=0 to sw/2
d =sqr(st_xx_r2(i)*st_xx_r2(i) + st_xx_i2(i)*st_xx_i2(i))
if d > max then
max = d
m = i
end if
next
u_r = st_xx_r2(m - 1) - st_xx_r2(m + 1)
u_i = st_xx_i2(m - 1) - st_xx_i2(m + 1)
v_r = 2*st_xx_r2(m) - st_xx_r2(m - 1) - st_xx_r2(m + 1)
v_i = 2*st_xx_i2(m) - st_xx_i2(m - 1) - st_xx_i2(m + 1)
c = (u_r*v_r + u_i*v_i)/(v_r*v_r + v_i*v_i)
color _rgb(0,256,0)
_printstring (sw/4, sh/2 + 32), "f_peak = "+str$((m + c)*44000/sw)+" Hz"
i = m
pset ((i + c)*2, 70 + 3*sh/4), _rgb(0,256,0)
line -((i + c)*2, sh ), _rgb(0,256,0)
_display
_limit 30
loop until _keyhit=27
system
sub rfft(xx_r(), xx_i(), x_r(), n)
dim w_r as double, w_i as double, wm_r as double, wm_i as double
dim u_r as double, u_i as double, v_r as double, v_i as double
log2n = log(n/2)/log(2)
for i=0 to n/2 - 1
rev = 0
for j=0 to log2n - 1
if i and (2^j) then rev = rev + (2^(log2n - 1 - j))
next
xx_r(i) = x_r(2*rev)
xx_i(i) = x_r(2*rev + 1)
next
for i=1 to log2n
m = 2^i
wm_r = cos(-2*pi/m)
wm_i = sin(-2*pi/m)
for j=0 to n/2 - 1 step m
w_r = 1
w_i = 0
for k=0 to m/2 - 1
p = j + k
q = p + (m \ 2)
u_r = w_r*xx_r(q) - w_i*xx_i(q)
u_i = w_r*xx_i(q) + w_i*xx_r(q)
v_r = xx_r(p)
v_i = xx_i(p)
xx_r(p) = v_r + u_r
xx_i(p) = v_i + u_i
xx_r(q) = v_r - u_r
xx_i(q) = v_i - u_i
u_r = w_r
u_i = w_i
w_r = u_r*wm_r - u_i*wm_i
w_i = u_r*wm_i + u_i*wm_r
next
next
next
xx_r(n/2) = xx_r(0)
xx_i(n/2) = xx_i(0)
for i=1 to n/2 - 1
xx_r(n/2 + i) = xx_r(n/2 - i)
xx_i(n/2 + i) = xx_i(n/2 - i)
next
dim xpr as double, xpi as double
dim xmr as double, xmi as double
for i=0 to n/2 - 1
xpr = (xx_r(i) + xx_r(n/2 + i)) / 2
xpi = (xx_i(i) + xx_i(n/2 + i)) / 2
xmr = (xx_r(i) - xx_r(n/2 + i)) / 2
xmi = (xx_i(i) - xx_i(n/2 + i)) / 2
xx_r(i) = xpr + xpi*cos(2*pi*i/n) - xmr*sin(2*pi*i/n)
xx_i(i) = xmi - xpi*sin(2*pi*i/n) - xmr*cos(2*pi*i/n)
next
'symmetry, complex conj
'for i=0 to n/2 - 1
' xx_r(n/2 + i) = xx_r(n/2 - 1 - i)
' xx_i(n/2 + i) =-xx_i(n/2 - 1 - i)
'next
end sub
Posts: 3,548
Threads: 165
Joined: Apr 2022
Reputation:
172
FFT example
![[Image: FFT-example.png]](https://i.ibb.co/gP14tFp/FFT-example.png)
b = b + ...
Posts: 256
Threads: 11
Joined: Apr 2022
Reputation:
29
Fractal explorer
May as well stick this one in here. It's a convenient mouse driven interface for exploring escape-time fractals. I use it for all kinds of custom formulas but the following is showing the classic Mandelbrot (there are a couple of others in there commented out that you can try). Left/right click to zoom in and out. Mouse wheel to change the zoom window. Press keys '+' or '-' to increase or decrease the number of iterations.
Code: (Select All) defint a-z
const sw = 800
const sh = 600
dim shared pi as double
pi = 4*atn(1)
dim shared mx,my,mbl,mbr,mw
dim u as double, v as double
dim uu as double, vv as double
dim xx as double, yy as double
dim x0 as double, y0 as double
dim z as double, zz as double
dim c as single
z = 0.004
zz = 0.1
x0 = -0.5
dim p1 as long
p1 = _newimage(sw, sh, 32)
screen _newimage(sw, sh, 32)
redraw = -1
iter = 100
do
mw = 0
getmouse
if redraw then
for y = 0 to sh-1
for x = 0 to sw-1
u = 0
v = 0
xx = (x - sw/2)*z + x0
yy = (y - sh/2)*z + y0
for i = 0 to iter
'''mandelbrot
uu = u*u - v*v + xx
vv = 2*u*v + yy
'''
'''burning ship
'u = abs(u)
'v = abs(v)
'uu = u*u - v*v + xx
'vv = 2*u*v + yy
'''
'''tricorn
'u = u
'v = -v
'uu = u*u - v*v + xx
'vv = 2*u*v + yy
'''
u = uu
v = vv
if (u*u + v*v) > 4 then exit for
next
if i > iter then
pset(x, y), _rgb(0,0,0)
else
c = i/iter
r = 80 - 80*sin(2*pi*c - pi/2)
g = (114 + 114*sin(2*pi*c*1.5 - pi/2)) * -(c < 0.66)
b = (114 + 114*sin(2*pi*c*1.5 + pi/2)) * -(c > 0.33)
pset(x, y), _rgb(r, g, b)
end if
next
next
'locate 1,1
'print "iter =";iter
_title str$(iter)
_dest p1
_putimage , 0
_dest 0
_putimage , p1
_autodisplay
redraw = 0
end if
if mw < 0 then
zz = zz + 0.01
elseif mw > 0 then
if zz > 0.01 then zz = zz - 0.01
end if
'draw box
if omx <> mx or omy <> my or mw <> 0 then
_putimage , p1
line (mx - (sw*zz/2), my - (sh*zz/2))-step(sw*zz,sh*zz),_rgb(255,255,255),b
_autodisplay
omx = mx
omy = my
end if
if mbl then
do
getmouse
loop while mbl
x0 = x0 + (mx - sw/2)*z
y0 = y0 - (sh/2 - my)*z
z = z*zz
iter = iter + 100
redraw = -1
elseif mbr then
do
getMouse
loop while mbr
x0 = x0 + (mx - sw/2)*z
y0 = y0 - (sh/2 - my)*z
z = z/zz
iter = iter - 100
redraw = -1
end if
k = _keyhit
if k = 43 then
iter = iter + 50
redraw = -1
elseif k = 45 then
if iter > 50 then iter = iter - 50
redraw = -1
end if
loop until k = 27
system
sub getmouse ()
do
mx = _mousex
my = _mousey
mbl = _mousebutton(1)
mbr = _mousebutton(2)
mw = mw + _mousewheel
loop while _mouseinput
end sub
Posts: 3,548
Threads: 165
Joined: Apr 2022
Reputation:
172
A very nice version of the Classic Mandelbrot!
![[Image: Fractal-Explorer.png]](https://i.ibb.co/GdM1hFh/Fractal-Explorer.png)
b = b + ...
Posts: 256
Threads: 11
Joined: Apr 2022
Reputation:
29
Discrete cosine transform, interesting image processing algorithm -- WIP
Code: (Select All) deflng a-z
const n = 10
type dct_type
r as double
g as double
b as double
end type
type q_type
r as _unsigned _byte
g as _unsigned _byte
b as _unsigned _byte
end type
dim shared pi as double
pi = _pi
img1 = _loadimage("greenland1.png", 32)
w = _width(img1)
h = _height(img1)
ww = (w\n+1)*n
hh = (h\n+1)*n
dim dct(ww, hh) as dct_type
dim q(ww, hh) as q_type
dim sr as double, sg as double, sb as double
dim c as double, cu as double, cv as double
img2 = _newimage(w, h, 32)
img3 = _newimage(w, h, 32)
img1_dct = _newimage(w, h, 32)
img2_dct = _newimage(w, h, 32)
img3_dct = _newimage(w, h, 32)
screen _newimage(3*w, 2*h, 32)
_putimage (0,0),img1
_source img1
'forward DCT
for y0=0 to hh-1 step n
for x0=0 to ww-1 step n
for y=0 to n-1
for x=0 to n-1
sr = 0
sg = 0
sb = 0
for v=0 to n-1
for u=0 to n-1
if (x0 + u > w - 1) then px = x0 + u - n else px = x0 + u
if (y0 + v > h - 1) then py = y0 + v - n else py = y0 + v
z = point(px, py)
r = _red(z)
g = _green(z)
b = _blue(z)
c = cos((2*u + 1)*x*pi/(2*n)) * cos((2*v + 1)*y*pi/(2*n))
sr = sr + r*c
sg = sg + g*c
sb = sb + b*c
next
next
if x = 0 then cu = 1/sqr(2) else cu = 1
if y = 0 then cv = 1/sqr(2) else cv = 1
dct(x0 + x, y0 + y).r = sr*cu*cv/(0.5*n)
dct(x0 + x, y0 + y).g = sg*cu*cv/(0.5*n)
dct(x0 + x, y0 + y).b = sb*cu*cv/(0.5*n)
next
next
next
next
'quantization
dim minr as double, ming as double, minb as double
dim maxr as double, maxg as double, maxb as double
minr = 1000000
ming = 1000000
minb = 1000000
maxr = -1000000
maxg = -1000000
maxb = -1000000
for y=0 to hh
for x=0 to ww
if dct(x, y).r < minr then minr = dct(x, y).r
if dct(x, y).g < ming then ming = dct(x, y).g
if dct(x, y).b < minb then minb = dct(x, y).b
if dct(x, y).r > maxr then maxr = dct(x, y).r
if dct(x, y).g > maxg then maxg = dct(x, y).g
if dct(x, y).b > maxb then maxb = dct(x, y).b
next
next
_dest img1_dct
for y=0 to hh
for x=0 to ww
r = q(x, y).r
g = q(x, y).g
b = q(x, y).b
pset (x, y), _rgb(r, g, b)
next
next
_dest img1_dct
for y=0 to hh
for x=0 to ww
q(x, y).r = 255*(dct(x,y).r - minr)/(maxr - minr)
q(x, y).g = 255*(dct(x,y).g - ming)/(maxg - ming)
q(x, y).b = 255*(dct(x,y).b - minb)/(maxb - minb)
r = q(x, y).r
g = q(x, y).g
b = q(x, y).b
pset (x, y), _rgb(r, g, b)
next
next
_dest img2_dct
for y0=0 to hh-1 step n
for x0=0 to ww-1 step n
for y=0 to 7 'n-1
for x=0 to 7 'n-1
r = q(x0 + x, y0 + y).r
g = q(x0 + x, y0 + y).g
b = q(x0 + x, y0 + y).b
if (x0 + x < w) and (y0 + y < h) then pset (x0 + x, y0 + y), _rgb(r, g, b)
next
next
next
next
_dest img3_dct
for y0=0 to hh-1 step n
for x0=0 to ww-1 step n
for y=0 to 2 'n-1
for x=0 to 2 'n-1
r = q(x0 + x, y0 + y).r
g = q(x0 + x, y0 + y).g
b = q(x0 + x, y0 + y).b
if (x0 + x < w) and (y0 + y < h) then pset (x0 + x, y0 + y), _rgb(r, g, b)
next
next
next
next
_dest img2
'inverse DCT
for y0=0 to hh-1 step n
for x0=0 to ww-1 step n
for y=0 to n-1
for x=0 to n-1
sr = 0
sg = 0
sb = 0
for v=0 to 7 'n-1
for u=0 to 7 'n-1
c = cos((2*x + 1)*u*pi/(2*n))*cos((2*y + 1)*v*pi/(2*n))
if u = 0 then cu = 1/sqr(2) else cu = 1
if v = 0 then cv = 1/sqr(2) else cv = 1
'sr = sr + dct(x + x3, y + y3).r*c*cu*cv
'sg = sg + dct(x + x3, y + y3).g*c*cu*cv
'sb = sb + dct(x + x3, y + y3).b*c*cu*cv
r = q(x0 + u, y0 + v).r
g = q(x0 + u, y0 + v).g
b = q(x0 + u, y0 + v).b
sr = sr + c*cu*cv*((r/255)*(maxr - minr) + minr)
sg = sg + c*cu*cv*((g/255)*(maxg - ming) + ming)
sb = sb + c*cu*cv*((b/255)*(maxb - minb) + minb)
next
next
sr = sr/(0.5*n)
sg = sg/(0.5*n)
sb = sb/(0.5*n)
if (x0 + x < w) and (y0 + y < h) then pset (x0 + x, y0 + y), _rgb(sr, sg, sb)
next
next
next
next
_dest img3
'inverse DCT
for y0=0 to hh-1 step n
for x0=0 to ww-1 step n
for y=0 to n-1
for x=0 to n-1
sr = 0
sg = 0
sb = 0
for v=0 to 2
for u=0 to 2
c = cos((2*x + 1)*u*pi/(2*n))*cos((2*y + 1)*v*pi/(2*n))
if u = 0 then cu = 1/sqr(2) else cu = 1
if v = 0 then cv = 1/sqr(2) else cv = 1
'sr = sr + dct(x + x3, y + y3).r*c*cu*cv
'sg = sg + dct(x + x3, y + y3).g*c*cu*cv
'sb = sb + dct(x + x3, y + y3).b*c*cu*cv
r = q(x0 + u, y0 + v).r
g = q(x0 + u, y0 + v).g
b = q(x0 + u, y0 + v).b
sr = sr + c*cu*cv*((r/255)*(maxr - minr) + minr)
sg = sg + c*cu*cv*((g/255)*(maxg - ming) + ming)
sb = sb + c*cu*cv*((b/255)*(maxb - minb) + minb)
next
next
sr = sr/(0.5*n)
sg = sg/(0.5*n)
sb = sb/(0.5*n)
if (x0 + x < w) and (y0 + y < h) then pset (x0 + x, y0 + y), _rgb(sr, sg, sb)
next
next
next
next
_dest 0
_putimage (w,0), img2
_putimage (2*w,0), img3
_putimage (0,h), img1_dct
_putimage (w,h), img2_dct
_putimage (2*w,h), img3_dct
do
loop until _keyhit=27
system
|
