gambas-source-code/app/examples/OpenGL/GambasGears/.src/Module1.module
2019-05-21 09:02:05 +03:00

256 lines
6.6 KiB
Text

' 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