{-# LANGUAGE ForeignFunctionInterface #-} module Main where import Affection as A import qualified SDL import NanoVG hiding (V2(..), V3(..)) import Graphics.Rendering.OpenGL.GL.FlushFinish (finish) import Linear import Foreign.C.Types (CInt(..)) import Data.Maybe (fromJust) -- internal imports import Types import StateMachine () import Init foreign import ccall unsafe "glewInit" glewInit :: IO CInt main :: IO () main = do let config = AffectionConfig { initComponents = All , windowTitle = "Tracer" , windowConfig = SDL.defaultWindow { SDL.windowInitialSize = V2 1280 720 , SDL.windowResizable = True , SDL.windowOpenGL = Just 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 -- _ <- SDL.glSetAttribute SDL.SDL_GL_SHARE_WITH_CURRENT_CONTEXT 1 threadContext <- SDL.glCreateContext (drawWindow ad) SDL.glMakeCurrent (drawWindow ad) (glContext ad) Subsystems w m k <- subsystems <$> getAffection _ <- partSubscribe w (fitViewport (1280/720)) _ <- partSubscribe w exitOnWindowClose putAffection ud { threadContext = Just threadContext , mainContext = Just (glContext ad) , window = Just (drawWindow ad) } 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 = do SDL.glDeleteContext $ fromJust $ threadContext ud