source: trunk/ab5.0/ablib/src/Classes/ActiveBasic/OpenGL/Context.ab @ 690

#require <gl\gl.sbp>
#require <gl\glu.sbp>

/*
Const PFD_TYPE_RGBA = 0
Const PFD_TYPE_COLORINDEX = 1

Const PFD_MAIN_PLANE = 0
Const PFD_OVERLAY_PLANE = 1
Const PFD_UNDERLAY_PLANE = (-1)

Const PFD_DOUBLEBUFFER = &H00000001
Const PFD_STEREO = &H00000002
Const PFD_DRAW_TO_WINDOW = &H00000004
Const PFD_DRAW_TO_BITMAP = &H00000008
Const PFD_SUPPORT_GDI = &H00000010
Const PFD_SUPPORT_OPENGL = &H00000020
Const PFD_GENERIC_FORMAT = &H00000040
Const PFD_NEED_PALETTE = &H00000080
Const PFD_NEED_SYSTEM_PALETTE = &H00000100
Const PFD_SWAP_EXCHANGE = &H00000200
Const PFD_SWAP_COPY = &H00000400
Const PFD_SWAP_LAYER_BUFFERS = &H00000800
Const PFD_GENERIC_ACCELERATED = &H00001000
Const PFD_SUPPORT_DIRECTDRAW = &H00002000

Const PFD_DEPTH_DONTCARE = &H20000000
Const PFD_DOUBLEBUFFER_DONTCARE = &H40000000
Const PFD_STEREO_DONTCARE = &H80000000

Type PIXELFORMATDESCRIPTOR
    nSize As Word
    nVersion As Word
    dwFlags As DWord
    iPixelType As Byte
    cColorBits As Byte
    cRedBits As Byte
    cRedShift As Byte
    cGreenBits As Byte
    cGreenShift As Byte
    cBlueBits As Byte
    cBlueShift As Byte
    cAlphaBits As Byte
    cAlphaShift As Byte
    cAccumBits As Byte
    cAccumRedBits As Byte
    cAccumGreenBits As Byte
    cAccumBlueBits As Byte
    cAccumAlphaBits As Byte
    cDepthBits As Byte
    cStencilBits As Byte
    cAuxBuffers As Byte
    iLayerType As Byte
    bReserved As Byte
    dwLayerMask As DWord
    dwVisibleMask As DWord
    dwDamageMask As DWord
End Type
*/

Namespace ActiveBasic
Namespace OpenGL

    Class AlphaTestManager
    Public
        Sub AlphaFunction(func As DWord)
            glAlphaFunc(func,ReferenceAlpha())
        End Sub
        Function AlphaFunction() As DWord
            glGetIntegerv(GL_ALPHA_TEST_FUNC,VarPtr(AlphaFunction))
        End Function
        Sub ReferenceAlpha(ref As Single)
            glAlphaFunc(AlphaFunction,ref)
        End Sub
        Function ReferenceAlpha() As Single
            glGetFloatv(GL_ALPHA_TEST_REF,VarPtr(ReferenceAlpha))
        End Function
    End Class

    Class BlendManager
    Public
        Sub Destination(dest As DWord)
            glBlendFunc(Source(),dest)
        End Sub
        Function Destination() As DWord
            glGetIntegerv(GL_BLEND_DST,VarPtr(Destination))
        End Function
        Sub Source(src As DWord)
            glBlendFunc(src,Destination())
        End Sub
        Function Source() As DWord
            glGetIntegerv(GL_BLEND_SRC,VarPtr(Source))
        End Function
    End Class

    Class ClientStateManager
    Public
        Sub ColorArrayEnable(enable As Boolean)
            setEnable(GL_COLOR_ARRAY,enable)
        End Sub
        Function ColorArrayEnable() As Boolean
            Return getEnable(GL_COLOR_ARRAY)
        End Function
        Sub EdgeFlagArrayEnable(enable As Boolean)
            setEnable(GL_EDGE_FLAG_ARRAY,enable)
        End Sub
        Function EdgeFlagArrayEnable() As Boolean
            Return getEnable(GL_EDGE_FLAG_ARRAY)
        End Function
        Sub IndexArrayEnable(enable As Boolean)
            setEnable(GL_INDEX_ARRAY,enable)
        End Sub
        Function IndexArrayEnable() As Boolean
            Return getEnable(GL_INDEX_ARRAY)
        End Function
        Sub NormalArrayEnable(enable As Boolean)
            setEnable(GL_NORMAL_ARRAY,enable)
        End Sub
        Function NormalArrayEnable() As Boolean
            Return getEnable(GL_NORMAL_ARRAY)
        End Function
        Sub TextureCoordArrayEnable(enable As Boolean)
            setEnable(GL_TEXTURE_COORD_ARRAY,enable)
        End Sub
        Function TextureCoordArrayEnable() As Boolean
            Return getEnable(GL_TEXTURE_COORD_ARRAY)
        End Function
        Sub VertexArrayEnable(enable As Boolean)
            setEnable(GL_VERTEX_ARRAY,enable)
        End Sub
        Function VertexArrayEnable() As Boolean
            Return getEnable(GL_VERTEX_ARRAY)
        End Function

    Private
        Sub setEnable(cap As DWord, enable As Boolean)
            If enable Then
                glEnable(cap)
            Else
                glDisable(cap)
            End If
        End Sub
        Function getEnable(cap As DWord) As Boolean
            Dim b As Byte
            glGetBooleanv(cap,VarPtr(b))
            Return b
        End Function
    End Class

    Class FogManager
    Public
        Sub Density(dens As Single)
            glFogf(GL_FOG_DENSITY,dens)
        End Sub
        Function Density() As Single
            glGetFloatv(GL_FOG_DENSITY,VarPtr(Density))
        End Function
        Sub End(end As Single)
            glFogf(GL_FOG_END,end)
        End Sub
        Function End() As Single
            glGetFloatv(GL_FOG_END,VarPtr(End))
        End Function
        Sub Mode(mode As DWord)
            glFogi(GL_FOG_MODE,mode)
        End Sub
        Function Mode() As DWord
            glGetIntegerv(GL_FOG_MODE,VarPtr(Mode))
        End Function
        Sub Start(start As Single)
            glFogf(GL_FOG_START,start)
        End Sub
        Function Start() As Single
            glGetFloatv(GL_FOG_START,VarPtr(Start))
        End Function

    Public
        Sub FogColor(red As Single, green As Single, blue As Single, alpha As Single)
            Dim c[3] As Single
            glFogfv(GL_FOG_COLOR,c)
        End Sub

    Private
    End Class

    Class ServerStateManager
    Public
        Sub AlphaTestEnable(enable As Boolean)
            setEnable(GL_ALPHA_TEST,enable)
        End Sub
        Function AlphaTestEnable() As Boolean
            Return getEnable(GL_ALPHA_TEST)
        End Function
        Sub AutoNormalEnable(enable As Boolean)
            setEnable(GL_AUTO_NORMAL,enable)
        End Sub
        Function AutoNormalEnable() As Boolean
            Return getEnable(GL_AUTO_NORMAL)
        End Function
        Sub BlendEnable(enable As Boolean)
            setEnable(GL_BLEND,enable)
        End Sub
        Function BlendEnable() As Boolean
            Return getEnable(GL_BLEND)
        End Function
        Sub CullFaceEnable(enable As Boolean)
            setEnable(GL_CULL_FACE,enable)
        End Sub
        Function CullFaceEnable() As Boolean
            Return getEnable(GL_CULL_FACE)
        End Function
        Sub DepthTestEnable(enable As Boolean)
            setEnable(GL_DEPTH_TEST,enable)
        End Sub
        Function DepthTestEnable() As Boolean
            Return getEnable(GL_DEPTH_TEST)
        End Function
        Sub FogEnable(enable As Boolean)
            setEnable(GL_FOG,enable)
        End Sub
        Function FogEnable() As Boolean
            Return getEnable(GL_FOG)
        End Function
        Sub LightingEnable(enable As Boolean)
            setEnable(GL_LIGHTING,enable)
        End Sub
        Function LightingEnable() As Boolean
            Return getEnable(GL_LIGHTING)
        End Function
        Sub LineSmoothEnable(enable As Boolean)
            setEnable(GL_LINE_SMOOTH,enable)
        End Sub
        Function LineSmoothEnable() As Boolean
            Return getEnable(GL_LINE_SMOOTH)
        End Function
        Sub LineStippleEnable(enable As Boolean)
            setEnable(GL_LINE_STIPPLE,enable)
        End Sub
        Function LineStippleEnable() As Boolean
            Return getEnable(GL_LINE_STIPPLE)
        End Function
        Sub NormalizeEnable(enable As Boolean)
            setEnable(GL_NORMALIZE,enable)
        End Sub
        Function NormalizeEnable() As Boolean
            Return getEnable(GL_NORMALIZE)
        End Function
        Sub PointSmoothEnable(enable As Boolean)
            setEnable(GL_POINT_SMOOTH,enable)
        End Sub
        Function PointSmoothEnable() As Boolean
            Return getEnable(GL_POINT_SMOOTH)
        End Function
        Sub PolygonSmoothEnable(enable As Boolean)
            setEnable(GL_POLYGON_SMOOTH,enable)
        End Sub
        Function PolygonSmoothEnable() As Boolean
            Return getEnable(GL_POLYGON_SMOOTH)
        End Function
        Sub StencilTestEnable(enable As Boolean)
            setEnable(GL_STENCIL_TEST,enable)
        End Sub
        Function StencilTestEnable() As Boolean
            Return getEnable(GL_STENCIL_TEST)
        End Function
        Sub Texture1DEnable(enable As Boolean)
            setEnable(GL_TEXTURE_1D,enable)
        End Sub
        Function Texture1DEnable() As Boolean
            Return getEnable(GL_TEXTURE_1D)
        End Function
        Sub Texture2DEnable(enable As Boolean)
            setEnable(GL_TEXTURE_2D,enable)
        End Sub
        Function Texture2DEnable() As Boolean
            Return getEnable(GL_TEXTURE_2D)
        End Function

    Private
        Sub setEnable(cap As DWord, enable As Boolean)
            If enable Then
                glEnable(cap)
            Else
                glDisable(cap)
            End If
        End Sub
        Function getEnable(cap As DWord) As Boolean
            Dim b As Byte
            glGetBooleanv(cap,VarPtr(b))
            Return b
        End Function
    End Class


    Class Context
    Public /* constructor & destructor */
        Sub Context(hdc As HDC)
            Dim pfd = [
            SizeOf(PIXELFORMATDESCRIPTOR),  ' size of this pfd
            1,                              ' version number
            PFD_DRAW_TO_WINDOW or_            ' support window
              PFD_SUPPORT_OPENGL or_          ' support OpenGL
              PFD_DOUBLEBUFFER,             ' double buffered
            PFD_TYPE_RGBA,                  ' RGBA type
            32,                             ' 24-bit color depth
            0, 0, 0, 0, 0, 0,               ' color bits ignored
            8,                              ' 8-bit alpha buffer
            0,                              ' shift bit ignored
            0,                              ' no accumulation buffer
            0, 0, 0, 0,                     ' accum bits ignored
            32,                             ' 32-bit z-buffer
            8,                              ' 8-bit stencil buffer
            0,                              ' no auxiliary buffer
            PFD_MAIN_PLANE,                 ' main layer
            0,                              ' reserved
            0, 0, 0
            ] As PIXELFORMATDESCRIPTOR


            Dim pfmt As Long

            pfmt=ChoosePixelFormat(hdc, pfd)
            If pfmt = 0 Then
                OutputDebugString(Ex"ChoosePixelFormat failed\n")
                'Throw 
            End If

            If SetPixelFormat(hdc, pfmt, pfd) = FALSE Then
                OutputDebugString(Ex"SetPixelFormat failed\n")
                'MessageBox("SetPixelFormat failed");
                'Throw 
            End If

            hrc = wglCreateContext(hdc)
            wglMakeCurrent(hdc, hrc)

        End Sub
        Sub ~Context()
            wglMakeCurrent(NULL, NULL)
            wglDeleteContext(hrc)
        End Sub

    Public /* property */
        Function AlphaTest() As AlphaTestManager
            Return New AlphaTestManager
        End Function
        Function ClientState() As ClientStateManager
            Return New ClientStateManager
        End Function
        Function Fog() As FogManager
            Return New FogManager
        End Function
        Function ServerState() As ServerStateManager
            Return New ServerStateManager
        End Function

    Public /* method */
        Sub Clear(mask As DWord)
            glClear(mask)
        End Sub
        Sub ClearAccum(red As Single, green As Single, blue As Single, alpha As Single)
            glClearAccum(red,green,blue,alpha)
        End Sub
        Sub ClearColor(red As Single, green As Single, blue As Single, alpha As Single)
            glClearColor(red,green,blue,alpha)
        End Sub
        Sub ClearDepth(depth As Single)
            glClearDepth(depth)
        End Sub
        Sub ClearIndex(index As Single)
            glClearIndex(index)
        End Sub
        Sub ClearStencil()
        End Sub
        Sub Begin(mode As DWord)
            glBegin(mode)
        End Sub
        Sub End()
            glEnd()
        End Sub

        Sub SwapBuffer()
            SwapBuffers(wglGetCurrentDC())
        End Sub
    Private
        hrc As HGLRC
    End Class

End Namespace
End Namespace