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