{-# LANGUAGE ForeignFunctionInterface #-} module Main where import Affection as A import Data.Ecstasy import qualified SDL import NanoVG hiding (V2(..), V3(..)) import Linear import Foreign.C.Types (CInt(..)) import Data.Maybe (fromJust) import Control.Monad import Control.Concurrent.MVar import Control.Monad.Trans.Resource (allocate) -- internal imports import Types hiding (draw) import StateMachine () import Init import Util foreign import ccall unsafe "glewInit" glewInit :: IO CInt instance Affectionate UserData where preLoop = (\ud -> pre ud >> smLoad Load ud) handleEvents = handle update = Main.update draw = Main.draw loadState = Init.init cleanUp = clean hasNextStep = liftIO . readMVar . doNextStep main :: IO () main = do let config = AffectionConfig { initComponents = All , windowTitle = "Tracer" , windowConfigs = [ ( 0 , SDL.defaultWindow { SDL.windowInitialSize = V2 1280 720 , SDL.windowResizable = True , SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL { SDL.glProfile = SDL.Core SDL.Normal 3 3 } } , SDL.Windowed ) ] } :: AffectionConfig UserData withAffection config pre :: UserData -> Affection () pre ud = do ad <- A.get let (AffectionWindow awwindow _ _) = head $ drawWindows ad threadCtx <- SDL.glCreateContext awwindow SDL.glMakeCurrent awwindow (acContext $ head $ glContext ad) let Subsystems w _ k j _ = subsystems ud _ <- partSubscribe w (fitViewport (1280/720)) _ <- partSubscribe w (exitOnWindowClose ud) _ <- partSubscribe k toggleFullScreen _ <- partSubscribe k (quitGame ud) u <- partSubscribe j (cacheJoypad ud) (ws, _) <- yieldSystemT (0, defStorage) (return ()) void $ liftIO $ swapMVar (threadContext ud) (Just threadCtx) void $ liftIO $ swapMVar (window ud) (Just awwindow) void $ liftIO $ putMVar (worldState ud) ws void $ liftIO $ putMVar (joyUUID ud) u quitGame :: UserData -> KeyboardMessage -> Affection () quitGame ud (MsgKeyboardEvent _ _ SDL.Pressed False sym) | SDL.keysymKeycode sym == SDL.KeycodeEscape = void $ liftIO $ swapMVar (doNextStep ud) False | SDL.keysymKeycode sym == SDL.KeycodeF5 = do ad <- A.get curState <- liftIO $ readMVar (state ud) when (curState == Main WorldMap || curState == Main MindMap) $ do let Subsystems w m k j t = subsystems ud curUUID <- liftIO $ readMVar (uuid ud) mapM_ (partUnSubscribe w) curUUID mapM_ (partUnSubscribe m) curUUID mapM_ (partUnSubscribe k) curUUID mapM_ (partUnSubscribe j) curUUID mapM_ (partUnSubscribe t) curUUID SDL.glMakeCurrent (awWindow $ head $ drawWindows ad) (acContext $ head $ glContext ad) (ws, _) <- yieldSystemT (0, defStorage) (return ()) void $ liftIO $ swapMVar (worldState ud) ws void $ liftIO $ swapMVar (state ud) Load smLoad Load ud | otherwise = return () quitGame _ _ = return () toggleFullScreen :: KeyboardMessage -> Affection () toggleFullScreen (MsgKeyboardEvent _ _ SDL.Pressed False sym) | SDL.keysymKeycode sym == SDL.KeycodeF11 = toggleScreen 0 | otherwise = return () toggleFullScreen _ = return () update :: UserData -> Double -> Affection () update ud dt = do curState <- liftIO $ readMVar (state ud) smUpdate curState ud dt draw :: UserData -> Affection () draw ud = do curState <- liftIO $ readMVar (state ud) liftIO $ beginFrame (nano ud) 1280 720 1 smDraw curState ud liftIO $ endFrame (nano ud) handle :: UserData -> [SDL.EventPayload] -> Affection () handle ud evs = do s <- liftIO $ readMVar (state ud) smEvent s ud evs exitOnWindowClose :: UserData -> WindowMessage -> Affection () exitOnWindowClose ud (MsgWindowClose _ _) = do liftIO $ logIO A.Debug "Window Closed" void $ liftIO $ swapMVar (doNextStep ud) False exitOnWindowClose _ _ = return () clean :: UserData -> IO () clean ud = do tContext <- readMVar (threadContext ud) SDL.glDeleteContext $ fromJust tContext