ibis/src/Draw.hs

152 lines
3.2 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
]
uvCoord :: [Float]
uvCoord =
[ 0, 0
, 1, 0
, 0, 1
, 1, 0
, 1, 1
, 0, 1
]
initGL :: IO GLbo
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
textureBufferObject <- GL.genObjectName
GL.bindBuffer GL.ArrayBuffer $= Just textureBufferObject
withArray uvCoord $ \ptr ->
GL.bufferData GL.ArrayBuffer $=
( fromIntegral $ length uvCoord * sizeOf (0 :: Float)
, ptr
, GL.StaticDraw
)
GL.vertexAttribPointer (GL.AttribLocation 2) $=
( GL.ToFloat
, GL.VertexArrayDescriptor 2 GL.Float 0 nullPtr
)
GL.vertexAttribArray (GL.AttribLocation 2) $= GL.Enabled
GL.clearColor $= (GL.Color4 0 0 1 1 :: GL.Color4 Float)
return GLbo
{ glVBO = vertexBufferObject
, glEBO = elementBufferObject
, glTBO = textureBufferObject
}
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 (stAspectRatio st) (fmap fromIntegral dim)
GL.currentProgram $= (Just . GU.program $ stProgram st)
GU.setUniform (stProgram st) "ident" (
( if ident == stPresentationWindow st
then 1 :: Float
else 0 :: Float
)
)
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 :: BS.ByteString
fragmentShader = foldl (\acc a -> acc `BS.append` "\n" `BS.append` a) BS.empty
[ "#version 330 core"
, ""
, "out vec4 FragColor;"
, ""
, "uniform float ident;"
, ""
, "void main() {"
, " FragColor = vec4(ident, 0.5, 0.2, 1.0);"
, "}"
]