More nesting of fields in CWorld

This commit is contained in:
2022-08-19 11:41:07 +01:00
parent 3b7841677a
commit 2e34481ab1
9 changed files with 58 additions and 40 deletions
+9 -7
View File
@@ -1,13 +1,15 @@
module Dodge.Clock
( clockCycle
) where
module Dodge.Clock (
clockCycle,
) where
import Control.Lens
import qualified Data.Vector as V
import Dodge.Data.World
import qualified Data.Vector as V
clockCycle :: Int -> V.Vector a -> World -> a
{-# INLINABLE clockCycle #-}
clockCycle tPeriod xs w = xs V.! i
{-# INLINEABLE clockCycle #-}
clockCycle tPeriod xs w = xs V.! i
where
l = V.length xs
t = _worldClock (_cWorld w) `mod` (l * tPeriod)
t = (w ^. cWorld . cwTime . worldClock) `mod` (l * tPeriod)
i = t `div` tPeriod
+9 -3
View File
@@ -173,7 +173,6 @@ data CWorld = CWorld
, _decorations :: IM.IntMap Picture
, _foregroundShapes :: IM.IntMap ForegroundShape
, _corpses :: IM.IntMap Corpse
, _clickMousePos :: Point2
, _pathGraph :: Gr Point2 PathEdge
, _pnZoning :: IM.IntMap (IM.IntMap [(Int, Point2)]) --Zoning IM.IntMap Creature
, _peZoning :: IM.IntMap (IM.IntMap [(Int, Int, PathEdge)]) --Zoning IM.IntMap Creature
@@ -184,12 +183,17 @@ data CWorld = CWorld
, _seenLocations :: IM.IntMap (WdP2, String)
, _selLocation :: Int
, _distortions :: [Distortion]
, _maybeWorld :: Maybe' CWorld
, _cwTime :: CWTime
, _cwGen :: CWGen
}
data CWTime = CWTime
{ _maybeWorld :: Maybe' CWorld
, _rewindWorlds :: [CWorld]
, _worldClock :: Int
, _deathDelay :: Maybe Int
, _cwGen :: CWGen
}
data CWGen = CWGen
{ _cwgParams :: GenParams
@@ -211,10 +215,12 @@ deriveJSON defaultOptions ''CWorld
deriveJSON defaultOptions ''WorldBeams
deriveJSON defaultOptions ''CWCam
deriveJSON defaultOptions ''CWGen
deriveJSON defaultOptions ''CWTime
makeLenses ''CWorld
makeLenses ''WorldBeams
makeLenses ''CWCam
makeLenses ''CWGen
makeLenses ''CWTime
-- $($(derive [d|
-- instance Deriving (Store CWorld)
-- |]))
+1
View File
@@ -39,6 +39,7 @@ data World = World
, _lrLine :: (Point2, Point2)
, _lSelect :: Point2
, _rSelect :: Point2
, _clickMousePos :: Point2
, _backspaceTimer :: Int
, _timeFlow :: TimeFlowStatus
, _rbOptions :: RightButtonOptions
+18 -9
View File
@@ -15,6 +15,7 @@ defaultWorld :: World
defaultWorld =
World
{ _cWorld = defaultCWorld
, _clickMousePos = V2 0 0
, _toPlaySounds = M.empty
, _playingSounds = M.empty
, _randGen = mkStdGen 2
@@ -109,17 +110,10 @@ defaultCWorld =
, _buttons = IM.empty
, _corpses = IM.empty
, _decorations = IM.empty
, _clickMousePos = V2 0 0
, _pathGraph = Data.Graph.Inductive.Graph.empty
, _pnZoning = mempty
, _peZoning = mempty
, _hud =
HUD
{ _hudElement = DisplayInventory NoSubInventory
, _carteCenter = V2 0 0
, _carteZoom = 0.5
, _carteRot = 0
}
, _hud = defaultHUD
, _lightSources = IM.empty
, _tempLightSources = []
, _closeObjects = []
@@ -131,12 +125,27 @@ defaultCWorld =
, _selLocation = 0
, _foregroundShapes = mempty
, _distortions = []
, _worldClock = 0
, _cwTime = defaultCWTime
}
defaultCWTime :: CWTime
defaultCWTime =
CWTime
{ _worldClock = 0
, _maybeWorld = Nothing'
, _rewindWorlds = []
, _deathDelay = Nothing
}
defaultHUD :: HUD
defaultHUD =
HUD
{ _hudElement = DisplayInventory NoSubInventory
, _carteCenter = V2 0 0
, _carteZoom = 0.5
, _carteRot = 0
}
defaultWorldHammers :: M.Map WorldHammer HammerPosition
defaultWorldHammers = M.fromSet (const HammerUp) $ S.fromList [minBound .. maxBound]
+4 -4
View File
@@ -26,10 +26,10 @@ onOffEff f g it
rewindEffect :: Item -> Creature -> World -> World
rewindEffect itm cr w
| Just invid == _crLeftInvSel cr =
w & cWorld . rewindWorlds %~ (take maxcharge . (cw :))
& ptrWpCharge .~ length (_rewindWorlds (_cWorld w))
w & cWorld . cwTime . rewindWorlds %~ (take maxcharge . (cw :))
& ptrWpCharge .~ length (w ^. cWorld . cwTime . rewindWorlds)
| otherwise =
w & cWorld . rewindWorlds .~ []
w & cWorld . cwTime . rewindWorlds .~ []
& ptrWpCharge .~ 0
where
invid = _ipInvID $ _itLocation itm
@@ -37,7 +37,7 @@ rewindEffect itm cr w
maxcharge = itm ^?! itUse . leftConsumption . wpMaxCharge
cw =
_cWorld w
& rewindWorlds .~ []
& cwTime . rewindWorlds .~ []
--resetAttachmentEffect :: Item -> Creature -> World -> World
--resetAttachmentEffect itm cr w
+1 -1
View File
@@ -459,7 +459,7 @@ withTempLight time rad col eff item cr =
modClock :: Int -> ChainEffect -> ChainEffect
modClock n chainEff eff it cr w
| _worldClock (_cWorld w) `mod` n == 0 = chainEff eff it cr w
| (w ^. cWorld . cwTime . worldClock) `mod` n == 0 = chainEff eff it cr w
| otherwise = eff it cr w
withMuzFlareI :: ChainEffect
+3 -3
View File
@@ -20,7 +20,7 @@ useL lu = case lu of
LBoost -> boostSelfL 10
useRewindGun :: Item -> Creature -> World -> World
useRewindGun _ _ w = case _rewindWorlds (_cWorld w) of
useRewindGun _ _ w = case w ^. cWorld . cwTime . rewindWorlds of
[w'] -> rewindusing w' [w']
(w' : ws) -> rewindusing w' ws
_ -> w
@@ -28,10 +28,10 @@ useRewindGun _ _ w = case _rewindWorlds (_cWorld w) of
rewindusing :: CWorld -> [CWorld] -> World
rewindusing w' ws =
w
& cWorld . maybeWorld
& cWorld . cwTime . maybeWorld
.~ Just'
( w'
& rewindWorlds .~ ws
& cwTime . rewindWorlds .~ ws
)
-- be careful changing this around; potential problems include updating the
+6 -6
View File
@@ -88,7 +88,7 @@ functionalUpdate w =
checkEndGame
-- . updateRandGen
. over uvWorld (mouseButtons . each .~ True) -- to determine if the mouse button is held
. over uvWorld (cWorld . worldClock +~ 1)
. over uvWorld (cWorld . cwTime . worldClock +~ 1)
. over uvWorld updateWorldSelect
. over uvWorld doRewind
. over uvWorld (hammers . each %~ moveHammerUp)
@@ -219,7 +219,7 @@ setOldPos cr =
--updateRandGen = randGen %~ (snd . (uniform :: StdGen -> (Int,StdGen)))
doRewind :: World -> World
doRewind w = case _maybeWorld (_cWorld w) of
doRewind w = case w ^. cWorld . cwTime . maybeWorld of
Just' cw ->
w & cWorld .~ cw
& timeFlow .~ RewindingLastFrame
@@ -444,13 +444,13 @@ markSeen :: Wall -> Wall
markSeen wl = wl{_wlSeen = True}
checkEndGame :: Universe -> Universe
checkEndGame uv = case _deathDelay (_cWorld w) of
checkEndGame uv = case w ^. cWorld . cwTime . deathDelay of
Just x
| x < 0 ->
uv & uvScreenLayers .~ [gameOverMenu]
& uvWorld . cWorld . deathDelay .~ Nothing
Just _ -> uv & uvWorld . cWorld . deathDelay . _Just -~ 1
_ | _crHP (you w) < 1 -> uv & uvWorld . cWorld . deathDelay ?~ 50
& uvWorld . cWorld . cwTime . deathDelay .~ Nothing
Just _ -> uv & uvWorld . cWorld . cwTime . deathDelay . _Just -~ 1
_ | _crHP (you w) < 1 -> uv & uvWorld . cWorld . cwTime . deathDelay ?~ 50
_ -> uv
where
w = _uvWorld uv
+7 -7
View File
@@ -61,7 +61,7 @@ updatePressedButtons' pkeys w
| isDown ButtonRight && inTopInv = w
| isDown ButtonMiddle =
w & cWorld . cwCam . cwcRot -~ rotation
& cWorld . clickMousePos .~ _mousePos w
& clickMousePos .~ _mousePos w
| isDown ButtonLeft = w & hammers . ix DoubleMouseHam .~ HammerDown
| otherwise = w
where
@@ -69,7 +69,7 @@ updatePressedButtons' pkeys w
DisplayInventory NoSubInventory -> True
_ -> False
isDown but = but `M.member` pkeys
rotation = angleBetween (_mousePos w) (_clickMousePos (_cWorld w))
rotation = angleBetween (_mousePos w) (_clickMousePos w)
-- note "sort" on the inventory indices; otherwise
-- lower items may be shifted up and items below these removed instead
@@ -90,16 +90,16 @@ updatePressedButtonsCarte :: M.Map MouseButton Bool -> World -> World
updatePressedButtonsCarte pkeys w
| isDown ButtonRight =
w
& cWorld . clickMousePos .~ _mousePos w
& clickMousePos .~ _mousePos w
& cWorld . hud . carteCenter %~ (-.- trans)
| isDown ButtonLeft =
w
& cWorld . clickMousePos .~ _mousePos w
& clickMousePos .~ _mousePos w
& cWorld . hud . carteRot -~ rot
& cWorld . hud . carteZoom *~ czoom
| otherwise = w
where
isDown but = but `M.member` pkeys
rot = angleBetween (_mousePos w) (_clickMousePos (_cWorld w))
czoom = magV (_mousePos w) / magV (_clickMousePos (_cWorld w))
trans = rotateV (_carteRot (_hud (_cWorld w))) $ 1 / _carteZoom (_hud (_cWorld w)) *.* (_mousePos w -.- _clickMousePos (_cWorld w))
rot = angleBetween (_mousePos w) (_clickMousePos w)
czoom = magV (_mousePos w) / magV (_clickMousePos w)
trans = rotateV (_carteRot (_hud (_cWorld w))) $ 1 / _carteZoom (_hud (_cWorld w)) *.* (_mousePos w -.- _clickMousePos w)