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 bx bx
   
rsx=IntArray rx
   
n=IntArray bx
   
cminrot=ccenter+rot cmin-ccenter
ignore [   
setpc drawvec cmin
setpc drawvec cmax
setpc drawvec ccenter
y=1i*(by-1)*fy
setpc drawvec y
c=(bx-1)*fx
setpc drawvec c
stop
]
   
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]
   
]
   
(pr timefine-"seconds)
   
stopping=false
   
c1=mouseSelectC   false  if stopping [pr [finishedstop]
   
c2=mouseSelectC   true   if stopping [pr [finishedstop]
   
ccenter=(c1+c2)/2
   
c1=ccenter+irot (c1-ccenter)
   
c2=ccenter+irot (c2-ccenter)
   
angle=rotateRubber     if stopping [pr [finishedstop]
   
if Key? [c=readChar if == char 27 [pr [finishedstop]]
   
(mandel2 c1 c2 angle)
end

to mandelIterateLogo z c maxiter
   
repeat maxiter   ; compute orbit
   
[   z=z*z+c
      
if [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 cy0
      
(type [\ \ \ \ \ \ \ ])
      
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 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 [fd height right 90 fd width right 90]
   
PenPaint
   
PenUp
end