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

Distinguish between selected item and root-selected item

Browse Source
This commit is contained in:
justin
2024-09-21 21:59:53 +01:00
parent 2154abfb1d
commit 31b5db6e9e
33 changed files with 313 additions and 281 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/You.hs
+10 -4
View File
@@ -3,7 +3,8 @@ module Dodge.Base.You
-- , yourScopeInvID
, yourInv
-- , yourScrollAttachment
, yourItem
, yourSelectedItem
, yourRootItem
)where
import Dodge.Data.World
@@ -17,9 +18,14 @@ import Control.Lens
you :: World -> Creature
you w = w ^?! cWorld . lWorld . creatures . ix 0
yourItem :: World -> Maybe Item
yourItem w = do
i <- you w ^? crManipulation . manObject . inInventory . ispItem
yourSelectedItem :: World -> Maybe Item
yourSelectedItem w = do
i <- you w ^? crManipulation . manObject . inInventory . imSelectedItem
_crInv (you w) IM.!? i
yourRootItem :: World -> Maybe Item
yourRootItem w = do
i <- you w ^? crManipulation . manObject . inInventory . imRootItem
_crInv (you w) IM.!? i
--yourScrollAttachment :: World -> Maybe (Int,ScrollAttachParams)
src/Dodge/Creature/Action.hs
+4 -3
View File
@@ -192,7 +192,7 @@ dropItem cr invid = rmInvItem (_crID cr) invid . copyInvItemToFloor cr invid --
youDropItem :: World -> World
youDropItem w = fromMaybe w $ do
curpos <-
you w ^? crManipulation . manObject . inInventory . ispItem
you w ^? crManipulation . manObject . inInventory . imSelectedItem
<|> fmap fst (IM.lookupMax =<< w ^? hud . hudElement . diSections . sssSections . ix 0 . ssItems)
guard $ not $ _crInvLock (you w) || cursed
return $
@@ -202,7 +202,7 @@ youDropItem w = fromMaybe w $ do
where
cr = you w
cursed = fromMaybe False $ do
it <- yourItem w
it <- yourSelectedItem w
return $ it ^. itCurseStatus /= Uncursed
-- | Copy an inventory item to the floor.
@@ -210,7 +210,8 @@ copyInvItemToFloor :: Creature -> Int -> World -> World
copyInvItemToFloor cr i =
copyItemToFloor (_crPos cr) $
_crInv cr IM.! i
& itIsHeld .~ False
& itIsSelected .~ False
& itIsRoot .~ False
sizeSelf :: Float -> Creature -> World -> Maybe World
sizeSelf x cr w
src/Dodge/Creature/Impulse.hs
+2 -1
View File
@@ -33,6 +33,7 @@ followImpulses w cr = foldl' (flip f) (id, cr) (reverse $ _apImpulse $ _crAction
where
f imp (theupdate, cr') = first (. theupdate) $ followImpulse cr' w imp
-- note SwitchToItem doesn't necessarily update the root item correctly
followImpulse :: Creature -> World -> Impulse -> (World -> World, Creature)
followImpulse cr w imp = case imp of
ImpulseNothing -> (id, cr)
@@ -47,7 +48,7 @@ followImpulse cr w imp = case imp of
TurnTo p -> crup $ creatureTurnTo p cr
ChangePosture post -> crup $ cr & crStance . posture .~ post
UseItem -> (useItemRightClick cr, cr)
SwitchToItem i -> crup $ cr & crManipulation . manObject .~ InInventory (SelItem i NoInvSelAction)
SwitchToItem i -> crup $ cr & crManipulation . manObject .~ InInventory (SelectedItem i i)
Melee cid' ->
( hitCr cid'
, crMvAbsolute (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20
src/Dodge/Creature/Impulse/UseItem.hs
+6 -4
View File
@@ -25,7 +25,7 @@ import qualified IntMapHelp as IM
useItemRightClick :: Creature -> World -> World
useItemRightClick cr' w = fromMaybe (f w) $ do
cr <- w ^? cWorld . lWorld . creatures . ix (_crID cr')
itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
itRef <- cr ^? crManipulation . manObject . inInventory . imRootItem
it <- invTrees (_crInv cr) ^? ix itRef
return $
itemEffect cr it w
@@ -51,7 +51,7 @@ itemEffect cr it w = case it ^. ldtValue . itUse of
AmmoMagUse{} -> w
where
itm = it ^. ldtValue
itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
itRef = cr ^?! crManipulation . manObject . inInventory . imRootItem -- unsafe!! TODO change
hammerTest f = case _crHammerPosition cr of
HammerUp -> f w & setuhamdown
_ -> w & setuhamdown
@@ -97,14 +97,16 @@ toggleEquipmentAt invid cr w = case getEquipmentAllocation w of
crpoint = cWorld . lWorld . creatures . ix (_crID cr)
itmat i = _crInv cr IM.! i
itm = itmat itRef
itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change?
itRef = cr ^?! crManipulation . manObject . inInventory . imSelectedItem -- unsafe!! TODO change?
onequip itm' = useE ((_eeOnEquip . _equipEffect . _itUse) itm') itm'
onremove itm' = useE ((_eeOnRemove . _equipEffect . _itUse) itm') itm'
-- need to make sure that the root item is not erroneously selected in the
-- following
useItemLeftClick :: Creature -> World -> World
useItemLeftClick cr w = fromMaybe w $ do
guard . not $ _crInvLock cr
invid <- cr ^? crManipulation . manObject . inInventory . ispItem
invid <- cr ^? crManipulation . manObject . inInventory . imSelectedItem
ituse <- cr ^? crInv . ix invid . itUse
case ituse of
--HeldUse{} -> return $ hammerTest (cWorld . lWorld . creatures . ix (_crID cr) %~ crReloadToggle)
src/Dodge/Creature/State.hs
+6 -4
View File
@@ -251,7 +251,7 @@ itemInvSideEffect cr it
| hastorchattach = createAttachLight cr it
| otherwise = id
where
hastorchattach = it ^? itType . iyModules . ix ModHeldAttach == Just ATTACHTORCH && _itIsHeld it
hastorchattach = it ^? itType . iyModules . ix ModHeldAttach == Just ATTACHTORCH && _itIsRoot it
createAttachLight :: Creature -> Item -> World -> World
createAttachLight cr it = createTorchLightOffset cr it attachoff
@@ -263,9 +263,11 @@ itemUpdate cr i =
updateAutoRecharge
. (itUse %~ useUpdate)
. (itLocation .~ InInv (_crID cr) i)
. (itIsHeld .~ itmisheld)
. (itIsRoot .~ itmisroot)
. (itIsSelected .~ itmisselected)
where
itmisheld = Just i == (cr ^? crManipulation . manObject . inInventory . ispItem)
itmisroot = Just i == (cr ^? crManipulation . manObject . inInventory . imRootItem)
itmisselected = Just i == (cr ^? crManipulation . manObject . inInventory . imSelectedItem)
updateAutoRecharge :: Item -> Item
updateAutoRecharge it = case it ^? itUse . leftConsumption of
@@ -281,7 +283,7 @@ updateAutoRecharge it = case it ^? itUse . leftConsumption of
-- in the inventory
crGetTargeting :: Creature -> Maybe TargetType
crGetTargeting cr = do
i <- cr ^? crManipulation . manObject . inInventory . ispItem
i <- cr ^? crManipulation . manObject . inInventory . imRootItem
itm <- cr ^? crInv . ix i
itm ^? itType . iyModules . ix ModTarget . imtTargetType
<|> do
src/Dodge/Creature/Statistics.hs
+1 -1
View File
@@ -38,6 +38,6 @@ strFromHeldItem :: Creature -> Int
strFromHeldItem cr
--x--- | _posture (_crStance cr) == Aiming || crIsReloading cr = negate $ fromMaybe 0 $ do
| _posture (_crStance cr) == Aiming = negate $ fromMaybe 0 $ do
i <- cr ^? crManipulation . manObject . inInventory . ispItem
i <- cr ^? crManipulation . manObject . inInventory . imRootItem
cr ^? crInv . ix i . itUse . heldAim . aimWeight
| otherwise = 0
src/Dodge/Creature/Test.hs
+11 -11
View File
@@ -12,11 +12,11 @@ module Dodge.Creature.Test (
oneH,
twists,
twoFlat,
crWeaponReady,
-- crWeaponReady,
crInAimStance,
crNearPoint,
isAnimate,
crCanShoot,
-- crCanShoot,
crHasTargetLOS,
crAwayFromPost,
crHasTarget,
@@ -38,12 +38,12 @@ import Geometry
-- Just ReloadAction{} -> True
-- _ -> False
-- Assumes the ammotype below the selected item is correct
crWeaponReady :: Creature -> Bool
crWeaponReady cr = fromMaybe False $ do
i <- cr ^? crManipulation . manObject . inInventory . ispItem
x <- cr ^? crInv . ix (i + 1) . itUse . amagLoadStatus . iaLoaded
return (x > 0)
---- Assumes the ammotype below the selected item is correct
--crWeaponReady :: Creature -> Bool
--crWeaponReady cr = fromMaybe False $ do
-- i <- cr ^? crManipulation . manObject . inInventory . ispItem
-- x <- cr ^? crInv . ix (i + 1) . itUse . amagLoadStatus . iaLoaded
-- return (x > 0)
crCanSeeCr :: Creature -> (World, Creature) -> Bool
crCanSeeCr tcr (w, cr) = hasLOS (_crPos cr) (_crPos tcr) w
@@ -82,8 +82,8 @@ crAwayFromPost cr = case find sentinelGoal . _apGoal $ _crActionPlan cr of
sentinelGoal (SentinelAt _ _) = True
sentinelGoal _ = False
crCanShoot :: Creature -> Bool
crCanShoot cr = crIsAiming cr && crWeaponReady cr
--crCanShoot :: Creature -> Bool
--crCanShoot cr = crIsAiming cr && crWeaponReady cr
crInAimStance :: AimStance -> Creature -> Bool
crInAimStance as cr =
@@ -91,7 +91,7 @@ crInAimStance as cr =
&& mitstance == Just as
where
mitstance = do
i <- cr ^? crManipulation . manObject . inInventory . ispItem
i <- cr ^? crManipulation . manObject . inInventory . imRootItem
cr ^? crInv . ix i . itUse . heldAim . aimStance
oneH :: Creature -> Bool
src/Dodge/Creature/YourControl.hs
+9 -9
View File
@@ -88,7 +88,7 @@ tryAssignHotkey w sc = fromMaybe w $ do
pt <- w ^? input . pressedKeys . ix sc
guard (pt == InitialPress)
cr <- w ^? cWorld . lWorld . creatures . ix 0
itid <- cr ^? crManipulation . manObject . inInventory . ispItem
itid <- cr ^? crManipulation . manObject . inInventory . imSelectedItem
return $ w & cWorld . lWorld . creatures . ix 0 %~ assignHotkey itid (scancodeToHotkey sc)
{- | Turn key presses into creature movement.
@@ -152,6 +152,7 @@ wasdAim inp cam cr
theTurn cr' = creatureTurnTowardDir (_crMvAim cr') 0.2 cr'
mouseDir = argV $ mouseWorldPos inp cam - (cr ^. crPos)
-- aim with the root item
wasdTwist :: Creature -> Creature
wasdTwist cr
| _posture (_crStance cr) == Aiming = addAnyTwist cr
@@ -163,7 +164,7 @@ wasdTwist cr
& crDir +~ _crTwist cr'
& crTwist .~ 0
addAnyTwist = fromMaybe id $ do
itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
itRef <- cr ^? crManipulation . manObject . inInventory . imRootItem
astance <- cr ^? crInv . ix itRef . itUse . heldAim . aimStance
case (astance, cr ^. crTwist) of
(TwoHandUnder, 0) ->
@@ -189,19 +190,18 @@ aimTurn :: Float -> Creature -> Creature
aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
where
x = fromMaybe 1 $ do
itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
itRef <- cr ^? crManipulation . manObject . inInventory . imRootItem
cr ^? crInv . ix itRef . itUse . heldAim . aimTurnSpeed
-- | Set posture according to mouse presses.
mouseActionsCr :: M.Map SDL.MouseButton Int -> Creature -> Creature
mouseActionsCr pkeys cr
| SDL.ButtonRight `M.member` pkeys && noaction =
cr & crStance . posture .~ Aiming
| SDL.ButtonRight `M.member` pkeys = cr & crStance . posture .~ Aiming
| otherwise = cr & crStance . posture .~ AtEase
where
noaction = fromMaybe True $ do
theaction <- cr ^? crManipulation . manObject . inInventory . iselAction
return $ theaction == NoInvSelAction
-- where
-- noaction = fromMaybe True $ do
-- theaction <- cr ^? crManipulation . manObject . inInventory . iselAction
-- return $ theaction == NoInvSelAction
pressedMBEffectsTopInventory :: M.Map SDL.MouseButton Int -> World -> World
pressedMBEffectsTopInventory pkeys w
src/Dodge/CreatureEffect.hs
+2 -1
View File
@@ -48,8 +48,9 @@ doWdCrBl wcb = case wcb of
doCrBl :: CrBl -> Creature -> Bool
doCrBl cb = case cb of
CrCanShoot -> crCanShoot
-- CrCanShoot -> crCanShoot
-- CrIsReloading -> crIsReloading
CrCanShoot -> error "got rid of crCanShoot"
CrIsAiming -> crIsAiming
CrIsAnimate -> isAnimate
src/Dodge/Data/Item.hs
+2 -1
View File
@@ -35,7 +35,8 @@ data Item = Item
, _itType :: ItemType
, _itID :: Int
, _itLocation :: ItemLocation
, _itIsHeld :: Bool
, _itIsRoot :: Bool
, _itIsSelected :: Bool
, _itEffect :: ItEffect
, _itInvSize :: Float
, _itDimension :: ItemDimension
src/Dodge/Data/Item/HeldUse.hs
+2 -2
View File
@@ -23,8 +23,8 @@ data Huse
| HeldDetectorEffect Detector
-- | HeldTeslaArc
-- | HeldLaser
| HeldCircleLaser
| HeldDualLaser
-- | HeldCircleLaser
-- | HeldDualLaser
| HeldTractor
| HeldForceField
| HeldShatter
src/Dodge/Data/Item/Use/Consumption/LoadAction.hs
+1 -1
View File
@@ -30,7 +30,7 @@ data NearbyManipulation
data InventoryManipulation
= SortInventory
| SelItem { _ispItem :: Int, _iselAction :: InvSelAction}
| SelectedItem { _imSelectedItem :: Int, _imRootItem :: Int}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data InvSelAction
src/Dodge/Default/Item.hs
+2 -1
View File
@@ -25,7 +25,8 @@ defaultHeldItem = Item
, _itType = ItemType (HELD PISTOL) mempty
, _itEffect = defaultItEffect
, _itID = 0
, _itIsHeld = False
, _itIsRoot = False
, _itIsSelected = False
, _itInvSize = 1
, _itLocation = InVoid
, _itDimension = defaultItemDimension
src/Dodge/HeldUse.hs
+10 -5
View File
@@ -115,7 +115,12 @@ applySidePush maxSide cr w = w
(pushAmount, g) = randomR (- maxSide, maxSide) $ _randGen w
applyTorqueCME :: Item -> Creature -> World -> World
applyTorqueCME itm cr w = w
applyTorqueCME itm cr w
| cid == 0 = w
& wCam . camRot -~ rot
& cWorld . lWorld . creatures . ix cid . crDir +~ rot
& randGen .~ g
| otherwise = w
& cWorld . lWorld . creatures . ix cid . crDir +~ rot
& randGen .~ g
where
@@ -221,7 +226,7 @@ shootTractorBeam _ cr w = w & cWorld . lWorld . tractorBeams .:~ tractorBeamAt'
dir = _crDir cr
outpos = fst $ collidePointWallsFilter (const True) cpos xpos w
power = _attractionPower . _itParams $ _crInv cr IM.! itRef
itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
itRef = cr ^?! crManipulation . manObject . inInventory . imRootItem -- unsafe!! TODO change
tractorBeamAt' :: Point2 -> Point2 -> Float -> Point2 -> TractorBeam
tractorBeamAt' pos outpos dir power =
@@ -309,8 +314,8 @@ useHeld hu = case hu of
HeldDetectorEffect dt -> detectorEffect dt . _ldtValue
-- HeldTeslaArc -> shootTeslaArc . _ldtValue
-- HeldLaser -> shootLaser . _ldtValue
HeldCircleLaser -> circleLaser . _ldtValue
HeldDualLaser -> shootDualLaser . _ldtValue
-- HeldCircleLaser -> circleLaser . _ldtValue
-- HeldDualLaser -> shootDualLaser . _ldtValue
HeldTractor -> aTractorBeam . _ldtValue
-- HeldSonicWave -> aSonicWave
HeldForceField -> useForceFieldGun . _ldtValue
@@ -466,7 +471,7 @@ shootTeslaArc itm cr mz w =
w'
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itParams .~ ip
where
itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
itRef = cr ^?! crManipulation . manObject . inInventory . imRootItem -- unsafe!! TODO change
(w', ip) = makeTeslaArc (_itParams itm) pos dir w
pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
dir = _crDir cr + _mzRot mz
src/Dodge/Humanoid.hs
+9 -9
View File
@@ -146,10 +146,10 @@ updateHumanoid cr = case cr ^?! crType . humanoidAI of
defaultImpulsive
[ sentinelExtraWatchUpdate
[
( const $ not . crWeaponReady
, \_ _ -> StrategyActions Reload reloadActions
)
,
-- ( const $ not . crWeaponReady
-- , \_ _ -> StrategyActions Reload reloadActions
-- )
-- ,
( const $ not . crSafeDistFromTarg 150
, \_ _ ->
StrategyActions
@@ -172,11 +172,11 @@ updateHumanoid cr = case cr ^?! crType . humanoidAI of
InanimateAI -> id
where
drawwp = DoActionIfElse NoAction (WdCrBlfromCrBl CrIsAiming) (DoActionThen drawWeapon (WaitThen 50 NoAction))
reloadActions =
[ holsterWeapon
--, WaitThen 1 $ DoActionWhileInterrupt NoAction (WdCrBlfromCrBl CrIsReloading) (DoImpulses [ChangeStrategy WatchAndWait])
, WaitThen 1 $ (DoImpulses [ChangeStrategy WatchAndWait])
]
-- reloadActions =
-- [ holsterWeapon
-- --, WaitThen 1 $ DoActionWhileInterrupt NoAction (WdCrBlfromCrBl CrIsReloading) (DoImpulses [ChangeStrategy WatchAndWait])
-- , WaitThen 1 $ (DoImpulses [ChangeStrategy WatchAndWait])
-- ]
humanoidAIList ::
[World -> Creature -> Creature] ->
src/Dodge/Inventory.hs
+11 -5
View File
@@ -14,6 +14,7 @@ module Dodge.Inventory (
module Dodge.Inventory.RBList
) where
import Dodge.Inventory.FindRoot
import Dodge.Inventory.RBList
import Control.Applicative
import Data.Maybe
@@ -59,15 +60,16 @@ rmInvItem cid invid w = w
& pointcid . crInvHotkeys %~ IM.mapKeys g
& updateselection
& pointcid %~ updateRootItemID
& worldEventFlags . at InventoryChange ?~ ()
where
pointcid = cWorld . lWorld . creatures . ix cid
updateselection
| cid == 0 && cr ^? crManipulation . manObject . inInventory . ispItem == Just invid =
| cid == 0 && cr ^? crManipulation . manObject . inInventory . imSelectedItem == Just invid =
scrollAugInvSel (-1) . scrollAugInvSel 1 . updateInventorySectionItems
| otherwise =
pointcid . crManipulation . manObject . inInventory . ispItem %~ g
pointcid . crManipulation . manObject . inInventory . imSelectedItem %~ g
cr = w ^?! cWorld . lWorld . creatures . ix cid
itm = _crInv cr IM.! invid
@@ -158,7 +160,7 @@ rmInvItem cid invid w = w
-- | otherwise = x
rmSelectedInvItem :: Int -> World -> World
rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crManipulation . manObject . inInventory . ispItem of
rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crManipulation . manObject . inInventory . imSelectedItem of
Just i -> rmInvItem cid i w
Nothing -> w
@@ -231,6 +233,7 @@ changeSwapInv f i w = fromMaybe w $ do
k <- f i ss
return $
w & cWorld . lWorld . creatures . ix 0 %~ updatecreature k
& cWorld . lWorld . creatures . ix 0 %~ updateRootItemID
& hud . hudElement . diSections . sssExtra . sssSelPos . _Just . _2 .~ k
& worldEventFlags . at InventoryChange ?~ ()
where
@@ -241,7 +244,7 @@ changeSwapInv f i w = fromMaybe w $ do
updatecreature k =
(crInv %~ IM.safeSwapKeys i k)
-- . (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel k)
. (crManipulation . manObject . inInventory . ispItem .~ k)
. (crManipulation . manObject . inInventory . imSelectedItem .~ k)
. (crInvEquipped %~ IM.safeSwapKeys i k)
. swapSite i k
. swapSite k i
@@ -280,12 +283,15 @@ setInvPosFromSS w =
(i, j) <- sss ^? sssExtra . sssSelPos . _Just
case i of
(-1) -> Just $ InInventory SortInventory
0 -> Just $ InInventory (SelItem j NoInvSelAction)
--0 -> Just $ InInventory (SelItem j (getRootItemID i (you w)))
0 -> Just $ InInventory (SelectedItem j (getRootItemID j (you w)))
1 -> Just SelNothing
2 -> Just $ InNearby SortNearby
3 -> Just $ InNearby $ SelCloseObject j
_ -> error "selection out of bounds"
selectedCloseObject :: World -> Maybe (Either FloorItem Button)
selectedCloseObject w = do
i <-
src/Dodge/Inventory/Add.hs
+3 -1
View File
@@ -4,6 +4,8 @@ module Dodge.Inventory.Add (
createAndSelectItem,
) where
import Dodge.Inventory.FindRoot
--import Dodge.Item.Grammar
import Control.Lens
import Data.Maybe
import Dodge.Base.You
@@ -47,7 +49,7 @@ createAndSelectItem itm w = case createPutItem itm w of
w'
& hud . hudElement . diSections . sssExtra . sssSelPos ?~ (0, i)
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
.~ InInventory (SelItem i NoInvSelAction)
.~ InInventory (SelectedItem i (getRootItemID i (you w)))
(Nothing, w') -> w'
createPutItem :: Item -> World -> (Maybe Int, World)
src/Dodge/Inventory/RBList.hs
+3 -3
View File
@@ -20,7 +20,7 @@ updateRBList w
| otherwise = case w ^. rbOptions of
EquipOptions{} -> w
_ -> fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
i <- cr ^? crManipulation . manObject . inInventory . ispItem
i <- cr ^? crManipulation . manObject . inInventory . imSelectedItem
esite <- cr ^? crInv . ix i . itUse . equipEffect . eeSite
return $
w
@@ -35,7 +35,7 @@ updateRBList w
-- find a free equipment slot
chooseEquipmentPosition :: Creature -> [EquipPosition] -> Int
chooseEquipmentPosition cr eps = fromMaybe (chooseFreeSite cr eps) $ do
i <- cr ^? crManipulation . manObject . inInventory . ispItem
i <- cr ^? crManipulation . manObject . inInventory . imSelectedItem
ep <- cr ^? crInvEquipped . ix i
elemIndex ep eps
@@ -46,7 +46,7 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
getEquipmentAllocation :: World -> EquipmentAllocation
getEquipmentAllocation w = fromMaybe DoNotMoveEquipment $ do
curpos <- you w ^? crManipulation . manObject . inInventory . ispItem
curpos <- you w ^? crManipulation . manObject . inInventory . imSelectedItem
esite <- you w ^? crInv . ix curpos . itUse . equipEffect . eeSite
i <- w ^? rbOptions . opSel
<|> Just (chooseEquipmentPosition (you w) (equipSiteToPositions esite))
src/Dodge/ItEffect.hs
+1 -1
View File
@@ -23,7 +23,7 @@ doFloorEffect NoFloorEffect = const id
onOffEff :: ItInvEffect -> ItInvEffect -> Item -> Creature -> World -> World
onOffEff f g it
| _itIsHeld it = doInvEffect f it
| _itIsRoot it = doInvEffect f it
| otherwise = doInvEffect g it
--timeScrollEffect :: Item -> Creature -> World -> World
src/Dodge/Item/Draw.hs
+1 -1
View File
@@ -16,7 +16,7 @@ import ShapePicture
itemEquipPict :: Creature -> Item -> SPic
itemEquipPict cr it = case it ^. itUse of
HeldUse{} | _itIsHeld it -> overPosSP (heldItemOffset it cr) (itemSPic it)
HeldUse{} | _itIsRoot it -> overPosSP (heldItemOffset it cr) (itemSPic it)
ituse -> fromMaybe mempty $ do
attachpos <- ituse ^? equipEffect . eeAttachPos
i <- it ^? itLocation . ipInvID
src/Dodge/Item/HeldOffset.hs
+5 -5
View File
@@ -23,18 +23,18 @@ transToHandle itm = fromMaybe id $ do
heldItemOffset :: Item -> Creature -> Point3 -> Point3
heldItemOffset itm cr
| isSelected && _posture (_crStance cr) == Aiming =
| isroot && _posture (_crStance cr) == Aiming =
(+.+.+ aimingWeaponZeroPos cr itm `v2z` shoulderHeight)
| isSelected && isTwoHandFlat =
| isroot && isTwoHandFlat =
(+.+.+ V3 (_crRad cr) 0 handD)
. rotate3 (twoFlatHRot cr)
. transToHandle itm
| isSelected && isOneHand =
| isroot && isOneHand =
(+.+.+ V3 0 0 handD)
. (+.+.+ V3 (_crRad cr * 0.7 + handPos) (_crRad cr * negate 0.7) 0)
. (+.+.+ V3 (-2) 0 0)
. transToHandle itm
| isSelected =
| isroot =
(+.+.+ V3 0 0 handD)
. (+.+.+ V3 (_crRad cr) 0 0)
. rotate3 (strideRot cr + 1.2)
@@ -44,7 +44,7 @@ heldItemOffset itm cr
| otherwise = id
where
handD = 15
isSelected = _itIsHeld itm
isroot = _itIsRoot itm
handPos = case cr ^? crStance . carriage of
Just (Walking x LeftForward) -> f x * 50
_ -> 0
src/Dodge/Item/Location.hs
+10 -4
View File
@@ -2,7 +2,8 @@ module Dodge.Item.Location (
pointerToItemLocation,
getItem,
pointerToItem,
pointerYourItem,
pointerYourSelectedItem,
pointerYourRootItem,
) where
import Control.Lens
@@ -28,9 +29,14 @@ pointerToItemLocation (InInv cid invid) = cWorld . lWorld . creatures . ix cid .
pointerToItemLocation (OnFloor flid) = cWorld . lWorld . floorItems . ix flid . flIt
pointerToItemLocation _ = const pure
pointerYourItem :: Applicative a => (Item -> a Item) -> World -> a World
pointerYourItem f w = fromMaybe (pure w) $ do
itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . ispItem
pointerYourSelectedItem :: Applicative a => (Item -> a Item) -> World -> a World
pointerYourSelectedItem f w = fromMaybe (pure w) $ do
itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . imSelectedItem
Just $ pointerToItemLocation (InInv 0 itinvid) f w
pointerYourRootItem :: Applicative a => (Item -> a Item) -> World -> a World
pointerYourRootItem f w = fromMaybe (pure w) $ do
itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . imRootItem
Just $ pointerToItemLocation (InInv 0 itinvid) f w
pointerToItem ::
src/Dodge/Item/Weapon/BatteryGuns.hs
+64 -64
View File
@@ -5,20 +5,20 @@ module Dodge.Item.Weapon.BatteryGuns (
splitBeamCombine,
-- shootTeslaArc,
shootLaser,
circleLaser,
shootDualLaser,
--circleLaser,
--shootDualLaser,
aTractorBeam,
) where
import Dodge.Base
import Dodge.Beam
import Dodge.Creature.HandPos
--import Dodge.Creature.HandPos
import Dodge.Data.World
import Dodge.Item.Weapon.LaserPath
--import Dodge.Item.Weapon.LaserPath
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import Picture
--import Picture
--import Control.Monad.State
@@ -84,67 +84,67 @@ shootLaser it cr =
(_crPos cr)
(_crDir cr)
-- this has the feel of a left click item
circleLaser :: Item -> Creature -> World -> World
circleLaser it cr w
| hasLOSIndirect cpos pos w =
w
& cWorld . lWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
| otherwise = w
where
cpos = _crPos cr
mwp = mouseWorldPos (w ^. input) (w ^. wCam)
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 ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
dam = _lasDamage $ _itParams it
---- this has the feel of a left click item
--circleLaser :: Item -> Creature -> World -> World
--circleLaser it cr w
-- | hasLOSIndirect cpos pos w =
-- w
-- & cWorld . lWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
-- | otherwise = w
-- where
-- cpos = _crPos cr
-- mwp = mouseWorldPos (w ^. input) (w ^. wCam)
-- 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 ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
-- dam = _lasDamage $ _itParams it
shootDualLaser :: Item -> Creature -> World -> World
shootDualLaser it cr w =
w
& cWorld . lWorld . newBeams . positronBeams .:~ dualRayAt (_lasBeam $ _itParams it) itid w (_lasColor $ _itParams it) dam phasev posl dirl
& cWorld . lWorld . newBeams . electronBeams .:~ basicBeamAt itid w (_lasColor2 $ _itParams it) dam phasev posr dirr
where
itid = _itID it
dir = _crDir cr
pos = _crPos cr +.+ aimlength *.* unitVectorAtAngle dir
aimlength = aimingMuzzleLength cr it
gap = _dbGap . _itParams $ it
posl = pos +.+ (- gap) *.* vNormal (unitVectorAtAngle dir)
posr = pos +.+ gap *.* vNormal (unitVectorAtAngle dir)
mwp = mouseWorldPos (w ^. input) (w ^. wCam)
mwp'
| dist mwp (_crPos cr) < aimlength + 5 = _crPos cr +.+ (aimlength + 5) *.* unitVectorAtAngle dir
| otherwise = mwp
dirl = argV $ mwp' -.- posl
dirr = argV $ mwp' -.- posr
phasev = _phaseV . _itParams $ _crInv cr IM.! itRef
itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
dam = _lasDamage $ _itParams it
--shootDualLaser :: Item -> Creature -> World -> World
--shootDualLaser it cr w =
-- w
-- & cWorld . lWorld . newBeams . positronBeams .:~ dualRayAt (_lasBeam $ _itParams it) itid w (_lasColor $ _itParams it) dam phasev posl dirl
-- & cWorld . lWorld . newBeams . electronBeams .:~ basicBeamAt itid w (_lasColor2 $ _itParams it) dam phasev posr dirr
-- where
-- itid = _itID it
-- dir = _crDir cr
-- pos = _crPos cr +.+ aimlength *.* unitVectorAtAngle dir
-- aimlength = aimingMuzzleLength cr it
-- gap = _dbGap . _itParams $ it
-- posl = pos +.+ (- gap) *.* vNormal (unitVectorAtAngle dir)
-- posr = pos +.+ gap *.* vNormal (unitVectorAtAngle dir)
-- mwp = mouseWorldPos (w ^. input) (w ^. wCam)
-- mwp'
-- | dist mwp (_crPos cr) < aimlength + 5 = _crPos cr +.+ (aimlength + 5) *.* unitVectorAtAngle dir
-- | otherwise = mwp
-- dirl = argV $ mwp' -.- posl
-- dirr = argV $ mwp' -.- posr
-- phasev = _phaseV . _itParams $ _crInv cr IM.! itRef
-- itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
-- dam = _lasDamage $ _itParams it
basicBeamAt :: Int -> World -> Color -> Int -> Float -> Point2 -> Float -> Beam
basicBeamAt itid w col dam phasev pos dir =
Beam
{ _bmDraw = BasicBeamDraw --drawBeam
, _bmPos = pos
, _bmDir = dir
, _bmDamage = dam
, _bmRange = 800
, _bmPhaseV = phasev
, _bmColor = col
, _bmPoints = pos : ps
, _bmFirstPoints = []
, _bmOrigin = Just itid
, _bmType = BeamCombine NoBeamCombine
}
where
(_, ps) = reflectLaserAlong phasev pos (pos +.+ 800 *.* unitVectorAtAngle dir) w
--basicBeamAt :: Int -> World -> Color -> Int -> Float -> Point2 -> Float -> Beam
--basicBeamAt itid w col dam phasev pos dir =
-- Beam
-- { _bmDraw = BasicBeamDraw --drawBeam
-- , _bmPos = pos
-- , _bmDir = dir
-- , _bmDamage = dam
-- , _bmRange = 800
-- , _bmPhaseV = phasev
-- , _bmColor = col
-- , _bmPoints = pos : ps
-- , _bmFirstPoints = []
-- , _bmOrigin = Just itid
-- , _bmType = BeamCombine NoBeamCombine
-- }
-- where
-- (_, ps) = reflectLaserAlong phasev pos (pos +.+ 800 *.* unitVectorAtAngle dir) w
dualRayAt :: BeamType -> Int -> World -> Color -> Int -> Float -> Point2 -> Float -> Beam
dualRayAt bt itid w col dam phasev pos dir =
basicBeamAt itid w col dam phasev pos dir
& bmType .~ bt
--dualRayAt :: BeamType -> Int -> World -> Color -> Int -> Float -> Point2 -> Float -> Beam
--dualRayAt bt itid w col dam phasev pos dir =
-- basicBeamAt itid w col dam phasev pos dir
-- & bmType .~ bt
aTractorBeam :: Item -> Creature -> World -> World
aTractorBeam _ cr w = w & cWorld . lWorld . tractorBeams .:~ tractorBeamAt spos outpos dir power
@@ -155,7 +155,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 ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
itRef = cr ^?! crManipulation . manObject . inInventory . imRootItem -- unsafe!! TODO change
tractorBeamAt :: Point2 -> Point2 -> Float -> Point2 -> TractorBeam
tractorBeamAt pos outpos dir power =
src/Dodge/Item/Weapon/TriggerType.hs
+17 -16
View File
@@ -16,8 +16,8 @@ module Dodge.Item.Weapon.TriggerType (
trigDoAlso,
withTempLight,
withItem,
withItemUpdate,
withItemUpdateFirst,
-- withItemUpdate,
-- withItemUpdateFirst,
-- rateIncAB,
-- torqueBefore,
-- torqueBeforeAtLeast,
@@ -68,7 +68,7 @@ import Dodge.Creature.HandPos
import Data.Foldable
import Data.Maybe
import Dodge.Base
import Dodge.Creature.Test
--import Dodge.Creature.Test
import Dodge.Data.World
import Dodge.Inventory.Lock
import Dodge.LightSource
@@ -208,7 +208,8 @@ withWarmUp ::
SoundID ->
ChainEffect
withWarmUp soundID f item cr w
| curWarmUp < maxWarmUp && crWeaponReady cr =
-- | curWarmUp < maxWarmUp && crWeaponReady cr =
| curWarmUp < maxWarmUp =
w
& pointertoitem . itUse . heldDelay . warmTime +~ 2
& soundContinue (CrWeaponSound cid 0) (_crPos cr) soundID (Just 2)
@@ -219,7 +220,7 @@ withWarmUp soundID f item cr w
where
item' = _ldtValue item
cid = _crID cr
itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
itRef = cr ^?! crManipulation . manObject . inInventory . imRootItem -- unsafe!! TODO change
pointertoitem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef
curWarmUp = _warmTime . _heldDelay $ _itUse item'
maxWarmUp = _warmMax . _heldDelay $ _itUse item'
@@ -391,7 +392,7 @@ useTimeCheck f item cr w = case item ^? ldtValue . itUse . heldDelay of
cid = _crID cr
setUseRate = cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itUse . heldDelay . rateTime
+~ userate
itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
itRef = cr ^?! crManipulation . manObject . inInventory . imRootItem -- unsafe!! TODO change
userate = fromMaybe 0 $ item ^? ldtValue . itUse . heldDelay . rateMax
-- | Applies a world effect after a hammer position check.
@@ -451,16 +452,16 @@ shootL f item cr w
withItem :: (Item -> ChainEffect) -> ChainEffect
withItem g f it = g (_ldtValue it) f it
-- not ideal
withItemUpdateFirst :: (Item -> Item) -> ChainEffect
withItemUpdateFirst up f it cr = f (over ldtValue up it) cr . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef %~ up)
where
itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
withItemUpdate :: (Item -> Item) -> (Item -> ChainEffect) -> ChainEffect
withItemUpdate up g f it cr = g (_ldtValue it) f it cr . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef %~ up)
where
itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
---- not ideal
--withItemUpdateFirst :: (Item -> Item) -> ChainEffect
--withItemUpdateFirst up f it cr = f (over ldtValue up it) cr . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef %~ up)
-- where
-- itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
--
--withItemUpdate :: (Item -> Item) -> (Item -> ChainEffect) -> ChainEffect
--withItemUpdate up g f it cr = g (_ldtValue it) f it cr . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef %~ up)
-- where
-- itRef = cr ^?! crManipulation . manObject . inInventory . 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
@@ -94,7 +94,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 . crManipulation . manObject . inInventory . ispItem
&& w ^? cWorld . lWorld . creatures . ix cid . crManipulation . manObject . inInventory . imSelectedItem
== w ^? cWorld . lWorld . itemLocations . ix itid . ipInvID
= (w ^. wCam . camRot) + argV (_mousePos (_input w))
| otherwise = _prjDir pj
src/Dodge/Render/HUD.hs
+3 -3
View File
@@ -97,7 +97,7 @@ drawExamineInventory cfig mtweaki w =
)
)
where
itm = yourItem w
itm = yourSelectedItem w
f str =
SelectionItem
{ _siPictures = [str]
@@ -122,14 +122,14 @@ floorItemPickupInfo n itm
-- 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 ^? crManipulation . manObject of
Just (InInventory (SelItem i _)) -> f $ yourInv w ^?! ix i
Just (InInventory (SelectedItem i _)) -> f $ yourInv w ^?! ix i
Just (InNearby (SelCloseObject i)) -> g $ w ^?! hud . closeObjects . ix i
_ -> x
drawRBOptions :: Configuration -> World -> Picture
drawRBOptions cfig w = fromMaybe mempty $ do
guard $ ButtonRight `M.member` _mouseButtons (_input w)
invid <- you w ^? crManipulation . manObject . inInventory . ispItem
invid <- you w ^? crManipulation . manObject . inInventory . imSelectedItem
eslist <- fmap equipSiteToPositions $ you w ^? crInv . ix invid . itUse . equipEffect . eeSite
i <- w ^? rbOptions . opSel
let ae = getEquipmentAllocation w
src/Dodge/Update/Camera.hs
+6 -6
View File
@@ -88,26 +88,26 @@ moveZoomCamera cfig theinput cr campos =
where
vfoffset = fromMaybe 0 $ do
guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
i <- cr ^? crManipulation . manObject . inInventory . ispItem
i <- cr ^? crManipulation . manObject . inInventory . imSelectedItem
(cr ^? crInv . ix i . itScope . remotePos)
docamrot = rotateV (campos ^. camRot)
offset = fromMaybe noscopeoffset $ do
guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
i <- cr ^? crManipulation . manObject . inInventory . ispItem
i <- cr ^? crManipulation . manObject . inInventory . imSelectedItem
(fmap docamrot (cr ^? crInv . ix i . itScope . opticPos))
<|> (cr ^? crInv . ix i . itScope . remotePos)
noscopeoffset = docamrot $
((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput
newzoom = fromMaybe (newDefaultZoom * newItemZoom) $ do
i <- cr ^? crManipulation . manObject . inInventory . ispItem
i <- cr ^? crManipulation . manObject . inInventory . imSelectedItem
(cr ^? crInv . ix i . itScope . opticZoom)
idealDefaultZoom = clipZoom wallZoom
newDefaultZoom = fromMaybe (changeZoom (campos ^. camDefaultZoom) idealDefaultZoom) $ do
i <- cr ^? crManipulation . manObject . inInventory . ispItem
i <- cr ^? crManipulation . manObject . inInventory . imSelectedItem
(cr ^? crInv . ix i . itScope . opticZoom)
idealItemZoom = fromMaybe 1 $ do
guard $ crIsAiming cr
i <- cr ^? crManipulation . manObject . inInventory . ispItem
i <- cr ^? crManipulation . manObject . inInventory . imSelectedItem
zoomFromItem <$> (cr ^? crInv . ix i . itUse . heldAim . aimZoom)
newItemZoom = changeZoom (campos ^. camItemZoom) idealItemZoom
changeZoom curZoom idealZoom
@@ -128,7 +128,7 @@ moveZoomCamera cfig theinput cr campos =
-- is wanted
updateScopeZoom :: World -> World
updateScopeZoom w = fromMaybe w $ do
i <- you w ^? crManipulation . manObject . inInventory . ispItem
i <- you w ^? crManipulation . manObject . inInventory . imSelectedItem
return $ updateScopeZoom' i w
updateScopeZoom' :: Int -> World -> World
src/Dodge/Update/Input/InGame.hs
+1 -1
View File
@@ -247,7 +247,7 @@ toggleTweakInv w = case w ^? hud . hudElement . subInventory of
_ -> w & thepointer .~ ExamineInventory mi
where
thepointer = hud . hudElement . subInventory
mi = 0 <$ (yourItem w >>= (^? itTweaks . tweakParams . ix 0))
mi = 0 <$ (yourSelectedItem w >>= (^? itTweaks . tweakParams . ix 0))
tryCombine :: SelectionSections CombinableItem -> World -> World
tryCombine sss w = fromMaybe w $ do
src/Dodge/Update/Scroll.hs
+4 -4
View File
@@ -46,7 +46,7 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
_ -> w
where
rbscrollmax = fromMaybe 1 $ do
invid <- you w ^? crManipulation . manObject . inInventory . ispItem
invid <- you w ^? crManipulation . manObject . inInventory . imSelectedItem
esite <- you w ^? crInv . ix invid . itUse . equipEffect . eeSite
return $ length $ equipSiteToPositions esite
y = fromIntegral yi
@@ -111,15 +111,15 @@ scrollRBOption dy ymax
| otherwise = id
moveTweakSel :: Int -> World -> World
moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of
moveTweakSel i w = case yourSelectedItem w ^? _Just . itTweaks . tweakParams of
Just l -> moveSubSel i (length l) w
_ -> w
changeTweakParam :: Maybe Int -> Int -> World -> World
changeTweakParam mi i w = fromMaybe w $ do
curpos <- you w ^? crManipulation . manObject . inInventory . ispItem
curpos <- you w ^? crManipulation . manObject . inInventory . imSelectedItem
paramid <- mi
params <- yourItem w ^? _Just . itTweaks . tweakParams . ix paramid
params <- yourSelectedItem w ^? _Just . itTweaks . tweakParams . ix paramid
let x = (_tweakVal params + i) `mod` _tweakMax params
return $
w & cWorld . lWorld . creatures . ix 0 . crInv . ix curpos
src/Dodge/WorldEffect.hs
+1 -1
View File
@@ -39,7 +39,7 @@ doWdWd we = case we of
WdWdFromItixCrixWdWd _ crid f -> \w -> fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix crid
--it <- getItem itid w
itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
itRef <- cr ^? crManipulation . manObject . inInventory . imSelectedItem
it <- invTrees (_crInv cr) ^? ix itRef
return $ doItCrWdWd f it cr w
WdWdFromItCrixWdWd it crid f -> \w -> fromMaybe w $ do