116 lines
2.6 KiB
Haskell
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);"
|
|
, "}"
|
|
]
|