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/Base/You.hs
+5 -3
View File
@@ -11,10 +11,12 @@ youc :: CWorld -> Creature
youc w = w ^?! lWorld . creatures . ix 0
yourItem :: World -> Maybe Item
yourItem w = _crInv (you w) IM.!? crSel (you w)
yourItem w = do
i <- you w ^? crInvSel . isel . ispItem
_crInv (you w) IM.!? i
yourInv :: World -> IM.IntMap Item
yourInv = _crInv . you
yourInvSel :: World -> Int
yourInvSel = crSel . you
--yourInvSel :: World -> Int
--yourInvSel = crSel . you
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
src/Dodge/Data/Creature.hs
+2 -2
View File
@@ -97,8 +97,8 @@ data Intention = Intention
--deriving (Eq, Show, Read) --Generic, Flat)
crSel :: Creature -> Int
crSel = _iselPos . _crInvSel
crSel :: Creature -> ManipulatedObject
crSel = _isel . _crInvSel
makeLenses ''Creature
makeLenses ''CreatureTargeting
src/Dodge/Data/Item/Use/Consumption/LoadAction.hs
+8 -4
View File
@@ -18,14 +18,16 @@ data LoadAction
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data InvSel -- should be ManipulatedObject?
= InvSel {_iselPos :: Int, _iselAction :: InvSelAction}
-- = InvSel {_isel :: SelPos}
= InvSel {_isel :: ManipulatedObject}
| Brute
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data SelPos
= SelItem Int
data ManipulatedObject
= SelItem { _ispItem :: Int
, _iselAction :: InvSelAction}
| SelNothing
| SelCloseObject Int
| SelCloseObject {_ispCloseObject :: Int}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data InvSelAction
@@ -39,10 +41,12 @@ data LeftInvSel = LeftInvSel
}
makeLenses ''LoadAction
makeLenses ''ManipulatedObject
makeLenses ''InvSel
makeLenses ''LeftInvSel
makeLenses ''InvSelAction
deriveJSON defaultOptions ''LoadAction
deriveJSON defaultOptions ''InvSelAction
deriveJSON defaultOptions ''ManipulatedObject
deriveJSON defaultOptions ''InvSel
deriveJSON defaultOptions ''LeftInvSel
src/Dodge/Default/Creature.hs
+1 -1
View File
@@ -26,7 +26,7 @@ defaultCreature =
, _crHP = 100
, _crMaxHP = 150
, _crInv = IM.empty
, _crInvSel = InvSel 0 NoInvSelAction
, _crInvSel = InvSel SelNothing
, _crInvCapacity = 25
, _crInvLock = False
, _crInvEquipped = mempty
src/Dodge/Euse.hs
+2 -2
View File
@@ -37,8 +37,8 @@ useE eo = case eo of
trySiphonFuel :: Item -> Creature -> World -> World
trySiphonFuel itm cr w = fromMaybe w $ do
eix <- itm ^? itLocation . ipInvID
hix <- cr ^? crInvSel . iselPos
guard (cr ^? crInvSel . iselAction == Just NoInvSelAction)
hix <- cr ^? crInvSel . isel . ispItem
guard (cr ^? crInvSel . isel . iselAction == Just NoInvSelAction)
la <- cr ^? crInv . ix hix . itUse . heldConsumption
atype <- la ^? laAmmoType
guard (isGas atype)
src/Dodge/HeldScroll.hs
+4 -1
View File
@@ -8,6 +8,7 @@ import Data.Sequence
import Dodge.Data.Creature
import Dodge.Data.World
import Dodge.Item.Weapon.ZoomScope
import Data.Maybe
--import LensHelp hiding ((|>), (<|))
-- should be able to just import data.item
@@ -17,7 +18,9 @@ doHeldScroll hs = case hs of
HeldScrollZoom -> overYourItem (const . setZoomScopeChange)
HeldScrollCharMode{} -> overYourItem $ \x _ -> itUse . heldScroll . hsCharMode %~ cycleSignum x
where
overYourItem f x cr w = w & cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ f x cr
overYourItem f x cr w = fromMaybe w $ do
i <- cr ^? crInvSel . isel . ispItem
return $ w & cWorld . lWorld . creatures . ix 0 . crInv . ix i %~ f x cr
cycleSignum :: Float -> Seq a -> Seq a
cycleSignum x
src/Dodge/HeldUse.hs
+4 -3
View File
@@ -408,7 +408,7 @@ overNozzles' ::
overNozzles' eff it cr w = neww & cWorld . lWorld . creatures . ix cid . crInv . ix i . itParams . sprayNozzles .~ newNozzles
where
cid = _crID cr
i = crSel $ w ^?! cWorld . lWorld . creatures . ix cid
i = w ^?! cWorld . lWorld . creatures . ix cid . crInvSel . isel . ispItem
(neww, newNozzles) = mapAccumR (eff it cr) w $ _sprayNozzles (_itParams it)
overNozzle ::
@@ -461,7 +461,7 @@ fireRemoteShell it cr w =
, PJThrust 330 0
, PJRemoteDirection 340 0 cid itid
]
j = crSel cr
j = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
caneStickSoundChoice :: Item -> SoundID
caneStickSoundChoice it
@@ -500,8 +500,9 @@ mcShootLaser it mc = cWorld . lWorld . lasers .:~ lasRayAt (_lasColor $ _itParam
shootTeslaArc :: Item -> Creature -> World -> World
shootTeslaArc it cr w =
w'
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itParams .~ ip
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itParams .~ ip
where
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
(w', ip) = makeTeslaArc (_itParams it) pos dir w
pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
dir = _crDir cr
src/Dodge/Inventory.hs
+111 -93
View File
@@ -3,7 +3,7 @@
module Dodge.Inventory (
checkInvSlotsYou,
rmSelectedInvItem,
invSelPos,
--invSelPos,
invSelSize,
selNumPos,
selNumTextPos,
@@ -59,7 +59,8 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
w
& pointcid . crInv %~ f
& pointcid %~ crCancelReloading
& pointcid . crInvSel . iselPos %~ g
-- & pointcid . crInvSel . iselPos %~ g THIS NEEDS CHECKING
& pointcid . crInvSel . isel . ispItem %~ g
& pointcid . crLeftInvSel . lisMPos %~ g'
& removeAnySlotEquipment
& dounequipfunction
@@ -97,7 +98,9 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
| otherwise = Just x
rmSelectedInvItem :: Int -> World -> World
rmSelectedInvItem cid w = rmInvItem cid (crSel (w ^?! cWorld . lWorld . creatures . ix cid)) w
rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crInvSel . isel . ispItem of
Just i -> rmInvItem cid i w
Nothing -> w
augmentedInvSizes :: World -> IM.IntMap Int
augmentedInvSizes = trimapAugmentInv itSlotsTaken 1 closeObjectSize
@@ -146,8 +149,8 @@ selNumMidHeight cfig w i = V2 (150 - hw) (hh + bump - (20 * fromIntegral ipos +
selNumCol :: Int -> World -> Color
selNumCol i w = fromMaybe white $ trimapAugmentInv _itInvColor invDimColor closeObjectCol w IM.!? i
invSelPos :: World -> Int
invSelPos w = sum . fst $ IM.split (yourInvSel w) (augmentedInvSizes w)
--invSelPos :: World -> Int
--invSelPos w = sum . fst $ IM.split (yourInvSel w) (augmentedInvSizes w)
updateTerminal :: World -> World
updateTerminal = checkTermDist
@@ -164,12 +167,14 @@ checkTermDist w = case w ^? hud . hudElement . subInventory . termID of
updateCloseObjects :: World -> World
updateCloseObjects w =
w
& hud . closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
& cWorld . lWorld . creatures . ix 0 . crInvSel . iselPos %~ updateinvsel
& hud . closeObjects .~ newcloseobjects
& updatecursorposifnecessary
where
updateinvsel curinvsel
| length (augmentedInvSizes w) <= curinvsel = max 0 $ length (augmentedInvSizes w) - 1
| otherwise = curinvsel
newcloseobjects = unionBy closeObjEq oldCloseFiltered currentClose
updatecursorposifnecessary
= case w ^? cWorld . lWorld . creatures . ix 0 . crInvSel . isel . ispCloseObject of
Just i | i >= length newcloseobjects -> changeAugInvSel 1
_ -> id
filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasButtonLOS ypos (closeObjPos obj) w
ypos = _crPos $ you w
activeButtons =
@@ -188,7 +193,8 @@ updateRBList w
| w ^? rbOptions . opItemID == mcurrentitemid =
w & setEquipAllocation & setEquipActivation
| otherwise = fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
esite <- cr ^? crInv . ix curinvid . itUse . equipEffect . eeSite
i <- cr ^? crInvSel . isel . ispItem
esite <- cr ^? crInv . ix i . itUse . equipEffect . eeSite
itid <- mcurrentitemid
return $
w
@@ -203,13 +209,16 @@ updateRBList w
& setEquipAllocation
& setEquipActivation
where
mcurrentitemid = cr ^? crInv . ix curinvid . itID
curinvid = crSel cr
mcurrentitemid = do
i <- cr ^? crInvSel . isel . ispItem
cr ^? crInv . ix i . itID
--curinvid = crSel cr
cr = you w
chooseEquipmentPosition :: Creature -> [EquipPosition] -> Int
chooseEquipmentPosition cr eps = fromMaybe (chooseFreeSite cr eps) $ do
ep <- cr ^? crInvEquipped . ix (crSel cr)
i <- cr ^? crInvSel . isel . ispItem
ep <- cr ^? crInvEquipped . ix i
elemIndex ep eps
chooseFreeSite :: Creature -> [EquipPosition] -> Int
@@ -218,42 +227,44 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep
setEquipAllocation :: World -> World
setEquipAllocation w = case _rbOptions w of
EquipOptions{_opEquip = es, _opSel = i} ->
case you w ^? crInvEquipped . ix (crSel (you w)) of
Just epos
| es !! i == epos ->
setEquipAllocation w = fromMaybe w $ do
curpos <- you w ^? crInvSel . isel . ispItem
return $ case _rbOptions w of
EquipOptions{_opEquip = es, _opSel = i} ->
case you w ^? crInvEquipped . ix curpos of
Just epos
| es !! i == epos ->
w & rbOptions . opAllocateEquipment
.~ RemoveEquipment
{ _allocOldPos = epos
}
Just epos
| isJust (you w ^? crEquipment . ix (es !! i)) ->
w & rbOptions . opAllocateEquipment
.~ SwapEquipment
{ _allocOldPos = epos
, _allocNewPos = es !! i
, _allocSwapID = _crEquipment (you w) M.! (es !! i)
}
Just epos ->
w & rbOptions . opAllocateEquipment
.~ RemoveEquipment
{ _allocOldPos = epos
}
Just epos
| isJust (you w ^? crEquipment . ix (es !! i)) ->
w & rbOptions . opAllocateEquipment
.~ SwapEquipment
.~ MoveEquipment
{ _allocOldPos = epos
, _allocNewPos = es !! i
, _allocSwapID = _crEquipment (you w) M.! (es !! i)
}
Just epos ->
w & rbOptions . opAllocateEquipment
.~ MoveEquipment
{ _allocOldPos = epos
, _allocNewPos = es !! i
}
Nothing
| isJust (you w ^? crEquipment . ix (es !! i)) ->
Nothing
| isJust (you w ^? crEquipment . ix (es !! i)) ->
w & rbOptions . opAllocateEquipment
.~ ReplaceEquipment
{ _allocNewPos = es !! i
, _allocRemoveID = _crEquipment (you w) M.! (es !! i)
}
Nothing ->
w & rbOptions . opAllocateEquipment
.~ ReplaceEquipment
.~ PutOnEquipment
{ _allocNewPos = es !! i
, _allocRemoveID = _crEquipment (you w) M.! (es !! i)
}
Nothing ->
w & rbOptions . opAllocateEquipment
.~ PutOnEquipment
{ _allocNewPos = es !! i
}
_ -> w
_ -> w
setEquipActivation :: World -> World
setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
@@ -261,7 +272,7 @@ setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
Just RemoveEquipment{} ->
case you w ^. crLeftInvSel . lisMPos of
Just i
| i == invsel ->
| Just i == minvsel ->
w & rbOptions . opActivateEquipment
.~ DeactivateEquipment
{ _deactivateEquipment = i
@@ -269,12 +280,12 @@ setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
_ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Just rbos ->
case you w ^. crLeftInvSel . lisMPos of
Just i | i == invsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Just i | Just i == minvsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Just i
| invselcanactivate ->
w & rbOptions . opActivateEquipment
.~ ActivateDeactivateEquipment
{ _activateEquipment = invsel
{ _activateEquipment = fromJust minvsel
, _deactivateEquipment = i
}
Just i
@@ -285,13 +296,17 @@ setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
| invselcanactivate ->
w & rbOptions . opActivateEquipment
.~ ActivateEquipment
{ _activateEquipment = invsel
{ _activateEquipment = fromJust minvsel
}
Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
where
invsel = crSel (you w)
invselcanactivate = isJust (you w ^? crInv . ix invsel . itUse . leftUse)
--invsel = crSel (you w)
minvsel = cr ^? crInvSel . isel . ispItem
cr = you w
invselcanactivate = isJust $ do
i <- minvsel
return $ cr ^? crInv . ix i . itUse . leftUse
equipSiteToPositions :: EquipSite -> [EquipPosition]
equipSiteToPositions es = case es of
@@ -310,14 +325,10 @@ closeObjScrollDir x
changeInvSel :: Int -> World -> World
changeInvSel i w
| i == 0 || n == 0 = w
| yourInvSel w < n =
w
& pointcrInvSel . iselPos %~ (`mod` n) . subtract i
& pointcrInvSel . iselAction .~ NoInvSelAction
| otherwise =
w
& pointcrInvSel . iselPos %~ ((+ n) . (`mod` numCO) . subtract (i + n))
& pointcrInvSel . iselAction .~ NoInvSelAction
| otherwise = w
& pointcrInvSel . isel . ispItem %~ (`mod` n) . subtract i
& pointcrInvSel . isel . iselAction .~ NoInvSelAction
& pointcrInvSel . isel . ispCloseObject %~ (`mod` numCO) . subtract i
where
-- arguably this should jump the invpos into the inventory proper
pointcrInvSel = cWorld . lWorld . creatures . ix 0 . crInvSel
@@ -325,47 +336,58 @@ changeInvSel i w
numCO = length $ w ^. hud . closeObjects
changeSwapInvSel :: Int -> World -> World
changeSwapInvSel k w
| k == 0 = w
| yourInvSel w < n =
w
& cWorld . lWorld . creatures . ix 0 %~ updatecreature
| yourInvSel w > n =
w
& cWorld . lWorld . creatures . ix 0 . crInvSel . iselPos .~ ico'
& hud . closeObjects %~ swapIndices (i - (n + 1)) (ico' - (n + 1))
| otherwise = w
changeSwapInvSel k w = case you w ^? crInvSel . isel of
Just (SelItem i _) -> w & cWorld . lWorld . creatures . ix 0 %~ updatecreature i
Just (SelCloseObject i) -> w
& cWorld . lWorld . creatures . ix 0 . crInvSel . isel . ispCloseObject
.~ ((i - k) `mod` numCO)
& hud . closeObjects %~ swapIndices i ((i - k) `mod` numCO)
_ -> w
where
updatecreature =
(crInv %~ IM.safeSwapKeys (i `mod` n) swapi)
. (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel)
. (crInvSel . iselPos %~ (`mod` n) . subtract k)
. (crInvEquipped %~ IM.safeSwapKeys i swapi)
. swapSite i swapi
. swapSite swapi i
updatecreature i =
(crInv %~ IM.safeSwapKeys (i `mod` n) (swapi i))
. (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel i)
. (crInvSel . isel . ispItem %~ (`mod` n) . subtract k)
. (crInvEquipped %~ IM.safeSwapKeys i (swapi i))
. swapSite i (swapi i)
. swapSite (swapi i) i
swapSite a b = case cr ^? crInvEquipped . ix a of
Just epos -> crEquipment . ix epos .~ b
Nothing -> id
cr = you w
swapi = (i - k) `mod` n
updateLeftInvSel li
| i == li = swapi
| swapi == li = i
swapi i = (i - k) `mod` n
updateLeftInvSel i li
| i == li = swapi i
| swapi i == li = i
| otherwise = li
i = crSel cr
ico' = ((i - (k + n + 1)) `mod` numCO) + n + 1
n = length $ _crInv cr
numCO = length $ w ^. hud . closeObjects
changeAugInvSel :: Int -> World -> World
changeAugInvSel i w
| i == 0 = w
changeAugInvSel yi w
| yi == 0 = w
| otherwise =
w
& cWorld . lWorld . creatures . ix 0 . crInvSel . iselPos %~ (`mod` n) . subtract i
& cWorld . lWorld . creatures . ix 0 . crInvSel . iselAction .~ NoInvSelAction
w & cWorld . lWorld . creatures . ix 0 . crInvSel . isel %~ f
where
n = length (yourInv w) + length (w ^. hud . closeObjects) + 1
f = fromAugSelPos w . (`mod` (ninv + nclose + 1)) . subtract yi . toAugSelPos w
ninv = length (yourInv w)
nclose = length (w ^. hud . closeObjects)
toAugSelPos :: World -> ManipulatedObject -> Int
toAugSelPos w mo = case mo of
SelItem i _ -> i
SelNothing -> ninv
SelCloseObject i -> ninv + i + 1
where
ninv = length (yourInv w)
fromAugSelPos :: World -> Int -> ManipulatedObject
fromAugSelPos w i
| i > ninv = SelCloseObject (i - ninv - 1)
| i == ninv = SelNothing
| otherwise = SelItem i NoInvSelAction
where
ninv = length (yourInv w)
bestCloseObjectIndex :: World -> Maybe Int
bestCloseObjectIndex w = findIndex f $ w ^. hud . closeObjects
@@ -375,13 +397,9 @@ bestCloseObjectIndex w = findIndex f $ w ^. hud . closeObjects
ycr = you w
selectedCloseObject :: World -> Maybe (Int, Either FloorItem Button)
selectedCloseObject w
| invsel >= (length inv + 1) = selectNthCloseObject w (invsel - (length inv + 1))
| otherwise = selectNthCloseObject w =<< bestCloseObjectIndex w
where
invsel = crSel cr
cr = you w
inv = _crInv cr
selectedCloseObject w = case you w ^? crInvSel . isel . ispCloseObject of
Just i -> selectNthCloseObject w i
Nothing -> selectNthCloseObject w =<< bestCloseObjectIndex w
selectNthCloseObject :: World -> Int -> Maybe (Int, Either FloorItem Button)
selectNthCloseObject w n = (length (yourInv w) + n + 1,) <$> (_closeObjects (_hud w) !? n)
src/Dodge/Inventory/Add.hs
+2 -1
View File
@@ -37,7 +37,8 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
createAndSelectItem :: Item -> World -> World
createAndSelectItem itm w = case createPutItem itm w of
(Just i, w') -> w' & cWorld . lWorld . creatures . ix 0 . crInvSel .~ InvSel i NoInvSelAction
(Just i, w') -> w'
& cWorld . lWorld . creatures . ix 0 . crInvSel .~ InvSel (SelItem i NoInvSelAction)
(Nothing, w') -> w'
createPutItem :: Item -> World -> (Maybe Int, World)
src/Dodge/Inventory/SelectionList.hs
+24 -20
View File
@@ -1,6 +1,10 @@
module Dodge.Inventory.SelectionList where
module Dodge.Inventory.SelectionList
( invSelectionItem
, closeObjectToSelectionItem
)
where
import Dodge.Default.SelectionList
--import Dodge.Default.SelectionList
import Dodge.Inventory.Color
import Dodge.Item.Display
import Dodge.Inventory.ItemSpace
@@ -12,11 +16,11 @@ import Dodge.Data.World
import qualified Data.IntMap.Strict as IM
import LensHelp
makeInventorySelectionList :: World -> SelectionList ()
makeInventorySelectionList w = defaultSelectionList
& slItems .~ inventorySelectionList w
& slSelPos .~ inventoryCursorPos w
--makeInventorySelectionList :: World -> SelectionList ()
--makeInventorySelectionList w = defaultSelectionList
-- & slItems .~ inventorySelectionList w
-- & slSelPos .~ inventoryCursorPos w
--
inventorySelectionList :: World -> [SelectionItem ()]
inventorySelectionList w = map (invSelectionItem cr) (IM.toList inv)
++ [SelectionItem [thetext] 1 True (length thetext) invDimColor 2 ()]
@@ -29,12 +33,12 @@ inventorySelectionList w = map (invSelectionItem cr) (IM.toList inv)
0 -> " INVENTORY FULL"
1 -> " +1 FREE SLOT"
x -> " +" ++ show x ++ " FREE SLOTS"
inventoryCursorPos :: World -> Maybe Int
inventoryCursorPos w = case w ^? hud . hudElement . subInventory of
Just CombineInventory{} -> Nothing
_ -> Just $ yourInvSel w
--
--inventoryCursorPos :: World -> Maybe Int
--inventoryCursorPos w = case w ^? hud . hudElement . subInventory of
-- Just CombineInventory{} -> Nothing
-- _ -> Just $ yourInvSel w
--
invSelectionItem :: Creature -> (Int,Item) -> SelectionItem ()
invSelectionItem cr (i,it) = SelectionItem
{ _siPictures = pics
@@ -49,9 +53,9 @@ invSelectionItem cr (i,it) = SelectionItem
col = _itInvColor it
pics = take (itSlotsTaken it) . (++ replicate 10 "*") $ case _itCurseStatus it of
UndroppableIdentified -> itemDisplay it
_ | crSel cr == i -> selectedItemDisplay cr it
_ | cr ^? crInvSel . isel . ispItem == Just i -> selectedItemDisplay cr it
_ -> itemDisplay it
--
closeObjectToSelectionItem :: Int -> Either FloorItem Button -> SelectionItem ()
closeObjectToSelectionItem n e = SelectionItem
{ _siPictures = pics
@@ -64,7 +68,7 @@ closeObjectToSelectionItem n e = SelectionItem
}
where
(pics,col) = closeObjectToTextPictures' n e
--
closeObjectToTextPictures' :: Int -> Either FloorItem Button -> ([String],Color)
closeObjectToTextPictures' nfreeslots e = case e of
Left flit -> let it = _flIt flit
@@ -75,9 +79,9 @@ closeObjectToTextPictures' nfreeslots e = case e of
thecol it
| nfreeslots >= itSlotsTaken it = _itInvColor it
| otherwise = invDimColor
--
clObjIntIn :: Int
clObjIntIn = 2
clObjFloatIn :: Float
clObjFloatIn = fromIntegral clObjIntIn * 9
--
--clObjFloatIn :: Float
--clObjFloatIn = fromIntegral clObjIntIn * 9
src/Dodge/Item/Display.hs
+1 -1
View File
@@ -65,7 +65,7 @@ showAutoRechargeProgress lc = case lc of
ChargeableAmmo{} -> show (_wpCharge lc)
showReloadProgress :: Creature -> HeldConsumption -> String
showReloadProgress cr ic = case cr ^? crInvSel . iselAction of
showReloadProgress cr ic = case cr ^? crInvSel . isel . iselAction of
Just (ReloadAction i la) -> show i ++ showLoadActionType la (_laLoaded ic)
_ -> case ic ^? laProgress . _Just . ix 0 of
Nothing -> show $ _laLoaded ic
src/Dodge/Item/Weapon/BatteryGuns.hs
+8 -4
View File
@@ -136,7 +136,8 @@ shootLaser it cr = cWorld . lWorld . lasers .:~ lasRayAt (_lasColor $ _itParams
where
pos = _crPos cr
dir = _crDir cr
phasev = _phaseV . _itParams $ _crInv cr IM.! crSel cr
phasev = _phaseV . _itParams $ _crInv cr IM.! itRef
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
dam = _lasDamage $ _itParams it
-- this has the feel of a left click item
@@ -151,7 +152,8 @@ circleLaser it cr w
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
pos = _crPos cr +.+ rotateV dir (V2 0 (max 70 $ dist cpos mwp))
dir = fromIntegral (_lasCycle (_itParams it)) * pi / 1000
phasev = _phaseV . _itParams $ _crInv cr IM.! crSel cr
phasev = _phaseV . _itParams $ _crInv cr IM.! itRef
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
dam = _lasDamage $ _itParams it
shootDualLaser :: Item -> Creature -> World -> World
@@ -173,7 +175,8 @@ shootDualLaser it cr w =
| otherwise = mwp
dirl = argV $ mwp' -.- posl
dirr = argV $ mwp' -.- posr
phasev = _phaseV . _itParams $ _crInv cr IM.! crSel cr
phasev = _phaseV . _itParams $ _crInv cr IM.! itRef
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
dam = _lasDamage $ _itParams it
basicBeamAt :: Int -> World -> Color -> Int -> Float -> Point2 -> Float -> Beam
@@ -207,7 +210,8 @@ aTractorBeam _ cr w = w & cWorld . lWorld . tractorBeams .:~ tractorBeamAt spos
xpos = cpos +.+ 400 *.* unitVectorAtAngle dir
dir = _crDir cr
outpos = fst $ collidePointWallsFilter (const True) cpos xpos w
power = _attractionPower . _itParams $ _crInv cr IM.! crSel cr
power = _attractionPower . _itParams $ _crInv cr IM.! itRef
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
tractorBeamAt :: Point2 -> Point2 -> Float -> Point2 -> TractorBeam
tractorBeamAt pos outpos dir power =
src/Dodge/Item/Weapon/TriggerType.hs
+20 -9
View File
@@ -191,7 +191,7 @@ rateIncAB exeffFirst exeffCont eff item cr w
fastRate = _rateMinMax . _heldDelay $ _itUse item
startRate = _rateMaxMax . _heldDelay $ _itUse item
cid = _crID cr
itRef = crSel cr
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
pointItem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef
currentRate = _rateMax (_heldDelay (_itUse item))
repeatFire = crWeaponReady cr && _rateTime (_heldDelay (_itUse item)) == 1
@@ -215,7 +215,7 @@ withWarmUp soundID f item cr w
& f item cr
where
cid = _crID cr
itRef = crSel cr
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
pointerToItem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef
curWarmUp = _warmTime . _heldDelay $ _itUse item
maxWarmUp = _warmMax . _heldDelay $ _itUse item
@@ -341,19 +341,25 @@ withSidePushAfterI maxSide eff item cr w =
useAllAmmo :: ChainEffect
useAllAmmo eff item cr =
eff item cr
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded .~ 0)
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itUse . heldConsumption . laLoaded .~ 0)
where
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
useAmmoUpTo :: Int -> ChainEffect
useAmmoUpTo amAmount eff item cr =
eff item cr
. ( cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded
. ( cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itUse . heldConsumption . laLoaded
%~ (max 0 . subtract amAmount)
)
where
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
useAmmoAmount :: Int -> ChainEffect
useAmmoAmount amAmount eff item cr =
eff item cr
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded -~ amAmount)
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itUse . heldConsumption . laLoaded -~ amAmount)
where
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
{- |
Applies a world effect after an item use cooldown check.
@@ -364,7 +370,8 @@ useTimeCheck f item cr w = case item ^? itUse . heldDelay . rateTime of
_ -> w
where
cid = _crID cr
setUseTime = cWorld . lWorld . creatures . ix cid . crInv . ix (crSel cr) . itUse . heldDelay . rateTime +~ userate
setUseTime = cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itUse . heldDelay . rateTime +~ userate
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
userate = fromMaybe 0 $ item ^? itUse . heldDelay . rateMax
-- | Applies a world effect after a hammer position check.
@@ -389,7 +396,7 @@ ammoUseCheck f item cr w
| otherwise = w
where
cid = _crID cr
itRef = crSel cr
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
pointerToItem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef
fireCondition =
crWeaponReady cr
@@ -444,10 +451,14 @@ withItem g f it = g it f it
-- not ideal
withItemUpdate' :: (Item -> Item) -> ChainEffect
withItemUpdate' up f it cr = f (up it) cr . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up)
withItemUpdate' up f it cr = f (up it) cr . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef %~ up)
where
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
withItemUpdate :: (Item -> Item) -> (Item -> ChainEffect) -> ChainEffect
withItemUpdate up g f it cr = g it f it cr . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up)
withItemUpdate up g f it cr = g it f it cr . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef %~ up)
where
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
withTempLight :: Int -> Float -> V3 Float -> ChainEffect
withTempLight time rad col eff item cr =
src/Dodge/Luse.hs
+2 -1
View File
@@ -58,7 +58,8 @@ useRewindGun itm _ w = w
-- 22.05.23 this has been changed from using invids to items
useShrinkGun :: Item -> Creature -> World -> World
useShrinkGun it cr w = case it ^? itParams . shrinkGunStatus of
Just FullSize -> tryResize 0.5 $ stripNoItems cr . f Shrunk UndroppableIdentified . dropExcept cr invid
--Just FullSize -> tryResize 0.5 $ stripNoItems cr . f Shrunk UndroppableIdentified . dropExcept cr invid
Just FullSize -> tryResize 0.5 $ f Shrunk UndroppableIdentified . dropExcept cr invid
Just Shrunk -> tryResize 1 $ f FullSize Uncursed . setMinInvSize defaultInvSize cr
Nothing -> error "useShrinkGun applied to item with incorrect ItParam"
where
src/Dodge/Projectile/Update.hs
+1 -1
View File
@@ -95,7 +95,7 @@ setRemoteDir cid itid pj w = w & cWorld . lWorld . projectiles . ix (_prjID pj)
--i = _prjID pj
newdir
| SDL.ButtonRight `M.member` _mouseButtons (_input w)
&& w ^? cWorld . lWorld . creatures . ix cid . crInvSel . iselPos
&& w ^? cWorld . lWorld . creatures . ix cid . crInvSel . isel . ispItem
== w ^? cWorld . lWorld . itemLocations . ix itid . ipInvID
= (w ^. cWorld . camPos . camRot) + argV (_mousePos (_input w))
| otherwise = _prjDir pj
src/Dodge/Reloading.hs
+32 -22
View File
@@ -5,57 +5,67 @@ module Dodge.Reloading (
tryStartLoading,
) where
import Dodge.Data.Item.Use.Consumption.LoadAction
import Control.Lens
import Dodge.Data.Creature
import Data.Maybe
crCancelReloading :: Creature -> Creature
crCancelReloading cr =
cr
& crInv . ix (crSel cr) . itUse . heldConsumption . laProgress %~ const Nothing
& crInvSel . iselAction .~ NoInvSelAction
& updateProgress
& crInvSel . isel . iselAction .~ NoInvSelAction
where
updateProgress = case crSel cr of
SelItem i _ -> crInv . ix i . itUse . heldConsumption . laProgress %~ const Nothing
_ -> id
stepReloading :: Creature -> Creature
stepReloading cr = case cr ^?! crInvSel . iselAction of
ReloadAction x la
stepReloading cr = case cr ^?! crInvSel . isel of
SelItem i (ReloadAction x la)
| x > 0 ->
cr & crInvSel . iselAction . actionProgress -~ 1
cr & crInvSel . isel . iselAction . actionProgress -~ 1
| otherwise ->
cr
& crInv . ix (crSel cr) . itUse . heldConsumption %~ doLoadAction la
& crInv . ix (crSel cr) . itUse . heldConsumption %~ rotateActionProgress
& crInv . ix i . itUse . heldConsumption %~ doLoadAction la
& crInv . ix i . itUse . heldConsumption %~ rotateActionProgress
& tryNextLoadAction
_ -> cr
tryNextLoadAction :: Creature -> Creature
tryNextLoadAction cr = case cr ^? crInv . ix (crSel cr) . itUse . heldConsumption . laProgress . _Just . ix 0 of
Nothing -> cr & crInvSel . iselAction .~ NoInvSelAction
Just la ->
cr & crInvSel . iselAction . actionProgress .~ _actionTime la
& crInvSel . iselAction . reloadAction .~ la
tryNextLoadAction cr = case cr ^? crInvSel . isel of
Just (SelItem i _) -> case cr ^? crInv . ix i . itUse . heldConsumption . laProgress . _Just . ix 0 of
Nothing -> cr & crInvSel . isel . iselAction .~ NoInvSelAction
Just la ->
cr & crInvSel . isel . iselAction . actionProgress .~ _actionTime la
& crInvSel . isel . iselAction . reloadAction .~ la
_ -> cr
crToggleReloading :: Creature -> Creature
crToggleReloading cr = case cr ^? crInvSel . iselAction of
Just ReloadAction{} -> cr & crInvSel . iselAction .~ NoInvSelAction
crToggleReloading cr = case cr ^? crInvSel . isel . iselAction of
Just ReloadAction{} -> cr & crInvSel . isel . iselAction .~ NoInvSelAction
_ -> cr & tryStartLoading
tryStartLoading :: Creature -> Creature
tryStartLoading cr = case cr ^? crInv . ix (crSel cr) . itUse . heldConsumption of
Just hc -> startLoading hc cr
Nothing -> cr
tryStartLoading cr = fromMaybe cr $ do
i <- cr ^? crInvSel . isel . ispItem
hc <- cr ^? crInv . ix i . itUse . heldConsumption
return $ startLoading hc cr
startLoading :: HeldConsumption -> Creature -> Creature
startLoading ic cr = case ic ^? laProgress . _Just . ix 0 of
Just la -> cr & startLoadingStep la
Nothing -> case ic ^? laCycle of
Nothing -> cr
Just [] -> error ("item has empty load cycle" ++ show (cr ^?! crInv . ix (crSel cr) . itType))
Just [] -> error ("item has empty load cycle")
Just _ | _laLoaded ic >= _laMax ic -> cr
Just (la : las) ->
cr & startLoadingStep la
& crInv . ix (crSel cr) . itUse . heldConsumption . laProgress ?~ (la : las)
Just (la : las) -> fromMaybe (error "item loading error") $ do
i <- cr ^? crInvSel . isel . ispItem
return $ cr & startLoadingStep la
& crInv . ix i . itUse . heldConsumption . laProgress ?~ (la : las)
startLoadingStep :: LoadAction -> Creature -> Creature
startLoadingStep la cr = cr & crInvSel . iselAction .~ ReloadAction (_actionTime la) la
startLoadingStep la cr = cr & crInvSel . isel . iselAction .~ ReloadAction (_actionTime la) la
rotateActionProgress :: HeldConsumption -> HeldConsumption
rotateActionProgress ic = case ic ^? laProgress . _Just of
src/Dodge/Render/HUD.hs
+34 -32
View File
@@ -143,32 +143,33 @@ floorItemPickupInfo n itm
| n >= ceiling (_itInvSize itm) = ", but you have space to pick it up."
| otherwise = ", and you don't have space to pick it up."
-- this should not produce Nothing, and the logic should be changed to reflect
-- this
yourAugmentedItem :: (Item -> a) -> a -> (Either FloorItem Button -> a) -> World -> a
yourAugmentedItem f x g w
| i < n = f $ yourInv w ^?! ix i
| i == n = x
| otherwise = g $ w ^?! hud . closeObjects . ix (i - n - 1)
yourAugmentedItem f x g w = case you w ^? crInvSel . isel of
Just (SelItem i _) -> f $ yourInv w ^?! ix i
Just (SelCloseObject i) -> g $ w ^?! hud . closeObjects . ix (i - n - 1)
_ -> x
where
i = crSel (you w)
n = length $ yourInv w
drawNoSubInventory :: Configuration -> World -> Picture
drawNoSubInventory cfig w =
pictures
[ closeobjectcursor
, equipcursors
[ --closeobjectcursor
equipcursors
, equipcursor -- the order is important, this should go on top of the other equipcursors
, rboptions
]
where
closeobjectcursor = case selectedCloseObject w of
Nothing -> mempty
Just (i, _) ->
drawCursorAt
(invDisplayParams w & ldpCursorType .~ BorderCursor [North, South])
cfig
(Just i)
(inventorySelectionList w)
-- closeobjectcursor = case selectedCloseObject w of
-- Nothing -> mempty
-- Just (i, _) ->
-- drawCursorAt
-- (invDisplayParams w & ldpCursorType .~ BorderCursor [North, South])
-- cfig
-- (Just i)
-- (inventorySelectionList w)
equipcursor = case cr ^. crLeftInvSel . lisMPos of
Just invid -> f cyan invid (_crInvEquipped cr IM.! invid)
_ -> mempty
@@ -267,27 +268,28 @@ displayTerminal tid cfig w = fromMaybe mempty $ do
| otherwise = []
drawRBOptions :: Configuration -> World -> RightButtonOptions -> Picture
drawRBOptions cfig w EquipOptions{_opEquip = es, _opSel = i, _opAllocateEquipment = ae} =
listPicturesAtOff 342 0 cfig (curpos - i) (map (text . eqPosText) es)
<> case ae of
DoNotMoveEquipment -> mempty
PutOnEquipment{} ->
midtext "PUT ONTO"
MoveEquipment{} ->
midtext "MOVE TO" <> extratext []
SwapEquipment{_allocOldPos = oldp, _allocSwapID = sid} ->
midtext "MOVE TO" <> extratext ("SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp)
ReplaceEquipment{_allocRemoveID = rid} ->
midtext "PUT ONTO" <> extratext ("REMOVES " ++ otheritem rid)
RemoveEquipment{} ->
midtext "TAKE OFF"
drawRBOptions cfig w EquipOptions{_opEquip = es, _opSel = i, _opAllocateEquipment = ae}
= fromMaybe mempty $ do
curpos <- you w ^? crInvSel . isel . ispItem
let midtext str = listTextPictureAt 252 0 cfig curpos (text str)
let extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext))
return $ listPicturesAtOff 342 0 cfig (curpos - i) (map (text . eqPosText) es)
<> case ae of
DoNotMoveEquipment -> mempty
PutOnEquipment{} ->
midtext "PUT ONTO"
MoveEquipment{} ->
midtext "MOVE TO" <> extratext []
SwapEquipment{_allocOldPos = oldp, _allocSwapID = sid} ->
midtext "MOVE TO" <> extratext ("SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp)
ReplaceEquipment{_allocRemoveID = rid} ->
midtext "PUT ONTO" <> extratext ("REMOVES " ++ otheritem rid)
RemoveEquipment{} ->
midtext "TAKE OFF"
where
midtext str = listTextPictureAt 252 0 cfig curpos (text str)
extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext))
deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of
Just k -> " DEACTIVATES " ++ show (_iyBase $ _itType (_crInv (you w) IM.! k))
Nothing -> ""
curpos = invSelPos w
otheritem j = show $ _iyBase $ _itType (_crInv (you w) IM.! j)
drawRBOptions _ _ _ = mempty
src/Dodge/Update/Camera.hs
+17 -7
View File
@@ -43,7 +43,9 @@ moveZoomCamera cfig theinput cr campos =
& camItemZoom .~ newItemZoom
where
cpos = _crPos cr
mitm = cr ^? crInv . ix (crSel cr)
mitm = do
i <- cr ^? crInvSel . isel . ispItem
cr ^? crInv . ix i
newvf = cpos +.+ fromMaybe (V2 0 0) vfoffset
vfoffset = do
iscam <- mitm ^? _Just . itScope . scopeIsCamera
@@ -83,11 +85,16 @@ moveZoomCamera cfig theinput cr campos =
zoomOutSpeed = 15
updateScopeZoom :: World -> World
updateScopeZoom w
updateScopeZoom w = fromMaybe w $ do
i <- w ^? cWorld . lWorld . creatures . ix 0 . crInvSel . isel . ispItem
return $ updateScopeZoom' i w
updateScopeZoom' :: Int -> World -> World
updateScopeZoom' i w
| SDL.ButtonRight `M.member` _mouseButtons (_input w) = w & wppointer %~ doScopeZoom mp
| otherwise = w & wppointer %~ resetscope
where
wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (w ^?! cWorld . lWorld . creatures . ix 0)) . itScope
wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix i . itScope
resetscope (ZoomScope _ _ _ defz bl) = ZoomScope (V2 0 0) 0 defz defz bl
resetscope otherAtt = otherAtt
mp = rotateV (w ^. cWorld . camPos . camRot) $ _mousePos (_input w)
@@ -170,10 +177,13 @@ rotateCameraBy :: Float -> CWorld -> CWorld
rotateCameraBy x w =
w
& camPos . camRot +~ x
& lWorld . creatures . ix 0 . crInv . ix (crSel (w ^?! lWorld . creatures . ix 0))
. itScope
. scopePos
%~ rotateV x
& fromMaybe id (do
i <- w ^? lWorld . creatures . ix 0 . crInvSel . isel . ispItem
return $ lWorld . creatures . ix 0 . crInv . ix i
. itScope
. scopePos
%~ rotateV x
)
rotateCamera :: Configuration -> World -> World
rotateCamera cfig w
src/Dodge/Update/Scroll.hs
+2 -1
View File
@@ -105,11 +105,12 @@ moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of
changeTweakParam :: Maybe Int -> Int -> World -> World
changeTweakParam mi i w = fromMaybe w $ do
curpos <- you w ^? crInvSel . isel . ispItem
paramid <- mi
params <- yourItem w ^? _Just . itTweaks . tweakParams . ix paramid
let x = (_tweakVal params + i) `mod` _tweakMax params
return $
w & cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (you w))
w & cWorld . lWorld . creatures . ix 0 . crInv . ix curpos
%~ ( (itTweaks . tweakParams . ix paramid . tweakVal .~ x)
. doTweak (_tweakType params) x
)