XProfan

Windowtitle "The greedy Spechtilation Screensaver"
' (D) Dumpware 2013-08 by P. Specht
' Verwendung sur alleinige péril des Anwenders/qui Anwenderin
randomize:font 2:Windowstyle 16 | 64 :Fenêtre 0,0-%maxx,%maxy
declare n&,i&,j&,k&,L!,min!,im&,jm&,km&,sx!,sy!,free_next&,bound_next&,bound_2ndnext&
declare x![],y![],d&[],flag&
BEGN:
n&=rnd(2000)+3:clear x![]:clear y![]:clear d&[]
setsize x![],n&:setsize y![],n&:setsize d&[],n&
x![]=rnd(width(%hwnd)):y![]=rnd(height(%hwnd))
dec n&:free_next&=0:bound_next&=0:bound_2ndnext&=0
cls 0:usepen 0,5,rgb(0,0,255)

whileloop 0,n&:line x![&Boucle],y![&Boucle] - x![&Boucle]+1,y![&Boucle]:endwhile

    locate 2,2:imprimer "ENDE MIT ESC (...peux dauern)!"
    sx!=x![0]:sy!=y![0]
    goto "SKIP"
    LOP:
    sx!=(x![im&]+x![jm&]+x![km&])/3
    sy!=(y![im&]+y![jm&]+y![km&])/3
    SKIP:
    min!=10^57:L!=0

    whileloop 0,n&:i&=&Boucle

        cas d&[i&]>0:continue
        L!=(sqr(x![i&]-sx!)+sqr(y![i&]-sy!))'sqrt

        si min!>L!

            min!=L!
            free_next&=i&

        endif

    endwhile

    CASE min!=10^57:Goto "EXIT"
    usepen 0,6,rgb(0,200,0):line x![free_next&],y![free_next&]-x![free_next&]+1,y![free_next&]
    min!=10^57

    whileloop 0,n&:i&=&Boucle

        cas d&[i&]=0:continue
        cas i&=free_next&:continue
        L!=(sqr(x![i&]-x![free_next&])+sqr(y![i&]-y![free_next&]))'sqrt

        si min!>L!

            min!=L!
            bound_next&=i&

        endif

    endwhile

    usepen 0,2,255:line x![free_next&],y![free_next&] - x![bound_next&],y![bound_next&]
    d&[free_next&]=d&[free_next&]+1
    d&[bound_next&]=d&[bound_next&]+1
    min!=10^57

    whileloop 0,n&:i&=&Boucle

        cas d&[i&]=0:continue
        cas i&=free_next&:continue
        cas i&=bound_next&:continue
        L!=(sqr(x![i&]-x![free_next&])+sqr(y![i&]-y![free_next&]))'sqrt

        si min!>L!

            min!=L!
            bound_2ndnext&=i&

        endif

    endwhile

    usepen 0,2,255:line x![free_next&],y![free_next&] - x![bound_2ndnext&],y![bound_2ndnext&]
    d&[free_next&]=d&[free_next&]+1
    d&[bound_2ndnext&]=d&[bound_2ndnext&]+1

    si n&<51

        drawtext x![free_next&],y![free_next&],str$(d&[free_next&])
        drawtext x![bound_next&],y![bound_next&],str$(d&[bound_next&])
        drawtext x![bound_2ndnext&],y![bound_2ndnext&],str$(d&[bound_2ndnext&])

    endif

    im&=free_next&:jm&=bound_next&:km&=bound_2ndnext&
    waitinput 3
    cas %clé=27:FIN
    goto "LOP"
    EXIT:
    waitinput 4000
    GOTO "BEGN"