103 lines
2.4 KiB
Haskell
103 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)
|