From 5c8e786dfaafd3a6931d58fbf190e7a770a7befc Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 26 Jul 2022 10:22:55 +0100 Subject: [PATCH] Cleanup --- src/Dodge/Base/Coordinate.hs | 7 +- src/Dodge/Combine/Data.hs | 2 +- src/Dodge/Creature/Impulse/UseItem.hs | 2 +- src/Dodge/Creature/YourControl.hs | 8 +- src/Dodge/Data.hs | 17 +-- src/Dodge/Data/Creature.hs | 1 - src/Dodge/Data/Equipment.hs | 35 ++++++ .../Data.hs => Data/Equipment/Misc.hs} | 3 +- src/Dodge/Data/Item/Use.hs | 30 +---- src/Dodge/Data/RightButtonOptions.hs | 2 +- src/Dodge/Default/World.hs | 12 +- src/Dodge/Event.hs | 12 +- src/Dodge/Event/Keyboard.hs | 4 +- src/Dodge/Item/Weapon/ExtraEffect.hs | 15 +-- src/Dodge/Luse.hs | 2 - src/Dodge/Projectile/Update.hs | 11 +- src/Dodge/Render/HUD.hs | 6 +- src/Dodge/Render/Picture.hs | 2 +- src/Dodge/Save.hs | 2 +- src/Dodge/SoundLogic.hs | 109 +++++++++++------- src/Dodge/Update.hs | 10 +- src/Dodge/Update/Camera.hs | 16 +-- src/Dodge/Update/UsingInput.hs | 40 +++---- src/Dodge/Zoning.hs | 1 - 24 files changed, 191 insertions(+), 158 deletions(-) create mode 100644 src/Dodge/Data/Equipment.hs rename src/Dodge/{Equipment/Data.hs => Data/Equipment/Misc.hs} (94%) diff --git a/src/Dodge/Base/Coordinate.hs b/src/Dodge/Base/Coordinate.hs index 7570ede14..6476d85bc 100644 --- a/src/Dodge/Base/Coordinate.hs +++ b/src/Dodge/Base/Coordinate.hs @@ -30,8 +30,9 @@ crToMousePosOffset :: Creature -> World -> (Point2,Float) crToMousePosOffset cr w = (mouseWorldPos w -.- _crPos cr,0) {- | The mouse position in world coordinates. -} mouseWorldPos :: World -> Point2 -mouseWorldPos w = _cameraCenter (_cWorld w) +.+ (1/_cameraZoom (_cWorld w)) *.* rotateV (_cameraRot (_cWorld w)) (_mousePos (_cWorld w)) +mouseWorldPos w = _cameraCenter (_cWorld w) +.+ + (1/_cameraZoom (_cWorld w)) *.* rotateV (_cameraRot (_cWorld w)) (_mousePos w) {- | The mouse position in map coordinates -} mouseCartePos :: World -> Point2 -mouseCartePos w = _carteCenter (_hud (_cWorld w)) +.+ (1/_carteZoom (_hud (_cWorld w))) - *.* rotateV (_carteRot (_hud (_cWorld w))) (_mousePos (_cWorld w)) +mouseCartePos w = _carteCenter (_hud (_cWorld w)) +.+ + (1/_carteZoom (_hud (_cWorld w))) *.* rotateV (_carteRot (_hud (_cWorld w))) (_mousePos w) diff --git a/src/Dodge/Combine/Data.hs b/src/Dodge/Combine/Data.hs index ecb7c3370..8eaf0fbdc 100644 --- a/src/Dodge/Combine/Data.hs +++ b/src/Dodge/Combine/Data.hs @@ -4,7 +4,7 @@ module Dodge.Combine.Data where import GHC.Generics import Data.Aeson -import Dodge.Equipment.Data +import Dodge.Data.Equipment.Misc import Dodge.Data.ItemAmount import Control.Lens import qualified Data.Map.Strict as M diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index 87c8482f2..494d90a0a 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -46,7 +46,7 @@ itemEffect cr it w = case it ^? itUse of tryReload :: Creature -> Item -> World -> (World -> World) -> World -> World tryReload cr it w f - | _crID cr == _yourID (_cWorld w) && itNeedsLoading it && _mouseButtons (_cWorld w) M.!? SDL.ButtonLeft == Just False + | _crID cr == _yourID (_cWorld w) && itNeedsLoading it && _mouseButtons w M.!? SDL.ButtonLeft == Just False = crToggleReloading cr | otherwise = (runIdentity . pointToItem (_itPos it) (return . (itUse . useHammer .~ HammerDown))) diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 38e8fa482..2433443c0 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -19,7 +19,7 @@ yourControl cr w | inTermFocus w = dimCreatureLight cr w & updateUsingInput | otherwise = dimCreatureLight cr w & cWorld . creatures . ix (_crID cr) %~ - (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons (_cWorld w))) + (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons w)) & updateUsingInput dimCreatureLight :: Creature -> World -> World @@ -35,7 +35,7 @@ wasdWithAiming -> Creature wasdWithAiming w speed cr | isAiming = addAnyTwist $ set crDir mouseDir $ theMovement cr - | crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons (_cWorld w) + | crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons w = addAnyTwist $ set crDir (mouseDir + anytwist) $ theMovement cr | otherwise = theMovement $ theTurn $ removeTwist cr where @@ -57,7 +57,7 @@ wasdWithAiming w speed cr isAiming = _posture (_crStance cr) == Aiming mouseDir = case cr ^? crInv . ix (crSel cr) . itScope . scopePos of Just _ -> argV $ mouseWorldPos w -.- _crPos cr - _ -> argV (_mousePos (_cWorld w)) + _cameraRot (_cWorld w) + _ -> argV (_mousePos w) + _cameraRot (_cWorld w) wasdM :: SDL.Scancode -> Point2 wasdM scancode = case scancode of @@ -68,7 +68,7 @@ wasdM scancode = case scancode of _ -> V2 0 0 wasdDir :: World -> Point2 -wasdDir = foldr ((+.+) . wasdM) (V2 0 0) . _keys . _cWorld +wasdDir = foldr ((+.+) . wasdM) (V2 0 0) . _keys {- | Set posture according to mouse presses. -} mouseActionsCr :: M.Map SDL.MouseButton Bool -> Creature -> Creature diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index da219cfc9..9fdf9ef9d 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -70,7 +70,6 @@ module Dodge.Data , module Dodge.Item.Attachment.Data , module Dodge.Item.Data , module Dodge.Config.Data - , module Dodge.Equipment.Data , module MaybeHelp , module Dodge.Data.ItemAmount , module Dodge.RoomCluster.Data @@ -165,7 +164,6 @@ import Dodge.Creature.Stance.Data import Dodge.Creature.Perception.Data import Dodge.Creature.Memory.Data import Dodge.Distortion.Data -import Dodge.Equipment.Data import Dodge.Data.SoundOrigin import Dodge.Data.Damage import Dodge.Combine.Data @@ -217,12 +215,13 @@ data World = World , _randGen :: StdGen , _toPlaySounds :: M.Map SoundOrigin Sound , _playingSounds :: M.Map SoundOrigin Sound + , _mousePos :: Point2 + , _keys :: S.Set Scancode + , _mouseButtons :: M.Map MouseButton Bool + , _hammers :: M.Map WorldHammer HammerPosition } data CWorld = CWorld - { _keys :: S.Set Scancode - , _mouseButtons :: M.Map MouseButton Bool - , _mousePos :: Point2 - , _cameraCenter :: Point2 + { _cameraCenter :: Point2 , _cameraRot :: Float , _cameraZoom :: Float -- smaller values zoom out , _itemZoom :: Float @@ -236,7 +235,6 @@ data CWorld = CWorld , _creatureGroups :: IM.IntMap CrGroupParams , _itemPositions :: IM.IntMap ItemPos , _clouds :: [Cloud] - --, _clZoning :: Zoning [] Cloud , _clZoning :: IM.IntMap (IM.IntMap [Cloud]) --Zoning IM.IntMap Creature , _gusts :: IM.IntMap Gust , _gsZoning :: IM.IntMap (IM.IntMap IS.IntSet) @@ -244,8 +242,6 @@ data CWorld = CWorld , _projectiles :: IM.IntMap Proj , _instantBullets :: [Bullet] , _bullets :: [Bullet] --- , _instantParticles :: [Particle] --- , _particles :: [Particle] , _radarSweeps :: [RadarSweep] , _energyBalls :: [EnergyBall] , _posEvents :: [PosEvent] @@ -284,8 +280,6 @@ data CWorld = CWorld , _corpses :: IM.IntMap Corpse , _clickMousePos :: Point2 , _pathGraph :: Gr Point2 PathEdge - --, _pnZoning :: Zoning [] (Int,Point2) - --, _peZoning :: Zoning [] (Int,Int,PathEdge) , _pnZoning :: IM.IntMap (IM.IntMap [(Int,Point2)]) --Zoning IM.IntMap Creature , _peZoning :: IM.IntMap (IM.IntMap [(Int,Int,PathEdge)]) --Zoning IM.IntMap Creature , _hud :: HUD @@ -303,7 +297,6 @@ data CWorld = CWorld , _rewindWorlds :: [CWorld] , _timeFlow :: TimeFlowStatus , _worldClock :: Int - , _hammers :: M.Map WorldHammer HammerPosition , _backspaceTimer :: Int , _genParams :: GenParams , _deathDelay :: Maybe Int diff --git a/src/Dodge/Data/Creature.hs b/src/Dodge/Data/Creature.hs index 7ae528a49..416f47210 100644 --- a/src/Dodge/Data/Creature.hs +++ b/src/Dodge/Data/Creature.hs @@ -19,7 +19,6 @@ import Dodge.Creature.Perception.Data import Dodge.Creature.Memory.Data import Dodge.Creature.Stance.Data import Dodge.Creature.State.Data -import Dodge.Equipment.Data import Geometry.Data import qualified IntMapHelp as IM import qualified Data.Map.Strict as M diff --git a/src/Dodge/Data/Equipment.hs b/src/Dodge/Data/Equipment.hs new file mode 100644 index 000000000..f700c81ba --- /dev/null +++ b/src/Dodge/Data/Equipment.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE DeriveGeneric #-} +module Dodge.Data.Equipment + ( module Dodge.Data.Equipment.Misc + , module Dodge.Data.Equipment + ) + where +import Dodge.Data.Item.HeldUse +import Dodge.Data.Equipment.Misc +import GHC.Generics +import Data.Aeson +import Control.Lens +data Equipment = Equipment + { _eqUse :: Euse --Item -> Creature -> World -> World + , _eqOnEquip :: Euse --Item -> Creature -> World -> World + , _eqOnRemove :: Euse --Item -> Creature -> World -> World + , _eqSite :: EquipSite + , _eqParams :: EquipParams + , _eqViewDist :: Maybe Float + } + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON Equipment where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Equipment +data EquipParams + = NoEquipParams + | EquipID {_eparamID :: Int} + | EquipCounter {_eparamInt :: Int} + deriving (Eq,Ord,Show,Read,Generic) +instance ToJSON EquipParams where + toEncoding = genericToEncoding defaultOptions +instance FromJSON EquipParams +makeLenses ''Equipment +makeLenses ''EquipParams diff --git a/src/Dodge/Equipment/Data.hs b/src/Dodge/Data/Equipment/Misc.hs similarity index 94% rename from src/Dodge/Equipment/Data.hs rename to src/Dodge/Data/Equipment/Misc.hs index 9ab2eb069..b3a14e3c0 100644 --- a/src/Dodge/Equipment/Data.hs +++ b/src/Dodge/Data/Equipment/Misc.hs @@ -1,6 +1,7 @@ {-# LANGUAGE StrictData #-} {-# LANGUAGE DeriveGeneric #-} -module Dodge.Equipment.Data where +module Dodge.Data.Equipment.Misc + where import GHC.Generics import Data.Aeson data EquipSite diff --git a/src/Dodge/Data/Item/Use.hs b/src/Dodge/Data/Item/Use.hs index 124442643..d9dda05ef 100644 --- a/src/Dodge/Data/Item/Use.hs +++ b/src/Dodge/Data/Item/Use.hs @@ -1,14 +1,18 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} -module Dodge.Data.Item.Use where +module Dodge.Data.Item.Use + ( module Dodge.Data.Item.Use + , module Dodge.Data.Equipment + ) + where import GHC.Generics import Data.Aeson import Dodge.Data.Item.HeldUse import Dodge.Data.Item.HeldScroll import Dodge.Data.Item.UseDelay import Dodge.Data.Hammer -import Dodge.Equipment.Data +import Dodge.Data.Equipment import Control.Lens data ItemUse = RightUse @@ -36,18 +40,6 @@ data ItemUse instance ToJSON ItemUse where toEncoding = genericToEncoding defaultOptions instance FromJSON ItemUse -data Equipment = Equipment - { _eqUse :: Euse --Item -> Creature -> World -> World - , _eqOnEquip :: Euse --Item -> Creature -> World -> World - , _eqOnRemove :: Euse --Item -> Creature -> World -> World - , _eqSite :: EquipSite - , _eqParams :: EquipParams - , _eqViewDist :: Maybe Float - } - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON Equipment where - toEncoding = genericToEncoding defaultOptions -instance FromJSON Equipment data AimParams = AimParams { _aimWeight :: Int , _aimRange :: Float @@ -69,14 +61,6 @@ data AimStance instance ToJSON AimStance where toEncoding = genericToEncoding defaultOptions instance FromJSON AimStance -data EquipParams - = NoEquipParams - | EquipID {_eparamID :: Int} - | EquipCounter {_eparamInt :: Int} - deriving (Eq,Ord,Show,Read,Generic) -instance ToJSON EquipParams where - toEncoding = genericToEncoding defaultOptions -instance FromJSON EquipParams data ItZoom = ItZoom { _itZoomMax :: Float , _itZoomMin :: Float @@ -87,7 +71,5 @@ instance ToJSON ItZoom where toEncoding = genericToEncoding defaultOptions instance FromJSON ItZoom makeLenses ''ItemUse -makeLenses ''Equipment makeLenses ''AimParams -makeLenses ''EquipParams makeLenses ''ItZoom diff --git a/src/Dodge/Data/RightButtonOptions.hs b/src/Dodge/Data/RightButtonOptions.hs index f27a90912..1d0347563 100644 --- a/src/Dodge/Data/RightButtonOptions.hs +++ b/src/Dodge/Data/RightButtonOptions.hs @@ -4,7 +4,7 @@ module Dodge.Data.RightButtonOptions where import GHC.Generics import Data.Aeson -import Dodge.Equipment.Data +import Dodge.Data.Equipment.Misc import Control.Lens data RightButtonOptions diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 1dfd1f7de..34d0ac1ea 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -15,16 +15,18 @@ defaultWorld = World , _toPlaySounds = M.empty , _playingSounds = M.empty , _randGen = mkStdGen 2 + , _keys = S.empty + , _mouseButtons = mempty + , _mousePos = V2 0 0 + , _hammers = defaultWorldHammers } defaultCWorld :: CWorld defaultCWorld = CWorld - { _keys = S.empty - , _magnets = IM.empty - , _mouseButtons = mempty - , _cameraCenter = V2 0 0 + { _cameraCenter = V2 0 0 , _cameraRot = 0 , _cameraZoom = 1 + , _magnets = IM.empty , _itemZoom = 1 , _defaultZoom = 1 , _cameraViewFrom = V2 0 0 @@ -70,7 +72,6 @@ defaultCWorld = CWorld , _wlZoning = IM.empty --Zoning IM.empty wlZoneSize zoneOfWall , _floorItems = IM.empty , _floorTiles = [] - , _mousePos = V2 0 0 , _yourID = 0 , _worldEvents = [] , _delayedEvents = [] @@ -109,7 +110,6 @@ defaultCWorld = CWorld , _maybeWorld = Nothing' , _rewindWorlds = [] , _timeFlow = NormalTimeFlow - , _hammers = defaultWorldHammers , _backspaceTimer = 0 , _genParams = GenParams M.empty -- , _genPlacements = IM.empty diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 790e09ec2..8d341e7af 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -46,7 +46,7 @@ handleEvent e = case eventPayload e of _ -> return . Just handleMouseMotionEvent :: MouseMotionEventData -> Universe -> Maybe Universe -handleMouseMotionEvent mmev u = Just $ u & uvWorld . cWorld . mousePos .~ V2 +handleMouseMotionEvent mmev u = Just $ u & uvWorld . mousePos .~ V2 (fromIntegral x - 0.5*_windowX cfig) (0.5*_windowY cfig - fromIntegral y) where @@ -55,8 +55,8 @@ handleMouseMotionEvent mmev u = Just $ u & uvWorld . cWorld . mousePos .~ V2 handleMouseButtonEvent :: MouseButtonEventData -> World -> World handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of - Released -> cWorld . mouseButtons . at thebutton .~ Nothing - Pressed -> cWorld . mouseButtons . at thebutton ?~ False + Released -> mouseButtons . at thebutton .~ Nothing + Pressed -> mouseButtons . at thebutton ?~ False where thebutton = mouseButtonEventButton mbev @@ -135,9 +135,9 @@ wheelEvent y w = case _hudElement $ _hud (_cWorld w) of numcombs = length $ combineItemListYou w yi = round $ signum y numLocs = (fst . IM.findMax $ _seenLocations (_cWorld w)) + 1 - rbDown = ButtonRight `M.member` _mouseButtons (_cWorld w) - lbDown = ButtonLeft `M.member` _mouseButtons (_cWorld w) - invKeyDown = ScancodeCapsLock `S.member` _keys (_cWorld w) + rbDown = ButtonRight `M.member` _mouseButtons w + lbDown = ButtonLeft `M.member` _mouseButtons w + invKeyDown = ScancodeCapsLock `S.member` _keys w getArguments' :: TerminalCommand -> Terminal -> World -> [String] getArguments' tc tm = ("" :) . getArguments tc tm diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 4e6ff3a05..648803faa 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -60,9 +60,9 @@ see 'handlePressedKeyInGame'. -} handleKeyboardEvent :: KeyboardEventData -> Universe -> IO (Maybe Universe) handleKeyboardEvent kev u = case keyboardEventKeyMotion kev of - Released -> return . Just $ u & uvWorld . cWorld . keys %~ S.delete scode + Released -> return . Just $ u & uvWorld . keys %~ S.delete scode Pressed -> handlePressedKey (keyboardEventRepeat kev) scode - (u & uvWorld . cWorld . keys %~ S.insert scode) + (u & uvWorld . keys %~ S.insert scode) where scode = (keysymScancode . keyboardEventKeysym) kev diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index 46d385060..73f1ad501 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -83,14 +83,9 @@ targetRBCreatureUp it cr w t & tgPos .~ Nothing & tgActive .~ False ) - | SDL.ButtonRight `M.member` _mouseButtons (_cWorld w) && isJust (t ^? tgID . _Just) - && canSeeTarget = (w, t & updatePos - & tgActive .~ True - ) - | otherwise = (w, t & tgID .~ fmap _crID newtarg - & updatePos - & tgActive .~ False - ) + | SDL.ButtonRight `M.member` _mouseButtons w && isJust (t ^? tgID . _Just) + && canSeeTarget = (w, t & updatePos & tgActive .~ True) + | otherwise = (w, t & tgID .~ fmap _crID newtarg & updatePos & tgActive .~ False ) where newtarg = safeMinimumOn (dist mwp . _crPos) . filter (canseepos . _crPos) @@ -113,7 +108,7 @@ targetUpdateWith f it _ w t targetCursorUpdate :: World -> Targeting -> Targeting targetCursorUpdate w t - | SDL.ButtonRight `M.member` _mouseButtons (_cWorld w) = t + | SDL.ButtonRight `M.member` _mouseButtons w = t & tgPos . _Just .~ mouseWorldPos w & tgActive .~ True | otherwise = t & tgPos %~ const Nothing @@ -121,7 +116,7 @@ targetCursorUpdate w t targetRBPressUpdate :: World -> Targeting -> Targeting targetRBPressUpdate w t - | SDL.ButtonRight `M.member` _mouseButtons (_cWorld w) = t + | SDL.ButtonRight `M.member` _mouseButtons w = t & tgPos %~ maybe (Just $ mouseWorldPos w) Just & tgActive .~ True | otherwise = t & tgPos %~ const Nothing diff --git a/src/Dodge/Luse.hs b/src/Dodge/Luse.hs index 87212e404..1136904ef 100644 --- a/src/Dodge/Luse.hs +++ b/src/Dodge/Luse.hs @@ -24,10 +24,8 @@ useRewindGun _ _ w = case _rewindWorlds (_cWorld w) of rewindusing :: CWorld -> [CWorld] -> World rewindusing w' ws = w & cWorld . maybeWorld .~ Just' ( w' - & upbuts & rewindWorlds .~ ws ) - upbuts = (keys .~ _keys (_cWorld w)) . (mouseButtons .~ _mouseButtons (_cWorld w)) -- be careful changing this around; potential problems include updating the -- creature but using the old crInvSel value diff --git a/src/Dodge/Projectile/Update.hs b/src/Dodge/Projectile/Update.hs index ffad5b0cc..709d55e2e 100644 --- a/src/Dodge/Projectile/Update.hs +++ b/src/Dodge/Projectile/Update.hs @@ -123,13 +123,14 @@ retireRemoteProj'' itid pjid w = w & cWorld . props %~ IM.delete pjid setRemoteDir :: Int -> Int -> Proj -> World -> World -setRemoteDir cid itid pj w = w & cWorld . projectiles . ix i . prjDir .~ newdir +setRemoteDir cid itid pj w = w & cWorld . projectiles . ix (_prjID pj) . prjDir .~ newdir where - i = _prjID pj + --i = _prjID pj newdir - | SDL.ButtonRight `M.member` _mouseButtons (_cWorld w) - && w ^? cWorld . creatures . ix cid . crInvSel . iselPos == w ^? cWorld . itemPositions . ix itid . ipInvID - = _cameraRot (_cWorld w) + argV (_mousePos (_cWorld w)) + | SDL.ButtonRight `M.member` _mouseButtons w + && w ^? cWorld . creatures . ix cid . crInvSel . iselPos + == w ^? cWorld . itemPositions . ix itid . ipInvID + = _cameraRot (_cWorld w) + argV (_mousePos w) | otherwise = _prjDir pj doThrust' :: Proj -> World -> World diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 294ca7377..ca673f842 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -131,7 +131,7 @@ subInventoryDisplay subinv cfig w = case subinv of selcursor' ct = fromMaybe mempty $ ct 0 0 cfig curpos itcol (determineInvSelCursorWidth w) cury <$ it selcursor = selcursor' selcursortype selcursortype - | ButtonRight `M.member` _mouseButtons (_cWorld w) = listCursorNESW + | ButtonRight `M.member` _mouseButtons w = listCursorNESW | otherwise = listCursorNSW curpos = invSelPos w cury = fromMaybe 1 $ augmentedInvSizes w IM.!? crSel (you w) @@ -140,7 +140,7 @@ subInventoryDisplay subinv cfig w = case subinv of _ -> mempty equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr) f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos - rboptions = if ButtonRight `M.member` _mouseButtons (_cWorld w) + rboptions = if ButtonRight `M.member` _mouseButtons w then drawRBOptions cfig w (_rbOptions (_cWorld w)) else mempty @@ -257,7 +257,7 @@ topCursorTypeWidth ctype width cfig w i determineInvSelCursorWidth :: World -> Int determineInvSelCursorWidth w = case _rbOptions (_cWorld w) of NoRightButtonOptions -> topInvW - EquipOptions {} -> if ButtonRight `M.member` _mouseButtons (_cWorld w) + EquipOptions {} -> if ButtonRight `M.member` _mouseButtons w then 47 else topInvW diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index 2091dea4b..c7a289066 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -23,6 +23,6 @@ fixedCoordPictures u = case _menuLayers u of customMouseCursor :: Configuration -> World -> Picture customMouseCursor cfig w = winScale cfig - . uncurryV translate (_mousePos (_cWorld w)) + . uncurryV translate (_mousePos w) . color white $ pictures [ line [V2 (-5) 0,V2 5 0] , line [V2 0 (-5),V2 0 5] ] diff --git a/src/Dodge/Save.hs b/src/Dodge/Save.hs index f8e18c7ad..a551e54c4 100644 --- a/src/Dodge/Save.hs +++ b/src/Dodge/Save.hs @@ -62,7 +62,7 @@ doQuicksave :: Universe -> Universe doQuicksave = saveWorldInSlot QuicksaveSlot clearKeys :: World -> World -clearKeys = (cWorld . keys .~ mempty) . (cWorld . mouseButtons .~ mempty) +clearKeys = (keys .~ mempty) . (mouseButtons .~ mempty) saveLevelStartSlot :: Universe -> Universe --saveLevelStartSlot = id diff --git a/src/Dodge/SoundLogic.hs b/src/Dodge/SoundLogic.hs index d2f9e3a94..e5c239635 100644 --- a/src/Dodge/SoundLogic.hs +++ b/src/Dodge/SoundLogic.hs @@ -45,16 +45,16 @@ pauseSound w = w resumeSound :: Universe -> Universe resumeSound w = w -soundWithStatusVolume +soundWithStatusVolumeGeneral :: Float -- ^ Volume factor, 0 - 1 -> PlayStatus -> SoundOrigin -- ^ \"Creator\" of sound - -> Point2 -- ^ Position of sound + -> (World -> Point2) -- ^ Position of sound -> SoundID -- ^ ID of sound to be played -> Maybe Int -- ^ Frames to play sound for, Nothing for until finished -> World -> World -soundWithStatusVolume vol status so pos sType mtime w = w & toPlaySounds %~ M.insertWith f so sound +soundWithStatusVolumeGeneral vol status so fpos sType mtime w = w & toPlaySounds %~ M.insertWith f so sound where sound = Sound { _soundChunkID = sType @@ -65,12 +65,40 @@ soundWithStatusVolume vol status so pos sType mtime w = w & toPlaySounds %~ M.in } , _soundChannel = Nothing , _soundAngDist = Just (a,floor (225 * (1 - vol))) - , _soundPos = pos + , _soundPos = fpos w , _soundVolume = soundToVol sType * vol , _soundVolumeFraction = vol } f _ s = s {_soundTime = mtime } - a = soundAngle pos w + a = soundAngle (fpos w) w + +soundWithStatusVolume + :: Float -- ^ Volume factor, 0 - 1 + -> PlayStatus + -> SoundOrigin -- ^ \"Creator\" of sound + -> Point2 -- ^ Position of sound + -> SoundID -- ^ ID of sound to be played + -> Maybe Int -- ^ Frames to play sound for, Nothing for until finished + -> World + -> World +soundWithStatusVolume vol status so pos = soundWithStatusVolumeGeneral vol status so (const pos) +--soundWithStatusVolume vol status so pos sType mtime w = w & toPlaySounds %~ M.insertWith f so sound +-- where +-- sound = Sound +-- { _soundChunkID = sType +-- , _soundTime = mtime +-- , _soundStatus = SoundStatus +-- {_playStatus = status +-- ,_isLooping = isJust mtime +-- } +-- , _soundChannel = Nothing +-- , _soundAngDist = Just (a,floor (225 * (1 - vol))) +-- , _soundPos = pos +-- , _soundVolume = soundToVol sType * vol +-- , _soundVolumeFraction = vol +-- } +-- f _ s = s {_soundTime = mtime } +-- a = soundAngle pos w soundWithStatus :: PlayStatus @@ -117,23 +145,24 @@ soundFromGeneral -> Maybe Int -- ^ Frames to play sound for, Nothing for until finished -> World -> World -soundFromGeneral so fpos sType mtime w = over toPlaySounds (M.insertWith f so sound) w - where - sound = Sound - { _soundChunkID = sType - , _soundTime = mtime - , _soundStatus = SoundStatus - { _playStatus = ToStart - , _isLooping = isJust mtime - } - , _soundChannel = Nothing - , _soundAngDist = Just (a,0) - , _soundPos = fpos w - , _soundVolume = soundToVol sType - , _soundVolumeFraction = 1 - } - f _ s = s {_soundTime = mtime } - a = soundAngle (fpos w) w +soundFromGeneral = soundWithStatusVolumeGeneral 1 ToStart +--soundFromGeneral so fpos sType mtime w = w & toPlaySounds %~ M.insertWith f so sound +-- where +-- sound = Sound +-- { _soundChunkID = sType +-- , _soundTime = mtime +-- , _soundStatus = SoundStatus +-- { _playStatus = ToStart +-- , _isLooping = isJust mtime +-- } +-- , _soundChannel = Nothing +-- , _soundAngDist = Just (a,0) +-- , _soundPos = fpos w +-- , _soundVolume = soundToVol sType +-- , _soundVolumeFraction = 1 +-- } +-- f _ s = s {_soundTime = mtime } +-- a = soundAngle (fpos w) w {-| Calculates the angle of a sound with reference to '_cameraViewFrom'. Within 10 units considers the sound to be directly in front. @@ -153,30 +182,30 @@ soundAngle p w {-| Uses the first free origin from a list. Does nothing if all origins are already creating sounds. -} soundMultiFrom - :: [SoundOrigin] + :: [SoundOrigin] -> Point2 -- ^ Position -> SoundID -- ^ Sound ID -> Maybe Int -- ^ Frames to play for, Nothing for full length -> World -> World soundMultiFrom [] _ _ _ w = w -soundMultiFrom [so] pos sType mtime w - = over toPlaySounds (M.insert so sound) w - where - sound = Sound - { _soundChunkID = sType - , _soundTime = mtime - , _soundStatus = SoundStatus - { _playStatus = ToStart - , _isLooping = isJust mtime - } - , _soundChannel = Nothing - , _soundAngDist = Just (a,0) - , _soundPos = pos - , _soundVolume = soundToVol sType - , _soundVolumeFraction = 1 - } - a = soundAngle pos w +--soundMultiFrom [so] pos sType mtime w +-- = over toPlaySounds (M.insert so sound) w +-- where +-- sound = Sound +-- { _soundChunkID = sType +-- , _soundTime = mtime +-- , _soundStatus = SoundStatus +-- { _playStatus = ToStart +-- , _isLooping = isJust mtime +-- } +-- , _soundChannel = Nothing +-- , _soundAngDist = Just (a,0) +-- , _soundPos = pos +-- , _soundVolume = soundToVol sType +-- , _soundVolumeFraction = 1 +-- } +-- a = soundAngle pos w soundMultiFrom (so:sos) pos sType mtime w | so `M.member` _playingSounds w = soundMultiFrom sos pos sType mtime w | otherwise = over toPlaySounds (M.insert so sound) w diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 723795996..70798ee19 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -78,11 +78,11 @@ updateUniverse u = case _menuLayers u of functionalUpdate :: Universe -> Universe functionalUpdate w = checkEndGame -- . updateRandGen - . over uvWorld (cWorld . 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 updateWorldSelect . over uvWorld doRewind - . over uvWorld (cWorld . hammers . each %~ moveHammerUp) + . over uvWorld (hammers . each %~ moveHammerUp) . over uvWorld updateDistortions . over uvWorld updateCreatureSoundPositions . over uvWorld ppEvents @@ -148,7 +148,7 @@ zoneClouds w = w --runIdentity (S.fold_ (flip $ updateZoning (:)) (zn & znObjects .~ mempty) id (_clouds w)) updateWorldSelect :: World -> World -updateWorldSelect w = f . g $ case (w ^? cWorld . mouseButtons . ix ButtonLeft, w ^? cWorld . mouseButtons . ix ButtonRight) of +updateWorldSelect w = f . g $ case (w ^? mouseButtons . ix ButtonLeft, w ^? mouseButtons . ix ButtonRight) of (Nothing ,Nothing) -> w (Just False,Nothing) -> w & cWorld . lLine . _1 .~ mwp (Just True ,Nothing) -> w & cWorld . lLine . _2 .~ mwp @@ -157,9 +157,9 @@ updateWorldSelect w = f . g $ case (w ^? cWorld . mouseButtons . ix ButtonLeft, (Just True ,_) -> w & cWorld . rLine . _2 .~ mwp where mwp = mouseWorldPos w - f | ButtonLeft `M.member` _mouseButtons (_cWorld w) = cWorld . lSelect .~ mwp + f | ButtonLeft `M.member` _mouseButtons w = cWorld . lSelect .~ mwp | otherwise = id - g | ButtonRight `M.member` _mouseButtons (_cWorld w) = cWorld . rSelect .~ mwp + g | ButtonRight `M.member` _mouseButtons w = cWorld . rSelect .~ mwp | otherwise = id --mcChooseUpdate :: Machine -> Machine -> World -> World diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 9987d7ece..5c9220847 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -55,13 +55,13 @@ moveZoomCamera uv = uv vfoffset = do iscam <- yourItem w ^? _Just . itScope . scopeIsCamera guard iscam - guard (SDL.ButtonRight `M.member` _mouseButtons (_cWorld w)) + guard (SDL.ButtonRight `M.member` _mouseButtons w) yourItem w ^? _Just . itScope . scopePos mscopeoffset = do - guard (SDL.ButtonRight `M.member` _mouseButtons (_cWorld w)) + guard (SDL.ButtonRight `M.member` _mouseButtons w) yourItem w ^? _Just . itScope . scopePos newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset - offset = rotateV (_cameraRot (_cWorld w)) $ ((newzoom - newDefaultZoom)/(newDefaultZoom*newzoom)) *.* _mousePos (_cWorld w) + offset = rotateV (_cameraRot (_cWorld w)) $ ((newzoom - newDefaultZoom)/(newDefaultZoom*newzoom)) *.* _mousePos w --newzoom = changeZoom (_cameraZoom w) idealZoom' newzoom = case yourItem w ^? _Just . itScope of Just zs@ZoomScope {} -> _scopeZoom zs @@ -93,7 +93,7 @@ moveZoomCamera uv = uv updateScopeZoom :: World -> World updateScopeZoom w - | SDL.ButtonRight `M.member` _mouseButtons (_cWorld w) + | SDL.ButtonRight `M.member` _mouseButtons w = case w ^? cWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_cWorld w) IM.! 0)) . itScope . scopeZoomChange of Just x @@ -127,7 +127,7 @@ zoomInLongGun w wp = _crInv (_creatures (_cWorld w) IM.! 0) IM.! crSel (_creatures (_cWorld w) IM.! 0) Just currentZoom = wp ^? itScope . scopeZoom newzoom = (wp ^?! itScope . scopeZoom) / zoomSpeed - mousep = rotateV (_cameraRot (_cWorld w)) $ _mousePos (_cWorld w) + mousep = rotateV (_cameraRot (_cWorld w)) $ _mousePos w zoomOutLongGun :: World -> World zoomOutLongGun w @@ -146,7 +146,7 @@ zoomOutLongGun w ifConfigWallRotate :: Configuration -> World -> World ifConfigWallRotate cfig w - | _gameplay_rotate_to_wall cfig && not (SDL.ButtonRight `M.member` _mouseButtons (_cWorld w)) + | _gameplay_rotate_to_wall cfig && not (SDL.ButtonRight `M.member` _mouseButtons w) = rotateToOverlappingWall w | otherwise = w @@ -185,8 +185,8 @@ rotateCamera cfig w | keyr = rotateCameraBy (-0.025) w | otherwise = ifConfigWallRotate cfig w where - keyl = SDL.ScancodeQ `Set.member` _keys (_cWorld w) && notAtTerminal w - keyr = SDL.ScancodeE `Set.member` _keys (_cWorld w) && notAtTerminal w + keyl = SDL.ScancodeQ `Set.member` _keys w && notAtTerminal w + keyr = SDL.ScancodeE `Set.member` _keys w && notAtTerminal w -- TODO check where/how this is used notAtTerminal :: World -> Bool diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index 9477b95b5..52c6dac3a 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/src/Dodge/Update/UsingInput.hs @@ -21,55 +21,55 @@ import Control.Lens updateUsingInput :: World -> World updateUsingInput w = case _hudElement $ _hud (_cWorld w) of DisplayInventory subinv - -> updatePressedButtons subinv (_mouseButtons (_cWorld w)) w + -> updatePressedButtons subinv (_mouseButtons w) w DisplayCarte - -> updatePressedButtonsCarte (_mouseButtons (_cWorld w)) w + -> updatePressedButtonsCarte (_mouseButtons w) w updatePressedButtons :: SubInventory -> M.Map MouseButton Bool -> World -> World updatePressedButtons subinv pkeys w = case subinv of NoSubInventory - | ButtonLeft `M.member` pkeys && w ^?! cWorld . hammers . ix SubInvHam /= HammerUp - -> w & cWorld . hammers . ix SubInvHam .~ HammerDown + | ButtonLeft `M.member` pkeys && w ^?! hammers . ix SubInvHam /= HammerUp + -> w & hammers . ix SubInvHam .~ HammerDown | otherwise -> updatePressedButtons' pkeys w CombineInventory mi | pkeys ^? ix ButtonLeft == Just False - -> maybeexitcombine (maybe id doCombine mi w) & cWorld . hammers . ix SubInvHam .~ HammerDown + -> maybeexitcombine (maybe id doCombine mi w) & hammers . ix SubInvHam .~ HammerDown DisplayTerminal tmid | pkeys ^? ix ButtonLeft == Just False && inTermFocus w -> doTerminalEffectLB (w ^?! cWorld . terminals . ix tmid) w - & cWorld . hammers . ix SubInvHam .~ HammerDown + & hammers . ix SubInvHam .~ HammerDown | pkeys ^? ix ButtonLeft == Just False -> w & cWorld . terminals . ix tmid . tmInput . tiFocus %~ const True - & cWorld . hammers . ix SubInvHam .~ HammerDown + & hammers . ix SubInvHam .~ HammerDown _ | ButtonLeft `M.member` pkeys - -> w & cWorld . hammers . ix SubInvHam .~ HammerDown + -> w & hammers . ix SubInvHam .~ HammerDown _ -> w where maybeexitcombine - | ButtonRight `M.member` _mouseButtons (_cWorld w) = id + | ButtonRight `M.member` _mouseButtons w = id | otherwise = cWorld . hud . hudElement .~ DisplayInventory NoSubInventory updatePressedButtons' :: M.Map MouseButton Bool -> World -> World updatePressedButtons' pkeys w | isDown ButtonLeft && isDown ButtonRight && inTopInv - = useItem (you w) w & cWorld . hammers . ix DoubleMouseHam .~ HammerDown + = useItem (you w) w & hammers . ix DoubleMouseHam .~ HammerDown | isDown ButtonLeft && (inTopInv || _timeFlow (_cWorld w) == RewindingLastFrame) - && w ^?! cWorld . hammers . ix DoubleMouseHam == HammerUp + && w ^?! hammers . ix DoubleMouseHam == HammerUp = useLeftItem (_yourID (_cWorld w)) w | isDown ButtonLeft && (inTopInv || _timeFlow (_cWorld w) == RewindingLastFrame) - = w & cWorld . hammers . ix DoubleMouseHam .~ HammerDown + = w & hammers . ix DoubleMouseHam .~ HammerDown | isDown ButtonRight && inTopInv = w | isDown ButtonMiddle = w & cWorld . cameraRot -~ rotation - & cWorld . clickMousePos .~ _mousePos (_cWorld w) - | isDown ButtonLeft = w & cWorld . hammers . ix DoubleMouseHam .~ HammerDown + & cWorld . clickMousePos .~ _mousePos w + | isDown ButtonLeft = w & hammers . ix DoubleMouseHam .~ HammerDown | otherwise = w where inTopInv = case _hudElement (_hud (_cWorld w)) of DisplayInventory NoSubInventory -> True _ -> False isDown but = but `M.member` pkeys - rotation = angleBetween (_mousePos (_cWorld w)) (_clickMousePos (_cWorld w)) + rotation = angleBetween (_mousePos w) (_clickMousePos (_cWorld w)) -- note "sort" on the inventory indices; otherwise @@ -90,15 +90,15 @@ doCombine i w = case combineItemListYou w ^? ix i of updatePressedButtonsCarte :: M.Map MouseButton Bool -> World -> World updatePressedButtonsCarte pkeys w | isDown ButtonRight = w - & cWorld . clickMousePos .~ _mousePos (_cWorld w) + & cWorld . clickMousePos .~ _mousePos w & cWorld . hud . carteCenter %~ (-.- trans) | isDown ButtonLeft = w - & cWorld . clickMousePos .~ _mousePos (_cWorld w) + & cWorld . clickMousePos .~ _mousePos w & cWorld . hud . carteRot -~ rot & cWorld . hud . carteZoom *~ czoom | otherwise = w where isDown but = but `M.member` pkeys - rot = angleBetween (_mousePos (_cWorld w)) (_clickMousePos (_cWorld w)) - czoom = magV (_mousePos (_cWorld w)) / magV (_clickMousePos (_cWorld w)) - trans = rotateV (_carteRot (_hud (_cWorld w))) $ 1 / _carteZoom (_hud (_cWorld w)) *.* (_mousePos (_cWorld w) -.- _clickMousePos (_cWorld w)) + 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)) diff --git a/src/Dodge/Zoning.hs b/src/Dodge/Zoning.hs index f1c01a136..af9c161d2 100644 --- a/src/Dodge/Zoning.hs +++ b/src/Dodge/Zoning.hs @@ -6,4 +6,3 @@ module Dodge.Zoning import Dodge.Zoning.Creature import Dodge.Zoning.Wall import Dodge.Zoning.Pathing -