XProfan

Titre de la fenêtre "Figuren mittels Superformel erzeugen"
Fenêtre Style 24:Cls rgb(0,0,0):ShowMax
var xh&=width(%hwnd)\2:var yh&=height(%hwnd)\2:randomize:font 2

Proc Superformel'liefert Radius(phi!,...)

    parameters phi!,Symmetrie!,forme1!,forme2!,forme3!,xHalbachse!,yHalbachse!
    casenot xHalbachse!*yHalbachse!:return 0
    var Winkel!=Symmetrie!*phi!*0.25
    'r! = (abs(cos(Winkel!)/xHalbachse!)^Form2!+abs(sin(Winkel!)/yHalbachse!)^Form3!)^(-1/forme1!)
    var co!=cos(Winkel!):var si!=sin(Winkel!)
    var r!=0:cas co!<>0:r!=abs(co!/xHalbachse!)^Form2!
    cas si!<>0:r!=r!+abs(sin(Winkel!)/yHalbachse!)^Form3!
    :si r!>0:r! = r!^(-1/forme1!):d'autre r!=0:endif
    return r!

ENDPROC

Proc To_xy :parameters r!,phi!:x!=r!*cos(phi!):y!=r!*sin(phi!):endproc

    Proc rPhi :parameters x!,y!:r!=sqrt(sqr(x!)+sqr(y!)):phi!=ArcTan4(x!,y!):endproc

        Proc ArcTan4 :parameters x!,y!:var pi!=3.1415926535897932:var w!=0

            si x!=0:si y!>0:w!=pi!*0.5:elseif y!<0:w!=pi!*1.5:d'autre :w!=0:endif :return w!:elseif x!>0

                si y!=0:w!=0:return w!:elseif y!>0:si x!>y!:w!=arctan(y!/x!):d'autre :w!=pi!/2-arctan(x!/y!):endif

                    return w!:d'autre :si x!<-y!:w!=pi!*1.5+arctan(x!/-y!):d'autre :w!=2*pi!-arctan(-y!/x!):endif :return w!
                    endif :d'autre :si y!>0:si x!>-y!:w!=pi!/2+arctan(-x!/y!):return w!:d'autre :w!=pi!-arctan(y!/-x!)
                    return w!:endif :elseif y!<0:si x!<y!:w!=pi!+arctan(-y!/-x!):d'autre :w!=pi!*1.5-arctan(-x!/-y!)
                    endif :return w!:d'autre :w!=pi!:return w!:endif :endif :Imprimer " ArcTan4 ERROR":waitinput 1e5

                endproc

                MAIN:
                var s!=100' Size
                var f!=pi()/180
                Déclarer x!,y!,r!,phi!,w!,n&,\
                \
                Symmetrie!,forme1!,forme2!,forme3!,xHalbachse!,yHalbachse! :var Data$=\
                "3 5 18 18 1 1 "+"6 20 7 18 1 1 "+"4 2 4 13 1 1 "+"7 2 4 17 1 1 " +\
                "7 3 6 6 1 1 "+"3 3 14 2 1 1 "+"19 9 14 11 1 1 "+"12 15 20 3 1 1 "+\
                "8 1 1 8 1 1 "+"8 1 5 8 1 1 "+"8 3 4 3 1 1 "+"8 7 8 2 1 1 "+\
                "5 2 6 6 1 1 "+"6 1 1 6 1 1 "+"6 1 7 8 1 1 "+"7 2 8 4 1 1 "+\
                "3 2 8 3 1 1 "+"3 6 6 6 1 1 "+"4 1 7 8 1 1 "+"4 4 7 7 1 1 "+\
                "2 2 2 2 1 1 "+"2 1 1 1 1 1 "+"2 1 4 8 1 1 "+"3 2 5 7 1 1"
                Déclarer LSymmetrie!,LForm1!,LForm2!,LForm3!,LxHalbachse!,LyHalbachse!
                Déclarer p!,q!,  p1!,p2!,p3!,p4!,p5!,p6!
                Nochmal:

                Whileloop 0,23:n&=&Boucle

                    Symmetrie!=val(substr$(Data$,6*n&+1," "))
                    forme1!=val(substr$(Data$,6*n&+2," "))
                    forme2!=val(substr$(Data$,6*n&+3," "))
                    forme3!=val(substr$(Data$,6*n&+4," "))
                    xHalbachse!=val(substr$(Data$,6*n&+5," "))
                    yHalbachse!=val(substr$(Data$,6*n&+6," "))

                    Whileloop 200,0,-2

                        p!=&Boucle/200:q!=1-p!
                        p1!=LSymmetrie!*p!+Symmetrie!*q!
                        p2!=LForm1!*p!+forme1!*q!
                        p3!=LForm2!*p!+forme2!*q!
                        p4!=LForm3!*p!+forme3!*q!
                        p5!=LxHalbachse!*p!+xHalbachse!*q!
                        p6!=LyHalbachse!*p!+yHalbachse!*q!
                        phi!=0
                        r!=Superformel(phi!,p1!,p2!,p3!,p4!,p5!,p6!)
                        To_xy(r!,phi!)
                        'cls 0:locate 1,1:imprimer "  ";n&;" - ";&Loop;"  "
                        MCLS %maxx, %maxy, 0'$FFFFFF
                        Début de peinture -1
                        Usepen 0,12,rgb(0,255,0)
                        moveto xh&+s!*x!,yh&-s!*y!

                        whileloop 0,360,3 :phi!=f!*&Boucle

                            r!=Superformel(phi!,p1!,p2!,p3!,p4!,p5!,p6!)
                            To_xy(r!,phi!):Lineto xh&+s!*x!,yh&-s!*y!

                        endwhile

                        EndPaint
                        MCopyBMP 0, 0 - %maxx,%maxy > 0, 0; 0
                        '  waitinput 42

                    Endwhile

                    LSymmetrie!=Symmetrie!
                    LForm1!=forme1!
                    LForm2!=forme2!
                    LForm3!=forme3!
                    LxHalbachse!=xHalbachse!
                    LyHalbachse!=yHalbachse!
                    waitinput 1000
                    'cls 0

                Endwhile

                beep
                n&=0
                goto "Nochmal"