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

Last change on this file since 690 was 690, checked in by NoWest, 15 years ago

本格的に作り始めました。
まだ、仕様を厳密に決めていないので
これを使って何か作るということはまだしないでください。

(#240)

File size: 10.2 KB
Line 
1#require <gl\gl.sbp>
2#require <gl\glu.sbp>
3
4/*
5Const PFD_TYPE_RGBA = 0
6Const PFD_TYPE_COLORINDEX = 1
7
8Const PFD_MAIN_PLANE = 0
9Const PFD_OVERLAY_PLANE = 1
10Const PFD_UNDERLAY_PLANE = (-1)
11
12Const PFD_DOUBLEBUFFER = &H00000001
13Const PFD_STEREO = &H00000002
14Const PFD_DRAW_TO_WINDOW = &H00000004
15Const PFD_DRAW_TO_BITMAP = &H00000008
16Const PFD_SUPPORT_GDI = &H00000010
17Const PFD_SUPPORT_OPENGL = &H00000020
18Const PFD_GENERIC_FORMAT = &H00000040
19Const PFD_NEED_PALETTE = &H00000080
20Const PFD_NEED_SYSTEM_PALETTE = &H00000100
21Const PFD_SWAP_EXCHANGE = &H00000200
22Const PFD_SWAP_COPY = &H00000400
23Const PFD_SWAP_LAYER_BUFFERS = &H00000800
24Const PFD_GENERIC_ACCELERATED = &H00001000
25Const PFD_SUPPORT_DIRECTDRAW = &H00002000
26
27Const PFD_DEPTH_DONTCARE = &H20000000
28Const PFD_DOUBLEBUFFER_DONTCARE = &H40000000
29Const PFD_STEREO_DONTCARE = &H80000000
30
31Type PIXELFORMATDESCRIPTOR
32    nSize As Word
33    nVersion As Word
34    dwFlags As DWord
35    iPixelType As Byte
36    cColorBits As Byte
37    cRedBits As Byte
38    cRedShift As Byte
39    cGreenBits As Byte
40    cGreenShift As Byte
41    cBlueBits As Byte
42    cBlueShift As Byte
43    cAlphaBits As Byte
44    cAlphaShift As Byte
45    cAccumBits As Byte
46    cAccumRedBits As Byte
47    cAccumGreenBits As Byte
48    cAccumBlueBits As Byte
49    cAccumAlphaBits As Byte
50    cDepthBits As Byte
51    cStencilBits As Byte
52    cAuxBuffers As Byte
53    iLayerType As Byte
54    bReserved As Byte
55    dwLayerMask As DWord
56    dwVisibleMask As DWord
57    dwDamageMask As DWord
58End Type
59*/
60
61Namespace ActiveBasic
62Namespace OpenGL
63
64    Class AlphaTestManager
65    Public
66        Sub AlphaFunction(func As DWord)
67            glAlphaFunc(func,ReferenceAlpha())
68        End Sub
69        Function AlphaFunction() As DWord
70            glGetIntegerv(GL_ALPHA_TEST_FUNC,VarPtr(AlphaFunction))
71        End Function
72        Sub ReferenceAlpha(ref As Single)
73            glAlphaFunc(AlphaFunction,ref)
74        End Sub
75        Function ReferenceAlpha() As Single
76            glGetFloatv(GL_ALPHA_TEST_REF,VarPtr(ReferenceAlpha))
77        End Function
78    End Class
79
80    Class BlendManager
81    Public
82        Sub Destination(dest As DWord)
83            glBlendFunc(Source(),dest)
84        End Sub
85        Function Destination() As DWord
86            glGetIntegerv(GL_BLEND_DST,VarPtr(Destination))
87        End Function
88        Sub Source(src As DWord)
89            glBlendFunc(src,Destination())
90        End Sub
91        Function Source() As DWord
92            glGetIntegerv(GL_BLEND_SRC,VarPtr(Source))
93        End Function
94    End Class
95
96    Class ClientStateManager
97    Public
98        Sub ColorArrayEnable(enable As Boolean)
99            setEnable(GL_COLOR_ARRAY,enable)
100        End Sub
101        Function ColorArrayEnable() As Boolean
102            Return getEnable(GL_COLOR_ARRAY)
103        End Function
104        Sub EdgeFlagArrayEnable(enable As Boolean)
105            setEnable(GL_EDGE_FLAG_ARRAY,enable)
106        End Sub
107        Function EdgeFlagArrayEnable() As Boolean
108            Return getEnable(GL_EDGE_FLAG_ARRAY)
109        End Function
110        Sub IndexArrayEnable(enable As Boolean)
111            setEnable(GL_INDEX_ARRAY,enable)
112        End Sub
113        Function IndexArrayEnable() As Boolean
114            Return getEnable(GL_INDEX_ARRAY)
115        End Function
116        Sub NormalArrayEnable(enable As Boolean)
117            setEnable(GL_NORMAL_ARRAY,enable)
118        End Sub
119        Function NormalArrayEnable() As Boolean
120            Return getEnable(GL_NORMAL_ARRAY)
121        End Function
122        Sub TextureCoordArrayEnable(enable As Boolean)
123            setEnable(GL_TEXTURE_COORD_ARRAY,enable)
124        End Sub
125        Function TextureCoordArrayEnable() As Boolean
126            Return getEnable(GL_TEXTURE_COORD_ARRAY)
127        End Function
128        Sub VertexArrayEnable(enable As Boolean)
129            setEnable(GL_VERTEX_ARRAY,enable)
130        End Sub
131        Function VertexArrayEnable() As Boolean
132            Return getEnable(GL_VERTEX_ARRAY)
133        End Function
134
135    Private
136        Sub setEnable(cap As DWord, enable As Boolean)
137            If enable Then
138                glEnable(cap)
139            Else
140                glDisable(cap)
141            End If
142        End Sub
143        Function getEnable(cap As DWord) As Boolean
144            Dim b As Byte
145            glGetBooleanv(cap,VarPtr(b))
146            Return b
147        End Function
148    End Class
149
150    Class FogManager
151    Public
152        Sub Density(dens As Single)
153            glFogf(GL_FOG_DENSITY,dens)
154        End Sub
155        Function Density() As Single
156            glGetFloatv(GL_FOG_DENSITY,VarPtr(Density))
157        End Function
158        Sub End(end As Single)
159            glFogf(GL_FOG_END,end)
160        End Sub
161        Function End() As Single
162            glGetFloatv(GL_FOG_END,VarPtr(End))
163        End Function
164        Sub Mode(mode As DWord)
165            glFogi(GL_FOG_MODE,mode)
166        End Sub
167        Function Mode() As DWord
168            glGetIntegerv(GL_FOG_MODE,VarPtr(Mode))
169        End Function
170        Sub Start(start As Single)
171            glFogf(GL_FOG_START,start)
172        End Sub
173        Function Start() As Single
174            glGetFloatv(GL_FOG_START,VarPtr(Start))
175        End Function
176
177    Public
178        Sub FogColor(red As Single, green As Single, blue As Single, alpha As Single)
179            Dim c[3] As Single
180            glFogfv(GL_FOG_COLOR,c)
181        End Sub
182
183    Private
184    End Class
185
186    Class ServerStateManager
187    Public
188        Sub AlphaTestEnable(enable As Boolean)
189            setEnable(GL_ALPHA_TEST,enable)
190        End Sub
191        Function AlphaTestEnable() As Boolean
192            Return getEnable(GL_ALPHA_TEST)
193        End Function
194        Sub AutoNormalEnable(enable As Boolean)
195            setEnable(GL_AUTO_NORMAL,enable)
196        End Sub
197        Function AutoNormalEnable() As Boolean
198            Return getEnable(GL_AUTO_NORMAL)
199        End Function
200        Sub BlendEnable(enable As Boolean)
201            setEnable(GL_BLEND,enable)
202        End Sub
203        Function BlendEnable() As Boolean
204            Return getEnable(GL_BLEND)
205        End Function
206        Sub CullFaceEnable(enable As Boolean)
207            setEnable(GL_CULL_FACE,enable)
208        End Sub
209        Function CullFaceEnable() As Boolean
210            Return getEnable(GL_CULL_FACE)
211        End Function
212        Sub DepthTestEnable(enable As Boolean)
213            setEnable(GL_DEPTH_TEST,enable)
214        End Sub
215        Function DepthTestEnable() As Boolean
216            Return getEnable(GL_DEPTH_TEST)
217        End Function
218        Sub FogEnable(enable As Boolean)
219            setEnable(GL_FOG,enable)
220        End Sub
221        Function FogEnable() As Boolean
222            Return getEnable(GL_FOG)
223        End Function
224        Sub LightingEnable(enable As Boolean)
225            setEnable(GL_LIGHTING,enable)
226        End Sub
227        Function LightingEnable() As Boolean
228            Return getEnable(GL_LIGHTING)
229        End Function
230        Sub LineSmoothEnable(enable As Boolean)
231            setEnable(GL_LINE_SMOOTH,enable)
232        End Sub
233        Function LineSmoothEnable() As Boolean
234            Return getEnable(GL_LINE_SMOOTH)
235        End Function
236        Sub LineStippleEnable(enable As Boolean)
237            setEnable(GL_LINE_STIPPLE,enable)
238        End Sub
239        Function LineStippleEnable() As Boolean
240            Return getEnable(GL_LINE_STIPPLE)
241        End Function
242        Sub NormalizeEnable(enable As Boolean)
243            setEnable(GL_NORMALIZE,enable)
244        End Sub
245        Function NormalizeEnable() As Boolean
246            Return getEnable(GL_NORMALIZE)
247        End Function
248        Sub PointSmoothEnable(enable As Boolean)
249            setEnable(GL_POINT_SMOOTH,enable)
250        End Sub
251        Function PointSmoothEnable() As Boolean
252            Return getEnable(GL_POINT_SMOOTH)
253        End Function
254        Sub PolygonSmoothEnable(enable As Boolean)
255            setEnable(GL_POLYGON_SMOOTH,enable)
256        End Sub
257        Function PolygonSmoothEnable() As Boolean
258            Return getEnable(GL_POLYGON_SMOOTH)
259        End Function
260        Sub StencilTestEnable(enable As Boolean)
261            setEnable(GL_STENCIL_TEST,enable)
262        End Sub
263        Function StencilTestEnable() As Boolean
264            Return getEnable(GL_STENCIL_TEST)
265        End Function
266        Sub Texture1DEnable(enable As Boolean)
267            setEnable(GL_TEXTURE_1D,enable)
268        End Sub
269        Function Texture1DEnable() As Boolean
270            Return getEnable(GL_TEXTURE_1D)
271        End Function
272        Sub Texture2DEnable(enable As Boolean)
273            setEnable(GL_TEXTURE_2D,enable)
274        End Sub
275        Function Texture2DEnable() As Boolean
276            Return getEnable(GL_TEXTURE_2D)
277        End Function
278
279    Private
280        Sub setEnable(cap As DWord, enable As Boolean)
281            If enable Then
282                glEnable(cap)
283            Else
284                glDisable(cap)
285            End If
286        End Sub
287        Function getEnable(cap As DWord) As Boolean
288            Dim b As Byte
289            glGetBooleanv(cap,VarPtr(b))
290            Return b
291        End Function
292    End Class
293
294
295    Class Context
296    Public /* constructor & destructor */
297        Sub Context(hdc As HDC)
298            Dim pfd = [
299            SizeOf(PIXELFORMATDESCRIPTOR),  ' size of this pfd
300            1,                              ' version number
301            PFD_DRAW_TO_WINDOW or_            ' support window
302              PFD_SUPPORT_OPENGL or_          ' support OpenGL
303              PFD_DOUBLEBUFFER,             ' double buffered
304            PFD_TYPE_RGBA,                  ' RGBA type
305            32,                             ' 24-bit color depth
306            0, 0, 0, 0, 0, 0,               ' color bits ignored
307            8,                              ' 8-bit alpha buffer
308            0,                              ' shift bit ignored
309            0,                              ' no accumulation buffer
310            0, 0, 0, 0,                     ' accum bits ignored
311            32,                             ' 32-bit z-buffer
312            8,                              ' 8-bit stencil buffer
313            0,                              ' no auxiliary buffer
314            PFD_MAIN_PLANE,                 ' main layer
315            0,                              ' reserved
316            0, 0, 0
317            ] As PIXELFORMATDESCRIPTOR
318
319
320            Dim pfmt As Long
321
322            pfmt=ChoosePixelFormat(hdc, pfd)
323            If pfmt = 0 Then
324                OutputDebugString(Ex"ChoosePixelFormat failed\n")
325                'Throw
326            End If
327
328            If SetPixelFormat(hdc, pfmt, pfd) = FALSE Then
329                OutputDebugString(Ex"SetPixelFormat failed\n")
330                'MessageBox("SetPixelFormat failed");
331                'Throw
332            End If
333
334            hrc = wglCreateContext(hdc)
335            wglMakeCurrent(hdc, hrc)
336
337        End Sub
338        Sub ~Context()
339            wglMakeCurrent(NULL, NULL)
340            wglDeleteContext(hrc)
341        End Sub
342
343    Public /* property */
344        Function AlphaTest() As AlphaTestManager
345            Return New AlphaTestManager
346        End Function
347        Function ClientState() As ClientStateManager
348            Return New ClientStateManager
349        End Function
350        Function Fog() As FogManager
351            Return New FogManager
352        End Function
353        Function ServerState() As ServerStateManager
354            Return New ServerStateManager
355        End Function
356
357    Public /* method */
358        Sub Clear(mask As DWord)
359            glClear(mask)
360        End Sub
361        Sub ClearAccum(red As Single, green As Single, blue As Single, alpha As Single)
362            glClearAccum(red,green,blue,alpha)
363        End Sub
364        Sub ClearColor(red As Single, green As Single, blue As Single, alpha As Single)
365            glClearColor(red,green,blue,alpha)
366        End Sub
367        Sub ClearDepth(depth As Single)
368            glClearDepth(depth)
369        End Sub
370        Sub ClearIndex(index As Single)
371            glClearIndex(index)
372        End Sub
373        Sub ClearStencil()
374        End Sub
375        Sub Begin(mode As DWord)
376            glBegin(mode)
377        End Sub
378        Sub End()
379            glEnd()
380        End Sub
381
382        Sub SwapBuffer()
383            SwapBuffers(wglGetCurrentDC())
384        End Sub
385    Private
386        hrc As HGLRC
387    End Class
388
389End Namespace
390End Namespace
Note: See TracBrowser for help on using the repository browser.