Here is an OxygenBasic version.
Hi,
Not that fast!
DWord hdc,hwin hwin=Canvas_Window("Mandel",10,10,640,480) Canvas_Attach(hwin,0,%TRUE) Canvas_Font("verdana",16,%CANVAS_FONTSTYLE_BOLD) Single lx, ly, x, y, a2, b2, a, b, z, c, x2, y2 Long tick, tack, t Canvas_Clear 0 DrawText 260,40,"MOMENT....",Rgb 255,255,255 Canvas_Redraw tick = GetTickCount lx=3/640 ly=2/480 For x=0 To 640-1 For y=0 To 480-1 a=0: b=0: c=0 x2 = lx*x-2 y2 = ly*y-1 While c <50 a2 = a*a-b*b b2 = 2*a*b a = a2+x2 b = b2+y2 z = a*a+b*b If z >=4 Then Exit While c=c+1 Wend If c = 50 Then Canvas_SetPixel x,y, 0 ElseIf c <17 Then Canvas_SetPixel x,y, Rgb(0,245-((17-c)*3),0) ElseIf c <33 Then Canvas_SetPixel x,y, Rgb(0,245,((c-16)*16)-16) Else Canvas_SetPixel x,y, Rgb(0,641-(c*12),((c-32)*15)) End If Next Next tack = GetTickCount t = (tack-tick)/1000 DrawText 0, 0,"Press Escape To Exit ",Rgb(0,0,255) DrawText 0,20,"Time: " & Str$(t) & " seconds",Rgb(0,0,255) Canvas_Redraw Canvas_WaitKey Canvas_Window End hwin Sub DrawText(x,y As Long, txt As String, col As Long) Canvas_Color(col,-2) Canvas_SetPos(x,y) Canvas_Print(txt) End Sub
Here is an OxygenBasic version.
Here's another one, yet slower but plotting in real time:
Uses "UI" Declare Sub GetClientRect Lib "USER32.DLL" Alias "GetClientRect" (ByVal hWnd As DWord, ByVal lpRect As RECT Ptr) Declare Function GetDC Lib "USER32.DLL" Alias "GetDC" (ByVal hWnd As DWord) As Long Declare Sub ReleaseDC Lib "USER32.DLL" Alias "ReleaseDC" (ByVal hWnd As DWord, ByVal hDC As DWord) Declare Sub SetPixel Lib "GDI32.DLL" Alias "SetPixel" (ByVal hDC As DWord, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) Dim rc As RECT Dim MaxIters As Long = 50 Dim XRes, YRes As Long Dim colors(MaxIters + 2) As Long Dim hDC, hDlg As DWord Dim t As Long Dialog New 0, "Mandelbrot",-1,-1, 426, 295, _ %WS_POPUP Or %WS_VISIBLE Or %WS_CAPTION Or %WS_SYSMENU Or %WS_MINIMIZEBOX Or %WS_MAXIMIZEBOX To hDlg Dialog Show Modeless hDlg FillColorTable GetClientRect hDlg, rc XRes = rc.nRight YRes = rc.nBottom hDC = GetDC(hDlg) t = GetTickCount GenMandelbrot -2.1, -1.25, 0.6, 1.25 MsgBox hDlg, Format$(GetTickCount - t) & " ticks" ReleaseDC hDlg, hDC Sub GenMandelbrot(xMn As Double, yMn As Double, xMx As Double, yMx As Double) Dim iX, iY As Long Dim cx, cy, dx, dy As Double dx = (xMx - xMn) / XRes dy = (yMx - yMn) / YRes For iY = 0 To YRes cy = yMn + iY * dy For iX = 0 To XRes cx = xMn + iX * dx SetPixel hDC, iX, iY, colors(MIterate(cx, cy) + 1) Next Next End Sub Function MIterate(cx As Double, cy As Double) As Long Dim iters As Long Dim X As Double = cx Dim Y As Double = cy Dim X2 As Double = X * X Dim Y2 As Double = Y * Y Dim temp As Double While (iters <= MaxIters) And (X2 + Y2 < 4) temp = cx + X2 - Y2 Y = cy + 2 * X * Y Y2 = Y * Y X = temp X2 = X * X iters += 1 Wend Return iters End Function Sub FillColorTable() Dim r, g, b As Long Dim rd, gd, bd As Long Dim rr, gg, bb As Long Dim i, j, wid As Long Dim clr(4) As Long clr(2) = Rgb(0, 255, 0) clr(3) = Rgb(255, 255, 0) clr(4) = Rgb(255, 0, 0) wid = MaxIters / 3 For j = 0 To 2 toRGB(clr(j + 1), r, g, b) toRGB(clr(j + 2), rr, gg, bb) rd = (rr - r) / (wid + 1) gd = (gg - g) / (wid + 1) bd = (bb - b) / (wid + 1) For i = 0 To wid colors(j * wid + i + 1) = Rgb(r, g, b) r += rd g += gd b += bd Next Next colors(MaxIters + 2) = 0 End Sub Sub toRGB(c As Long, ByRef r As Long, ByRef g As Long, ByRef b As Long) r = c And &HFF g = (c And &HFF00) / &H100 b = (c And &HFF0000) / &H10000 End Sub
Mike
(3.6GHz i5 Core Quad w/ 16GB RAM, nVidia GTX 1060Ti w/ 6GB VRAM, x64 Windows 7 Ultimate Sp1)
Great stuff !!
attached - "greased lightning speed" Dynamic O2 -- bmp transfer , real time adjusting .. (Julia however, easy to convert into Mandelbrot)
best
Rob
Thank you Mike, RobbeK
Mike,
I like your Mandelbrot, looks good for me.
RobbeK,
Your animated Mandelbrot looks great as well.
Wow Rob,
Your interactive TV is amazing!
Can I have your permission to port it to FBSL and publish with due attribution of course? It's a pity we don't have a built-in Canvas for persistent drawing though. We have to use low-level API's for a memory backbuffer plus BitBlt (slower) or work directly with the bmp's DIB section pixel data array (faster). But the effect and speed will be as smooth and fast as your original.
Regards,
Mike
(3.6GHz i5 Core Quad w/ 16GB RAM, nVidia GTX 1060Ti w/ 6GB VRAM, x64 Windows 7 Ultimate Sp1)
Hi,
here's Mike's Mandelbrot, translate to OxygenBasic.
Last edited by peter; 08-12-2013 at 17:50.
Peter,
Thanks for the Mandelbrot O2 example. I'm only able to post the resulting time dialog as I'm not quick enough to capture the graphic generated. (don't blink) Can you post another version of this that retains the generated fractal? I'm running under Wine so the Windows version of this should even be faster.
Last edited by John Spikowski; 08-12-2013 at 22:13.
Okay, here is the source code.
Hi Mike,
Sure -- but the timer events were coded by Eros , and the Canvas_Bitmap byRef was new for TB 1.9.10 then.
Attached , IIRC my first BMP linking thing < 1.9.10 (I made something similar in Freebasic and Freepascal to gain some speed )
best, Rob
(those glitter pixels were added later IIRC )
OOps , always forget to ask -- your DynC does it lazy evaluation ??? -- I really need this for some mathematical related progs ..
Last edited by RobbeK; 09-12-2013 at 11:26.
Bookmarks