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