Gambas France BETA


Pas de compte ? Incription

OpenGL

3DWebCam



1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
' Gambas module file

PRIVATE hWebCam AS VideoDevice
PRIVATE CONST ScrWidth AS INTEGER = 640
PRIVATE CONST ScrHeight AS INTEGER = 480

' Needed for frame count
PRIVATE Frames AS INTEGER
PRIVATE CTime AS FLOAT

' Rotations
PRIVATE xrot AS FLOAT
PRIVATE yrot AS FLOAT
PRIVATE zrot AS FLOAT

' texture
PRIVATE textures AS NEW Integer[]
PRIVATE Screen AS NEW Window(TRUE) AS "Screen"

PRIVATE logo AS Image
PRIVATE tmpLogo AS Image
PRIVATE hTimer AS NEW Timer AS "Timer1"
PRIVATE count AS INTEGER
PRIVATE UpdateLogo AS BOOLEAN

PUBLIC SUB Main()

TRY hWebCam = NEW VideoDevice("/dev/video0")
IF ERROR THEN
PRINT ("Unable to open video device")
RETURN

END IF
hWebCam.Hue = 10
hWebCam.Color = 10
hWebcam.Resize(320, 240)

logo = hWebCam.Image
logo.Resize(256, 256)

screen.Width = ScrWidth
screen.Height = ScrHeight
Screen.show()
Screen.Resizable = TRUE
InitGL()
textures = Gl.GenTextures(1)
LoadTextures()
Screen_resize()
CTime = Timer()
hTimer.Delay = 200
hTimer.Enabled = TRUE

END

PUBLIC SUB LoadTextures()

Gl.BindTexture(gl.TEXTURE_2D, textures[0])
Gl.TexImage2D(logo)
Gl.TexParameteri(gl.TEXTURE_2D, gl.TEXTURE_MIN_FILTER, gl.LINEAR)
Gl.TexParameteri(gl.TEXTURE_2D, gl.TEXTURE_MAG_FILTER, gl.LINEAR)

END

PUBLIC SUB InitGL()

' Enable smooth shading
Gl.ShadeModel(gl.SMOOTH)
' Set the background black
Gl.ClearColor(0.0, 0.0, 0.0, 0.5)
' Depth buffer setup
Gl.ClearDepth(1.0)
' Enables Depth Testing
Gl.Enable(gl.DEPTH_TEST)
' Enable texturing
Gl.Enable(gl.TEXTURE_2D)
' The Type OF Depth Test TO DO
Gl.DepthFunc(gl.LESS)
' Really Nice Perspective Calculations
Gl.Hint(gl.PERSPECTIVE_CORRECTION_HINT, gl.NICEST)

END

PUBLIC SUB Screen_close()

' Delete textures if needed
IF (textures.count > 0) THEN Gl.DeleteTextures(textures)

END

PUBLIC SUB Screen_resize()

' Width/Height Ratio
DIM ratio AS FLOAT
DIM Height AS INTEGER

Height = Screen.Height
' Protect against a divide by zero
IF Height = 0 THEN Height = 1

ratio = Screen.Width / Height

' Setup our viewport
Gl.Viewport(0, 0, Screen.Width, Screen.Height)
' change to the projection matrix AND set our viewing volume.
Gl.MatrixMode(gl.PROJECTION)
Gl.LoadIdentity()

' Set our perspective
Glu.Perspective(45.0, ratio, 0.1, 100.0)

' Make sure we're changing the model view and not the projection
Gl.MatrixMode(gl.MODELVIEW)
GL.LoadIdentity()

END

PUBLIC SUB Screen_Draw()

DIM calc AS FLOAT

INC count
IF UpdateLogo THEN
'count = 0
'logo = tmpLogo
logo.Resize(256, 256)
LoadTextures()
UpdateLogo = FALSE
ENDIF

Gl.Clear(gl.COLOR_BUFFER_BIT OR gl.DEPTH_BUFFER_BIT)

Gl.LoadIdentity()
Gl.Translatef(0.0, 0.0, -5.0)

Gl.Rotatef(xrot, 1.0, 0.0, 0.0) ' Rotate On The X Axis
Gl.Rotatef(yrot, 0.0, 1.0, 0.0) ' Rotate On The Y Axis
Gl.Rotatef(zrot, 0.0, 0.0, 1.0) ' Rotate On The Z Axis

' Select our texture
Gl.BindTexture(gl.TEXTURE_2D, textures[0])

Gl.Begin(gl.QUADS)
' front face
' Bottom Left OF The Texture AND Quad
Gl.TexCoord2f(0.0, 1.0)
Gl.Vertex3f(-1.0, -1.0, 1.0)
' Bottom Right OF The Texture AND Quad
Gl.TexCoord2f(1.0, 1.0)
Gl.Vertex3f(1.0, -1.0, 1.0)
' Top Right OF The Texture AND Quad
Gl.TexCoord2f(1.0, 0.0)
Gl.Vertex3f(1.0, 1.0, 1.0)
' Top Left OF The Texture AND Quad
Gl.TexCoord2f(0.0, 0.0)
Gl.Vertex3f(-1.0, 1.0, 1.0)

' Back face
' Bottom Right OF The Texture AND Quad
Gl.TexCoord2f(0.0, 0.0)
Gl.Vertex3f(-1.0, -1.0, -1.0)
' Top Right OF The Texture AND Quad
Gl.TexCoord2f(0.0, 1.0)
Gl.Vertex3f(-1.0, 1.0, -1.0)
' Top Left OF The Texture AND Quad
Gl.TexCoord2f(1.0, 1.0)
Gl.Vertex3f(1.0, 1.0, -1.0)
' Bottom Left OF The Texture AND Quad
Gl.TexCoord2f(1.0, 0.0)
Gl.Vertex3f(1.0, -1.0, -1.0)

' Top face
' Top Left OF The Texture AND Quad
Gl.TexCoord2f(1.0, 1.0)
Gl.Vertex3f(-1.0, 1.0, -1.0)
' Bottom Left OF The Texture AND Quad
Gl.TexCoord2f(1.0, 0.0)
Gl.Vertex3f(-1.0, 1.0, 1.0)
' Bottom Right OF The Texture AND Quad
Gl.TexCoord2f(0.0, 0.0)
Gl.Vertex3f(1.0, 1.0, 1.0)
' Top Right OF The Texture AND Quad
Gl.TexCoord2f(0.0, 1.0)
Gl.Vertex3f(1.0, 1.0, -1.0)

' Bottom ace
' Top Right OF The Texture AND Quad
Gl.TexCoord2f(0.0, 1.0)
Gl.Vertex3f(-1.0, -1.0, -1.0)
' Top Left OF The Texture AND Quad
Gl.TexCoord2f(1.0, 1.0)
Gl.Vertex3f(1.0, -1.0, -1.0)
' Bottom Left OF The Texture AND Quad
Gl.TexCoord2f(1.0, 0.0)
Gl.Vertex3f(1.0, -1.0, 1.0)
' Bottom Right OF The Texture AND Quad
Gl.TexCoord2f(0.0, 0.0)
Gl.Vertex3f(-1.0, -1.0, 1.0)

' Right face
' Bottom Right OF The Texture AND Quad
Gl.TexCoord2f(0.0, 0.0)
Gl.Vertex3f(1.0, -1.0, -1.0)
' Top Right OF The Texture AND Quad
Gl.TexCoord2f(0.0, 1.0)
Gl.Vertex3f(1.0, 1.0, -1.0)
' Top Left OF The Texture AND Quad
Gl.TexCoord2f(1.0, 1.0)
Gl.Vertex3f(1.0, 1.0, 1.0)
' Bottom Left OF The Texture AND Quad
Gl.TexCoord2f(1.0, 0.0)
Gl.Vertex3f(1.0, -1.0, 1.0)

' Left face
' Bottom Left OF The Texture AND Quad
Gl.TexCoord2f(1.0, 0.0)
Gl.Vertex3f(-1.0, -1.0, -1.0)
' Bottom Right OF The Texture AND Quad
Gl.TexCoord2f(0.0, 0.0)
Gl.Vertex3f(-1.0, -1.0, 1.0)
' Top Right OF The Texture AND Quad
Gl.TexCoord2f(0.0, 1.0)
Gl.Vertex3f(-1.0, 1.0, 1.0)
' Top Left OF The Texture AND Quad
Gl.TexCoord2f(1.0, 1.0)
Gl.Vertex3f(-1.0, 1.0, -1.0)

Gl.End()

INC (Frames)
IF (Timer() > CTime + 5) THEN
calc = Timer() - CTime
PRINT CStr(Frames) & " " & ("frames in") & " " & Format$(calc, "#.0") & " " & ("seconds =") & " " & Format$((Frames / calc), "######.000") & " " & ("FPS")
Frames = 0
CTime = Timer()
ENDIF

xrot += 0.3 ' X Axis Rotation
yrot += 0.2 ' Y Axis Rotation
zrot += 0.4 ' Z Axis Rotation
SLEEP 0.05

END

PUBLIC SUB Screen_keyPress()

IF key.Code = key.F1 THEN Screen.Fullscreen = NOT Screen.Fullscreen
IF key.Code = key.Esc THEN Screen.Close()

END

PUBLIC SUB Timer1_Timer()

logo = hWebCam.Image

UpdateLogo = TRUE

END

GambasGears



1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
' Gambas module file

' GambasGears
' Released under GPL v2 or later
' aka glxgears for gambas :)
' based on gears.c by Brian Paul / Mark J. Kilgard
'
' Code : Bodard Fabien & Carlier Laurent
'

PRIVATE screen AS NEW Window(TRUE) AS "Screen"
PRIVATE gearlists AS INTEGER

PRIVATE angle AS FLOAT
PRIVATE Frames AS INTEGER
PRIVATE fTime AS FLOAT

PUBLIC SUB Main()

WITH screen
'.Resizable = True
.Resize(480, 480)
.Show()
END WITH

fTime = Timer

END

PUBLIC SUB Screen_Open()

DIM red AS Float[]
DIM green AS Float[]
DIM blue AS Float[]
DIM pos AS Float[]

red = [0.8, 0.1, 0.0, 0.2]
green = [0.0, 0.8, 0.2, 0.8]
blue = [0.1, 0.1, 0.8, 1.0]

' we enable lights, depth test, cull face
Gl.Lightfv(Gl.LIGHT0, Gl.POSITION, [5.0, 5.0, 10.0, 0.0])
Gl.Enable(Gl.CULL_FACE)
Gl.Enable(Gl.LIGHTING)
Gl.Enable(Gl.LIGHT0)
Gl.Enable(Gl.DEPTH_TEST)
Gl.ClearDepth(1.0)

' We need 3 displaylists for the 3 gears
gearlists = Gl.GenLists(3)

Gl.NewList(gearlists, Gl.COMPILE)
Gl.Materialfv(Gl.FRONT, Gl.AMBIENT_AND_DIFFUSE, red)
Gear(1.0, 4.0, 1.0, 20, 0.7)
Gl.EndList()
Gl.NewList(gearlists + 1, Gl.COMPILE)
Gl.Materialfv(Gl.FRONT, Gl.AMBIENT_AND_DIFFUSE, green)
Gear(0.5, 2.0, 2.0, 10, 0.7)
Gl.EndList()
Gl.NewList(gearlists + 2, Gl.COMPILE)
Gl.Materialfv(Gl.FRONT, Gl.AMBIENT_AND_DIFFUSE, blue)
Gear(1.3, 2.0, 0.5, 10, 0.7)
Gl.EndList()
Gl.Enable(Gl.NORMALIZE)

END

PUBLIC SUB Screen_Resize()

Gl.Viewport(0, 0, Screen.Width, Screen.Height)
Gl.MatrixMode(Gl.PROJECTION)
Gl.LoadIdentity()
Gl.Frustum(-1.0, 1.0, -(Screen.Height / Screen.Width), (Screen.Height / Screen.Width), 5.0, 60.0)
Gl.MatrixMode(Gl.MODELVIEW)
Gl.LoadIdentity()
Gl.Translatef(0.0, 0.0, -40.0)

END

PUBLIC SUB Screen_Draw()

DIM calc AS FLOAT

angle += 0.05

Gl.Clear(Gl.COLOR_BUFFER_BIT OR Gl.DEPTH_BUFFER_BIT)

Gl.PushMatrix()

Gl.Rotatef(20, 1.0, 0.0, 0.0)
Gl.Rotatef(30, 0.0, 1.0, 0.0)
Gl.Rotatef(0, 0.0, 0.0, 1.0)

Gl.PushMatrix()
Gl.Translatef(-3.0, -2.0, 0.0)
Gl.Rotatef(angle, 0.0, 0.0, 1.0)
Gl.CallList(gearlists)
Gl.PopMatrix()

Gl.PushMatrix()
Gl.Translatef(3.1, -2.0, 0.0)
Gl.Rotatef((-2.0 * angle) - 9.0, 0.0, 0.0, 1.0)
Gl.CallList(gearlists + 1)
Gl.PopMatrix()

Gl.PushMatrix()
Gl.Translatef(-3.1, 4.2, 0.0)
Gl.Rotatef((-2.0 * angle) - 25.0, 0.0, 0.0, 1.0)
Gl.CallList(gearlists + 2)
Gl.PopMatrix()

Gl.PopMatrix()

IF (Timer > (fTime + 1)) THEN
INC fTime
PRINT Screen.Framerate; " " & ("FPS")
ENDIF

END

PUBLIC SUB Screen_Close()

Gl.DeleteLists(gearLists, 3)

END

PUBLIC SUB Screen_KeyPress()

IF (key.code = key.F1) THEN Screen.Fullscreen = NOT Screen.Fullscreen
IF (key.Code = key.Esc) THEN Screen.Close()

END

PUBLIC SUB Screen_MouseMove()

IF Mouse.Button = 0 THEN RETURN

Gl.Rotatef(Mouse.StartY - Mouse.Y, 0, 0, 1)
Gl.Rotatef(Mouse.StartX - Mouse.X, 1, 0, 0)

END

PUBLIC SUB Gear(inner_radius AS FLOAT, outer_radius AS FLOAT, width AS FLOAT, teeth AS INTEGER, tooth_depth AS FLOAT)

DIM i AS INTEGER
DIM r0 AS FLOAT
DIM r1 AS FLOAT
DIM r2 AS FLOAT
DIM angle AS FLOAT
DIM da AS FLOAT
DIM u AS FLOAT
DIM v AS FLOAT
DIM fLen AS FLOAT

r0 = inner_radius
r1 = outer_radius - tooth_depth / 2.0
r2 = outer_radius + tooth_depth / 2.0

da = 2.0 * Pi / teeth / 4.0

Gl.ShadeModel(Gl.FLAT)
Gl.Normal3f(0.0, 0.0, 1.0)

' Draw front face
Gl.Begin(Gl.QUAD_STRIP)
FOR i = 0 TO teeth
angle = i * 2.0 * Pi / teeth
Gl.Vertexf(r0 * Cos(angle), r0 * Sin(angle), width * 0.5)
Gl.Vertexf(r1 * Cos(angle), r1 * Sin(angle), width * 0.5)
IF i < teeth THEN
Gl.Vertexf(r0 * Cos(angle), r0 * Sin(angle), width * 0.5)
Gl.Vertexf(r1 * Cos(angle + 3 * da), r1 * Sin(angle + 3 * da), width * 0.5)
ENDIF
NEXT
Gl.End()

' Draw front sides of teeth
Gl.Begin(Gl.QUADS)
da = 2.0 * Pi / teeth / 4.0
FOR i = 0 TO teeth - 1
angle = i * 2.0 * Pi / teeth
Gl.Vertexf(r1 * Cos(angle), r1 * Sin(angle), width * 0.5)
Gl.Vertexf(r2 * Cos(angle + da), r2 * Sin(angle + da), width * 0.5)
Gl.Vertexf(r2 * Cos(angle + 2 * da), r2 * Sin(angle + 2 * da), width * 0.5)
Gl.Vertexf(r1 * Cos(angle + 3 * da), r1 * Sin(angle + 3 * da), width * 0.5)
NEXT
Gl.End()

Gl.Normal3f(0.0, 0.0, -1.0)

' Draw back face
Gl.Begin(Gl.QUAD_STRIP)
FOR i = 0 TO teeth
angle = i * 2.0 * Pi / teeth
Gl.Vertexf(r1 * Cos(angle), r1 * Sin(angle), -width * 0.5)
Gl.Vertexf(r0 * Cos(angle), r0 * Sin(angle), -width * 0.5)
IF i < teeth THEN
Gl.Vertexf(r1 * Cos(angle + 3 * da), r1 * Sin(angle + 3 * da), -width * 0.5)
Gl.Vertexf(r0 * Cos(angle), r0 * Sin(angle), -width * 0.5)
ENDIF
NEXT
Gl.End()

' Draw back sides of teeth
Gl.Begin(Gl.QUADS)
da = 2.0 * Pi / teeth / 4.0
FOR i = 0 TO teeth - 1
angle = i * 2.0 * Pi / teeth
Gl.Vertexf(r1 * Cos(angle + 3 * da), r1 * Sin(angle + 3 * da), -width * 0.5)
Gl.Vertexf(r2 * Cos(angle + 2 * da), r2 * Sin(angle + 2 * da), -width * 0.5)
Gl.Vertexf(r2 * Cos(angle + da), r2 * Sin(angle + da), -width * 0.5)
Gl.Vertexf(r1 * Cos(angle), r1 * Sin(angle), -width * 0.5)
NEXT
Gl.End()

' Draw outward faces of teeth
Gl.Begin(Gl.QUAD_STRIP)
FOR i = 0 TO teeth - 1
angle = i * 2.0 * Pi / teeth
Gl.Vertexf(r1 * Cos(angle), r1 * Sin(angle), width * 0.5)
Gl.Vertexf(r1 * Cos(angle), r1 * Sin(angle), -width * 0.5)
u = r2 * Cos(angle + da) - r1 * Cos(angle)
v = r2 * Sin(angle + da) - r1 * Sin(angle)
fLen = Sqr(u * u + v * v)
u /= fLen
v /= fLen
Gl.Normal3f(v, -u, 0.0)
Gl.Vertexf(r2 * Cos(angle + da), r2 * Sin(angle + da), width * 0.5)
Gl.Vertexf(r2 * Cos(angle + da), r2 * Sin(angle + da), -width * 0.5)
Gl.Normal3f(Cos(angle), Sin(angle), 0.0)
Gl.Vertexf(r2 * Cos(angle + 2 * da), r2 * Sin(angle + 2 * da), width * 0.5)
Gl.Vertexf(r2 * Cos(angle + 2 * da), r2 * Sin(angle + 2 * da), -width * 0.5)
u = r1 * Cos(angle + 3 * da) - r2 * Cos(angle + 2 * da)
v = r1 * Sin(angle + 3 * da) - r2 * Sin(angle + 2 * da)
Gl.Normal3f(v, -u, 0.0)
Gl.Vertexf(r1 * Cos(angle + 3 * da), r1 * Sin(angle + 3 * da), width * 0.5)
Gl.Vertexf(r1 * Cos(angle + 3 * da), r1 * Sin(angle + 3 * da), -width * 0.5)
Gl.Normal3f(Cos(angle), Sin(angle), 0.0)
NEXT
Gl.Vertexf(r1 * Cos(0), r1 * Sin(0), width * 0.5)
Gl.Vertexf(r1 * Cos(0), r1 * Sin(0), -width * 0.5)
Gl.End()

Gl.ShadeModel(Gl.SMOOTH)

' Draw inside radius cylinder
Gl.Begin(Gl.QUAD_STRIP)
FOR i = 0 TO teeth
angle = i * 2.0 * Pi / teeth
Gl.Normal3f(-Cos(angle), -Sin(angle), 0.0)
Gl.Vertexf(r0 * Cos(angle), r0 * Sin(angle), -width * 0.5)
Gl.Vertexf(r0 * Cos(angle), r0 * Sin(angle), width * 0.5)
NEXT
Gl.End()

END

Md2Model



1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
' Gambas class file

PRIVATE $aModel AS Md2Model[]
PRIVATE $aObject AS Md2Object[]
PRIVATE $iFrames AS INTEGER
PRIVATE $fTime AS SINGLE
PRIVATE $fFramerate AS FLOAT
PRIVATE $iEndWidth AS INTEGER
PRIVATE $iEndZ AS INTEGER

PRIVATE $iDisk AS INTEGER
PRIVATE $hQuadric AS GluQuadric
PRIVATE $nDraw AS INTEGER

' Private $fRotX As Float
' Private $fRotY As Float
' Private $fStartX As Float
' Private $fStartY As Float

PUBLIC SUB glaScreen_Open()

Init()
Gl.ClearDepth(100.0) ' Enables clearing of the depth buffer
Glu.ClearColor(&H3398C3) ' This will clear the background color to blue
Gl.DepthFunc(Gl.LESS) ' The type of depth test to do
Gl.Enable(Gl.DEPTH_TEST) ' Enables depth testing
Gl.ShadeModel(Gl.SMOOTH) ' Enables smooth color shading

$fTime = Timer
timAnim.Enabled = TRUE

END

PUBLIC SUB glaScreen_Resize()

Gl.Viewport(0, 0, glaScreen.Width, glaScreen.Height)
Gl.MatrixMode(Gl.PROJECTION)
Gl.LoadIdentity() 'Reset The Projection Matrix
Glu.Perspective(45.0, glaScreen.Width / glaScreen.Height, 0.1, 3000.0) 'Calculate The Aspect Ratio Of The Window
Glu.LookAt(0, 100, 120, 0, 0, -300, 0, 100, 0)
Gl.MatrixMode(Gl.MODELVIEW)

END

PUBLIC SUB Init()

DIM X, D, Z AS FLOAT
DIM sModel AS STRING
DIM hModel AS Md2Model
DIM I AS INTEGER
DIM aModel AS String[] = ["bauul", "goblin", "knight", "ogro", "rat", "rhino"]
DIM hObject AS Md2Object

'Randomize 1972
$aModel = NEW Md2Model[]
$aObject = NEW Md2Object[]

FOR EACH sModel IN aModel
$aModel.Add(Md2Model.Load(sModel & ".md2"))
$aModel[$aModel.Max].Texture = LoadTexture(sModel & ".jpg")
NEXT

D = 100

X = -D
Z = -100

DO

hModel = $aModel[Int(Rnd(0, aModel.Count))]
hObject = NEW Md2Object(hModel)
$aObject.Add(hObject)
$aObject[$aObject.Max].Move(X, -10, Z)
X += 50
IF X > D THEN
D += 100
X = -D
Z -= 100
INC I
IF I = 10 THEN BREAK
ENDIF

LOOP

PRINT $aObject.Count; " " & ("objects")

$iEndWidth = D
$iEndZ = Z

sldFrame.MinValue = 0
sldFrame.MaxValue = $aModel[0].Count

$iDisk = Gl.GenLists(1)
$hQuadric = Glu.NewQuadric()

Gl.NewList($iDisk, Gl.COMPILE)
Gl.Rotatef(90, 1, 0, 0)
Glu.Disk($hQuadric, 0, 20, 30, 1)
Gl.EndList

END

PUBLIC SUB glaScreen_Draw()

DIM fTime AS FLOAT = Timer
DIM I, N AS INTEGER

Gl.Clear(Gl.COLOR_BUFFER_BIT OR Gl.DEPTH_BUFFER_BIT) ' Clear The Screen And The Depth Buffer

Gl.PushMatrix

Gl.Disable(Gl.TEXTURE_2D)

Glu.Color(&HD96800&)
Gl.Begin(Gl.QUADS)
Gl.Vertex3f(-100, -34.2, -100)
Gl.Vertex3f(100, -34.2, -100)
Gl.Vertex3f($iEndWidth, -34.2, $iEndZ)
Gl.Vertex3f(-$iEndWidth, -34.2, $iEndZ)
Gl.End

Glu.Color(Color.Lighter(&HD96800&))
FOR I = 0 TO $aObject.Max

Gl.PushMatrix()
Gl.Translatef($aObject[I].X, -34, $aObject[I].Z)
Gl.CallList($iDisk)
Gl.PopMatrix()

NEXT

Gl.Enable(Gl.TEXTURE_2D)
Gl.Color3f(1, 1, 1)
FOR I = 0 TO $aObject.Max
N += $aObject[I].Draw()
NEXT

' You can use this code to get FPS printed in terminal

INC $iFrames
IF Timer >= ($fTime + 1) THEN
$fFrameRate = $iFrames / (Timer - $fTime)
$iFrames = 0
INC $fTime
ENDIF

lblInfo.Text = Format($aObject[0].Frame, "0.00") & " / " & $aObject[0].Model.Count & " ( " & CInt($fFramerate) & " " & ("FPS") & " )"

Gl.PopMatrix

INC $nDraw
PRINT "\r"; Format($nDraw, "#####0"); ": "; N; " " & ("vertices in") & " "; Format(Timer - fTime, "0.000000"); " " & ("seconds");

END

PUBLIC SUB Form_KeyPress()

IF Key.code = Key.F1 THEN
ME.FullScreen = NOT ME.FullScreen
sldFrame.Visible = NOT ME.FullScreen
ELSE IF Key.Code = Key.Esc THEN
ME.Close
ELSE IF Key.code = Key.Space THEN
timAnim.Enabled = NOT timAnim.Enabled
ELSE IF LCase(Key.Text) = "w" THEN
Gl.PolygonMode(Gl.FRONT_AND_BACK, Gl.LINE)
ELSE IF LCase(Key.Text) = "f" THEN
Gl.PolygonMode(Gl.FRONT_AND_BACK, Gl.FILL)
ENDIF

END

PUBLIC SUB timAnim_Timer()

' At every timer call we increase interpolation. It makes Frame number increase every 10 calls.
' You can control frame flow any way you want. The smaller incrementation, the smoother movement.

DIM I AS INTEGER

FOR I = 0 TO $aObject.Max
WITH $aObject[I]
.Frame += 0.1
IF .Frame >= .Count THEN .Frame = 0
END WITH
NEXT

Object.Lock(sldFrame)
sldFrame.Value = CInt($aObject[0].Frame)
Object.Unlock(sldFrame)

glaScreen.Refresh

END

' Just the subroutine to load textures for our models
PRIVATE SUB LoadTexture(sPath AS STRING) AS INTEGER

DIM iTex AS INTEGER
DIM hImage AS Image

iTex = Gl.GenTextures(1)[0]
hImage = Image.Load(sPath)
Gl.BindTexture(Gl.TEXTURE_2D, iTex)
Gl.TexImage2D(hImage)
Glu.Build2DMipmaps(hImage)
Gl.Texparameteri(Gl.TEXTURE_2D, Gl.TEXTURE_MIN_FILTER, Gl.LINEAR_MIPMAP_LINEAR)
Gl.Texparameteri(Gl.TEXTURE_2D, Gl.TEXTURE_MAG_FILTER, Gl.LINEAR)
RETURN iTex

END

PUBLIC SUB sldFrame_Change()

$aObject[0].Frame = sldFrame.Value

END

' Public Sub glaScreen_MouseMove()
'
' $fRotX = $fStartX + 180 * (Mouse.X - Mouse.StartX) / glaScreen.Width
' $fRotY = $fStartY + 180 * (Mouse.Y - Mouse.StartY) / glaScreen.Height
' glaScreen.Refresh
'
' End
'
' Public Sub glaScreen_MouseDown()
'
' $fStartX = $fRotX
' $fStartY = $fRotY
'
' End

' Public Sub Form_Activate()
'
' While $nDraw < 10
' glaScreen.Refresh
' Wait 1
' Wend
' Me.Close
'
' End

NeHeTutorial



NeHeTutorialShell



PDFPresentation



1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
' Gambas class file

PRIVATE currentDoc AS CpdfPresentation
'PUBLIC Screen AS NEW Window(TRUE) AS "Screen"
PRIVATE currentLogo AS Clogo

PUBLIC SUB glaPresentation_Draw()

IF NOT currentDoc THEN RETURN

IF NOT MMain.ShowLogo THEN
currentDoc.Draw()
ELSE
currentLogo.Draw()
IF currentLogo.Finished = TRUE THEN MMain.ShowLogo = FALSE
ENDIF

END

PUBLIC SUB glaPresentation_KeyPress()

IF Key.code = Key.Escape THEN ME.Close()

IF Key.Code = key["f"] THEN
ME.FullScreen = NOT ME.Fullscreen
panSelect.Visible = NOT ME.FullScreen
ENDIF

IF NOT MMain.ShowLogo THEN
' right arrow
IF Key.Code = Key.Right THEN currentDoc.MoveNext()
' left arrow
IF Key.code = Key.Left THEN currentDoc.MovePrev()
ELSE
IF Key.Code = Key.Space THEN currentLogo.Quit()
ENDIF

END

PUBLIC SUB glaPresentation_Resize()

IF NOT currentDoc THEN RETURN

IF MMain.ShowLogo THEN
currentLogo.Resize(glaPresentation.Width, glaPresentation.Height)
ELSE
currentDoc.Resize(glaPresentation.Width, glaPresentation.Height)
ENDIF

END

PUBLIC SUB Form_Open()

glaPresentation.SetFocus

END

PUBLIC SUB timUpdate_Timer()

glaPresentation.Refresh

END

PUBLIC SUB btnPath_Click()

DIM sPath AS STRING

Dialog.Title = ("Select a PDF file")
Dialog.Filter = ["*.pdf", ("PDF files")]
IF Dialog.OpenFile() THEN RETURN
sPath = Dialog.Path
txtPath.Text = sPath

timUpdate.Stop

CurrentDoc = NEW CpdfPresentation(sPath, MMain.FrameRate)
currentDoc.Effect = currentDoc.Rotate

currentLogo = NEW Clogo(MMain.FrameRate)

glaPresentation_Resize

timUpdate.Delay = 1000 / MMain.FrameRate
PRINT ("Frame rate is") & " "; Format(1000 / timUpdate.Delay, "#.##"); " " & ("images by second")
timUpdate.Start

glaPresentation.SetFocus

END

PUBLIC SUB glaPresentation_MouseWheel()

IF NOT currentDoc THEN RETURN
IF MMain.ShowLogo THEN RETURN

IF Mouse.Delta < 0 THEN
currentDoc.ZoomIn
ELSE
currentDoc.ZoomOut
ENDIF

END

PUBLIC SUB btnHelp_Click()

Message(("<h2>PDFPresentation example</h2><i>Made by Laurent Carlier & Benoît Minisini.</i><p>" & "<br>" &
("Select a PDF file, then press SPACE.<br>Use the left and right arrows to flick through the document."))
glaPresentation.SetFocus

END

TunnelSDL



1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
' Gambas module file

' Original author : Arnaud Storq
' Gambas Port : Fabien Bodard

PRIVATE Screen AS Window

PUBLIC SUB Main()

DIM Texture AS Image

Screen = NEW Window(TRUE) AS "Screen"

WITH Screen
.Resize(512, 512)
.Framerate = 120
.Resizable = TRUE
.Show
END WITH

Texture = image.Load("texture.png")
CTunnel.tunnelInitialiser(Texture)

END

PUBLIC SUB Screen_Draw()

CTunnel.tunnelAfficher(GetTickCount())

PRINT Screen.FrameRate; " " & ("FPS") & "\r";

END

PUBLIC SUB Screen_Close()

CTunnel.tunnelDetruire()

END

PUBLIC SUB Screen_Keypress()

IF key.Code = key.f1 THEN
Screen.FullScreen = NOT Screen.FullScreen
ELSE IF Key.Code = Key.Esc THEN
Screen.Close
ENDIF

END

PRIVATE SUB GetTickCount() AS INTEGER

RETURN CInt(Timer() * 1000)

END

PUBLIC SUB Screen_Resize()

Gl.Viewport(0, 0, Screen.Width, Screen.Height)
Gl.MatrixMode(Gl.PROJECTION)
Gl.LoadIdentity()
Gl.Frustum(-1.0, 1.0, -(Screen.Height / Screen.Width), (Screen.Height / Screen.Width), 5.0, 60.0)
Gl.MatrixMode(Gl.MODELVIEW)
Gl.LoadIdentity()
Gl.Translatef(0.0, 0.0, -40.0)

END

====================

Navigation :



<-- Accueil du WIKI : <--

====================

Documentation :



==============================