{-# 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 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.blendFunc $= (GL.SrcAlpha, GL.OneMinusSrcAlpha) GL.frontFace $= GL.CCW GL.blend $= GL.Enabled GL.depthFunc $= Nothing GL.scissor $= Nothing GL.viewport $= (GL.Position 0 0, GL.Size 1920 1080) GL.clearColor $= GL.Color4 1 1 1 1 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)