Commit mid add time scroll

This commit is contained in:
2022-10-24 10:44:23 +01:00
parent 21dc670c9f
commit 86a9ab7582
17 changed files with 62 additions and 55 deletions
+1 -1
View File
@@ -11,5 +11,5 @@ clockCycle :: Int -> V.Vector a -> World -> a
clockCycle tPeriod xs w = xs V.! i
where
l = V.length xs
t = (w ^. cWorld . cwTime . worldClock) `mod` (l * tPeriod)
t = (w ^. cwTime . worldClock) `mod` (l * tPeriod)
i = t `div` tPeriod
+2 -1
View File
@@ -30,7 +30,8 @@ useItem cr' w = fromMaybe (f w) $ do
itemEffect :: Creature -> Item -> World -> World
itemEffect cr it w = case it ^. itUse of
HeldUse{_heldUse = eff, _heldMods = usemods} ->
hammerTest $ tryReload cr it w $ foldl' (&) (useHeld eff) (reverse $ useMod usemods) it cr
hammerTest $ tryReload cr it w $ foldl' (&) (useHeld eff) (useMod usemods) it cr
--hammerTest $ tryReload cr it w $ foldl' (&) (useHeld eff) (reverse $ useMod usemods) it cr
LeftUse{} -> doequipmentchange
EquipUse{} -> doequipmentchange
-- ConsumeUse will cause problems if the item is not selected
+1 -20
View File
@@ -114,18 +114,7 @@ data CWCam = CWCam
, _cwcBoundDist :: (Float, Float, Float, Float) -- NSEW, S and W negative
}
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data CWorld = CWorld
--{ _cameraCenter :: Point2
--, _cameraRot :: Float
--, _cameraZoom :: Float -- smaller values zoom out
--, _itemZoom :: Float
--, _defaultZoom :: Float
--, _cameraViewFrom :: Point2
--, _viewDistance :: Float
--, _boundBox :: [Point2]
--, _boundDist :: (Float, Float, Float, Float) -- NSEW, S and W negative
{ _cwCam :: CWCam
, _creatures :: IM.IntMap Creature
, _crZoning :: IM.IntMap (IM.IntMap IS.IntSet)
@@ -186,19 +175,12 @@ data CWorld = CWorld
, _seenLocations :: IM.IntMap (WdP2, String)
, _selLocation :: Int
, _distortions :: [Distortion]
, _cwTime :: CWTime
, _cwGen :: CWGen
}
--deriving (Eq, Show, Read) --, Generic)
--h--deriving (Eq, Show, Read) --Generic, Flat)
data CWTime = CWTime
{ _maybeWorld :: Maybe' CWorld
, _rewindWorlds :: [CWorld]
, _worldClock :: Int
, _deathDelay :: Maybe Int
}
--deriving (Eq, Show, Read) --, Generic)
--h--deriving (Eq, Show, Read) --Generic, Flat)
@@ -226,13 +208,12 @@ makeLenses ''CWorld
makeLenses ''WorldBeams
makeLenses ''CWCam
makeLenses ''CWGen
makeLenses ''CWTime
concat
<$> mapM
(deriveJSON defaultOptions)
[ ''WorldBeams
, ''CWCam
, ''CWGen
, ''CWTime
-- , ''CWTime
, ''CWorld
]
+1
View File
@@ -19,6 +19,7 @@ data HeldScroll
{ _hsInt :: Int
, _hsMaxInt :: Int
}
| HeldScrollTime
deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''HeldScroll
+2 -2
View File
@@ -10,7 +10,7 @@ import Data.Aeson.TH
import Dodge.Data.CamouflageStatus
import Dodge.Data.Item.Combine
data HeldUse
data Huse
= HeldDoNothing
| HeldUseAmmoParams
| HeldOverNozzlesUseGasParams
@@ -94,5 +94,5 @@ data HeldMod
deriveJSON defaultOptions ''Cuse
deriveJSON defaultOptions ''HeldMod
deriveJSON defaultOptions ''Euse
deriveJSON defaultOptions ''HeldUse
deriveJSON defaultOptions ''Huse
deriveJSON defaultOptions ''Luse
+1 -1
View File
@@ -25,7 +25,7 @@ import Dodge.Data.Item.HeldDelay
data ItemUse
= HeldUse
{ _heldUse :: HeldUse
{ _heldUse :: Huse
, _heldDelay :: UseDelay
, _heldMods :: HeldMod
, _heldHammer :: HammerPosition
+12
View File
@@ -23,6 +23,7 @@ import Dodge.Data.SoundOrigin
import Geometry.Data
import SDL (MouseButton, Scancode)
import Sound.Data
import MaybeHelp
import System.Random
data World = World
@@ -44,12 +45,14 @@ data World = World
, _backspaceTimer :: Int
, _timeFlow :: TimeFlowStatus
, _rbOptions :: RightButtonOptions
, _cwTime :: CWTime
}
data TimeFlowStatus
= RewindingNow
| RewindingLastFrame
| NormalTimeFlow
| ScrollTimeFlow
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data WorldHammer
@@ -57,4 +60,13 @@ data WorldHammer
| DoubleMouseHam
deriving (Eq, Ord, Show, Read, Enum, Bounded)
data CWTime = CWTime
{ _maybeWorld :: Maybe' CWorld
, _rewindWorlds :: [CWorld]
, _futureWorlds :: [CWorld]
, _worldClock :: Int
, _deathDelay :: Maybe Int
}
makeLenses ''World
makeLenses ''CWTime
+2 -1
View File
@@ -32,6 +32,7 @@ defaultWorld =
, _backspaceTimer = 0
, _timeFlow = NormalTimeFlow
, _rbOptions = NoRightButtonOptions
, _cwTime = defaultCWTime
}
defaultCWGen :: CWGen
@@ -125,7 +126,6 @@ defaultCWorld =
, _selLocation = 0
, _foregroundShapes = mempty
, _distortions = []
, _cwTime = defaultCWTime
}
defaultCWTime :: CWTime
@@ -134,6 +134,7 @@ defaultCWTime =
{ _worldClock = 0
, _maybeWorld = Nothing'
, _rewindWorlds = []
, _futureWorlds = []
, _deathDelay = Nothing
}
+1 -1
View File
@@ -107,7 +107,7 @@ wheelEvent y w = case _hudElement $ _hud (_cWorld w) of
| rbDown -> case (yourItem w ^? _Just . itUse . heldScroll, _rbOptions w) of
(_, EquipOptions{}) -> scrollRBOption y w
(Nothing, _) -> closeObjScrollDir y w
(Just f, _) -> w & cWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ doHeldScroll f y (you w)
(Just f, _) -> doHeldScroll f y (you w) w
| lbDown -> w & cWorld . cwCam . cwcZoom +~ y
| invKeyDown -> changeSwapInvSel yi w
| otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
+17 -3
View File
@@ -2,19 +2,33 @@ module Dodge.HeldScroll (
doHeldScroll,
) where
import Dodge.Base.You
import Control.Lens hiding ((<|), (|>))
import Data.Sequence
import Dodge.Data.Creature
import Dodge.Data.World
import Dodge.Item.Weapon.ZoomScope
import LensHelp hiding ((|>), (<|))
-- should be able to just import data.item
doHeldScroll :: HeldScroll -> Float -> Creature -> Item -> Item
doHeldScroll :: HeldScroll -> Float -> Creature -> World -> World
doHeldScroll hs = case hs of
HeldScrollDoNothing -> const . const id
HeldScrollZoom -> zoomLongGun
HeldScrollCharMode{} -> \x _ -> itUse . heldScroll . hsCharMode %~ cycleSignum x
HeldScrollZoom -> overYourItem zoomLongGun
HeldScrollCharMode{} -> overYourItem $ \x _ -> itUse . heldScroll . hsCharMode %~ cycleSignum x
HeldScrollTime -> doScrollTime
HeldScrollInt{} -> undefined
where
overYourItem f x cr w = w & cWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ f x cr
doScrollTime :: Float -> Creature -> World -> World
doScrollTime x _ w
| x > 0 = case _futureWorlds $ _cwTime w of
(w':ws) -> w -- & cWorld .~ w'
-- & cwTime . futureWorlds %~ tail
-- & cwTime . rewindWorlds .:~ _cWorld w
_ -> w
| otherwise = w
cycleSignum :: Float -> Seq a -> Seq a
cycleSignum x
| x > 0 = cycleL
+1 -1
View File
@@ -359,7 +359,7 @@ mcUseHeld hit = case hit of
LASGUN -> mcShootLaser
_ -> \_ _ -> id
useHeld :: HeldUse -> Item -> Creature -> World -> World
useHeld :: Huse -> Item -> Creature -> World -> World
useHeld hu = case hu of
HeldDoNothing -> const $ const id
HeldUseAmmoParams -> useAmmoParams
+3 -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 . cwTime . rewindWorlds %~ (take maxcharge . (cw :))
& ptrWpCharge .~ length (w ^. cWorld . cwTime . rewindWorlds)
w & cwTime . rewindWorlds %~ (take maxcharge . (cw :))
& ptrWpCharge .~ length (w ^. cwTime . rewindWorlds)
| otherwise =
w & cWorld . cwTime . rewindWorlds .~ []
w & cwTime . rewindWorlds .~ []
& ptrWpCharge .~ 0
where
invid = _ipInvID $ _itLocation itm
@@ -37,7 +37,6 @@ rewindEffect itm cr w
maxcharge = itm ^?! itUse . leftConsumption . wpMaxCharge
cw =
_cWorld w
& 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
| (w ^. cWorld . cwTime . worldClock) `mod` n == 0 = chainEff eff it cr w
| (w ^. cwTime . worldClock) `mod` n == 0 = chainEff eff it cr w
| otherwise = eff it cr w
withMuzFlareI :: ChainEffect
+4
View File
@@ -14,6 +14,10 @@ import Picture
import Shape
import ShapePicture
timeScrollGun :: Item
timeScrollGun =
defaultHeldItem
rewindGun :: Item
rewindGun =
defaultLeftItem
+6 -12
View File
@@ -20,19 +20,13 @@ useL lu = case lu of
LBoost -> boostSelfL 10
useRewindGun :: Item -> Creature -> World -> World
useRewindGun _ _ w = case w ^. cWorld . cwTime . rewindWorlds of
[w'] -> rewindusing w' [w']
(w' : ws) -> rewindusing w' ws
useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of
[w'] -> w & cwTime . maybeWorld .~ Just' w'
(w' : ws) -> w
& cwTime . maybeWorld
.~ Just' w'
& cwTime . rewindWorlds .~ ws
_ -> w
where
rewindusing :: CWorld -> [CWorld] -> World
rewindusing w' ws =
w
& cWorld . cwTime . maybeWorld
.~ Just'
( w'
& cwTime . rewindWorlds .~ ws
)
-- be careful changing this around; potential problems include updating the
-- creature but using the old crInvSel value
+6 -6
View File
@@ -87,7 +87,7 @@ functionalUpdate w =
checkEndGame
-- . updateRandGen
. over uvWorld (mouseButtons . each .~ True) -- to determine if the mouse button is held
. over uvWorld (cWorld . cwTime . worldClock +~ 1)
. over uvWorld (cwTime . worldClock +~ 1)
. over uvWorld updateWorldSelect
. over uvWorld doRewind
-- . over uvWorld (hammers . each %~ moveHammerUp)
@@ -231,7 +231,7 @@ setOldPos cr =
--updateRandGen = randGen %~ (snd . (uniform :: StdGen -> (Int,StdGen)))
doRewind :: World -> World
doRewind w = case w ^. cWorld . cwTime . maybeWorld of
doRewind w = case w ^. cwTime . maybeWorld of
Just' cw ->
w & cWorld .~ cw
& timeFlow .~ RewindingLastFrame
@@ -457,13 +457,13 @@ markSeen :: Wall -> Wall
markSeen wl = wl{_wlSeen = True}
checkEndGame :: Universe -> Universe
checkEndGame uv = case w ^. cWorld . cwTime . deathDelay of
checkEndGame uv = case w ^. cwTime . deathDelay of
Just x
| x < 0 ->
uv & uvScreenLayers .~ [gameOverMenu]
& uvWorld . cWorld . cwTime . deathDelay .~ Nothing
Just _ -> uv & uvWorld . cWorld . cwTime . deathDelay . _Just -~ 1
_ | _crHP (you w) < 1 -> uv & uvWorld . cWorld . cwTime . deathDelay ?~ 50
& uvWorld . cwTime . deathDelay .~ Nothing
Just _ -> uv & uvWorld . cwTime . deathDelay . _Just -~ 1
_ | _crHP (you w) < 1 -> uv & uvWorld . cwTime . deathDelay ?~ 50
_ -> uv
where
w = _uvWorld uv
+1 -1
View File
@@ -53,7 +53,7 @@ aStaticBall p =
, _ebPos = p
, _ebWidth = 3
, _ebTimer = 20
, _ebEff = (ELECTRICAL, 1)
, _ebEff = (ELECTRICAL, 10)
, _ebZ = 20
, _ebRot = 0
}