Make concrete world read/showable

This commit is contained in:
2022-07-25 12:23:21 +01:00
parent f8f9fbe800
commit f5604ef429
6 changed files with 15 additions and 13 deletions
+3 -3
View File
@@ -291,8 +291,8 @@ data CWorld = CWorld
, _worldBounds :: Bounds , _worldBounds :: Bounds
, _gameRooms :: [GameRoom] -- consider using an IntMap , _gameRooms :: [GameRoom] -- consider using an IntMap
, _roomClipping :: [ConvexPoly] , _roomClipping :: [ConvexPoly]
, _maybeWorld :: Maybe' World , _maybeWorld :: Maybe' CWorld
, _rewindWorlds :: [World] , _rewindWorlds :: [CWorld]
, _timeFlow :: TimeFlowStatus , _timeFlow :: TimeFlowStatus
, _worldClock :: Int , _worldClock :: Int
, _hammers :: M.Map WorldHammer HammerPosition , _hammers :: M.Map WorldHammer HammerPosition
@@ -305,7 +305,7 @@ data CWorld = CWorld
, _lSelect :: Point2 , _lSelect :: Point2
, _rSelect :: Point2 , _rSelect :: Point2
} }
--deriving (Eq,Show,Read) deriving (Eq,Show,Read)
data TimeFlowStatus data TimeFlowStatus
= RewindingNow = RewindingNow
| RewindingLastFrame | RewindingLastFrame
+4 -3
View File
@@ -29,7 +29,7 @@ onOffEff f g it
rewindEffect :: Item -> Creature -> World -> World rewindEffect :: Item -> Creature -> World -> World
rewindEffect itm cr w rewindEffect itm cr w
| Just invid == _crLeftInvSel cr = w & cWorld . rewindWorlds %~ (take maxcharge . (w' : )) | Just invid == _crLeftInvSel cr = w & cWorld . rewindWorlds %~ (take maxcharge . (cw : ))
& ptrWpCharge .~ length (_rewindWorlds (_cWorld w)) & ptrWpCharge .~ length (_rewindWorlds (_cWorld w))
| otherwise = w & cWorld . rewindWorlds .~ [] | otherwise = w & cWorld . rewindWorlds .~ []
& ptrWpCharge .~ 0 & ptrWpCharge .~ 0
@@ -37,8 +37,9 @@ rewindEffect itm cr w
invid = _ipInvID $ _itPos itm invid = _ipInvID $ _itPos itm
ptrWpCharge = cWorld . creatures . ix (_crID cr) . crInv . ix invid . itConsumption . wpCharge ptrWpCharge = cWorld . creatures . ix (_crID cr) . crInv . ix invid . itConsumption . wpCharge
maxcharge = _wpMaxCharge . _itConsumption $ itm maxcharge = _wpMaxCharge . _itConsumption $ itm
w' = w & cWorld . rewindWorlds .~ [] cw = _cWorld w
& cWorld . timeFlow .~ NormalTimeFlow & rewindWorlds .~ []
& timeFlow .~ NormalTimeFlow
resetAttachmentEffect :: Item -> Creature -> World -> World resetAttachmentEffect :: Item -> Creature -> World -> World
resetAttachmentEffect itm cr w resetAttachmentEffect itm cr w
+3 -3
View File
@@ -21,13 +21,13 @@ useRewindGun _ _ w = case _rewindWorlds (_cWorld w) of
(w':ws) -> rewindusing w' ws (w':ws) -> rewindusing w' ws
_ -> w _ -> w
where where
rewindusing :: CWorld -> [CWorld] -> World
rewindusing w' ws = w rewindusing w' ws = w
& cWorld . maybeWorld .~ Just' ( w' & cWorld . maybeWorld .~ Just' ( w'
-- & creatures . ix (_crID cr) .~ cr
& upbuts & upbuts
& cWorld . rewindWorlds .~ ws & rewindWorlds .~ ws
) )
upbuts = (cWorld . keys .~ _keys (_cWorld w)) . (cWorld . mouseButtons .~ _mouseButtons (_cWorld w)) upbuts = (keys .~ _keys (_cWorld w)) . (mouseButtons .~ _mouseButtons (_cWorld w))
-- be careful changing this around; potential problems include updating the -- be careful changing this around; potential problems include updating the
-- creature but using the old crInvSel value -- creature but using the old crInvSel value
+2 -2
View File
@@ -199,8 +199,8 @@ setOldPos cr = cr
doRewind :: World -> World doRewind :: World -> World
doRewind w = case _maybeWorld (_cWorld w) of doRewind w = case _maybeWorld (_cWorld w) of
Just' w' -> w' & cWorld . timeFlow .~ RewindingLastFrame Just' cw -> w & cWorld .~ (cw & timeFlow .~ RewindingLastFrame)
Nothing' -> w & cWorld . timeFlow .~ NormalTimeFlow Nothing' -> w & cWorld . timeFlow .~ NormalTimeFlow
zoneCreatures :: World -> World zoneCreatures :: World -> World
zoneCreatures w = w zoneCreatures w = w
+2 -1
View File
@@ -4,8 +4,9 @@ module FoldlHelp
, module Control.Foldl , module Control.Foldl
) where ) where
import Control.Foldl import Control.Foldl
import MaybeHelp
data Maybe' a = Just' !a | Nothing' --data Maybe' a = Just' !a | Nothing'
data Pair a b = !a :!: !b data Pair a b = !a :!: !b
minimumOn :: Ord b => (a -> b) -> Fold a (Maybe a) minimumOn :: Ord b => (a -> b) -> Fold a (Maybe a)
+1 -1
View File
@@ -4,7 +4,7 @@ module MaybeHelp where
import Control.Lens import Control.Lens
data Maybe' a = Just' {__Just' :: a} | Nothing' data Maybe' a = Just' {__Just' :: a} | Nothing'
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show,Read)
fromJust' :: Maybe' a -> a fromJust' :: Maybe' a -> a
fromJust' mx = case mx of fromJust' mx = case mx of