VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CXXX"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'******************************Module*Header******************************
'FUNCTION: main class which responds to the ocx
'AUTHOR: ported by edx - edx@hk.super.net Feb 99, from:
'Fast Picking Using OpenGL, Angus dorbie, dorbie@ sgi.com
'HISTORY: -
'NOTES: this is a port of:
'from: Picking Exercise:
'This directory contains an example of using the OpenGL picking and
'selection modes, as well as some simple hacks for picking.
'This example is written using the Microsoft Foundation Classes (MFC) libraries.
'1997 OpenGL Programming Labs - available at sgi
'I slightly modified the PickScene_Select routine to use a glpickmatrix.
'
'This shows various methods of doing picking by rendering only the objects
'of interest. It also demostrates a method using colors.
'Use the toolbar to select an interaction mode:
'1 - navigation
'2 - pick grid lines (note: only green grid is pickable)
'3 - same as above, draws quads for picking
'4 - select objects by clicking
'5 - same as above, but using a drag rectangle
'6 - select objects using the color technique
'
'7 - toggle alpha (the round target object
'8 - anti-alias lines
'Not sure if picking works right in the 'invisible' regions of the
'target.
'*************************************************************************
Dim m_bTexture As Boolean
Dim m_bMoving As Boolean
Dim m_Grids As Boolean
Dim m_MouseX&, m_MouseY&
Dim m_StartX&, m_StartY&
Dim m_Width&, m_Height&
Dim m_Dragging As Boolean

'----------------------------------------------------------------------------
Const SELSIZE = 1024 'size of selection buffer
Const MAXOBJS = 20
Public Enum InteractionModes
    INTER_MOTION = 0
    INTER_SELECT_GRID = 1
    INTER_SELECT_POLY = 2
    INTER_SELECT_OBJ = 3
    INTER_SELECT_COLOR = 4
    INTER_SELECT_DRAG = 5
End Enum
Public Enum MotionModes
    MOTION_NONE = 0
    MOTION_ROTATE = 1
    MOTION_ZOOM = 2
    MOTION_XLATE = 3
End Enum


'----------------------------------------------------------------------------
Dim m_NumSceneObjs& ' number of scene objects display listed
'navigation
Dim m_inmotion As MotionModes
Dim m_InteractionMode As InteractionModes  ' interaction mode
Dim m_AngleX!, m_AngleY!
Dim m_TranslateZ!
Dim m_PanX!, m_PanY!
Dim m_Alpha As Boolean 'status of cull alpha
'props
Dim m_AntiAlias As Boolean
'grid
Dim m_GridSizeX!, m_GridSizeY!, m_GridSizeZ!
Dim m_Gxpos!, m_Gypos!, m_Gzpos!
Dim m_GridSpaceZ!, m_GridSpaceX!, m_GridSpaceY!
'picking
Dim m_DoPick As Boolean 'indicates picking action is outstanding
Dim m_XGridPick&, m_ZGridPick&
Dim m_PickSize! 'size of pick region
Dim m_SBuffer As Boolean 'status of single buffer toggle
Dim m_angle1grab!, m_angle2grab!, m_rangegrab!
Dim m_PanXgrab!, m_PanYgrab!
Dim m_xgrab&, m_ygrab&
Dim m_ObjPick(0 To MAXOBJS - 1) As Boolean
Dim PickingColors(0 To 7)  As POINT4F
Dim m_StartPoint#(0 To 2), m_EndPoint#(0 To 2)

Private Sub Class_Initialize()
    m_TranslateZ! = -10
    m_GridSizeX! = 15
    m_GridSpaceX! = 1
    m_Gxpos! = -15
    m_GridSizeY! = 15
    m_GridSpaceY! = 1
    m_GridSizeZ = 15
    m_GridSpaceZ! = 1
    m_Gzpos! = -15
    m_XGridPick& = 15
    m_ZGridPick& = 15
    m_PickSize = 10
    m_Alpha = True
    PickingColors(0).p(3) = 1
    FillArrayf PickingColors(1).p, 1, 0, 0, 1 '1
    FillArrayf PickingColors(2).p, 0, 1, 0, 1 '2
    FillArrayf PickingColors(3).p, 1, 1, 0, 1 '3
    FillArrayf PickingColors(4).p, 0, 0, 1, 1 '4
    FillArrayf PickingColors(5).p, 1, 0, 1, 1 '5
    FillArrayf PickingColors(6).p, 0, 1, 1, 1 '6
    FillArrayf PickingColors(7).p, 1, 1, 1, 1 '7
End Sub

'----------------------------------------------------------------------------
'PROPERTIES
'----------------------------------------------------------------------------

Property Let AlphaCulling(cull As Boolean)
    m_Alpha = cull
    gCtl.Render
End Property

Property Let AntiAlias(aa As Boolean)
    m_AntiAlias = aa
    gCtl.Render
End Property

Property Let SingleBuffering(sng As Boolean)
    m_SBuffer = sng
    If m_SBuffer Then
        glDrawBuffer GL_FRONT
        glReadBuffer GL_FRONT
    Else
        glDrawBuffer GL_BACK
        glReadBuffer GL_BACK
    End If
End Property

Property Let Picksize(NewSize&)
    m_PickSize = NewSize&
    If m_PickSize < 1 Then m_PickSize = 0.01
End Property

Property Let InteractionMode(mode As InteractionModes)
    m_InteractionMode = mode
End Property

'----------------------------------------------------------------------------
'EVENT HANDLERS
'----------------------------------------------------------------------------
Public Sub Init()
'do pre-GL stuff here - set pf
End Sub

Public Sub InitGL()
    glClearColor 0, 0, 0, 0
    With gCtl.Lights.Item(liLight0)
        .SetAmbient 0.1, 0.1, 0.1
        .SetDiffuse 1, 1, 1
        .SetPosition 90, 90, 150
        .Enabled = True
    End With
    glDisable GL_LIGHTING
    With gCtl.Camera
        .FarPlane = 1000
        .NearPlane = 1
        .FieldOfView = 30
        .SetEyePos 0, 0, 20
        .SetTargetPos 0, 0, 0
    End With
    '
    With gCtl
        .Trackball.Animate = False
        .Grid = glxGridX
        .axis = glxXYZ
        '.Pick = True
        '.UseCamera = False
    End With
    glCullFace GL_BACK
    glEnable GL_CULL_FACE
    CheckError
    'draw the lists for the objects
    m_NumSceneObjs = 1
    ' colourfull Gouraud shaded pyramid
    DrawPyramid m_NumSceneObjs
    ' wireline Torus
    m_NumSceneObjs = m_NumSceneObjs + 1
    DrawWireTorus m_NumSceneObjs
    'Bezier patch using evaluators
    m_NumSceneObjs = m_NumSceneObjs + 1
    DrawPatch m_NumSceneObjs
    ' cube
    m_NumSceneObjs = m_NumSceneObjs + 1
    DrawCube m_NumSceneObjs
    ' alpha textured quad
    m_NumSceneObjs = m_NumSceneObjs + 1
    DrawTarget m_NumSceneObjs, m_Alpha
    CheckError
End Sub

'----------------------------------------------------------------------------
Public Sub Draw()
Dim A!
    If m_Dragging Then
        Select Case m_InteractionMode
        Case INTER_SELECT_DRAG:
            DrawRect
        End Select
    End If
    '---------------------------------------------------
    ' SetupViewingXform
    ' This is a static, default viewing transform
    glTranslatef 0, 0, m_TranslateZ
    glTranslatef m_PanX, m_PanY, 0
    glRotatef m_AngleY, 1, 0, 0
    glRotatef m_AngleX, 0, 1, 0

    '----------------------------------------------------
    'CheckError
    If m_DoPick Then
        m_DoPick = False
        Select Case m_InteractionMode
        Case INTER_SELECT_GRID: ' grid selection
            PickGrid 0
        Case INTER_SELECT_POLY: ' grid polygon selection
            PickGrid 1
        Case INTER_SELECT_OBJ: ' object selection
            PickScene_Select 0
        Case INTER_SELECT_COLOR: ' colour read pixels
            PickScene_Color
        Case INTER_SELECT_DRAG: ' object rubberband
            PickScene_Select 1
        End Select
        glClear GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT
    End If
    '----------------------------------------------------
    'CheckError
    m_RenderObjects
    m_RenderGrid

    'CheckError
    If m_InteractionMode = INTER_MOTION Then
        If m_inmotion <> MOTION_NONE Then
            glViewport 0, 0, m_Width / 10, m_Height / 10
            glMatrixMode GL_PROJECTION
            glPushMatrix
            glLoadIdentity
            If m_Height Then A = m_Width / m_Height Else A = 1
            glOrtho -A, A, -1, 1, -1, 1
            glMatrixMode GL_MODELVIEW
            glLoadIdentity
            glColor4f 1, 1, 1, 1

            glDisable GL_DEPTH_TEST

            Select Case m_inmotion
            Case (MOTION_ZOOM):
                glBegin GL_TRIANGLES
                glVertex2f 0, 0.75
                glVertex2f -0.2, -0.75
                glVertex2f 0.2, -0.75
                glEnd
               Case (MOTION_XLATE):
                glRectf -0.75, -0.1, 0.75, 0.1
                glRectf -0.1, -0.75, 0.1, 0.75
            Case (MOTION_ROTATE):
                glRectf 0, 0, 1, 0.5

            End Select

            glEnable GL_DEPTH_TEST
            glMatrixMode GL_PROJECTION
            glPopMatrix
            glMatrixMode GL_MODELVIEW
            glViewport 0, 0, m_Width, m_Height
        End If
    End If
    CheckError
End Sub

Private Sub m_RenderObjects()
Dim i&
Dim HiLiteColor!(0 To 3)
    HiLiteColor(0) = 1 'Red
    HiLiteColor(3) = 1
    ' The alpha test is enabled by some objects so this should toggle
    ' its effects w.r.t. fragments for those objects
    If m_Alpha Then
        glAlphaFunc GL_GREATER, 0.05
    Else
        glAlphaFunc GL_ALWAYS, 0
    End If
    ' Render Normal
    For i = 1 To m_NumSceneObjs
        If Not m_ObjPick(i - 1) Then
            glCallList i
        End If
    Next
    ' Render Highlighted Objects
    glMaterialfv GL_FRONT_AND_BACK, GL_EMISSION, HiLiteColor(0)
    glNormal3f 0, 1, 0
    glEnable GL_LIGHTING
    gCtl.Lights(liLight0).Enabled = False
    For i = 1 To m_NumSceneObjs
        glPushMatrix
        'glTranslatef 0, 0.05, 0
        If m_ObjPick(i - 1) Then
            glCallList i
        End If
        glPopMatrix
    Next
    gCtl.Lights(liLight0).Enabled = True
    glDisable GL_LIGHTING
End Sub

Public Function Reshape(width&, height&) As Boolean
    m_Width = width&
    m_Height = height&
    Reshape = True
End Function

Public Sub KeyDown(KeyCode%, Shift%)
    Select Case (KeyCode)
    Case vbKeyLeft:
    Case vbKeyRight:
    Case vbKeyUp:
    Case vbKeyDown:
    Case 27:   Unload frmMain
    Case Else:
    End Select
End Sub

Public Sub KeyPress(KeyAscii As Integer)
Dim s$
    s = Chr$(KeyAscii)
    Select Case (s)
    End Select
End Sub

Public Sub DblClick()
    '
End Sub

Public Sub MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        m_bMoving = True
        m_StartX = X: m_StartY = Y
        Select Case m_InteractionMode
        Case 0: ' Motion
            If m_inmotion = MOTION_XLATE Then
                m_inmotion = MOTION_ZOOM
            Else
                m_inmotion = MOTION_ROTATE
            End If
            m_angle1grab = m_AngleX
            m_angle2grab = m_AngleY
            m_rangegrab = m_TranslateZ
            m_xgrab = X: m_ygrab = Y
        Case INTER_SELECT_GRID, INTER_SELECT_POLY, INTER_SELECT_OBJ, INTER_SELECT_COLOR
            m_DoPick = True ' pick grid in the OnDraw function
        Case INTER_SELECT_DRAG: ' object rubberband
            m_xgrab = X: m_ygrab = Y
            m_Dragging = True
        Case Else
            Exit Sub
        End Select
        gCtl.Render
    ElseIf Button = 2 Then
        If m_InteractionMode = INTER_MOTION Then
            ' TODO: Add your message handler code here and/or call default
            If m_inmotion = MOTION_ROTATE Then
                m_inmotion = MOTION_ZOOM
            Else
                m_inmotion = MOTION_XLATE
            End If
            m_rangegrab = m_TranslateZ
            m_PanXgrab = m_PanX
            m_PanYgrab = m_PanY
            m_xgrab = X
            m_ygrab = Y
            gCtl.Render
        End If
    End If
End Sub

Public Sub MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Update As Boolean
    m_MouseX = X: m_MouseY = Y
    If Button = 0 Then
        Exit Sub
    ElseIf Button = 1 Then
        If m_Dragging Then
            gCtl.Render
        End If
    Else
    End If
    m_MouseX = X
    m_MouseY = Y
    Select Case m_inmotion
    Case MOTION_ROTATE:
        m_AngleX = m_angle1grab + 0.5 * (X - m_xgrab)
        m_AngleY = m_angle2grab + 0.5 * (Y - m_ygrab)
        m_AngleX = m_AngleX Mod 360
        m_AngleY = m_AngleY Mod 360
        gCtl.Render
    Case MOTION_ZOOM:
        m_TranslateZ = m_rangegrab + 0.05 * (Y - m_ygrab)
        gCtl.Render
    Case MOTION_XLATE:
        m_PanX = m_PanXgrab + 0.05 * (X - m_xgrab)
        m_PanY = m_PanYgrab - 0.05 * (Y - m_ygrab)
        gCtl.Render
    End Select
End Sub

Public Sub MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    m_bMoving = False
    If Button = 1 Then
        Select Case m_InteractionMode
        Case INTER_MOTION: ' Motion
            If m_inmotion <> MOTION_NONE And m_inmotion <> MOTION_ROTATE Then
                m_inmotion = MOTION_XLATE
                m_PanXgrab = m_PanX
                m_PanYgrab = m_PanY
                m_xgrab = X
                m_ygrab = Y
            Else
                m_inmotion = MOTION_NONE
            End If
    
            gCtl.Render
        Case INTER_SELECT_GRID: ' grid selection
        Case INTER_SELECT_POLY: ' grid polygon selection
        Case INTER_SELECT_OBJ: ' object selection
        Case INTER_SELECT_COLOR: ' colour read pixels
        Case INTER_SELECT_DRAG: ' object rubberband
            m_DoPick = 1 ' pick grid in the OnDraw function
            m_Dragging = False
            gCtl.Render
        End Select
    ElseIf Button = 2 Then
        If m_InteractionMode = INTER_MOTION Then
            If m_inmotion <> MOTION_NONE And m_inmotion <> MOTION_XLATE Then
                m_inmotion = MOTION_ROTATE
                m_angle1grab = m_AngleX
                m_angle2grab = m_AngleY
                m_xgrab = X
                m_ygrab = Y
            Else
                m_inmotion = MOTION_NONE
            End If
    
            gCtl.Render
        End If
    End If
End Sub

Public Sub Pick(items() As Long)
Dim Name&, ptr&, i&, j&, cnt&, n&
Dim Picked&, Z#, z1!
    'bug: ocx returns right clicks
    If Not m_bMoving Then Exit Sub
    'Z = 1.79769313486232E308
    Z = 10000000000# ' a big number, limit of the data type
    Debug.Print "ocx pick''''''''''''''''''/"
    cnt = gCtl.hits
    Debug.Print "Count:" & cnt
    If cnt Then
        For i = 1 To cnt
            'Debug.Print "Name " & i & ":"
            '1.number of names on stack
                n = items(ptr)
                Debug.Print " number of names = " & n
                ptr = ptr + 1
            '2.z1
                Debug.Print " z1 = " & items(ptr)
                z1 = items(ptr)
                ptr = ptr + 1
            '3.z2
                Debug.Print " z2 = " & items(ptr)
                ptr = ptr + 1
            '4.names
            For j = 1 To n
                Debug.Print "    name " & (j) & " = " & items(ptr)
                If items(ptr) <> -1 Then
                    'get the lowest z-value, nearest node
                    If z1 < Z Then
                        Z = z1
                        Picked = items(ptr)
                    End If
                End If
                ptr = ptr + 1
            Next
        Next
    Else
        Exit Sub
    End If
    Debug.Print "Selected: " & Picked
    If Picked > 0 Then
        'gCtl.Render
    End If
End Sub

'----------------------------------------------------------------------------
Sub PickScene_Select(drag&)
Dim i&, Scount&, Sbuffer&(0 To SELSIZE - 1)
Dim CurrHit&
    Debug.Print "Picking using gl selection"
    glSelectBuffer SELSIZE, Sbuffer(0)
    glRenderMode GL_SELECT
    glInitNames
    glPushName 0

    CheckError
    If drag Then DoPickFrustumDrag _
    Else DoPickFrustum
    
    CheckError
    If drag Then glDisable GL_CULL_FACE
    ' draw the scene
    For i = 1 To m_NumSceneObjs
        glLoadName i
        glCallList i
    Next
    If drag Then
        glEnable GL_CULL_FACE
    End If
    CheckError
    UndoPickFrustum
    ' back to normal rendering
    Scount = glRenderMode(GL_RENDER)
    ' parse the selection buffer for picked data
    TraceSelect Scount, Sbuffer
    ' use pick info to highlight objects
    For i = 0 To m_NumSceneObjs - 1
        m_ObjPick(i) = False
    Next
    For i = 0 To Scount - 1
        ' we know only one name is on the stack
        m_ObjPick(Sbuffer((CurrHit + 3)) - 1) = True '  highlight this hit object
        CurrHit = CurrHit + 4 ' advance to next hit
    Next
    'Stop
    'SwapBuffers gCtl.hDC
    'Stop
End Sub

'----------------------------------------------------------------------------
'this technique uses lighting, but all lights must be disabled. Lighting is enabled
'and an emmissive color is assigned to each object by a scheme where the
'rgb values (0,1) are treated as binary values.
'----------------------------------------------------------------------------
Sub PickScene_Color()
Dim pixbuf!(0 To 30 * 30 * 3 - 1) ' buffer for rgb*20*20 for max pick size
Dim i&
Dim ps&, oby&
    Debug.Print "Picking with Colors"
    'glClear GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT 'should be clear already
    ' draw the objects with different colours on each object
    glEnable GL_LIGHTING
    gCtl.Lights(liLight0).Enabled = False
    glNormal3f 0, 1, 0
    For i = 1 To m_NumSceneObjs
        glMaterialfv GL_FRONT_AND_BACK, GL_EMISSION, PickingColors(i).p(0)
        glCallList i
    Next
    glDisable GL_LIGHTING
    ' clear pick info
    For i = 0 To m_NumSceneObjs - 1
        m_ObjPick(i) = False
    Next
    ' read framebuffer and check colours data
    ps = m_PickSize ': Debug.Print "PickSize:" & m_PickSize
    If ps < 1 Then ps = 1
    If ps > 20 Then ps = 20
    glReadPixels m_MouseX - (ps / 2), (m_Height - m_MouseY) - (ps / 2), ps, ps, GL_RGB, GL_FLOAT, pixbuf(0)
    For i = 0 To (ps * ps * 3 - 1) Step 3
        If pixbuf(i) > 0.2 Then
            oby = 1
        Else
            oby = 0
        End If
        If pixbuf(i + 1) > 0.2 Then oby = oby + 2
        If pixbuf(i + 2) > 0.2 Then oby = oby + 4
        If oby > 0 Then
            If m_ObjPick(oby - 1) = False Then
                Debug.Print "Object " & oby & " picked"
            End If
            m_ObjPick(oby - 1) = True
        End If
    Next
    'to see what is happening, uncomment the following lines:
    'glFlush
    'SwapBuffers gCtl.hDC
    'the MFC doesn't use lights, I'm experimenting to see what
    'impact they have
    gCtl.Lights(liLight0).Enabled = True
    'stop here to see the frame buffer used during picking
    'Stop
End Sub

'----------------------------------------------------------------------------
Sub PickGrid(poly&)
Dim i&, Scount&, dimension!
Dim Sbuffer&(0 To SELSIZE - 1)
Dim j&, NameCount&, CurrHit&
    Debug.Print "Picking grid lines"
    ' set up the picking buffer
    glSelectBuffer SELSIZE, Sbuffer(0)
    glRenderMode GL_SELECT
    glInitNames
    ' No need to modify the Frustum
    ' start off by pushing a name onto the stack
    glPushName 0
    DoPickFrustum
    ' draw the XZ Grid
    'glColor4f 0.25, 0.5, 0.25, 1
    If poly Then
       ' draw polygonal grid for picking
        glDisable GL_CULL_FACE
        i = 0
        For dimension = -m_GridSizeY - m_GridSpaceY * 0.5 To m_GridSizeY + m_GridSpaceY * 0.5 - m_GridSpaceY Step m_GridSpaceY
            ' name will indicate dimension
            ' stack depth will indicate axis
            glLoadName i
            glBegin GL_QUADS
            glVertex3f dimension, m_Gypos, -m_GridSizeY
            glVertex3f dimension, m_Gypos, m_GridSizeY
            glVertex3f dimension + m_GridSpaceY, m_Gypos, m_GridSizeY
            glVertex3f dimension + m_GridSpaceY, m_Gypos, -m_GridSizeY
            glEnd
            glPushName i ' push for new axis
            glBegin GL_QUADS
            glVertex3f -m_GridSizeY, m_Gypos, dimension + m_GridSpaceY
            glVertex3f m_GridSizeY, m_Gypos, dimension + m_GridSpaceY
            glVertex3f m_GridSizeY, m_Gypos, dimension
            glVertex3f -m_GridSizeY, m_Gypos, dimension
            glEnd
            glPopName ' pop to old axis
            i = i + 1
        Next
        glEnable GL_CULL_FACE
    Else
       ' draw wireline grid for picking
       i = 0
        For dimension = -m_GridSizeY To m_GridSizeY + m_GridSpaceY * 0.5 - m_GridSpaceY Step m_GridSpaceY
            ' name will indicate dimension
            ' stack depth will indicate axis
            glLoadName i
            glBegin GL_LINES
            glVertex3f dimension, m_Gypos, -m_GridSizeY
            glVertex3f dimension, m_Gypos, m_GridSizeY
            glEnd
            glPushName i ' push for new axis
            glBegin GL_LINES
            glVertex3f -m_GridSizeY, m_Gypos, dimension
            glVertex3f m_GridSizeY, m_Gypos, dimension
            glEnd
            glPopName ' pop to old axis
            i = i + 1
        Next
    End If

    UndoPickFrustum
    ' back to normal rendering
    Scount = glRenderMode(GL_RENDER)
    ' parse the selection buffer for picked data
    TraceSelect Scount, Sbuffer
    For i = 0 To Scount - 1
        NameCount = Sbuffer(CurrHit) ' number of names on stack
        CurrHit = CurrHit + 3 ' advance past name count and z min max
        For j = 0 To NameCount - 1
            If NameCount = 2 Then
                m_ZGridPick = Sbuffer(CurrHit)
            Else
                m_XGridPick = Sbuffer(CurrHit)
            End If
            CurrHit = CurrHit + 1
        Next
    Next
End Sub

'----------------------------------------------------------------------------
' RenderGrid
Private Sub m_RenderGrid()
Dim dimension!, i&
    'glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA
    glBlendFunc GL_SRC_ALPHA, GL_ONE
    glEnable GL_BLEND

    If m_AntiAlias Then
      glEnable GL_LINE_SMOOTH
      'glDepthMask GL_FALSE
    End If

    glBegin GL_LINES
    For dimension = -m_GridSizeX To m_GridSizeX + m_GridSpaceX * 0.5 - m_GridSpaceX Step m_GridSpaceX
        If i Mod 5 Then
            glColor4f 0.25, 0.25, 0.5, 1
        Else
            glColor4f 0.5, 0.5, 1, 1
        End If
        glVertex3f m_Gxpos, -m_GridSizeX, dimension
        glVertex3f m_Gxpos, m_GridSizeX, dimension
        glVertex3f m_Gxpos, dimension, -m_GridSizeX
        glVertex3f m_Gxpos, dimension, m_GridSizeX
        i = i + 1
    Next

    i = 0
    For dimension = -m_GridSizeY To m_GridSizeY + m_GridSpaceY * 0.5 - m_GridSpaceY Step m_GridSpaceY
        If i = m_XGridPick Then
            glColor4f 1, 1, 1, 1
        ElseIf i Mod 5 Then
            glColor4f 0.25, 0.5, 0.25, 1
        Else
            glColor4f 0.5, 1, 0.5, 1
        End If
        glVertex3f dimension, m_Gypos, -m_GridSizeY
        glVertex3f dimension, m_Gypos, m_GridSizeY

        If i = m_ZGridPick Then
            glColor4f 1, 1, 1, 1
        ElseIf i Mod 5 Then
            glColor4f 0.25, 0.5, 0.25, 1
        Else
            glColor4f 0.5, 1, 0.5, 1
        End If
        glVertex3f -m_GridSizeY, m_Gypos, dimension
        glVertex3f m_GridSizeY, m_Gypos, dimension
        i = i + 1
    Next

    i = 0
    For dimension = -m_GridSizeZ To m_GridSizeZ + m_GridSpaceZ * 0.5 - m_GridSpaceZ Step m_GridSpaceZ
        If i Mod 5 Then
            glColor4f 0.5, 0.25, 0.25, 1
        Else
            glColor4f 1, 0.5, 0.5, 1
        End If
        glVertex3f -m_GridSizeZ, dimension, m_Gzpos
        glVertex3f m_GridSizeZ, dimension, m_Gzpos
        glVertex3f dimension, -m_GridSizeZ, m_Gzpos
        glVertex3f dimension, m_GridSizeZ, m_Gzpos
        i = i + 1
    Next
    glEnd

    glDisable GL_BLEND

    If m_AntiAlias Then
        glDisable GL_LINE_SMOOTH
        'glDepthMask GL_TRUE
    End If
End Sub

'-----------------------------------------------------------------
Sub DoPickFrustum()
Dim viewport&(0 To 3)

    ' set up a pick region by modifying the projection
    glGetIntegerv GL_VIEWPORT, viewport(0)
    glMatrixMode GL_PROJECTION
    glPushMatrix
    'xxx use mouse position in window & pick region size
    'xxx there are other approaches including gluPickMatrix
    'we use gluPickMatrix here instead
    glLoadIdentity
     
    gluPickMatrix m_MouseX, viewport(3) - m_MouseY, m_PickSize, m_PickSize, viewport(0)
    gluPerspective 30, m_Width / m_Height, 1, 1000

    glMatrixMode GL_MODELVIEW
End Sub

'-----------------------------------------------------------------
Sub DoPickFrustumDrag()
Dim w#, h#, CX#, cy#
Dim viewport&(0 To 3)
    glGetIntegerv GL_VIEWPORT, viewport(0)
    'get the rect center
    w = Abs(m_MouseX - m_StartX)
    h = Abs(m_MouseY - m_StartY)
    If m_MouseX > m_StartX Then
        CX = m_MouseX - w \ 2
    Else
        CX = m_StartX - w \ 2
    End If
    If m_MouseY > m_StartY Then
        cy = m_MouseY - h \ 2
    Else
        cy = m_StartY - h \ 2
    End If
    ' set up a pick region by modifying the projection
    CheckError
    glMatrixMode GL_PROJECTION
    glPushMatrix
    ' use mouse position in window & pick region size
    ' there are other approaches including gluPickMatrix
    glLoadIdentity
    CheckError
    'glFrustum xpick, xpick2, ypick, ypick2, 1, 1000
    gluPickMatrix CX, m_Height - cy, w, h, viewport(0)
    gluPerspective 30, m_Width / m_Height, 1, 1000
    glMatrixMode GL_MODELVIEW
End Sub

Sub UndoPickFrustum()
    ' return the projection matrix to normal
    glMatrixMode GL_PROJECTION
    glPopMatrix
    glMatrixMode GL_MODELVIEW
End Sub

Sub TraceSelect(Scount&, Sbuffer&())
Dim i&, j&, NameCount&, CurrHit&, s$
    Debug.Print "######## TOTAL HITS = " & Scount & " ########"
    ' parse the selection buffer for picked data
    'for i=0, CurrHit = Sbuffer; i<Scount; i++)
    For i = 0 To Scount - 1
        Debug.Print "--HIT NUMBER-- = " & i
        NameCount = Sbuffer(CurrHit) ' number of names in this hit
        Debug.Print "StackDepth (NameCount) = " & NameCount
        CurrHit = CurrHit + 1
        Debug.Print "MinZ = " & Sbuffer(CurrHit)
        CurrHit = CurrHit + 1
        Debug.Print "MaxZ = " & Sbuffer(CurrHit)
        CurrHit = CurrHit + 1
        Debug.Print "Stack:"
        For j = 0 To NameCount - 1
            Select Case Sbuffer(CurrHit)
            Case 1: s = "pyramid"
            Case 2: s = "wire torus"
            Case 3: s = "b patch"
            Case 4: s = "target"
            Case 5: s = "cube"
            End Select
            Debug.Print "Name: " & Sbuffer(CurrHit) & " - " & s
            CurrHit = CurrHit + 1
        Next
    Next
End Sub


'note: this code is arranged this way because
'1) we use double buffering, so XOR rubberbands don't work well
'2) the scene can rotated with right mouse, so the projection
'needs to be calculated each time
Public Sub DrawRect()
Dim viewport&(0 To 3)
Dim modelMatrix#(0 To 15), projMatrix#(0 To 15)
Dim dy!
Dim objx#, objy#, objz#
        glGetDoublev GL_MODELVIEW_MATRIX, modelMatrix(0)
        glGetDoublev GL_PROJECTION_MATRIX, projMatrix(0)
        glGetIntegerv GL_VIEWPORT, viewport(0)
        'unproject the mousepoint at near plane
        dy = m_Height - m_StartY
        gluUnProject m_StartX, dy, 0, _
                        modelMatrix(0), projMatrix(0), viewport(0), _
                        objx, objy, objz
        m_StartPoint(0) = objx
        m_StartPoint(1) = objy
        m_StartPoint(2) = objz
        'unproject the start point
        dy = m_Height - m_MouseY
        gluUnProject m_MouseX, dy, 0, _
                        modelMatrix(0), projMatrix(0), viewport(0), _
                        objx, objy, objz

        m_EndPoint(0) = objx
        m_EndPoint(1) = objy
        m_EndPoint(2) = objz
        Debug.Print "width:" & m_StartPoint(0) - m_EndPoint(0)
        Debug.Print "height:" & m_StartPoint(1) - m_EndPoint(1)
    glPushAttrib GL_ALL_ATTRIB_BITS
        glEnable GL_LINE_STIPPLE
        glDisable GL_LIGHTING
        glLineStipple 1, &HAAAA
        glDepthFunc GL_ALWAYS
        glColor3d 1, 0.5, 0.5
        glBegin GL_LINE_LOOP
            glVertex3d m_StartPoint(0), m_StartPoint(1), m_StartPoint(2)
            glVertex3d m_EndPoint(0), m_StartPoint(1), m_StartPoint(2)
            glVertex3d m_EndPoint(0), m_EndPoint(1), m_StartPoint(2)
            glVertex3d m_StartPoint(0), m_EndPoint(1), m_StartPoint(2)
        glEnd
    glPopAttrib
End Sub