thanks to strfry it works now
This commit is contained in:
parent
6a11ba265f
commit
08e69c5064
3 changed files with 25 additions and 24 deletions
34
src/Draw.hs
34
src/Draw.hs
|
@ -1,6 +1,7 @@
|
||||||
module Draw where
|
module Draw where
|
||||||
|
|
||||||
import SDL (($=), get)
|
import SDL (($=), get)
|
||||||
|
import qualified SDL
|
||||||
|
|
||||||
import qualified Graphics.Rendering.OpenGL as GL
|
import qualified Graphics.Rendering.OpenGL as GL
|
||||||
|
|
||||||
|
@ -11,6 +12,8 @@ import qualified Data.ByteString.Char8 as BC
|
||||||
|
|
||||||
import Data.Maybe (fromJust)
|
import Data.Maybe (fromJust)
|
||||||
|
|
||||||
|
import Data.Word (Word32)
|
||||||
|
|
||||||
import Control.Concurrent.MVar
|
import Control.Concurrent.MVar
|
||||||
|
|
||||||
import Linear
|
import Linear
|
||||||
|
@ -21,6 +24,8 @@ import Foreign
|
||||||
|
|
||||||
import Types
|
import Types
|
||||||
|
|
||||||
|
import Util
|
||||||
|
|
||||||
quadCoord :: [Float]
|
quadCoord :: [Float]
|
||||||
quadCoord =
|
quadCoord =
|
||||||
[ 1 , 1 , 0
|
[ 1 , 1 , 0
|
||||||
|
@ -29,7 +34,7 @@ quadCoord =
|
||||||
, (-1), 1 , 0
|
, (-1), 1 , 0
|
||||||
]
|
]
|
||||||
|
|
||||||
quadIndices :: [Word]
|
quadIndices :: [Word32]
|
||||||
quadIndices =
|
quadIndices =
|
||||||
[ 0, 1, 3
|
[ 0, 1, 3
|
||||||
, 1, 2, 3
|
, 1, 2, 3
|
||||||
|
@ -37,9 +42,11 @@ quadIndices =
|
||||||
|
|
||||||
initGL :: IO GLvebo
|
initGL :: IO GLvebo
|
||||||
initGL = do
|
initGL = do
|
||||||
GL.depthFunc $= Just GL.Less
|
--GL.depthFunc $= Just GL.Less
|
||||||
|
|
||||||
vertexBufferObject <- GL.genObjectName
|
vertexBufferObject <- GL.genObjectName
|
||||||
|
GL.bindBuffer GL.ArrayBuffer $= Just vertexBufferObject
|
||||||
|
|
||||||
withArray quadCoord $ \ptr ->
|
withArray quadCoord $ \ptr ->
|
||||||
GL.bufferData GL.ArrayBuffer $=
|
GL.bufferData GL.ArrayBuffer $=
|
||||||
( fromIntegral $ length quadCoord * sizeOf (0 :: Float)
|
( fromIntegral $ length quadCoord * sizeOf (0 :: Float)
|
||||||
|
@ -52,7 +59,7 @@ initGL = do
|
||||||
|
|
||||||
withArray quadIndices $ \ptr ->
|
withArray quadIndices $ \ptr ->
|
||||||
GL.bufferData GL.ElementArrayBuffer $=
|
GL.bufferData GL.ElementArrayBuffer $=
|
||||||
( fromIntegral $ length quadIndices * sizeOf (0 :: Word)
|
( fromIntegral $ length quadIndices * (sizeOf (0 :: Word32))
|
||||||
, ptr
|
, ptr
|
||||||
, GL.StaticDraw
|
, GL.StaticDraw
|
||||||
)
|
)
|
||||||
|
@ -61,8 +68,7 @@ initGL = do
|
||||||
( GL.ToFloat
|
( GL.ToFloat
|
||||||
, GL.VertexArrayDescriptor 3 GL.Float 0 nullPtr
|
, GL.VertexArrayDescriptor 3 GL.Float 0 nullPtr
|
||||||
)
|
)
|
||||||
|
GL.vertexAttribArray (GL.AttribLocation 0) $= GL.Enabled
|
||||||
GL.drawElements GL.Triangles 6 GL.UnsignedInt nullPtr
|
|
||||||
|
|
||||||
GL.clearColor $= (GL.Color4 0 0 1 1 :: GL.Color4 Float)
|
GL.clearColor $= (GL.Color4 0 0 1 1 :: GL.Color4 Float)
|
||||||
|
|
||||||
|
@ -71,24 +77,21 @@ initGL = do
|
||||||
, giEBO = elementBufferObject
|
, giEBO = elementBufferObject
|
||||||
}
|
}
|
||||||
|
|
||||||
initVAO :: Word -> IO (Word, GL.VertexArrayObject)
|
initVAO :: IO ()
|
||||||
initVAO ident = do
|
initVAO = do
|
||||||
vertexArrayObject <- GL.genObjectName
|
vertexArrayObject <- GL.genObjectName
|
||||||
GL.bindVertexArrayObject $= Just vertexArrayObject
|
GL.bindVertexArrayObject $= Just vertexArrayObject
|
||||||
return (ident, vertexArrayObject)
|
|
||||||
|
|
||||||
draw :: MVar State -> Word -> IO ()
|
draw :: MVar State -> Word -> IO ()
|
||||||
draw state ident = do
|
draw state ident = do
|
||||||
st <- readMVar state
|
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 $
|
GL.currentProgram $= (Just . GU.program $ fromJust $ lookup ident $
|
||||||
stPrograms st)
|
stPrograms st)
|
||||||
-- let proj = ortho (-1) 1 (-1) (1) (-1) 1
|
|
||||||
-- model = mkTransformation (Quaternion 1 (V3 0 0 0)) (V3 0 0 0)
|
GL.drawElements GL.Triangles 6 GL.UnsignedInt nullPtr
|
||||||
-- 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 :: BS.ByteString
|
||||||
vertexShader = foldl (\acc a -> acc `BS.append` "\n" `BS.append` a) BS.empty
|
vertexShader = foldl (\acc a -> acc `BS.append` "\n" `BS.append` a) BS.empty
|
||||||
|
@ -105,7 +108,6 @@ fragmentShader :: Word -> BS.ByteString
|
||||||
fragmentShader ident = foldl (\acc a -> acc `BS.append` "\n" `BS.append` a) BS.empty
|
fragmentShader ident = foldl (\acc a -> acc `BS.append` "\n" `BS.append` a) BS.empty
|
||||||
[ "#version 330 core"
|
[ "#version 330 core"
|
||||||
, ""
|
, ""
|
||||||
-- , "out vec4 gl_FragColor;"
|
|
||||||
, ""
|
, ""
|
||||||
, "void main() {"
|
, "void main() {"
|
||||||
, " gl_FragColor = vec4(" `BS.append` BC.pack (show (fromIntegral ident * (1 :: Float))) `BS.append` ", 0.5, 0.2, 1.0);"
|
, " gl_FragColor = vec4(" `BS.append` BC.pack (show (fromIntegral ident * (1 :: Float))) `BS.append` ", 0.5, 0.2, 1.0);"
|
||||||
|
|
11
src/Main.hs
11
src/Main.hs
|
@ -92,12 +92,9 @@ main = do
|
||||||
mapM_ (flip SDL.setWindowMode SDL.FullscreenDesktop . snd) wins
|
mapM_ (flip SDL.setWindowMode SDL.FullscreenDesktop . snd) wins
|
||||||
void $ SDL.glSetAttribute SDL.SDL_GL_SHARE_WITH_CURRENT_CONTEXT 1
|
void $ SDL.glSetAttribute SDL.SDL_GL_SHARE_WITH_CURRENT_CONTEXT 1
|
||||||
verb opts "Creating OpenGL context(s)"
|
verb opts "Creating OpenGL context(s)"
|
||||||
context <- (SDL.glCreateContext . snd) (head wins)
|
context <- (SDL.glCreateContext . snd) (last wins)
|
||||||
-- verb opts "Creating NanoVG context"
|
|
||||||
-- _ <- glewInit
|
|
||||||
-- nano <- NVG.createGL3 (S.fromList [NVG.Antialias, NVG.StencilStrokes])
|
|
||||||
verb opts "Initializing rendering pipeline"
|
verb opts "Initializing rendering pipeline"
|
||||||
glInits <- mapM (initVAO . fst) wins
|
initVAO
|
||||||
vebo <- initGL
|
vebo <- initGL
|
||||||
programs <- mapM (\(ident, _) -> do
|
programs <- mapM (\(ident, _) -> do
|
||||||
ret <- GU.simpleShaderProgramBS vertexShader (fragmentShader ident)
|
ret <- GU.simpleShaderProgramBS vertexShader (fragmentShader ident)
|
||||||
|
@ -111,7 +108,7 @@ main = do
|
||||||
1
|
1
|
||||||
(last $ map fst wins)
|
(last $ map fst wins)
|
||||||
time
|
time
|
||||||
glInits
|
wins
|
||||||
programs
|
programs
|
||||||
vebo
|
vebo
|
||||||
)
|
)
|
||||||
|
@ -125,9 +122,9 @@ main = do
|
||||||
mapM_ (eventHandler run) =<< SDL.pollEvents
|
mapM_ (eventHandler run) =<< SDL.pollEvents
|
||||||
GL.clear [GL.ColorBuffer, GL.DepthBuffer, GL.StencilBuffer]
|
GL.clear [GL.ColorBuffer, GL.DepthBuffer, GL.StencilBuffer]
|
||||||
draw state ident
|
draw state ident
|
||||||
GL.flush
|
|
||||||
SDL.glSwapWindow window
|
SDL.glSwapWindow window
|
||||||
) wins
|
) wins
|
||||||
|
-- GL.flush
|
||||||
)
|
)
|
||||||
verb opts "Deleting context"
|
verb opts "Deleting context"
|
||||||
SDL.glDeleteContext context
|
SDL.glDeleteContext context
|
||||||
|
|
|
@ -1,5 +1,7 @@
|
||||||
module Types where
|
module Types where
|
||||||
|
|
||||||
|
import qualified SDL
|
||||||
|
|
||||||
import qualified Graphics.Rendering.OpenGL as GL
|
import qualified Graphics.Rendering.OpenGL as GL
|
||||||
|
|
||||||
import qualified Graphics.GLUtil as GU
|
import qualified Graphics.GLUtil as GU
|
||||||
|
@ -20,7 +22,7 @@ data State = State
|
||||||
{ stCurrentPage :: Word
|
{ stCurrentPage :: Word
|
||||||
, stPresentationWindow :: Word
|
, stPresentationWindow :: Word
|
||||||
, stStartTime :: UTCTime
|
, stStartTime :: UTCTime
|
||||||
, stVAOs :: [(Word, GL.VertexArrayObject)]
|
, stWindows :: [(Word, SDL.Window)]
|
||||||
, stPrograms :: [(Word, GU.ShaderProgram)]
|
, stPrograms :: [(Word, GU.ShaderProgram)]
|
||||||
, stVEBO :: GLvebo
|
, stVEBO :: GLvebo
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in a new issue