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, 16 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.