XProfan

WindowTitle upper$("Moduloide")
'(TW) Trashware by P. Specht, Wien; OHNE JEDWEDE GEWÄHR!
' Quelle: https://www.youtube.com/watch?v=qhbuKbxJsk8
WindowStyle 24:randomize:Window 0,0-%maxx,%maxy
declare i&,j&,k&,n&,co&,r!,s!,faktor!:font 2:CLS
declare x&[],y&[],pi2!,u!,xh&,yh&:set("decimals",2)
pi2!=pi()*2:xh&=width(%hwnd)\2:yh&=height(%hwnd)\2
r!=yh&*0.96

whileloop 80,220:i&=&Loop' 200

    MCLS %maxx,%maxy,$FFFFFF
    usebrush 0,0:usepen 0,3,rgb(255,0,0)

    whileloop 3*i&:faktor!=&Loop/15

        StartPaint -1
        cls
        locate 1,1:print i&;"-Eck mit Faktor ";faktor!;
        s!=pi2!/i&:u!=0

        while u!<pi2!

            x&[n&]=xh&+r!*cos(u!)
            y&[n&]=yh&-r!*sin(u!)
            'usepen 0,3,rgb(255,0,0)
            'ellipse x&[n&]+3,(y&[n&]+3) - x&[n&]-3,y&[n&]-3
            drawtext x&[n&],y&[n&],n&
            u!=u!+s!
            inc n&

        endwhile

        if n&>1

            co&=rgb(rnd(180),rnd(256),10*faktor!)

            whileloop n&-1:j&=&Loop

                k&=(j&*faktor!) mod (n&-1)
                usepen 0,2,co&
                line x&[j&],(y&[j&]) - x&[k&],y&[k&]

            endwhile

        endif

        EndPaint:MCopyBMP 0,0 - %maxx,%maxy > 0,0;0
        'waitinput 150
        n&=0:clear x&[],y&[]

    endwhile

endwhile

beep:print "ok":waitinput :End