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

Work on inventory management

Browse Source
This commit is contained in:
justin
2023-02-16 16:12:03 +00:00
parent ff5fa6321a
commit 934dd64704
30 changed files with 129 additions and 111 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/You.hs
+1 -1
View File
@@ -12,7 +12,7 @@ youc w = w ^?! lWorld . creatures . ix 0
yourItem :: World -> Maybe Item
yourItem w = do
i <- you w ^? crInvSel . isel . ispItem
i <- you w ^? crManipulation . isel . ispItem
_crInv (you w) IM.!? i
yourInv :: World -> IM.IntMap Item
src/Dodge/Creature/Action.hs
+1 -1
View File
@@ -190,7 +190,7 @@ 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 = fromMaybe w $ do
curpos <- you w ^? crInvSel . isel . ispItem
curpos <- you w ^? crManipulation . isel . ispItem
guard $ not $ _crInvLock (you w) || cursed
return $ w
& dropItem cr curpos
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 (SelItem i NoInvSelAction)
SwitchToItem i -> crup $ cr & crManipulation .~ Manipulator (SelItem i NoInvSelAction)
Melee cid' ->
( hitCr cid'
, crMvBy (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20
src/Dodge/Creature/Impulse/UseItem.hs
+4 -4
View File
@@ -23,7 +23,7 @@ import qualified SDL
useItem :: Creature -> World -> World
useItem cr' w = fromMaybe (f w) $ do
cr <- w ^? cWorld . lWorld . creatures . ix (_crID cr')
itRef <- cr ^? crInvSel . isel . ispItem
itRef <- cr ^? crManipulation . isel . ispItem
it <- cr ^? crInv . ix itRef
return $ itemEffect cr it w
where
@@ -39,7 +39,7 @@ itemEffect cr it w = case it ^. itUse of
(ConsumeUse eff _) -> setuhamdown $ hammerTest $ useC eff it cr . rmInvItem (_crID cr) itRef
CraftUse{} -> setuhamdown w
where
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
itRef = cr ^?! crManipulation . isel . ispItem -- unsafe!! TODO change
hammerTest f = case _crHammerPosition cr of
HammerUp -> f w
_ -> w & setuhamdown
@@ -109,7 +109,7 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
crpoint = cWorld . lWorld . creatures . ix (_crID cr)
itmat i = _crInv cr IM.! i
itm = itmat itRef
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
itRef = cr ^?! crManipulation . isel . ispItem -- unsafe!! TODO change
onequip itm' = useE ((_eeOnEquip . _equipEffect . _itUse) itm') itm'
onremove itm' = useE ((_eeOnRemove . _equipEffect . _itUse) itm') itm'
@@ -117,7 +117,7 @@ useLeftItem :: Int -> World -> World
useLeftItem cid w = fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix cid
guard . not $ _crInvLock cr
let mitRef = cr ^? crInvSel . isel . ispItem
let mitRef = cr ^? crManipulation . isel . ispItem
itmIsConsumable = isJust $ do
itRef <- mitRef
cr ^? crInv . ix itRef . itUse . cUse
src/Dodge/Creature/ReaderUpdate.hs
+1 -1
View File
@@ -153,7 +153,7 @@ doStrategyActions cr = case cr ^? crActionPlan . apStrategy of
reloadOverride :: Creature -> Creature
reloadOverride cr = fromMaybe cr $ do
guard $ cr ^. crStance . posture == Aiming
itRef <- cr ^? crInvSel . isel . ispItem
itRef <- cr ^? crManipulation . isel . ispItem
guard $ cr ^? crInv . ix itRef . itUse . heldConsumption . laLoaded == Just 0
return $ cr & crActionPlan . apStrategy .~ StrategyActions Reload reloadActions
where
src/Dodge/Creature/State.hs
+4 -4
View File
@@ -68,7 +68,7 @@ stateUpdate f =
heldAimEffects :: Creature -> World -> World
heldAimEffects cr = fromMaybe id $ do
guard (crIsAiming cr)
ipos <- cr ^? crInvSel . isel . ispItem
ipos <- cr ^? crManipulation . isel . ispItem
itm <- cr ^? crInv . ix ipos
f <- itm ^? itEffect . ieWhileAiming
return $ doInvEffect f itm cr
@@ -263,7 +263,7 @@ itemUpdate cr i = updateAutoRecharge
. (itLocation .~ InInv (_crID cr) i)
. (itIsHeld .~ itmisheld)
where
itmisheld = Just i == (cr ^? crInvSel . isel . ispItem)
itmisheld = Just i == (cr ^? crManipulation . isel . ispItem)
updateAutoRecharge :: Item -> Item
updateAutoRecharge it = case it ^? itUse . leftConsumption of
@@ -279,12 +279,12 @@ crGetTargeting cr = do
where
hastargeting itm = isJust (itm ^? itUse . useTargeting . _Just)
helditem = fromMaybe [] $ do
i <- cr ^? crInvSel . isel . ispItem
i <- cr ^? crManipulation . isel . ispItem
itm <- cr ^? crInv . ix i
return [itm]
weaponReloadSounds :: Creature -> World -> World
weaponReloadSounds cr w = case cr ^? crInvSel . isel . iselAction of
weaponReloadSounds cr w = case cr ^? crManipulation . isel . iselAction of
Just ReloadAction{_reloadAction = la} ->
soundContinue
(CrReloadSound cid)
src/Dodge/Creature/Statistics.hs
+3 -4
View File
@@ -36,8 +36,7 @@ crCurrentEquipment cr =
strFromHeldItem :: Creature -> Int
strFromHeldItem cr
| _posture (_crStance cr) == Aiming || crIsReloading cr =
negate $ fromMaybe 0 $ cr ^? crInv . ix itRef . itUse . heldAim . aimWeight
| _posture (_crStance cr) == Aiming || crIsReloading cr = negate $ fromMaybe 0 $ do
i <- cr ^? crManipulation . isel . ispItem
cr ^? crInv . ix i . itUse . heldAim . aimWeight
| otherwise = 0
where
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
src/Dodge/Creature/Test.hs
+3 -3
View File
@@ -32,13 +32,13 @@ import Dodge.Data.World
import Geometry
crIsReloading :: Creature -> Bool
crIsReloading cr = case cr ^? crInvSel . isel . iselAction of
crIsReloading cr = case cr ^? crManipulation . isel . iselAction of
Just ReloadAction{} -> True
_ -> False
crWeaponReady :: Creature -> Bool
crWeaponReady cr = fromMaybe False $ do
i <- cr ^? crInvSel . isel . ispItem
i <- cr ^? crManipulation . isel . ispItem
ic <- cr ^? crInv . ix i . itUse . heldConsumption
return (_laLoaded ic > 0 && _laPrimed ic)
@@ -83,7 +83,7 @@ crInAimStance as cr =
&& mitstance == Just as
where
mitstance = do
i <- cr ^? crInvSel . isel . ispItem
i <- cr ^? crManipulation . isel . ispItem
cr ^? crInv . ix i . itUse . heldAim . aimStance
oneH :: Creature -> Bool
src/Dodge/Creature/YourControl.hs
+4 -4
View File
@@ -52,7 +52,7 @@ wasdWithAiming w speed cr
& crDir +~ _crTwist cr'
& crTwist .~ 0
addAnyTwist = fromMaybe id $ do
itRef <- cr ^? crInvSel . isel . ispItem
itRef <- cr ^? crManipulation . isel . ispItem
astance <- cr ^? crInv . ix itRef . itUse . heldAim . aimStance
let currenttwistamount = cr ^. crTwist
case (astance,currenttwistamount) of
@@ -73,7 +73,7 @@ wasdWithAiming w speed cr
mouseDir = fromMaybe
(argV (_mousePos (_input w)) + (w ^. cWorld . camPos . camRot) )
$ do
itRef <- cr ^? crInvSel . isel . ispItem
itRef <- cr ^? crManipulation . isel . ispItem
_ <- cr ^? crInv . ix itRef . itScope . scopePos
return . argV $ mouseWorldPos (w ^. input) (w ^. cWorld . camPos) -.- _crPos cr
@@ -81,7 +81,7 @@ aimTurn :: Float -> Creature -> Creature
aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
where
x = fromMaybe 1 $ do
itRef <- cr ^? crInvSel . isel . ispItem
itRef <- cr ^? crManipulation . isel . ispItem
cr ^? crInv . ix itRef . itUse . heldAim . aimTurnSpeed
wasdM :: SDL.Scancode -> Point2
@@ -104,5 +104,5 @@ mouseActionsCr pkeys cr
where
rbPressed = SDL.ButtonRight `M.member` pkeys
noaction = fromMaybe True $ do
theaction <- cr ^? crInvSel . isel . iselAction
theaction <- cr ^? crManipulation . isel . iselAction
return $ theaction == NoInvSelAction
src/Dodge/Data/Creature.hs
+2 -2
View File
@@ -49,7 +49,7 @@ data Creature = Creature
, _crHP :: Int
, _crMaxHP :: Int
, _crInv :: IM.IntMap Item
, _crInvSel :: InvSel
, _crManipulation :: Manipulation
, _crInvCapacity :: Int
, _crInvLock :: Bool
, _crInvEquipped :: IM.IntMap EquipPosition
@@ -98,7 +98,7 @@ data Intention = Intention
--deriving (Eq, Show, Read) --Generic, Flat)
crSel :: Creature -> ManipulatedObject
crSel = _isel . _crInvSel
crSel = _isel . _crManipulation
makeLenses ''Creature
makeLenses ''CreatureTargeting
src/Dodge/Data/Item/Use/Consumption/LoadAction.hs
+4 -4
View File
@@ -17,9 +17,9 @@ data LoadAction
| LoadPrime {_actionTime :: Int, _actionSound :: SoundID}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data InvSel -- should be ManipulatedObject?
data Manipulation -- should be ManipulatedObject?
-- = InvSel {_isel :: SelPos}
= InvSel {_isel :: ManipulatedObject}
= Manipulator {_isel :: ManipulatedObject}
| Brute
deriving (Eq, Ord, Show, Read) --Generic, Flat)
@@ -42,11 +42,11 @@ data LeftInvSel = LeftInvSel
makeLenses ''LoadAction
makeLenses ''ManipulatedObject
makeLenses ''InvSel
makeLenses ''Manipulation
makeLenses ''LeftInvSel
makeLenses ''InvSelAction
deriveJSON defaultOptions ''LoadAction
deriveJSON defaultOptions ''InvSelAction
deriveJSON defaultOptions ''ManipulatedObject
deriveJSON defaultOptions ''InvSel
deriveJSON defaultOptions ''Manipulation
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 SelNothing
, _crManipulation = Manipulator SelNothing
, _crInvCapacity = 25
, _crInvLock = False
, _crInvEquipped = mempty
src/Dodge/DisplayInventory.hs
+1 -1
View File
@@ -21,7 +21,7 @@ import Dodge.Data.SelectionList
import Dodge.Data.World
updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections ()
updateDisplayInventory w cfig sss = case cr ^? crInvSel . isel of
updateDisplayInventory w cfig sss = case cr ^? crManipulation . isel of
Just (SelItem i _) -> sss
{ _sssSections = updateSections availablelines (0,i) [invx ,youx, closex]
, _sssSelPos = Just 0
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 . isel . ispItem
guard (cr ^? crInvSel . isel . iselAction == Just NoInvSelAction)
hix <- cr ^? crManipulation . isel . ispItem
guard (cr ^? crManipulation . isel . iselAction == Just NoInvSelAction)
la <- cr ^? crInv . ix hix . itUse . heldConsumption
atype <- la ^? laAmmoType
guard (isGas atype)
src/Dodge/HeldScroll.hs
+1 -1
View File
@@ -19,7 +19,7 @@ doHeldScroll hs = case hs of
HeldScrollCharMode{} -> overYourItem $ \x _ -> itUse . heldScroll . hsCharMode %~ cycleSignum x
where
overYourItem f x cr w = fromMaybe w $ do
i <- cr ^? crInvSel . isel . ispItem
i <- cr ^? crManipulation . isel . ispItem
return $ w & cWorld . lWorld . creatures . ix 0 . crInv . ix i %~ f x cr
cycleSignum :: Float -> Seq a -> Seq a
src/Dodge/HeldUse.hs
+3 -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 = w ^?! cWorld . lWorld . creatures . ix cid . crInvSel . isel . ispItem
i = w ^?! cWorld . lWorld . creatures . ix cid . crManipulation . 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 = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
j = cr ^?! crManipulation . isel . ispItem -- unsafe!! TODO change
caneStickSoundChoice :: Item -> SoundID
caneStickSoundChoice it
@@ -502,7 +502,7 @@ shootTeslaArc it cr w =
w'
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itParams .~ ip
where
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
itRef = cr ^?! crManipulation . 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/InputFocus.hs
+18 -4
View File
@@ -1,5 +1,7 @@
module Dodge.InputFocus
( inTermFocus
, inInvRegex
, inSubInvRegex
, inputFocus
) where
@@ -15,13 +17,25 @@ inTermFocus w = fromMaybe False $ do
connectionstatus <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus
return $ hasfocus && connectionstatus == TerminalReady
inputFocus :: World -> Bool
inputFocus w = inTermFocus w || inregexfocus
where
inregexfocus = fromMaybe False $ do
inInvRegex :: World -> Bool
inInvRegex w = fromMaybe False $ do
sss <- w ^? hud . hudElement . diSections
i <- sss ^? sssSelPos . _Just
ss <- sss ^? sssSections . ix i
j <- ss ^? ssCursor . _Just . scurSel
si <- ss ^? ssItems . ix j
return $ case si of
SelectionRegex {} -> True
_ -> False
inSubInvRegex :: World -> Bool
inSubInvRegex w = fromMaybe False $ do
sm <- w ^? hud . hudElement . subInventory . subInvMap
i <- sm ^? smSelPos . _Just
si <- sm ^? smShownItems . ix i
case si of
SelectionRegex {} -> return True
_ -> return False
inputFocus :: World -> Bool
inputFocus w = inTermFocus w || inSubInvRegex w || inInvRegex w
src/Dodge/Inventory.hs
+13 -13
View File
@@ -60,7 +60,7 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
& pointcid . crInv %~ f
& pointcid %~ crCancelReloading
-- & pointcid . crInvSel . iselPos %~ g THIS NEEDS CHECKING
& pointcid . crInvSel . isel . ispItem %~ g
& pointcid . crManipulation . isel . ispItem %~ g
& pointcid . crLeftInvSel . lisMPos %~ g'
& removeAnySlotEquipment
& dounequipfunction
@@ -98,7 +98,7 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
| otherwise = Just x
rmSelectedInvItem :: Int -> World -> World
rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crInvSel . isel . ispItem of
rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crManipulation . isel . ispItem of
Just i -> rmInvItem cid i w
Nothing -> w
@@ -172,7 +172,7 @@ updateCloseObjects w =
where
newcloseobjects = unionBy closeObjEq oldCloseFiltered currentClose
updatecursorposifnecessary
= case w ^? cWorld . lWorld . creatures . ix 0 . crInvSel . isel . ispCloseObject of
= case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . isel . ispCloseObject of
Just i | i >= length newcloseobjects -> changeAugInvSel 1
_ -> id
filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasButtonLOS ypos (closeObjPos obj) w
@@ -193,7 +193,7 @@ updateRBList w
| w ^? rbOptions . opItemID == mcurrentitemid =
w & setEquipAllocation & setEquipActivation
| otherwise = fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
i <- cr ^? crInvSel . isel . ispItem
i <- cr ^? crManipulation . isel . ispItem
esite <- cr ^? crInv . ix i . itUse . equipEffect . eeSite
itid <- mcurrentitemid
return $
@@ -210,14 +210,14 @@ updateRBList w
& setEquipActivation
where
mcurrentitemid = do
i <- cr ^? crInvSel . isel . ispItem
i <- cr ^? crManipulation . 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
i <- cr ^? crInvSel . isel . ispItem
i <- cr ^? crManipulation . isel . ispItem
ep <- cr ^? crInvEquipped . ix i
elemIndex ep eps
@@ -228,7 +228,7 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
setEquipAllocation :: World -> World
setEquipAllocation w = fromMaybe w $ do
curpos <- you w ^? crInvSel . isel . ispItem
curpos <- you w ^? crManipulation . isel . ispItem
return $ case _rbOptions w of
EquipOptions{_opEquip = es, _opSel = i} ->
case you w ^? crInvEquipped . ix curpos of
@@ -302,7 +302,7 @@ setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
where
--invsel = crSel (you w)
minvsel = cr ^? crInvSel . isel . ispItem
minvsel = cr ^? crManipulation . isel . ispItem
cr = you w
invselcanactivate = isJust $ do
i <- minvsel
@@ -323,10 +323,10 @@ closeObjScrollDir x
| otherwise = id
changeSwapInvSel :: Int -> World -> World
changeSwapInvSel k w = case you w ^? crInvSel . isel of
changeSwapInvSel k w = case you w ^? crManipulation . 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
& cWorld . lWorld . creatures . ix 0 . crManipulation . isel . ispCloseObject
.~ ((i - k) `mod` numCO)
& hud . closeObjects %~ swapIndices i ((i - k) `mod` numCO)
_ -> w
@@ -334,7 +334,7 @@ changeSwapInvSel k w = case you w ^? crInvSel . isel of
updatecreature i =
(crInv %~ IM.safeSwapKeys (i `mod` n) (swapi i))
. (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel i)
. (crInvSel . isel . ispItem %~ (`mod` n) . subtract k)
. (crManipulation . isel . ispItem %~ (`mod` n) . subtract k)
. (crInvEquipped %~ IM.safeSwapKeys i (swapi i))
. swapSite i (swapi i)
. swapSite (swapi i) i
@@ -359,7 +359,7 @@ changeAugInvSel yi w
setInvPosFromSS :: World -> World
setInvPosFromSS w = w
& cWorld . lWorld . creatures . ix 0 . crInvSel . isel .~ thesel
& cWorld . lWorld . creatures . ix 0 . crManipulation . isel .~ thesel
where
thesel = fromMaybe SelNothing $ do
sss <- w ^? hud . hudElement . diSections
@@ -493,7 +493,7 @@ bestCloseObjectIndex w = findIndex f $ w ^. hud . closeObjects
ycr = you w
selectedCloseObject :: World -> Maybe (Int, Either FloorItem Button)
selectedCloseObject w = case you w ^? crInvSel . isel . ispCloseObject of
selectedCloseObject w = case you w ^? crManipulation . isel . ispCloseObject of
Just i -> selectNthCloseObject w i
Nothing -> selectNthCloseObject w =<< bestCloseObjectIndex w
src/Dodge/Inventory/Add.hs
+1 -1
View File
@@ -38,7 +38,7 @@ 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 (SelItem i NoInvSelAction)
& cWorld . lWorld . creatures . ix 0 . crManipulation .~ Manipulator (SelItem i NoInvSelAction)
(Nothing, w') -> w'
createPutItem :: Item -> World -> (Maybe Int, World)
src/Dodge/Inventory/SelectionList.hs
+2 -2
View File
@@ -34,7 +34,7 @@ invSelectionItem' cr i it = SelectionItem
col = _itInvColor it
pics = take (itSlotsTaken it) . (++ replicate 10 "*") $ case _itCurseStatus it of
UndroppableIdentified -> itemDisplay it
_ | cr ^? crInvSel . isel . ispItem == Just i -> selectedItemDisplay cr it
_ | cr ^? crManipulation . isel . ispItem == Just i -> selectedItemDisplay cr it
_ -> itemDisplay it
invSelectionItem :: Creature -> (Int,Item) -> SelectionItem ()
invSelectionItem cr (i,it) = SelectionItem
@@ -50,7 +50,7 @@ invSelectionItem cr (i,it) = SelectionItem
col = _itInvColor it
pics = take (itSlotsTaken it) . (++ replicate 10 "*") $ case _itCurseStatus it of
UndroppableIdentified -> itemDisplay it
_ | cr ^? crInvSel . isel . ispItem == Just i -> selectedItemDisplay cr it
_ | cr ^? crManipulation . isel . ispItem == Just i -> selectedItemDisplay cr it
_ -> itemDisplay it
--
closeObjectToSelectionItem :: Int -> Either FloorItem Button -> SelectionItem ()
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 . isel . iselAction of
showReloadProgress cr ic = case cr ^? crManipulation . 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
+4 -4
View File
@@ -137,7 +137,7 @@ shootLaser it cr = cWorld . lWorld . lasers .:~ lasRayAt (_lasColor $ _itParams
pos = _crPos cr
dir = _crDir cr
phasev = _phaseV . _itParams $ _crInv cr IM.! itRef
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
itRef = cr ^?! crManipulation . isel . ispItem -- unsafe!! TODO change
dam = _lasDamage $ _itParams it
-- this has the feel of a left click item
@@ -153,7 +153,7 @@ circleLaser it cr w
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.! itRef
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
itRef = cr ^?! crManipulation . isel . ispItem -- unsafe!! TODO change
dam = _lasDamage $ _itParams it
shootDualLaser :: Item -> Creature -> World -> World
@@ -176,7 +176,7 @@ shootDualLaser it cr w =
dirl = argV $ mwp' -.- posl
dirr = argV $ mwp' -.- posr
phasev = _phaseV . _itParams $ _crInv cr IM.! itRef
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
itRef = cr ^?! crManipulation . isel . ispItem -- unsafe!! TODO change
dam = _lasDamage $ _itParams it
basicBeamAt :: Int -> World -> Color -> Int -> Float -> Point2 -> Float -> Beam
@@ -211,7 +211,7 @@ aTractorBeam _ cr w = w & cWorld . lWorld . tractorBeams .:~ tractorBeamAt spos
dir = _crDir cr
outpos = fst $ collidePointWallsFilter (const True) cpos xpos w
power = _attractionPower . _itParams $ _crInv cr IM.! itRef
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
itRef = cr ^?! crManipulation . isel . ispItem -- unsafe!! TODO change
tractorBeamAt :: Point2 -> Point2 -> Float -> Point2 -> TractorBeam
tractorBeamAt pos outpos dir power =
src/Dodge/Item/Weapon/TriggerType.hs
+9 -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 = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
itRef = cr ^?! crManipulation . 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 = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
itRef = cr ^?! crManipulation . isel . ispItem -- unsafe!! TODO change
pointerToItem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef
curWarmUp = _warmTime . _heldDelay $ _itUse item
maxWarmUp = _warmMax . _heldDelay $ _itUse item
@@ -343,7 +343,7 @@ useAllAmmo eff item cr =
eff item cr
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itUse . heldConsumption . laLoaded .~ 0)
where
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
itRef = cr ^?! crManipulation . isel . ispItem -- unsafe!! TODO change
useAmmoUpTo :: Int -> ChainEffect
useAmmoUpTo amAmount eff item cr =
@@ -352,14 +352,14 @@ useAmmoUpTo amAmount eff item cr =
%~ (max 0 . subtract amAmount)
)
where
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
itRef = cr ^?! crManipulation . isel . ispItem -- unsafe!! TODO change
useAmmoAmount :: Int -> ChainEffect
useAmmoAmount amAmount eff item cr =
eff item cr
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itUse . heldConsumption . laLoaded -~ amAmount)
where
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
itRef = cr ^?! crManipulation . isel . ispItem -- unsafe!! TODO change
{- |
Applies a world effect after an item use cooldown check.
@@ -371,7 +371,7 @@ useTimeCheck f item cr w = case item ^? itUse . heldDelay . rateTime of
where
cid = _crID cr
setUseTime = cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itUse . heldDelay . rateTime +~ userate
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
itRef = cr ^?! crManipulation . isel . ispItem -- unsafe!! TODO change
userate = fromMaybe 0 $ item ^? itUse . heldDelay . rateMax
-- | Applies a world effect after a hammer position check.
@@ -396,7 +396,7 @@ ammoUseCheck f item cr w
| otherwise = w
where
cid = _crID cr
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
itRef = cr ^?! crManipulation . isel . ispItem -- unsafe!! TODO change
pointerToItem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef
fireCondition =
crWeaponReady cr
@@ -453,12 +453,12 @@ withItem g f it = g it f it
withItemUpdate' :: (Item -> Item) -> ChainEffect
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
itRef = cr ^?! crManipulation . 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 itRef %~ up)
where
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
itRef = cr ^?! crManipulation . isel . ispItem -- unsafe!! TODO change
withTempLight :: Int -> Float -> V3 Float -> ChainEffect
withTempLight time rad col eff item cr =
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 . isel . ispItem
&& w ^? cWorld . lWorld . creatures . ix cid . crManipulation . isel . ispItem
== w ^? cWorld . lWorld . itemLocations . ix itid . ipInvID
= (w ^. cWorld . camPos . camRot) + argV (_mousePos (_input w))
| otherwise = _prjDir pj
src/Dodge/Reloading.hs
+12 -12
View File
@@ -14,17 +14,17 @@ crCancelReloading :: Creature -> Creature
crCancelReloading cr =
cr
& updateProgress
& crInvSel . isel . iselAction .~ NoInvSelAction
& crManipulation . 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 . isel of
stepReloading cr = case cr ^?! crManipulation . isel of
SelItem i (ReloadAction x la)
| x > 0 ->
cr & crInvSel . isel . iselAction . actionProgress -~ 1
cr & crManipulation . isel . iselAction . actionProgress -~ 1
| otherwise ->
cr
& crInv . ix i . itUse . heldConsumption %~ doLoadAction la
@@ -33,22 +33,22 @@ stepReloading cr = case cr ^?! crInvSel . isel of
_ -> cr
tryNextLoadAction :: Creature -> Creature
tryNextLoadAction cr = case cr ^? crInvSel . isel of
tryNextLoadAction cr = case cr ^? crManipulation . isel of
Just (SelItem i _) -> case cr ^? crInv . ix i . itUse . heldConsumption . laProgress . _Just . ix 0 of
Nothing -> cr & crInvSel . isel . iselAction .~ NoInvSelAction
Nothing -> cr & crManipulation . isel . iselAction .~ NoInvSelAction
Just la ->
cr & crInvSel . isel . iselAction . actionProgress .~ _actionTime la
& crInvSel . isel . iselAction . reloadAction .~ la
cr & crManipulation . isel . iselAction . actionProgress .~ _actionTime la
& crManipulation . isel . iselAction . reloadAction .~ la
_ -> cr
crToggleReloading :: Creature -> Creature
crToggleReloading cr = case cr ^? crInvSel . isel . iselAction of
Just ReloadAction{} -> cr & crInvSel . isel . iselAction .~ NoInvSelAction
crToggleReloading cr = case cr ^? crManipulation . isel . iselAction of
Just ReloadAction{} -> cr & crManipulation . isel . iselAction .~ NoInvSelAction
_ -> cr & tryStartLoading
tryStartLoading :: Creature -> Creature
tryStartLoading cr = fromMaybe cr $ do
i <- cr ^? crInvSel . isel . ispItem
i <- cr ^? crManipulation . isel . ispItem
hc <- cr ^? crInv . ix i . itUse . heldConsumption
return $ startLoading hc cr
@@ -60,12 +60,12 @@ startLoading ic cr = case ic ^? laProgress . _Just . ix 0 of
Just [] -> error "item has empty load cycle"
Just _ | _laLoaded ic >= _laMax ic -> cr
Just (la : las) -> fromMaybe (error "item loading error") $ do
i <- cr ^? crInvSel . isel . ispItem
i <- cr ^? crManipulation . isel . ispItem
return $ cr & startLoadingStep la
& crInv . ix i . itUse . heldConsumption . laProgress ?~ (la : las)
startLoadingStep :: LoadAction -> Creature -> Creature
startLoadingStep la cr = cr & crInvSel . isel . iselAction .~ ReloadAction (_actionTime la) la
startLoadingStep la cr = cr & crManipulation . isel . iselAction .~ ReloadAction (_actionTime la) la
rotateActionProgress :: HeldConsumption -> HeldConsumption
rotateActionProgress ic = case ic ^? laProgress . _Just of
src/Dodge/Render/HUD.hs
+3 -3
View File
@@ -85,7 +85,7 @@ inventoryDisplay sss w cfig = listPicturesAtScaleOff
spos <- _sssSelPos sss
sss ^? sssSections . ix spos . ssCursor . _Just . scurColor
thecursor = fromMaybe mempty $ do
sectype <- you w ^? crInvSel . isel
sectype <- you w ^? crManipulation . isel
let secnum = case sectype of
SelItem{} -> 0
SelNothing{} -> 1
@@ -152,7 +152,7 @@ floorItemPickupInfo n itm
-- note the use of ^?!
-- it is probably desirable for this to crash hard for now
yourAugmentedItem :: (Item -> a) -> a -> (Either FloorItem Button -> a) -> World -> a
yourAugmentedItem f x g w = case you w ^? crInvSel . isel of
yourAugmentedItem f x g w = case you w ^? crManipulation . isel of
Just (SelItem i _) -> f $ yourInv w ^?! ix i
Just (SelCloseObject i) -> g $ w ^?! hud . closeObjects . ix i
_ -> x
@@ -269,7 +269,7 @@ displayTerminal tid cfig w = fromMaybe mempty $ do
drawRBOptions :: Configuration -> World -> RightButtonOptions -> Picture
drawRBOptions cfig w EquipOptions{_opEquip = es, _opSel = i, _opAllocateEquipment = ae}
= fromMaybe mempty $ do
curpos <- you w ^? crInvSel . isel . ispItem
curpos <- you w ^? crManipulation . 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)
src/Dodge/Update.hs
+3 -3
View File
@@ -6,6 +6,7 @@ Description : Simulation update
-}
module Dodge.Update (updateUniverse) where
import Dodge.InputFocus
import Dodge.DisplayInventory
import Dodge.ScrollValue
import Color
@@ -25,7 +26,7 @@ import Dodge.DrWdWd
import Dodge.EnergyBall
import Dodge.Flame
import Dodge.Flare
import Dodge.InputFocus
--import Dodge.InputFocus
import Dodge.Inventory
import Dodge.Item.Location
import Dodge.Laser.Update
@@ -145,10 +146,9 @@ updateUseInput u = case u ^? uvScreenLayers . _head of
Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u
Just (CombineInventory sm)
| inregex sm -> doSubInvRegexInput u
_ | ininvregex -> doInvRegexInput u
_ | inInvRegex (u ^. uvWorld) -> doInvRegexInput u
_ -> M.foldlWithKey' updateKeyInGame u pkeys
where
ininvregex = False
inregex sm = fromMaybe False $ do
i <- sm ^? smSelPos . _Just
si <- sm ^? smShownItems . ix i
src/Dodge/Update/Camera.hs
+8 -12
View File
@@ -5,6 +5,7 @@ module Dodge.Update.Camera (
updateCamera,
) where
import Dodge.InputFocus
import Bound
import Dodge.Viewpoints
import Control.Monad
@@ -44,7 +45,7 @@ moveZoomCamera cfig theinput cr campos =
where
cpos = _crPos cr
mitm = do
i <- cr ^? crInvSel . isel . ispItem
i <- cr ^? crManipulation . isel . ispItem
cr ^? crInv . ix i
newvf = cpos +.+ fromMaybe (V2 0 0) vfoffset
vfoffset = do
@@ -86,7 +87,7 @@ moveZoomCamera cfig theinput cr campos =
updateScopeZoom :: World -> World
updateScopeZoom w = fromMaybe w $ do
i <- w ^? cWorld . lWorld . creatures . ix 0 . crInvSel . isel . ispItem
i <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . isel . ispItem
return $ updateScopeZoom' i w
updateScopeZoom' :: Int -> World -> World
@@ -178,7 +179,7 @@ rotateCameraBy x w =
w
& camPos . camRot +~ x
& fromMaybe id (do
i <- w ^? lWorld . creatures . ix 0 . crInvSel . isel . ispItem
i <- w ^? lWorld . creatures . ix 0 . crManipulation . isel . ispItem
return $ lWorld . creatures . ix 0 . crInv . ix i
. itScope
. scopePos
@@ -187,17 +188,12 @@ rotateCameraBy x w =
rotateCamera :: Configuration -> World -> World
rotateCamera cfig w
| keyl && keyr = w
| keyl = over cWorld (rotateCameraBy 0.025) w
| keyr = over cWorld (rotateCameraBy (-0.025)) w
| keydown SDL.ScancodeQ && keydown SDL.ScancodeE = w
| keydown SDL.ScancodeQ = over cWorld (rotateCameraBy 0.025) w
| keydown SDL.ScancodeE = over cWorld (rotateCameraBy (-0.025)) w
| otherwise = ifConfigWallRotate cfig w
where
keyl = SDL.ScancodeQ `M.member` _pressedKeys (_input w) && notAtTerminal w
keyr = SDL.ScancodeE `M.member` _pressedKeys (_input w) && notAtTerminal w
-- TODO check where/how this is used
notAtTerminal :: World -> Bool
notAtTerminal w = isNothing $ w ^? hud . hudElement . subInventory . termID
keydown scode = scode `M.member` _pressedKeys (_input w) && not (inputFocus w)
--zoomCamBy :: Float -> World -> World
--zoomCamBy x w = w {_cameraZoom = max (_cameraZoom w + x) 0.01}
src/Dodge/Update/Input.hs
+17 -8
View File
@@ -79,7 +79,9 @@ doInvRegexInput :: Universe -> Universe
doInvRegexInput u
| backspacetonothing
= u & uvWorld . hud . hudElement . diSections %~ overSection
( ssRegex .~ EmptyRegex )
( ( ssRegex .~ EmptyRegex )
. ( ssItems . at (-1) .~ Nothing)
)
-- . initialSelPos )
-- & uvWorld . hud . hudElement . diSections %~ setShownIntMap
| endkeys || endmouse = u
@@ -122,7 +124,13 @@ updateKeysInTerminal tmid u =
| otherwise = id
updateKeyInGame :: Universe -> Scancode -> PressType -> Universe
updateKeyInGame uv sc InitialPress = case sc of
updateKeyInGame uv sc pt = case pt of
InitialPress -> updateInitialPressInGame uv sc
LongPress -> updateLongPressInGame uv sc
_ -> uv
updateInitialPressInGame :: Universe -> Scancode -> Universe
updateInitialPressInGame uv sc = case sc of
ScancodeF5 -> doQuicksave uv
ScancodeF9 -> loadSaveSlot QuicksaveSlot uv
ScancodeEscape -> pauseGame uv
@@ -137,20 +145,19 @@ updateKeyInGame uv sc InitialPress = case sc of
-- the following should be put in a more sensible place
ScancodeSlash -> uv & uvWorld . hud . hudElement %~ updateEnterRegex
ScancodeBackspace -> uv & uvWorld . hud . hudElement %~ updateBackspaceRegex
-- in fact the whole logic should probably be rethought, oh well
_ -> uv
updateKeyInGame uv sc LongPress = case sc of
updateLongPressInGame :: Universe -> Scancode -> Universe
updateLongPressInGame uv sc = case sc of
ScancodeF -> over uvWorld youDropItem uv
ScancodeSpace -> over uvWorld spaceAction uv
_ -> uv
updateKeyInGame uv _ _ = uv
updateBackspaceRegex :: HUDElement -> HUDElement
updateBackspaceRegex di = case di ^? subInventory of
Just NoSubInventory -> di & diSections %~ overSection
( (ssRegex %~ backssregex)
. (ssCursor .~ Just (SectionCursor (-1) 0 1 white))
. (ssCursor ?~ SectionCursor (-1) 0 1 white)
)
Just CombineInventory {} -> di
& subInventory . subInvMap . smRegex %~ enternonzeroregex
@@ -165,7 +172,9 @@ updateBackspaceRegex di = case di ^? subInventory of
updateEnterRegex :: HUDElement -> HUDElement
updateEnterRegex di = case di ^? subInventory of
Just NoSubInventory -> di & diSections %~ overSection (ssRegex %~ enterssregex)
Just NoSubInventory -> di & diSections %~ overSection
( (ssRegex %~ enterssregex)
)
Just CombineInventory {} -> di
& subInventory . subInvMap . smRegex %~ enterregex
& subInventory . subInvMap . smSelPos ?~ 0
src/Dodge/Update/Scroll.hs
+1 -1
View File
@@ -104,7 +104,7 @@ 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
curpos <- you w ^? crManipulation . isel . ispItem
paramid <- mi
params <- yourItem w ^? _Just . itTweaks . tweakParams . ix paramid
let x = (_tweakVal params + i) `mod` _tweakMax params