Gdiplus Mandelbrot

[Aaron]

Hello,

Code: [Select]

include "gp.inc"
OpenWindow 640,480,1
SetSmoothMode 2

single x,y,zx,zy,cx,cy,tp
sys im=510,z=120,it
h = GetHeight
w = GetWidth

For y=0 to <h
    For x=0 to <w
        zx=0
        zy=0
        cx= (x-w/2)/z
        cy= (y-h/2)/z
        it = im
While zx * zx + zy * zy < 4 and it>0
           tp = zx * zx - zy * zy + cx
           zy = 2 * zx * zy + cy
           zx = tp
           it -=1
Wend     
        SetPixel x,y, ARGB 255,it*12,it*8,it*4
    Next
Next

Waitkey
CloseWindow


[JRS]

Peter doesn't show the generation time but I'm guessing it' pretty close to SB. Then again this could be a Wine / GDI issue and under Windows it rather instant.

Update: Just tried it under my VirtualBox XP and it took only a couple seconds. (see attached)

Here is Peter's Mandelbrot converted to ScriptBasic GFX. The Mandelbrot fractal is like the Hello Surface for graphics programming.

Code: [Select]

' ScriptBasic GFX - Mandelbrot

IMPORT gfx.inc

s = gfx::Window(640,480,"ScriptBasic GFX Mandelbrot")
ts = gfx::Time()
im = 510
z = 120
h = 480
w = 640
FOR y = 0 TO h - 1
  FOR x = 0 TO w - 1
    zx = 0
    zy = 0
    cx = (x - w / 2) / z
    cy = (y - h / 2) / z
    it = im
    WHILE zx * zx + zy * zy < 4 AND it > 0
      tp = zx * zx - zy * zy + cx
      zy = 2 * zx * zy + cy
      zx = tp
      it -= 1
    WEND
    gfx::PixelRGBA s, x, y, it * 12, it * 8, it * 4, 255
  NEXT
NEXT
te = gfx::Time()
gfx::stringColor s, 20, 15, "Time: " & FORMAT("%.4f",(te-ts)/1000) & " Seconds." & CHR(0), 0x000000ff
gfx::Update
WHILE gfx::KeyName(1) <> "+escape"
WEND
gfx::Close

.

[Aaron]

I'm guessing it' pretty close to SB.

     once again a good joke! 
here is time.

Code: [Select]

include "gp.inc"
OpenWindow 640,480,1
SetSmoothMode 2

single x,y,zx,zy,cx,cy,tp
sys im=510,z=120,it
single t1,t2
h = GetHeight
w = GetWidth

t1 = ticks
For y=0 to <h
    For x=0 to <w
        zx=0
        zy=0
        cx= (x-w/2)/z
        cy= (y-h/2)/z
        it = im
While zx * zx + zy * zy < 4 and it>0
           tp = zx * zx - zy * zy + cx
           zy = 2 * zx * zy + cy
           zx = tp
           it -=1
Wend     
        SetPixel x,y, ARGB 255,it*12,it*8,it*4
    Next
Next

t2 = ticks
t2 = (t2-t1)/1000
SetCaption "Time needed:  " + t2
Waitkey
CloseWindow



.

[JRS]

Thanks for the Mandelbrot update Peter!

I have noticed that the WHILE/WEND in SB is much slower than a FOR/NEXT. Not sure why that is but something I thought I would mention.

Update: I tried a few different approaches to the WHILE/WEND loop. This loop is the crux of the fractal and doing it interpretively is painful.

[JRS]

I remembered that Charles did a DLLC helper function for the JAPI Mandelbrot ScriptBasic for Windows example. I hacked it a bit and got it working with the DLLC code I use for the alpha circle example. The colors are wrong (help resolving this appreciated) but the execution time has improved dramatically. The point of this is to show that bottlenecks in SB can be resolved with extension to the language.

Code: [Select]

' ScriptBasic GFX & DLLC - Mandelbrot

include "dllcinc.sb"

oxy = dllfile("/sb22/modules/oxygen.dll")

o2_basic = dllproc( oxy, "o2_basic i =(c*source) " )
o2_exec  = dllproc( oxy, "o2_exec  i =(i call)   " )
o2_error = dllproc( oxy, "o2_error c*=()         " )
o2_errno = dllproc( oxy, "o2_errno i =()         " )
o2_len   = dllproc( oxy, "o2_len   i =()         " )
o2_mode  = dllproc( oxy, "o2_mode     (i mode)   " )

dllcall(o2_mode,1)

src = """
extern
function mandel(float zre,zim,sys maxiter) as sys
    float mx,my,betrag
    sys iter
 
    while iter < maxiter and betrag < 4.0
        iter = iter+1
        tmp = mx*mx-my*my+zre
        my = 2*mx*my+zim
        mx = tmp
        betrag = (mx*mx + my*my)
    wend
    return iter
end function

sub finish()
  terminate
end sub

function link(sys n) as sys
  select n
    case 0
      return @finish
    case 1
      return @mandel
  end select
end function

end extern

addr link
"""

dllcall(o2_basic, src)
dfn = dllcall(o2_exec,0)
mandel = dllproc(dfn,"mandel i = (f zre, f zim, i maxiter)", dllcald(dfn, 1))
finish = dllproc(dfn,"finish ()", dllcald(dfn, 0))

gfx = dllfile("SDL_gfx.dll")
sdl = dllfile("sdl.dll")

SDL_INIT     = dllproc(sdl, "SDL_Init i = (i flags)")
SDL_WINDOW   = dllproc(sdl, "SDL_SetVideoMode i = (i width, i height, i video_bpp, i videoflags)")
SDL_SETALPHA = dllproc(sdl, "SDL_SetAlpha i = (i surface, i flag, i alpha)")
SDL_TITLE    = dllproc(sdl, "SDL_WM_SetCaption (z title, z icon)")
SDL_WAIT     = dllproc(sdl, "SDL_Delay (i millsecs)")
SDL_TIME     = dllproc(sdl, "SDL_GetTicks i = ()")
SDL_CLIPRECT = dllproc(sdl, "SDL_SetClipRect (i surface, i* rect)")
GFX_PIXEL    = dllproc(gfx, "pixelRGBA i = (i surface, i x, i y, i r, i g, i b, i a)")
SDL_FLIP     = dllproc(sdl, "SDL_Flip i = (i screen(")
GFX_PRINT    = dllproc(gfx, "stringColor i = (i dst, i x, i y, c *s, i color)")
SDL_QUIT     = dllproc(sdl, "SDL_Quit ()")

GLOBAL CONST SDL_INIT_VIDEO = 0x00000020
GLOBAL CONST SDL_SWSURFACE  = 0x00000000
GLOBAL CONST SDL_SRCALPHA   = 0x00010000
GLOBAL CONST SDL_RESIZABLE  = 0x00000010

flags = SDL_SWSURFACE OR SDL_SRCALPHA OR SDL_RESIZABLE

dllcall(SDL_INIT, SDL_INIT_VIDEO)
screen = dllcall(SDL_WINDOW, 640, 480, 0, flags)
ok = dllcall(SDL_SETALPHA, screen, SDL_SRCALPHA, 0)
dllcall(SDL_TITLE, "ScriptBasic GFX & DLLC - Mandelbrot", 0)
ts = dllcall(SDL_TIME)
im = 510
z = 120
h = 480
w = 640
FOR y = 0 TO h -1
  FOR x = 0 TO w -1
    zx = 0
    zy = 0
    cx = (x - w / 2) / z
    cy = (y - h / 2) / z
    it = dllcall(mandel,cx,cy, im)   
    dllcall(GFX_PIXEL, screen, x, y, it * 12, it * 8, it * 4, 255)
  NEXT
NEXT
te = dllcall(SDL_TIME)
dllcall(GFX_PRINT, screen, 20, 15, "Time: " & FORMAT("%.4f",(te-ts)/1000) & " Seconds." & CHR(0), 0xffffffff)
dllcall(SDL_FLIP, screen)
LINE INPUT WAIT
dllcall(SDL_QUIT)


[Aaron]

Hi John,

I think what I see is a reversed colour.

( it *12, it * 8, it *4, 255 )  =  (  it*4, it*8,it*12, 255 )

But does not look bad!

[JRS]

Peter,

You got it in the color ballpark but it's still off. I added SDL_CLS to make sure the backgound was black. Any other ideas?

Code: [Select]

' ScriptBasic GFX & DLLC - Mandelbrot

include "dllcinc.sb"

oxy = dllfile("/sb22/modules/oxygen.dll")

o2_basic = dllproc( oxy, "o2_basic i =(c*source) " )
o2_exec  = dllproc( oxy, "o2_exec  i =(i call)   " )
o2_error = dllproc( oxy, "o2_error c*=()         " )
o2_errno = dllproc( oxy, "o2_errno i =()         " )
o2_len   = dllproc( oxy, "o2_len   i =()         " )
o2_mode  = dllproc( oxy, "o2_mode     (i mode)   " )

dllcall(o2_mode,1)

src = """
extern
function mandel(float zre,zim,sys maxiter) as sys
    float mx,my,betrag
    sys iter
 
    while iter < maxiter and betrag < 4.0
        iter = iter+1
        tmp = mx*mx-my*my+zre
        my = 2*mx*my+zim
        mx = tmp
        betrag = (mx*mx + my*my)
    wend
    return iter
end function

sub finish()
  terminate
end sub

function link(sys n) as sys
  select n
    case 0
      return @finish
    case 1
      return @mandel
  end select
end function

end extern

addr link
"""

dllcall(o2_basic, src)
dfn = dllcall(o2_exec,0)
mandel = dllproc(dfn,"mandel i = (f zre, f zim, i maxiter)", dllcald(dfn, 1))
finish = dllproc(dfn,"finish ()", dllcald(dfn, 0))

gfx = dllfile("SDL_gfx.dll")
sdl = dllfile("sdl.dll")

SDL_INIT     = dllproc(sdl, "SDL_Init i = (i flags)")
SDL_WINDOW   = dllproc(sdl, "SDL_SetVideoMode i = (i width, i height, i video_bpp, i videoflags)")
SDL_SETALPHA = dllproc(sdl, "SDL_SetAlpha i = (i surface, i flag, i alpha)")
SDL_TITLE    = dllproc(sdl, "SDL_WM_SetCaption (z title, z icon)")
SDL_WAIT     = dllproc(sdl, "SDL_Delay (i millsecs)")
SDL_TIME     = dllproc(sdl, "SDL_GetTicks i = ()")
SDL_CLIPRECT = dllproc(sdl, "SDL_SetClipRect (i surface, i* rect)")
GFX_PIXEL    = dllproc(gfx, "pixelRGBA i = (i surface, i x, i y, i r, i g, i b, i a)")
SDL_FLIP     = dllproc(sdl, "SDL_Flip i = (i screen)")
SDL_CLS      = dllproc(sdl, "SDL_FillRect i = (i surface, i* dstrect, i color)")
GFX_PRINT    = dllproc(gfx, "stringColor i = (i dst, i x, i y, c *s, i color)")
SDL_QUIT     = dllproc(sdl, "SDL_Quit ()")

GLOBAL CONST SDL_INIT_VIDEO = 0x00000020
GLOBAL CONST SDL_SWSURFACE  = 0x00000000
GLOBAL CONST SDL_SRCALPHA   = 0x00010000
GLOBAL CONST SDL_RESIZABLE  = 0x00000010

flags = SDL_SWSURFACE OR SDL_SRCALPHA OR SDL_RESIZABLE

dllcall(SDL_INIT, SDL_INIT_VIDEO)
screen = dllcall(SDL_WINDOW, 640, 480, 0, flags)
ok = dllcall(SDL_SETALPHA, screen, SDL_SRCALPHA, 0)
dllcall(SDL_TITLE, "ScriptBasic GFX & DLLC - Mandelbrot", 0)
dllcall(SDL_CLS, screen, 0, 0x000000)
ts = dllcall(SDL_TIME)
im = 510
z = 120
h = 480
w = 640
FOR y = 0 TO h -1
  FOR x = 0 TO w -1
    zx = 0
    zy = 0
    cx = (x - w / 2) / z
    cy = (y - h / 2) / z
    it = dllcall(mandel,cx,cy, im)   
    dllcall(GFX_PIXEL, screen, x, y, it * 4, it * 8, it * 12, 255)
  NEXT
NEXT
te = dllcall(SDL_TIME)
dllcall(GFX_PRINT, screen, 20, 15, "Time: " & FORMAT("%.4f",(te-ts)/1000) & " Seconds." & CHR(0), 0xffffffff)
dllcall(SDL_FLIP, screen)
LINE INPUT WAIT
dllcall(SDL_QUIT)



.

[JRS]

I think every pixel on the screen is colored by the Mandelbrot program and using a black or white background makes no difference.

[Aaron]

Yes, that's right.

Code: [Select]

include "ss.inc"
Window 640,480,1

single x,y,zx,zy,cx,cy,tp
sys im=510,z=120,it
single t1,t2

h = GetHeight
w = GetWidth

't1 = ticks
For y=0 to <h
    For x=0 to <w
        zx=0
        zy=0
        cx= (x-w/2)/z
        cy= (y-h/2)/z
        it = im
While zx * zx + zy * zy < 4 and it>0
           tp = zx * zx - zy * zy + cx
           zy = 2 * zx * zy + cy
           zx = tp
           it -=1
Wend     
        SetPixel x,y, RGB it*4,it*8,it*12
    Next
Next

't2 = ticks
't2 = (t2-t1)/1000
SetCaption "Time needed:  " + t2

Waitkey
Quit

.

[JRS]

The only thing that has changed is I'm using the Mandelbrot Charles wrote which may be effecting how colors are chosen.


BTW I noticed the colors of your latest version now look more like the SB original version (less pink) and it runs another magnitude faster. I see your using SDL. Welcome to the club!

[JRS]

Solved.

Code: [Select]

' ScriptBasic GFX & DLLC - Mandelbrot

include "dllcinc.sb"

oxy = dllfile("/sb22/modules/oxygen.dll")

o2_basic = dllproc( oxy, "o2_basic i =(c*source) " )
o2_exec  = dllproc( oxy, "o2_exec  i =(i call)   " )
o2_error = dllproc( oxy, "o2_error c*=()         " )
o2_errno = dllproc( oxy, "o2_errno i =()         " )
o2_len   = dllproc( oxy, "o2_len   i =()         " )
o2_mode  = dllproc( oxy, "o2_mode     (i mode)   " )

dllcall(o2_mode,1)

src = """
extern

FUNCTION mandel(float cx,cy,sys it) as sys
  float zx,zy,tp
  WHILE zx * zx + zy * zy < 4 AND it > 0
    tp = zx * zx - zy * zy + cx
    zy = 2 * zx * zy + cy
    zx = tp
    it -= 1
  WEND
  return it
END FUNCTION

sub finish()
  terminate
end sub

function link(sys n) as sys
  select n
    case 0
      return @finish
    case 1
      return @mandel
  end select
end function

end extern

addr link
"""

dllcall(o2_basic, src)
dfn = dllcall(o2_exec,0)
mandel = dllproc(dfn,"mandel i = (f zre, f zim, i maxiter)", dllcald(dfn, 1))
finish = dllproc(dfn,"finish ()", dllcald(dfn, 0))

gfx = dllfile("SDL_gfx.dll")
sdl = dllfile("sdl.dll")

SDL_INIT     = dllproc(sdl, "SDL_Init i = (i flags)")
SDL_WINDOW   = dllproc(sdl, "SDL_SetVideoMode i = (i width, i height, i video_bpp, i videoflags)")
SDL_SETALPHA = dllproc(sdl, "SDL_SetAlpha i = (i surface, i flag, i alpha)")
SDL_TITLE    = dllproc(sdl, "SDL_WM_SetCaption (z title, z icon)")
SDL_WAIT     = dllproc(sdl, "SDL_Delay (i millsecs)")
SDL_TIME     = dllproc(sdl, "SDL_GetTicks i = ()")
SDL_CLIPRECT = dllproc(sdl, "SDL_SetClipRect (i surface, i* rect)")
GFX_PIXEL    = dllproc(gfx, "pixelRGBA i = (i surface, i x, i y, i r, i g, i b, i a)")
SDL_FLIP     = dllproc(sdl, "SDL_Flip i = (i screen)")
SDL_CLS      = dllproc(sdl, "SDL_FillRect i = (i surface, i* dstrect, i color)")
GFX_PRINT    = dllproc(gfx, "stringColor i = (i dst, i x, i y, c *s, i color)")
SDL_QUIT     = dllproc(sdl, "SDL_Quit ()")

GLOBAL CONST SDL_INIT_VIDEO = 0x00000020
GLOBAL CONST SDL_SWSURFACE  = 0x00000000
GLOBAL CONST SDL_SRCALPHA   = 0x00010000
GLOBAL CONST SDL_RESIZABLE  = 0x00000010

flags = SDL_SWSURFACE OR SDL_SRCALPHA OR SDL_RESIZABLE

dllcall(SDL_INIT, SDL_INIT_VIDEO)
screen = dllcall(SDL_WINDOW, 640, 480, 0, flags)
ok = dllcall(SDL_SETALPHA, screen, SDL_SRCALPHA, 0)
dllcall(SDL_TITLE, "ScriptBasic GFX & DLLC - Mandelbrot", 0)
ts = dllcall(SDL_TIME)
im = 510
z = 120
h = 480
w = 640
FOR y = 0 TO h -1
  FOR x = 0 TO w -1
    zx = 0
    zy = 0
    cx = (x - w / 2) / z
    cy = (y - h / 2) / z
    it = dllcall(mandel,cx,cy, im)
    dllcall(GFX_PIXEL, screen, x, y, it * 12, it * 8, it * 4, 255)
  NEXT
NEXT
te = dllcall(SDL_TIME)
dllcall(GFX_PRINT, screen, 20, 15, "Time: " & FORMAT("%.4f",(te-ts)/1000) & " Seconds." & CHR(0), 0x000000FF)
dllcall(SDL_FLIP, screen)
LINE INPUT WAIT
dllcall(SDL_QUIT)


[JRS]

Linux ScriptBasic got jealous. 

With this generation speed,  (and double buffering) I bet with a little more effort I could have a usable pan and zoom version of this. I removed the color modifiers and attached a B&W version.

The Mandelbrot iterator function will be included in the next ScriptBasic GFX extension module build for Linux and Windows.

Code: [Select]

' ScriptBasic GFX - Mandelbrot

IMPORT gfx.inc

s = gfx::Window(640,480,"ScriptBasic GFX Mandelbrot")
ts = gfx::Time()
FOR y = 0 TO 479
  FOR x = 0 TO 639
    cx = (x - 320) / 120
    cy = (y - 240) / 120
    rit = gfx::Mandelbrot(cx, cy, 510)
    gfx::PixelRGBA s, x, y, rit * 12, rit * 8, rit * 4, 255
  NEXT
NEXT
te = gfx::Time()
gfx::stringColor s, 20, 15, "Time: " & FORMAT("%.4f",(te-ts)/1000) & " Seconds." & CHR(0), 0x000000ff
gfx::Update
WHILE gfx::KeyName(1) <> "+escape"
WEND
gfx::Close

interface.c (SB GFX ext. module)

Code: [Select]

besFUNCTION(gfx_Mandelbrot)
  DIM AS double cx, cy, zx, zy, tp;
  DIM AS int iter;
  besARGUMENTS("rri")
    AT cx, AT cy, AT iter
  besARGEND
  DEF_WHILE (zx * zx + zy * zy < 4 AND iter > 0)
  BEGIN_WHILE
    tp = zx * zx - zy * zy + cx;
    zy = 2 * zx * zy + cy;
    zx = tp;
    iter = iter - 1;
  WEND
  besRETURN_LONG(iter);
besEND

.

[JRS]

Peter,

Can you let us know what license if any applies to using your libraries? It would be a shame for someone to invest a lot of time into their project using your libraries to find out they can't without prior approval. If you have no plans to profit from your efforts, why not make them open source and maximize the benefit to others with your fine efforts?

I hope you continue on the SDL trail as it applies to more than just Windows.

I'm guessing it' pretty close to SB.

     once again a good joke! 
here is time.

I wasn't joking. The SB and O2 version of the Mandelbrot are within a second of each other. Arguing further is spiting hairs. I have said for years that with todays hardware, interpreters can hold there own. When a CPU intensive task rolls around, having a simple way to turn the task into a C function to eliminate the interpretive bottle neck seems like the best of both worlds. In my mind portability and ease of use have priority and shoring up the code with C functions when needed solves all my long term goals.




John

[Aaron]

Can you let us know what license if any applies to using your libraries?

Hello John,

You can use all the libraries, there is no licence for those libraries.
Whatever you do therewith, (commercial or own projects or garbage can) do it!

Of course, the libraries are on your risk to use! Do not worry, they are oxygen stable.
Have I more to say? 

Hu, you are liking Sdl! Yes I stay with Sdl, and have made a small library today.
And again, it's absolutly free!  Still no GetPixel, but I think is comming soon.
 
If you have difficulties reading this horrible English, then simply learn German!

Some sdl demo:

Code: [Select]

include "ss.inc"
OpenWindow 640,480,1           

f1 = LoadFont "textfonts/bne.ttf",28,2
f2 = LoadFont "textfonts/choco.ttf",48,0

sys a, x
p = LoadImage "png/banana.png",1
m = LoadTile  "png/fontc.png",16,6

while KeyDown(27)=0
Cls 255,190,0

TileText m,100,50,"OXYSDL"
DrawImage p,200,200,0
DrawText f1, 200,  0,"Hello Banana", RGB(0,55,255) 
DrawText f2, 200,100,"Hello Banana", RGB(0,100,255) 
DrawText f1,0,0, xMouse + "  " + yMouse,0

Color(0,0,255,255)
DrawRoundRect 500,200,40,40,8
DrawTriangle 400,200,350,250,450,250
FillTriangle 400,300,350,250,450,250

Color(0,255,255,255)
FillRoundRect 500,100,40,40,4

Color(255,0,0,255)
DrawLine 0,400,639,400

Color(0,0,255,255)
ThickLine 0,310,639,310,6

Color(255,0,0,155)
FillEllipse 300,300,40,60

Color(0,0,255,255)
DrawEllipse 400,400,60,20

Color(0,0,255,255)
DrawPoint 320,240,10

Color(0,255,0,155)
FillCircle x,100,20
FillCircle 50,258,30
   
Color(20,170,16,255)
DrawCircle(200,180,40) 

Color(255,0,0,200)
DrawRect 100,100,50,50
FillRect 300,100,50,50

x +=1
if x >=620 then x=0

if KeyPressed()=1
   DrawText f1,10,350,"WHAT WANTED YOU SAY?",0
end if

Redraw()
Wait (2)
wend

CloseWindow()

.

[Aaron]

Code: [Select]

include "ss.inc"
OpenWindow 640,480,1

sys cx[100],cy[100],cd[100],cr[100],cs[100]
sys cr[100],cg[100],cb[100],ca[100]

For c=1, 100
    cx[c]=310
    cy[c]=230
    cd[c]=Rnd(1,8)
    cs[c]=Rnd(20,30)
    cr[c]=Rnd(64,255)
    cg[c]=Rnd(64,255)
    cb[c]=Rnd(64,255)
    ca[c]=Rnd(64,255)
Next

Sub Circles()
For m=1, 100
    Color(cr[m],cg[m],cb[m],ca[m])   
    FillCircle cx[m],cy[m],cs[m]
Next
End Sub

Sub Bound()
For x=1, 100
    if cx[x] <=10 then
       cd[x] = Rnd(1,9)
       cx[x] =10
    end if
    if cx[x] >=620 then
       cd[x] = Rnd(1,9)
       cx[x] =620
    end if
    if cy[x] >=460 then
       cd[x] = Rnd(1,9)
       cy[x] =460
    end if
    if cy[x] <=10 then
       cd[x] = Rnd(1,9)
       cy[x] =10
    end if
Next
End Sub

while KeyDown(27)=0
cls 0,0,0
for c=1, 100
    if cd[c]=1 then
       cx[c]=cx[c]+1
       Bound()
    elseif cd[c]=2 then
       cx[c]=cx[c]-1
       Bound()
    elseif cd[c]=3 then
       cy[c]=cy[c]-1
       Bound()
    elseif cd[c]=4 then
       cy[c]=cy[c]+1
       Bound()
    elseif cd[c]=5 then
       cy[c]=cy[c]-1
       cx[c]=cx[c]-1
       Bound()
    elseif cd[c]=6 then
       cy[c]=cy[c]-1
       cx[c]=cx[c]+1
       Bound()
    elseif cd[c]=7 then
       cy[c]=cy[c]+1
       cx[c]=cx[c]-1
       Bound()
    elseif cd[c]=8 then
       cy[c]=cy[c]+1
       cx[c]=cx[c]+1
       Bound()
    end if
Next
Circles
Redraw
Wait 2
wend
CloseWindow