justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Work on mouse wheel scrolling

Browse Source
This commit is contained in:
justin
2022-10-25 22:59:01 +01:00
parent 86a9ab7582
commit 4ffd361f11
15 changed files with 143 additions and 57 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature.hs
+1
View File
@@ -214,6 +214,7 @@ inventoryX c = case c of
, makeTypeCraftNum 1 CONCUSSMODULE
, makeTypeCraftNum 1 STATICMODULE
]
'L' -> [timeScrollGun]
'M' -> stackedInventory
'T' -> testInventory
_ -> []
src/Dodge/Creature/State.hs
+11
View File
@@ -3,6 +3,7 @@ module Dodge.Creature.State (
doDamage,
) where
import Dodge.Creature.Test
import Data.Foldable
import Dodge.Base
import Dodge.Corpse.Make
@@ -59,8 +60,18 @@ stateUpdate f =
, upInv -- upInv must be called before invSideEff 22.05.23
, invSideEff
, equipmentEffects
, heldAimEffects
]
heldAimEffects :: Creature -> World -> World
heldAimEffects cr
| crIsAiming cr = case cr ^? crInv . ix (cr ^. crInvSel . iselPos) of
Just itm -> case itm ^? itEffect . ieWhileAiming of
Just f -> doInvEffect f itm cr
_ -> id
_ -> id
| otherwise = id
checkDeath :: Creature -> World -> World
checkDeath cr w
| _crHP cr > 0 = w
src/Dodge/Data/CWorld.hs
-1
View File
@@ -99,7 +99,6 @@ import Dodge.GameRoom
import Geometry.ConvexPoly
import Geometry.Data
import qualified IntMapHelp as IM
import MaybeHelp
import Picture.Data
data CWCam = CWCam
src/Dodge/Data/Item/Effect.hs
+2 -2
View File
@@ -13,14 +13,14 @@ data ItEffect = ItEffect
{ _ieInv :: ItInvEffect --Item -> Creature -> World -> World
, _ieOnInsert :: ItInvEffect
, _ieOnDrop :: ItInvEffect --Item -> Creature -> World -> World
, _ieOnHeld :: ItInvEffect
, _ieOnStash :: ItInvEffect
, _ieWhileAiming :: ItInvEffect
}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data ItInvEffect
= NoInvEffect
| RewindEffect
| TimeScrollEffect
| EffectIfHeld ItInvEffect ItInvEffect
| CreateHeldLight
| CreateShieldWall
src/Dodge/Data/Item/Use/Consumption.hs
+2
View File
@@ -26,6 +26,8 @@ data HeldConsumption
, _laCycle :: [LoadAction]
, _laProgress :: Maybe [LoadAction]
}
| ChargingAmmo { _caCharge :: Int
, _caMax :: Int }
| NoConsumption
deriving (Eq, Show, Read) --Generic, Flat)
src/Dodge/Data/World.hs
+6 -1
View File
@@ -34,6 +34,8 @@ data World = World
, _mousePos :: Point2
, _keys :: S.Set Scancode
, _mouseButtons :: M.Map MouseButton Bool
, _scrollAmount :: Int
, _previousScrollAmount :: Int
, _hammers :: M.Map WorldHammer HammerPosition
, _testFloat :: Float
, _lLine :: (Point2, Point2)
@@ -53,6 +55,7 @@ data TimeFlowStatus
| RewindingLastFrame
| NormalTimeFlow
| ScrollTimeFlow
{ _scrollSmoothing :: Int }
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data WorldHammer
@@ -62,7 +65,8 @@ data WorldHammer
data CWTime = CWTime
{ _maybeWorld :: Maybe' CWorld
, _rewindWorlds :: [CWorld]
, _pastWorlds :: [CWorld]
, _pastWorldsNum :: Int
, _futureWorlds :: [CWorld]
, _worldClock :: Int
, _deathDelay :: Maybe Int
@@ -70,3 +74,4 @@ data CWTime = CWTime
makeLenses ''World
makeLenses ''CWTime
makeLenses ''TimeFlowStatus
src/Dodge/Default/Item/Effect.hs
+1 -2
View File
@@ -8,6 +8,5 @@ defaultItEffect =
{ _ieInv = NoInvEffect
, _ieOnInsert = NoInvEffect
, _ieOnDrop = NoInvEffect
, _ieOnHeld = NoInvEffect
, _ieOnStash = NoInvEffect
, _ieWhileAiming = NoInvEffect
}
src/Dodge/Default/World.hs
+4 -1
View File
@@ -22,6 +22,8 @@ defaultWorld =
, _keys = S.empty
, _mouseButtons = mempty
, _mousePos = V2 0 0
, _scrollAmount = 0
, _previousScrollAmount = 0
, _hammers = defaultWorldHammers
, _testFloat = 0
, _lrLine = (0, 0)
@@ -133,7 +135,8 @@ defaultCWTime =
CWTime
{ _worldClock = 0
, _maybeWorld = Nothing'
, _rewindWorlds = []
, _pastWorlds = []
, _pastWorldsNum = 0
, _futureWorlds = []
, _deathDelay = Nothing
}
src/Dodge/Event.hs
+7 -1
View File
@@ -15,7 +15,7 @@ module Dodge.Event (
handleEvent,
) where
import Control.Lens
import LensHelp
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Set as S
@@ -93,8 +93,14 @@ handleMouseWheelEvent :: MouseWheelEventData -> Universe -> Maybe Universe
handleMouseWheelEvent mwev w = case _uvScreenLayers w of
[] -> case mouseWheelEventPos mwev of
V2 _ y -> Just $ w & uvWorld %~ wheelEvent (fromIntegral y)
& uvWorld . scrollAmount +~ fromIntegral y
_ -> Just w
--wheelEvent' :: Int -> World -> World
--wheelEvent' y w = case w ^. timeFlow of
-- ScrollTimeFlow -> wheelTimeEvent y w
-- _ -> wheelEvent y w
wheelEvent :: Float -> World -> World
wheelEvent y w = case _hudElement $ _hud (_cWorld w) of
DisplayCarte
src/Dodge/HeldScroll.hs
+8 -8
View File
@@ -8,7 +8,7 @@ import Data.Sequence
import Dodge.Data.Creature
import Dodge.Data.World
import Dodge.Item.Weapon.ZoomScope
import LensHelp hiding ((|>), (<|))
--import LensHelp hiding ((|>), (<|))
-- should be able to just import data.item
doHeldScroll :: HeldScroll -> Float -> Creature -> World -> World
@@ -22,13 +22,13 @@ doHeldScroll hs = case hs of
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
doScrollTime _ _ w = 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
src/Dodge/ItEffect.hs
+18 -13
View File
@@ -9,6 +9,7 @@ doInvEffect :: ItInvEffect -> Item -> Creature -> World -> World
doInvEffect iie = case iie of
NoInvEffect -> const $ const id
RewindEffect -> rewindEffect
TimeScrollEffect -> timeScrollEffect
EffectIfHeld f g -> onOffEff f g
CreateHeldLight -> createHeldLight
CreateShieldWall -> createShieldWall
@@ -23,20 +24,24 @@ onOffEff f g it
| _itIsHeld it = doInvEffect f it
| otherwise = doInvEffect g it
timeScrollEffect :: Item -> Creature -> World -> World
timeScrollEffect _ _ w = w & timeFlow .~ ScrollTimeFlow 0
rewindEffect :: Item -> Creature -> World -> World
rewindEffect itm cr w
| Just invid == _crLeftInvSel cr =
w & cwTime . rewindWorlds %~ (take maxcharge . (cw :))
& ptrWpCharge .~ length (w ^. cwTime . rewindWorlds)
| otherwise =
w & cwTime . rewindWorlds .~ []
& ptrWpCharge .~ 0
where
invid = _ipInvID $ _itLocation itm
ptrWpCharge = cWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge
maxcharge = itm ^?! itUse . leftConsumption . wpMaxCharge
cw =
_cWorld w
rewindEffect _ _ w = w
--rewindEffect itm cr w =
-- | Just invid == _crLeftInvSel cr =
-- w & cwTime . rewindWorlds %~ (take maxcharge . (cw :))
-- & ptrWpCharge .~ length (w ^. cwTime . rewindWorlds)
-- | otherwise =
-- w & cwTime . rewindWorlds .~ []
-- & ptrWpCharge .~ 0
-- where
-- invid = _ipInvID $ _itLocation itm
-- ptrWpCharge = cWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge
-- maxcharge = itm ^?! itUse . leftConsumption . wpMaxCharge
-- cw =
-- _cWorld w
--resetAttachmentEffect :: Item -> Creature -> World -> World
--resetAttachmentEffect itm cr w
src/Dodge/Item/Weapon/Utility.hs
+5 -4
View File
@@ -17,16 +17,17 @@ import ShapePicture
timeScrollGun :: Item
timeScrollGun =
defaultHeldItem
& itEffect . ieWhileAiming .~ TimeScrollEffect
rewindGun :: Item
rewindGun =
defaultLeftItem
{ _itInvColor = cyan
, _itUse =
defaultLeftUse
& itUse .~
(defaultLeftUse
& leftUse .~ LRewind --useRewindGun
& equipEffect . eeSite .~ GoesOnWrist
}
)
& itInvColor .~ cyan
& itEffect . ieInv .~ RewindEffect
& itType . iyBase .~ LEFT REWINDER
& itUse . leftConsumption
src/Dodge/Luse.hs
+9 -8
View File
@@ -3,7 +3,7 @@ module Dodge.Luse where
import Dodge.Base
import Dodge.Creature.Action
import Dodge.Data.World
import MaybeHelp
--import MaybeHelp
import Dodge.Default.Creature
import Dodge.Item.Weapon.TriggerType
import Geometry
@@ -20,13 +20,14 @@ useL lu = case lu of
LBoost -> boostSelfL 10
useRewindGun :: Item -> Creature -> World -> World
useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of
[w'] -> w & cwTime . maybeWorld .~ Just' w'
(w' : ws) -> w
& cwTime . maybeWorld
.~ Just' w'
& cwTime . rewindWorlds .~ ws
_ -> w
useRewindGun _ _ w = w
--useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of
-- [w'] -> w & cwTime . maybeWorld .~ Just' w'
-- (w' : ws) -> w
-- & cwTime . maybeWorld
-- .~ Just' w'
-- & cwTime . rewindWorlds .~ ws
-- _ -> w
-- be careful changing this around; potential problems include updating the
-- creature but using the old crInvSel value
src/Dodge/TestString.hs
+3 -2
View File
@@ -6,8 +6,9 @@ import Control.Lens
import ShortShow
testStringInit :: Universe -> [String]
testStringInit u = [
shortShow $ u ^?! uvWorld . cWorld . creatures . ix 0 . crPos
testStringInit u = [show $ u ^. uvWorld . scrollAmount
, show $ u ^. uvWorld . previousScrollAmount
, shortShow $ u ^?! uvWorld . cWorld . creatures . ix 0 . crPos
]
-- [ show $ u ^? uvWorld . hammers . ix DoubleMouseHam
-- , show $ u ^? uvWorld . cWorld . creatures . ix 0 . crLeftInvSel . _Just
src/Dodge/Update.hs
+66 -14
View File
@@ -6,6 +6,7 @@ Description : Simulation update
-}
module Dodge.Update (updateUniverse) where
import StrictHelp
import Color
--import Dodge.Zone
@@ -56,14 +57,14 @@ import Dodge.Zoning.Creature
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import MaybeHelp
--import MaybeHelp
import SDL
import Sound.Data
{- For most menus the only way to change the world is using event handling. -}
updateUniverse :: Universe -> Universe
updateUniverse u
| isblocking = u
| concurrentblocking = u
| otherwise = case _uvScreenLayers u of
(OptionScreen{_scOptionFlag = GameOverOptions} : _) ->
u & uvWorld
@@ -75,21 +76,63 @@ updateUniverse u
. updateClouds
)
(_ : _) -> u
[] -> functionalUpdate u
[] -> functionalUpdate'' u
where
isblocking = case u ^. uvConcEffects of
concurrentblocking = case u ^. uvConcEffects of
BlockingConcEffect{} -> True
_ -> False
functionalUpdate'' :: Universe -> Universe
functionalUpdate'' = advanceScrollAmount . functionalUpdate'
functionalUpdate' :: Universe -> Universe
functionalUpdate' u = case u ^. uvWorld . timeFlow of
NormalTimeFlow -> functionalUpdate u
ScrollTimeFlow smoothing -> over uvWorld (doTimeScroll smoothing) u
_ -> u
timeScrollAmount :: World -> Int
timeScrollAmount w
| x == 0 = 0
| x > 0 && y > 0 = x * y
| x < 0 && y < 0 = negate (x * y)
| otherwise = x
where
x = w ^. scrollAmount
y = w ^. previousScrollAmount
doTimeScroll :: Int -> World -> World
doTimeScroll smoothing w = case timeScrollAmount w of
x | x > 1 -> (foldr ($) w $ replicate x scrollTimeBack) & timeFlow . scrollSmoothing .~ 20
x | x > 0 -> foldr ($) w $ replicate x scrollTimeBack
x | x < (-1) -> (foldr ($) w $ replicate x scrollTimeForward) & timeFlow . scrollSmoothing .~ negate 20
x | x < 0 -> foldr ($) w $ replicate (negate x) scrollTimeForward
_ | smoothing > 0 -> scrollTimeBack w & timeFlow . scrollSmoothing -~ 1
_ | smoothing < 0 -> scrollTimeForward w & timeFlow . scrollSmoothing +~ 1
_ -> w
scrollTimeBack :: World -> World
scrollTimeBack w = case w ^? cwTime . pastWorlds . _head of
Nothing -> w
Just cw -> w & cwTime . pastWorlds %~ tail
& cwTime . futureWorlds .:~ _cWorld w
& cWorld .~ cw
scrollTimeForward :: World -> World
scrollTimeForward w = case w ^? cwTime . futureWorlds . _head of
Nothing -> w
Just cw -> w & cwTime . futureWorlds %~ tail
& cwTime . pastWorlds .:~ _cWorld w
& cWorld .~ cw
-- | The update step.
functionalUpdate :: Universe -> Universe
functionalUpdate w =
checkEndGame
functionalUpdate w = checkEndGame
-- . updateRandGen
. over uvWorld (mouseButtons . each .~ True) -- to determine if the mouse button is held
. over uvWorld (cwTime . worldClock +~ 1)
. over uvWorld updateWorldSelect
. over uvWorld doRewind
-- . over uvWorld doRewind
-- . over uvWorld (hammers . each %~ moveHammerUp)
-- . over (uvWorld . hammers . each) moveHammerUp
-- . over uvWorld (hammers %~ fmap moveHammerUp)
@@ -139,7 +182,16 @@ functionalUpdate w =
. over uvWorld updateTerminal
. over uvWorld updateRBList
. updateBounds -- where should this go? next to update camera?
$ over uvWorld updateCloseObjects w
. over uvWorld updateCloseObjects
$ over uvWorld updatePastWorlds w
advanceScrollAmount :: Universe -> Universe
advanceScrollAmount u = u
& uvWorld . previousScrollAmount .~ _scrollAmount (_uvWorld u)
& uvWorld . scrollAmount .~ 0
updatePastWorlds :: World -> World
updatePastWorlds w = w & cwTime . pastWorlds %~ (forceFoldable . take 100 . (_cWorld w :))
moveHammersUp :: Universe -> Universe
--moveHammersUp = uvWorld . hammers .~ M.empty
@@ -230,12 +282,12 @@ setOldPos cr =
--updateRandGen :: World -> World
--updateRandGen = randGen %~ (snd . (uniform :: StdGen -> (Int,StdGen)))
doRewind :: World -> World
doRewind w = case w ^. cwTime . maybeWorld of
Just' cw ->
w & cWorld .~ cw
& timeFlow .~ RewindingLastFrame
Nothing' -> w & timeFlow .~ NormalTimeFlow
--doRewind :: World -> World
--doRewind w = case w ^. cwTime . maybeWorld of
-- Just' cw ->
-- w & cWorld .~ cw
-- & timeFlow .~ RewindingLastFrame
-- Nothing' -> w & timeFlow .~ NormalTimeFlow
zoneCreatures :: World -> World
zoneCreatures w =