canvas_setpixel (mandelbrot)

[largo_winch]

hello. I wanted to explore some UI/Canvas functions and started this mandelbrot-looks-like example. the problem zones I have marked. perhaps anybody can check this code example. the aim of this example I show as image ;) my results shows only a black creating pixel canvas window, but that's not ok.

use at own risk.


' Empty GUI script created on 10-25-2011 12:48:25 by largo_winch (ThinAIR)

Uses "console", "ui"

Randomize Timer

Function TBMain () As Long
Local hwin As DWord
Local tmr, xmin, xmax, ymin, ymax, cx, cy, dcx, dcy, x, y, zr, zi As Single
Local xi, j,k, numiter, numxpix, numypix, te, ts As Long
Local color_map(216) As Long
Local stuff_done As Long
Local s As String

hWin = Canvas_Window ("Canvas_colors_testing - kind of mandelbrot", 50, 50, 800, 600)

Canvas_Attach hwin, 0, Redraw
Canvas_Scale Pixels

xmin = -.65 : xmax = -.45 : ymin = .52 : ymax = .72 : numiter = 215
numxpix = 800
numypix = 600
dcx = (xmax - xmin)/(numxpix - 1)
dcy = (ymin - ymax)/(numypix - 1)

'-----------------------> 1 --------------------------->
ReDim color_map (216) '(6*6*6)
For xi = 1 To 5
For j = 1 To 5
For k = 1 To 5
color_map(xi + 6*j + 36*k) = Rgb(51*j,51*xi,51*k)
Next
Next
Next
ts = Timer
tmr = Timer
cx = xmin

'-----------------------> 2 --------------------------->
ReDim color_map(216)
For xi = 1 To numxpix
cy = ymax
For j = 1 To numypix
x = cx
y = cy
For k = 1 To numiter
zr = x*x - y*y + cx
zi = 2*x*y + cy
'-----------> important ------------->
If (zr*zr + zi*zi) > 4 Then 'Exit
x = zr : y = zi
End If
Next
cy += dcy
'-------------------> problem zone 2 --------------------------------->
Canvas_SetPixel(xi, j, color_map(numiter+2-k) )

'Canvas_SetPixel(xi, j, color_map(numiter + 1 - k)) ' +1 doesn't work, out of range!
'Canvas_SetPixel(xi, j, color_map(numiter+2-k) ) '-> result black painting!
'Canvas_SetPixel(x, y, Rgb(color_map(numiter+1), color_map(numiter+1), color_map(numiter+1))) ' testing ok
'Canvas_SetPixel(x, y, Rgb(0, 255, 0)) ' testing ok
'-------------------> problem zone 2 --------------------------------->
Next
cx += dcx
Next

Canvas_Color(Rgb(255,10,10))
Canvas_SetPos(20,420)
s = Format$(("Took ##.## seconds ") + Format$(Timer - tmr) )
'Format$(w)+"x"+Format$(h)+","+Str$(Len(s))+" bytes total"
Canvas_Print s
MsgBox 0, "testing ok?"

Canvas_Redraw
te = Timer
Canvas_WaitKey(27)

Canvas_Window End

End Function



bye, largo

[ErosOlmi]

I am by car and I'm posting from iPhone so I cannot test but looking at data I just realize inner loop is 800x600x215=103200000 loops and it can take a while to show results for an interpreted programming language like thinbasic

I will check better when home

[largo_winch]

I am back at home too ;) thanks eros. I am very close to solve the problem zone.


'-----------> that's the important thingy !------------->
If (zr*zr + zi*zi) > 4 Then Exit
x = zr : y = zi
'End If
'-----------> that's the important thingy !------------->


how I can convert


If (zr*zr + zi*zi) > 4 Then Exit

to thinbasic? "Then Exit" thinbasic doesn't like.

error message: error code 37:
EXIT: exit from a non supported block

then everything will be fine. The black pixel window is ok after my further testings :)

I've tested with lower resolution


numxpix = 400 '800
numypix = 300 '600

bye largo and thanks for fast feedback

[ErosOlmi]

Here again from car an iPhone :) (quite complex but not impossible)

In thinbasic EXIT must be followed by the name of the construct you want to exit.
So: exit for, exit while, Exit function, ...
See help at http://www.thinbasic.com/public/products/thinBasic/help/html/index.html?exit.htm

Ciao
Eros

[largo_winch]

now I am very close to the solution. thanks for the hint with loop/exit eros! There will be some more tests, but perhaps the problem caused a) by missing loops, I am astonished and b) canvas_setpixel formula. I have used "do.. loop.. exit for" for my new example.

use again at own risk!


' Empty GUI script created on 10-25-2011 12:48:25 by largo_winch (ThinAIR)

Uses "console", "ui"

Randomize Timer

Function TBMain () As Long
Local hwin As DWord
Local tmr, xmin, xmax, ymin, ymax, cx, cy, dcx, dcy, x, y, zr, zi As Single
Local xi, j,k, numiter, numxpix, numypix, te, ts As Long
Local color_map(216) As Long
Local stuff_done As Long
Local s As String
'800,600
hWin = Canvas_Window ("Canvas_colors_testing - kind of mandelbrot", 50, 50, 400, 300)

Canvas_Attach hwin, 0, Redraw
Canvas_Scale Pixels

xmin = -.65 : xmax = -.45 : ymin = .52 : ymax = .72 : numiter = 215
numxpix = 400 '800
numypix = 300 '600
dcx = (xmax - xmin)/(numxpix - 1)
dcy = (ymin - ymax)/(numypix - 1)

Do
'-----------------------> 1 --------------------------->
ReDim color_map(216) '(6*6*6) 216
For xi = 1 To 5
For j = 1 To 5
For k = 1 To 5
color_map(xi + 6*j + 36*k) = Rgb(51*j,51*xi,51*k)
Next
Next
Next
ts = Timer
tmr = Timer
cx = xmin

'-----------------------> 2 --------------------------->
ReDim color_map(216)

For xi = 1 To numxpix
cy = ymax
For j = 1 To numypix
x = cx
y = cy
For k = 1 To numiter
zr = x*x - y*y + cx
zi = 2*x*y + cy

'-----------> that's the important thingy !------------->
If (zr*zr + zi*zi) > 4 Then Exit For 'Do 'Exit
x = zr : y = zi
' Console_WriteLine "FOR/NEXT zr=" + Format$(zr)
' Console_WriteLine "FOR/NEXT zi=" + Format$(zi)

'-----------> that's the important thingy !------------->
Next
cy += dcy
'-------------------> problem zone nearly solved! --------------------------------->
Canvas_SetPixel(xi, j, Rgb(numiter+2-k, 255*zi, 255*zr)) ' testing ok
'-------------------> problem zone --------------------------------->
Next
cx += dcx
Next
Loop

Canvas_Color(Rgb(255,10,10))
Canvas_SetPos(20,420)
s = Format$(("Took ##.## seconds ") + Format$(Timer - tmr) )
Canvas_Print s
MsgBox 0, "testing ok?" ' example works

Canvas_Redraw
te = Timer
Canvas_WaitKey(27)

Canvas_Window End

End Function



here's the problem zone for clearing better performance ;)


Canvas_SetPixel(xi, j, Rgb(numiter+2-k, 255*zi, 255*zr)) ' testing ok

only the chaotic background (not linear) is still a problem I will see to solve it for next time.

pic and tbasic example as attachement.

bye, largo

[ErosOlmi]

Dear largo,

the do/loop is creating and endless loop because there is no condition to exit from it and (as far as I can understand) looping seems having no meaning for the program. Why doing what you have already done?

Another strange pont is second

ReDim color_map(216)
You have dimensioned and filled color_map() array just few lines above. If you redim it again you are in practice destroying it and allocating another array.

Ciao
Eros

[ErosOlmi]

Regarding colors, you filled color_map() arra but never used.
Maybe you would like to change

Canvas_SetPixel(xi, j, Rgb(color_map(numiter+2-k), 255*zi, 216*zr)) ' testing ok
with something like

Canvas_SetPixel(xi, j, color_map(numiter+2-k) ) ' testing ok

color_map() already contains a RGB color.

Just guessing.

Attached my image after that change
Ciao
Eros

[ErosOlmi]

Again guessing ...
The last problem may be related to how you fill your color_map() array. Your code

ReDim color_map(216) '(6*6*6) 216
For xi = 1 To 5
For j = 1 To 5
For k = 1 To 5
color_map(xi + 6*j + 36*k) = Rgb(51*j,51*xi,51*k)
Next
Next
Next
seems filling 5*5*5 (125) buckets while your array seems to be 6*6*6

Maybe you have to change it with something like that (or something more clever)


ReDim color_map(216) '(6*6*6) 216
For xi = 1 To 6
For j = 1 To 6
For k = 1 To 6
color_map(xi + 6*(j-1) + 36*(k-1)) = Rgb(51*j,51*xi,51*k)
Next
Next
Next


See image after this change

[largo_winch]

thank you eros, you've shown and focussed for me the dilemma I have had! thinbasic doesn't work with 0 to 5 arrays (1 to 6), then I've doubled used rgb values, therefore I've got these hypnotical backgrounds, but if you like some joints or other people I have created an armada of examples last hour you can be sure they are nice little artworks for (digital) exhibitions :)

my son (8 years old) was coming back at late afternoon from school and noticed my examples and wanted to know what's teacher of his school is able to create such beautiful paintings, so we have had a lot of fun together to do more than 20 examples with chaotical structures for background and madelbrot patterns too. thanks for pointing me in right direction! if you like you can manipulate data for different colors and change window size for bigger one.

1) working examples: (one of hundred possible examples)

' Empty GUI script created on 10-25-2011 12:48:25 by largo_winch (ThinAIR)

Uses "console", "ui"

Randomize Timer

Function TBMain () As Long
Local hwin As DWord
Local tmr, xmin, xmax, ymin, ymax, cx, cy, dcx, dcy, x, y, zr, zi As Single
Local xi, j,k, numiter, numxpix, numypix, te, ts As Long
Local color_map(216) As Long
Local stuff_done As Long
Local s As String
'800,600
hWin = Canvas_Window ("Canvas_colors_testing 1e_go : mandelbrot", 50, 50, 400, 300)

Canvas_Attach hwin, 0, Redraw
Canvas_Scale Pixels

xmin = -.65 : xmax = -.45 : ymin = .52 : ymax = .72 : numiter = 215
numxpix = 400 '800
numypix = 300 '600
dcx = (xmax - xmin)/(numxpix - 1)
dcy = (ymin - ymax)/(numypix - 1)

Do
'-----------------------> problem 1 solved array dimension ! --------------------------->
ReDim color_map(216) '(6*6*6) 216
For xi = 1 To 6
For j = 1 To 6
For k = 1 To 6 'but "6*j + 36*k" doesn't work here (I don't grasp it!)
color_map(xi + 5*j + 30*k) = Rgb(51*j,51*xi,51*k)
Next
Next
Next
'-----------------------> problem 1 solved array dimension ! --------------------------->
ts = Timer
tmr = Timer
cx = xmin
'-----------------------> 2 --------------------------->
For xi = 1 To numxpix
cy = ymax
For j = 1 To numypix
x = cx
y = cy
For k = 1 To numiter
zr = x*x - y*y + cx
zi = 2*x*y + cy

'-----------> important thingy solved !------------->
If (zr*zr + zi*zi) > 4 Then Exit For
x = zr : y = zi
'Console_WriteLine "FOR/NEXT zr=" + Format$(zr)
'Console_WriteLine "FOR/NEXT zi=" + Format$(zi)
'-----------> important thingy solved !------------->
Next
cy += dcy
'-------------------> problem zone 2 solved! --------------------------------->
Canvas_SetPixel(xi, j, color_map(numiter+2-k) ) ' testing ok

'-------------------> problem zone 2 solved --------------------------------->
Next
cx += dcx
Next
'Canvas_Clear(color_map(numiter+2-k)) 'starts rendering again ;)

Canvas_Color(Rgb(255,10,10))
Canvas_SetPos(20,120)
s = Format$(("Took ##.## seconds ") + Format$(Timer - tmr) )
Canvas_Print s
'MsgBox 0, "testing ok?" ' example works

Canvas_Redraw
Loop
te = Timer
Canvas_WaitKey(27)


Canvas_Window End

End Function



2)
btw:
For k = 1 To 6 'but "6*j + 36*k" doesn't work here (I don't grasp it!)
color_map(xi + 5*j + 30*k) = Rgb(51*j,51*xi,51*k)


3) don't use console printing (I have deactivated these lines) because it decrease heavy rendering speed. and if you like you can "Canvas_Clear(color_map(numiter+2-k)) 'starts rendering again ;)" activate so rendering starts again. all in all that was a real funny work! my son is absolutely happy that all works here and will ask next days his friends how to build such structures with their laptops at math. courses.

4) example and pic as attachement

bye, largo

[ErosOlmi]

Great largo.
I'm happy I could help.

Your example is also very useful for me because I can use it as a stress test when sometime I go into thinBasic optimization phase :D
Your example is perfect because it involves big loops with some math inside.

Have fun with your son. I can understand you: it is great moment when you can share some time with your son making things that are fun for both of you.

Ciao
Eros

PS: you can get a little speed improvement not using SINGLE data type but using DOUBLE instead. SINGLE data type is always internally truncated to correct SINGLE "imprecision"

[largo_winch]

last not least: how to save this rendered image? I've found "Canvas_BitmapSave" in help file.


If GetAsyncKeyState(%VK_SPACE) <> 0 Then
Canvas_BitmapSave("mandelbrot_canvas.bmp")
MsgBox 0, "save canvas_mandelbrot?"
End If


that's correct?

bye, largo

[ErosOlmi]

Yes, Canvas_BitmapSave should do the job but be usre to indicate full file path and not only file name.
So something like:


Canvas_BitmapSave(APP_ScriptPath & "mandelbrot_canvas.bmp")


Ciao
Eros

[largo_winch]

thank you for confirmation, only one line I need for saving as bitmap file, good! :)

I've included save function after last

Canvas_Redraw


Canvas_BitmapSave(APP_ScriptPath & "mandelbrot_canvas.bmp")

and all works fine here and end of project.

bye, largo

[ErosOlmi]

Hi largo,

here below the usage of an undocumented thinBasic module called GDIP module: GDI Plus module.
This module implements some GDI Plus functionality and is meant to be active when thinBasic will reach version 2 (version 2 will not be backward comaptible with Win9x systems but only compatible from Windows XP or later OSs)
In any case I started to distribute GDIP module since many thinBasic versions ago so you should have in your thinBasic installation.

To use GDIP module just add

Uses "GDIP"
than use undocumented GDIP_ConvertImage function whose syntax is:

GDIp_ConvertImage(SourceFile, DestinationFile, MimeType)
MimeType is a sting representing the destination file image format. See here to have a list of mime types: http://www.sfsu.edu/training/mimetype.htm

Here some code example that explain GDIP_ConvertImage usage:



Uses "GDIP"
...

DIM sFileName AS String

...
'---Save as bitmap and convert into png format
sFileName = APP_ScriptPath & "Mandel"
Canvas_BitmapSave(sFileName & ".bmp")
GDIP_ConvertImage(sFileName & ".bmp", sFileName & ".png", "image/png")

...

[largo_winch]

converting image files works with GDIP+ module too. :)


'------------------------------------------------------------------------------
' Load needed modules
'------------------------------------------------------------------------------
'--------------------> largos_test example for converting jpg to bmp file works :)

Uses "UI", "File"

'---Test if module was loaded. If not, abort!
if uses("GDIP") < 0 then
msgbox 0, "GDI+ lib not found"
stop
end if

dim wWidth as long value 425
dim wHeight as long value 425

function TBMain()

'------------------------------------------------------------------------------
' Create dialog
'------------------------------------------------------------------------------
dim hDlg as dword
DIALOG NEW pixels, 0, "thinBasic using GDI+", -1, -1, wWidth, wHeight, _
%WS_DLGFRAME OR _
%DS_CENTER OR _
%WS_CAPTION OR _
%WS_SYSMENU OR _
0 TO hDlg

'------------------------------------------------------------------------------
' Show dialog
'------------------------------------------------------------------------------
DIALOG SHOW modal hDlg, call dlgCallback

end function

callback function dlgCallback() as long
Dim ImagesDir As String = APP_SourcePath + "Images\"
'Dim JPGFileName As String = APP_SourcePath + "Images\ferrari-enzo.png"
Dim JPGFileName As String = APP_SourcePath + "Images\Ninax3.jpg"

dim lWidth as long
dim lHeight as long
dim nFiles as long
dim sFiles() as string
dim Counter as long
dim x as long
dim y as long
dim cWidth as long
dim cHeight as long
dim cForLine as long
Dim sFileName As String

dim hBitmap, hGpBitmap, pThumbnail AS long

select case cbMsg

case %WM_INITDIALOG
'------------------------------------------------------------------------------
' Create controls and Load images
'------------------------------------------------------------------------------
nFiles = DIR_ListArray(sFiles, ImagesDir, "*.*", %FILE_NORMAL Or %FILE_ADDPATH)

x = 5
y = 5
cForLine = 4
cWidth = (wWidth - (x * (cForLine + 2)) ) / cForLine
cHeight = cWidth

for Counter = 1 to nFiles

CONTROL ADD LABEL, cbHndl, 1000 + Counter, "", x, y, cWidth, cHeight, %SS_SUNKEN or %SS_BITMAP

'---Create an image handle
hGpBitmap = GDIP_CreateBitMapFromFile(sFiles(Counter))
'---Get image W and H
' lWidth = GDIP_GetImageWidth(hGpBitmap)
' lHeight = GDIP_GetImageHeight(hGpBitmap)
'---Alternative way to get width and height directly from file:
'GDIp_GetImageSizeFromFile(JPGFileName, cWidth, cHeight)

pThumbnail = GDIp_GetImageThumbnail(hGpBitmap, cWidth, cHeight)

'---Convert to a hBitbam handle
hBitmap = GDIp_HBitMapFromBitmap(pThumbnail)
'---Release GDI image
GDIP_DisposeImage(hGpBitmap)
GDIP_DisposeImage(pThumbnail)

'---------> test for converting image files is ok :) --------------------->
'---Converto to other formats
GDIp_ConvertImage(JPGFileName, JPGFileName & ".BMP", "image/bmp")
'---------> test for converting image files is ok :) --------------------->

'GDIp_ConvertImage(JPGFileName, JPGFileName & ".JPG", "image/jpeg")
'GDIp_ConvertImage(JPGFileName, JPGFileName & ".TIFF", "image/tiff")
'GDIp_ConvertImage(JPGFileName, JPGFileName & ".gif", "image/gif")

Control Send CBHNDL, 1000 + Counter, %STM_SETIMAGE, %IMAGE_BITMAP, hBitmap


'---Release temp hBitmap
Object_Delete(hBitmap)
'control set resize hDlg, 1000 + Counter, 0, 1, 0, 0

x += 5 + cWidth
if mod(Counter, cForLine) = 0 then
x = 5
y += 5 + cHeight
end if

next
end select

end function



see zip file.

bye, largo