canvas/app/Main.hs

115 lines
2.9 KiB
Haskell
Raw Permalink Normal View History

2020-02-07 04:50:19 +00:00
{-# LANGUAGE OverloadedStrings #-}
2020-02-01 15:09:09 +00:00
module Main where
2020-02-05 06:21:39 +00:00
import Affection
2020-02-07 04:50:19 +00:00
import SDL (($=))
import qualified SDL
2020-02-07 13:57:09 +00:00
import qualified Graphics.Rendering.OpenGL as GL
2020-02-09 01:38:02 +00:00
import qualified Graphics.GL as GLRaw
2020-02-07 23:15:53 +00:00
import qualified Graphics.GLUtil as GLU
2020-02-07 04:50:19 +00:00
import Codec.Picture
import Control.Monad (void)
2020-02-07 13:57:09 +00:00
import Control.Monad.IO.Class (liftIO)
2020-02-07 04:50:19 +00:00
import Control.Concurrent.STM
import qualified Data.Map.Strict as M
2020-02-09 01:38:02 +00:00
import Foreign (nullPtr, plusPtr)
2020-02-05 06:21:39 +00:00
-- internal imports
import Types
2020-02-07 13:57:09 +00:00
import Types.Sprite
import Renderer
import Classes.Renderable as CR
2020-02-05 06:21:39 +00:00
2020-02-09 01:38:02 +00:00
cattyness = 1000
2020-02-01 15:09:09 +00:00
main :: IO ()
2020-02-07 04:50:19 +00:00
main =
withAffection AffectionConfig
{ initComponents = All
, windowTitle = "canvas"
, windowConfigs =
[ ( 0
2020-02-07 13:57:09 +00:00
, SDL.defaultWindow
2020-02-09 01:38:02 +00:00
{ SDL.windowInitialSize = SDL.V2 1920 1080
2020-02-07 13:57:09 +00:00
, SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL
2020-02-09 01:38:02 +00:00
{ SDL.glProfile = SDL.Core SDL.Normal 3 3
2020-02-07 04:50:19 +00:00
}
}
)
]
, initScreenMode = SDL.FullscreenDesktop
2020-02-07 23:15:53 +00:00
, preLoop = preLoopImpl
2020-02-07 13:57:09 +00:00
, eventLoop = mapM_ handle
, updateLoop = updateLoopImpl
, drawLoop = drawLoopImpl
, loadState = loadStateImpl
2020-02-07 04:50:19 +00:00
, cleanUp = (\_ -> return ())
, canvasSize = Nothing
}
2020-02-07 23:15:53 +00:00
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)
2020-02-07 13:57:09 +00:00
loadStateImpl :: IO UserData
loadStateImpl = do
2020-02-07 04:50:19 +00:00
2020-02-07 13:57:09 +00:00
subs <- Subsystems
2020-02-07 04:50:19 +00:00
<$> (SubWindow <$> newTVarIO [])
<*> (SubMouse <$> newTVarIO [])
2020-02-09 01:38:02 +00:00
spriteDetails <- loadSprites cattyness
2020-02-07 04:50:19 +00:00
return UserData
{ udSubsystems = subs
2020-02-07 06:51:31 +00:00
, udRenderAssets = RenderAssets
{ assetSprites = spriteDetails
}
2020-02-07 04:50:19 +00:00
}
2020-02-07 13:57:09 +00:00
handle event = return ()
2020-02-07 04:50:19 +00:00
2020-02-09 01:38:02 +00:00
updateLoopImpl dt = do
liftIO $ putStrLn (show $ 1 / dt)
return ()
2020-02-07 04:50:19 +00:00
2020-02-07 13:57:09 +00:00
drawLoopImpl = do
2020-02-09 01:38:02 +00:00
-- liftIO $ putStrLn "I'm in your draw"
2020-02-07 06:51:31 +00:00
ud@(UserData subs rassets) <- getAffection
2020-02-07 23:15:53 +00:00
let (RenderAssets sDetails@(AssetDetails svo sso sto sdo)) = rassets
2020-02-07 13:57:09 +00:00
liftIO $ do
2020-02-07 23:15:53 +00:00
mapM_
(\ident -> do
CR.init
(svo :: VertexObjects Sprite)
(sso :: ShaderObjects Sprite)
(sto M.! ident)
(head (sdo M.! ident))
2020-02-09 01:38:02 +00:00
-- 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
2020-02-07 23:15:53 +00:00
clean
(head (sdo M.! ident))
)
(M.keys sdo)