Oxygen Basic

Programming => Example Code => Topic started by: Peter on October 14, 2015, 10:26:07 AM

Title: Mandelbrot
Post by: Peter on October 14, 2015, 10:26:07 AM

Hello,
unfortunately, Mike did not show his Mandelbrot collection!
I am interested in the speed!

Code: [Select]

include "asm.inc"
window 512,512,1

float bx,by, int bw=512,bh=512,col
float sx=-2.2,sy=-1.7,sw=3.4,sh=3.4
float t,gx,gy,zx,zy,nzx,r,v,b

t = ticks
for x=0 to bw
for y=0 to bh
    gx=x/bw*sw+sx
    gy=y/bh*sh+sy
    zx=gx
    zy=gy
for c=0 to 255
    col = c
    nzx = zx*zx - zy*zy + gx
    zy  = 2*zx*zy+gy
    zx  = nzx
    if zx*zx + zy*zy > 4 then
       col = c
       exit for
    end if
next
r = col     
v = col*32 
b = col*64 
color r,v,b
setpixel x,y
next
next

color 255,255,255
text 0,0,14, str((ticks()-t)/1000,4) + " secondes"

waitkey
winExit



[attachment deleted by admin]

Title: Re: Mandelbrot
Post by: JRS on October 14, 2015, 01:00:18 PM

@Peter: Don't make me dig out the word count challenge again.  ;D

Title: Re: Mandelbrot
Post by: Mike Lobanovsky on October 14, 2015, 01:50:55 PM

Hi Peter,

My absolute best for a 400x400 px window was

(http://i1240.photobucket.com/albums/gg490/FbslGeek/M_DC_PER_DIBITS.png)

Eros Olmi's thinBasic + O2 add-on for 400x400 pixels was a very, very close second-best with

(http://i1240.photobucket.com/albums/gg490/FbslGeek/M_O2_BUF.png)

which, for all intents and purposes and given GetTickCount() inaccuracy, would be practically the same. :)

The entire epopee can still be found starting with this message by Eros (http://www.fbsl.net/phpbb2/viewtopic.php?f=14&t=2971&start=15#p10470) on the FBSL forum.



Can you please compile your O2 code to an exe for me, Peter?

Title: Re: Mandelbrot
Post by: Peter on October 14, 2015, 03:09:47 PM

Quote

Can you please compile your O2 code to an exe for me, Peter?

but sure!


[attachment deleted by admin]

Title: Re: Mandelbrot
Post by: Mike Lobanovsky on October 15, 2015, 02:08:55 AM

Thank you!

Not too bad, Peter, I'd say, very decent for a typical BASIC penis-metering contest using some form of PSet. :)

My 15/31 msec duel with Eros used direct writes into the DIB pixel array rather than GDI function calls. That is why it yielded much faster results, but unfortunately this method inverts the original MS Windows colors and therefore is rarely used in practice.

[attachment deleted by admin]

Title: Re: Mandelbrot
Post by: Peter on October 15, 2015, 07:15:15 AM

Hello,
here's another Mandel Julia test.

Code: [Select]

include "asm.inc"
window 1024,768,1  '0=fullscreen, be careful with windowsXP due to the desctop icons!

float r,i,x,y,z t
int c[32]

for i=0 to 32
    c[i] = RGB(i*8,i*14,i*8)
next

Sub Invers() 
d = x*x + y*y
if d=0 then
   r=100000
   x=r
   i=r
   y=r
else
   r=r/d
   x=r
   i=i/d
   y=i
end if
End Sub

Sub Inside(float d, fac, z, it)
i = Abs(Log(d))*fac
if z = it then
   r = GetR(c[i])
   g = GetG(c[i])
   b = GetB(c[i])
   color r,g,b
else
   color 0,0,0
end if
End Sub

Sub Julia_Init(float xss,yss,lt,rt,bm,tp,it,bb,inv,ins,fac,dx,dy,ci,cr)
dxpp = (rt-lt)/xss
dypp = (tp-bm)/yss
r=bm
for xr=0 to xss
    i = lt
for yr=0 to yss
    x = r
    y = i
    b = x
    m = y
    if inv=1 then Invers()
    xs = x*x
    ys = y*y
    while key(27)=0
    y = x*y
    Y = y+y-cr
    x = xs-ys-ci
    xs = x*x
    ys = y*y
    d = xs+ys
    if d < bb and z < it
       z +=1
    else
       exit while
    end if
    wend 
    if ins=0
       r = GetR(c[z])
       g = GetG(c[z])
       b = GetB(c[z])
       color r,g,b
    else
       Inside(d, fac, z, it)
    end if
    setpixel xr+dx, yr+dy
    z=0
    r=b
    i=m
    i += dypp
next
r += dxpp
redraw
next
End Sub

lt=-2 : rt=2
bm=-2 : tp=2
t = ticks
Julia_Init(1024,768,lt,rt,bm,tp,20,30.0,1,1,5,1,1,-0.32,-0.043)
wintext "TIME: " + (ticks()-t)/1000 + " SECONDS"
waitkey
WinExit


[attachment deleted by admin]

Title: Re: Mandelbrot
Post by: Mike Lobanovsky on October 15, 2015, 01:25:11 PM

Hi Peter,

Thanks for that one! On my PC, it takes exactly 2.25 seconds to draw. My equivalent rewritten in FBSL draws in 0.296 seconds with 20 iterations as your original, and in exactly 0.5 seconds, with 100 iterations for much richer output. FBSL also uses my hand-written approximation of log() function that's about 7 times faster than the one from the standard C library.

[UPD] On revisiting the code in the morning, I was able to further reduce the 100-iteration version's exec time to 0.391 seconds by eliminating a good deal of redundant SetPixelV() calls with Julia's functionality intact. Code updated, snapshot and executable reuploaded.

Please see below for the FBSL sources, snapshot, and executable.

Code: OxygenBasic

1. #Define width 1024
2. #Define height 768
3.  
4. Type RECT
5.   Left As Long
6.   Top As Long
7.   Right As Long
8.   Bottom As Long
9. End Type
10.  
11. Type BITMAPINFOHEADER Align 2
12.   biSize As Long
13.   biWidth As Long
14.   biHeight As Long
15.   biPlanes As Integer * 16
16.   biBitCount As Integer * 16
17.   biCompression As Long
18.   biSizeImage As Long
19.   biXPelsPerMeter As Long
20.   biYPelsPerMeter As Long
21.   biClrUsed As Long
22.   biClrImportant As Long
23. End Type
24.  
25. Dim rc As RECT, bi As BITMAPINFOHEADER
26.  
27. With bi
28.   .biSize = SizeOf(BITMAPINFOHEADER)
29.   .biWidth = width
30.   .biHeight = height
31.   .biPlanes = 1
32.   .biBitCount = 24
33. End With
34.  
35. Dim %c[32]
36. For Dim i = 0 To 32
37.   c[i] = RGB(i * 8, i * 14, i * 8)
38. Next
39.  
40. Dim lt = -2, rt = 2
41. Dim bm = -2, tp = 2
42. Dim hBmp = CreateDIBSection(NULL, @bi, 0, NULL, NULL, 0)
43. Dim hDC = GetDC(ME), hMemDC = CreateCompatibleDC(NULL)
44. Dim hOldBmp = SelectObject(hMemDC, hBmp): SetStretchBltMode(hDC, 4) ' HALFTONE
45. Dim t = GetTickCount()
46.  
47. Julia(hMemDC, lt, rt, bm, tp, 100, 30, TRUE, TRUE, 5, 1, 1, -0.32, -0.043)
48.  
49. FbslSetText(ME, "-= GDI Julia =-  TIME: " & (GetTickCount() - t) / 1000 & " SECONDS")
50. Resize(ME, 0, 0, width, height)
51. Center(ME)
52. Show(ME)
53.  
54. Begin Events
55.   If CBMSG = &H111 AndAlso CBWPARAM = 2 Then ' WM_COMMAND && Esc
56.    PostMessage(ME, &H10, 0, 0) ' WM_CLOSE
57.  ElseIf CBMSG = &HF OrElse CBMSG = &H5 Then ' WM_PAINT || WM_SIZE
58.    GetClientRect(ME, @rc)
59.     ValidateRect(ME, NULL)
60.     StretchBlt(hDC, 0, 0, rc.Right, rc.Bottom, hMemDC, 0, 0, width, height, &HCC0020) ' SRCCOPY
61.    Return 0
62.   ElseIf CBMSG = &H10 Then ' WM_CLOSE
63.    DeleteObject(SelectObject(hMemDC, hOldBmp))
64.     DeleteDC(hMemDC)
65.     ReleaseDC(ME, hDC)
66.   End If
67. End Events
68.  
69. DynC Julia(%dc, %lt, %rt, !bm, !tp, %it, !bb, %inv, %ins, !fac, !dx, !dy, _
70.           !ci, !cr, %clr = @c, !xss = width, !yss = height)
71.  
72.   double fabs(double);
73.   void __attribute__((stdcall)) SetPixelV(int, int, int, int);
74.  
75.   float mylog(float x) { // 7 times faster than log(), accurate to two decimal places
76.     union {float f; int i;} vx = {x};
77.     float y = vx.i;
78.     y *= 1.0 / (1 << 23);
79.     return 0.69314718f * (y - 126.94269504f);
80.   }
81.  
82.   void main(int hdc, int lt, int rt, float bm, float tp, int it, float bb, int inv, int ins,
83.             float fac, float dx, float dy, float ci, float cr, int c[], float xss, float yss)
84.   {
85.     int xr, yr, z, ix, iy;
86.     float xs, ys, b, m;
87.     float dxpp = (rt - lt) / xss;
88.     float dypp = (tp - bm) / yss;
89.     float r = bm, i, x, y, xs, ys, d, b, m;
90.    
91.     for (xr = 0; xr < xss; xr++) {
92.       i = lt;
93.       for (yr = 0; yr < yss; yr++) {
94.         b = x = r; m = y = i;
95.         if (inv) { // inverse()
96.           d = x * x + y * y;
97.           if (d == 0.0f)
98.             x = y = i = r = 100000.0f;
99.           else {
100.             x = r /= d; y = i /= d;
101.           }
102.         }
103.         xs = x * x; ys = y * y;
104.         while (1) {
105.           y += (y *= x) - cr;
106.           x = xs - ys - ci;
107.           d = (xs = x * x) + (ys = y * y);
108.           if (d < bb && z < it)
109.             z++;
110.           else
111.             break;
112.         }
113.         if (!ins) // inside()
114.           SetPixelV(hdc, xr + dx, yr + dy, c[z]);
115.         else if (z == it)
116.           SetPixelV(hdc, xr + dx, yr + dy, c[(int)(fabs(mylog(d)) * fac)]);
117.         z = 0; r = b;
118.         i = m + dypp;
119.       }
120.       r += dxpp;
121.     }
122.   }
123. End DynC

[attachment deleted by admin]

Title: Re: Mandelbrot
Post by: Peter on October 16, 2015, 01:08:00 AM

Hi Mike,

indeed. very fast!  :D
SetDIBSection is a tad unfair, we don't have the same conditions.   ;D

[attachment deleted by admin]

Title: Re: Mandelbrot
Post by: Peter on October 16, 2015, 01:24:36 AM

Hi Mike,

found this at basicprogramming.org

Code: [Select]

'vonoroi.bas for SmallBASIC 2015-10-14 MGA/B+
'modified bluatigro code from JB 2015-09-07 vonoroi diagram

include "asm.inc"
window 800,600,1

int sq=800,s2=sq/2,points=240
int x[240],y[240],kl[240]

single t = ticks
for i=0 to points
    x[i] = rand(32,sq)
    y[i] = rand(32,sq)
    g=127-127*(abs(s2-x[i])/s2)+127-127*(abs(s2-y[i])/s2)
    kl[i] = RGB(255-x[i]/sq*255,g,y[i]/sq*255)
next

for xx=0 to sq
for yy=0 to sq
    d = 307201
for i=0 to points
    a=x[i]-xx: b=y[i]-yy
    q=a*a+b*b
    if q<d then
       d=q
       kkl = i
    end if   
next
PutPixel xx, yy, kl[kkl]
next
next
WinText "TIME: " + (ticks()-t)/1000 + " SECONDS"

waitkey
winExit


[attachment deleted by admin]

Title: Re: Mandelbrot
Post by: Peter on October 16, 2015, 01:39:53 AM

Here's a SDL version.

Code: [Select]

'vonoroi.bas for SmallBASIC 2015-10-14 MGA/B+
'modified bluatigro code from JB 2015-09-07 vonoroi diagram

actually, his name is Voronoy!

include "sdl.inc"
window 800,600,1

int sq=800,s2=sq/2,points=240
int x[240],y[240],kl[240]

single t = ticks
for i=0 to points
    x[i] = rand(32,sq)
    y[i] = rand(32,sq)
    g=127-127*(abs(s2-x[i])/s2)+127-127*(abs(s2-y[i])/s2)
    kl[i] = RGBA(255-x[i]/sq*255,g,y[i]/sq*255,255)
next

for xx=0 to sq
for yy=0 to sq
    d = 307201
for i=0 to points
    a=x[i]-xx: b=y[i]-yy
    q=a*a+b*b
    if q<d then
       d=q
       kkl = i
    end if   
next
PutPixel xx, yy, kl[kkl]
next
next
SetCaption "TIME: " + (ticks()-t)/1000 + " SECONDS"
waitkey
winExit

[attachment deleted by admin]

Title: Re: Mandelbrot
Post by: Mike Lobanovsky on October 16, 2015, 03:25:13 AM

Hi Peter,

Quote from: Peter on October 16, 2015, 01:08:00 AM

SetDIBSection is a tad unfair, we don't have the same conditions.   ;D

DIB section isn't critical in this context as long as we're using anything SetPixelV-/PSet-/setpixel-compatible. We could as well have used CreateCompatibleBitmap instead and it wouldn't change the speed in any way. SetPixelV is reasonably fast for BASIC when drawing static images to an invisible memory DC for picture persistency but becomes dramatically slow for per-pixel draws directly on screen. Subsequent bit-blitting or stretch-blitting of the entire DC in response to the WM_PAINT/WM_RESIZE messages is very fast if not artificially looped, because it is harware-assisted on all modern GPUs.

However, if we would try and store colors directly into the bitmap's pixel array instead of PSet-ing pixels in the in-memory canvas like we did, we would have to use the DIB section only. Direct writes to the DIB could speed up the program by yet another 30% but they would also require a different [x, y] order of addressing pixels and the loop code would have to be changed.

Quote from: Peter's new Big_Julia

TIME: 0.516 SECONDS

That's nice! That's what I had been getting before I eliminated the SitPixelV calls that would draw black pixels over the initially black background in the newly created memory context. :)

I'm also going to give your Voronoi bananas a try in the evening, but now it's time for a short nap.

(http://www.fbsl.net/phpbb2/images/smilies/icon_ml_gnight.gif)

Title: Re: Mandelbrot
Post by: Aurel on October 16, 2015, 10:02:39 AM

Hey Mike
Your julia100 get 2.068 sec on my old XP 1.7Ghz machine...is that ok?
 ;D

Title: Re: Mandelbrot
Post by: Mike Lobanovsky on October 16, 2015, 10:17:49 AM

Hi Aurel,

How long does Peter's latest big_julia take on your PC?

Title: Re: Mandelbrot
Post by: Peter on October 16, 2015, 10:26:50 AM

Perhaps but none of us will live to see that, so why bother advertizing in a technical thread?

advertising
Sorry Mike, but I am English learner!  ;D

Title: Re: Mandelbrot
Post by: Mike Lobanovsky on October 16, 2015, 10:54:41 AM

Quote from: Peter on October 16, 2015, 10:26:50 AM

I am English learner!  ;D

(http://www.thumbupthumbdown.com/wp-content/uploads/2014/12/thumb_up.png)

:D

Title: Re: Mandelbrot
Post by: Mike Lobanovsky on October 16, 2015, 12:18:16 PM

Hello John,

Here's its FBSL equivalent with interpreted loops and JIT compiled iteration kernel, performing on my PC at ~60% of your sample speed for 512 iterations in a 640x480 window, persistent and resizable. (N.B. no DIB sections this time, Peter)

Code: OxygenBasic

1. Dim MaxIter = 512
2. Dim width = 640
3. Dim height = 480
4. Dim colors[MaxIter]
5.  
6. FillColorTable()
7.  
8. Dim hDC = GetDC(ME), hMemDC = CreateCompatibleDC(NULL)
9. Dim hBmp = CreateCompatibleBitmap(hDC, width, height)
10. Dim hOldBmp = SelectObject(hMemDC, hBmp): SetStretchBltMode(hDC, 4) ' HALFTONE
11. Dim t = GetTickCount()
12.  
13. GenMandelbrot(-3, -2, 2.5, 2)
14.  
15. FbslSetText(ME, "-= JRS Compatible Mandel =-  TIME: " & (GetTickCount() - t) / 1000 & " SECONDS")
16. Resize(ME, 0, 0, width, height)
17. Center(ME)
18. Show(ME)
19.  
20. Begin Events
21.   Type RECT
22.     Left As Long
23.     Top As Long
24.     Right As Long
25.     Bottom As Long
26.   End Type
27.  
28.   Static rc As RECT
29.  
30.   If CBMSG = &H111 AndAlso CBWPARAM = 2 Then ' WM_COMMAND && Esc
31.    PostMessage(ME, &H10, 0, 0) ' WM_CLOSE
32.  ElseIf CBMSG = &HF OrElse CBMSG = &H5 Then ' WM_PAINT || WM_SIZE
33.    GetClientRect(ME, @rc)
34.     ValidateRect(ME, NULL)
35.     StretchBlt(hDC, 0, 0, rc.Right, rc.Bottom, hMemDC, 0, 0, width, height, &HCC0020) ' SRCCOPY
36.    Return 0
37.   ElseIf CBMSG = &H10 Then ' WM_CLOSE
38.    DeleteObject(SelectObject(hMemDC, hOldBmp))
39.     DeleteDC(hMemDC)
40.     ReleaseDC(ME, hDC)
41.   End If
42. End Events
43.  
44. Sub GenMandelbrot(xMn, yMn, xMx, yMx)
45.   Dim iX, iY, cx, cy, dx, dy
46.  
47.   dx = (xMx - xMn) / (width - 1)
48.   dy = (yMx - yMn) / (height - 1)
49.  
50.   For iY = 0 To height
51.     cy = yMn + iY * dy
52.     For iX = 0 To width
53.       cx = xMn + iX * dx
54.       If Iterate(MaxIter, cx, cy) <> MaxIter Then SetPixel(hMemDC, iX, iY, colors[Iterate])
55.     Next
56.   Next
57. End Sub
58.  
59. DynC Iterate(%mi, !!cx, !!cy) As Long
60.   long main(long MaxIter, double cx, double cy)
61.   {
62.     int iters = 0;
63.     double X = cx, Y = cy, X2 = X * X, Y2 = Y * Y, temp;
64.    
65.     while ((iters < MaxIter) && (X2 + Y2 < 4)) {
66.       temp = cx + X2 - Y2;
67.       Y = cy + 2 * X * Y;
68.       Y2 = Y * Y;
69.       X = temp;
70.       X2 = X * X;
71.       iters++;
72.     }
73.     return iters;
74.   }
75. End DynC
76.  
77. Sub FillColorTable()
78.   Dim r, g, b
79.   Dim rd, gd, bd
80.   Dim rr, gg, bb
81.   Dim i, j, wid
82.  
83.   Dim clr[3]
84.   clr[1] = RGB(0, 255, 0)
85.   clr[2] = RGB(255, 255, 0)
86.   clr[3] = RGB(255, 0, 0)
87.  
88.   wid = MaxIter / 64
89.  
90.   For j = 0 To 2
91.     toRGB(clr[j], r, g, b)
92.     toRGB(clr[j + 1], rr, gg, bb)
93.     rd = (rr - r) / (wid + 1)
94.     gd = (gg - g) / (wid + 1)
95.     bd = (bb - b) / (wid + 1)
96.     For i = 0 To wid
97.       colors[j * wid + i] = RGB(r, g, b)
98.       r = r + rd
99.       g = g + gd
100.       b = b + bd
101.     Next
102.   Next
103. End Sub
104.  
105. Sub toRGB(c, r, g, b)
106.   r = c BAnd &HFF
107.   g = (c BAnd &HFF00) / &H100
108.   b = (c BAnd &HFF0000) / &H10000
109. End Sub

[attachment deleted by admin]

Title: Re: Mandelbrot
Post by: Aurel on October 16, 2015, 12:58:23 PM

Quote

How long does Peter's latest big_julia take on your PC?

Mike
It takes 3.043 seconds ...is that Ok to?

/
well really why John remove post ?
I don't get it  ???
in fact maybe i can built-in into ruben such a mandelbrot function
and lock buffer to speed up slow interpreter (ruben)
 ;D ;D ;D
/

Title: Re: Mandelbrot
Post by: Peter on October 16, 2015, 01:53:36 PM

Hi,
another mandelbrot.

Code: [Select]

include "asm.inc"
window 600,500,1

sys ma=16
single xs=-2.5,ys=-2,zml=1.25

Function cfunc(sys p,w) as sys
  pP=(p*1792)/w
  sys red,green,blue
  if pP <256
     red=0
     green=0
     blue=pP
  else if pP <512
     red=0
     green=pP-256
     blue=255
  else if pP <768
     red=0
     green=255
     blue =255-(pP-512)
  else if pP <1024
     red= pP-768
     green=255
     blue=0
  else if pP <1280
     red=255
     green=255-(pP-1024)
     blue=0
  else if pP <1536
     red=255
     green=0
     blue=pP-1280
  else
     red=255
     green=pP-1536
     blue=255
  end if   
  Return RGB(red,green+4,blue)
End Function

Sub funcpix(sys ix,iy, single x,y,zm)
    single xC=(xs)+(single(ix)+.5)/100/zm)
    single yC=(ys)+(single(iy)-.5)/100/zm)
    single x0=(xs)+(single(ix)+.5)/100/zm)
    single y0=(ys)+(single(iy)-.5)/100/zm)
    single x2=xc*xc
    single y2=yc*yc
    sys it
    while (x2+y2) < (2*2) and it < ma 
    yc = 2*xc*yc + y0
    xc = x2 - y2 + x0
    x2 = xc*xc
    y2 = yc*yc
    it +=1
    wend
    if it=ma
       PutPixel ix,iy,rgb(41,60,194)
    else
       PutPixel ix,iy,cfunc(it,ma)
    end if
End Sub   

t = ticks
For i=0 to 600
   For j=0 to 500
     funcpix(i,j,xs,ys,zml)
   Next
 Next
 color 255,255,255
 text 0,0,12,"TIME: " + (ticks()-t)/1000 + " SECONDS"

 WaitKey
 WinExit




[attachment deleted by admin]

Title: Re: Mandelbrot
Post by: Mike Lobanovsky on October 16, 2015, 01:54:35 PM

Yep Aurel, those timings seem plausible for a single-core 1.7GHz Pentium. My Intel Pentium has four cores running in parallel with each other at roughly two times the speed of yours, which gives a tremendous boost even to single-threaded applications. But my CPU isn't the fastest one these days either. :)

As for the built-in Mandelbrot function, you might do it but for what purpose? We don't use fractals every day so its practicality would be next to zero...

Title: Re: Mandelbrot
Post by: Mike Lobanovsky on October 16, 2015, 02:53:15 PM

Hehe Peter,

Your latest Mandel won't do; it does only 16 iterations against John's and my 512. That's cheating. :D

In the meantime, here are your bananas on my PC: (FBSL's one is resizable)

Code: OxygenBasic

1. 'vonoroi.bas for SmallBASIC 2015-10-14 MGA/B+
2. 'modified bluatigro code from JB 2015-09-07 vonoroi diagram
3. 'further modified into O2 banana by peter
4. 'and finally, devoured by ML's FBSL
5.  
6. Dim width = 800, height = 600, points = 240
7. Dim hDC = GetDC(ME), hMemDC = CreateCompatibleDC(NULL)
8. Dim hBmp = CreateCompatibleBitmap(hDC, width, height)
9. Dim hOldBmp = SelectObject(hMemDC, hBmp): SetStretchBltMode(hDC, 4) ' HALFTONE
10. Dim t = GetTickCount()
11.  
12. PetersBanana(hMemDC)
13.  
14. FbslSetText(ME, "-= Peter's Banana =-  TIME: " & (GetTickCount() - t) / 1000 & " SECONDS")
15. Resize(ME, 0, 0, width, height)
16. Center(ME)
17. Show(ME)
18.  
19. Begin Events
20.   Type RECT
21.     Left As Long
22.     Top As Long
23.     Right As Long
24.     Bottom As Long
25.   End Type
26.  
27.   Static rc As RECT
28.  
29.   If CBMSG = &H111 AndAlso CBWPARAM = 2 Then ' WM_COMMAND && Esc
30.    PostMessage(ME, &H10, 0, 0) ' WM_CLOSE
31.  ElseIf CBMSG = &HF OrElse CBMSG = &H5 Then ' WM_PAINT || WM_SIZE
32.    GetClientRect(ME, @rc)
33.     ValidateRect(ME, NULL)
34.     StretchBlt(hDC, 0, 0, rc.Right, rc.Bottom, hMemDC, 0, 0, width, height, &HCC0020) ' SRCCOPY
35.    Return 0
36.   ElseIf CBMSG = &H10 Then ' WM_CLOSE
37.    DeleteObject(SelectObject(hMemDC, hOldBmp))
38.     DeleteDC(hMemDC)
39.     ReleaseDC(ME, hDC)
40.   End If
41. End Events
42.  
43. DynC PetersBanana(%dc, %w = width, %p = points)
44.   #define rnd(x, y) (rand() % (y - x) + (x))
45.   #define RGB(r, g, b) (b) << 16 | (g) << 8 | (r)
46.  
47.   void __attribute__((stdcall)) SetPixelV(int, int, int, int);
48.   double fabs(double);
49.  
50.   void main(int hdc, int sq, int points)
51.   {
52.     int x[240], y[240], kl[240]; // can't dim arrays with a var in DynC
53.    int xx, yy, i, a, b, g, r, d, q, kkl, s2 = sq >> 1;
54.    
55.     for (i = 0; i < points; i++) {
56.       x[i] = rnd(32, sq);
57.       y[i] = rnd(32, sq);
58.       r = 255 - x[i] / (double)sq * 255;
59.       g = 127 - 127 * (fabs(s2 - x[i]) / s2) + 127 - 127 * (fabs(s2 - y[i]) / s2);
60.       b = y[i] / (double)sq * 255;
61.       kl[i] = RGB(r, g, b);
62.     }
63.    
64.     for (xx = 0; xx < sq; xx++) {
65.       for (yy = 0; yy < sq; yy++) {
66.         d = 307201;
67.         for (i = 0; i < points; i++) {
68.           a = x[i] - xx; b = y[i] - yy;
69.           q = a * a + b * b;
70.           if (q < d) {
71.             d = q;
72.             kkl = i;
73.           }
74.         }
75.         SetPixelV(hdc, xx, yy, kl[kkl]);
76.       }
77.     }
78.   }
79. End DynC

[attachment deleted by admin]

Title: Re: Mandelbrot
Post by: Mike Lobanovsky on October 17, 2015, 03:53:48 AM

Hi John,

There still seems to be some room left that evidently attributes to my CPU being slightly faster than your fastest compilation (VC):

Code: OxygenBasic

1. Type RECT
2.   %left %top
3.   %right %bottom
4. End Type
5.  
6. Dim MaxIter = 512
7. Dim width = 640
8. Dim height = 480
9.  
10. Dim hDC = GetDC(ME), hMemDC = CreateCompatibleDC(NULL)
11. Dim hBmp = CreateCompatibleBitmap(hDC, width, height)
12. Dim hOldBmp = SelectObject(hMemDC, hBmp): SetStretchBltMode(hDC, 4) ' HALFTONE
13. Dim rc As RECT: SetRect(@rc, 10, 35, width + 10, height + 35)
14. Dim t = GetTickCount()
15.  
16. GenMandelbrot(-3, -2, 2.5, 2)
17.  
18. FbslSetText(ME, "-= JRS Compatible Mandel =-  TIME: " & (GetTickCount() - t) / 1000 & " SECONDS")
19. AdjustWindowRectEx(@rc, &HCF0000, FALSE, &H100) ' WS_OVERLAPPEDWINDOW && WS_EX_WINDOWEDGE
20. Resize(ME, 0, 0, rc.right - rc.left, rc.bottom - rc.top)
21. Center(ME): Show(ME)
22.  
23. Begin Events
24.   If CBMSG = &H111 AndAlso CBWPARAM = 2 Then ' WM_COMMAND && Esc
25.    PostMessage(ME, &H10, 0, 0) ' WM_CLOSE
26.  ElseIf CBMSG = &HF OrElse CBMSG = &H5 Then ' WM_PAINT || WM_SIZE
27.    GetClientRect(ME, @rc)
28.     ValidateRect(ME, NULL)
29.     StretchBlt(hDC, 0, 0, rc.right, rc.bottom, hMemDC, 0, 0, width, height, &HCC0020) ' SRCCOPY
30.    Return 0
31.   ElseIf CBMSG = &H10 Then ' WM_CLOSE
32.    DeleteObject(SelectObject(hMemDC, hOldBmp))
33.     DeleteDC(hMemDC)
34.     ReleaseDC(ME, hDC)
35.   End If
36. End Events
37.  
38. Sub GenMandelbrot(xMn, yMn, xMx, yMx)
39.   Dim iX, iY, cx, cy, dx, dy
40.  
41.   dx = (xMx - xMn) / (width - 1)
42.   dy = (yMx - yMn) / (height - 1)
43.  
44.   For iY = 0 To height
45.     cy = yMn + iY * dy
46.     For iX = 0 To width
47.       cx = xMn + iX * dx
48.       If Iterate(MaxIter, cx, cy) <> MaxIter Then
49.         SetPixel(hMemDC, iX, iY, RGB(160 - Iterate * 32, 208 - Iterate * 16, 232 - Iterate * 8))
50.       End If
51.     Next
52.   Next
53. End Sub
54.  
55. DynC Iterate(%mi, !!cx, !!cy) As Long
56.   long main(long MaxIter, double cx, double cy)
57.   {
58.     int iters = 0;
59.     double X = cx, Y = cy, X2 = X * X, Y2 = Y * Y, temp;
60.    
61.     while ((iters < MaxIter) && (X2 + Y2 < 4)) {
62.       temp = cx + X2 - Y2;
63.       Y = cy + 2 * X * Y;
64.       Y2 = Y * Y;
65.       X = temp;
66.       X2 = X * X;
67.       iters++;
68.     }
69.     return iters;
70.   }
71. End DynC

[attachment deleted by admin]

Title: Re: Mandelbrot
Post by: JRS on October 17, 2015, 08:16:02 PM

64 bit SDL and Script BASIC on Windows 7 64 bit.

Code: Script BASIC

1. ' ScriptBasic GFX - Mandelbrot
2.  
3. IMPORT gfx.inc
4.  
5. s = gfx::Window(640,480,"ScriptBasic GFX Mandelbrot")
6. ts = gfx::Time()
7. FOR y = 0 TO 479
8.   FOR x = 0 TO 639
9.     cx = (x - 320) / 120
10.     cy = (y - 240) / 120
11.     rit = gfx::Mandelbrot(cx, cy, 510)
12.     gfx::PixelRGBA s, x, y, rit * 32, rit * 16, rit * 8, 255
13.   NEXT
14. NEXT
15. te = gfx::Time()
16. gfx::stringColor s, 20, 15, "Time: " & FORMAT("%.4f",(te-ts)/1000) & " Seconds." & CHR(0), 0x000000ff
17. gfx::Update
18. WHILE gfx::KeyName(1) <> "+escape"
19. WEND
20. gfx::Close
21.  

Code: C

1. besFUNCTION(gfx_Mandelbrot)
2.   DIM AS double cx, cy, zx, zy, tp;
3.   DIM AS int iter;
4.   besARGUMENTS("rri")
5.     AT cx, AT cy, AT iter
6.   besARGEND
7.   DEF_WHILE (zx * zx + zy * zy < 4 AND iter > 0)
8.   BEGIN_WHILE
9.     tp = zx * zx - zy * zy + cx;
10.     zy = 2 * zx * zy + cy;
11.     zx = tp;
12.     iter = iter - 1;
13.   WEND
14.   besRETURN_LONG(iter);
15. besEND
16.  

(http://www.allbasic.info/forum/index.php?action=dlattach;topic=363.0;attach=866;image)

Title: Re: Mandelbrot
Post by: Peter on October 18, 2015, 03:44:50 AM

Hi,
Potato Mandel  ???

Code: [Select]

include "asm.inc"
window 800,600,1

Loadimage "bmp/potato.bmp"

int cells=1000
single headx, heady

single px[3000] 
single py[3000]

single radX[3000]
single radY[3000]

single angle[3000]
single cRadius[3000]
single frequency[3000]

headx = scrw()/2
heady = scrh()/2

for i=0 to cells
   radx[i] = Rand(-7,7) 
   rady[i] = Rand(-4,4)
   frequency[i] = Rand(-9,9)
   cRadius[i] = Rand(16,30)
next

while key(27)=0
  cls 0,0,0
  for i=0 to cells
     if i=0
        px[i]=headx+sin(angle[i])*radx[i]
        py[i]=heady+cos(angle[i])*rady[i]
     else
        px[i]=px[i-1]+cos(angle[i])*radx[i]
        py[i]=py[i-1]+sin(angle[i])*rady[i]
     endif   
        drawimage 1,px[i],py[i]
angle[i] = angle[i] + rad(frequency[i])
   next
   color 255,255,255
   text 316,32,12,"MANDEL POTATO"
   redraw
   wait 10
wend
winexit
[attachment deleted by admin]

Title: Re: Mandelbrot
Post by: Peter on October 18, 2015, 04:42:57 AM

Hi,
Mandel Complex

Code: [Select]

include "asm.inc"
window 800,600,1

single x,y,zx,zy,cx,cy,tmp, sys MaxIter=512,zoom=150

ts = ticks
For y=0 to <scrH
For x=0 to <scrW
    zx=0
    zy=0
    cx= (x-400)/zoom
    cy= (y-300)/zoom
    Iter = MaxIter
    while zx * zx + zy * zy < 4 && iter > 0
      tmp = zx * zx - zy * zy + cX
      zy  = 2 * zx * zy + cY
      zx  = tmp
      iter--
    wend     
    PutPixel x,y,iter+iter*256+iter*65536/5
Next
Next
color 255,255,255
text 0,0,12,"TIME: " (ticks()-ts)/1000 " SECONDS"
waitkey
winExit
[attachment deleted by admin]

Title: Re: Mandelbrot
Post by: JRS on October 18, 2015, 07:31:57 AM

Quote

FBSL's one is re-sizable

That feature alone make all the others static dummies.  8)

Title: Re: Mandelbrot
Post by: Mike Lobanovsky on October 18, 2015, 08:25:55 AM

Yeah Peter, that's fast. :)

Code: OxygenBasic

1. Type RECT
2.   %Left %top
3.   %Right %bottom
4. End Type
5.  
6. Dim width = 800, height = 600, maxiter = 512, zoom = 150
7. Dim hDC = GetDC(ME), hMemDC = CreateCompatibleDC(NULL)
8. Dim hBmp = CreateCompatibleBitmap(hDC, width, height)
9. Dim hOldBmp = SelectObject(hMemDC, hBmp): SetStretchBltMode(hDC, 4) ' HALFTONE
10. Dim rc As RECT: SetRect(@rc, 10, 35, width + 10, height + 35)
11. Dim t = GetTickCount()
12.  
13. Mandelbrot(hMemDC)
14.  
15. FbslSetText(ME, "-= Peter's Fast Mandelbrot =-  TIME: " &(GetTickCount() - t) / 1000 & " SECONDS")
16. AdjustWindowRectEx(@rc, &HCF0000, FALSE, &H100) ' WS_OVERLAPPEDWINDOW && WS_EX_WINDOWEDGE
17. Resize(ME, 0, 0, rc.Right - rc.Left, rc.bottom - rc.top)
18. Center(ME): Show(ME)
19.  
20. Begin Events
21.   If CBMSG = &H111 AndAlso CBWPARAM = 2 Then ' WM_COMMAND && Esc
22.    PostMessage(ME, &H10, 0, 0) ' WM_CLOSE
23.  ElseIf CBMSG = &HF OrElse CBMSG = &H5 Then ' WM_PAINT || WM_SIZE
24.    GetClientRect(ME, @rc)
25.     ValidateRect(ME, NULL)
26.     StretchBlt(hDC, 0, 0, rc.Right, rc.Bottom, hMemDC, 0, 0, width, height, &HCC0020) ' SRCCOPY
27.    Return 0
28.   ElseIf CBMSG = &H10 Then ' WM_CLOSE
29.    DeleteObject(SelectObject(hMemDC, hOldBmp))
30.     DeleteDC(hMemDC)
31.     ReleaseDC(ME, hDC)
32.   End If
33. End Events
34.  
35. DynC Mandelbrot(%dc, %w = width, %h = height, %i = maxiter, !!z = zoom)
36.   void __attribute__((stdcall)) SetPixelV(int, int, int, int);
37.  
38.   void main(int hdc, int srcW, int srcH, int maxiter, double zoom)
39.   {
40.     int x, y, iter;
41.     double zx, zy, cx, cy, sq, tmp;
42.    
43.     for (y = 0; y < srcH; y++) {
44.       for (x = 0; x < srcW; x++) {
45.         zx = zy = 0.0;
46.         cx = (x - 400) / zoom;
47.         cy = (y - 300) / zoom;
48.         iter = maxiter;
49.         while (zx * zx + zy * zy < 4 && iter-- > 0) {
50.           tmp = zx * zx - zy * zy + cx;
51.           zy = 2 * zx * zy + cy;
52.           zx = tmp;
53.         }
54.         SetPixelV(hdc, x, y, iter + (iter << 8) + (iter << 16) / 5);
55.       }
56.     }
57.   }
58. End DynC

[attachment deleted by admin]

Title: Re: Mandelbrot
Post by: Peter on October 19, 2015, 08:51:42 AM

Hello,

Mandelbrot Robustly.  ;D

Code: [Select]

include "asm.inc"
window 800,480,1

Sub filledcircle(x1, y1, r)
r=r/2
for y=-r to r
for x=-r to r
    if x*x+y*y <= r*r
       setpixel x1+x, y1+y
    end if
next
next
End Sub

float ts = ticks
color 255,255,255
text 10,10,10,"PRESS ANY KEY"

for i=40 to 680 step 80
    color 200,200,255-i*10
    filledcircle i-200,240,i-240
next
color 255,255,255
float tz = ticks
text 0,460,12,"Time: " (tz-ts)/1000 " seconds"
waitkey
winExit

[attachment deleted by admin]

Title: Re: Mandelbrot
Post by: Mike Lobanovsky on October 19, 2015, 10:03:12 AM

(https://scontent-waw1-1.xx.fbcdn.net/hphotos-xaf1/t39.1997-6/p64x64/851575_126362140881916_1086262136_n.png)