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 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

   be mandelIterateLogo z c maxiter
      repeat maxiter   ; compute orbit
      [   z=z*z+c
         if z > 4 [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* -1 ang)+(irot (p1-pcenter)*zoom*zoom ang*2)+sxh+1i*syh
         b2=(irot (pcenter-sxh-1i*syh)*zoom* -1 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-ccenter) angle
      c2=ccenter+irot (c2-ccenter) angle
   end
end