|
Post by mikesharpe on Oct 13, 2022 9:09:57 GMT
const sw = 640 const sh = 480
dim shared pi pi = 4*atn(1)
zoom = 140
screen _newimage(sw, sh, 32)
dim z(1), w(1), p(1), q(1)
for yy=0 to sh for xx=0 to sw
x = (xx - sw/2)/zoom y = (sh/2 - yy)/zoom
cnum p(), 1, 0 cnum q(), x, y cdiv w(), p(), q() pset (xx, yy), checker(w()) next next
sleep system
function checker(z()) if 1 then x = z(0) y = z(1) else x = _atan2(z(1), z(0))/(pi/4) y = sqr(z(0)*z(0) + z(1)*z(1)) end if a = 2*(abs(x - int(x))) b = 2*(abs(y - int(y)))
$If Javascript Then c = a ^ b; $End If
if c = 0 then checker = _rgb(0,0,0) else checker = _rgb(255,255,255) end if end function
sub cnum( w(), x, y) w(0) = x w(1) = y end sub
sub cmul( w(), z1(), z2() ) x = z1(0) y = z1(1) a = z2(0) b = z2(1)
w(0) = x*a - y*b w(1) = x*b + y*a end sub
sub cdiv( w(), z1(), z2() ) x = z1(0) y = z1(1) a = z2(0) b = z2(1) d = a*a + b*b w(0) = (x*a + y*b)/d w(1) = (y*a - x*b)/d end sub
|
|
|
Post by mikesharpe on Oct 16, 2022 22:58:31 GMT
derivatives
const sw = 640'1024 const sh = 480'768
dim shared pi pi = 4*atn(1)
zoom = 140
screen _newimage(sw, sh, 32)
dim z(1), w(1), p(1), q(1), f(1), g(1)
for yy=0 to sh for xx=0 to sw
x = (xx - sw/2)/zoom y = (sh/2 - yy)/zoom
i=2 select case i case 0 cnum p, x + 1, y - 1 cnum q, x + 1, y + 1
cnum z, 1, 0 cmul w, z, p
cnum z, w(0), w(1) cmul w, z, q
cnum g, x - 1, y cnum z, w(0), w(1) cdiv w, z, g
'pset (xx, yy), checker(w) pset (xx, yy), hue1(w) case 1
'cnum z, exp(1), 0 cnum z, x, y 'cnum w, x, y ccos w, z 'cexp w, z, w pset (xx, yy), checker(w) case 2
n=10
cnum g, 0, 0 for j=0 to n-1 'C: z(t) p(0) = 1.5*cos(j*2*pi/n) p(1) = 1.5*sin(j*2*pi/n) 'f(z(t)) csin w, p 'cnum f, exp(1), 0 'cexp w, f, w 'f(z)/(z - z0)^(n + 1) cnum q, p(0) - x, p(1) - y cnum f, 2, 0 cexp q, q, f cdiv w, w, q 'dz/dt cnum q, -1.5*sin(j*2*pi/n), 1.5*cos(j*2*pi/n) cmul w, w, q if j=0 or j=n - 1 then g(0) = g(0) + 0.5*w(0) g(1) = g(1) + 0.5*w(1) else g(0) = g(0) + 0.5*w(0) g(1) = g(1) + 0.5*w(1) end if next 'dt w(0) = g(0)*2*pi/n w(1) = g(1)*2*pi/n '1/(2 pi i) cnum q, 0, -1/(2*pi) cmul w, w, q 'n! w(0) = 1*w(0) w(1) = 1*w(1) pset (xx, yy), checker(w)
end select next next
'n=100 for a=0 to 2*pi step 2*pi/n x = 1.5*cos(a) y = 1.5*sin(a) circle (x*zoom + sw/2, sh/2 - y*zoom), 3, _rgb(255,255,0) next
sleep system
function hue1( z() )
m = sqr(z(0)*z(0) + z(1)*z(1)) a = (pi + _atan2(z(1), z(0))) / (2*_pi)
'dim rr, gg, bb 'hue(v) ( .6 + .6 * cos( 2.*PI*(v) + vec3(0,-2.*PI/3.,2.*PI/3.))) rr = 0.5 - 0.5*sin(2*pi*a - pi/2) gg = (0.5 + 0.5*sin(2*pi*a*1.5 - pi/2)) * (a < 0.66) bb = (0.5 + 0.5*sin(2*pi*a*1.5 + pi/2)) * (a > 0.33)
'polar contouring n = 16 mm = (m*500) mod 500 pp = abs(a*n - int(a*n))
rr = rr - 0.0005*mm - 0.14*pp gg = gg - 0.0005*mm - 0.14*pp bb = bb - 0.0005*mm - 0.14*pp
hue1 = _rgb(255*rr, 255*gg, 255*bb) end function
function checker(z()) if 0 then x = z(0) y = z(1) else x = _atan2(z(1), z(0))/(pi/4) y = sqr(z(0)*z(0) + z(1)*z(1)) end if
a = 2*(abs(x - int(x))) b = 2*(abs(y - int(y)))
$If Javascript Then c = a ^ b; $End If
if c = 0 then checker = _rgb(0,0,0) else checker = _rgb(255,255,255) end if end function
sub cnum( w(), x, y ) w(0) = x w(1) = y end sub
sub cmul( w(), z1(), z2() ) x1 = z1(0) y1 = z1(1) a1 = z2(0) b1 = z2(1)
w(0) = x1*a1 - y1*b1 w(1) = x1*b1 + y1*a1 end sub
sub cdiv( w(), z1(), z2() ) x1 = z1(0) y1 = z1(1) a1 = z2(0) b1 = z2(1)
d1 = a1*a1 + b1*b1 w(0) = (x1*a1 + y1*b1)/d1 w(1) = (y1*a1 - x1*b1)/d1 end sub
sub cexp( w(), z1(), z2() ) x1 = z1(0) y1 = z1(1) a1 = z2(0) b1 = z2(1) lnz = x1*x1 + y1*y1 if lnz = 0 then w(0) = 0 w(1) = 0 else lnz = 0.5*log(lnz) argz = _atan2(y1, x1) mz = exp(a1*lnz - b1*argz) az = a1*argz + b1*lnz w(0) = mz*cos(az) w(1) = mz*sin(az) end if end sub
function cosh(x) cosh = 0.5*(exp(x) + exp(-x)) end function
function sinh(x) sinh = 0.5*(exp(x) - exp(-x)) end function
sub csin( w(), z1() ) x1 = z1(0) y1 = z1(1) w(0) = sin(x1)*cosh(y1) w(1) = cos(x1)*sinh(y1) end sub
sub ccos( w(), z1() ) x1 = z1(0) y1 = z1(1) w(0) = cos(x1)*cosh(y1) w(1) =-sin(x1)*sinh(y1) end sub
|
|
|
Post by bplus on Oct 16, 2022 23:42:11 GMT
These are nice, this latest reminds me of old fractal. Found it: 'radiolarians.bas for QB64 fork (B+=MGA) 2017-05-13 ' rotolarians.bas SmallBASIC 0.12.9 (B+=MGA) 2017-05-13 ' Mad Teddy's web pages Fractals #2 Biomorphs ' http://www.madteddy.com/biomorph.htm ' colorized mod, bplus
Dim sh, sw, i, j, n As Integer sh = 720: sw = 960
Dim cReal, cImag, aspRatio, ymax, ymin, xmax, xmin, x0, y0, x, y, xx, yy As Double cReal = .5: cImag = 0: aspRatio = sw / sh '4/3 ymax = 2.5: ymin = -ymax: xmax = ymax * aspRatio: xmin = -xmax
Screen _NewImage(sw, sh, 32) _Title "Fractals #2 Biomorphs, colorized by bplus for QB64 Fork"
While 1 Cls For i = 0 To sh For j = 0 To sw x0 = xmin + (xmax - xmin) * j / sw y0 = -ymin - (ymax - ymin) * i / sh x = x0: y = y0 For n = 1 To 255 xx = x * (x * x - 3 * y * y) + cReal yy = y * (3 * x * x - y * y) + cImag x = xx: y = yy If Abs(x) > 10 Or Abs(y) > 10 Or x * x + y * y > 10 ^ 2 Then Exit For Next n If n > 255 Then n = 255 If x > 10 Then x = 10 If x < 0 Then x = 0 If y > 10 Then y = 10 If y < 0 Then y = 0 PSet (j, i), _RGB(255 - x * 25, x * y * 2.5, y * 25) Next j Next i _Display cReal = cReal + .01 'if cImag >= 0 then cImag = cImag - .1 Wend
A little blinky... qbjs.org/index.html?mode=play&code=J3JhZGlvbGFyaWFucy5iYXMgZm9yIFFCNjTECWsgKEIrPU1HQSkgMjAxNy0wNS0xMwonIHJvdM00U21hbGxCQVNJQyAwLjEyLjnXOE1hZCBUZWRkeSdzIHdlYiBwYWdlcyBGcmFjdGFscyAjMiBCaW9tb3JwaHMKJyBodHRwOi8vd3d3Lm1hZHTEOC5jb20vYsckLmh0bQonIGNvbG9yaXplZCBtb2QsIGJwbHVzCgpEaW0gc2gsIHN3LCBpLCBqLCBuIEFzIEludGVnZXIKc2ggPSA3MjA6IHN3ID0gOTYwxjNjUmVhbCwgY0ltYWcsIGFzcFJhdGlvLCB5bWF4xAZpbiwgeMUMeMYMMCwgeTAsIMQdLCB4xAd5xGhEb3VibGUKxU8gPSAuNTrGVCA9IDA6yVggPcR/LyBzaCAnNC8zCsRmID0gMsQvxGwgPSAtxBQ6xXQgPeUAhyAqyUDEGMYmxCAKClNjcmVlbiBfTmV3xG1lKOQA/uQBBjMyKQpfVGl0bGUgIvUBbyzrAUdieeYBReoCC0ZvcmsiCgpXaGlsZSAxCiAgICBDbHPFCEZvciBp5ADWIFRvIHNoxRTIGGrJGHfJGMQBeDAgPeYAuisgKOUA2i3FDykgKiBq5AEPzi95xC8t5QEQLSAo5QEDLeUBH8QwacQwynfFX8ReMDogeeQBMTDNG+QAluQBMDHkAJYyNTXNHcU8xT0gKiAoxAXEaTMgKiB5xAQpICvmAh/RNXnFasQ1xC3IOco15AGM0mrEaXjnAKZ50R9JZiBBYnMoeCkgPiAxMCBPcsUPecoPxmcrxmfGFl4gMiBUaGVuIEV4aXTkAOzNVk5leHQgbs0TSWYgbiA+5AEJxjjkARvwARZJZiB4xl/FI+QAtzHuAVXFIjzkAerIIdEg5wChxSHkAPHSQnnKQsQhziBQU2V0IChqLCBpKSwgX1JHQijkALMt5QEEMjUsxQjkAQgyLjUsxgk1KclB5QD4asUPxQtpxQtfRGlzcGxh5gF56AOnxggrIC4w5gLlJ2lm5wO3PuQCynTkAJ7GED3HCC0gLjEKV2VuZAoK
|
|
|
Post by mikesharpe on Oct 18, 2022 1:05:42 GMT
nice mod, bplus
|
|