XProfan

WindowTitle "A nonrecursive CONVEX HULL drawing algorithm"
' Demoware (C) 2012-07 by P. Specht - No warranties! Ohne jedwede Gewähr!
Window 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&=&Loop:x![i&]=rnd(xx&)+xx&/2:y![i&]=rnd(yy&)+yy&/2:EndWhile

    WhileLoop n&:i&=&Loop:WhileLoop n&:j&=&Loop

        if 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&=&Loop
            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&=&Loop

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

                if nenn!<>0

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

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

                    else

                        if 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&=&Loop

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

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

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

                        else

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

                                BREAK

                            endif

                        endif

                    Endwhile

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

                UNTIL q&=bestpoint&

                ' Möglichen Fehler ausbessern:

                if bestpoint&<>qred&

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

                endif

                inc countr&:locate 1,50:print countr&
                ' waitinput
                Goto "Nochmal"
                End
                ProgEnd