XProfan

Italia

Sven
Bader

Die Methode ist nicht aktuell, kommt dafür aber mit dem zugänglichen Befehlssatz aus. Heutzutage verwendet man VBOs (vertex buffer objects). Die Idee ist die gleiche aber in meinem Beispiel mit glDrawArrays wird anstatt den Video-RAM der herkömmliche Arbeitsspeicher verwendet. Dennoch ist es um ein vielfaches schneller als z.B. eine oGL("DrawList", N) mit tausenden oGL("Sphere", ...) darin.

Ich speichere Vertex-Daten (Punkte) von Kugeln in einen Bereich, welcher dann in einem Arbeitsgang jeden Frame dargestellt wird. Ohne Texturkoordinaten oder ohne Normalen geht es noch schneller. Bei einer schnellen Grafikkarte scheint hier das einzige Nadelöhr der RAM zu sein.

Achtung: die initiale Erstellung dauert möglicherweise sehr lang, danach lassen sich aber mehrere tausend Kugeln mit hoher Framerate darstellen.

Oben im Code können testweise Normalen und Textur ausgeschaltet werden:

Kompilieren Markieren Separieren

usetex& = 1
usenormal& = 1

Hier die verwendete Textur (an das XProfan Icon angelehnt):

Hier das ganze Listing. Wenn man die Funktion per die Kugel und die Input-Abfrage ausklammert, ist der Code sehr überschaubar.

Kompilieren Markieren Separieren

 $H windows.ph
 $H opengl.ph
Declare tex&[5]
Declare xrot!, yrot!, zrot!, xpos!, ypos!, zpos!,xsrot!,ysrot!,zsrot!,xspos!,yspos!,zspos!
Declare smooth%,mb&,mousestartx%,mousestarty%,mousex%,mousey%
Declare ende%,hPic&
Declare sphere&,frame&,time&,fps&, usetex&,usenormal&
usetex& = 1
usenormal& = 1
declare vertex#,normal#,texture#,count&
Dim vertex#         ,200000000
Dim normal#         ,200000000
Dim texture#         ,(200000000/3*2)

proc Sphere

    parameters px!,py!,pz!,fRadius!, iStacks%,iSlices%
    declare t1a!, t1b!, n1a!, n1b!, n1c!, v1a!, v1b!, v1c!, t2a!, t2b!, n2a!, n2b!, n2c!, v2a!, v2b!, v2c!
    declare PI!,PIx2!,drho!,dtheta!,ds!,dt!,t!,s!,x!,y!,z!
    declare rho!,srho!,crho!,srhodrho!,crhodrho!
    declare theta!,stheta!,ctheta!,i%,j%,k%
    PI! =  Pi()
    PIx2! = Pi() * 2.0
    drho! = PI! / iStacks%
    dtheta! = PIx2! / iSlices%
    ds! = 1.0 / iSlices%
    dt! = 1.0 / iStacks%
    t! = 1.0
    s! = 0.0
    k% = 0

    whileloop 0, (iStacks%-1)

        i% = &loop
        rho! = i% * drho!
        srho! =  sin(rho!)
        crho! = cos(rho!)
        srhodrho! = sin(rho! + drho!)
        crhodrho! = cos(rho! + drho!)
        s! = 0.0

        whileloop  0, iSlices%

            inc k%
            j% = &loop
            theta! = if(j% = iSlices%, 0.0, j% * dtheta!)
            stheta! = -sin(theta!)
            ctheta! = cos(theta!)
            x! = stheta! * srho!
            y! = ctheta! * srho!
            z! = crho!

            if   (j% > 1)

                Float vertex#,(count&*24)  = v1a!,v1b!,v1c!
                case usetex& : Float texture#,(count&*16) = t1a!,t1b!
                case usenormal& : Float normal#,(count&*24)  = n1a!,n1b!,n1c!
                inc count&
                Float vertex#,(count&*24)  = v2a!,v2b!,v2c!
                case usetex& : Float texture#,(count&*16) = t2a!,t2b!
                case usenormal& : Float normal#,(count&*24)  = n2a!,n2b!,n2c!
                inc count&

            endif

            v1a! = (x! * fRadius!)+px!
            v1b! = (y! * fRadius!)+py!
            v1c! = (z! * fRadius!)+pz!
            t1a! = s!
            t1b! = t!
            n1a! = x!
            n1b! = y!
            n1c! = z!
            Float vertex#,(count&*24)  = (x! * fRadius!)+px!,(y! * fRadius!)+py!, (z! * fRadius!)+pz!
            case usetex& : Float texture#,(count&*16) = s!,t!
            case usenormal& : Float normal#,(count&*24)  = x!,y!,z!
            inc count&
            x! = stheta! * srhodrho!
            y! = ctheta! * srhodrho!
            z! = crhodrho!

            if   (j% > 0)

                Float vertex#,(count&*24)  = v1a!,v1b!,v1c!
                case usetex& : Float texture#,(count&*16) = t1a!,t1b!
                case usenormal& : Float normal#,(count&*24)  = n1a!,n1b!,n1c!
                inc count&
                Float vertex#,(count&*24)  = v2a!,v2b!,v2c!
                case usetex& : Float texture#,(count&*16) = t2a!,t2b!
                case usenormal& : Float normal#,(count&*24)  = n2a!,n2b!,n2c!
                inc count&

            endif

            t2a! = s!
            t2b! = (t! - dt!)
            n2a! = x!
            n2b! = y!
            n2c! = z!
            v2a! = (x! * fRadius!)+px!
            v2b! = (y! * fRadius!)+py!
            v2c! = (z! * fRadius!)+pz!
            case usetex& : Float texture#,(count&*16 ) = t2a!,t2b!
            s! = s! + ds!
            case usenormal& :  Float normal#,(count&*24)  = n2a!,n2b!,n2c!
            Float vertex#,(count&*24)  = v2a!,v2b!,v2c!
            inc count&

        endwhile

        t! = t! - dt!

    endwhile

endproc

Proc MouseKeyboard

    mousex% = %MouseX
    mousey% = %MouseY

    if mb& = 0

        case isKey(~VK_LBUTTON) : mb& = 1
        case isKey(~VK_RBUTTON) : mb& = 2

    endif

    if (not(isKey(~VK_RBUTTON)) & not(isKey(~VK_LBUTTON)))

        'Startposition fürs rotieren und Zoomwen wieder nullen
        mb& = 0
        mousestartx% = %mousex
        mousestarty% = %mousey
        xsrot! = xrot!
        ysrot! = yrot!
        zspos! =  zpos!

    endif

    'Tastaturrotation
    case isKey(~VK_LEFT)  : yrot! = yrot! - 1.0
    case isKey(~VK_RIGHT) : yrot! = yrot! + 1.0
    case isKey(~VK_UP)    : xrot! = xrot! + 1.0
    case isKey(~VK_DOWN)  : xrot! = xrot! - 1.0
    'Mausrotation

    if (mb& = 1)

        yrot! = ysrot! - (mousestartx% - %mousex) * 0.4
        xrot! = xsrot! - (mousestarty% - %mousey) * 0.4

    endif

    'Mauszoom

    if (mb& = 2) & (abs(mousestarty% - %mousey) > 10)

        zpos! = zspos! + (mousestarty% - %mousey) * 0.03
        'Wenn darüber hinaus bewegt wurde, soll es beim Richtungswechsel trotzdem direkt rückwärts gehen
        'Unschöner Hack, Rechnen wäre der feinere Weg ...

        while (zpos! > -2.0)

            dec mousestarty%
            zpos! = zspos! + (mousestarty% - %mousey) * 0.03

        endwhile

        while (zpos! < -15.0)

            inc mousestarty%
            zpos! = zspos! + (mousestarty% - %mousey) * 0.03

        endwhile

    endif

    'Tastaturzoom
    case isKey(~VK_SUBTRACT)     : zpos! = zpos! - 0.06
    case isKey(~VK_ADD)    : zpos! = zpos! + 0.06
    'Zoom begrenzen
    case (zpos! > -2.0)  : zpos! = -2.0
    case (zpos! < -15.0) : zpos! = -15.0
    'Sonstige Tastatureingaben
    case IsKey(27) : Ende% = 1

Endproc

Proc DrawGLScene

    oGL("Clear")
    ogl("Origin",0,0,-0.2)
    oGL("Move", xpos!, ypos!, zpos!)
    oGL("Rotate", xrot!,yrot!,zrot!)
    oGL("glDrawArrays",~GL_TRIANGLES, 0 ,count&-1)'mode, first, count
    oGL("Show")

Endproc

' Hauptprogramm
' -------------
windowstyle 1+2+4+8+16
windowtitle "Sphere"
window (%maxx *  0.5 -480), (%maxy *  0.5 - 300) - 960,600'kompatible Schreibweise
UseIcon "Gesicht"
oGL("Init", %hWnd, 1,1,1,1)
oGL("PosMode",1)
oGL("glEnable", ~GL_CULL_FACE)
'oGL("glShadeModel", ~GL_FLAT)
case usetex& : oGL("glEnableClientState",~GL_TEXTURE_COORD_ARRAY_EXT)
case usenormal& : oGL("glEnableClientState",~GL_NORMAL_ARRAY_EXT)
oGL("glEnableClientState",~GL_VERTEX_ARRAY_EXT)
case usetex& : oGL("glTexCoordPointer",2,~GL_DOUBLE,0,texture#)
case usenormal& : oGL("glNormalPointer",~GL_DOUBLE,0,normal#)
oGL("glVertexPointer",3,~GL_DOUBLE,0,vertex#)
hPic&=create("hPic",-1,"smile.png")
tex&[1]=ogl("getTextureBmp",hPic&,2)
DeleteObject hPic&
oGL("Texture",tex&[1],1)
'oGL("Texture",0,1)

whileloop 0, 500

    'Sphere(X, Y, Z, Dimensione, Scheiben, Segmente)
    Sphere((rnd(1000)-500)*0.01,(rnd(1000)-500)*0.01,(rnd(1000)-500)*0.01,0.05,6,6)

endwhile

zpos! = -5
xrot! = -90
yrot! = 0
time& = &gettickcount

WhileNot ende%

    if (frame& MOD 100 = 0)

        time& = ((&gettickcount - time&) * 0.01) + 1
        fps& =  1000 / time&
        setText %hWnd, str$(fps&) + " fps"
        time& = &gettickcount

    endif

    MouseKeyboard()
    DrawGLScene()
    inc frame&

EndWhile

oGL("Done")
End