renderer-tutorial/src/Main.hs

173 lines
4.1 KiB
Haskell
Raw Normal View History

2020-05-17 04:40:30 +00:00
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict #-}
2020-05-15 18:04:18 +00:00
module Main where
2020-05-17 04:40:30 +00:00
import SDL (($=), get)
import qualified SDL
2020-08-29 02:41:23 +00:00
import qualified SDL.Internal.Numbered as SDL
2020-05-17 04:40:30 +00:00
import qualified SDL.Raw.Video as SDL (glSetAttribute)
import qualified SDL.Raw.Enum as SDL
import qualified Graphics.Rendering.OpenGL as GL
import qualified Graphics.GL as GLRaw
import Control.Concurrent.MVar
import Control.Monad
import Control.Monad.Loops
import Foreign hiding (void)
import Foreign.Ptr
import Foreign.Marshal.Array
import Foreign.Storable
import Data.Word
import qualified Data.ByteString as B
2020-05-17 08:59:15 +00:00
import qualified Data.ByteString.Char8 as B8
import qualified Data.List as L
2020-05-17 04:40:30 +00:00
import System.Random (randomRIO)
import Linear
2020-05-18 02:58:45 +00:00
-- internal imports
2020-05-21 16:17:38 +00:00
import BindableClass
2020-05-18 02:58:45 +00:00
import BufferClass
2020-05-20 03:54:14 +00:00
import VertexArray
2020-05-18 02:58:45 +00:00
import VertexBuffer
import IndexBuffer
2020-05-21 19:04:05 +00:00
import Shader
2020-05-22 00:29:16 +00:00
import Renderer
2020-05-22 14:16:06 +00:00
import Texture
2020-08-09 20:24:32 +00:00
import EventHandler
2020-05-18 02:58:45 +00:00
2020-08-29 02:41:23 +00:00
import Scenes.SceneClass
import Scenes.ClearColor
2020-05-15 18:04:18 +00:00
main :: IO ()
2020-05-17 04:40:30 +00:00
main = do
-- -- INITIALIZATION
-- Initialize all the things! (including wacky stuff like joysticks and so on)
SDL.initializeAll
-- create an actual window with OpenGL 3.3
window <- SDL.createWindow "renderer" (SDL.defaultWindow
{ SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL
{ SDL.glProfile = SDL.Core SDL.Normal 3 3
}
}
)
-- enable context sharing (this is not absolutely neccessary)
void $ SDL.glSetAttribute SDL.SDL_GL_SHARE_WITH_CURRENT_CONTEXT 1
-- create ancutal context
context <- SDL.glCreateContext window
-- window should be a window, not fullscreen or so
SDL.setWindowMode window SDL.Windowed
2020-05-17 15:27:18 +00:00
-- synchronize buffer swapping with monitor's vsync
SDL.swapInterval $= SDL.SynchronizedUpdates
2020-05-17 04:40:30 +00:00
-- show the window
SDL.showWindow window
-- print OpenGL version of active context
version <- peekArray0 (0 :: Word8) =<< GLRaw.glGetString GLRaw.GL_VERSION
print (B.pack version)
2020-05-17 11:06:09 +00:00
err <- get GL.errors
print $ "pre-loop errors: " <> show err
2020-05-17 04:40:30 +00:00
2020-08-29 02:41:23 +00:00
-- -- Constructing Scenes
2020-05-17 19:27:35 +00:00
2020-08-29 02:41:23 +00:00
-- Construct state machine for the Scenes
curScene <- newEmptyMVar :: IO (MVar Scene)
2020-05-17 19:27:35 +00:00
-- -- LOOPING
2020-05-17 04:40:30 +00:00
-- initial poll for events
evs <- newMVar =<< SDL.pollEvents
-- Loop running until window closes
whileM_ (notElem (SDL.WindowClosedEvent (SDL.WindowClosedEventData window))
<$> map SDL.eventPayload <$> readMVar evs) $ do
-- poll again
void $ swapMVar evs =<< SDL.pollEvents
2020-08-29 02:41:23 +00:00
currentEvents <- readMVar evs
2020-05-17 04:40:30 +00:00
-- -- OBEY THE HYPNOTOAD!
-- clearcol <- GL.Color4
-- <$> (randomRIO (0, 1))
-- <*> (randomRIO (0, 1))
-- <*> (randomRIO (0, 1))
-- <*> pure 1
-- GL.clearColor $= clearcol
2020-08-29 02:41:23 +00:00
hasSelect <- not <$> isEmptyMVar curScene
if hasSelect
then do
(Scene sceneObject) <- readMVar curScene
onEvents sceneObject currentEvents
update sceneObject 0
render sceneObject
else do
GL.clear [GL.ColorBuffer]
2020-08-10 13:09:23 +00:00
2020-08-29 02:41:23 +00:00
-- Switch to different scene on keyboard presses F1 thourgh F?
2020-08-10 13:09:23 +00:00
2020-08-29 02:41:23 +00:00
sceneSwitch curScene currentEvents
2020-08-10 13:09:23 +00:00
2020-05-17 11:06:09 +00:00
err <- get GL.errors
when (not $ null err) (print $ "loop errors: " <> show err)
2020-05-17 04:40:30 +00:00
2020-05-22 21:48:40 +00:00
-- make GL finish things up
2020-05-22 21:59:29 +00:00
GL.flush
2020-05-17 04:40:30 +00:00
-- draw context on screen
SDL.glSwapWindow window
-- -- CLEAN UP
-- wrapping things up
putStrLn "loop exited. shutting down."
-- delete context
SDL.glDeleteContext context
-- destroy window
SDL.destroyWindow window
-- quit SDL
SDL.quit
-- This is the end.
putStrLn "Bye!"
2020-08-29 02:41:23 +00:00
sceneSwitch :: MVar Scene -> [SDL.Event] -> IO ()
sceneSwitch curScene evs = mapM_ (switch . SDL.eventPayload) evs
where
switch (SDL.KeyboardEvent
(SDL.KeyboardEventData
_
SDL.Pressed
_
(SDL.Keysym _ code mod))) =
when (SDL.toNumber mod == 0) $
case code of
SDL.KeycodeF1 -> do
void $ tryTakeMVar curScene
putMVar curScene =<< scene1
_ ->
return ()
switch _ = return ()
-- initialize scenes
scene1 = Scene <$> ClearColor <$> newMVar (V4 0 0.2 0.3 1)