aUCBLogo Demos and Tests / mandel4


be mandel4
   
setUpdateGraph false
   
cs ht pu WindowMode
   
disableLineSmooth
   
cmin=0
   
cmax=0
   
ccenter=0
   
c1=0
   
c2=0
   
angle=0
   
sx=800
   
sy=600
   
sxh=sx/2
   
syh=sy/2
   
   
maxiter=500
   
col=IntArray maxiter
   
repeat maxiter
   
[   n=repcount
      
col.n=HSB n*5*360/maxiter 1 1
   
]
   
col.maxiter=RGB 0 0 0
   
mandel

   
be mandel   [mandel4::cmin -0.6-(1*400/300+1i)]~
            [
mandel4::cmax -0.6+(1*400/300+1i)]~
            [
mandel4::angle 0]

      
if Key? [c=readChar if c==char 27 [stop]]
      
t=timefine
      
setH 0
      
cs
      
setXY -400 -300
      
bm=BitCopy 800 600
      
bx=BitMaxX bm
      
by=BitMaxY bm
      
ccenter=(cmax+cmin)/2
      
dx=rot real cmax-cmin angle
      
dy=rot imag cmax-cmin angle
      
fx=dx/(bx-1)
      
fy=dy/(by-1)
      
sfx=fx*(bx-1)/(sx-1) 
      
sfy=fy*(by-1)/(sy-1)
      
rx=Array rSeq bx bx
      
rsx=IntArray rx
      
n=IntArray bx
      
cminrot=ccenter+rot cmin-ccenter angle
      
for [ry by]
      
[   y=cminrot+1i*(ry-1)*fy
         
c=(rx-1)*fx+y
         
z=Array rSeq 0i+0 0i+bx
         
n=mandelIterate z c maxiter
      
;   repeat bx
      ;   [   i=repcount
      ;      n.i=mandelIterateLogo z.i c.i maxiter
      ;   ]
         
BitSetPixel bm rsx ry col.n
         
if (Int mod ry 16)==[BitPaste bm  updateGraph]
         
if KeyP [ry=by]
      
]
      
GC
      
(pr timefine-"seconds)
      
stopping=false
      
zoomAround
      
if stopping [pr [finishedstop]
      
(mandel c1 c2 angle)
   
end
   
   
be mandelIterateLogo z c maxiter
      
repeat maxiter   ; compute orbit
      
[   z=z*z+c
         
if [output repcount]
      
]
      
output maxiter
   
end
   
   
be rot x angle
      
output x*exp angle*1i*pi/180
   
end
   
   
be irot x angle
      
output x*exp angle* -1i*pi/180
   
end
   
   
be drawvec c
      
local [f]
      
f=100
      
pu home pd 
      
setXY f*real c f*imag c   
      
pu
   
end
   
   
be setTexc c
      
setTexXY real c/sx imag c/sy
   
end
   
   
be ctolist c
      
output list (real c)-sxh (imag c)-syh
   
end
   
   
be zoomAround
      
if not nameP "texs
      
[   texs=[]
         
p1=[]   b1=[]
         
p2=[]   b2=[]
         
ppdx=[]   bbdx=[]
         
ppdy=[]   bbdy=[]
         
pdx=[]   bdx=[]
         
pdy=[]   bdy=[]
         
ang=[]
         
zoom=[]
      
]
      
tex=Texture mandel::bm
      
push "texs tex
   
      
setPenColor RGBA 1 1 1 0.5
      
push "p1 0+0i
      
push "p2 sx+1i*sy
      
push "ppdx sx+0i
      
push "ppdy 0+1i*sy
      
push "pdx 0.1*sx+0i
      
push "pdy 0+0.1i*sy
      
push "ang 0
      
push "zoom 1
   
      
setPenColor RGBA 1 1 1 1
      
dang=10
      
dzoom=1.1
      
zooming=true
      
while [zooming]
      
[   
         
pcenter=(p1+p2)/2
         
b1=(irot (pcenter-sxh-1i*syh)*zoom* -ang)+(irot (p1-pcenter)*zoom*zoom ang*2)+sxh+1i*syh
         
b2=(irot (pcenter-sxh-1i*syh)*zoom* -ang)+(irot (p2-pcenter)*zoom*zoom ang*2)+sxh+1i*syh
         
bbdx=(irot ppdx ang*2)*zoom*zoom
         
bbdy=(irot ppdy ang*2)*zoom*zoom
         
bdx=(irot pdx ang*2)*zoom*zoom
         
bdy=(irot pdy ang*2)*zoom*zoom
         
cs
         
N=count texs
         
repeat N
         
[   i=N-repcount+1
            
PenUp
            
PenDown
   
;ignore [
            
Texture texs.i
            
PolyStart
            
setTexXY 0 0
            
setPos ctolist b1.i
            
setTexXY 0 1
            
setPos ctolist b1.i+bbdy.i
            
setTexXY 1 1
            
setPos ctolist b2.i
            
setTexXY 1 0
            
setPos ctolist b1.i+bbdx.i
            
PolyEnd
   
;]
   
ignore[
            
pu
            
setXY -400 -300
            
pd
            
PolyStart
            
setTexc p1+ppdy
            
setXY -400  300
            
setTexc p2
            
setXY  400  300
            
setTexc p1+ppdx
            
setXY  400 -300
            
setTexc p1
            
setXY -400 -300
            
PolyEnd
   
]
         
]
         
updateGraph
   
         
ch=readChar
         
if ch==char WXK_ESCAPE [zooming=false stopping=true]
         
if ch==char WXK_RETURN [zooming=false]
         
if ch=="+   
         
[   ang=ang+dang
            
p1=(rot p1-pcenter dang)+pcenter
            
p2=(rot p2-pcenter dang)+pcenter
            
ppdx=rot ppdx dang
            
ppdy=rot ppdy dang
            
pdx=rot pdx dang
            
pdy=rot pdy dang
         
]
         
if ch=="-   
         
[   ang=ang-dang
            
p1=(irot p1-pcenter dang)+pcenter
            
p2=(irot p2-pcenter dang)+pcenter
            
ppdx=irot ppdx dang
            
ppdy=irot ppdy dang
            
pdx=irot pdx dang
            
pdy=irot pdy dang
         
]
         
if ch==char 255
         
[   ch=readCharExt
            
if ch==WXK_RIGHT  [p1=p1+pdx p2=p2+pdx]
            
if ch==WXK_LEFT   [p1=p1-pdx p2=p2-pdx]
            
if ch==WXK_UP     [p1=p1+pdy p2=p2+pdy]
            
if ch==WXK_DOWN   [p1=p1-pdy p2=p2-pdy]
            
if ch==WXK_PRIOR  
            
[   p1=(p1-pcenter)/dzoom+pcenter
               
p2=(p2-pcenter)/dzoom+pcenter
               
ppdx=ppdx/dzoom
               
ppdy=ppdy/dzoom
               
pdx=pdx/dzoom
               
pdy=pdy/dzoom
               
zoom=zoom*dzoom
            
]
            
if ch==WXK_NEXT  
            
[   p1=(p1-pcenter)*dzoom+pcenter
               
p2=(p2-pcenter)*dzoom+pcenter
               
ppdx=ppdx*dzoom
               
ppdy=ppdy*dzoom
               
pdx=pdx*dzoom
               
pdy=pdy*dzoom
               
zoom=zoom/dzoom
            
]
         
]
      
]
      
x=((real p1.1)/sx-0.5)*(real (cmax-cmin))
      
y=((imag p1.1)/sy-0.5)*(imag (cmax-cmin))
      
c1=ccenter+rot x+1i*y angle
      
x=((real p2.1)/sx-0.5)*(real (cmax-cmin))
      
y=((imag p2.1)/sy-0.5)*(imag (cmax-cmin))
      
c2=ccenter+rot x+1i*y angle
      
ccenter=(c1+c2)/2
      
angle=angle+ang.1
      
c1=ccenter+irot (c1-ccenterangle
      
c2=ccenter+irot (c2-ccenterangle
   
end
end