{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RankNTypes #-} import Affection import qualified SDL import Control.Concurrent.STM data StateData = StateData { sdSubs :: Subsystems } data Subsystems = Subsystems { subWindow :: AffectionWindow StateData , subMouse :: AffectionMouse StateData , subKeyboard :: AffectionKeyboard StateData } main :: IO () main = do logIO Debug "Starting" let conf = AffectionConfig { initComponents = All , windowTitle = "affection: example00" , windowConfig = SDL.defaultWindow , initScreenMode = SDL.Windowed , canvasSize = Nothing , loadState = load , preLoop = pre , eventLoop = handle , updateLoop = update , drawLoop = draw , cleanUp = clean } withAffection conf load :: IO StateData load = do empty1 <- newTVarIO [] -- ([] :: [(UUID, WindowMessage -> Affection StateData ())]) empty2 <- newTVarIO [] -- ([] :: [(UUID, MouseMessage -> Affection StateData ())]) empty3 <- newTVarIO [] -- ([] :: [(UUID, KeyboardMessage -> Affection StateData ())]) return $ StateData $ Subsystems (AffectionWindow empty1) (AffectionMouse empty2) (AffectionKeyboard empty3) pre :: Affection StateData () pre = do sd <- getAffection _ <- partSubscribe (subKeyboard $ sdSubs sd) exitOnQ return () exitOnQ :: KeyboardMessage -> Affection StateData () exitOnQ (MsgKeyboardEvent _ _ _ _ sym) = case SDL.keysymKeycode sym of SDL.KeycodeQ -> quit otherwise -> return () handle :: [SDL.EventPayload] -> Affection StateData () handle es = do (Subsystems a b c) <- sdSubs <$> getAffection _ <- consumeSDLEvents a es _ <- consumeSDLEvents b es _ <- consumeSDLEvents c es return () update _ = return () draw = return () clean _ = return ()