XProfan

English

Sven
Bader

The method isn't currently, comes for but with the accessible Functions from. nowadys uses one VBOs (vertex buffer objects). The Idea is the same but in my example with glDrawArrays becomes instead of whom video-RAM the conventional main memory uses. nevertheless is it for a multiple faster as z.B. a oGL("DrawList", n) with tausenden oGL("Sphere", ...) therein.

I save Vertex-data (spots) of Kugeln in a area, which then in a operation each Frame displayed becomes. without Texturkoordinaten or without Normalen goes it even faster. with of/ one speedy Grafikkarte shining here the only eye of a needle the RAM To his.

deference: The initiale Creation lasts möglicherweise very long, thereafter can but several thousand Kugeln with high Framerate present.

supra in the code can testweise Normalen and Textur off go:

Compile Mark Separation

usetex& = 1
usenormal& = 1

here The used Textur (on the XProfan Icon angelehnt):

here the whole Listing. If one The Function for the bullet and the Input-request ausklammert, is the code very überschaubar.

Compile Mark Separation

 $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 end%,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 (hardship(isKey(~VK_RBUTTON)) & hardship(isKey(~VK_LBUTTON)))

        'Startposition for rotate and Zoomwen again nobodies
        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
        'If moreover moving watts, should it at Richtungswechsel nevertheless directly backward weg
        'Unschöner Hack, calculate would the feinere lane ...

        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 limit
    case (zpos! > -2.0)  : zpos! = -2.0
    case (zpos! < -15.0) : zpos! = -15.0
    'other Tastatureingaben
    case IsKey(27) : end% = 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)'fashion, ridge, 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 spelling
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, Size, 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 end%

    if (frame& MOD 100 = 0)

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

    endif

    MouseKeyboard()
    DrawGLScene()
    inc frame&

EndWhile

oGL("Done")
End