XProfan

Titre de la fenêtre "A nonrecursive CONVEX HULL drawing algorithm"
' Demoware (C) 2012-07 by P. Specht - No warranties! sans jedwede Gewähr!
Fenêtre 0,0-%maxx,%maxy:font 2:var xx&=%maxx\2:var yy&=%maxy\2' :randomize
declare u!,v!,k!,q&,nenn!,lastk!,bestpoint&,wait%,countr&,qred&
var n&=80:declare x![n&],y![n&],i&,j&,tmp!
Nochmal:

WhileLoop n&:i&=&Boucle:x![i&]=rnd(xx&)+xx&/2:y![i&]=rnd(yy&)+yy&/2:Endwhile

    WhileLoop n&:i&=&Boucle:WhileLoop n&:j&=&Boucle

        si x![i&]<x![j&]:tmp!=x![i&]:x![i&]=x![j&]:x![j&]=tmp!:tmp!=y![i&]:y![i&]=y![j&]:y![j&]=tmp!:endif

            Endwhile :Endwhile :usepen 0,1,rgb(200,0,0):cls:WhileLoop n&:i&=&Boucle
            rectangle x![i&]+3,(y![i&]+3) - (x![i&]-3),y![i&]-3
            'drawtext x![i&],y![i&],str$(int(& Loop))

        Endwhile

        ' ROTE SEITE
        bestpoint&=1

        REPEAT

            q&=bestpoint&:lastk! = val("-1.7976931348623157E+308")

            WhileLoop q&+1,n&,1:i&=&Boucle

                nenn!=x![i&]-x![q&]

                si nenn!<>0

                    k!=(y![i&]-y![q&])/nenn!

                    si k!>lastk!:lastk!=k!:bestpoint&=i&:endif

                    d'autre

                        si y![i&]>=y![q&]:bestpoint&=i&:

                            BREAK

                        endif

                    endif

                Endwhile

                Line x![q&],y![q&] - x![bestpoint&],y![bestpoint&]

            UNTIL q&=bestpoint&

            qred&=bestpoint&
            ' BLAUE SEITE
            Usepen 0,1,rgb(0,0,200):bestpoint&=1

            REPEAT

                q&=bestpoint&:lastk! = val("1.7976931348623157E+308")

                WhileLoop q&+1,n&:i&=&Boucle

                    nenn!=x![i&]-x![q&]

                    si nenn!>0:k!=(y![i&]-y![q&])/nenn!

                        si k!<lastk!:lastk!=k!:bestpoint&=i&:endif

                        d'autre

                            si y![i&]<=y![q&]:bestpoint&=i&

                                BREAK

                            endif

                        endif

                    Endwhile

                    Line x![q&],y![q&] - x![bestpoint&],y![bestpoint&]

                UNTIL q&=bestpoint&

                ' Möglichen faute ausbessern:

                si bestpoint&<>qred&

                    Usepen 0,3,rgb(0,200,0)
                    Line x![qred&],y![qred&] - x![bestpoint&],y![bestpoint&]

                endif

                inc countr&:locate 1,50:imprimer countr&
                ' waitinput
                Goto "Nochmal"
                Fin
                ProgEnd