More nesting of fields in CWorld
This commit is contained in:
+9
-7
@@ -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
|
||||
|
||||
@@ -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)
|
||||
-- |]))
|
||||
|
||||
@@ -39,6 +39,7 @@ data World = World
|
||||
, _lrLine :: (Point2, Point2)
|
||||
, _lSelect :: Point2
|
||||
, _rSelect :: Point2
|
||||
, _clickMousePos :: Point2
|
||||
, _backspaceTimer :: Int
|
||||
, _timeFlow :: TimeFlowStatus
|
||||
, _rbOptions :: RightButtonOptions
|
||||
|
||||
@@ -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]
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
@@ -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
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user