ibis/src/Draw.hs

152 lines
3.2 KiB
Haskell
Raw Permalink Normal View History

2019-02-01 10:54:38 +00:00
module Draw where
2019-02-02 21:45:57 +00:00
import SDL (($=), get)
2019-02-02 23:57:52 +00:00
import qualified SDL
2019-02-02 21:45:57 +00:00
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)
2019-02-02 23:57:52 +00:00
import Data.Word (Word32)
2019-02-01 10:54:38 +00:00
import Control.Concurrent.MVar
2019-02-02 21:45:57 +00:00
import Linear
import Foreign
2019-02-01 10:54:38 +00:00
-- internal imports
import Types
2019-02-02 23:57:52 +00:00
import Util
2019-02-02 21:45:57 +00:00
quadCoord :: [Float]
quadCoord =
[ 1 , 1 , 0
, 1 , (-1), 0
, (-1), (-1), 0
, (-1), 1 , 0
]
2019-02-02 23:57:52 +00:00
quadIndices :: [Word32]
2019-02-02 21:45:57 +00:00
quadIndices =
[ 0, 1, 3
, 1, 2, 3
]
2019-02-08 15:10:52 +00:00
uvCoord :: [Float]
uvCoord =
[ 0, 0
, 1, 0
, 0, 1
, 1, 0
, 1, 1
, 0, 1
]
initGL :: IO GLbo
2019-02-02 21:45:57 +00:00
initGL = do
2019-02-02 23:57:52 +00:00
--GL.depthFunc $= Just GL.Less
2019-02-02 21:45:57 +00:00
vertexBufferObject <- GL.genObjectName
2019-02-02 23:57:52 +00:00
GL.bindBuffer GL.ArrayBuffer $= Just vertexBufferObject
2019-02-02 21:45:57 +00:00
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 $=
2019-02-02 23:57:52 +00:00
( fromIntegral $ length quadIndices * (sizeOf (0 :: Word32))
2019-02-02 21:45:57 +00:00
, ptr
, GL.StaticDraw
)
GL.vertexAttribPointer (GL.AttribLocation 0) $=
( GL.ToFloat
, GL.VertexArrayDescriptor 3 GL.Float 0 nullPtr
)
2019-02-02 23:57:52 +00:00
GL.vertexAttribArray (GL.AttribLocation 0) $= GL.Enabled
2019-02-02 21:45:57 +00:00
2019-02-08 15:10:52 +00:00
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
2019-02-02 21:45:57 +00:00
GL.clearColor $= (GL.Color4 0 0 1 1 :: GL.Color4 Float)
2019-02-08 15:10:52 +00:00
return GLbo
2019-02-08 08:19:09 +00:00
{ glVBO = vertexBufferObject
, glEBO = elementBufferObject
2019-02-08 15:10:52 +00:00
, glTBO = textureBufferObject
2019-02-02 21:45:57 +00:00
}
2019-02-02 23:57:52 +00:00
initVAO :: IO ()
initVAO = do
2019-02-02 21:45:57 +00:00
vertexArrayObject <- GL.genObjectName
GL.bindVertexArrayObject $= Just vertexArrayObject
2019-02-01 10:54:38 +00:00
draw :: MVar State -> Word -> IO ()
draw state ident = do
2019-02-02 21:45:57 +00:00
st <- readMVar state
2019-02-02 23:57:52 +00:00
let win = fromJust (lookup ident $ stWindows st)
dim <- get (SDL.windowSize win)
2019-02-08 15:10:52 +00:00
fitViewport (stAspectRatio st) (fmap fromIntegral dim)
2019-02-03 01:08:37 +00:00
GL.currentProgram $= (Just . GU.program $ stProgram st)
GU.setUniform (stProgram st) "ident" (
( if ident == stPresentationWindow st
then 1 :: Float
else 0 :: Float
)
)
2019-02-02 23:57:52 +00:00
GL.drawElements GL.Triangles 6 GL.UnsignedInt nullPtr
2019-02-02 21:45:57 +00:00
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);"
, "}"
]
2019-02-03 01:08:37 +00:00
fragmentShader :: BS.ByteString
fragmentShader = foldl (\acc a -> acc `BS.append` "\n" `BS.append` a) BS.empty
2019-02-02 21:45:57 +00:00
[ "#version 330 core"
, ""
2019-02-03 01:08:37 +00:00
, "out vec4 FragColor;"
, ""
, "uniform float ident;"
2019-02-02 21:45:57 +00:00
, ""
, "void main() {"
2019-02-03 01:08:37 +00:00
, " FragColor = vec4(ident, 0.5, 0.2, 1.0);"
2019-02-02 21:45:57 +00:00
, "}"
]