module Draw where import SDL (($=), get) import qualified SDL 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 Data.Word (Word32) import Control.Concurrent.MVar import Linear import Foreign -- internal imports import Types import Util quadCoord :: [Float] quadCoord = [ 1 , 1 , 0 , 1 , (-1), 0 , (-1), (-1), 0 , (-1), 1 , 0 ] quadIndices :: [Word32] quadIndices = [ 0, 1, 3 , 1, 2, 3 ] initGL :: IO GLvebo initGL = do --GL.depthFunc $= Just GL.Less vertexBufferObject <- GL.genObjectName GL.bindBuffer GL.ArrayBuffer $= Just vertexBufferObject 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 :: Word32)) , ptr , GL.StaticDraw ) GL.vertexAttribPointer (GL.AttribLocation 0) $= ( GL.ToFloat , GL.VertexArrayDescriptor 3 GL.Float 0 nullPtr ) GL.vertexAttribArray (GL.AttribLocation 0) $= GL.Enabled GL.clearColor $= (GL.Color4 0 0 1 1 :: GL.Color4 Float) return GLvebo { giVBO = vertexBufferObject , giEBO = elementBufferObject } initVAO :: IO () initVAO = do vertexArrayObject <- GL.genObjectName GL.bindVertexArrayObject $= Just vertexArrayObject draw :: MVar State -> Word -> IO () draw state ident = do st <- readMVar state let win = fromJust (lookup ident $ stWindows st) dim <- get (SDL.windowSize win) fitViewport (800/600) (fmap fromIntegral dim) GL.currentProgram $= (Just . GU.program $ fromJust $ lookup ident $ stPrograms st) GL.drawElements GL.Triangles 6 GL.UnsignedInt nullPtr 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" , "" , "" , "void main() {" , " gl_FragColor = vec4(" `BS.append` BC.pack (show (fromIntegral ident * (1 :: Float))) `BS.append` ", 0.5, 0.2, 1.0);" , "}" ]