{-# 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 (when) -- internal imports import Types hiding (draw) import StateMachine () import Init import Util foreign import ccall unsafe "glewInit" glewInit :: IO CInt 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 } } ) ] , canvasSize = Nothing , preLoop = pre >> smLoad Load , eventLoop = handle , updateLoop = update , drawLoop = draw , loadState = Init.init , cleanUp = clean , initScreenMode = SDL.Windowed } withAffection config pre :: Affection UserData () pre = do ad <- A.get ud <- getAffection threadCtx <- SDL.glCreateContext (snd $ head $ drawWindows ad) SDL.glMakeCurrent (snd $ head $ drawWindows ad) (snd $ head $ glContext ad) let Subsystems w m k j t = subsystems ud _ <- partSubscribe w (fitViewport (1280/720)) _ <- partSubscribe w exitOnWindowClose _ <- partSubscribe k toggleFullScreen _ <- partSubscribe k quitGame u <- partSubscribe j cacheJoypad (ws, _) <- yieldSystemT (0, defStorage) (return ()) putAffection ud { threadContext = Just threadCtx , window = Just (snd $ head $ drawWindows ad) , worldState = ws , joyUUID = u } quitGame :: KeyboardMessage -> Affection UserData () quitGame (MsgKeyboardEvent _ _ SDL.Pressed False sym) | SDL.keysymKeycode sym == SDL.KeycodeEscape = quit | SDL.keysymKeycode sym == SDL.KeycodeF5 = do ad <- A.get ud <- getAffection when (state ud == Main WorldMap || state ud == Main MindMap) $ do let Subsystems w m k j t = subsystems ud mapM_ (partUnSubscribe w) (uuid ud) mapM_ (partUnSubscribe m) (uuid ud) mapM_ (partUnSubscribe k) (uuid ud) mapM_ (partUnSubscribe j) (uuid ud) mapM_ (partUnSubscribe t) (uuid ud) SDL.glMakeCurrent (snd $ head $ drawWindows ad) (snd $ head $ glContext ad) (ws, _) <- yieldSystemT (0, defStorage) (return ()) putAffection ud { worldState = ws , state = Load } smLoad Load | otherwise = return () quitGame _ = return () toggleFullScreen :: KeyboardMessage -> Affection UserData () toggleFullScreen (MsgKeyboardEvent _ _ SDL.Pressed False sym) | SDL.keysymKeycode sym == SDL.KeycodeF11 = toggleScreen | otherwise = return () toggleFullScreen _ = return () update :: Double -> Affection UserData () update dt = do ud <- getAffection smUpdate (state ud) dt draw :: Affection UserData () draw = do ud <- getAffection liftIO $ beginFrame (nano ud) 1280 720 1 smDraw (state ud) liftIO $ endFrame (nano ud) handle :: [SDL.EventPayload] -> Affection UserData () handle evs = do s <- state <$> getAffection smEvent s evs exitOnWindowClose :: WindowMessage -> Affection UserData () exitOnWindowClose (MsgWindowClose _ _) = do liftIO $ logIO A.Debug "Window Closed" quit exitOnWindowClose _ = return () clean :: UserData -> IO () clean ud = SDL.glDeleteContext $ fromJust $ threadContext ud