ibis/src/Draw.hs

114 lines
2.7 KiB
Haskell

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);"
, "}"
]