/
2013-12-02-linear-example.hs
125 lines (100 loc) · 3.88 KB
/
2013-12-02-linear-example.hs
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
{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative
import Control.Lens
import Control.Monad (forever)
import Data.Distributive (distribute)
import Foreign (Ptr, castPtr, nullPtr, sizeOf, with)
import Foreign.C (CFloat)
import Graphics.Rendering.OpenGL (($=))
import qualified Graphics.Rendering.OpenGL as GL
import qualified Graphics.Rendering.OpenGL.Raw as GL
import qualified Graphics.UI.SDL as SDL
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Vector.Storable as V
import Linear as L
import Linear ((!*!))
import Data.IORef
--------------------------------------------------------------------------------
triangleTransformation :: (Epsilon a, Floating a) => a -> M44 a
triangleTransformation =
liftA2 (!*!) triangleTranslation triangleRotation
--------------------------------------------------------------------------------
triangleRotation :: (Epsilon a, Floating a) => a -> M44 a
triangleRotation t =
m33_to_m44 $
fromQuaternion $
axisAngle (V3 0 1 0) (t * 2)
triangleTranslation :: Floating a => a -> M44 a
triangleTranslation t =
eye4 & translation .~ V3 (sin t * 2) 0 (-5)
--------------------------------------------------------------------------------
main :: IO ()
main =
SDL.withWindow "OpenGL Testing" (SDL.Position 0 0) (SDL.Size 800 600) [SDL.WindowOpengl] $ \win ->
SDL.withOpenGL win $ do
let z = 0
let vertices = V.fromList [ 0, 1, 0
, -1, -1, z
, 1, -1, z ] :: V.Vector Float
vertexAttribute = GL.AttribLocation 0
cubeVao <- GL.genObjectName
cubeVbo <- GL.genObjectName
GL.bindVertexArrayObject $= Just cubeVao
GL.bindBuffer GL.ArrayBuffer $= Just cubeVbo
V.unsafeWith vertices $ \v -> GL.bufferData GL.ArrayBuffer $=
(fromIntegral $ V.length vertices * sizeOf (0 :: Float), v, GL.StaticDraw)
GL.vertexAttribPointer vertexAttribute $=
(GL.ToFloat, GL.VertexArrayDescriptor 3 GL.Float 0 nullPtr)
GL.vertexAttribArray vertexAttribute $= GL.Enabled
GL.bindBuffer GL.ArrayBuffer $= Just cubeVbo
vertexShader <- GL.createShader GL.VertexShader
fragmentShader <- GL.createShader GL.FragmentShader
GL.shaderSourceBS vertexShader $= Text.encodeUtf8
(Text.pack $ unlines
[ "#version 130"
, "uniform mat4 projection;"
, "uniform mat4 model;"
, "in vec3 in_Position;"
, "void main(void) {"
, " gl_Position = projection * model * vec4(in_Position, 1.0);"
, "}"
])
GL.shaderSourceBS fragmentShader $= Text.encodeUtf8
(Text.pack $ unlines
[ "#version 130"
, "out vec4 fragColor;"
, "void main(void) {"
, " fragColor = vec4(1.0,1.0,1.0,1.0);"
, "}"
])
GL.compileShader vertexShader
GL.compileShader fragmentShader
shaderProg <- GL.createProgram
GL.attachShader shaderProg vertexShader
GL.attachShader shaderProg fragmentShader
GL.attribLocation shaderProg "in_Position" $= vertexAttribute
GL.linkProgram shaderProg
GL.currentProgram $= Just shaderProg
let fov = 90
s = recip (tan $ fov * 0.5 * pi / 180)
f = 1000
n = 1
let perspective = V.fromList [ s, 0, 0, 0
, 0, s, 0, 0
, 0, 0, -(f/(f - n)), -1
, 0, 0, -((f*n)/(f-n)), 1
]
GL.UniformLocation loc <- GL.get (GL.uniformLocation shaderProg "projection")
V.unsafeWith perspective $ \ptr -> GL.glUniformMatrix4fv loc 1 0 ptr
tr <- newIORef 0
forever $ do
t <- readIORef tr
GL.clearColor $= GL.Color4 0.5 0.2 1 1
GL.clear [GL.ColorBuffer]
GL.UniformLocation loc <- GL.get (GL.uniformLocation shaderProg "model")
with (distribute $ triangleTransformation t) $ \ptr ->
GL.glUniformMatrix4fv loc 1 0 (castPtr (ptr :: Ptr (M44 CFloat)))
GL.drawArrays GL.Triangles 0 3
SDL.glSwapWindow win
writeIORef tr (t + 0.1)