{-# 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)