ibis/src/Draw.hs

116 lines
2.6 KiB
Haskell

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