pituicat/examples/example00.hs
2017-12-13 15:19:53 +01:00

72 lines
1.8 KiB
Haskell

{-# 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 ()