aUCBLogo Demos and Tests / mandel2

to mandel2 [cmin -2-1.2i][cmax 0.7+1.2i][angle 40]
   if Key? [c=readChar if c==char 27 [stop]]
   t=timefine
   cs ht pu WindowMode
   disableLineSmooth
   setXY -400 -300
   bm=BitCopy 800 600
   bx=BitMaxX bm
   by=BitMaxY bm
   sx=800
   sy=600
   sxh=sx/2
   syh=sy/2
   pd

   maxiter=100
   col=IntArray maxiter
   repeat maxiter
   [   n=repcount
      col.n=HSB n*360/maxiter 1 1
   ]
   col.maxiter=RGB 0 0 0
   ccenter=(cmax+cmin)/2
   fx0=real cmax-cmin
   fy0=imag cmax-cmin
   fx=rot fx0/(bx-1)
   fy=rot fy0/(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
ignore [
setpc 0 drawvec cmin
setpc 1 drawvec cmax
setpc 2 drawvec ccenter
y=1i*(by-1)*fy
setpc 3 drawvec y
c=(bx-1)*fx
setpc 4 drawvec c
stop
]
   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]
   ]
   (pr timefine-t "seconds)
   stopping=false
   c1=mouseSelectC   false  if stopping [pr [finished] stop]
   c2=mouseSelectC   true   if stopping [pr [finished] stop]
   ccenter=(c1+c2)/2
   c1=ccenter+irot (c1-ccenter)
   c2=ccenter+irot (c2-ccenter)
   angle=rotateRubber     if stopping [pr [finished] stop]
   if Key? [c=readChar if c == char 27 [pr [finished] stop]]
   (mandel2 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
   output x*exp 1i*angle*pi/180
end

to irot x
   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 mouseSelectC   rubber
   pr [Use the mouse for selection of a coordinate!]
   cy0=last cursor
   pr [___________________]
   overwriteMode
   updateGraph
   if rubber
   [   rubberpos2=list MouseX MouseY
      drawRubber rubberpos rubberpos2
   ]
   while [mousebuttons==0]
   [   x=MouseX/sx*(real (cmax-cmin))
      y=MouseY/sy*(imag (cmax-cmin))
      c=ccenter+rot x+1i*y
      setCursor list 0 cy0
      (type c [\ \ \ \ \ \ \ ])
      if Key?
      [   ch=readChar
         if ch == char 27
         [   insertMode
            stopping=true
            output 0
         ]
      ]
      ifelse rubber
      [   drawRubber rubberpos rubberpos2
         rubberpos2=list MouseX MouseY
         drawRubber rubberpos rubberpos2
         updateGraph
      ][   rubberpos=list MouseX MouseY
      ]
      wait 2
      dispatchMessages
   ]
   if rubber
   [   drawRubber rubberpos rubberpos2
   ]
   insertMode
   pr []
   cy0=last cursor
   until [MouseButtons==0]
   [   setCursor list 0 cy0
      type repcount
      dispatchMessages
   ]
   pr []
   output c
end

to rotateRubber
   if stopping [stop]
   local [rotating]
   rotating=true
   ang=0
   oang=ang
   dang=10
   drawRubber2 rubberpos rubberpos2 ang
   print [Rotate the rubber with the left and right cursor keys!]
   ConsoleSetFocus
   while [rotating]
   [   if Key?
      [
         ch=readChar
         if ch==char WXK_ESCAPE [rotating=false stopping=true]
         if ch==char WXK_RETURN [rotating=false]
         if ch==char 255
         [   ch=readCharExt
            if ch==WXK_LEFT   [ang=ang+dang]
            if ch==WXK_RIGHT  [ang=ang-dang]
         ]
         drawRubber2 rubberpos rubberpos2 oang
         drawRubber2 rubberpos rubberpos2 ang
         oang=ang
      ]
      wait 2
      dispatchMessages
   ]
   drawRubber2 rubberpos rubberpos2 ang
   output angle+ang
end

to drawRubber p1 p2
   PenReverse
   PenUp
   setPos p1
   PenDown
   setXY p1.1 p2.2
   setXY p2.1 p2.2
   setXY p2.1 p1.2
   setXY p1.1 p1.2
   PenPaint
   PenUp
end

to drawRubber2 p1 p2 angle
   PenReverse
   PenUp
   setPos (p1+p2)/2
   setHeading -angle
   local [height width]
   width=p2.1-p1.1
   height=p2.2-p1.2
   left 90 fd width/2
   left 90 fd height/2
   right 180
   PenDown
   repeat 2 [fd height right 90 fd width right 90]
   PenPaint
   PenUp
end