46 lines
1.6 KiB
Haskell
46 lines
1.6 KiB
Haskell
module Dodge.Concurrent where
|
|
|
|
--import qualified Data.Set as S
|
|
import Control.Lens
|
|
import Dodge.Data.Universe
|
|
import Data.Sequence (Seq (..))
|
|
|
|
--import Control.Concurrent
|
|
--import SDL.Input.Keyboard.Codes
|
|
|
|
conEffects :: Universe -> ConcurrentEffect Universe
|
|
conEffects u = case u ^? uvSideEffects . _head of
|
|
Just NewSideEffect{_ceSideEffect = eff} -> ConcurrentEffect (u & uvSideEffects . _head %~ g)
|
|
(dopop eff)
|
|
Just HardQuit -> ImmediateEffect (return Nothing)
|
|
_ -> NoConcurrentEffect
|
|
where
|
|
g seff = RunningSideEffect (_ceString seff)
|
|
dopop :: IO (Universe -> Maybe Universe) -> IO (Universe -> Maybe Universe)
|
|
dopop mf = do
|
|
f <- mf
|
|
return $ f . (uvSideEffects %~ taker)
|
|
taker (_ :<| xs) = xs
|
|
taker _ = mempty
|
|
|
|
addSideEffect :: IO (Universe -> Maybe Universe) -> String -> Universe -> Universe
|
|
addSideEffect f s = uvSideEffects %~ (|> NewSideEffect f s)
|
|
|
|
hardQuit :: Universe -> Universe
|
|
hardQuit = uvSideEffects %~ (HardQuit <|)
|
|
--hardQuit = addSideEffect (return $ const Nothing) "QUITTING"
|
|
|
|
--tryConcEffect :: Bool -> String -> IO (Universe -> Maybe Universe) -> Universe -> Universe
|
|
--tryConcEffect bl str eff u = case u ^. uvConcEffects of
|
|
-- NoConcEffect -> u & uvConcEffects .~ NewConcEffect (ConcurrentEffect setstr (clearConcEff eff)) str bl
|
|
-- _ -> u
|
|
-- where
|
|
-- setstr
|
|
-- | bl = uvConcEffects .~ BlockingConcEffect str
|
|
-- | otherwise = uvConcEffects .~ BackgroundConcEffect str
|
|
|
|
--clearConcEff :: IO (Universe -> Maybe Universe) -> IO (Universe -> Maybe Universe)
|
|
--clearConcEff eff = do
|
|
-- f <- eff
|
|
-- return (f . (uvConcEffects .~ NoConcEffect))
|