Qbasicnews.com
January 22, 2022, 07:47:41 AM *
Welcome, Guest. Please login or register.

Login with username, password and session length
News: Back to Qbasicnews.com | QB Online Help | FAQ | Chat | All Basic Code | QB Knowledge Base
 
   Home   Help Search Login Register  
Pages: [1]
  Print  
Author Topic: mandelbrot  (Read 7868 times)
neuro
Forum Regular
**
Posts: 114



WWW
« on: April 06, 2006, 06:15:16 PM »

challenge: make the awesomest mandelbrot renderer you can.

rules: must allow the user to manually input coordinates (via keyboard or just by pointing/dragging).
Can be done using any language.
You may post entries or email them to me...

In case you don't have any idea what the mandelbrot is or how it is rendered, the wikipedia article should satisfy all your curiousities:

http://en.wikipedia.org/wiki/Mandelbrot_set

Peace
 - neuro
Logged

ignatures suck
relsoft
*/-\*
*****
Posts: 3927



WWW
« Reply #1 on: April 06, 2006, 09:32:53 PM »

The coolest looking mandel render I have seen is this:

http://www.creativemagazine.com/science/Rings01/index.html

I like it so much I implemented the algo in a Julia set. :*)

FB:
http://rel.betterwebber.com/junk.php?id=33

C/C++:

http://rel.betterwebber.com/junk.php?id=34
Logged

y smiley is 24 bit.


Genso's Junkyard:
http://rel.betterwebber.com/
neuro
Forum Regular
**
Posts: 114



WWW
« Reply #2 on: April 07, 2006, 04:20:49 AM »

Hey, that's a pretty nifty program.  I came up with a java renderer, available as an applet or just run it via java:
http://www.wrongway.org/java/mandel.php

(Source code available here:)
http://www.wrongway.org/work/mandel.zip

Peace
 - Eric
Logged

ignatures suck
Antoni Gual
Na_th_an
*****
Posts: 1434



WWW
« Reply #3 on: April 08, 2006, 05:44:57 AM »

Mine is FB
It uses derivatives for the coloring of the boundary points, that makes it  slow, but results are interesting.
Use mouse to select a new region.
EDITED: Added variable amount of iterations depending on zoom
Code:

'Mini mandelbrot viewer by Antoni Gual 4/2006
'bounding box routine bt DJ.Peters
'HsvToRgb and coloring scheme by Jark
'--------------------------------------------------------------------------
option explicit
#define maxx 800
#define maxy 600
#define hmaxx (maxx/2)
#define hmaxy (maxy/2)
#define frel (maxx/maxy)  

enum  rendermeths
  rndr_dazibao=0
  rndr_bw
  rndr_md
  rndr_solar
end enum

type mdbrestype
   nit as double
   maxmod as double
   strip as double
   dea    as double
   par as integer
end type

dim shared as double zoomfact

type myrect
  as integer x0,y0,x1,y1
end type
'
'-------------------------------------------------------------------------------
sub DrawXorBox(byval x0 as integer,byval y0 as integer ,_
            byval x1 as integer,byval y1 as integer)
  dim as integer x,y,c
  if x0>x1 then swap x0,x1
  if y0>y1 then swap y0,y1
  for x=x0 to x1:c=point(x,y0):c=c xor &hffffff:pset(x,y0),c:next
  if y0<>y1 then for x=x0 to x1:c=point(x,y1):c=c xor &hffffff :pset(x,y1),c:next
  for y=y0 to y1:c=point(x0,y):c=c xor &hffffff:pset(x0,y),c:next
  if x0<>x1 then for y=y0 to y1:c=point(x1,y):c=c xor &hffffff:pset(x1,y),c:next
end sub
'
'-------------------------------------------------------------------------------
function boundbox (byval x as integer,byval y as integer) as myrect
  dim as integer newx,newy,oldx,oldy,button,sx,sy
  dim as myrect  r
  screeninfo sx,sy
  oldx=x+1:oldy=y+1:button=1
  DrawXorBox x,y,oldx,oldy
  while button=1
    sleep 0
    getmouse newx,newy,,button
    if newx<0 or newy<0 or newx>(sx-1) then
      button=1:newx=oldx:newy=oldy
      setmouse newx,newy
    end if
    if newx<>oldx or newy<>oldy then
      r.x0=x:r.y0=y:r.x1=newx:r.y1=newy
      ScreenLock
      DrawXorBox x,y,oldx,oldy
      DrawXorBox x,y,newx,newy
      ScreenUnlock
      oldx=newx:oldy=newy
    end if
  wend
  DrawXorBox x,y,oldx,oldy
  if r.x1<r.x0 then swap r.x1, r.x0
  if r.y1<r.y0 then swap r.y1, r.y0
  return r
end function
'
'-----------------------------------------------------------------------------------------
Function HSVtoRGB (byval Hue as single ,byval Sat as single,byval Value as single) as integer
' Converts a HSV colour definition into RGB values via exact trigonometry calculations.
' by Jark
CONST SQR12 = SQR(1/2)
CONST SQR16 = SQR(1/6)
CONST SQR23 = SQR(2/3)
CONST SatCoeff = 100/ATN(SQR(6))
CONST SatCoef = 1/SatCoeff
const pi=3.1415926#
CONST PiOver180 = pi/180
CONST PiOver2 = pi/2


dim red ,green ,blue
dim as single ur,vr,wr ,radius,angle,rdim

Angle = (Hue! - 150) * PiOver180
Ur = Value! * 2.55  
Radius = Ur * TAN(Sat! * SatCoef)
Vr = Radius * COS(Angle) * SQR12
Wr = Radius * SIN(Angle) * SQR16

Red  = Ur - Vr - Wr
Green  = Ur + Vr - Wr
Blue  = Ur + Wr + Wr

IF Red  < 0 THEN
Rdim = Ur / (Vr + Wr)
  Red  = 0
Green  = Ur + (Vr - Wr) * Rdim
Blue  = Ur + 2 * Wr * Rdim
GOTO Ctrl2  
END IF

IF Green  < 0 THEN
Rdim = -Ur / (Vr - Wr)
Red  = Ur - (Vr + Wr) * Rdim
Green  = 0
Blue  = Ur + 2 * Wr * Rdim
GOTO Ctrl2  
END IF

IF Blue  < 0 THEN
Rdim = -Ur / (Wr + Wr)
Red  = Ur - (Vr + Wr) * Rdim
Green  = Ur + (Vr - Wr) * Rdim
Blue  = 0
GOTO Ctrl2  
END IF

Ctrl2:
IF Red  > 255   THEN
Rdim = (Ur - 255) / (Vr + Wr)
Red  = 255  
Green  = Ur + (Vr - Wr) * Rdim
Blue  = Ur + 2 * Wr * Rdim
END IF

IF Green  > 255   THEN
Rdim = (255 - Ur) / (Vr - Wr)
Red  = Ur - (Vr + Wr) * Rdim
Green  = 255  
Blue  = Ur + 2 * Wr * Rdim
END IF

IF Blue  > 255   THEN
Rdim = (255  - Ur) / (Wr + Wr)
Red  = Ur - (Vr + Wr) * Rdim
Green  = Ur + (Vr - Wr) * Rdim
Blue  = 255  
END IF
function= RGB(Red%,Green%,Blue%)
end function
'
'
'-------------------------------------------------------------------------------------
function calcmdb(byval xi as double,byval yi as double,byval maxit as integer,dea) as mdbrestype
  dim  as double maxmdb=0
  dim n=0
  dim r as mdbrestype
 
  dim as double xn=0,yn=0,mdbmod2,t,dx,dy,x,y,x2,y2,dxn,dyn
  do
   x  = xn                                        
   y  = yn
   xn  = x2  - y2  + xi
   yn  = 2  * x  * y  + yi
   x2  = xn  * xn
   y2  = yn  * yn
   mdbmod2  = (x2  + y2 )
   if dea then
     dxn = 1 + 2 * (x * dx - y * dy)
     dyn = 2 * (x * dy + y * dx)
     dx = dxn: dy = dyn
   end if
   if mdbmod2 >maxmdb  then maxmdb =mdbmod2
   IF mdbmod2  >= 4  THEN EXIT DO
   n+=1
  loop until (n=maxit)

  r.par=n and 1
  r.nit=n/maxit
  r.maxmod=maxmdb
  if n>=maxit then
x  = xn*xn  - yn*yn  + xi
y  = 2  * xn  * yn  + yi
    r.strip =sqr((xn - x)*(xn-x) +(yn - y)*(yn-y))
  end if
  'this calc takes a 10% of the total rendering
  if dea then r.dea=LOG(MdbMod2)*SQR(MdbMod2 / (dx^2 + dy^2)) *zoomfact
  function=r
end function
'
'
'------------------------------------------------------------------------
function shademdb(byval mthd as rendermeths,byval r as mdbrestype)
  dim as single h,s,v
  const limdea = 0.0057994   ' exp(-5.15)
  select case as const mthd
   case rndr_solar
    if r.nit=1 then
      h=60+log(r.strip)*120
      s=65
      v=60
    elseif r.dea<=limdea then
     h=120
     s=50
     v=16 -4.2* log(r.dea)
    else
     h=r.nit*50+r.par*180
     s=80
     v=45
   end if
    function=hsvtorgb(h,s,v)
  end select  
 
end function
'
'
'--------------------------------------------------------------------------
function rendermdb(byval offx as double,_
                   byval offy as double ,_
                   byval xwidth as double,_
                   byval maxit,_
                   byval mthd as rendermeths)
dim i,j,dea=1
dim as double x,y,inc,x0,y0,c
dim as integer ptr videopage
if xwidth=0 then xwidth=4
if maxit=0 then maxit=100
'get complex coord of tl corner, and pixel increment
x0=offx-(xwidth/2)
y0=offy+(xwidth/frel/2)

inc=xwidth/maxx
y=y0
screenlock
VideoPage=ScreenPtr
for j=1 to maxy
x=x0
screenlock
for i=1 to maxx
 videopage[c]=shademdb(mthd,calcmdb(x,y,maxit,dea))
 x+=inc:c+=1
next i
  if (j and 15)=0 then
   screenunlock j-16,j
   sleep 0:
   screenlock
   if len(inkey$) then exit for
  end if
y-=inc
next j
screenunlock
end function
'
'
'----------------------------------------------------------
sub launchmandel(xc as double,yc as double,xw as double,its,mthd)
dim t!
t!=timer
zoomfact=4/xw
windowtitle "x:"&xc &" y:"& yc &" Zoom:"&zoomfact
rendermdb(xc,yc,xw,its,mthd)  
windowtitle(str$(timer-t!))  
end sub

'
'
'----------------------------------------------------------------------------
dim t!
dim x,y,b,its,oldits,rndr
dim as double xc,yc,xw,oldxc,oldyc,oldxw,d1,d2
dim r as myrect
screenres maxx,maxy,32

xc=-0.5
yc=0
xw=4
its=200
rndr=rndr_solar
launchmandel(xc,yc,xw,its,rndr)
'end  
do
 sleep 50
 getmouse x,y,,b  
 if b=1 then
  oldxc=xc
  oldyc=yc
  oldxw=xw
  oldits=its
  r= boundbox(x,y)
  xc=oldxc +oldxw/cdbl(maxx)*((r.x1+r.x0-maxx)/2.0)
  yc=oldyc -oldxw/cdbl(maxx)*((r.y1+r.y0-maxy)/2.0)
  d1=abs(r.x1-r.x0)/maxx
  d2=abs(r.y1-r.y0)/maxy
  xw=oldxw*iif(d1>d2,d1,d2)
  zoomfact=4/xw
  its=100*log(zoomfact)
  launchmandel(xc,yc,xw,its,rndr)
 elseif b=2 then
  xc=oldxc
  yc=oldyc
  xw=oldxw
  its=oldits
  launchmandel(xc,yc,xw,its,rndr)  
 end if
loop until len(inkey$)
sleep
'----------------------------------------------------------------------------
Logged

Antoni
neuro
Forum Regular
**
Posts: 114



WWW
« Reply #4 on: April 11, 2006, 07:18:54 AM »

That's pretty cool too, antoni:D

keep 'em comin...

On a side note, I lived in Malaga for several years as a child...
Logged

ignatures suck
Antoni Gual
Na_th_an
*****
Posts: 1434



WWW
« Reply #5 on: April 11, 2006, 07:44:47 AM »

Did you enjoyed your stay in Malaga? It is one of the few cities in spain i have never visited..I live a thousand kilometers from there.

I have added a save to bmp and a coordinate input from the command line.
I would like to know enough assembler to optimize the inner loop, it becomes a little slow for deep zooms, as the nr of iterations increases.
I would like to make the coloring independent from the max iterations, it's a liitle ugly to have a zone in red in a view and have it green at the next view...

I will release it as a finished product when I'm happy with it.
Logged

Antoni
KiZ
__/--\__
*****
Posts: 2879


WWW
« Reply #6 on: April 11, 2006, 05:07:07 PM »

Quote from: "Antoni Gual"
Did you enjoyed your stay in Malaga? It is one of the few cities in spain i have never visited..I live a thousand kilometers from there.


Might I assume because it is an ugly tourist trap now? Filled with litter, bars and tourists? Or has it escaped that curse?
Logged
Antoni Gual
Na_th_an
*****
Posts: 1434



WWW
« Reply #7 on: April 11, 2006, 05:14:51 PM »

I did'nt said that. I just never have had an occasion of being there.  My knowledge of the south of spain is limited to Sevilla, Granada and Cordoba.

Summer is warm enough in Barcelona, I  prefer cooler places for my summer holidays. Cheesy
Logged

Antoni
KiZ
__/--\__
*****
Posts: 2879


WWW
« Reply #8 on: April 11, 2006, 05:21:19 PM »

I know you didnt say that, I was just inquiring.

I was in Greece recently and was appauled at how the tourist industry had ruined what used to be a lovely Greek town, filled it with bars, nightclubs and cheap resturants selling British food (barely any Greek food to be found!). The place was dirty and crawling with (ugly) tourists, who were not caring for the place at all. It made me think the locals must be fed up with it all.

So It was just an inquiry :)
Logged
Antoni Gual
Na_th_an
*****
Posts: 1434



WWW
« Reply #9 on: April 12, 2006, 07:57:35 AM »

That's happening everywhere,t he flights have become affordable for everyone. Try Zanzibar...Cheesy
Logged

Antoni
na_th_an
*/-\*
*****
Posts: 8244



WWW
« Reply #10 on: April 12, 2006, 08:37:56 AM »

Malaga is still beautiful. Some weeks ago I went there for some free-software conferences (with people from work) and spent the afternoon sitting next to the beach drinking coffee outside a nice small hotel in an almost deserted place. It was beautiful and calm. Great Smiley

I love Andalucía, my land Wink so nice.
Logged

SCUMM (the band) on Myspace!
ComputerEmuzone Games Studio
underBASIC, homegrown musicians
[img]http://www.ojodepez-fanzine.net/almacen/yoghourtslover.png[/i
Pages: [1]
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!