dcromley
04-09-2010, 04:49
You guys have been doing SO MUCH! EXCELLENT!
I wrote this program back in 1994, in QBASIC, named VMbrot. I think this was back in the days of bulletin boards. I was pleased To see it used by a Wolfgang E. Lorenz in his master's thesis. For Some reason I was moved to update it to thinBasic.
This program presents the algorithm's iterations visually.
There has been very much done with the Mandelbrot set. Start with
http://en.wikipedia.org/wiki/Mandelbrot_set
This program works just like I want it to. But I'm sure that I'm not using all the thinBasic features efficiently. I'm posting a question "Dragging the mouse in a Canvas Window" in another thread.
' MandelbrotOrbits, Dave Cromley 2010
Uses "File", "Math", "UI"
Global ghwnd As Long
Sub TBMain()
ghwnd = Canvas_Window("Mandelbrot Orbits: ESC to exit; F1 for Help; G for grid; " & _
"Select a point to display its orbits", 0, 0, 1018, 736)
Canvas_Attach(ghwnd,0,%TRUE)
GetAsyncKeyState(-1)
If Not FILE_Exists("MandelbrotDC.bmp") Then DrawMandelbrot
OrbitsMainLoop
Canvas_Window End
End Sub
Sub OrbitsMainLoop()
Local ix0, iy0, swGrid, swBGDone As Long
Local xy As Double
Do While CkWin(ghwnd)
If swBGDone = 0 Then ' redraw background
Canvas_BitmapRender("MandelbrotDC.bmp", 0, 0) ' bring in bmp
If swGrid Then ' draw grid
Canvas_Ellipse(xtoix(-.03), ytoiy(-.03), xtoix(.03), ytoiy(.03), Rgb(128,128,128))
For xy = -2 To 2
Canvas_Line((xtoix(xy), ytoiy(-2)), (xtoix(xy), ytoiy(2)), Rgb(128,128,128))
Canvas_Line((xtoix(-2), ytoiy(xy)), (xtoix(2), ytoiy(xy)), Rgb(128,128,128))
Next xy
End If
Canvas_Redraw
swBGDone = 1
End If
If GetAsyncKeyOnce(%VK_F1) <> 0 Then ' ck for help
doHelp()
ElseIf GetAsyncKeyOnce(%VK_G) <> 0 Then ' ck for grid
swGrid = 1-swGrid
swBGDone = 0
ElseIf mousedown(ix0, iy0) Then ' ck for point select
DoOrbits(ix0, iy0)
swBGDone = 0
Else ' else just show mouse coordinates
Canvas_SetPos (0,0)
Canvas_Printl Format$(ixtox(ix0),"+0.000;-0.000") & " " & _
Format$(iytoy(iy0),"+0.000;-0.000 ") & " "
Canvas_Redraw
Sleep 100
End If
Loop
End Sub
Sub DoHelp()
Local hwnd As Long, s1 As String
hwnd = Canvas_Window("Mandelbrot Orbits Help: F1 to return", 20, 20, 800, 600)
Canvas_Attach(hwnd,0,%FALSE)
Canvas_Font "Courier New", 14, 1
Help1 0, " Mandelbrot Orbits"
Help1 2, "(The first run will create a 2MB Mandelbrot bmp image file)"
Help1 1, "Hit F1 to toggle this help."
Help1 1, "Hit G to toggle the grid."
Help1 1, "The BRIGHTEST points are the Mandelbrot set."
Help1 1, "The brighter the point, the more iterations needed"
Help1 1, " to determine that the orbits will eventually go to"
Help1 1, " infinity, and therefore the points are NOT in the set."
Help1 1, "The orbits of the brightest points never go to infinity,"
Help1 1, " and therefore the points ARE in the set."
Help1 1, "The simple algorithm results in incredible complexity."
Help1 2, "Select a point with the mouse -- this program displays"
Help1 1, " the algorithm calculations visually."
Help1 2, "Example 1: -1.7, +0.3 needs only 3 iterations."
Help1 1, "Example 2: -0.8, +0.3 needs many iterations."
Help1 1, "Example 3: -0.6, +0.3 never goes to infinity (is IN the set)."
Help1 2, "See http://en.wikipedia.org/wiki/Mandelbrot_set"
Help1 1, " for a discussion of the Mandelbrot_set"
Help1 2, "Hit F1 to return to program."
Do While CkWin(hwnd) And GetAsyncKeyOnce(%VK_F1) = 0
Sleep 100
Loop
Canvas_Window End
Canvas_Attach(ghwnd,0,%TRUE)
End Sub
Sub DrawMandelbrot() ' draw the Mset and save bmp
Local irgb, zrgb As Long
Local ix, iy, iteration As Long, x0, y0, x, y, xtemp As Double
Local max_iteration As Long Value 1000
Local logmaxiter As Long Value Log(max_iteration)
Canvas_SetPos (100,100)
Canvas_Printl "Creating MandelbrotDC.bmp image file (2MB)"
For iy = 368 To 0 Step -1: y0 = iytoy(iy)
For ix = 0 To 1018: x0 = ixtox(ix)
x = x0: y = y0
iteration = 0
Do While x*x + y*y <= 4 And iteration < max_iteration
xtemp = x*x - y*y + x0 ' this is the algorithm
y = 2*x*y + y0
x = xtemp
Incr iteration
Loop
If (iteration = max_iteration) Then ' point is in Mset
Canvas_SetPixel(ix, iy , Rgb(255,192,0))
Canvas_SetPixel(ix, 736-iy , Rgb(255,192,0))
Else ' point is not in Mset
irgb = 255*Log(iteration)/logmaxiter ' calc shade of orange
' irgb = 255*iteration/max_iteration ' alternate image
zrgb = Rgb(irgb,irgb*3/4,0)
Canvas_SetPixel(ix, iy , zRgb)
Canvas_SetPixel(ix, 736-iy , zRgb)
End If
Next ix
Canvas_Redraw ' full line
If GetAsyncKeyOnce(%VK_F1) <> 0 Then DoHelp
If GetAsyncKeyState(%VK_ESCAPE) <> 0 Then Stop
Next iy
Canvas_BitmapSave("MandelbrotDC.bmp")
End Sub
Sub DoOrbits(ix0 As Long, iy0 As Long) ' draw the orbits
Local ix9, iy9 As Long
Local x0, y0, x, y, xtemp As Double
Canvas_SetPos(ix0, iy0) ' start at point
x0 = ixtox(ix0): y0 = iytoy(iy0)
x = x0: y = y0
Do While mousedown(ix9, iy9) ' ignore position
If x*x + y*y < 8 Then
xtemp = x*x - y*y + x0
y = 2*x*y + y0
x = xtemp
Canvas_Line(,(xtoix(x),ytoiy(y)),Rgb(255,255,255))
Canvas_Redraw
End If
Sleep 100
Loop
End Sub
Sub Help1(pSkip As Long, pMsg As String)
Static iy As Long
If pSkip = 0 Then Canvas_Clear: iy = 40
iy += pskip*20
Canvas_SetPos (80,iy)
Canvas_Printl pmsg
End Sub
Function ixtox(ix As Long) ' scaling/unscaling routines
Function = (ix-640) / 270
End Function
Function iytoy(iy As Long)
Function = (-iy+368) / 270
End Function
Function xtoix(x As Double)
Function = x * 270 + 640
End Function
Function ytoiy(y As Double)
Function = -y * 270 + 368
End Function
Function MouseDown(ByRef px As Long, ByRef py As Long) As Long
Local p1 As pointapi
If GetAsyncKeyState(%VK_LBUTTON) <> 0 Then Function = -1 ' true
Win_GetCursorPos(p1)
px = p1.x - 3: py = p1.y - 29 ' correction ?
End Function
Function GetAsyncKeyOnce(pKey As Long) As Long
Local i1 As Long
i1 = GetAsyncKeyState(pKey)
If i1 = 0 Then Exit Function
Do While GetAsyncKeyState(pKey) <> 0 ' wait for key up
Loop
Function = i1
End Function
Function CkWin(hwnd As Long) ' stop if no window or ESC
If Not IsWindow(hwnd) Then Stop
If GetAsyncKeyState(%VK_ESCAPE) <> 0 Then Stop
Function = 1
End Function
I wrote this program back in 1994, in QBASIC, named VMbrot. I think this was back in the days of bulletin boards. I was pleased To see it used by a Wolfgang E. Lorenz in his master's thesis. For Some reason I was moved to update it to thinBasic.
This program presents the algorithm's iterations visually.
There has been very much done with the Mandelbrot set. Start with
http://en.wikipedia.org/wiki/Mandelbrot_set
This program works just like I want it to. But I'm sure that I'm not using all the thinBasic features efficiently. I'm posting a question "Dragging the mouse in a Canvas Window" in another thread.
' MandelbrotOrbits, Dave Cromley 2010
Uses "File", "Math", "UI"
Global ghwnd As Long
Sub TBMain()
ghwnd = Canvas_Window("Mandelbrot Orbits: ESC to exit; F1 for Help; G for grid; " & _
"Select a point to display its orbits", 0, 0, 1018, 736)
Canvas_Attach(ghwnd,0,%TRUE)
GetAsyncKeyState(-1)
If Not FILE_Exists("MandelbrotDC.bmp") Then DrawMandelbrot
OrbitsMainLoop
Canvas_Window End
End Sub
Sub OrbitsMainLoop()
Local ix0, iy0, swGrid, swBGDone As Long
Local xy As Double
Do While CkWin(ghwnd)
If swBGDone = 0 Then ' redraw background
Canvas_BitmapRender("MandelbrotDC.bmp", 0, 0) ' bring in bmp
If swGrid Then ' draw grid
Canvas_Ellipse(xtoix(-.03), ytoiy(-.03), xtoix(.03), ytoiy(.03), Rgb(128,128,128))
For xy = -2 To 2
Canvas_Line((xtoix(xy), ytoiy(-2)), (xtoix(xy), ytoiy(2)), Rgb(128,128,128))
Canvas_Line((xtoix(-2), ytoiy(xy)), (xtoix(2), ytoiy(xy)), Rgb(128,128,128))
Next xy
End If
Canvas_Redraw
swBGDone = 1
End If
If GetAsyncKeyOnce(%VK_F1) <> 0 Then ' ck for help
doHelp()
ElseIf GetAsyncKeyOnce(%VK_G) <> 0 Then ' ck for grid
swGrid = 1-swGrid
swBGDone = 0
ElseIf mousedown(ix0, iy0) Then ' ck for point select
DoOrbits(ix0, iy0)
swBGDone = 0
Else ' else just show mouse coordinates
Canvas_SetPos (0,0)
Canvas_Printl Format$(ixtox(ix0),"+0.000;-0.000") & " " & _
Format$(iytoy(iy0),"+0.000;-0.000 ") & " "
Canvas_Redraw
Sleep 100
End If
Loop
End Sub
Sub DoHelp()
Local hwnd As Long, s1 As String
hwnd = Canvas_Window("Mandelbrot Orbits Help: F1 to return", 20, 20, 800, 600)
Canvas_Attach(hwnd,0,%FALSE)
Canvas_Font "Courier New", 14, 1
Help1 0, " Mandelbrot Orbits"
Help1 2, "(The first run will create a 2MB Mandelbrot bmp image file)"
Help1 1, "Hit F1 to toggle this help."
Help1 1, "Hit G to toggle the grid."
Help1 1, "The BRIGHTEST points are the Mandelbrot set."
Help1 1, "The brighter the point, the more iterations needed"
Help1 1, " to determine that the orbits will eventually go to"
Help1 1, " infinity, and therefore the points are NOT in the set."
Help1 1, "The orbits of the brightest points never go to infinity,"
Help1 1, " and therefore the points ARE in the set."
Help1 1, "The simple algorithm results in incredible complexity."
Help1 2, "Select a point with the mouse -- this program displays"
Help1 1, " the algorithm calculations visually."
Help1 2, "Example 1: -1.7, +0.3 needs only 3 iterations."
Help1 1, "Example 2: -0.8, +0.3 needs many iterations."
Help1 1, "Example 3: -0.6, +0.3 never goes to infinity (is IN the set)."
Help1 2, "See http://en.wikipedia.org/wiki/Mandelbrot_set"
Help1 1, " for a discussion of the Mandelbrot_set"
Help1 2, "Hit F1 to return to program."
Do While CkWin(hwnd) And GetAsyncKeyOnce(%VK_F1) = 0
Sleep 100
Loop
Canvas_Window End
Canvas_Attach(ghwnd,0,%TRUE)
End Sub
Sub DrawMandelbrot() ' draw the Mset and save bmp
Local irgb, zrgb As Long
Local ix, iy, iteration As Long, x0, y0, x, y, xtemp As Double
Local max_iteration As Long Value 1000
Local logmaxiter As Long Value Log(max_iteration)
Canvas_SetPos (100,100)
Canvas_Printl "Creating MandelbrotDC.bmp image file (2MB)"
For iy = 368 To 0 Step -1: y0 = iytoy(iy)
For ix = 0 To 1018: x0 = ixtox(ix)
x = x0: y = y0
iteration = 0
Do While x*x + y*y <= 4 And iteration < max_iteration
xtemp = x*x - y*y + x0 ' this is the algorithm
y = 2*x*y + y0
x = xtemp
Incr iteration
Loop
If (iteration = max_iteration) Then ' point is in Mset
Canvas_SetPixel(ix, iy , Rgb(255,192,0))
Canvas_SetPixel(ix, 736-iy , Rgb(255,192,0))
Else ' point is not in Mset
irgb = 255*Log(iteration)/logmaxiter ' calc shade of orange
' irgb = 255*iteration/max_iteration ' alternate image
zrgb = Rgb(irgb,irgb*3/4,0)
Canvas_SetPixel(ix, iy , zRgb)
Canvas_SetPixel(ix, 736-iy , zRgb)
End If
Next ix
Canvas_Redraw ' full line
If GetAsyncKeyOnce(%VK_F1) <> 0 Then DoHelp
If GetAsyncKeyState(%VK_ESCAPE) <> 0 Then Stop
Next iy
Canvas_BitmapSave("MandelbrotDC.bmp")
End Sub
Sub DoOrbits(ix0 As Long, iy0 As Long) ' draw the orbits
Local ix9, iy9 As Long
Local x0, y0, x, y, xtemp As Double
Canvas_SetPos(ix0, iy0) ' start at point
x0 = ixtox(ix0): y0 = iytoy(iy0)
x = x0: y = y0
Do While mousedown(ix9, iy9) ' ignore position
If x*x + y*y < 8 Then
xtemp = x*x - y*y + x0
y = 2*x*y + y0
x = xtemp
Canvas_Line(,(xtoix(x),ytoiy(y)),Rgb(255,255,255))
Canvas_Redraw
End If
Sleep 100
Loop
End Sub
Sub Help1(pSkip As Long, pMsg As String)
Static iy As Long
If pSkip = 0 Then Canvas_Clear: iy = 40
iy += pskip*20
Canvas_SetPos (80,iy)
Canvas_Printl pmsg
End Sub
Function ixtox(ix As Long) ' scaling/unscaling routines
Function = (ix-640) / 270
End Function
Function iytoy(iy As Long)
Function = (-iy+368) / 270
End Function
Function xtoix(x As Double)
Function = x * 270 + 640
End Function
Function ytoiy(y As Double)
Function = -y * 270 + 368
End Function
Function MouseDown(ByRef px As Long, ByRef py As Long) As Long
Local p1 As pointapi
If GetAsyncKeyState(%VK_LBUTTON) <> 0 Then Function = -1 ' true
Win_GetCursorPos(p1)
px = p1.x - 3: py = p1.y - 29 ' correction ?
End Function
Function GetAsyncKeyOnce(pKey As Long) As Long
Local i1 As Long
i1 = GetAsyncKeyState(pKey)
If i1 = 0 Then Exit Function
Do While GetAsyncKeyState(pKey) <> 0 ' wait for key up
Loop
Function = i1
End Function
Function CkWin(hwnd As Long) ' stop if no window or ESC
If Not IsWindow(hwnd) Then Stop
If GetAsyncKeyState(%VK_ESCAPE) <> 0 Then Stop
Function = 1
End Function