affection/examples/example00.hs

72 lines
1.8 KiB
Haskell
Raw Normal View History

2016-11-04 15:06:16 +00:00
{-# LANGUAGE RecordWildCards #-}
2017-12-13 14:19:53 +00:00
{-# LANGUAGE RankNTypes #-}
2016-11-04 15:06:16 +00:00
2016-05-29 16:01:23 +00:00
import Affection
2016-11-04 15:06:16 +00:00
import qualified SDL
2017-12-13 14:19:53 +00:00
import Control.Concurrent.STM
2016-12-26 13:06:51 +00:00
2017-12-13 14:19:53 +00:00
data StateData = StateData
{ sdSubs :: Subsystems
}
2016-11-04 15:06:16 +00:00
2017-12-13 14:19:53 +00:00
data Subsystems = Subsystems
{ subWindow :: AffectionWindow StateData
, subMouse :: AffectionMouse StateData
, subKeyboard :: AffectionKeyboard StateData
}
2016-05-29 16:01:23 +00:00
main :: IO ()
2016-11-04 15:06:16 +00:00
main = do
2017-12-13 14:19:53 +00:00
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
}
2016-11-04 15:06:16 +00:00
withAffection conf
2017-12-13 14:19:53 +00:00
load :: IO StateData
2017-03-23 03:27:57 +00:00
load = do
2017-12-13 14:19:53 +00:00
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 ()
2016-11-04 15:06:16 +00:00
2017-12-13 14:19:53 +00:00
exitOnQ :: KeyboardMessage -> Affection StateData ()
exitOnQ (MsgKeyboardEvent _ _ _ _ sym) =
case SDL.keysymKeycode sym of
SDL.KeycodeQ -> quit
otherwise -> return ()
2016-11-04 15:06:16 +00:00
2017-12-13 14:19:53 +00:00
handle :: [SDL.EventPayload] -> Affection StateData ()
handle es = do
(Subsystems a b c) <- sdSubs <$> getAffection
_ <- consumeSDLEvents a es
_ <- consumeSDLEvents b es
_ <- consumeSDLEvents c es
return ()
2017-12-13 14:19:53 +00:00
update _ = return ()
2017-12-13 14:19:53 +00:00
draw = return ()
2016-11-13 12:46:23 +00:00
clean _ = return ()