Work on saving/loading concurrently

2022-08-18 10:05:24 +01:00
parent 26e88f059a
commit c74d3b04bf
20 changed files with 232 additions and 154 deletions
@@ -2,9 +2,24 @@ module Dodge.Concurrent where

 import Dodge.Data.Universe
 --import qualified Data.Set as S
--import Control.Lens
+import Control.Lens
 --import Control.Concurrent
 --import SDL.Input.Keyboard.Codes

-conTest :: Universe -> Maybe (IO (Universe -> Universe))
-conTest = _uvConcEffects
+conEffects :: Universe -> Maybe (Universe -> Universe,IO (Universe -> Maybe Universe))
+conEffects u = case u ^. uvConcEffects of
+    NewConcEffect {_ceFunction = eff} -> Just eff
+    _ -> Nothing
+
+tryConcEffect :: Bool -> String -> IO (Universe -> Maybe Universe) -> Universe -> Universe
+tryConcEffect bl str eff u = case u ^. uvConcEffects of
+    NoConcEffect -> u & uvConcEffects .~ NewConcEffect (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))