canvas/app/Main.hs
2020-02-08 00:15:53 +01:00

104 lines
2.4 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
module Main where
import Affection
import SDL (($=))
import qualified SDL
import qualified Graphics.Rendering.OpenGL as GL
import qualified Graphics.GLUtil as GLU
import Codec.Picture
import Control.Monad (void)
import Control.Monad.IO.Class (liftIO)
import Control.Concurrent.STM
import qualified Data.Map.Strict as M
-- internal imports
import Types
import Types.Sprite
import Renderer
import Classes.Renderable as CR
main :: IO ()
main =
withAffection AffectionConfig
{ initComponents = All
, windowTitle = "canvas"
, windowConfigs =
[ ( 0
, SDL.defaultWindow
{ SDL.windowInitialSize = SDL.V2 1600 900
, SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL
{ SDL.glProfile = SDL.Core SDL.Debug 3 3
}
}
)
]
, initScreenMode = SDL.FullscreenDesktop
, preLoop = preLoopImpl
, eventLoop = mapM_ handle
, updateLoop = updateLoopImpl
, drawLoop = drawLoopImpl
, loadState = loadStateImpl
, cleanUp = (\_ -> return ())
, canvasSize = Nothing
}
preLoopImpl :: Affection UserData ()
preLoopImpl = liftIO $ do
void $ SDL.setMouseLocationMode SDL.RelativeLocation
-- GL.depthFunc $= Just GL.Less
GL.textureFilter GL.Texture2D $= ((GL.Nearest, Nothing), GL.Nearest)
GLU.texture2DWrap $= (GL.Repeated, GL.ClampToEdge)
GL.texture GL.Texture2D $= GL.Enabled
-- GL.frontFace $= GL.CW
GL.viewport $= (GL.Position 0 0, GL.Size 1920 1080)
loadStateImpl :: IO UserData
loadStateImpl = do
subs <- Subsystems
<$> (SubWindow <$> newTVarIO [])
<*> (SubMouse <$> newTVarIO [])
spriteDetails <- loadSprites
return UserData
{ udSubsystems = subs
, udRenderAssets = RenderAssets
{ assetSprites = spriteDetails
}
}
handle event = return ()
updateLoopImpl dt = return ()
drawLoopImpl = do
ud@(UserData subs rassets) <- getAffection
let (RenderAssets sDetails@(AssetDetails svo sso sto sdo)) = rassets
liftIO $ do
mapM_
(\ident -> do
CR.init
(svo :: VertexObjects Sprite)
(sso :: ShaderObjects Sprite)
(sto M.! ident)
(head (sdo M.! ident))
mapM_
(draw
(svo :: VertexObjects Sprite)
(sso :: ShaderObjects Sprite)
)
(sdo M.! ident)
clean
(head (sdo M.! ident))
)
(M.keys sdo)