Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

ArcBall Demo

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • ArcBall Demo

    hi, there!

    the following is the source-code for a demo of the "semi-infamous"
    arcball-- a rather cool way to display, and view 3d objects.
    the idea was originally presented by ken shoemake in the early 1980s,
    and numerous versions/"flavors" of it have been written in the years since.

    this version utilizes opengl, and has some elements shared with
    the arcball demo at nehe.game.net, and incorporates some ideas of my own
    and others as well. given the relative complexity of the subject, i chose
    clarity and readability over all-out performance for the purposes of this demo.

    i'll post a functional over-view here later on, but for now, cut & paste
    and enjoy!

    please either respond to me directly, or at the following: http://www.powerbasic.com/support/pb...ad.php?t=11760


    ------------------
    scott martindale
    [email protected]

    [this message has been edited by scott j. martindale (edited april 11, 2005).]
    Scott Martindale
    [email protected]

  • #2
    A scaled-down version of the GL.inc file:

    Copy & Paste the following, and save the file as:

    "GL_ArcBall.inc"

    Code:
    '-----------------------------------------------------------------------------------------
    ' A "Condensed" version of the GL.inc file. Containing only the items needed for ArcBall.
    '-----------------------------------------------------------------------------------------
       %GL_ARCBALL = -1
        MACRO GLenum     = DWORD   '32-Bit unsigned
        MACRO GLboolean  = BYTE    '8-Bit  unsigned
        MACRO GLbitfield = DWORD   '32-Bit unsigned
        MACRO GLbyte     = BYTE    '8-Bit  signed
        MACRO GLshort    = INTEGER '16-Bit signed
        MACRO GLint      = LONG    '32-Bit signed
        MACRO GLubyte    = BYTE    '8-Bit  unsigned
        MACRO GLushort   = WORD    '16-Bit unsigned
        MACRO GLuint     = DWORD   '32-Bit unsigned
        MACRO GLsizei    = LONG    '32-Bit signed
        MACRO GLfloat    = SINGLE  'single precision float
        MACRO GLclampf   = SINGLE  'single precision float in [0,1]
        MACRO GLdouble   = DOUBLE  'double precision float
        MACRO GLclampd   = DOUBLE  'double precision float in [0,1]
        MACRO GLvoid     = ANY     'No real need, but why not...
    
        MACRO GL_PERSPECTIVE_CORRECTION_HINT      = &h0C50&
        MACRO GL_NICEST                           = &h1102&
        MACRO GL_LEQUAL                           = &h0203&
        MACRO GL_DEPTH_TEST                       = &h0B71&
        MACRO GL_FLAT                             = &h1D00&
        MACRO GL_SMOOTH                           = &h1D01&
        MACRO GL_COMPILE                          = &h1300&
        MACRO GL_TRIANGLE_FAN                     = &h0006&
        MACRO GL_QUAD_STRIP                       = &h0008&
        MACRO GL_TRUE                             = -1
        MACRO GL_FALSE                            =  0
        MACRO GL_COLOR_BUFFER_BIT                 = &h4000&
        MACRO GL_DEPTH_BUFFER_BIT                 = &h0100&
        MACRO GL_LIGHTING                         = &h0B50&
        MACRO GL_LIGHT0                           = &h4000&
        MACRO GL_COLOR_MATERIAL                   = &h0B57&
        MACRO GL_MODELVIEW                        = &h1700&
        MACRO GL_PROJECTION                       = &h1701&
        DECLARE SUB glCallList      LIB "opengl32.dll" ALIAS "glCallList"   (BYVAL list AS GLuint)
        DECLARE SUB glColor3f       LIB "opengl32.dll" ALIAS "glColor3f"    (BYVAL red AS GLfloat,_
                                                                             BYVAL green AS GLfloat,_
                                                                             BYVAL blue AS GLfloat)
        DECLARE SUB glDeleteLists   LIB "opengl32.dll" ALIAS "glDeleteLists"(BYVAL list AS GLuint,_
                                                                             BYVAL range AS GLsizei)
        DECLARE SUB glFlush         LIB "opengl32.dll" ALIAS "glFlush"
        DECLARE SUB glMultMatrixf   LIB "opengl32.dll" ALIAS "glMultMatrixf"(BYREF m AS ANY)
        DECLARE SUB glLoadIdentity  LIB "opengl32.dll" ALIAS "glLoadIdentity"
        DECLARE SUB glTranslatef    LIB "opengl32.dll" ALIAS "glTranslatef" (BYVAL x AS GLfloat,_
                                                                             BYVAL y AS GLfloat,_
                                                                             BYVAL z AS GLfloat)
        DECLARE SUB glPopMatrix     LIB "opengl32.dll" ALIAS "glPopMatrix"
        DECLARE SUB glPushMatrix    LIB "opengl32.dll" ALIAS "glPushMatrix"
        DECLARE SUB glBegin         LIB "opengl32.dll" ALIAS "glBegin"      (BYVAL mode AS GLenum)
        DECLARE SUB glClear         LIB "opengl32.dll" ALIAS "glClear"      (BYVAL mask AS GLbitfield)
        DECLARE SUB glDepthFunc     LIB "opengl32.dll" ALIAS "glDepthFunc"  (BYVAL func AS GLenum)
        DECLARE SUB glEnable        LIB "opengl32.dll" ALIAS "glEnable"     (BYVAL cap AS GLenum)
        DECLARE SUB glEnd           LIB "opengl32.dll" ALIAS "glEnd"
        DECLARE SUB glEndList       LIB "opengl32.dll" ALIAS "glEndList"
        DECLARE SUB glFrustum       LIB "opengl32.dll" ALIAS "glFrustum"    (BYVAL nleft AS GLdouble,_
                                                                             BYVAL nright AS GLdouble,_
                                                                             BYVAL bottom AS GLdouble,_
                                                                             BYVAL top AS GLdouble,_
                                                                             BYVAL zNear AS GLdouble,_
                                                                             BYVAL zFar AS GLdouble)
        DECLARE FUNCTION glGenLists LIB "opengl32.dll" ALIAS "glGenLists"   (BYVAL range AS GLsizei)_
                                                                             AS GLuint
        DECLARE SUB glHint          LIB "opengl32.dll" ALIAS "glHint"       (BYVAL ntarget AS GLenum,_
                                                                             BYVAL mode AS GLenum)
        DECLARE SUB glMatrixMode    LIB "opengl32.dll" ALIAS "glMatrixMode" (BYVAL mode AS GLenum)
        DECLARE SUB glNewList       LIB "opengl32.dll" ALIAS "glNewList"    (BYVAL list AS GLuint,_
                                                                             BYVAL mode AS GLenum)
        DECLARE SUB glNormal3f      LIB "opengl32.dll" ALIAS "glNormal3f"   (BYVAL nx AS GLfloat,_
                                                                             BYVAL ny AS GLfloat,_
                                                                             BYVAL nz AS GLfloat)
        DECLARE SUB glShadeModel    LIB "opengl32.dll" ALIAS "glShadeModel" (BYVAL mode AS GLenum)
        DECLARE SUB glVertex3f      LIB "opengl32.dll" ALIAS "glVertex3f"   (BYVAL x AS GLfloat,_
                                                                             BYVAL y AS GLfloat,_
                                                                             BYVAL z AS GLfloat)
        DECLARE SUB glClearColor    LIB "opengl32.dll" ALIAS "glClearColor" (BYVAL GLclampf,_
                                                                             BYVAL GLclampf,_
                                                                             BYVAL GLclampf,_
                                                                             BYVAL GLclampf)
        DECLARE SUB glClearDepth    LIB "opengl32.dll" ALIAS "glClearDepth" (BYVAL GLclampd)
        DECLARE SUB glViewport      LIB "opengl32.dll" ALIAS "glViewport"   (BYVAL GLint,_
                                                                             BYVAL GLint,_
                                                                             BYVAL GLsizei,_
                                                                             BYVAL GLsizei)
    '-----------------------------------------------------------------------------------------
    ------------------
    Scott Martindale
    [email protected]
    Scott Martindale
    [email protected]

    Comment


    • #3
      UDTs, Macros, and Functions for ArcBall Demo.

      Copy & Paste, and save file as "ArcBall.inc"
      Code:
      '-----------------------------------------------------------------------------------------
      'ArcBall Meta-Statements:
      '-----------------------------------------------------------------------------------------
          #IF NOT %DEF(%GL_ARCBALL)
              #INCLUDE "GL_ArcBall.inc"
          #ENDIF
          #IF NOT %DEF(%SphereTorusDL)
              #INCLUDE "SphereTorusList.inc"
              %SphereTorusDL = -1
          #ENDIF
      
      '-----------------------------------------------------------------------------------------
      'User-Defined Types used for ArcBall:
      '-----------------------------------------------------------------------------------------
         '--------------------------------------------------------------------------------------
         '3D-Vector:
         '--------------------------------------------------------------------------------------
              TYPE Vector3f
                  x AS GLfloat
                  y AS GLfloat
                  z AS GLfloat
              END TYPE
              MACRO pos3D    = Vector3f
              MACRO vertex3D = Vector3f
         '--------------------------------------------------------------------------------------
         'Quaternion/Homogeneous Vector:
         '--------------------------------------------------------------------------------------
              TYPE tQUAT
                  x    AS GLfloat
                  y    AS GLfloat
                  z    AS GLfloat
                  w    AS GLfloat
              END TYPE
              UNION QUAT
                  tQuat
                  v(3) AS GLfloat
              END UNION
              MACRO HVect      = QUAT
              MACRO QUATERNION = QUAT
              MACRO Vector4f   = QUAT
              GLOBAL qIDN AS quaternion
         '--------------------------------------------------------------------------------------
         'Matrix4f: 4x4 Matrix
         '--------------------------------------------------------------------------------------
              TYPE Matrix4f
                  mm(15) AS GLfloat
              END TYPE
         '--------------------------------------------------------------------------------------
         'ArcBall UDT:
         '--------------------------------------------------------------------------------------
              TYPE tARCBALL
                  center     AS Vector3f 'Center of arcball rotation (translation offset).
                  radius     AS GLfloat  'Length of ArcBall's radius.
                  mouseXScl  AS GLfloat  'Amount to scale message mouse-X value by.
                  mouseYScl  AS GLfloat  'Amount to scale message mouse-Y value by.
                  dragPosNow AS Vector3f 'Current Normalized, "3D" position of mouse.
                  dragPosBeg AS Vector3f '3D mouse-position at begining of drag (LMB click-dn).
                  qNow       AS QUAT     'Current  ArcBall quaternion value.
                  qPrev      AS QUAT     'Previous ArcBall quaternion value.
                  isClicked  AS GLint    'Left  Mouse-Button Down flag.
                  isRClicked AS GLint    'Right Mouse-Button Down flag.
                  isDragging AS GLint    'True if LMB-down, and mouse-move event occured.
                  rMatrix    AS Matrix4f 'ArcBall's 4x4 Rotation-Matrix.
              END TYPE
      '-----------------------------------------------------------------------------------------
      'ArcBall Math: For the context of this demo, and to maintain clarity, these functions and
      '              macros weren't written in ASM, or utilize pointers.
      '-----------------------------------------------------------------------------------------
          '-------------------------------------------------------------------------------------
          'Epsilon: A constant representing the lower threshold of single-precision accuracy.
          '-------------------------------------------------------------------------------------
              MACRO Epsilon  = 1.0e-5
          '-------------------------------------------------------------------------------------
          'Matrix4fSetIdentity: Sets specified 4x4 matrix to identity.
          '-------------------------------------------------------------------------------------
              MACRO Matrix4fSetIdentity(m)
                  RESET m
                  m.mm(00) = 1!: m.mm(05) = 1!: m.mm(10) = 1!: m.mm(15) = 1!
              END MACRO
          '-------------------------------------------------------------------------------------
          'Vector3fCross-- Result-vector = cross product of vectors v1 and v2.
          '-------------------------------------------------------------------------------------
              MACRO Vector3fCross(Result, v1, v2)
                  Result.X = (v1.Y * v2.Z) - (v1.Z * v2.Y)
                  Result.Y = (v1.Z * v2.X) - (v1.X * v2.Z)
                  Result.Z = (v1.X * v2.Y) - (v1.Y * v2.X)
              END MACRO
          '-------------------------------------------------------------------------------------
          'Vector3fDot-- Computes the dot product of the this vector and vector v1.
          '-------------------------------------------------------------------------------------
              MACRO FUNCTION Vector3fDot(v1, v2)
                  MACROTEMP dot
                  DIM dot AS GLfloat
                  dot = (v1.X * v2.X) +_
                        (v1.Y * v2.Y) +_
                        (v1.Z * v2.Z)
              END MACRO = dot
          '-------------------------------------------------------------------------------------
          'Vector3fLengthSquared-- Returns the squared-length of vector.
          '-------------------------------------------------------------------------------------
              MACRO FUNCTION Vector3fLengthSquared(v)
                  MACROTEMP lenSq
                  DIM lenSq AS GLfloat
                  lenSq  = (v.X * v.X) +_
                           (v.Y * v.Y) +_
                           (v.Z * v.Z)
              END MACRO = lenSq
          '-------------------------------------------------------------------------------------
          'Vector3fLength-- Returns the length of vector.
          '-------------------------------------------------------------------------------------
              MACRO FUNCTION Vector3fLength(v)
                  MACROTEMP vLen
                  DIM vLen AS GLfloat
                  vLen  = SQR((v.X * v.X) +_
                              (v.Y * v.Y) +_
                              (v.Z * v.Z))
              END MACRO = vLen
          '-------------------------------------------------------------------------------------
          'QuatMult-- Multiplies quatA*quatB, placing return value quatA.
          '-------------------------------------------------------------------------------------
              SUB quatMult(qA AS quaternion, qB AS quaternion)
                  LOCAL qT AS quaternion: qT = qA
                  qA.X  = (qT.W*qB.X) + (qT.X*qB.W) + (qT.Y*qB.Z) - (qT.Z*qB.Y)
                  qA.Y  = (qT.W*qB.Y) + (qT.Y*qB.W) + (qT.Z*qB.X) - (qT.X*qB.Z)
                  qA.Z  = (qT.W*qB.Z) + (qT.Z*qB.W) + (qT.X*qB.Y) - (qT.Y*qB.X)
                  qA.W  = (qT.W*qB.W) - (qT.X*qB.X) - (qT.Y*qB.Y) - (qT.Z*qB.Z)
              END SUB
          '-------------------------------------------------------------------------------------
          'QuatToMatrix-- Converts quaternion to a column-major 4x4 matrix.
          '-------------------------------------------------------------------------------------
              SUB quatToMatrix(q AS quaternion, m4 AS Matrix4f)
                  LOCAL s!,xs!,ys!,zs!,wx!,wy!,wz!,xx!,xy!,xz!,yy!,yz!,zz!
                  s = (q.X*q.X) + (q.Y*q.Y) + (q.Z*q.Z) + (q.W*q.W)
                  IF s THEN 'BTW, If q was already normalized, s(cale) will = 1.
                      s = 2/s
                      xs = q.X * s  : ys = q.Y * s  : zs = q.Z * s
                      xx = q.X * xs : xy = q.X * ys : xz = q.X * zs
                      yy = q.Y * ys : yz = q.Y * zs : zz = q.Z * zs
                      wx = q.W * xs : wy = q.W * ys : wz = q.W * zs
                      m4.mm(00) = (1-(yy + zz))
                      m4.mm(01) = (xy + wz)
                      m4.mm(02) = (xz - wy)
                      m4.mm(04) = (xy - wz)
                      m4.mm(05) = (1-(xx + zz))
                      m4.mm(06) = (yz + wx)
                      m4.mm(08) = (xz + wy)
                      m4.mm(09) = (yz - wx)
                      m4.mm(10) = (1-(xx + yy))
                  ELSE
                      Matrix4fSetIdentity(m4)
                      q = qIDN
                  END IF
              END SUB
      '-----------------------------------------------------------------------------------------
      'ArcBall Processing and Display Functions:
      '-----------------------------------------------------------------------------------------
          '-------------------------------------------------------------------------------------
          'ArcBallInit-- Initialize ArcBall variables, and create OpenGL Display-Lists
          '-------------------------------------------------------------------------------------
              SUB arcBallInit(aBall AS tArcBall)
                  STATIC init AS GLint
                  IF ISFALSE(init) THEN
                      TorusDL   = CreateTorusList (0.3,  1.0)  'Generate Torus  glList
                      SphereDL  = CreateSphereList(1.3, 20.0)  'Generate Sphere glList
                      RESET qIDN: qIDN.W = 1
                      init = 1
                  END IF
                  Matrix4fSetIdentity (aBall.rMatrix)
                  aBall.qNow = qIDN: aBall.qPrev = qIDN
              END SUB
          '-------------------------------------------------------------------------------------
          'ArcBallGetMouse3DPos-- Convert mouse's 2D-position to "3D" spherical coordinates.
          '-------------------------------------------------------------------------------------
              SUB ArcBallGetMouse3DPos(posn AS GLint, aBall AS tArcBall)
               'Local scale variable
                  LOCAL mousePosScale AS GLfloat
      
               'Adjust point coords and scale down to range of [-1 ... 1]
                  aBall.dragPosNow.X  =   (LOINT(posn) * aBall.mouseXScl)-1
                  aBall.dragPosNow.Y  = 1-(HIINT(posn) * aBall.mouseYScl)
      
               'Get the Mouse's 2D squared-length:
                  mousePosScale  = (aBall.dragPosNow.X * aBall.dragPosNow.X) +_
                                   (aBall.dragPosNow.Y * aBall.dragPosNow.Y)
      
               'Determine if point is inside, or outside the unit-sphere.
                  IF (mousePosScale > 1.0) THEN
                   'The point is "outside" the sphere.
                      mousePosScale      = 1/SQR(mousePosScale)
                      aBall.dragPosNow.X = aBall.dragPosNow.X * mousePosScale
                      aBall.dragPosNow.Y = aBall.dragPosNow.Y * mousePosScale
                      aBall.dragPosNow.Z = 0
                  ELSE
                   'The point is "inside" the sphere.
                      aBall.dragPosNow.Z = SQR(1-mousePosScale)
                  END IF
              END SUB
          '-------------------------------------------------------------------------------------
          'ArcBallDrag-- Takes the start-vector and current mouse position, and returns the
          '              corresponding rotational value in the form of a quaternion.
          '              Quat.XYZ = The cross-product of the start & end vectors
          '              Quat.W   = The dot-product of the start & end vectors.
          '-------------------------------------------------------------------------------------
              SUB arcBallDrag(aBall AS tArcBall)
                  LOCAL Perp AS Vector3f PTR: Perp = VARPTR(aBall.qNow)
      
               'Get quaternion's imaginary-components [X, Y, Z]:
                  Vector3fCross(@Perp, aBall.dragPosBeg, aBall.dragPosNow)
      
               'Check for validity imaginary-components:
                  IF (Vector3fLength(@Perp) > Epsilon) THEN
                   'Valid. Assign real-component [W]:
                      aBall.qNow.W = Vector3fDot(aBall.dragPosBeg, aBall.dragPosNow)
                  ELSE
                   'Invalid (Colinear). Set quaternion to "identity":
                      aBall.qNow = qIDN
                  END IF
      
              END SUB
          '-------------------------------------------------------------------------------------
          'ArcBallUpdate-- Perform updates to ArcBall-Rotation:
          '-------------------------------------------------------------------------------------
              SUB arcBallUpdate(aBall AS tArcBall)
               'If Right Mouse Clicked, Reset All Rotations
                  IF aBall.isRClicked THEN
                      Matrix4fSetIdentity (aBall.rMatrix)
                      aBall.qPrev = qIDN: aBall.qNow = qIDN
                  END IF
               'If not dragging, but LMB was clicked, prepare ArcBall elements for dragging:
                  IF ISFALSE(aBall.isDragging) THEN
                      IF aBall.isClicked THEN
                       'Set dragging-flag
                          aBall.isDragging = GL_TRUE
                       'Last static (base) quaternion = Last dynamic quaternion
                          aBall.qPrev = aBall.qNow
                       'Set ArcBall's start-vector
                          aBall.dragPosBeg = aBall.dragPosNow
                      END IF
                  ELSE
               'Otherwise...
                   'If dragging-flag is true, and the LMB is down, we're dragging.
                      IF aBall.isClicked THEN
                          arcBallDrag(aBall)
                       'aBall.qNow = aBall.qNow * aBall.qPrev
                          quatMult(aBall.qNow, aBall.qPrev)
                       'Convert quaternion to Arcball Matrix
                          quatToMatrix(aBall.qNow, aBall.rMatrix)
                   'If LMB isn't down, we're no longer dragging.
                      ELSE
                       'Reset dragging-flag
                          RESET aBall.isDragging
                      END IF
                  END IF
               'End processing user ArcBall mouse-events.
              END SUB
          '-------------------------------------------------------------------------------------
          'ArcballDraw-- Draw the arcball part of the OpenGL display to the render-buffer
          '-------------------------------------------------------------------------------------
              SUB arcballDraw(aBall AS tArcBall)
                  glClear GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT'Clear OpenGL Buffers
                  glPushMatrix
                  glLoadIdentity                                    'Set Modelview Matrix to IDN
                  glPushMatrix
                  glTranslatef (-1.5, 0.0, -6.0)                    'Move X -1.5 Units, & Z -6.0
                  glMultMatrixf(aBall.rMatrix)                      'Apply Dynamic Transform
                  glColor3f (0.75, 0.75, 1.0)                       'Set Torus Color
                  glCallList TorusDL                                'Draw Torus
      
                  glPopMatrix                                       'Unapply Dynamic Transform
      
                  glTranslatef (1.5, 0.0, -6.0)                     'Move X 1.5 Units, & Z -6.0
                  glMultMatrixf(aBall.rMatrix)                      'Apply Dynamic Transform
                  glColor3f(1.0, 0.75, 0.75)                        'Set Sphere Color
                  glCallList SphereDL                               'Draw Sphere
                  glPopMatrix                                       'Unapply Dynamic Transform
      
                  glFlush                                           'Flush GL Rendering Pipeline
              END SUB
      '-----------------------------------------------------------------------------------------
      '-----------------------------------------------------------------------------------------
      ------------------
      Scott Martindale
      [email protected]
      Scott Martindale
      [email protected]

      Comment


      • #4
        The following code creates the 3D-objects used for ArcBall Demo.

        Copy & Paste, and save file as "SphereTorusList.inc"

        Code:
        #IF NOT %DEF(%SphereTorusDL)
        %SphereTorusDL = -1
        '-----------------------------------------------------------------------------------------
        'Global OpenGL Display-List Handles for Sphere and Torus
        '-----------------------------------------------------------------------------------------
            GLOBAL SphereDL AS GLuint, TorusDL AS GLuint
        '-----------------------------------------------------------------------------------------
        'PI-Derivative MACROS:
        '-----------------------------------------------------------------------------------------
            MACRO twopi   = 06.28318530717958648
            MACRO halfpi  = 01.57079632679489662
        '-----------------------------------------------------------------------------------------
        'CreateSphereList-- Generates an OpenGL display-list of a solid, segmented sphere.
        '-----------------------------------------------------------------------------------------
            FUNCTION CreateSphereList(Radius AS GLfloat, n AS GLfloat) AS GLuint
                LOCAL theta1!, theta2!, theta3! ,px!, py!, pz!, x!, y!, z!, i&, j&, glist???
        
             'Obtain Sphere list-handle value from OpenGL:
                glist = glGenLists 1: FUNCTION = glist
        
             'Compile Sphere-List
                glNewList glist, GL_COMPILE
                 'Draw top triangle-fan
                    glBegin GL_TRIANGLE_FAN
                        glNormal3f(0,1,0)
                        glVertex3f(0,radius,0)
                        theta1 = -SIN(twopi/n - halfpi)
                        theta2 =  COS(twopi/n - halfpi)
                        FOR j = 0 TO n
                            theta3 = j*twopi/n
                            x  = theta2*COS(theta3)
                            y  = theta1
                            z  = theta2*SIN(theta3)
                            px = Radius*x
                            py = Radius*y
                            pz = Radius*z
                            glNormal3f x, y, z
                            glVertex3f px,py,pz
                        NEXT
                    glEnd 'GL_TRIANGLE_FAN
                 'Draw Quad-Strip part of sphere
                    FOR j = 1 TO (n/2)-2
                        theta1 = j*twopi/n - halfpi
                        theta2 = (j+1)*twopi/n - halfpi
                        glBegin GL_QUAD_STRIP
                            FOR i = 0 TO n
                                theta3 = i*twopi/n
                                x  = COS(theta2) * COS(theta3)
                                y  = SIN(theta2)
                                z  = COS(theta2) * SIN(theta3)
                                px = Radius*x
                                py = Radius*y
                                pz = Radius*z
                                glNormal3f x, y, z
                                glVertex3f px,py,pz
                                x  = COS(theta1) * COS(theta3)
                                y  = SIN(theta1)
                                z  = COS(theta1) * SIN(theta3)
                                px = Radius*x
                                py = Radius*y
                                pz = Radius*z
                                glNormal3f x, y, z
                                glVertex3f px, py, pz
                            NEXT i
                        glEnd 'GL_QUAD_STRIP
                    NEXT j
                 'Draw bottom triangle-fan
                    glBegin GL_TRIANGLE_FAN
                        glNormal3f(0,-1, 0)
                        glVertex3f(0,-radius,0)
                        theta1 = SIN(twopi/n - halfpi)
                        theta2 = COS(twopi/n - halfpi)
                        FOR j = n TO 0 STEP -1
                            theta3 = j*twopi/n
                            x  = theta2 * COS(theta3)
                            y  = theta1
                            z  = theta2 * SIN(theta3)
                            px = Radius*x
                            py = Radius*y
                            pz = Radius*z
                            glNormal3f x, y, z
                            glVertex3f px,py,pz
                        NEXT j
                    glEnd 'GL_TRIANGLE_FAN
                glEndList
          END FUNCTION
        '-----------------------------------------------------------------------------------------
        'CreateTorusList-- Generates an OpenGL display-list of a solid torus (aka; "doughnut")
        '-----------------------------------------------------------------------------------------
            FUNCTION CreateTorusList(MinorRadius AS GLfloat, MajorRadius AS GLfloat) AS GLuint
                LOCAL stacks AS GLint, wrapFrac AS GLfloat, slices AS GLint, phi AS GLfloat,_
                      stMod  AS GLfloat, stMod1 AS GLfloat, sinphi AS GLfloat, cosphi AS GLfloat,_
                      r AS GLfloat, glist AS GLuint
        
             'Obtain Torus list-handle value from OpenGL.
                glist = glGenLists 1: FUNCTION = glist
        
             'Compile Torus List
                glNewList glist, GL_COMPILE
                 'Start Quad-Strip
                    glBegin GL_QUAD_STRIP
                     'Stacks
                        FOR stacks = 0 TO 20
                         'Slices
                            FOR slices = 0 TO 19
                                wrapFrac = (slices MOD 20)/20
                                phi      = twopi*wrapFrac
                                sinphi   = SIN(phi)
                                cosphi   = COS(phi)
                                r        = MajorRadius + (MinorRadius * cosphi)
                                stMod    = twopi*( stacks  MOD 20 + wrapFrac)/20
                                stMod1   = twopi*((stacks+1) MOD 20 + wrapFrac)/20
                                glNormal3f(SIN(stMod) * cosphi, sinphi, COS(stMod)*cosphi)
                                glVertex3f(SIN(stMod) * r, MinorRadius*sinphi, COS(stMod)*r)
                                glNormal3f(SIN(stMod1)* cosphi, sinphi, COS(stMod1)*cosphi)
                                glVertex3f(SIN(stMod1)* r, MinorRadius*sinphi, COS(stMod1)*r)
                            NEXT slices
                        NEXT stacks
                    glEnd 'GL_QUAD_STRIP
                glEndList 'TorusDL
            END FUNCTION
        '-----------------------------------------------------------------------------------------
        #ENDIF
        ------------------
        Scott Martindale
        [email protected]
        Scott Martindale
        [email protected]

        Comment


        • #5
          And now, (finally) the "Main" source...

          Code:
          '-----------------------------------------------------------------------------------------
          '-----------------------------------------------------------------------------------------
          ' PowerBASIC OpenGL Demo: ArcBall (v1.0) 11/APR/05
          ' by Scott Martindale [email protected]
          '
          '-----------------------------------------------------------------------------------------
          'Includes and Metastatements:
          '-----------------------------------------------------------------------------------------
              #COMPILE EXE
              %USEMACROS = 1
              #INCLUDE "WIN32API.INC"
              #INCLUDE "ArcBall.inc"
          '-----------------------------------------------------------------------------------------
          'Global Variables:
          '-----------------------------------------------------------------------------------------
              GLOBAL g_HDC AS GLuint, glRefresh AS GLint, hWnd AS GLuint, ArcBall AS tArcBall
          '-----------------------------------------------------------------------------------------
          'Forward Declarations and Function Prototypes:
          '-----------------------------------------------------------------------------------------
              DECLARE SUB initGLdisplayParameters(hDC AS GLuint)
              DECLARE SUB resizeGL (nWidth AS GLint, nHeight AS GLint)
              DECLARE SUB setGLPerspective(fovy  AS GLfloat, nAspect AS GLfloat,_
                                           zNear AS GLfloat, zFar AS GLfloat)
          '-----------------------------------------------------------------------------------------
          'WINMAIN-- Program's "Entry-Point".
          '-----------------------------------------------------------------------------------------
              FUNCTION WINMAIN (BYVAL hInstance AS GLuint, BYVAL hPrevInstance AS GLuint,_
                                BYVAL lpCmdLine AS ASCIIZ PTR, BYVAL iCmdShow  AS GLint) AS GLint
          
                  LOCAL msg AS tagMsg, wce AS WndClassEx, ClassName AS ASCIIZ * 80
          
               'Define and register OpenGL-Application class:
                  ClassName         = "OpenGL"
                  wce.hInstance     = hInstance
                  wce.cbSize        = SIZEOF(wce)
                  wce.lpszClassName = VARPTR(ClassName)
                  wce.lpfnWndProc   = CODEPTR(WndProc)
                  wce.style         = %CS_HREDRAW OR %CS_VREDRAW
                  wce.hCursor       = LoadCursor(%NULL,     BYVAL %IDC_ARROW)
                  wce.hIcon         = LoadIcon  (hInstance, BYVAL %IDI_APPLICATION)
                  wce.hIconSm       = LoadIcon  (hInstance, BYVAL %IDI_APPLICATION)
                  IF ISFALSE(RegisterClassEx(wce)) THEN
                      MSGBOX "Unable to Register Window Class."
                      EXIT FUNCTION
                  END IF
          
               'Create a window using the registered class:
                  hWnd = CreateWindowEx(%NULL, ClassName, "OpenGL ArcBall Demo",_
                                        %WS_OVERLAPPEDWINDOW OR %WS_VISIBLE OR %WS_SYSMENU,_
                                         100, 100, 640, 480, %NULL, %NULL, hInstance,_
                                         BYVAL %NULL)
                  IF ISFALSE(hWnd) THEN
                      MSGBOX "Unable to create window"
                      EXIT FUNCTION
                  END IF
          
               'Show Window:
                  ShowWindow hWnd, iCmdShow                         'Display Window
                  UpdateWindow hWnd                                 'Update Window
                  SetForegroundWindow hWnd                          'Make this the topmost window
                  SetFocus hWnd                                     'Set UI focus to this window
          
               'Main Proc-Loop:
                  DO
                      IF PeekMessage(msg, hWnd, 0, 0, %PM_NOREMOVE) THEN
                          IF GetMessage(msg, hWnd, 0, 0) THEN
                              TranslateMessage msg
                              DispatchMessage  msg
                          ELSE
                              EXIT DO
                          END IF
                      ELSE
                          IF glRefresh THEN
                              arcBallUpdate(ArcBall)
                              arcballDraw(ArcBall)
                              SwapBuffers g_HDC
                              RESET glRefresh
                          END IF
                          waitmessage
                      END IF
                  LOOP
          
                  FUNCTION = msg.wParam
          
              END FUNCTION
          
          '-----------------------------------------------------------------------------------------
          'WndProc-- Process system-messages here (usually).
          '-----------------------------------------------------------------------------------------
              FUNCTION WndProc (BYVAL hWnd AS GLuint, BYVAL wMsg AS GLuint, _
                                BYVAL wParam AS GLint, BYVAL lParam AS GLint) AS GLint
          
                  SELECT CASE AS GLint wMsg
          
                      CASE %WM_MOUSEMOVE
                          IF (wParam AND %MK_LBUTTON) THEN
                              ArcBallGetMouse3DPos(lParam, ArcBall)
                          END IF
                          glRefresh = glRefresh OR (wParam AND %MK_LBUTTON)
                          EXIT FUNCTION
          
                      CASE %WM_LBUTTONUP
                          glRefresh  = ArcBall.isClicked OR ArcBall.isDragging
                          RESET ArcBall.isClicked
                          RESET ArcBall.isDragging
                          releasecapture
                          EXIT FUNCTION
          
                      CASE %WM_RBUTTONUP
                          RESET ArcBall.isRClicked
                          RESET ArcBall.isDragging
                          EXIT FUNCTION
          
                      CASE %WM_LBUTTONDOWN
                          ArcBall.isClicked  = GL_TRUE
                          glRefresh  = GL_TRUE
                          ArcBallGetMouse3DPos(lParam, ArcBall)
                          setcapture(hWnd)
                          EXIT FUNCTION
          
                      CASE %WM_RBUTTONDOWN
                          ArcBall.isRClicked = GL_TRUE
                          glRefresh  = GL_TRUE
                          RESET ArcBall.isClicked
                          EXIT FUNCTION
          
                      CASE %WM_CHAR
                          IF wParam = %VK_ESCAPE THEN PostQuitMessage 0
                          EXIT FUNCTION
          
                      CASE %WM_SIZE
                          resizeGL(LOINT(lParam), HIINT(lParam))
                          arcBallUpdate(ArcBall): arcballDraw(ArcBall)
                          glRefresh = GL_TRUE
                          EXIT FUNCTION
          
                      CASE %WM_PAINT
                          SwapBuffers g_hDC
                          validateRect(hWnd, BYVAL(0))
                          EXIT FUNCTION
          
                      CASE %WM_CREATE
                          g_hDC = GetDC hWnd
                          initGLdisplayParameters g_hDC
                          arcBallInit(ArcBall)
                          EXIT FUNCTION
          
                      CASE %WM_CLOSE
                          wglMakeCurrent   g_hDC, %NULL
                          wglDeleteContext g_hDC
                          glDeleteLists SphereDL, 0
                          glDeleteLists TorusDL,  0
                          PostQuitMessage 0
                          EXIT FUNCTION
          
                      CASE %WM_SYSCOMMAND
                          IF (wParam <> %SC_SCREENSAVE) OR (wParam <> %SC_MONITORPOWER) THEN
                              FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
                          END IF
                          EXIT FUNCTION
          
                      CASE ELSE
                          FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
          
                      END SELECT
              END FUNCTION
          
          '-----------------------------------------------------------------------------------------
          'initGLdisplayParameters-- Establish parameters of, and set OpenGL's window pixel-format:
          '-----------------------------------------------------------------------------------------
              SUB initGLdisplayParameters(hDC AS GLuint)
               'Local pixel-format descriptor
                  LOCAL pfd AS PIXELFORMATDESCRIPTOR
               'Fill relevent members of pfd
                  pfd.nSize           = SIZEOF(PIXELFORMATDESCRIPTOR) 'Size of UDT structure
                  pfd.nVersion        = 1                             'Version. Always set to 1.
                  pfd.dwFlags         = &h25                          'Window/OpenGL/Double-Buffer
                  pfd.cColorBits      = 32                            '32-Bit Color Mode
                  pfd.cDepthBits      = 16                            '16-bit z-buffer depth
                  pfd.iLayerType      = %PFD_MAIN_PLANE               'Main Drawing Plane
          
               'Set pixel format to device context.
                  SetPixelFormat(hDC, ChoosePixelFormat(hDC, pfd), pfd)
          
               'Create OpenGL context.
                  wglMakeCurrent hDC, wglCreateContext(hDC)
          
               'Set Initial OpenGL attributes:
                  glShadeModel GL_FLAT                                'Enable Flat Shading
                  glClearColor 0.0, 0.0, 0.0, 0.5                     'Black Background
                  glClearDepth 1.0                                    'Depth Buffer Setup
                  glEnable GL_DEPTH_TEST                              'Enables Depth Testing
                  glDepthFunc GL_LEQUAL                               'Type of Depth Testing To Do
                  glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST    'Do nicest perspective
                  glEnable GL_LIGHT0                                  'Enable Default Light
                  glEnable GL_LIGHTING                                'Enable Lighting
                  glEnable GL_COLOR_MATERIAL                          'Enable Coloring Of Material
              END SUB
          '-----------------------------------------------------------------------------------------
          'SetGLPerspective-- Sets the view-frustum parameters:
          '-----------------------------------------------------------------------------------------
                  SUB setGLPerspective(fovy  AS GLfloat, nAspect AS GLfloat,_
                                       zNear AS GLfloat, zFar    AS GLfloat)
                      LOCAL xmin!, xmax!, ymin!, ymax!
                      ymax =  zNear * TAN(fovy * 0.00872664626)
                      ymin = -ymax
                      xmin =  ymin * nAspect
                      xmax =  ymax * nAspect
                      glFrustum xmin, xmax, ymin, ymax, zNear, zFar
                  END SUB
          '-----------------------------------------------------------------------------------------
          'ResizeGL-- Adjust OpenGL's Projection-Matrix to properly maintain aspect-ratio and other
          '           related attributes when the window is resized.
          '-----------------------------------------------------------------------------------------
              SUB resizeGL (nWidth AS GLint, nHeight AS GLint)
                  nWidth = MAX&(nWidth,1&): nHeight = MAX&(nHeight,1&)
                  glViewport 0, 0, nWidth, nHeight              'Set viewport region.
                  glMatrixMode GL_PROJECTION                    'Switch to Projection-Matrix mode.
                  glLoadIdentity                                'Reset the Projection-Matrix.
                  setGLPerspective (45, nWidth/nHeight, 1, 100) 'Set view-attributes (Projection).
                  glMatrixMode   (GL_MODELVIEW)                 'Select the Modelview-Matrix
                  ArcBall.mouseXScl = 1/((nWidth -1)*0.5)       'Set ArcBall.mouseXScl  for arcball eval.
                  ArcBall.mouseYScl = 1/((nHeight-1)*0.5)       'Set ArcBall.mouseYScl for arcball eval.glLoadIdentity                                'Reset  the Modelview-Matrix
              END SUB
          '-----------------------------------------------------------------------------------------
          '-----------------------------------------------------------------------------------------
          ------------------
          Scott Martindale
          [email protected]

          [This message has been edited by Scott J. Martindale (edited April 11, 2005).]
          Scott Martindale
          [email protected]

          Comment


          • #6
            I found three calls to functions that did not have the () around a
            passed parameter. When the () were added, the program compiled and
            ran as intended.

            ------------------
            Old Navy Chief, Systems Engineer, Systems Analyst, now semi-retired

            Comment


            • #7
              Accidentally got duplicated. Seems you should be able to get rid
              of your own posts, but you can't.
              ------------------
              Old Navy Chief, Systems Engineer, Systems Analyst, now semi-retired

              [This message has been edited by Donald Darden (edited April 15, 2005).]

              Comment

              Working...
              X