1 import qualified Data.ByteString as B
2 import Graphics.Rendering.OpenGL
3 import qualified Graphics.GL.Functions as GL
4 import Graphics.UI.GLUT
5 import qualified Linear.Projection as L
8 import Linear.Quaternion
10 import Foreign.C.Types
15 (_progName, _args) <- getArgsAndInitialize
17 initialDisplayMode $= [WithDepthBuffer, DoubleBuffered, Borderless]
18 win <- createWindow "Hello world"
20 (program, triangles) <- setup
22 let projection = transpose $ L.perspective 0.785 1.33 0.001 100
23 view = transpose $ L.lookAt (V3 0.0 0.0 (-5.0)) (V3 0.0 0.0 (-4.0)) (V3 0.0 1.0 0.0)
26 clear [ColorBuffer, DepthBuffer]
28 (UniformLocation projLoc) <- uniformLocation program "projection"
29 with projection $ \ptr ->
30 GL.glUniformMatrix4fv projLoc 1 0 (castPtr (ptr :: Ptr (M44 CFloat)))
32 (UniformLocation viewLoc) <- uniformLocation program "view"
34 GL.glUniformMatrix4fv viewLoc 1 0 (castPtr (ptr :: Ptr (M44 CFloat)))
36 time <- fromIntegral <$> get elapsedTime
37 let model = transpose $ m33_to_m44 $ fromQuaternion $ axisAngle (V3 0 1 0) (time * 0.001)
38 (UniformLocation modelLoc) <- uniformLocation program "model"
40 GL.glUniformMatrix4fv modelLoc 1 0 (castPtr (ptr :: Ptr (M44 CFloat)))
42 bindVertexArrayObject $= Just triangles
43 drawArrays Triangles 0 12
45 get errors >>= \es -> unless (null es) (fail $ show es)
47 let draw = addTimerCallback 16 (postRedisplay (Just win) >> draw) in draw
51 setup :: IO (Program, VertexArrayObject)
53 depthFunc $= Just Lequal
55 triangles <- genObjectName
56 bindVertexArrayObject $= Just triangles
58 Vertex3 (-1) (-1) (-1),
59 Vertex3 ( 1) (-1) (-1),
60 Vertex3 ( 0) ( 1) ( 0),
62 Vertex3 (-1) (-1) ( 1),
63 Vertex3 ( 1) (-1) ( 1),
64 Vertex3 ( 0) ( 1) ( 0),
66 Vertex3 (-1) (-1) (-1),
67 Vertex3 (-1) (-1) ( 1),
68 Vertex3 ( 0) ( 1) ( 0),
70 Vertex3 ( 1) (-1) (-1),
71 Vertex3 ( 1) (-1) ( 1),
72 Vertex3 ( 0) ( 1) ( 0)] :: [Vertex3 Float]
73 verticesSize = fromIntegral $ length vertices * sizeOf (head vertices)
75 colors = take 12 $ cycle [
78 Vertex4 0 0 1 1 ] :: [Vertex4 Float]
79 colorsSize = fromIntegral $ length colors * sizeOf (head colors)
81 buffer <- genObjectName
82 bindBuffer ArrayBuffer $= Just buffer
84 bufferData ArrayBuffer $= (verticesSize + colorsSize, nullPtr, StaticDraw)
86 withArray vertices $ \ptr ->
87 bufferSubData ArrayBuffer WriteToBuffer 0 verticesSize ptr
89 withArray colors $ \ptr ->
90 bufferSubData ArrayBuffer WriteToBuffer verticesSize colorsSize ptr
92 program <- createProgram
93 loadShader program VertexShader "vertex.glsl"
94 loadShader program FragmentShader "fragment.glsl"
98 status <- linkStatus program
100 get (programInfoLog program) >>= fail
102 currentProgram $= Just program
104 verticesLoc <- get (attribLocation program "vPosition")
105 vertexAttribPointer verticesLoc $=
106 (ToFloat, VertexArrayDescriptor 3 Float 0 (ptrOffset 0))
107 vertexAttribArray verticesLoc $= Enabled
109 colorsLoc <- get (attribLocation program "vColor")
110 vertexAttribPointer colorsLoc $=
111 (ToFloat, VertexArrayDescriptor 4 Float 0 (ptrOffset verticesSize))
112 vertexAttribArray colorsLoc $= Enabled
114 validateProgram program
115 status' <- validateStatus program
117 get (programInfoLog program) >>= fail
119 return (program, triangles)
120 where ptrOffset = plusPtr nullPtr . fromIntegral
122 loadShader :: Program -> ShaderType -> String -> IO ()
123 loadShader program shaderType file = do
124 shader <- createShader shaderType
125 src <- B.readFile file
126 shaderSourceBS shader $= src
128 status <- compileStatus shader
130 get (shaderInfoLog shader) >>= fail . ("shader failed " ++)
131 attachShader program shader
133 perspective' :: Float -> Float -> Float -> Float -> IO (GLmatrix Float)
134 perspective' fov aspect zNear zFar =
135 let f = 1.0 / tan(fov)
136 in newMatrix RowMajor
137 [f / aspect, 0, 0, 0,
139 0, 0, (zNear + zFar) / (zNear - zFar), -1,
140 0, 0, (2 * zFar * zNear) / (zNear - zFar), 0]