Continue reload refactor

This commit is contained in:
2022-06-21 14:07:17 +01:00
parent 14a7189b44
commit 53c8be0679
33 changed files with 106 additions and 115 deletions
+2 -2
View File
@@ -8,10 +8,10 @@ you :: World -> Creature
you w = _creatures w IM.! _yourID w
yourItem :: World -> Maybe Item
yourItem w = _crInv (you w) IM.!? _crInvSel (you w)
yourItem w = _crInv (you w) IM.!? crSel (you w)
yourInv :: World -> IM.IntMap Item
yourInv w = _crInv (you w)
yourInvSel :: World -> Int
yourInvSel = _crInvSel . you
yourInvSel = crSel . you
+4 -4
View File
@@ -243,16 +243,16 @@ stripNoItems cr = organiseInvKeys (_crID cr) .
organiseInvKeys :: Int -> World -> World
organiseInvKeys cid w = w & creatures . ix cid %~
( ( crInvSel .~ newSelKey ) . (crInv .~ newInv ) )
( ( crInvSel . iselPos .~ newSelKey ) . (crInv .~ newInv ) )
where
cr = _creatures w IM.! cid
pairs = IM.toList (_crInv cr)
newSelKey = fromMaybe 0 $ findIndex ( (== _crInvSel cr) . fst) pairs
newSelKey = fromMaybe 0 $ findIndex ( (== crSel cr) . fst) pairs
newInv = IM.fromAscList $ zip [0..] $ map snd pairs
dropUnselected :: Creature -> World -> World
dropUnselected cr w = foldr (dropItem cr) w . IM.keys
$ _crInvSel cr `IM.delete` _crInv cr
$ crSel cr `IM.delete` _crInv cr
dropExcept :: Creature -> Int -> World -> World
dropExcept cr invid w = foldr (dropItem cr) w . IM.keys
@@ -276,7 +276,7 @@ youDropItem w
youDropItem' :: World -> World
youDropItem' w = case yourItem w ^? _Just . itCurseStatus of
Just Uncursed -> w
& dropItem cr (_crInvSel cr)
& dropItem cr (crSel cr)
& soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
_ -> w
where
-1
View File
@@ -31,7 +31,6 @@ autoCrit = defaultCreature
, _crGoal = []
}
, _crInv = IM.fromList [(0,autoGun),(1,medkit 100)]
, _crInvSel = 0
, _crRad = 10
, _crHP = 300
, _crMvType = defaultAimMvType
+1 -1
View File
@@ -61,7 +61,7 @@ followImpulse cr w imp = case imp of
TurnTo p -> crup $ creatureTurnTo p cr
ChangePosture post -> crup $ cr & crStance . posture .~ post
UseItem -> (useItem cr, cr)
SwitchToItem i -> crup $ cr & crInvSel .~ i
SwitchToItem i -> crup $ cr & crInvSel .~ InvSel i NoInvSelAction
Melee cid' -> (hitCr cid'
, crMvBy (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20)
RandomTurn a -> (randGen .~ snd (rr a), creatureTurn (fst $ rr a) cr)
+7 -7
View File
@@ -13,7 +13,7 @@ import Data.Maybe
useItem :: Creature -> World -> World
useItem cr' w = fromMaybe (f w) $ do
cr <- w ^? creatures . ix (_crID cr')
it <- cr ^? crInv . ix (_crInvSel cr)
it <- cr ^? crInv . ix (crSel cr)
return $ itemEffect cr it w
where
f = creatures . ix (_crID cr') . crHammerPosition .~ HammerDown
@@ -25,7 +25,7 @@ itemEffect cr it w = case it ^? itUse of
Just LeftUse {} -> doequipmentchange
Just EquipUse{} -> doequipmentchange
-- ConsumeUse will cause problems if the item is not selected
Just (ConsumeUse eff) -> setuhamdown $ hammerTest $ eff it cr . rmInvItem (_crID cr) (_crInvSel cr)
Just (ConsumeUse eff) -> setuhamdown $ hammerTest $ eff it cr . rmInvItem (_crID cr) (crSel cr)
Just NoUse -> setuhamdown w
Nothing -> setuhamdown w
where
@@ -33,7 +33,7 @@ itemEffect cr it w = case it ^? itUse of
HammerUp -> f w
_ -> w & setuhamdown
setuhamdown = creatures . ix (_crID cr) . crHammerPosition .~ HammerDown
doequipmentchange = setuhamdown $ hammerTest (toggleEquipmentAt (_rbOptions w) (_crInvSel cr) cr
doequipmentchange = setuhamdown $ hammerTest (toggleEquipmentAt (_rbOptions w) (crSel cr) cr
. activateEquipmentAt (_rbOptions w) cr)
activateEquipmentAt :: RightButtonOptions -> Creature -> World -> World
@@ -72,7 +72,7 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
where
crpoint = creatures . ix (_crID cr)
itmat i = _crInv cr IM.! i
itm = itmat (_crInvSel cr)
itm = itmat (crSel cr)
onequip itm' = (_eqOnEquip . _eqEq . _itUse) itm' itm'
onremove itm' = (_eqOnRemove . _eqEq . _itUse) itm' itm'
@@ -87,8 +87,8 @@ useLeftItem cid w
return $ f itm cr w
where
cr = _creatures w IM.! cid
itmShouldBeUsed = isJust (cr ^? crInv . ix (_crInvSel cr) . itUse . cUse)
|| ( isJust (cr ^? crInv . ix (_crInvSel cr) . itUse . eqEq . eqUse)
&& _crLeftInvSel cr /= Just (_crInvSel cr)
itmShouldBeUsed = isJust (cr ^? crInv . ix (crSel cr) . itUse . cUse)
|| ( isJust (cr ^? crInv . ix (crSel cr) . itUse . eqEq . eqUse)
&& _crLeftInvSel cr /= Just (crSel cr)
)
-- TODO determine itmShouldBeUsed with reference to config options
-1
View File
@@ -46,7 +46,6 @@ launcherCrit = defaultCreature
, _crGoal = []
}
, _crInv = IM.fromList [(0,launcher)]
, _crInvSel = 0
, _crRad = 10
, _crState = defaultState
, _crHP = 300
-1
View File
@@ -50,7 +50,6 @@ ltAutoCrit = defaultCreature
, _crGoal = []
}
, _crInv = IM.fromList [(0,autoPistol),(1,medkit 100)]
, _crInvSel = 0
, _crRad = 10
, _crHP = 500
}
-1
View File
@@ -47,7 +47,6 @@ pistolCrit = defaultCreature
, _crGoal = []
}
, _crInv = IM.fromList [(0,pistol),(1,medkit 100)]
, _crInvSel = 0
, _crRad = 10
, _crHP = 500
}
+1 -1
View File
@@ -125,7 +125,7 @@ doStrategyActions cr = case cr ^? crActionPlan . crStrategy of
reloadOverride :: Creature -> Creature
reloadOverride cr
| cr ^? crInv . ix (_crInvSel cr) . itConsumption . laLoaded == Just 0
| cr ^? crInv . ix (crSel cr) . itConsumption . laLoaded == Just 0
&& cr ^. crStance . posture == Aiming
= cr & crActionPlan . crStrategy .~ StrategyActions Reload reloadActions
| otherwise = cr
-1
View File
@@ -52,7 +52,6 @@ spreadGunCrit = defaultCreature
, _crGoal = []
}
, _crInv = IM.fromList [(0,bangStick 6),(1,medkit 100)]
, _crInvSel = 0
, _crRad = 10
, _crHP = 500
}
-1
View File
@@ -29,7 +29,6 @@ data FootForward
deriving
(Eq,Ord,Show)
data Posture = Aiming
| Reloading
| AtEase
deriving
(Eq,Ord,Show)
+3 -3
View File
@@ -217,8 +217,8 @@ invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr)
itemUpdate :: Creature -> Int -> Item -> Item
itemUpdate cr i
| i == _crInvSel cr = baseupdate True
| otherwise = baseupdate False
| i == crSel cr = baseupdate True
| otherwise = baseupdate False
where
baseupdate bool = (itUse %~ useUpdate) . (itInvPos ?~ i) . (itIsHeld .~ bool)
@@ -230,7 +230,7 @@ doItemTargeting invid cr w = case cr ^? crInv . ix invid . itTargeting of
in w' & creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ t'
weaponReloadSounds :: Creature -> World -> World
weaponReloadSounds cr w = case cr ^? crInvSelAction of
weaponReloadSounds cr w = case cr ^? crInvSel . iselAction of
Just ReloadAction{} -> soundContinue (CrReloadSound cid) (_crPos cr) reloadS (Just 1) w
_ -> w
-- PassiveReload stype | Just (_laReloadTime am) == am ^? laTransfer . transferTime
+3 -2
View File
@@ -3,6 +3,7 @@ module Dodge.Creature.Statistics
, getCrDexterity
) where
import Dodge.Data
import Dodge.Creature.Test
import qualified IntMapHelp as IM
import LensHelp
@@ -31,6 +32,6 @@ crCurrentEquipment cr = merge dropMissing dropMissing (zipWithMatched (\_ _ itm
strFromHeldItem :: Creature -> Int
strFromHeldItem cr
| _posture (_crStance cr) == Aiming || _posture (_crStance cr) == Reloading
= negate $ fromMaybe 0 $ cr ^? crInv . ix (_crInvSel cr) . itUse . useAim . aimWeight
| _posture (_crStance cr) == Aiming || crIsReloading cr
= negate $ fromMaybe 0 $ cr ^? crInv . ix (crSel cr) . itUse . useAim . aimWeight
| otherwise = 0
+5 -5
View File
@@ -24,12 +24,12 @@ onBoth :: (a -> b -> c) -> (d -> a) -> (d -> b) -> d -> c
onBoth f g h x = f (g x) (h x)
crIsReloading :: Creature -> Bool
crIsReloading cr = case cr ^? crStance . posture of
Just Reloading -> True
crIsReloading cr = case cr ^? crInvSel . iselAction of
Just ReloadAction {} -> True
_ -> False
crWeaponReady :: Creature -> Bool
crWeaponReady cr = isNothing $ cr ^? crInv . ix (_crInvSel cr) . itConsumption . laProgress . _Just
crWeaponReady cr = isNothing $ cr ^? crInv . ix (crSel cr) . itConsumption . laProgress . _Just
crCanSeeCr :: Creature -> (World, Creature) -> Bool
crCanSeeCr tcr (w,cr) = hasLOS (_crPos cr) (_crPos tcr) w
@@ -65,14 +65,14 @@ crAwayFromPost cr = case find sentinelGoal . _crGoal $ _crActionPlan cr of
sentinelGoal _ = False
crHasAmmo :: Creature -> Bool
crHasAmmo cr = maybe False (> 0) $ cr ^? crInv . ix (_crInvSel cr) . itConsumption . laLoaded
crHasAmmo cr = maybe False (> 0) $ cr ^? crInv . ix (crSel cr) . itConsumption . laLoaded
crCanShoot :: Creature -> Bool
crCanShoot p = crIsAiming p && crHasAmmo p
crInAimStance :: AimStance -> Creature -> Bool
crInAimStance as cr = crIsAiming cr -- || (_posture (_crStance cr) == Reloading && hasAmmo cr)
&& cr ^? crInv . ix (_crInvSel cr) . itUse . useAim . aimStance == Just as
&& cr ^? crInv . ix (crSel cr) . itUse . useAim . aimStance == Just as
oneH :: Creature -> Bool
oneH = crInAimStance OneHand
+4 -6
View File
@@ -4,6 +4,7 @@ module Dodge.Creature.YourControl
import Dodge.Data
import Dodge.Base.Coordinate
import Dodge.Creature.Impulse.Movement
import Dodge.Creature.Test
import Dodge.Update.UsingInput
import Dodge.InputFocus
--import Dodge.Config.KeyConfig
@@ -33,7 +34,7 @@ wasdWithAiming
-> Creature
wasdWithAiming w speed cr
| isAiming = addAnyTwist $ set crDir mouseDir $ theMovement cr
| isReloading && SDL.ButtonRight `S.member` _mouseButtons w
| crIsReloading cr && SDL.ButtonRight `S.member` _mouseButtons w
= addAnyTwist $ set crDir (mouseDir + anytwist) $ theMovement cr
| otherwise = theMovement $ theTurn $ removeTwist cr
where
@@ -41,7 +42,7 @@ wasdWithAiming w speed cr
removeTwist cr' = cr'
& crDir +~ _crTwist cr'
& crTwist .~ 0
anytwist = case cr ^? crInv . ix (_crInvSel cr) . itUse . useAim . aimStance of
anytwist = case cr ^? crInv . ix (crSel cr) . itUse . useAim . aimStance of
Just TwoHandTwist -> twistamount * pi
_ -> 0
addAnyTwist = crTwist .~ anytwist
@@ -53,8 +54,7 @@ wasdWithAiming w speed cr
dir = _cameraRot w + argV movDir
movAbs = rotateV (_cameraRot w) $ normalizeV movDir
isAiming = _posture (_crStance cr) == Aiming
isReloading = _posture (_crStance cr) == Reloading
mouseDir = case cr ^? crInv . ix (_crInvSel cr) . itScope . scopePos of
mouseDir = case cr ^? crInv . ix (crSel cr) . itScope . scopePos of
Just _ -> argV $ mouseWorldPos w -.- _crPos cr
_ -> argV (_mousePos w) + _cameraRot w
@@ -72,9 +72,7 @@ wasdDir = foldr ((+.+) . wasdM) (V2 0 0) . _keys
{- | Set posture according to mouse presses. -}
mouseActionsCr :: S.Set SDL.MouseButton -> Creature -> Creature
mouseActionsCr pkeys cr
| _posture (_crStance cr) == Reloading = cr
| rbPressed = cr & crStance . posture .~ Aiming
| otherwise = cr & crStance . posture .~ AtEase
where
-- reloading = isJust $ cr ^? crInv . ix (_crInvSel cr) . itConsumption . laReloadState . _Just'
rbPressed = SDL.ButtonRight `S.member` pkeys
+6 -2
View File
@@ -346,8 +346,7 @@ data Creature = Creature
, _crHP :: Int
, _crMaxHP :: Int
, _crInv :: IM.IntMap Item
, _crInvSel :: Int
, _crInvSelAction :: InvSelAction
, _crInvSel :: InvSel
, _crInvCapacity :: Int
, _crInvLock :: Bool
, _crInvEquipped :: IM.IntMap EquipPosition
@@ -550,6 +549,7 @@ data LoadAction
| Insert {_actionTime :: Int, _insertMax :: Maybe Int }
| Prime {_actionTime :: Int}
deriving (Eq,Ord,Show)
data InvSel = InvSel {_iselPos :: Int, _iselAction :: InvSelAction }
data InvSelAction
= NoInvSelAction
| ReloadAction { _actionProgress :: Int, _reloadAction :: LoadAction }
@@ -1478,6 +1478,7 @@ makeLenses ''FloorItem
makeLenses ''ItemConsumption
makeLenses ''AmmoType
makeLenses ''LoadAction
makeLenses ''InvSel
makeLenses ''InvSelAction
makeLenses ''TweakParam
makeLenses ''Prop
@@ -1539,3 +1540,6 @@ makeLenses ''RoomType
makeLenses ''PSType
makeLenses ''PlacementSpot
makeLenses ''Placement
crSel :: Creature -> Int
crSel = _iselPos . _crInvSel
-1
View File
@@ -74,7 +74,6 @@ applySetTerminalString var = case key' of
"" -> showTerminalError ("set "++var) ("Unable to read as argument as float: " ++ val)
"hp" -> uvWorld . creatures . ix 0 . crHP .~ round (fromJust val')
"invcap" -> uvWorld . creatures . ix 0 . crInvCapacity .~ round (fromJust val')
"invsel" -> uvWorld . creatures . ix 0 . crInvSel .~ round (fromJust val')
"mass" -> uvWorld . creatures . ix 0 . crMass .~ fromJust val'
"mvspeed" -> uvWorld . creatures . ix 0 . crMvType .mvSpeed .~ fromJust val'
_ -> showTerminalError ("set "++var) ("Invalid set command: " ++ key) -- never reached?
+1 -2
View File
@@ -46,8 +46,7 @@ defaultCreature = Creature
, _crHP = 100
, _crMaxHP = 150
, _crInv = IM.empty
, _crInvSel = 0
, _crInvSelAction = NoInvSelAction
, _crInvSel = InvSel 0 NoInvSelAction
, _crInvCapacity = 25
, _crInvLock = False
, _crInvEquipped = mempty
+4 -4
View File
@@ -119,7 +119,7 @@ doCombine i w = case combineItemListYou w !? i of
$ foldr (rmInvItem yid) w (sort is)
where
yid = _yourID w
selectinv (Just i', w') = w' & creatures . ix yid . crInvSel .~ i'
selectinv (Just i', w') = w' & creatures . ix yid . crInvSel .~ InvSel i' NoInvSelAction
selectinv (Nothing, w') = w'
@@ -141,7 +141,7 @@ wheelEvent y w = case _hudElement $ _hud w of
| rbDown -> case (yourItem w ^? _Just . itUse . heldScroll,_rbOptions w) of
(_,EquipOptions{}) -> scrollRBOption y w
(Nothing,_) -> closeObjScrollDir y w
(Just f,_) -> w & creatures . ix 0 . crInv . ix (_crInvSel $ you w) %~ f y (you w)
(Just f,_) -> w & creatures . ix 0 . crInv . ix (crSel $ you w) %~ f y (you w)
| lbDown -> w & cameraZoom +~ y
| invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeSwapInvSel yi w
| otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
@@ -218,12 +218,12 @@ scrollRBOption y w
moveTweakSel :: Int -> World -> World
moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of
Just l -> w & creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w))
Just l -> w & creatures . ix (_yourID w) . crInv . ix (crSel (you w))
. itTweaks . tweakSel %~ (`mod` length l) . subtract i
_ -> w
changeTweakParam :: Int -> World -> World
changeTweakParam i w = w
& creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w)) %~
& creatures . ix (_yourID w) . crInv . ix (crSel (you w)) %~
( (itTweaks . tweakParams . ix paramid . curTweak .~ x)
. _doTweak params x)
where
+16 -14
View File
@@ -55,7 +55,7 @@ rmInvItem :: Int -- ^ Creature id
rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itConsumption . icAmount of
Just x | x > 1 -> w & creatures . ix cid . crInv . ix invid . itConsumption . icAmount %~ subtract 1
_ -> w & creatures . ix cid . crInv %~ f
& creatures . ix cid . crInvSel %~ g
& creatures . ix cid . crInvSel . iselPos %~ g
& creatures . ix cid . crLeftInvSel %~ g'
& removeAnySlotEquipment
& dounequipfunction
@@ -87,7 +87,7 @@ rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itCons
| otherwise = Just x
rmSelectedInvItem :: Int -> World -> World
rmSelectedInvItem cid w = rmInvItem cid (_crInvSel (_creatures w IM.! cid)) w
rmSelectedInvItem cid w = rmInvItem cid (crSel (_creatures w IM.! cid)) w
augmentedInvSizes :: World -> IM.IntMap Int
augmentedInvSizes = bimapAugmentInv itSlotsTaken closeObjectSize
@@ -160,7 +160,7 @@ checkTermDist w = case w ^? hud . hudElement . subInventory . termID of
updateCloseObjects :: World -> World
updateCloseObjects w = w
& closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
& creatures . ix (_yourID w) . crInvSel %~ updateinvsel
& creatures . ix (_yourID w) . crInvSel . iselPos %~ updateinvsel
where
updateinvsel curinvsel
| length (augmentedInvSizes w) <= curinvsel = max 0 $ length (augmentedInvSizes w) - 1
@@ -192,12 +192,12 @@ updateRBList w
Nothing -> w & rbOptions .~ NoRightButtonOptions
-- | otherwise = w & rbOptions .~ NoRightButtonOptions
where
curinvid = _crInvSel cr
curinvid = crSel cr
cr = you w
chooseEquipmentPosition :: Creature -> [EquipPosition] -> Int
chooseEquipmentPosition cr eps = fromMaybe (chooseFreeSite cr eps) $ do
ep <- cr ^? crInvEquipped . ix (_crInvSel cr)
ep <- cr ^? crInvEquipped . ix (crSel cr)
elemIndex ep eps
chooseFreeSite :: Creature -> [EquipPosition] -> Int
@@ -208,7 +208,7 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
setEquipAllocation :: World -> World
setEquipAllocation w = case _rbOptions w of
EquipOptions {_opEquip = es,_opSel=i} ->
case you w ^? crInvEquipped . ix (_crInvSel (you w)) of
case you w ^? crInvEquipped . ix (crSel (you w)) of
Just epos | es !! i == epos
-> w & rbOptions . opAllocateEquipment .~ RemoveEquipment
{_allocOldPos = epos}
@@ -254,7 +254,7 @@ setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
where
invsel = _crInvSel (you w)
invsel = crSel (you w)
invselcanactivate = isJust (you w ^? crInv . ix invsel . itUse . lUse)
equipSiteToPositions :: EquipSite -> [EquipPosition]
@@ -276,8 +276,10 @@ closeObjScrollDir x
changeInvSel :: Int -> World -> World
changeInvSel i w
| n == 0 = w
| yourInvSel w < n = w & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i
| otherwise = w & creatures . ix (_yourID w) . crInvSel %~ ((+n) . (`mod` numCO) . subtract (i+n))
| yourInvSel w < n = w & creatures . ix (_yourID w) . crInvSel . iselPos %~ (`mod` n) . subtract i
& creatures . ix (_yourID w) . crInvSel . iselAction .~ NoInvSelAction
| otherwise = w & creatures . ix (_yourID w) . crInvSel . iselPos %~ ((+n) . (`mod` numCO) . subtract (i+n))
& creatures . ix (_yourID w) . crInvSel . iselAction .~ NoInvSelAction
-- arguably this should jump the invpos into the inventory proper
where
n = length $ _crInv $ _creatures w IM.! _yourID w
@@ -288,12 +290,12 @@ changeSwapInvSel k w
| n == 0 = w
| yourInvSel w < n = w
& creatures . ix (_yourID w) %~ updatecreature
| otherwise = w & creatures . ix (_yourID w) . crInvSel .~ ico'
| otherwise = w & creatures . ix (_yourID w) . crInvSel . iselPos .~ ico'
& closeObjects %~ swapIndices (i - n) (ico' - n)
where
updatecreature = ( crInv %~ IM.safeSwapKeys (i `mod` n) swapi )
. (crLeftInvSel . _Just %~ updateLeftInvSel)
. (crInvSel %~ (`mod` n) . subtract k)
. (crInvSel . iselPos %~ (`mod` n) . subtract k)
. (crInvEquipped %~ IM.safeSwapKeys i swapi)
. swapSite i swapi
. swapSite swapi i
@@ -305,7 +307,7 @@ changeSwapInvSel k w
updateLeftInvSel li | i == li = swapi
| swapi == li = i
| otherwise = li
i = _crInvSel cr
i = crSel cr
ico' = ( (i - (k+n)) `mod` numCO ) + n
n = length $ _crInv cr
numCO = length $ _closeObjects w
@@ -313,7 +315,7 @@ changeSwapInvSel k w
changeAugInvSel :: Int -> World -> World
changeAugInvSel i w
| n == 0 = w
| otherwise = w & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i
| otherwise = w & creatures . ix (_yourID w) . crInvSel . iselPos %~ (`mod` n) . subtract i
where
n = length (yourInv w) + length (_closeObjects w)
@@ -329,7 +331,7 @@ selectedCloseObject w
| invsel >= length inv = selectNthCloseObject w (invsel - length inv)
| otherwise = selectNthCloseObject w =<< bestCloseObjectIndex w
where
invsel = _crInvSel cr
invsel = crSel cr
cr = you w
inv = _crInv cr
+1 -1
View File
@@ -43,7 +43,7 @@ charFiringStratI
:: [(Char, ChainEffect)] -- ^ Different firing effects for different characters
-> ChainEffect
charFiringStratI strats eff item cr w = case w ^? creatures . ix cid . crInv
. ix (_crInvSel $ _creatures w IM.! cid) . itAttachment . atCharMode of
. ix (crSel $ _creatures w IM.! cid) . itAttachment . atCharMode of
Just (c :<| _) -> fromMaybe id (Prelude.lookup c strats) eff item cr w
_ -> w
where
+1 -1
View File
@@ -52,7 +52,7 @@ pictureWeaponOnAimItem p' cr posInInv
where
shoulderD = translateSPz 18
handD = translateSPz 15
isSelected = _crInvSel cr == posInInv
isSelected = crSel cr == posInInv
twistWep = translateSPf (-5) 0 p
holsteredWep = translateSPf (_crRad cr) 0
(rotateSP (strideRot cr + 1.2) (translateSPf (-5) 0 twistWep))
+1 -1
View File
@@ -202,7 +202,7 @@ effectOnOffHeld f f' = ItInvEffectID
}
where
g itm cr w
| _crInvSel cr == invid = f cr invid w
| crSel cr == invid = f cr invid w
| otherwise = f' cr invid w
where
invid = fromJust $ _itInvPos itm
+1 -1
View File
@@ -17,7 +17,7 @@ getHeldItemLoc cr w = case maybeitid of
_ -> (w, itid)
where
cid = _crID cr
j = _crInvSel cr
j = crSel cr
newitid = IM.newKey $ _itemPositions w
maybeitid = cr ^? crInv . ix j . itID . _Just
itid = fromMaybe newitid maybeitid
+4 -4
View File
@@ -373,7 +373,7 @@ tractorGunPic it =
-- | assumes that the item is held
shootTeslaArc :: Item -> Creature -> World -> World
shootTeslaArc it cr w = w'
& creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itParams .~ ip
& creatures . ix (_crID cr) . crInv . ix (crSel cr) . itParams .~ ip
where
(w',ip) = shootTeslaArc' (_itParams it) pos dir w
pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
@@ -385,7 +385,7 @@ shootLaser it cr = instantParticles .:~ lasRayAt (_lasColor $ _itParams it) dam
where
pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
dir = _crDir cr
phasev = _phaseV . _itParams $ _crInv cr IM.! _crInvSel cr
phasev = _phaseV . _itParams $ _crInv cr IM.! crSel cr
dam = _lasDamage $ _itParams it
@@ -405,7 +405,7 @@ shootDualLaser it cr w = w'
| otherwise = mwp
dirl = argV $ mwp' -.- posl
dirr = argV $ mwp' -.- posr
phasev = _phaseV . _itParams $ _crInv cr IM.! _crInvSel cr
phasev = _phaseV . _itParams $ _crInv cr IM.! crSel cr
dam = _lasDamage $ _itParams it
drawBeam :: Beam -> Picture
@@ -448,7 +448,7 @@ aTractorBeam _ cr w = w & plNew props pjID (tractorBeamAt spos outpos dir power)
dir = _crDir cr
outpos = collidePointWalls cpos xpos
$ wallsAlongLine cpos xpos w
power = _attractionPower . _itParams $ _crInv cr IM.! _crInvSel cr
power = _attractionPower . _itParams $ _crInv cr IM.! crSel cr
tractorBeamAt :: Point2 -> Point2 -> Float -> Point2 -> Prop
tractorBeamAt pos outpos dir power = ProjectileTimed
+3 -3
View File
@@ -99,7 +99,7 @@ throwGrenade thePayload cr w = setWp $ removePict $ over props addG w
, _pjPayload = thePayload
, _pjTimer = fuseTime
}
j = _crInvSel cr
j = crSel cr
removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> (,) emptySH blank
i = IM.newKey $ _props w
v' = 1 / (fromIntegral fuseTime * _cameraZoom w) *.* rotateV (_cameraRot w) ( _mousePos w)
@@ -233,7 +233,7 @@ throwRemoteBomb cr w = setLocation
v' = 0.02 / _cameraZoom w *.* rotateV (_cameraRot w) ( _mousePos w)
v | magV v' > 6 = 6 *.* normalizeV v'
| otherwise = v'
j = _crInvSel cr
j = crSel cr
-- resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTE"
removePict = set (creatures . ix cid . crInv . ix j . itEquipPict) $ \ _ _ -> emptyBlank
resetFire = set (creatures . ix cid . crInv . ix j . itUse . rUse)
@@ -266,7 +266,7 @@ explodeRemoteBomb itid pjid cr w
resetPict = set (creatures . ix cid . crInv . ix j . itEquipPict )
(pictureWeaponAim $ \_ -> (,) emptySH remoteBombUnarmedPic)
-- resetScope = creatures . ix cid . crInv . ix j . itScope . _Just . scopePos .~ (0,0)
j = _crInvSel $ _creatures w IM.! cid
j = crSel $ _creatures w IM.! cid
remoteBombPic
:: Int -- ^ time
-> Picture
+2 -2
View File
@@ -293,7 +293,7 @@ fireRemoteShell it cr w = set (creatures . ix cid . crInv . ix j . itUse . rUse)
cid = _crID cr
addRemRocket = makeShell it cr $ \pj ->
decTimMvVel pj . setRemoteScope itid pj . moveRemoteShell cid itid pj
j = _crInvSel cr
j = crSel cr
moveRemoteShell :: Int -> Int -> Prop -> World -> World
moveRemoteShell cid itid pj w
@@ -320,7 +320,7 @@ moveRemoteShell cid itid pj w
newPos = oldPos +.+ vel
newdir
| SDL.ButtonRight `S.member` _mouseButtons w
&& w ^? creatures . ix cid . crInvSel == w ^? itemPositions . ix itid . ipInvId
&& w ^? creatures . ix cid . crInvSel . iselPos == w ^? itemPositions . ix itid . ipInvId
= _cameraRot w + argV (_mousePos w)
| otherwise = _pjDir pj
accel = rotateV newdir (V2 2 0)
+1 -1
View File
@@ -173,7 +173,7 @@ overNozzles' :: (Item -> Creature -> World -> Nozzle -> (World,Nozzle))
overNozzles' eff it cr w = neww & creatures . ix cid . crInv . ix i . itParams . sprayNozzles .~ newNozzles
where
cid = _crID cr
i = _crInvSel $ _creatures w IM.! cid
i = crSel $ _creatures w IM.! cid
(neww,newNozzles) = mapAccumR (eff it cr) w $ _sprayNozzles (_itParams it)
overNozzle :: (Nozzle -> Item -> Creature -> World -> World)
+1 -1
View File
@@ -12,7 +12,7 @@ useTargetPos
-> Creature
-> World
-> World
useTargetPos f cr w = case cr ^? crInv . ix (_crInvSel cr) . itTargeting . tgPos of
useTargetPos f cr w = case cr ^? crInv . ix (crSel cr) . itTargeting . tgPos of
Nothing -> w
Just p -> f p cr w
+10 -10
View File
@@ -140,7 +140,7 @@ ammoHammerCheck eff it cr w
_ -> setHammerDown w
where
cid = _crID cr
setHammerDown = creatures . ix cid . crInv . ix (_crInvSel cr) . itUse
setHammerDown = creatures . ix cid . crInv . ix (crSel cr) . itUse
. useHammer . hammerPosition .~ HammerDown
@@ -170,7 +170,7 @@ rateIncAB exeffFirst exeffCont eff item cr w
fastRate = _rateMinMax . _useDelay $ _itUse item
startRate = _rateMaxMax . _useDelay $ _itUse item
cid = _crID cr
itRef = _crInvSel cr
itRef = crSel cr
pointItem = creatures . ix cid . crInv . ix itRef
currentRate = _rateMax (_useDelay (_itUse item))
repeatFire = crWeaponReady cr && _rateTime (_useDelay (_itUse item)) == 1
@@ -190,7 +190,7 @@ withWarmUp soundID f item cr w
& f item cr
where
cid = _crID cr
itRef = _crInvSel cr
itRef = crSel cr
pointerToItem = creatures . ix cid . crInv . ix itRef
curWarmUp = _warmTime . _useDelay $ _itUse item
maxWarmUp = _warmMax . _useDelay $ _itUse item
@@ -283,14 +283,14 @@ withSidePushAfterI maxSide eff item cr w = over (creatures . ix cid) push . eff
(pushAmount, g) = randomR (-maxSide,maxSide) $ _randGen w
useAllAmmo :: ChainEffect
useAllAmmo eff item cr = eff item cr
. (creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itConsumption . laLoaded .~ 0)
. (creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded .~ 0)
useAmmoUpTo :: Int -> ChainEffect
useAmmoUpTo amAmount eff item cr = eff item cr
. (creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itConsumption . laLoaded
. (creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded
%~ (max 0 . subtract amAmount))
useAmmoAmount :: Int -> ChainEffect
useAmmoAmount amAmount eff item cr = eff item cr
. (creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itConsumption . laLoaded -~ amAmount)
. (creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded -~ amAmount)
{- |
Applies a world effect after an item use cooldown check. -}
useTimeCheck :: ChainEffect
@@ -299,7 +299,7 @@ useTimeCheck f item cr w = case item ^? itUse . useDelay . rateTime of
_ -> w
where
cid = _crID cr
setUseTime = creatures . ix cid . crInv . ix (_crInvSel cr) . itUse . useDelay . rateTime +~ userate
setUseTime = creatures . ix cid . crInv . ix (crSel cr) . itUse . useDelay . rateTime +~ userate
userate = fromMaybe 0 $ item ^? itUse . useDelay . rateMax
{- | Applies a world effect after a hammer position check. -}
hammerCheckI :: ChainEffect
@@ -308,7 +308,7 @@ hammerCheckI f it cr w = case it ^? itUse . useHammer . hammerPosition of
_ -> setHammerDown w
where
cid = _crID cr
setHammerDown = creatures . ix cid . crInv . ix (_crInvSel cr) . itUse
setHammerDown = creatures . ix cid . crInv . ix (crSel cr) . itUse
. useHammer . hammerPosition .~ HammerDown
{- | Applies a world effect after an ammo check. -}
-- this should be made "safe" incase there is no _rateTime
@@ -321,7 +321,7 @@ ammoUseCheck f item cr w
| otherwise = w
where
cid = _crID cr
itRef = _crInvSel cr
itRef = crSel cr
pointerToItem = creatures . ix cid . crInv . ix itRef
fireCondition = crWeaponReady cr
&& _rateTime (_useDelay (_itUse item)) == 0
@@ -366,7 +366,7 @@ shootL f item cr w
withItem :: (Item -> ChainEffect) -> ChainEffect
withItem g f it = g it f it
withItemUpdate :: (Item -> Item) -> (Item -> ChainEffect) -> ChainEffect
withItemUpdate up g f it cr = g it f it cr . (creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) %~ up)
withItemUpdate up g f it cr = g it f it cr . (creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up)
withTempLight :: Int -> Float -> V3 Float -> ChainEffect
withTempLight time rad col eff item cr = eff item cr
. over tempLightSources (theTLS :)
+16 -22
View File
@@ -1,8 +1,8 @@
module Dodge.Reloading
( stepReloading
-- , tryStartReloading
( tryStartLoading
, crStopReloading
, crStartReloading
, stepReloading
) where
import Dodge.Data
--import Dodge.Base.Arithmetic
@@ -12,28 +12,22 @@ import Control.Lens
import Data.Maybe
crStartReloading :: Creature -> World -> World
crStartReloading cr = creatures . ix (_crID cr) . crStance . posture .~ Reloading
crStartReloading cr w = fromMaybe w $ w & creatures . ix (_crID cr) %%~ tryStartLoading
crStopReloading :: Creature -> Creature
crStopReloading cr = cr & crStance . posture .~ AtEase
stepReloading :: Creature -> Creature
stepReloading cr = case _posture (_crStance cr) of
Reloading -> fromMaybe
(cr & crStance . posture .~ AtEase)
(cr & stepReloading')
_ -> cr & crInvSelAction .~ NoInvSelAction
stepReloading' :: Creature -> Maybe Creature
stepReloading' cr = case cr ^?! crInvSelAction of
ReloadAction x la | x > 0 -> Just $ cr & crInvSelAction . actionProgress -~ 1
| otherwise -> Just $ cr & completeLoadAction la
_ -> tryStartLoading cr
stepReloading cr = case cr ^?! crInvSel . iselAction of
ReloadAction x la
| x > 0 -> cr & crInvSel . iselAction . actionProgress -~ 1
| otherwise -> cr & completeLoadAction la
_ -> cr
tryStartLoading :: Creature -> Maybe Creature
tryStartLoading cr = case cr ^? crInv . ix (_crInvSel cr) . itConsumption . laProgress of
tryStartLoading cr = case cr ^? crInv . ix (crSel cr) . itConsumption . laProgress of
Just Nothing -> Just . continueLoading $ cr
& crInv . ix (_crInvSel cr) . itConsumption %~ setLoadCycle
& crInv . ix (crSel cr) . itConsumption %~ setLoadCycle
Just (Just _) -> Just . continueLoading $ cr
Nothing -> Nothing
@@ -41,16 +35,16 @@ setLoadCycle :: ItemConsumption -> ItemConsumption
setLoadCycle ic = ic & laProgress ?~ _laCycle ic
continueLoading :: Creature -> Creature
continueLoading cr = case cr ^? crInv . ix (_crInvSel cr) . itConsumption . laProgress . _Just of
Just (la:_) -> cr & crInvSelAction .~ ReloadAction (_actionTime la) la
_ -> cr & crInvSelAction .~ NoInvSelAction
& crInv . ix (_crInvSel cr) . itConsumption . laProgress .~ Nothing
continueLoading cr = case cr ^? crInv . ix (crSel cr) . itConsumption . laProgress . _Just of
Just (la:_) -> cr & crInvSel . iselAction .~ ReloadAction (_actionTime la) la
_ -> cr & crInvSel . iselAction .~ NoInvSelAction
& crInv . ix (crSel cr) . itConsumption . laProgress .~ Nothing
& crStance . posture .~ AtEase
completeLoadAction :: LoadAction -> Creature -> Creature
completeLoadAction la cr = continueLoading $ cr
& crInv . ix (_crInvSel cr) . itConsumption . laProgress . _Just %~ tail
& crInv . ix (_crInvSel cr) . itConsumption %~ doLoadAction la
& crInv . ix (crSel cr) . itConsumption . laProgress . _Just %~ tail
& crInv . ix (crSel cr) . itConsumption %~ doLoadAction la
-- Just LoadFinished
+1 -1
View File
@@ -128,7 +128,7 @@ subInventoryDisplay subinv cfig w = case subinv of
| ButtonRight `S.member` _mouseButtons w = listCursorNESW
| otherwise = listCursorNSW
curpos = invSelPos w
cury = fromMaybe 1 $ augmentedInvSizes w IM.!? _crInvSel (you w)
cury = fromMaybe 1 $ augmentedInvSizes w IM.!? crSel (you w)
equipcursor = case _crLeftInvSel cr of
Just invid -> f cyan invid (_crInvEquipped cr IM.! invid)
_ -> mempty
+7 -7
View File
@@ -81,7 +81,7 @@ moveZoomCamera cfig w = w
updateScopeZoom :: World -> World
updateScopeZoom w
| SDL.ButtonRight `S.member` _mouseButtons w
= case w ^? creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
= case w ^? creatures . ix 0 . crInv . ix (crSel (_creatures w IM.! 0))
. itScope . scopeZoomChange of
Just x
| x > 10 -> zoomInLongGun $ zoomInLongGun $ zoomInLongGun w
@@ -92,7 +92,7 @@ updateScopeZoom w
| x < 0 -> zoomOutLongGun w
| otherwise -> w
_ -> w
| otherwise = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
| otherwise = w & creatures . ix 0 . crInv . ix (crSel (_creatures w IM.! 0))
. itScope %~ updateScope
where
updateScope (ZoomScope _ _ _ defz bl) = ZoomScope (V2 0 0) 0 defz defz bl
@@ -110,8 +110,8 @@ zoomInLongGun w
| otherwise = w & wpPointer . itScope . scopeZoomChange .~ 0
where
decreaseScopeZoomChange = wpPointer . itScope . scopeZoomChange -~ 1
wpPointer = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
wp = _crInv (_creatures w IM.! 0) IM.! _crInvSel (_creatures w IM.! 0)
wpPointer = creatures . ix 0 . crInv . ix (crSel (_creatures w IM.! 0))
wp = _crInv (_creatures w IM.! 0) IM.! crSel (_creatures w IM.! 0)
Just currentZoom = wp ^? itScope . scopeZoom
newzoom = (wp ^?! itScope . scopeZoom) / zoomSpeed
mousep = rotateV (_cameraRot w) $ _mousePos w
@@ -127,8 +127,8 @@ zoomOutLongGun w
where
--mousep = rotateV (_cameraRot w) $ _mousePos w
increaseScopeZoomChange = wpPointer . itScope . scopeZoomChange +~ 1
wpPointer = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
wp = _crInv (_creatures w IM.! 0) IM.! _crInvSel (_creatures w IM.! 0)
wpPointer = creatures . ix 0 . crInv . ix (crSel (_creatures w IM.! 0))
wp = _crInv (_creatures w IM.! 0) IM.! crSel (_creatures w IM.! 0)
Just currentZoom = wp ^? itScope . scopeZoom
ifConfigWallRotate :: Configuration -> World -> World
@@ -156,7 +156,7 @@ rotateToOverlappingWall w = maybe w dowallrotate
rotateCameraBy :: Float -> World -> World
rotateCameraBy x w = w
& cameraRot +~ x
& creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
& creatures . ix 0 . crInv . ix (crSel (_creatures w IM.! 0))
. itScope . scopePos %~ rotateV x
rotateCamera :: Configuration -> World -> World