module Draw where import SDL (($=), get) import qualified Graphics.Rendering.OpenGL as GL import qualified Graphics.GLUtil as GU import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BC import Data.Maybe (fromJust) import Control.Concurrent.MVar import Linear import Foreign -- internal imports import Types quadCoord :: [Float] quadCoord = [ 1 , 1 , 0 , 1 , (-1), 0 , (-1), (-1), 0 , (-1), 1 , 0 ] quadIndices :: [Word] quadIndices = [ 0, 1, 3 , 1, 2, 3 ] initGL :: IO GLvebo initGL = do GL.depthFunc $= Just GL.Less vertexBufferObject <- GL.genObjectName withArray quadCoord $ \ptr -> GL.bufferData GL.ArrayBuffer $= ( fromIntegral $ length quadCoord * sizeOf (0 :: Float) , ptr , GL.StaticDraw ) elementBufferObject <- GL.genObjectName GL.bindBuffer GL.ElementArrayBuffer $= Just elementBufferObject withArray quadIndices $ \ptr -> GL.bufferData GL.ElementArrayBuffer $= ( fromIntegral $ length quadIndices * sizeOf (0 :: Word) , ptr , GL.StaticDraw ) GL.vertexAttribPointer (GL.AttribLocation 0) $= ( GL.ToFloat , GL.VertexArrayDescriptor 3 GL.Float 0 nullPtr ) GL.drawElements GL.Triangles 6 GL.UnsignedInt nullPtr GL.clearColor $= (GL.Color4 0 0 1 1 :: GL.Color4 Float) return GLvebo { giVBO = vertexBufferObject , giEBO = elementBufferObject } initVAO :: Word -> IO (Word, GL.VertexArrayObject) initVAO ident = do vertexArrayObject <- GL.genObjectName GL.bindVertexArrayObject $= Just vertexArrayObject return (ident, vertexArrayObject) draw :: MVar State -> Word -> IO () draw state ident = do st <- readMVar state GL.currentProgram $= (Just . GU.program $ fromJust $ lookup ident $ stPrograms st) -- let proj = ortho (-1) 1 (-1) (1) (-1) 1 -- model = mkTransformation (Quaternion 1 (V3 0 0 0)) (V3 0 0 0) -- view = lookAt (V3 0 0 0) (V3 0 0 0) (V3 0 0 0) -- pvm = proj !*! view !*! model GL.bindVertexArrayObject $= lookup ident (stVAOs st) GL.drawArrays GL.Triangles 0 (fromIntegral $ length quadCoord) return () vertexShader :: BS.ByteString vertexShader = foldl (\acc a -> acc `BS.append` "\n" `BS.append` a) BS.empty [ "#version 330 core" , "" , "layout (location = 0) in vec3 pos;" , "" , "void main() {" , " gl_Position = vec4(pos.x, pos.y, pos.z, 1.0);" , "}" ] fragmentShader :: Word -> BS.ByteString fragmentShader ident = foldl (\acc a -> acc `BS.append` "\n" `BS.append` a) BS.empty [ "#version 330 core" , "" -- , "out vec4 gl_FragColor;" , "" , "void main() {" , " gl_FragColor = vec4(" `BS.append` BC.pack (show (fromIntegral ident * (1 :: Float))) `BS.append` ", 0.5, 0.2, 1.0);" , "}" ]