Apply side effects to universe not world

This commit is contained in:
2021-11-28 11:43:17 +00:00
parent 24480bbe52
commit d6fb6adc66
4 changed files with 52 additions and 28 deletions
+5 -1
View File
@@ -52,6 +52,9 @@ import qualified Data.Map.Strict as M
import SDL (Scancode, MouseButton)
import Data.Monoid
type CRUpdate = Creature -> World -> (Endo World, Maybe Creature)
data Universe = Universe
{ _uvWorld :: World
}
data World = World
{ _keys :: !(S.Set Scancode)
, _mouseButtons :: !(S.Set MouseButton)
@@ -105,7 +108,7 @@ data World = World
, _closeActiveObjects :: [Either FloorItem Button]
, _seenLocations :: IM.IntMap (World -> Point2,String)
, _selLocation :: Int
, _sideEffects :: World -> IO World
, _sideEffects :: Universe -> IO Universe
, _inventoryMode :: InventoryMode
, _distortions :: [Distortion]
, _worldBounds :: Bounds
@@ -900,3 +903,4 @@ makeLenses ''ItemDimension
makeLenses ''Vocalization
makeLenses ''UseDelay
makeLenses ''AimParams
makeLenses ''Universe
+15 -8
View File
@@ -18,11 +18,12 @@ import Dodge.Event.Keyboard
import Dodge.Data
import Dodge.Base
import Dodge.Base.Window
import Dodge.PreloadData
--import Dodge.Creature.Action
import Dodge.SoundLogic
import Dodge.Inventory
--import Geometry
import Preload.Update
--import Preload.Update
import qualified IntMapHelp as IM
import Control.Lens
@@ -33,8 +34,14 @@ import Control.Lens
import qualified Data.Set as S
import SDL
handleEvent :: Event -> World -> Maybe World
handleEvent e = case eventPayload e of
handleEvent :: Event -> Universe -> Maybe Universe
handleEvent e uv = case handleEvent' e (_uvWorld uv) of
Nothing -> Nothing
Just w -> Just $ uv & uvWorld .~ w
handleEvent' :: Event -> World -> Maybe World
handleEvent' e = case eventPayload e of
KeyboardEvent kev -> handleKeyboardEvent kev
MouseMotionEvent mmev -> handleMouseMotionEvent mmev
MouseButtonEvent mbev -> handleMouseButtonEvent mbev
@@ -70,13 +77,13 @@ handleResizeEvent :: WindowSizeChangedEventData -> World -> Maybe World
handleResizeEvent sev w = Just
. set (config . windowX) (fromIntegral x)
. set (config . windowY) (fromIntegral y)
$ over sideEffects up
$ over sideEffects (sideEffectUpdatePreload divRes x y)
w
where
up :: (World -> IO World) -> World -> IO World
up f w' = do
pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData w')
f $ w' & preloadData .~ pdata
-- up :: (World -> IO World) -> World -> IO World
-- up f w' = do
-- pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData w')
-- f $ w' & preloadData .~ pdata
x = fromIntegral x'
y = fromIntegral y'
V2 x' y' = windowSizeChangedEventSize sev
+10 -5
View File
@@ -159,11 +159,16 @@ pauseMenuOptions =
startNewGame :: World -> Maybe World
startNewGame w = Just $ w
& menuLayers .~ [WaitScreen (const "GENERATING...") 1]
& sideEffects .~ const (generateWorldFromSeed i <&> keyConfig .~ _keyConfig w <&> config .~ _config w
<&> preloadData .~ _preloadData w) -- this kills save games etc...
& sideEffects .~ uvWorld (uvWorldSideEffects i w)
where
i = fst $ random (_randGen w)
uvWorldSideEffects :: Int -> World -> b -> IO World
uvWorldSideEffects i w = const (generateWorldFromSeed i <&> keyConfig .~ _keyConfig w <&> config .~ _config w
<&> preloadData .~ _preloadData w)
-- this kills save games etc...
-- | hacky
scodeToChar :: Scancode -> Char
scodeToChar = toEnum . (+ 61) . fromIntegral . toNumber
@@ -176,10 +181,10 @@ updateFramebufferSize w = w & sideEffects %~ up
where
(x,y) = (round $ getWindowX w, round $ getWindowY w)
divRes = w ^. config . resolution_factor
up :: (World -> IO World) -> World -> IO World
up :: (Universe -> IO Universe) -> Universe -> IO Universe
up f w' = do
pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData w')
f $ w' & preloadData .~ pdata
pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData (_uvWorld w'))
f $ w' & uvWorld . preloadData .~ pdata
--levelMenu :: Int -> ScreenLayer
--levelMenu x = OptionScreen