aUCBLogo Demos and Tests / mandel3

to mandel3
   setUpdateGraph false
   cs ht pu WindowMode
   disableLineSmooth
   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
end

to mandel [cmin -2-1.2i][cmax 0.7+1.2i][angle 0]
   if Key? [c=readChar if c==char 27 [stop]]
   t=timefine
   setH 0
   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 1 bx bx
   rsx=IntArray rx
   n=IntArray bx
   cminrot=ccenter+rot cmin-ccenter angle
   for [ry 1 by]
   [   y=cminrot+1i*(ry-1)*fy
      c=(rx-1)*fx+y
      z=Array rSeq 0i+0 0i+0 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)==0 [BitPaste bm  updateGraph]
      if KeyP [ry=by]
   ]
   GC
   (pr timefine-t "seconds)
   stopping=false
   zoomAround
   if stopping [pr [finished] stop]
   (mandel c1 c2 angle)
end

to mandelIterateLogo z c maxiter
   repeat maxiter   ; compute orbit
   [   z=z*z+c
      if z > 4 [output repcount]
   ]
   output maxiter
end

to rot x angle
   output x*exp 1i*angle*pi/180
end

to irot x angle
   output x*exp -1i*angle*pi/180
end

to drawvec c
   local [f]
   f=100
   pu home pd
   setXY f*real c f*imag c
   pu
end

to setTexc c
   setTexXY real c/sx imag c/sy
end

to ctolist c
   output list (real c)-sxh (imag c)-syh
end

to zoomAround
;   if not nameP "texs
;   [   texs=[]
;   ]
   tex=Texture bm
;   push "texs tex

   setPenColor "white
   p1=0+0i         b1=p1
   p2=sx+1i*sy      b2=p2
   ppdx=sx+0i      bbdx=ppdx
   ppdy=0+1i*sy   bbdy=ppdy
   pdx=0.1*sx+0i   bdx=pdx
   pdy=0+0.1i*sy   bdy=pdy

   ang=0
   dang=10
   zoom=1
   dzoom=1.1
   zooming=true
   while [zooming]
   [
      pcenter=(p1+p2)/2
      b1=(irot -(pcenter-sxh-1i*syh)*zoom ang)+(irot (p1-pcenter)*zoom*zoom 2*ang)+sxh+1i*syh
      b2=(irot -(pcenter-sxh-1i*syh)*zoom ang)+(irot (p2-pcenter)*zoom*zoom 2*ang)+sxh+1i*syh
      bbdx=(irot ppdx 2*ang)*zoom*zoom
      bbdy=(irot ppdy 2*ang)*zoom*zoom
      bdx=(irot pdx 2*ang)*zoom*zoom
      bdy=(irot pdy 2*ang)*zoom*zoom
      bcenter=(b1+b2)/2
      cs
      PenUp
      PenDown
;ignore [
      PolyStart
      setTexXY 0 0
      setPos ctolist b1
      setTexXY 0 1
      setPos ctolist b1+bbdy
      setTexXY 1 1
      setPos ctolist b2
      setTexXY 1 0
      setPos ctolist b1+bbdx
      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=pcenter+rot p1-pcenter dang
         p2=pcenter+rot p2-pcenter dang
         ppdx=rot ppdx dang
         ppdy=rot ppdy dang
         pdx=rot pdx dang
         pdy=rot pdy dang
      ]
      if ch=="-
      [   ang=ang-dang
         p1=pcenter+irot p1-pcenter dang
         p2=pcenter+irot p2-pcenter dang
         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=pcenter+(p1-pcenter)/dzoom
            p2=pcenter+(p2-pcenter)/dzoom
            ppdx=ppdx/dzoom
            ppdy=ppdy/dzoom
            pdx=pdx/dzoom
            pdy=pdy/dzoom
            zoom=zoom*dzoom
         ]
         if ch==WXK_NEXT
         [   p1=pcenter+(p1-pcenter)*dzoom
            p2=pcenter+(p2-pcenter)*dzoom
            ppdx=ppdx*dzoom
            ppdy=ppdy*dzoom
            pdx=pdx*dzoom
            pdy=pdy*dzoom
            zoom=zoom/dzoom
         ]
      ]
   ]
   x=((real p1)/sx-0.5)*(real (cmax-cmin))
   y=((imag p1)/sy-0.5)*(imag (cmax-cmin))
   c1=ccenter+rot x+1i*y angle
   x=((real p2)/sx-0.5)*(real (cmax-cmin))
   y=((imag p2)/sy-0.5)*(imag (cmax-cmin))
   c2=ccenter+rot x+1i*y angle
   ccenter=(c1+c2)/2
   angle=angle+ang
   c1=ccenter+irot (c1-ccenter) angle
   c2=ccenter+irot (c2-ccenter) angle
end