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

Cleanup

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