canvas/app/Main.hs

115 lines
2.9 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
module Main where
import Affection
import SDL (($=))
import qualified SDL
import qualified Graphics.Rendering.OpenGL as GL
import qualified Graphics.GL as GLRaw
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
import Foreign (nullPtr, plusPtr)
-- internal imports
import Types
import Types.Sprite
import Renderer
import Classes.Renderable as CR
cattyness = 1000
main :: IO ()
main =
withAffection AffectionConfig
{ initComponents = All
, windowTitle = "canvas"
, windowConfigs =
[ ( 0
, SDL.defaultWindow
{ SDL.windowInitialSize = SDL.V2 1920 1080
, SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL
{ SDL.glProfile = SDL.Core SDL.Normal 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 cattyness
return UserData
{ udSubsystems = subs
, udRenderAssets = RenderAssets
{ assetSprites = spriteDetails
}
}
handle event = return ()
updateLoopImpl dt = do
liftIO $ putStrLn (show $ 1 / dt)
return ()
drawLoopImpl = do
-- liftIO $ putStrLn "I'm in your draw"
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)
GL.drawArraysInstanced GL.Triangles 0 6 (fromIntegral cattyness)
-- GL.drawElementsInstanced GL.Triangles 6 GL.UnsignedInt (nullPtr `plusPtr` 1) 9999
-- GLRaw.glDrawElementsInstanced GLRaw.GL_TRIANGLES 6 GLRaw.GL_UNSIGNED_INT nullPtr 9999
clean
(head (sdo M.! ident))
)
(M.keys sdo)