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

Partially working change to selected items

Browse Source
This commit is contained in:
justin
2023-02-07 12:07:13 +00:00
parent 5f7d662454
commit c354949ca9
27 changed files with 386 additions and 288 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Action.hs
+31 -30
View File
@@ -3,9 +3,9 @@
-- | Actions performed by creatures within the world
module Dodge.Creature.Action (
performActions,
stripNoItems,
-- stripNoItems,
setMinInvSize,
dropUnselected,
-- dropUnselected,
dropExcept,
dropItem,
blinkActionMousePos,
@@ -19,7 +19,7 @@ module Dodge.Creature.Action (
) where
import Data.Bifunctor
import Data.List (findIndex)
--import Data.List (findIndex)
import Data.Maybe
import Dodge.Base
import Dodge.Creature.Action.Blink
@@ -36,6 +36,7 @@ import Dodge.WallCreatureCollisions
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import Control.Monad
performActions :: World -> Creature -> Creature
performActions w cr =
@@ -147,29 +148,29 @@ performAction cr w ac = case ac of
setMinInvSize :: Int -> Creature -> World -> World
setMinInvSize n cr = cWorld . lWorld . creatures . ix (_crID cr) . crInvCapacity .~ n
-- maybe this should be removed...
stripNoItems :: Creature -> World -> World
stripNoItems cr =
organiseInvKeys (_crID cr)
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just)
---- maybe this should be removed...
--stripNoItems :: Creature -> World -> World
--stripNoItems cr =
-- organiseInvKeys (_crID cr)
-- . (cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just)
--
--organiseInvKeys :: Int -> World -> World
--organiseInvKeys cid w =
-- w & cWorld . lWorld . creatures . ix cid
-- %~ ( (crInvSel . iselPos .~ newSelKey)
-- . (crInv .~ newInv)
-- . (crInvSel . iselAction .~ NoInvSelAction)
-- )
-- where
-- cr = w ^?! cWorld . lWorld . creatures . ix cid -- _creatures (_cWorld w) IM.! cid
-- pairs = IM.toList (_crInv cr)
-- newSelKey = fromMaybe 0 $ findIndex ((== crSel cr) . fst) pairs
-- newInv = IM.fromAscList $ zip [0 ..] $ map snd pairs
organiseInvKeys :: Int -> World -> World
organiseInvKeys cid w =
w & cWorld . lWorld . creatures . ix cid
%~ ( (crInvSel . iselPos .~ newSelKey)
. (crInv .~ newInv)
. (crInvSel . iselAction .~ NoInvSelAction)
)
where
cr = w ^?! cWorld . lWorld . creatures . ix cid -- _creatures (_cWorld w) IM.! cid
pairs = IM.toList (_crInv cr)
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 $
crSel cr `IM.delete` _crInv cr
--dropUnselected :: Creature -> World -> World
--dropUnselected cr w =
-- foldr (dropItem cr) w . IM.keys $
-- crSel cr `IM.delete` _crInv cr
dropExcept :: Creature -> Int -> World -> World
dropExcept cr invid w =
@@ -188,11 +189,11 @@ dropItem cr invid = rmInvItem cid invid . copyInvItemToFloor cr invid -- . maybe
-- | Get your creature to drop the item under the cursor.
youDropItem :: World -> World
youDropItem w
| _crInvLock (you w) || cursed = w
| otherwise =
w
& dropItem cr (crSel cr)
youDropItem w = fromMaybe w $ do
curpos <- you w ^? crInvSel . isel . ispItem
guard $ not $ _crInvLock (you w) || cursed
return $ w
& dropItem cr curpos
& soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
where
cr = you w
src/Dodge/Creature/Impulse.hs
+1 -1
View File
@@ -47,7 +47,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 .~ InvSel i NoInvSelAction
SwitchToItem i -> crup $ cr & crInvSel .~ InvSel (SelItem i NoInvSelAction)
Melee cid' ->
( hitCr cid'
, crMvBy (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20
src/Dodge/Creature/Impulse/UseItem.hs
+30 -22
View File
@@ -4,6 +4,7 @@ module Dodge.Creature.Impulse.UseItem (
itemEffect,
) where
import Control.Monad
import Data.Foldable
import Control.Lens
import qualified Data.Map.Strict as M
@@ -22,7 +23,8 @@ import qualified SDL
useItem :: Creature -> World -> World
useItem cr' w = fromMaybe (f w) $ do
cr <- w ^? cWorld . lWorld . creatures . ix (_crID cr')
it <- cr ^? crInv . ix (crSel cr)
itRef <- cr ^? crInvSel . isel . ispItem
it <- cr ^? crInv . ix itRef
return $ itemEffect cr it w
where
f = cWorld . lWorld . creatures . ix (_crID cr') . crHammerPosition .~ HammerDown
@@ -34,9 +36,10 @@ itemEffect cr it w = case it ^. itUse of
LeftUse{} -> doequipmentchange
EquipUse{} -> doequipmentchange
-- ConsumeUse will cause problems if the item is not selected
(ConsumeUse eff _) -> setuhamdown $ hammerTest $ useC eff it cr . rmInvItem (_crID cr) (crSel cr)
(ConsumeUse eff _) -> setuhamdown $ hammerTest $ useC eff it cr . rmInvItem (_crID cr) itRef
CraftUse{} -> setuhamdown w
where
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
hammerTest f = case _crHammerPosition cr of
HammerUp -> f w
_ -> w & setuhamdown
@@ -44,7 +47,7 @@ itemEffect cr it w = case it ^. itUse of
doequipmentchange =
setuhamdown $
hammerTest
( toggleEquipmentAt (_rbOptions w) (crSel cr) cr
( toggleEquipmentAt (_rbOptions w) itRef cr
. activateEquipmentAt (_rbOptions w) cr
)
@@ -105,29 +108,34 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
where
crpoint = cWorld . lWorld . creatures . ix (_crID cr)
itmat i = _crInv cr IM.! i
itm = itmat (crSel cr)
itm = itmat itRef
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
onequip itm' = useE ((_eeOnEquip . _equipEffect . _itUse) itm') itm'
onremove itm' = useE ((_eeOnRemove . _equipEffect . _itUse) itm') itm'
useLeftItem :: Int -> World -> World
useLeftItem cid w
| _crInvLock cr = w
| itmIsConsumable = useItem cr w -- I believe this ONLY sets equipment options
| itmIsEquipable = useItem cr w -- I believe this ONLY sets equipment options
| otherwise = fromMaybe w $ do
invid <- cr ^. crLeftInvSel . lisMPos
itm <- cr ^? crInv . ix invid
f <- cr ^? crInv . ix invid . itUse . leftUse
return
. (runIdentity . pointerToItemLocation (_itLocation itm) (return . (itUse . leftHammer .~ HammerDown)))
. useL f itm cr
$ w
useLeftItem cid w = fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix cid
guard . not $ _crInvLock cr
let mitRef = cr ^? crInvSel . isel . ispItem
itmIsConsumable = isJust $ do
itRef <- mitRef
cr ^? crInv . ix itRef . itUse . cUse
itmIsEquipable = isJust $ do
itRef <- mitRef
guard . not $ cr ^. crLeftInvSel . lisMPos /= Just itRef
cr ^? crInv . ix itRef . itUse . equipEffect . eeUse
if itmIsConsumable || itmIsEquipable
then return $ useItem cr w -- I believe this ONLY sets equipment options
else do
invid <- cr ^. crLeftInvSel . lisMPos
itm <- cr ^? crInv . ix invid
f <- cr ^? crInv . ix invid . itUse . leftUse
return
. (runIdentity . pointerToItemLocation (_itLocation itm) (return . (itUse . leftHammer .~ HammerDown)))
. useL f itm cr
$ w
where
cr = w ^?! cWorld . lWorld . creatures . ix cid-- _creatures (_cWorld w) IM.! cid
itmIsConsumable =
isJust (cr ^? crInv . ix (crSel cr) . itUse . cUse)
itmIsEquipable =
isJust (cr ^? crInv . ix (crSel cr) . itUse . equipEffect . eeUse)
&& cr ^. crLeftInvSel . lisMPos /= Just (crSel cr)
-- TODO determine itmShouldBeUsed with reference to config options
src/Dodge/Creature/ReaderUpdate.hs
+6 -5
View File
@@ -26,6 +26,7 @@ import Dodge.Data.World
import Dodge.Zoning.Creature
import FoldableHelp
import Geometry
import Control.Monad
overrideMeleeCloseTarget :: Creature -> Creature
overrideMeleeCloseTarget cr = maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr)
@@ -150,11 +151,11 @@ doStrategyActions cr = case cr ^? crActionPlan . apStrategy of
_ -> cr
reloadOverride :: Creature -> Creature
reloadOverride cr
| cr ^? crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded == Just 0
&& cr ^. crStance . posture == Aiming =
cr & crActionPlan . apStrategy .~ StrategyActions Reload reloadActions
| otherwise = cr
reloadOverride cr = fromMaybe cr $ do
guard $ cr ^. crStance . posture == Aiming
itRef <- cr ^? crInvSel . isel . ispItem
guard $ cr ^? crInv . ix itRef . itUse . heldConsumption . laLoaded == Just 0
return $ cr & crActionPlan . apStrategy .~ StrategyActions Reload reloadActions
where
reloadActions =
[ holsterWeapon
src/Dodge/Creature/State.hs
+7 -10
View File
@@ -68,7 +68,7 @@ stateUpdate f =
heldAimEffects :: Creature -> World -> World
heldAimEffects cr = fromMaybe id $ do
guard (crIsAiming cr)
ipos <- cr ^? crInvSel . iselPos
ipos <- cr ^? crInvSel . isel . ispItem
itm <- cr ^? crInv . ix ipos
f <- itm ^? itEffect . ieWhileAiming
return $ doInvEffect f itm cr
@@ -258,15 +258,12 @@ createAttachLight cr it = createTorchLightOffset cr it attachoff
attachoff = it ^?! itDimension . dimAttachPos
itemUpdate :: Creature -> Int -> Item -> Item
itemUpdate cr i
| i == crSel cr = baseupdate True
| otherwise = baseupdate False
where
baseupdate bool =
updateAutoRecharge
itemUpdate cr i = updateAutoRecharge
. (itUse %~ useUpdate)
. (itLocation .~ InInv (_crID cr) i)
. (itIsHeld .~ bool)
. (itIsHeld .~ itmisheld)
where
itmisheld = Just i == (cr ^? crInvSel . isel . ispItem)
updateAutoRecharge :: Item -> Item
updateAutoRecharge it = case it ^? itUse . leftConsumption of
@@ -282,12 +279,12 @@ crGetTargeting cr = do
where
hastargeting itm = isJust (itm ^? itUse . useTargeting . _Just)
helditem = fromMaybe [] $ do
i <- cr ^? crInvSel . iselPos
i <- cr ^? crInvSel . isel . ispItem
itm <- cr ^? crInv . ix i
return [itm]
weaponReloadSounds :: Creature -> World -> World
weaponReloadSounds cr w = case cr ^? crInvSel . iselAction of
weaponReloadSounds cr w = case cr ^? crInvSel . isel . iselAction of
Just ReloadAction{_reloadAction = la} ->
soundContinue
(CrReloadSound cid)
src/Dodge/Creature/Statistics.hs
+3 -1
View File
@@ -37,5 +37,7 @@ crCurrentEquipment cr =
strFromHeldItem :: Creature -> Int
strFromHeldItem cr
| _posture (_crStance cr) == Aiming || crIsReloading cr =
negate $ fromMaybe 0 $ cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimWeight
negate $ fromMaybe 0 $ cr ^? crInv . ix itRef . itUse . heldAim . aimWeight
| otherwise = 0
where
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
src/Dodge/Creature/Test.hs
+8 -3
View File
@@ -32,13 +32,14 @@ import Dodge.Data.World
import Geometry
crIsReloading :: Creature -> Bool
crIsReloading cr = case cr ^? crInvSel . iselAction of
crIsReloading cr = case cr ^? crInvSel . isel . iselAction of
Just ReloadAction{} -> True
_ -> False
crWeaponReady :: Creature -> Bool
crWeaponReady cr = fromMaybe False $ do
ic <- cr ^? crInv . ix (crSel cr) . itUse . heldConsumption
i <- cr ^? crInvSel . isel . ispItem
ic <- cr ^? crInv . ix i . itUse . heldConsumption
return (_laLoaded ic > 0 && _laPrimed ic)
crCanSeeCr :: Creature -> (World, Creature) -> Bool
@@ -79,7 +80,11 @@ crCanShoot cr = crIsAiming cr && crWeaponReady cr
crInAimStance :: AimStance -> Creature -> Bool
crInAimStance as cr =
crIsAiming cr
&& cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimStance == Just as
&& mitstance == Just as
where
mitstance = do
i <- cr ^? crInvSel . isel . ispItem
cr ^? crInv . ix i . itUse . heldAim . aimStance
oneH :: Creature -> Bool
oneH = crInAimStance OneHand
src/Dodge/Creature/YourControl.hs
+20 -8
View File
@@ -51,10 +51,14 @@ wasdWithAiming w speed cr
cr'
& crDir +~ _crTwist cr'
& crTwist .~ 0
addAnyTwist = case (cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimStance, cr^. crTwist) of
(Just TwoHandTwist, 0) -> (crTwist .~ twistamount * pi)
addAnyTwist = fromMaybe id $ do
itRef <- cr ^? crInvSel . isel . ispItem
astance <- cr ^? crInv . ix itRef . itUse . heldAim . aimStance
let currenttwistamount = cr ^. crTwist
case (astance,currenttwistamount) of
( TwoHandTwist, 0) -> return $ (crTwist .~ twistamount * pi)
. (crDir -~ twistamount * pi)
_ -> id
_ -> Nothing
theMovement
| movDir == V2 0 0 = id
| otherwise = crMvAbsolute (speed *.* movAbs)
@@ -66,14 +70,19 @@ wasdWithAiming w speed cr
dir = fmap ((w ^. cWorld . camPos . camRot) +) (safeArgV movDir)
movAbs = rotateV (w ^. cWorld . camPos . camRot) $ normalizeV movDir
isAiming = _posture (_crStance cr) == Aiming
mouseDir = case cr ^? crInv . ix (crSel cr) . itScope . scopePos of
Just _ -> argV $ mouseWorldPos (w ^. input) (w ^. cWorld . camPos) -.- _crPos cr
_ -> argV (_mousePos (_input w)) + (w ^. cWorld . camPos . camRot)
mouseDir = fromMaybe
(argV (_mousePos (_input w)) + (w ^. cWorld . camPos . camRot) )
$ do
itRef <- cr ^? crInvSel . isel . ispItem
_ <- cr ^? crInv . ix itRef . itScope . scopePos
return . argV $ mouseWorldPos (w ^. input) (w ^. cWorld . camPos) -.- _crPos cr
aimTurn :: Float -> Creature -> Creature
aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
where
x = fromMaybe 1 $ cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimTurnSpeed
x = fromMaybe 1 $ do
itRef <- cr ^? crInvSel . isel . ispItem
cr ^? crInv . ix itRef . itUse . heldAim . aimTurnSpeed
wasdM :: SDL.Scancode -> Point2
wasdM scancode = case scancode of
@@ -89,8 +98,11 @@ wasdDir = foldl' (flip $ (+.+) . wasdM) (V2 0 0) . M.keys . _pressedKeys . _inpu
-- | Set posture according to mouse presses.
mouseActionsCr :: M.Map SDL.MouseButton Bool -> Creature -> Creature
mouseActionsCr pkeys cr
| rbPressed && cr ^?! crInvSel . iselAction == NoInvSelAction =
| rbPressed && noaction =
cr & crStance . posture .~ Aiming
| otherwise = cr & crStance . posture .~ AtEase
where
rbPressed = SDL.ButtonRight `M.member` pkeys
noaction = fromMaybe True $ do
theaction <- cr ^? crInvSel . isel . iselAction
return $ theaction == NoInvSelAction