Binare Fractal

[Peter]

Hello,
only for fun. 

Code: [Select]

include "asm.inc"
window 512,512,1
Loadicon "bmp/brezel.ico"

float bx,by, int w=512,h=512,cl
float sx=-2.2,sy=-1.7,sw=3.4,sh=3.4
float gx,gy,zx,zy,nzx,r,g,b

while key(27)=0
cls 0,0,0
for x=0 to h step 10
for y=0 to w step 10
gx=x/w*sw+sx
gy=y/h*sh+sy
zx=gx
zy=gy
for c=0 to 255
cl  = c
nzx = zx*zx - zy*zy + gx
zy  = 2*zx*zy+gy
zx  = nzx
if zx*zx + zy*zy > 4 then
   cl = c
   exit for
end if
next
r = cl     
g = cl*32 
b = cl*64 
color r,g,b
text x,y,10,chr(rand(48,49))
next
next
drawicon 1,240,10,32,32,0
redraw
wait 40
wend
winExit


.

[Mike Lobanovsky]

WOW! That's beautiful!

Guess I need that for my collection too.

[Aurel]

Caramba und carambita herr Wirbelauer 
are you NEO or Peter ...because i see MATRIX 

[Mike Lobanovsky]

Peter, that was cool. Thanks again!

Code: OxygenBasic

1. ' ----------------------------------------------------------------
2. ' Oct 25, 2015 Thanks Peter Wirbelauer, http://www.oxygenbasic.org
3. ' ----------------------------------------------------------------
4.  
5. ' ------------------------- Compiler Stuff -----------------------
6. #Define page CreateCompatibleDC
7.  
8. Macro CalcClient() = SetRect(@R, 50, 50, 562, 562) + AdjustWindowRectEx(@R, &HCF0000, FALSE, &H100)
9. Macro CreatePage() = Resize(ME, 0, 0, R[2] - R[0], R[3] - R[1]) + Fbsl.GetClientRect(ME, 0, 0, W, H) _
10.                      + CreateCompatibleDC(GetDC(ME)) + DeleteObject(SelectObject(page, CreateCompatibleBitmap(GetDC, W, H))) _
11.                      + SetStretchBltMode(GetDC, 4) + SetBkColor(page, 0) + DeleteObject(SelectObject(page, _
12.                      CreateFont(-MulDiv(6, GetDeviceCaps(page, 90), 72), MulDiv, 0, 0, 400, 0, 0, 0, 0, 0, 0, 0, 0, "Courier")))
13. Macro ResizePage() = InvalidateRect(ME, NULL, TRUE) + LoWord(CBLPARAM) + HiWord(CBLPARAM) + PlotPage()
14. Macro ShowWindow() = FbslSetText(ME, "-= FBSL Binary Mandelbrot =-") + Center(ME) + Show(ME) + PostMessage(ME, &H5, 0, (H << 16) + W)
15. Macro PaintPage()  = ValidateRect(ME, NULL) + PlotPage(page,W,H) + StretchBlt( _
16.                      GetDC, 0, 0, LoWord, HiWord, page, 0, 0, W, H, &HCC0020) + InvalidateRect(ME, NULL, TRUE)
17. Macro Wait(t)      = Sleep(t) + InvalidateRect(ME, NULL, FALSE)
18. Macro Quit()       = IIf(CBWPARAM = 2, PostMessage(ME, &H10, 0, 0), 0) ' WM_CLOSE
19.  
20. ' ------------------------- App Starts Here ----------------------
21. Dim W = 0, H = 0, %R[3]
22.  
23. CalcClient()
24. CreatePage()
25. ResizePage()
26. ShowWindow()
27.  
28. Begin Events
29.   Select Case CBMSG
30.     Case &H111 ' WM_COMMAND
31.      Quit()
32.     Case &H5   ' WM_SIZE
33.      ResizePage()
34.     Case &H14  ' WM_ERASEBKGND
35.      Wait(15)
36.       Return 1
37.     Case &HF   ' WM_PAINT
38.      PaintPage()
39.   End Select
40. End Events
41. ' ------------------------ That's All Folks! ---------------------
42.  
43. ' -------------------------- Painting Proc -----------------------
44. DynC PlotPage(%p = page, %width = W, %height = H)
45.   void __attribute__((stdcall)) SetTextColor(int, int);
46.   void __attribute__((stdcall)) TextOutA(int, int, int, char*, int);
47.  
48.   void main(int page, int w, int h)
49.   {
50.     char digit[4];
51.     int x, y, c, cl;
52.     float sx = -2.2f, sy = -1.7f, sw = 3.4f, sh = 3.4f;
53.     float gx, gy, zx, zy, nzx;
54.    
55.     for (x = 0; x <= h; x += 10) {
56.       for (y = 0; y <= w; y += 10) {
57.         gx = (float)x / w * sw + sx;
58.         gy = (float)y / h * sh + sy;
59.         zx = gx; zy = gy;
60.         for (c = 0; c <= 255; c++) {
61.           nzx = zx * zx - zy * zy + gx;
62.           zy  = 2 * zx * zy + gy;
63.           zx  = nzx;
64.           cl  = c;
65.           if ((zx * zx + zy * zy) > 4.0f) {
66.             cl = c;
67.             break;
68.           }
69.         }
70.         sprintf(digit, "%c", rand() % 2 + 48);
71.         SetTextColor(page, (((cl << 6) & 0xFF) << 16) | (((cl << 5) & 0xFF) << 8) | cl);
72.         TextOutA(page, x, y, digit, 1);
73.       }
74.     }
75.   }
76. End DynC

.