aUCBLogo Demos and Tests / mandel5
be mandel5
setUpdateGraph false
cs ht pu
WindowMode
useMandelDLL=false
mandelDLL=[]
sx=800
sy=600
sxh=sx/2
syh=sy/2
maxiter=500
col=0
ccenter=0
angle=0
c1=0
c2=0
activePic=0
p1=0
p2=0
ppdx=0
ppdy=0
pdx=0
pdy=0
zoom=0
ang=0
texs=0
stopping=false
init
mandelFrame=(Frame [][Mandel5]
(BitOr
wxFRAME_TOOL_WINDOW
wxDEFAULT_FRAME_STYLE
wxSTAY_ON_TOP)
[100 600][200 200])
mandelLB=(ListBox mandelFrame [Areas][]
[zoomToArea 1+first ListBoxSelections])
FrameSetClientSize mandelFrame 200 200
ConsoleSetFocus
print [Arrow keys move, PageUp/Down zoom, +- rotate, enter computes.]
print [i changes maxIter, v starts/stops Video generating]
picNr=0
video=false
cmin=-0.6-(1*400/300+1i)
cmax=-0.6+(1*400/300+1i)
angle=0
mandel
be init
col=IntArray maxiter
repeat maxiter
[ n=repcount
col.n=HSB
n^(1/3)*40*360/500 1 1
;(ln n)*40*360/500 1 1
]
col.maxiter=RGB 0 0 0
if useMandelDLL
[ mandelDLL=DynamicLibrary [mandel/release/mandel.dll]
]
end
be mandel
if Key? [c=readChar if c==char 27 [stop]]
t=timefine
setH 0
pu
setXY -400 -300
disableTexture
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
ifelse useMandelDLL
[
; repeat bx
; [ i=repcount
; n.i=mandelc z.i c.i maxiter
; n.i=iterate_sinec z.i c.i maxiter
; ]
mandelIterateDLLfa z c maxiter n
][ 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)
picNr=picNr+1
ListBoxAppend mandelLB picNr
zoomAround
if stopping
[ ;FrameDestroy mandelFrame
;deleteTextures
pr [finished]
stop
]
cmin=c1
cmax=c2
mandel
end
be mandelIterateDLLf z c maxiter
output DLCall mandelDLL [mandelf] (list "int
"zr "float real z
"zi "float imag z
"cr "float real c
"ci "float imag c
"maxiter "int maxiter)
end
be mandelIterateDLLc z c maxiter
output DLCall mandelDLL [mandelc] (list "int
"z "complex z
"c "complex c
"maxiter "int maxiter)
end
be mandelIterateDLLfa z c maxiter n
DLCall mandelDLL [mandelfa] (list "void
"zr "FloatArray FloatArray real z
"zi "FloatArray FloatArray imag z
"cr "FloatArray FloatArray real c
"ci "FloatArray FloatArray imag c
"length "int count z
"maxiter "int maxiter
"result "intarray n)
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 texs == 0
[ 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
activePic=picNr
setPenColor RGBA 1 1 1 1
dang=10
dzoom=2^(1/12)
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
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
]
updateGraph
while [not Key?] [dispatchMessages]
ch=readChar
if ch==char WXK_ESCAPE [zooming=false stopping=true]
if ch==char WXK_RETURN [zooming=false]
if (Digit? ch) and2 (ch != "0) [zoomToArea ch]
if ch=="v
[ ifelse not video
[ video=true
VideoStart "mandel5
][ video=false
VideoEnd
]
]
if ch=="i
[ maxiter=getNumberFromUser [Enter new maxIter][maxIter][Mandel5]
maxIter 1 10000000
init
]
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
be zoomToArea a
if a==activePic [stop]
if a>picNr [stop]
an=picNr-activePic+1
a=a-1
bn=picNr-a
zp1=p1.bn
zp2=p2.bn
p10=p1
p20=p2
ppdx0=ppdx
ppdy0=ppdy
pdx0=pdx
pdy0=pdy
zoom0=zoom
ang0=ang
zd0=(p1.an+p2.an)/2-(zp1+zp2)/2
dzoomend=((Norm zp2-zp1)/(Norm p20.an-p10.an))
ifelse dzoomend > 1
[ steps=Int 100+100*log10 dzoomend
b11=Array steps
b12=Array steps
b22=Array steps
b21=Array steps
zp1=p10.bn
zp2=p20.bn
dzoom=((Norm zp2-zp1)/(Norm p20.an-p10.an))
dang=ang0.an-ang0.bn
pcenter=(p10+p20)/2
p1=(p10-pcenter)/dzoom+pcenter
p2=(p20-pcenter)/dzoom+pcenter
ppdx=ppdx0/dzoom
ppdy=ppdy0/dzoom
pdx=pdx0/dzoom
pdy=pdy0/dzoom
zoom=zoom0*dzoom
zd=zd0
zd=rot zd dang
p1=p1+pdx*(real zd)/(0.1*sx)+pdy*(imag zd)/(0.1*sy)
p2=p2+pdx*(real zd)/(0.1*sx)+pdy*(imag zd)/(0.1*sy)
pcenter=(p1+p2)/2
ang=ang0+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
zp1=p1.an
zp2=p2.an
p10=p1
p20=p2
ppdx0=ppdx
ppdy0=ppdy
pdx0=pdx
pdy0=pdy
zoom0=zoom
ang0=ang
zd0=(p1.bn+p2.bn)/2-(zp1+zp2)/2
for [s 1 steps]
[
zp1=p10.an
zp2=p20.an
dzoom=((Norm zp2-zp1)/(Norm p20.bn-p10.bn))^(s/steps)
dang=(ang0.bn-ang0.an)*(s/steps)
pcenter=(p10+p20)/2
p1=(p10-pcenter)/dzoom+pcenter
p2=(p20-pcenter)/dzoom+pcenter
ppdx=ppdx0/dzoom
ppdy=ppdy0/dzoom
pdx=pdx0/dzoom
pdy=pdy0/dzoom
zoom=zoom0*dzoom
zd=zd0*(s/steps)
zd=rot zd dang
p1=p1+pdx*(real zd)/(0.1*sx)+pdy*(imag zd)/(0.1*sy)
p2=p2+pdx*(real zd)/(0.1*sx)+pdy*(imag zd)/(0.1*sy)
pcenter=(p1+p2)/2
ang=ang0+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
pcenter=(p1+p2)/2
b11.s=(irot (pcenter-sxh-1i*syh)*zoom* -1 ang)+(irot (p1-pcenter)*zoom*zoom ang*2)+sxh+1i*syh
b22.s=(irot (pcenter-sxh-1i*syh)*zoom* -1 ang)+(irot (p2-pcenter)*zoom*zoom ang*2)+sxh+1i*syh
b12.s=b11.s+(irot ppdy ang*2)*zoom*zoom
b21.s=b11.s+(irot ppdx ang*2)*zoom*zoom
]
p1=p10
p2=p20
ppdx=ppdx0
ppdy=ppdy0
pdx=pdx0
pdy=pdy0
zoom=zoom0
ang=ang0
for [s steps 1]
[ cs
N=count texs
repeat N
[ i=N-repcount+1
PenUp
PenDown
Texture texs.i
PolyStart
setTexXY 0 0
setPos ctolist b11.s.i
setTexXY 0 1
setPos ctolist b12.s.i
setTexXY 1 1
setPos ctolist b22.s.i
setTexXY 1 0
setPos ctolist b21.s.i
PolyEnd
]
updateGraph
if video [VideoFrame]
if Key? [s=1]
]
][ steps=Int 100+100*log10 1/dzoomend
for [s 1 steps]
[
zp1=p10.(picNr-a)
zp2=p20.(picNr-a)
dzoom=((Norm zp2-zp1)/(Norm p20.an-p10.an))^(s/steps)
dang=(ang0.an-ang0.(picNr-a))*(s/steps)
pcenter=(p10+p20)/2
p1=(p10-pcenter)/dzoom+pcenter
p2=(p20-pcenter)/dzoom+pcenter
ppdx=ppdx0/dzoom
ppdy=ppdy0/dzoom
pdx=pdx0/dzoom
pdy=pdy0/dzoom
zoom=zoom0*dzoom
zd=zd0*(s/steps)
zd=rot zd dang
p1=p1+pdx*(real zd)/(0.1*sx)+pdy*(imag zd)/(0.1*sy)
p2=p2+pdx*(real zd)/(0.1*sx)+pdy*(imag zd)/(0.1*sy)
pcenter=(p1+p2)/2
ang=ang0+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
pcenter=(p1+p2)/2
b11=(irot (pcenter-sxh-1i*syh)*zoom* -1 ang)+(irot (p1-pcenter)*zoom*zoom ang*2)+sxh+1i*syh
b22=(irot (pcenter-sxh-1i*syh)*zoom* -1 ang)+(irot (p2-pcenter)*zoom*zoom ang*2)+sxh+1i*syh
b12=b11+(irot ppdy ang*2)*zoom*zoom
b21=b11+(irot ppdx ang*2)*zoom*zoom
cs
N=count texs
repeat N
[ i=N-repcount+1
PenUp
PenDown
Texture texs.i
PolyStart
setTexXY 0 0
setPos ctolist b11.i
setTexXY 0 1
setPos ctolist b12.i
setTexXY 1 1
setPos ctolist b22.i
setTexXY 1 0
setPos ctolist b21.i
PolyEnd
]
updateGraph
if video [VideoFrame]
if Key? and2 s<steps [s=steps-1]
]
]
dzoom=1.1
dang=10
activePic=a+1
ConsoleSetFocus
end
end