XProfan

Italia

p.specht

Graue Haare entstanden bei der Umsetzung aus C++: Im Demoprogramm werden die Endpunkte der Linien im Hauptteil jeweils via Zufallsgenerator definiert. Liegen diese Punkte aber genau circa- oder nebeneinander (oder lediglich 1 pixel Unterschied), wurde in der Innenschleife die Abbruchbedingung ("Geclippte Linie liegt nun komplett im innern des Sichtfenster-Rechtecks") nie mehr erreicht. Das C++ Vorbild lieferte bei der Division von zwei Integervariablen nämlich automatisch einen Integer-Wert zurück. XProfan-11.2a free versucht bei Verwendung der herkömmlichen Division aber, genau zu sein und liefert einen Floatwert - die Ursache per das merkwürdige Fehlerverhalten. Nach Ersatz des / Operators durch die veraltete Funktion @div&(a&,b&) bzw. durch das \ - Integerdivisionszeichen funktioniert nun alles. Interessant wäre eine Beschleunigung mittels Inline-Assemblercode. So bleibt es nur eine Demo.
Gruss

P.S.: Es gibt mittlerweile viel schnellere, hardwareunterstützte Verfahren, die sog. "Saturation-Arithmetik"!

Kompilieren Markieren Separieren

' Cohen-Sutherland Clipping Demo
' Keine Haftung, Verwendung auf eigene Gefahr!
' P. Specht 2011-01 per Paule´s PC Foro
' Anmerkung: Es gibt inzwischen bereits viel schnellere Algorithmen!
Def %CLIPLEFT  1'  Binär   0001
Def %CLIPRIGHT 2'          0010
Def %CLIPLOWER 4'          0100
Def %CLIPUPPER 8'          1000
Def %TRUE 1
Def %FALSE 0

Proc ClipLine

    var K1%=0
    var K2%=0
    declare dx&,dy&
    dx&=x2&-x1&
    dy&=y2&-y1&
    y1test
    y2test
    '  Schleife nach Cohen/Sutherland, die maximal 2 mal durchlaufen wird

    while K1% OR K2%

        rtn% = %TRUE

        if K1% & K2% : rtn% = %FALSE : BREAK : endif

            if K1%

                if K1% & %CLIPLEFT

                    y1& = y1& + (XMin&-x1&)*dy&\dx&
                    x1& = XMin&

                elseif K1% & %CLIPRIGHT

                    y1& = y1& + (XMax&-x1&)*dy&\dx&
                    x1& = XMax&

                endif

                if K1% & %CLIPLOWER

                    x1& = x1& + (YMin&-y1&)*dx&\dy&
                    y1& = YMin&

                elseif K1% & %CLIPUPPER

                    x1& = x1& + (YMax&-y1&)*dx&\dy&
                    y1& = YMax&

                endif

                K1% = 0
                y1test

            endif

            if K1% & K2% : rtn% = %FALSE : BREAK : endif

                if K2%

                    if K2% & %CLIPLEFT

                        y2& = y2& + (XMin&-x2&)*dy&\dx&
                        x2& = XMin&

                    elseif K2% & %CLIPRIGHT

                        y2& = y2& + (XMax&-x2&)*dy&\dx&
                        x2& = XMax&

                    endif

                    if K2% & %CLIPLOWER

                        x2& = x2& + (YMin&-y2&)*dx&\dy&
                        y2& = YMin&

                    elseif K2% & %CLIPUPPER

                        x2& = x2& + (YMax&-y2&)*dx&\dy&
                        y2& = YMax&

                    endif

                    K2% = 0
                    y2test

                endif

            EndWhile

            return rtn%

        EndProc

        proc y1test

            if y1&<YMin&

                K1% = %CLIPLOWER

            elseif y1& > YMax&

                K1% = %CLIPUPPER

            endif

            if x1& < XMin&

                K1% = K1% | %CLIPLEFT

            elseif x1&>XMax&

                K1% = K1% | %CLIPRIGHT

            endif

        endproc

        proc y2test

            if y2&<YMin&

                K2% = %CLIPLOWER

            elseif y2&>YMax&

                K2% = %CLIPUPPER

            endif

            if x2&<XMin&

                K2% = K2% | %CLIPLEFT

            elseif (x2&>XMax&)

                K2% = K2% | %CLIPRIGHT

            endif

        endproc

        'INIT
        Declare XMax&,YMax&,XMin&,YMin&,rtn%
        Declare x1&,y1&,x2&,y2&,colo&
        RANDOMIZE
        WindowTitle "Cohen/Sutherland Clipping Demo"
        WindowStyle  4 | 8 | 16
        'MAIN

        WHILE 1

            XMin& = Rnd(300)
            YMin& = Rnd(200)
            XMax& = XMin& + Rnd(500)
            YMax& = YMin& + Rnd(250)
            CLS
            colo&=rgb(rnd(256),rnd(256),rnd(256))
            UsePen 0,3,colo&
            rectangle XMin&,YMin& - XMax&,YMax&
            'print XMin&,YMin&,XMax&,YMax&

            WhileLoop 1000

                x1& = rnd(Width( %HWnd))
                y1& = rnd(Height(%Hwnd))
                x2& = rnd(Width( %HWnd))
                y2& = rnd(Height(%Hwnd))
                colo&=rgb(rnd(256),rnd(256),rnd(256))
                UsePen 3,1,colo&
                Line x1&,y1& - x2&,y2&

                if ClipLine()

                    UsePen 0,3,colo&
                    Line x1&,y1& - x2&,y2&

                endif

            EndWhile

        ENDWHILE

        END