{-# LANGUAGE OverloadedStrings #-} module Main where import Affection import qualified Data.Text as T import SDL (($=), get) import qualified SDL import qualified SDL.Internal.Numbered as SDL import qualified SDL.Raw.Video as SDL (glSetAttribute) import qualified SDL.Raw.Enum as SDL import qualified Graphics.Rendering.OpenGL as GL import Control.Monad (when, void) import Control.Concurrent.STM import qualified Data.Map.Strict as M import Data.String (fromString) import Data.Maybe (isJust) import Linear -- internal imports import StateMachine import Types import Classes import Scenes.Test instance Affectionate GameData where preLoop = preLoad handleEvents = handle update = Main.update draw = Main.draw loadState = Main.init cleanUp _ = return () hasNextStep = liftIO . atomically . readTVar . gameRunning main :: IO () main = do let config = AffectionConfig { initComponents = All , windowTitle = "Pituicat" , windowConfigs = [ ( 0 , SDL.defaultWindow { SDL.windowInitialSize = V2 800 600 , SDL.windowResizable = True , SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL { SDL.glProfile = SDL.Core SDL.Normal 3 3 } } , SDL.Windowed ) ] } :: AffectionConfig GameData withAffection config preLoad :: GameData -> Affection () preLoad _ = return () handle :: GameData -> [SDL.EventPayload] -> Affection () handle gd evs = do state <- liftIO (atomically $ readTVar $ gameState gd) smEvent state gd evs update :: GameData -> Double -> Affection () update gd dt = do liftIO ((logIO Verbose) =<< (atomically $ (("Progress: " <>) . snd) <$> (readTMVar $ gameStateLoadProgress gd))) state <- liftIO $ atomically $ readTVar $ gameState gd isStagePresent <- liftIO $ atomically $ fmap not $ isEmptyTMVar $ gameScene gd if isStagePresent then do liftIO $ logIO Verbose "Stage is present" (Stage sceneContainer) <- liftIO $ atomically $ readTMVar $ gameScene gd sceneLoaded <- isSceneLoaded sceneContainer if not sceneLoaded then do liftIO $ logIO Verbose "Loading scene" smLoad state gd else smUpdate state gd dt else liftIO $ logIO Error "No Stage to play on" draw :: GameData -> Affection () draw gd = do state <- liftIO (atomically $ readTVar $ gameState gd) liftIO $ logIO Verbose (fromString $ "now drawing: " <> show state) GL.clearColor $= GL.Color4 0 0 1 1 smDraw state gd err <- SDL.get GL.errors when (not $ null err) (liftIO $ logIO Error ("loop errors: " <> fromString (show err))) init :: IO GameData init = do GL.blend $= GL.Enabled GL.blendFunc $= (GL.SrcAlpha, GL.OneMinusSrcAlpha) void $ SDL.glSetAttribute SDL.SDL_GL_SHARE_WITH_CURRENT_CONTEXT 1 GameData <$> (newTMVarIO =<< (Stage <$> (initScene :: IO Test))) <*> newTVarIO Loading <*> newTMVarIO (0, "Ohai!") <*> (Subsystems <$> (SubWindow <$> newTVarIO []) <*> (SubMouse <$> newTVarIO []) <*> (SubKeyboard <$> newTVarIO []) <*> (SubTranslator <$> newTVarIO []) ) <*> newTVarIO (M.fromList []) <*> newTVarIO True <*> newTVarIO Nothing <*> newTVarIO Nothing