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

Move towards unifying (your) creature manipulation with selection

Browse Source
This commit is contained in:
justin
2026-05-14 13:42:33 +01:00
parent ab393febcb
commit 59d128f87a
35 changed files with 271 additions and 252 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/You.hs
+5 -3
View File
@@ -19,19 +19,21 @@ you w = w ^?! cWorld . lWorld . creatures . ix 0
yourSelectedItem :: World -> Maybe Item
yourSelectedItem w = do
i <- you w ^? crManipulation . manObject . imSelectedItem
i <- w ^? hud . manObject . imSelectedItem
--revise1 i <- you w ^? crManipulation . manObject . imSelectedItem
j <- _crInv (you w) ^? ix i
w ^? cWorld . lWorld . items . ix j
yourRootItem :: World -> Maybe Item
yourRootItem w = do
i <- you w ^? crManipulation . manObject . imRootSelectedItem
i <- w ^? hud . manObject . imRootSelectedItem
--revise1 i <- you w ^? crManipulation . manObject . imRootSelectedItem
j <- _crInv (you w) ^? ix i
w ^? cWorld . lWorld . items . ix j
yourRootItemDT :: World -> Maybe (DTree OItem)
yourRootItemDT w = do
i <- you w ^? crManipulation . manObject . imRootSelectedItem . unNInt
i <- w^?hud. manObject . imRootSelectedItem . unNInt
invIMDT ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> you w ^. crInv) ^? ix i
yourInv :: World -> NewIntMap InvInt Item
src/Dodge/Bullet.hs
+5 -5
View File
@@ -108,11 +108,11 @@ updateBulVel bt = bt & buVel .*.*~ _buDrag bt
-- return $ BezierTrajectory sp tpos (mouseWorldPos (w ^. input) (w ^. wCam))
-- might want to restrict what/how bounces by material type
bounceDir :: IM.IntMap Item -> (Point2, Either Creature Wall) -> Maybe Point2
bounceDir _ (_, Right wl) = Just $ uncurry (-) (_wlLine wl)
bounceDir m (p, Left cr) | crIsArmouredFrom m p cr
bounceDir :: World -> IM.IntMap Item -> (Point2, Either Creature Wall) -> Maybe Point2
bounceDir _ _ (_, Right wl) = Just $ uncurry (-) (_wlLine wl)
bounceDir w m (p, Left cr) | crIsArmouredFrom m p w cr
= Just $ vNormal $ p - (cr ^. crPos . _xy)
bounceDir _ _ = Nothing
bounceDir _ _ _ = Nothing
useBulletPayload :: Bullet -> Point2 -> World -> World
useBulletPayload bu = case _buPayload bu of
@@ -160,7 +160,7 @@ hitEffFromBul w bu = case _buEffect bu of
PenetrateBullet -> movePenBullet bu hitstream w
BounceBullet -> fromMaybe (expireAndDamage bu hitstream w) $ do
(hp, crwl) <- hitstream ^? _head
dir <- bounceDir (w ^. cWorld . lWorld . items) (hp, crwl)
dir <- bounceDir w (w ^. cWorld . lWorld . items) (hp, crwl)
return
( w
, bu
src/Dodge/Creature/Action.hs
+2 -1
View File
@@ -208,7 +208,8 @@ dropItem cr invid w =
youDropItem :: World -> World
youDropItem w = fromMaybe w $ do
curpos <-
cr ^? crManipulation . manObject . imSelectedItem . unNInt
w ^? hud . manObject . imSelectedItem . unNInt
--revise1 cr ^? crManipulation . manObject . imSelectedItem . unNInt
<|> fmap fst (IM.lookupMax (cr ^. crInv . unNIntMap))
guard $ not $ w ^. cWorld . lWorld . lInvLock
return $ case cr ^. crStance . posture of
src/Dodge/Creature/HandPos.hs
+47 -44
View File
@@ -16,6 +16,7 @@ module Dodge.Creature.HandPos (
strideLength,
) where
import Dodge.Data.World
import Control.Monad
import qualified Data.IntMap.Strict as IM
import Linear
@@ -27,21 +28,21 @@ import Geometry
import qualified Quaternion as Q
import ShapePicture
translateToES :: Creature -> EquipSite -> Point3 -> Point3
translateToES cr es p = fst (equipSitePQ es cr `Q.comp` (p, Q.qid))
translateToES :: World -> Creature -> EquipSite -> Point3 -> Point3
translateToES w cr es p = fst (equipSitePQ es w cr `Q.comp` (p, Q.qid))
equipSitePQ :: EquipSite -> Creature -> Point3Q
equipSitePQ :: EquipSite -> World -> Creature -> Point3Q
equipSitePQ = \case
OnLeftWrist -> leftWristPQ
OnRightWrist -> rightWristPQ
OnHead -> headPQ
OnChest -> chestPQ
OnBack -> backPQ
OnLeftLeg -> legPQ LeftForward
OnRightLeg -> legPQ RightForward
OnHead -> headPQ
OnChest -> chestPQ
OnBack -> backPQ
OnLeftLeg -> const $ legPQ LeftForward
OnRightLeg -> const $ legPQ RightForward
translatePointToRightHand :: Creature -> Point3 -> Point3
translatePointToRightHand cr p = fst (rightHandPQ cr `Q.comp` (p, Q.qid))
translatePointToRightHand :: World -> Creature -> Point3 -> Point3
translatePointToRightHand w cr p = fst (rightHandPQ w cr `Q.comp` (p, Q.qid))
strideLength :: Creature -> Float
strideLength cr = case cr ^. crType of
@@ -61,14 +62,15 @@ handWalkingPos b off cr = case (cr ^? crType . strideAmount,cr ^? crType . footF
zeroOneSmooth :: Float -> Float
zeroOneSmooth x = (1 - cos (pi * x)) / 2
rightHandPQ :: Creature -> Point3Q
rightHandPQ cr
| oneH cr = (V3 11 (-3) 20, Q.qid)
| twists cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 4 (-10) 0, Q.qz 1)
| twoFlat cr = (V3 8 (-8) 12, Q.qid)
| Just TwoHandTwist <- cr ^? crManipulation . manObject . imAimStance
rightHandPQ :: World -> Creature -> Point3Q
rightHandPQ w cr
| oneH w cr = (V3 11 (-3) 20, Q.qid)
| twists w cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 4 (-10) 0, Q.qz 1)
| twoFlat w cr = (V3 8 (-8) 12, Q.qid)
| Just TwoHandTwist <- w ^? hud . manObject . imAimStance
--revise1 | Just TwoHandTwist <- cr ^? crManipulation . manObject . imAimStance
= (V3 6 (-6) 10, Q.qid)
| Just TwoHandFlat <- cr ^? crManipulation . manObject . imAimStance
| Just TwoHandFlat <- w ^? hud . manObject . imAimStance
= (V3 (8 - twoHandOffY cr) (-8) 12, Q.qid)
| Just p <- crRightHandWall cr = (20 & _xy .~ p, Q.qid)
| otherwise = (handWalkingPos LeftForward (-8) cr, Q.qid)
@@ -109,22 +111,23 @@ crLeftHandWall cr = do
cd = cr ^. crDir
rot = rotateV (negate cd)
translateToRightHand :: Creature -> SPic -> SPic
translateToRightHand = overPosSP . translatePointToRightHand
translateToRightHand :: World -> Creature -> SPic -> SPic
translateToRightHand w = overPosSP . translatePointToRightHand w
rightWristPQ :: Creature -> Point3Q
rightWristPQ cr = rightHandPQ cr `Q.comp` (V3 0 (-4) (-4), Q.qid)
rightWristPQ :: World -> Creature -> Point3Q
rightWristPQ w cr = rightHandPQ w cr `Q.comp` (V3 0 (-4) (-4), Q.qid)
leftHandPQ :: Creature -> Point3Q
leftHandPQ cr
| twists cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 12 4 0, Q.qz 0.4)
| twoFlat cr = (V3 8 8 12, Q.qid)
| Just TwoHandTwist <- cr ^? crManipulation . manObject . imAimStance
leftHandPQ :: World -> Creature -> Point3Q
leftHandPQ w cr
| twists w cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 12 4 0, Q.qz 0.4)
| twoFlat w cr = (V3 8 8 12, Q.qid)
| Just TwoHandTwist <- w ^? hud . manObject . imAimStance
--revise1 | Just TwoHandTwist <- cr ^? crManipulation . manObject . imAimStance
= (V3 (10 + twoHandOffY cr) 6 20, Q.qid)
| Just TwoHandFlat <- cr ^? crManipulation . manObject . imAimStance
| Just TwoHandFlat <- w ^? hud . manObject . imAimStance
= (V3 (8 + twoHandOffY cr) 6 12, Q.qid)
| Just p <- crLeftHandWall cr = (20 & _xy .~ p, Q.qid)
| oneH cr = (V3 0 8 10, Q.qz 0.4)
| oneH w cr = (V3 0 8 10, Q.qz 0.4)
| otherwise = (handWalkingPos RightForward 8 cr, Q.qid)
twoHandOffY :: Creature -> Float
@@ -137,14 +140,14 @@ twoHandOffY cr = zeroOneSmooth $ case (cr ^? crType . strideAmount,cr ^? crType
in f sa
_ -> 0
translatePointToLeftHand :: Creature -> Point3 -> Point3
translatePointToLeftHand cr p = fst (leftHandPQ cr `Q.comp` (p, Q.qid))
translatePointToLeftHand :: World -> Creature -> Point3 -> Point3
translatePointToLeftHand w cr p = fst (leftHandPQ w cr `Q.comp` (p, Q.qid))
translateToLeftHand :: Creature -> SPic -> SPic
translateToLeftHand = overPosSP . translatePointToLeftHand
translateToLeftHand :: World -> Creature -> SPic -> SPic
translateToLeftHand w = overPosSP . translatePointToLeftHand w
leftWristPQ :: Creature -> Point3Q
leftWristPQ cr = leftHandPQ cr `Q.comp` (V3 0 4 (-4), Q.qid)
leftWristPQ :: World -> Creature -> Point3Q
leftWristPQ w cr = leftHandPQ w cr `Q.comp` (V3 0 4 (-4), Q.qid)
translateToLeftLeg :: Creature -> SPic -> SPic
translateToLeftLeg cr = overPosSP (\p -> fst (legPQ LeftForward cr `Q.comp` (p, Q.qid)))
@@ -171,17 +174,17 @@ legPQ' g cr =
translateToRightLeg :: Creature -> SPic -> SPic
translateToRightLeg cr = overPosSP (\p -> fst (legPQ RightForward cr `Q.comp` (p, Q.qid)))
headPQ :: Creature -> Point3Q
headPQ cr
| twists cr = (V3 0 2 20, Q.qz (-1)) `Q.comp` (V3 (negate 2.5) 0.25 0, Q.qz 1)
| oneH cr = (V3 0 0 20, Q.qz 0.5) `Q.comp` (V3 2.5 0 0, Q.qz (-0.5))
headPQ :: World -> Creature -> Point3Q
headPQ w cr
| twists w cr = (V3 0 2 20, Q.qz (-1)) `Q.comp` (V3 (negate 2.5) 0.25 0, Q.qz 1)
| oneH w cr = (V3 0 0 20, Q.qz 0.5) `Q.comp` (V3 2.5 0 0, Q.qz (-0.5))
| otherwise = (V3 2.5 0 20, Q.qid)
chestPQ :: Creature -> Point3Q
chestPQ cr = backPQ cr `Q.comp` (0, Q.qz pi)
chestPQ :: World -> Creature -> Point3Q
chestPQ w cr = backPQ w cr `Q.comp` (0, Q.qz pi)
backPQ :: Creature -> Point3Q
backPQ cr
| oneH cr = (V3 0 0 10, Q.qz 0.5)
| twists cr = (V3 0 3 10, Q.qz (-1.5))
backPQ :: World -> Creature -> Point3Q
backPQ w cr
| oneH w cr = (V3 0 0 10, Q.qz 0.5)
| twists w cr = (V3 0 3 10, Q.qz (-1.5))
| otherwise = (V3 0 0 10, Q.qz 0)
src/Dodge/Creature/Impulse.hs
+7 -7
View File
@@ -33,10 +33,10 @@ followImpulse cid w = \case
Bark sid ->
soundStart (CrMouth cid) cpos sid Nothing $
w & clens %~ resetCrVocCoolDown w
Move p -> crup $ crMvBy p (w ^. cWorld . lWorld)
Walk p -> crup $ crWalk p (w ^. cWorld . lWorld)
MoveForward x -> crup $ crMvForward x (w ^. cWorld . lWorld)
MoveNoStride p -> crup $ crMvByNoStride p (w ^. cWorld . lWorld)
Move p -> crup $ crMvBy p w
Walk p -> crup $ crWalk p w
MoveForward x -> crup $ crMvForward x w
MoveNoStride p -> crup $ crMvByNoStride p w
Turn a -> crup $ crDir +~ a
TurnToward p a -> crup $ creatureTurnToward p a
TurnTo p -> crup $ creatureTurnTo p
@@ -69,7 +69,7 @@ followImpulse cid w = \case
i <- cr ^? crIntention . targetCr . _Just
tcr <- w ^? cWorld . lWorld . creatures . ix i
return $ followImpulse cid w (doCrImp f tcr)
MvForward -> crup $ crMvForward' (w ^. cWorld . lWorld)
MvForward -> crup $ crMvForward' w
MvTurnToward p ->
crup $
mvTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir))
@@ -101,10 +101,10 @@ meleeMovement :: World -> Int -> Creature -> Creature
meleeMovement w tid cr = case cr ^. crType of
HoverCrit {} -> fromMaybe cr $ do
txy <- w ^? cWorld . lWorld . creatures . ix tid . crPos . _xy
return $ crMvAbsolute (w ^. cWorld . lWorld) (5 *^ normalizeV (cr ^. crPos . _xy - txy)) cr
return $ crMvAbsolute w (5 *^ normalizeV (cr ^. crPos . _xy - txy)) cr
ChaseCrit {} -> fromMaybe cr $ do
txy <- w ^? cWorld . lWorld . creatures . ix tid . crPos . _xy
return $ crMvAbsolute (w ^. cWorld . lWorld) (5 *^ normalizeV (txy - cr ^. crPos . _xy)) cr
return $ crMvAbsolute w (5 *^ normalizeV (txy - cr ^. crPos . _xy)) cr
_ -> cr
setBeeRandomMovement :: Int -> World -> World
src/Dodge/Creature/Impulse/Movement.hs
+10 -10
View File
@@ -25,26 +25,26 @@ The idea is that this may or may not work, depending on the status of the creatu
For now, though, this cannot fail.
p is the movement translation vector, will be made relative to creature direction
-}
crMvBy :: Point2 -> LWorld -> Creature -> Creature
crMvBy :: Point2 -> World -> Creature -> Creature
crMvBy p lw cr = crMvAbsolute lw (rotateV (_crDir cr) p) cr
-- | p is the movement translation vector, made relative to creature direction
crWalk :: Point2 -> LWorld -> Creature -> Creature
crWalk :: Point2 -> World -> Creature -> Creature
crWalk p lw cr = crWalkAbsolute lw (rotateV (_crDir cr) p) cr
-- | p is the movement translation vector, made relative to creature direction
crMvByNoStride :: Point2 -> LWorld -> Creature -> Creature
crMvByNoStride :: Point2 -> World -> Creature -> Creature
crMvByNoStride p lw cr = crMvAbsoluteNoStride lw (rotateV (_crDir cr) p) cr
crMvAbsolute :: LWorld -> Point2 -> Creature -> Creature
crMvAbsolute lw p' cr =
crMvAbsolute :: World -> Point2 -> Creature -> Creature
crMvAbsolute w p' cr =
cr
& crPos . _xy +~ p
& crMvDir .~ argV (p + cr ^. crOldPos . _xy - cr ^. crOldOldPos . _xy)
where
p = strengthFactor (getCrMoveSpeed lw cr) *^ p'
p = strengthFactor (getCrMoveSpeed w cr) *^ p'
crWalkAbsolute :: LWorld -> Point2 -> Creature -> Creature
crWalkAbsolute :: World -> Point2 -> Creature -> Creature
crWalkAbsolute lw p' cr
| Walking <- cr ^. crStance . carriage = cr
& crPos . _xy +~ p
@@ -53,7 +53,7 @@ crWalkAbsolute lw p' cr
where
p = strengthFactor (getCrMoveSpeed lw cr) *.* p'
crMvAbsoluteNoStride :: LWorld -> Point2 -> Creature -> Creature
crMvAbsoluteNoStride :: World -> Point2 -> Creature -> Creature
crMvAbsoluteNoStride lw p' cr = cr & crPos . _xy +~ p
where
p = strengthFactor (getCrMoveSpeed lw cr) *.* p'
@@ -64,7 +64,7 @@ strengthFactor i
| i < 1 = 0
| otherwise = 0.02 * fromIntegral i
crMvForward' :: LWorld -> Creature -> Creature
crMvForward' :: World -> Creature -> Creature
crMvForward' lw cr = case crMvType cr of
JitMvType s _ _ -> crMvBy (V2 s 0) lw cr
StartStopMvType s _ n ->
@@ -85,7 +85,7 @@ crMvForward' lw cr = case crMvType cr of
MvWalking s -> crMvBy (V2 s 0) lw cr
crMvForward :: Float -> LWorld -> Creature -> Creature
crMvForward :: Float -> World -> Creature -> Creature
crMvForward speed = crMvBy (V2 speed 0)
creatureTurnTo :: Point2 -> Creature -> Creature
src/Dodge/Creature/Picture.hs
+24 -24
View File
@@ -40,9 +40,9 @@ drawCreature w m cr = translateSP (_crPos cr) . fallrot . rotateSP (_crDir cr) $
BarrelCrit{} -> barrelShape
LampCrit{_lampHeight = h} -> lampCrSPic h
ChaseCrit{} -> noPic $ drawChaseCrit w cr
Avatar{} -> basicCrPict m cr
SwarmCrit -> basicCrPict m cr
AutoCrit -> basicCrPict m cr
Avatar{} -> basicCrPict w m cr
SwarmCrit -> basicCrPict w m cr
AutoCrit -> basicCrPict w m cr
CrabCrit{} -> noPic $ drawCrabCrit w cr
HoverCrit{} -> noPic $ drawHoverCrit cr
SlinkCrit{} -> noPic $ drawSlinkCrit cr
@@ -67,15 +67,15 @@ drawSlimeCrit cr =
guard $ length qs == 12
return $ zipWith (+) (fmap (0.1 * (10 - x) *^) so) (fmap (0.1 * x *^) qs)
basicCrPict :: IM.IntMap Item -> Creature -> SPic
basicCrPict m cr = drawEquipment m cr <> noPic (basicCrShape cr)
basicCrPict :: World -> IM.IntMap Item -> Creature -> SPic
basicCrPict w m cr = drawEquipment w m cr <> noPic (basicCrShape w cr)
basicCrShape :: Creature -> Shape
basicCrShape cr =
basicCrShape :: World -> Creature -> Shape
basicCrShape w cr =
scaleSH (V3 crsize crsize crsize) $
mconcat
[ colorSH (_skinHead cskin) . overPosSH (translateToES cr OnHead) $ scalp
, colorSH (_skinUpper cskin) $ upperBody cr
[ colorSH (_skinHead cskin) . overPosSH (translateToES w cr OnHead) $ scalp
, colorSH (_skinUpper cskin) $ upperBody w cr
, rotmdir $ colorSH (_skinLower cskin) $ feet cr
]
where
@@ -294,8 +294,8 @@ spiderJoint p q = (f $ Q.axisAngle (V3 0 (-1) 0) (pi - (a + b)), f . Q.axisAngle
-- c = argV $ (p-q) ^. _xy
-- f x = Q.qz c * x
makeCorpse :: StdGen -> Creature -> SPic
makeCorpse g cr = case cr ^. crType of
makeCorpse :: World -> StdGen -> Creature -> SPic
makeCorpse w g cr = case cr ^. crType of
HoverCrit{} -> noPic $ drawHoverCrit cr
ChaseCrit{} -> noPic $ chaseCorpse g cr
CrabCrit{} -> noPic $ crabCorpse g cr
@@ -305,7 +305,7 @@ makeCorpse g cr = case cr ^. crType of
. scaleSH (V3 crsize crsize crsize)
$ mconcat
[ colorSH (_skinHead cskin) $ deadScalp cr
, colorSH (_skinUpper cskin) $ deadUpperBody cr
, colorSH (_skinUpper cskin) $ deadUpperBody w cr
, rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
]
where
@@ -375,12 +375,12 @@ deadFeet :: Creature -> Shape
{-# INLINE deadFeet #-}
deadFeet = feet
arms :: Creature -> Shape
arms :: World -> Creature -> Shape
{-# INLINE arms #-}
arms cr =
arms w cr =
(^. _1) $
translateToRightHand cr aHand
<> translateToLeftHand cr aHand
translateToRightHand w cr aHand
<> translateToLeftHand w cr aHand
where
aHand = noPic $ translateSHz (-2) . upperPrismPolyHalfST 2 $ polyCirc 3 4
@@ -404,28 +404,28 @@ scalp =
(colorSH (greyN 0.9) . upperPrismPolyHalfST 5 $ polyCirc 3 5)
& each . sfShadowImportance .~ Unimportant
torso :: Creature -> Shape
torso :: World -> Creature -> Shape
{-# INLINE torso #-}
torso cr = overPosSH (translateToES cr OnBack) tsh
torso w cr = overPosSH (translateToES w cr OnBack) tsh
where
tsh = ashoulder 3 (-0.2) <> ashoulder (-3) 0.2
ashoulder y a = translateSHxy 0 y . rotateSH a $ scaleSH (V3 10 10 1) baseShoulder
deadUpperBody :: Creature -> Shape
deadUpperBody cr = deadRot cr . translateSHz (negate 10) . upperBody $ cr
deadUpperBody :: World -> Creature -> Shape
deadUpperBody w cr = deadRot cr . translateSHz (negate 10) . upperBody w $ cr
baseShoulder :: Shape
{-# INLINE baseShoulder #-}
-- baseShoulder = translateSHz (-20) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1
baseShoulder = scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1
upperBody :: Creature -> Shape
upperBody :: World -> Creature -> Shape
{-# INLINE upperBody #-}
upperBody cr = arms cr <> torso cr
upperBody w cr = arms w cr <> torso w cr
drawEquipment :: IM.IntMap Item -> Creature -> SPic
drawEquipment :: World -> IM.IntMap Item -> Creature -> SPic
{-# INLINE drawEquipment #-}
drawEquipment m cr = foldMap (itemEquipPict cr) (invDT . fmap (\i -> m ^?! ix i) $ _crInv cr)
drawEquipment w m cr = foldMap (itemEquipPict w cr) (invDT . fmap (\i -> m ^?! ix i) $ _crInv cr)
barrelShape :: SPic
barrelShape = noPic $ cylinderPoly Medium Important (map (addZ 20) ps) (map (addZ 0) ps)
src/Dodge/Creature/State.hs
+9 -9
View File
@@ -83,7 +83,7 @@ jitterPain cr w
where
dojitter x y =
let (p, g) = runState (randInCirc x) (_randGen w)
in w & cWorld . lWorld . creatures . ix (_crID cr) %~ crMvByNoStride p (w ^. cWorld . lWorld)
in w & cWorld . lWorld . creatures . ix (_crID cr) %~ crMvByNoStride p w
& cWorld . lWorld . creatures . ix (_crID cr) . crPain -~ y
& randGen .~ g
@@ -161,7 +161,7 @@ copierItemUpdate itm cr w = fromMaybe w $ do
x <- itm ^? itScroll . itsInt
invid <- itm ^? itLocation . ilInvID
ip <- itm ^? itType . ibtPathing
i <- getInventoryPath x ip (_unNInt invid) cr
i <- getInventoryPath w x ip (_unNInt invid) cr
itm' <- cr ^? crInv . ix (NInt i) >>= \k -> w ^? cWorld . lWorld . items . ix k
v <- getItemValue itm' w cr
return $ w & pointerToItem itm . itUse . uValue .~ v
@@ -251,7 +251,7 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d
, _lpOrigin = CrWeaponO $ cr ^. crID
}
where
o = locOrient loc cr
o = locOrient w loc cr
itmtree = loc ^. locDT
(p, q) = o `Q.comp` (V3 5 0 0, Q.qid)
x = 1
@@ -264,19 +264,19 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d
itid = itm ^. itID . unNInt
shineTorch :: Creature -> LocationDT OItem -> World -> World
shineTorch cr loc = fromMaybe id $ do
shineTorch cr loc w = fromMaybe w $ do
mag <- find (isammolink . (^. dtValue . _2)) (itmtree ^. dtLeft)
i <- mag ^. dtValue . _1 . itConsumables
-- guard $ crIsAiming cr
guard $ i >= x
itid <- mag ^? dtValue . _1 . itID . unNInt
return $
(cWorld . lWorld . lights .:~ LSParam pos 150 0.3)
. (cWorld . lWorld . lights .:~ LSParam (pos + V3 0 0 15) 50 0.3)
. (cWorld . lWorld . items . ix itid . itConsumables . _Just -~ x)
return $ w
& (cWorld . lWorld . lights .:~ LSParam pos 150 0.3)
& (cWorld . lWorld . lights .:~ LSParam (pos + V3 0 0 15) 50 0.3)
& (cWorld . lWorld . items . ix itid . itConsumables . _Just -~ x)
where
itmtree = loc ^. locDT
(p, q) = locOrient loc cr
(p, q) = locOrient w loc cr
x = 10
isammolink AmmoMagSF{} = True
isammolink _ = False
src/Dodge/Creature/Statistics.hs
+8 -6
View File
@@ -6,6 +6,7 @@ module Dodge.Creature.Statistics (
-- crIntelligence,
) where
import Dodge.Data.World
import Dodge.Data.Equipment.Misc
import qualified Data.Map.Strict as M
import NewInt
@@ -53,8 +54,8 @@ crStrength cr = case cr ^. crType of
-- BeeCrit{} -> 20
getCrMoveSpeed :: LWorld -> Creature -> Int
getCrMoveSpeed lw cr = strFromHeldItem lw cr + strFromEquipment lw cr + crStrength cr
getCrMoveSpeed :: World -> Creature -> Int
getCrMoveSpeed w cr = strFromHeldItem w cr + strFromEquipment (w^.cWorld.lWorld) cr + crStrength cr
strFromEquipment :: LWorld -> Creature -> Int
strFromEquipment lw = sum . fmap equipmentStrValue . crCurrentEquipment lw
@@ -70,12 +71,13 @@ crCurrentEquipment lw = fmap f . _crEquipment
where
f i = lw ^?! items . ix (_unNInt i)
strFromHeldItem :: LWorld -> Creature -> Int
strFromHeldItem lw cr = fromMaybe 0 $ do
strFromHeldItem :: World -> Creature -> Int
strFromHeldItem w cr = fromMaybe 0 $ do
Aiming {} <- cr ^? crStance . posture
is <- cr ^? crManipulation . manObject . imAttachedItems
is <- w^?hud . manObject . imAttachedItems
--revise1 is <- cr ^? crManipulation . manObject . imAttachedItems
let js = IM.elems $ IM.restrictKeys (cr ^. crInv . unNIntMap) is
return . negate . sum . fmap itemWeight $ IM.restrictKeys (lw ^. items) $ IS.fromList js
return . negate . sum . fmap itemWeight $ IM.restrictKeys (w ^.cWorld.lWorld. items) $ IS.fromList js
itemWeight :: Item -> Int
itemWeight it = case it ^. itType of
src/Dodge/Creature/Test.hs
+11 -10
View File
@@ -84,24 +84,25 @@ crAwayFromPost cr = case _apGoal $ _crActionPlan cr of
SentinelAt p _ -> dist p (cr ^. crPos . _xy) > 15
_ -> False
crInAimStance :: AimStance -> Creature -> Bool
crInAimStance as cr = cr ^? crStance . posture == Just Aiming
&& cr ^? crManipulation . manObject . imAimStance == Just as
crInAimStance :: AimStance -> World -> Creature -> Bool
crInAimStance as w cr = cr ^? crStance . posture == Just Aiming
&& w ^? hud . manObject . imAimStance == Just as
--revise1 && cr ^? crManipulation . manObject . imAimStance == Just as
oneH :: Creature -> Bool
oneH :: World -> Creature -> Bool
oneH = crInAimStance OneHand
twoFlat :: Creature -> Bool
twoFlat :: World -> Creature -> Bool
twoFlat = crInAimStance TwoHandFlat
twists :: Creature -> Bool
twists :: World -> Creature -> Bool
twists = crInAimStance TwoHandTwist
-- the use of crOldPos is because the damage position is calculated on the
-- previous frame
-- Not sure if it is a good idea
crIsArmouredFrom :: IM.IntMap Item -> Point2 -> Creature -> Bool
crIsArmouredFrom m p cr = fromMaybe False $ do
crIsArmouredFrom :: IM.IntMap Item -> Point2 -> World -> Creature -> Bool
crIsArmouredFrom m p w cr = fromMaybe False $ do
NInt itid <- cr ^? crEquipment . ix OnChest
ittype <- m ^? ix itid . itType
return $
@@ -112,8 +113,8 @@ crIsArmouredFrom m p cr = fromMaybe False $ do
where
-- even though angleVV can generate NaN, the comparison seems to deal with it
frontarmdirection
| crInAimStance OneHand cr = 0.5
| crInAimStance TwoHandTwist cr = negate 1
| crInAimStance OneHand w cr = 0.5
| crInAimStance TwoHandTwist w cr = negate 1
| otherwise = 0
--crOnSeg :: Point2 -> Point2 -> Creature -> Bool
src/Dodge/Creature/Update.hs
+1 -1
View File
@@ -534,7 +534,7 @@ corpseOrGib cr w =
.~ g
cid = cr ^. crID
sethp x = cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ x
thecorpse = makeCorpse (w ^. randGen) cr
thecorpse = makeCorpse w (w ^. randGen) cr
scorchSPic :: SPic -> SPic
scorchSPic = _1 %~ overColSH (mixColors 0.9 0.1 black . normalizeColor)
src/Dodge/Creature/YourControl.hs
+15 -19
View File
@@ -38,7 +38,8 @@ handleHotkeys :: World -> World
handleHotkeys w
| ispressed SDL.ScancodeLShift || ispressed SDL.ScancodeRShift
, (hk : _) <- mapMaybe scancodeToHotkey . M.keys $ pkeys
, Just invid <- lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
, Just invid <- w ^? hud . manObject . imSelectedItem
--revise1 , Just invid <- lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
, Just itid <- lw ^? creatures . ix 0 . crInv . ix invid =
w & cWorld . lWorld %~ assignHotkey (NInt itid) hk
| ispressed SDL.ScancodeLCtrl || ispressed SDL.ScancodeRCtrl
@@ -106,7 +107,7 @@ scancodeToHotkey = \case
wasdWithAiming :: World -> Creature -> Creature
wasdWithAiming w cr
| Walking <- cr ^. crStance . carriage
= wasdAim inp w $ wasdMovement (w ^. cWorld . lWorld) inp cam speed cr
= wasdAim inp w $ wasdMovement w inp cam speed cr
| otherwise = cr
where
speed = _mvSpeed $ crMvType cr
@@ -118,7 +119,7 @@ wasdAim inp w cr
| SDL.ButtonRight `M.member` _mouseButtons inp
, AtEase <- cr ^. crStance . posture =
setposture Aiming (-twoHandTwistAmount)
| SDL.ButtonRight `M.member` _mouseButtons inp = aimTurn (w ^. cWorld . lWorld) mousedir cr
| SDL.ButtonRight `M.member` _mouseButtons inp = aimTurn w mousedir cr
| Aiming{} <- cr ^. crStance . posture = setposture AtEase twoHandTwistAmount
-- | otherwise = creatureTurnTowardDir (_crMvAim cr) 0.2 cr
| otherwise = creatureTurnTowardDir (_crMvDir cr) 0.2 cr
@@ -126,7 +127,8 @@ wasdAim inp w cr
setposture x r =
cr
& crStance . posture .~ x
& doAimTwist (cr ^? crManipulation . manObject . imAimStance) r
& doAimTwist (w ^? hud . manObject . imAimStance) r
--revise1 & doAimTwist (cr ^? crManipulation . manObject . imAimStance) r
mousedir = argV $ w ^. cWorld . lWorld . lAimPos - (cr ^. crPos . _xy)
doAimTwist :: Maybe AimStance -> Float -> Creature -> Creature
@@ -137,8 +139,8 @@ doAimTwist as x
twoHandTwistAmount :: Float
twoHandTwistAmount = 1.6 * pi
wasdMovement :: LWorld -> Input -> Camera -> Float -> Creature -> Creature
wasdMovement lw inp cam speed = theMovement -- . setMvAim
wasdMovement :: World -> Input -> Camera -> Float -> Creature -> Creature
wasdMovement w inp cam speed = theMovement -- . setMvAim
where
-- setMvAim = fromMaybe id $ do
-- dir <- safeArgV movDir
@@ -147,14 +149,15 @@ wasdMovement lw inp cam speed = theMovement -- . setMvAim
movAbs = rotateV (cam ^. camRot) $ normalizeV movDir
theMovement
| movDir == V2 0 0 = id
| otherwise = crMvAbsolute lw (speed *^ movAbs)
| otherwise = crMvAbsolute w (speed *^ movAbs)
aimTurn :: LWorld -> Float -> Creature -> Creature
aimTurn :: World -> Float -> Creature -> Creature
aimTurn lw a cr = creatureTurnTowardDir a (x * 0.2) cr
where
x = fromMaybe 1 $ do
itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
fmap itemBulkiness $ cr ^? crInv . ix itRef >>= \k -> lw ^? items . ix k . itType
itRef <- lw ^? hud . manObject . imRootSelectedItem
--revise1 itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
fmap itemBulkiness $ cr ^? crInv . ix itRef >>= \k -> lw ^?cWorld.lWorld. items . ix k . itType
itemBulkiness :: ItemType -> Float
itemBulkiness = \case
@@ -209,14 +212,7 @@ tryClickUse pkeys w = fromMaybe w $ do
ltime <- pkeys ^? ix SDL.ButtonLeft
rtime <- pkeys ^? ix SDL.ButtonRight
guard $ ltime <= rtime
case w
^? cWorld
. lWorld
. creatures
. ix 0
. crManipulation
. manObject
. imSelectedItem
. unNInt of
case w ^?hud. manObject . imSelectedItem . unNInt of
--revise1 case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem . unNInt of
Just invid -> useItem invid ltime w
Nothing -> interactWithCloseObj <$> getSelectedCloseObj w ?? w
src/Dodge/Data/Creature.hs
+1 -1
View File
@@ -42,7 +42,7 @@ data Creature = Creature
, _crID :: Int
, _crHP :: CrHP
, _crInv :: NewIntMap InvInt Int
, _crManipulation :: Manipulation
-- , _crManipulation :: Manipulation
, _crEquipment :: M.Map EquipSite (NewInt ItmInt)
, _crDamage :: [Damage]
, _crPain :: Int
src/Dodge/Data/HUD.hs
+2
View File
@@ -3,6 +3,7 @@
module Dodge.Data.HUD where
import Dodge.Data.Item.Use.Consumption.LoadAction
import Control.Lens
import Dodge.Data.Combine
import Dodge.Data.Item.Location
@@ -33,6 +34,7 @@ data HUD = HUD
, _diCloseFilter :: Maybe String
, _closeItems :: [NewInt ItmInt]
, _closeButtons :: [Int]
, _manObject :: ManipulatedObject
}
data Selection = Sel {_slSec :: Int, _slInt :: Int}
src/Dodge/Data/Item/Use/Consumption/LoadAction.hs
+6 -6
View File
@@ -12,10 +12,10 @@ import Data.Aeson
import Data.Aeson.TH
--import Sound.Data
data Manipulation -- should be ManipulatedObject?
= Manipulator {_manObject :: ManipulatedObject }
| Brute
deriving (Eq, Ord, Show, Read) --Generic, Flat)
--data Manipulation -- should be ManipulatedObject?
-- = Manipulator {_manObject :: ManipulatedObject }
-- | Brute
-- deriving (Eq, Ord, Show, Read) --Generic, Flat)
data ManipulatedObject
= SortInventory
@@ -33,6 +33,6 @@ data ManipulatedObject
deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''ManipulatedObject
makeLenses ''Manipulation
--makeLenses ''Manipulation
deriveJSON defaultOptions ''ManipulatedObject
deriveJSON defaultOptions ''Manipulation
--deriveJSON defaultOptions ''Manipulation
src/Dodge/Debug.hs
+3 -2
View File
@@ -320,12 +320,13 @@ drawCreatureRad cr = setLayer DebugLayer
showMuzzlePositions :: Universe -> Picture
showMuzzlePositions u = fold $ do
cr <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0
invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt
invid <- u ^?uvWorld.hud . manObject . imRootSelectedItem . unNInt
--revise1 invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt
loc <- invIndents ((\k -> u ^?! uvWorld . cWorld . lWorld . items . ix k) <$> _crInv cr)
^? ix invid . _2
return . color red $ setLayer DebugLayer $ reduceLocDT (f cr) loc
where
f cr loc = foldMap (g . muzzlePos loc cr) (itemMuzzles loc)
f cr loc = foldMap (g . muzzlePos (u^.uvWorld) loc cr) (itemMuzzles loc)
where
g :: Point3Q -> Picture
g pq = translate3 (pq ^. _1) $ crossPic 5
src/Dodge/Default/Creature.hs
-1
View File
@@ -27,7 +27,6 @@ defaultCreature =
, _crHP = HP 100
-- , _crMaxHP = 150
, _crInv = mempty
, _crManipulation = Manipulator SelNothing
-- , _crInvCapacity = 25
, _crDamage = []
-- , _crCorpse = MakeDefaultCorpse
src/Dodge/Default/World.hs
+1
View File
@@ -182,4 +182,5 @@ defaultHUD =
, _diCloseFilter = mempty
, _closeItems = mempty
, _closeButtons = mempty
, _manObject = SelNothing
}
src/Dodge/Euse.hs
+3 -3
View File
@@ -62,12 +62,12 @@ useMagShield mt _ cr w =
-- _ -> w
createHeadLamp :: Item -> Creature -> World -> World
createHeadLamp _ cr =
createHeadLamp _ cr w = w &
cWorld
. lWorld
. lights
.:~ LSParam
(_crPos cr + rotate3z (_crDir cr) (translateToES cr OnHead (V3 5 0 3)))
(_crPos cr + rotate3z (_crDir cr) (translateToES w cr OnHead (V3 5 0 3)))
200
0.7
@@ -122,7 +122,7 @@ setWristShieldPos itm cr esite w = w & moveWallIDUnsafe i wlline
. itLocation
. ilEquipSite
. _Just of
Just x -> translateToES cr x -- . g
Just x -> translateToES w cr x -- . g
_ -> undefined
-- g
-- | twists cr = (+.+.+ V3 (-5) 10 0)
src/Dodge/HeldUse.hs
+16 -15
View File
@@ -484,12 +484,12 @@ applySoundCME itm cr = fromMaybe id $ do
cid = _crID cr
applyRecoil :: LocationDT OItem -> Creature -> World -> World
applyRecoil loc cr =
applyRecoil loc cr w = w &
cWorld . lWorld . creatures . ix (_crID cr) . crPos . _xy
+~ rotateV (_crDir cr + Q.qToAng q) (V2 ((- recoilAmount itm) / crMass (_crType cr)) 0)
where
itm = loc ^. locDT . dtValue . _1
(_, q) = locOrient loc cr
(_, q) = locOrient w loc cr
recoilAmount :: Item -> Float
recoilAmount itm
@@ -777,29 +777,29 @@ useLoadedAmmo loc cr mz m w =
MuzzleScroller -> useTimeScrollGun itm cr w
where
o = CrWeaponO $ cr ^. crID
pq = muzzlePos loc cr mz
(pq', g) = muzzleRandPos loc cr mz `runState` (w ^. randGen)
pq = muzzlePos w loc cr mz
(pq', g) = muzzleRandPos w loc cr mz `runState` (w ^. randGen)
itmtree = loc ^. locDT
mitid = magtree ^. dtValue . _1 . itID
itm = itmtree ^. dtValue . _1
(x, magtree) = fromJust m
muzzlePos :: LocationDT OItem -> Creature -> Muzzle -> Point3Q
muzzlePos m cr muz = (p1, q1) `Q.comp` pq `Q.comp` (p3, q3)
muzzlePos :: World -> LocationDT OItem -> Creature -> Muzzle -> Point3Q
muzzlePos w m cr muz = (p1, q1) `Q.comp` pq `Q.comp` (p3, q3)
where
pq = locOrient m cr
pq = locOrient w m cr
p1 = cr ^. crPos
q1 = Q.qz $ cr ^. crDir
p3 = addZ 0 $ muz ^. mzPos
q3 = Q.qz $ muz ^. mzRot
muzzleRandPos :: LocationDT OItem -> Creature -> Muzzle -> State StdGen Point3Q
muzzleRandPos m cr muz = do
muzzleRandPos :: World -> LocationDT OItem -> Creature -> Muzzle -> State StdGen Point3Q
muzzleRandPos w m cr muz = do
a <- state $ randomR (- inacc, inacc)
y <- case muz ^. mzRandomOffset of
0 -> return 0
i -> state $ randomR (- i, i)
return $ muzzlePos m cr muz `Q.comp` (V3 0 y 0, Q.qz a)
return $ muzzlePos w m cr muz `Q.comp` (V3 0 y 0, Q.qz a)
where
inacc = _mzInaccuracy muz
@@ -1004,7 +1004,7 @@ shootBullets loc cr (mz, x, magtree) w = fromMaybe w $ do
shootBullet :: Bullet -> LocationDT OItem -> Creature -> Muzzle -> World -> World
shootBullet bu loc cr mz w = makeBullet bu itm pq . (randGen .~ g) $ w
where
(pq, g) = muzzleRandPos loc cr mz `runState` (w ^. randGen)
(pq, g) = muzzleRandPos w loc cr mz `runState` (w ^. randGen)
itm = loc ^. locDT . dtValue . _1
makeBullet :: Bullet -> Item -> Point3Q -> World -> World
@@ -1384,10 +1384,10 @@ dropInventoryPath ::
Creature ->
World ->
World
dropInventoryPath i ip loc cr = fromMaybe id $ do
dropInventoryPath i ip loc cr w = fromMaybe w $ do
invid <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
j <- getInventoryPath i ip invid cr
return $ dropItem cr j
j <- getInventoryPath w i ip invid cr
return $ dropItem cr j w
--dropInventoryPath i ip loc cr w = case ip of
-- ABSOLUTE -> fromMaybe w $ do
@@ -1421,7 +1421,8 @@ useInventoryPath pt i ip loc cr w = case ip of
guard $ i `IM.member` (cr ^. crInv . unNIntMap)
return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem i pt)
RELCURS -> fromMaybe w $ do
j <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
j <- w ^? hud . manObject . imSelectedItem . unNInt
--revise1 j <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
guard $ (i + j) `IM.member` (cr ^. crInv . unNIntMap)
return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt)
RELITEM -> fromMaybe w $ do
src/Dodge/Inventory.hs
+13 -15
View File
@@ -90,9 +90,11 @@ rmInvItem cid invid w =
& cWorld . lWorld . items . ix itid . itLocation . ilEquipSite .~ Nothing
& updateselection
& updateselectionextra
& pointcid %~ updateRootItemID (w ^. cWorld . lWorld . items)
& uprootitem
--revise1 & pointcid %~ updateRootItemID (w ^. cWorld . lWorld . items)
& worldEventFlags . at InventoryChange ?~ ()
where
uprootitem w' = updateRootItemID (w ^. cWorld . lWorld . items) (w'^?!cWorld.lWorld.creatures.ix 0) w'
pointcid = cWorld . lWorld . creatures . ix cid
updateselectionextra
-- | cid == 0 = hud . diSelection . _Just . slSet %~ IS.foldl' h mempty
@@ -101,10 +103,9 @@ rmInvItem cid invid w =
-- | i < _unNInt invid = IS.insert i x
-- | otherwise = x
updateselection
| cid == 0 && cr ^? crManipulation . manObject . imSelectedItem == Just invid =
| cid == 0 && w ^? hud . manObject . imSelectedItem == Just invid =
scrollAugInvSel (-1) . scrollAugInvSel 1
| otherwise =
pointcid . crManipulation . manObject . imSelectedItem %~ g
| otherwise = hud . manObject . imSelectedItem %~ g
cr = w ^?! cWorld . lWorld . creatures . ix cid
itid = _crInv cr ^?! ix invid
itm = w ^?! cWorld . lWorld . items . ix itid
@@ -265,14 +266,8 @@ changeSwapOther manlens n f i w = fromMaybe w $ do
return $
w
& swapAnyExtraSelection 3 i k
& cWorld
. lWorld
. creatures
. ix 0
. crManipulation
. manObject
. manlens
%~ doswap
&hud. manObject . manlens %~ doswap
--revise1 & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . manlens %~ doswap
& hud . closeItems %~ swapIndices i k
& hud . diSelection . _Just . slInt %~ doswap
& worldEventFlags . at InventoryChange ?~ ()
@@ -299,7 +294,8 @@ invSetSelection sel w =
& hud . diSelection ?~ sel
& worldEventFlags . at InventoryChange ?~ ()
& setInvPosFromSS
& cWorld . lWorld %~ crUpdateItemLocations 0
& crUpdateItemLocations 0
--revise1 & cWorld . lWorld %~ crUpdateItemLocations 0
invSetSelectionPos :: Int -> Int -> World -> World
invSetSelectionPos i j = invSetSelection (Sel i j)
@@ -312,7 +308,8 @@ scrollAugInvSel yi w
& hud %~ doscroll
& worldEventFlags . at InventoryChange ?~ ()
& setInvPosFromSS
& cWorld . lWorld %~ crUpdateItemLocations 0
& crUpdateItemLocations 0
--revise1 & cWorld . lWorld %~ crUpdateItemLocations 0
where
doscroll he = fromMaybe he $ do
sss <- he ^? diSections
@@ -324,7 +321,8 @@ scrollAugNextInSection w =
& hud %~ doscroll
& worldEventFlags . at InventoryChange ?~ ()
& setInvPosFromSS
& cWorld . lWorld %~ crUpdateItemLocations 0
& crUpdateItemLocations 0
--revise1 & cWorld . lWorld %~ crUpdateItemLocations 0
where
doscroll he = fromMaybe he $ do
sss <- he ^? diSections
src/Dodge/Inventory/Add.hs
+2 -1
View File
@@ -36,7 +36,8 @@ tryPutItemInInv mcipos cid itid w = do
}
return $ (invid,) $
w
& cWorld . lWorld %~ crUpdateItemLocations cid
& crUpdateItemLocations cid
--revise1 & cWorld . lWorld %~ crUpdateItemLocations cid
-- not sure about the order of these...
& cWorld . lWorld . creatures . ix cid . crInv . at invid ?~ itid
& cWorld . lWorld . items . ix itid . itLocation .~ itloc
src/Dodge/Inventory/Location.hs
+21 -26
View File
@@ -39,42 +39,36 @@ getRootItemInvID m i cr = fromMaybe i $ do
theroot <- adj ^? ix i
theroot ^? _1 . _Just . _1
updateRootItemID :: IM.IntMap Item -> Creature -> Creature
updateRootItemID m cr = fromMaybe cr $ do
i <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
updateRootItemID :: IM.IntMap Item -> Creature -> World -> World
updateRootItemID m cr w = fromMaybe w $ do
i <- w^?hud . manObject . imSelectedItem . unNInt
let j = getRootItemInvID m i cr
return $ cr & crManipulation . manObject . imRootSelectedItem .~ NInt j
return $ w & hud . manObject . imRootSelectedItem .~ NInt j
-- the following assumes that the crManipulation is correct
crUpdateItemLocations :: Int -> LWorld -> LWorld
crUpdateItemLocations :: Int -> World -> World
crUpdateItemLocations crid lw = fromMaybe lw $ do
mo <- lw ^? creatures . ix crid . crManipulation . manObject
cinv <- lw ^? creatures . ix crid . crInv
let crinv = fmap (\k -> lw ^?! items . ix k) cinv
mo <- lw ^? hud . manObject
cinv <- lw ^? cWorld.lWorld.creatures . ix crid . crInv
let crinv = fmap (\k -> lw ^?! cWorld.lWorld.items . ix k) cinv
return $ crSetRoots crid $ IM.foldlWithKey' (crUpdateInvidLocations mo crid) lw $ _unNIntMap crinv
crSetRoots :: Int -> LWorld -> LWorld
crSetRoots :: Int -> World -> World
crSetRoots cid w = fromMaybe w $ do
inv <- w ^? creatures . ix cid . crInv
let cinv = invIMDT $ fmap (\i -> w ^?! items . ix i) inv
inv <- w ^? cWorld .lWorld. creatures . ix cid . crInv
let cinv = invIMDT $ fmap (\i -> w ^?! cWorld.lWorld.items . ix i) inv
return $ foldl' f (foldl' g w inv) cinv
where
g w' i = w' & items . ix i . itLocation . ilIsRoot .~ False
f :: LWorld -> DTree OItem -> LWorld
g w' i = w' &cWorld.lWorld.items . ix i . itLocation . ilIsRoot .~ False
f :: World -> DTree OItem -> World
f w' x =
w' & items . ix (x ^. dtValue . _1 . itID . unNInt) . itLocation . ilIsRoot .~ True
w' &cWorld.lWorld.items . ix (x ^. dtValue . _1 . itID . unNInt) . itLocation . ilIsRoot .~ True
crUpdateInvidLocations ::
ManipulatedObject ->
Int ->
LWorld ->
Int ->
Item ->
LWorld
crUpdateInvidLocations :: ManipulatedObject -> Int -> World -> Int -> Item -> World
crUpdateInvidLocations mo crid lw invid itm =
lw
& creatures . ix crid . crInv . ix (NInt invid) .~ itid
& items . ix itid .~ (itm & itLocation .~ newloc)
&cWorld.lWorld.creatures . ix crid . crInv . ix (NInt invid) .~ itid
&cWorld.lWorld.items . ix itid .~ (itm & itLocation .~ newloc)
where
itid = itm ^. itID . unNInt
newloc =
@@ -84,15 +78,16 @@ crUpdateInvidLocations mo crid lw invid itm =
, _ilIsRoot = Just (NInt invid) == mo ^? imRootSelectedItem
, _ilIsSelected = Just (NInt invid) == mo ^? imSelectedItem
, _ilIsAttached = invid `IS.member` (mo ^. imAttachedItems)
, _ilEquipSite = lw ^? items . ix itid . itLocation . ilEquipSite . _Just
, _ilEquipSite = lw ^? cWorld .lWorld. items . ix itid . itLocation . ilEquipSite . _Just
--revise1 , _ilEquipSite = lw ^? items . ix itid . itLocation . ilEquipSite . _Just
}
-- this should be looked at, as it is sometimes used in functions that need not
-- concern the player creature
-- this might not work if the selpos is in the inventory but too large
setInvPosFromSS :: World -> World
setInvPosFromSS w = w
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel
setInvPosFromSS w = w &hud . manObject .~ thesel
--revise1 & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel
where
thesel = fromMaybe SelNothing $ do
--Sel i j _ <- w ^? hud . diSelection . _Just
src/Dodge/Inventory/Path.hs
+5 -3
View File
@@ -1,16 +1,18 @@
module Dodge.Inventory.Path (getInventoryPath) where
import Dodge.Data.World
import NewInt
import Dodge.Data.Creature
import qualified Data.IntMap.Strict as IM
import Control.Lens
import Control.Monad
getInventoryPath :: Int -> InventoryPathing -> Int -> Creature -> Maybe Int
getInventoryPath x ip itid cr = case ip of
getInventoryPath :: World -> Int -> InventoryPathing -> Int -> Creature -> Maybe Int
getInventoryPath w x ip itid cr = case ip of
ABSOLUTE -> checkinvid x
RELCURS -> do
selid <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
selid <- w ^? hud . manObject . imSelectedItem . unNInt
--revise1 selid <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
checkinvid (x + selid)
RELITEM -> checkinvid (itid + x)
where
src/Dodge/Inventory/RBList.hs
+1 -1
View File
@@ -24,7 +24,7 @@ updateRBList w = case w ^. rbState of
_ | norightclick -> w & rbState .~ NoRightButtonState
EquipOptions{} -> w
_ -> fromMaybe (w & rbState .~ NoRightButtonState) $ do
i <- cr ^? crManipulation . manObject . imSelectedItem
i <- w^?hud . manObject . imSelectedItem
itid <- cr ^? crInv . ix i
itm <- w ^? cWorld . lWorld . items . ix itid
etype <- equipType itm
src/Dodge/Inventory/Swap.hs
+6 -3
View File
@@ -37,19 +37,22 @@ swapInvItems f i w = fromMaybe w $ do
& swapAnyExtraSelection 0 i k
& checkConnection InventorySound disconnectItemS i k
& cWorld . lWorld . creatures . ix 0 %~ updatecreature k
& updatecreature' k
& updateselection
& worldEventFlags . at InventoryChange ?~ ()
& cWorld . lWorld %~ crUpdateItemLocations 0
& crUpdateItemLocations 0
--revise1 & cWorld . lWorld %~ crUpdateItemLocations 0
& setInvPosFromSS
& cWorld . lWorld %~ crUpdateItemLocations 0 -- the double application is inefficient, but necessary without further changes
& crUpdateItemLocations 0 -- the double application is inefficient, but necessary without further changes
-- a rethink is maybe in order
& checkConnection InventoryConnectSound connectItemS i k
where
updatecreature k =
(crInv . unNIntMap %~ IM.safeSwapKeys i k)
. (crManipulation . manObject . imSelectedItem .~ NInt k)
. swapSite i k
. swapSite k i
updatecreature' k =
(hud . manObject . imSelectedItem .~ NInt k)
cr = you w
swapSite a b = case cr ^? crInv . ix (NInt a) >>= \k -> w ^? cWorld . lWorld . items . ix k . itLocation . ilEquipSite . _Just of
Just epos -> crEquipment . ix epos .~ NInt b
src/Dodge/Item/Draw.hs
+10 -8
View File
@@ -2,6 +2,7 @@
module Dodge.Item.Draw (itemEquipPict) where
import Dodge.Data.World
import Dodge.Item.Draw.SPicTree
import Control.Lens
import Dodge.Creature.HandPos
@@ -15,13 +16,14 @@ import Geometry.Data
import qualified Quaternion as Q
import ShapePicture
itemEquipPict :: Creature -> DTree CItem -> SPic
itemEquipPict cr itmtree
itemEquipPict :: World -> Creature -> DTree CItem -> SPic
itemEquipPict w cr itmtree
| Just esite <- itm ^? itLocation . ilEquipSite . _Just
, Just attachpos <- equipAttachPos <$> itm ^? itType . ibtEquip =
equipPosition esite cr attachpos (itemSPic itm)
| itm ^? itLocation . ilInvID == cr ^? crManipulation . manObject . imRootSelectedItem =
overPosSP (Q.apply $ handHandleOrient loc cr) (itemTreeSPic itmtree)
equipPosition esite w cr attachpos (itemSPic itm)
| itm ^? itLocation . ilInvID == w ^? hud . manObject . imRootSelectedItem =
--revise1 | itm ^? itLocation . ilInvID == cr ^? crManipulation . manObject . imRootSelectedItem =
overPosSP (Q.apply $ handHandleOrient w loc cr) (itemTreeSPic itmtree)
| otherwise = mempty
where
itm = itmtree ^. dtValue . _1
@@ -35,7 +37,7 @@ equipAttachPos = \case
BULLETBELTBRACER -> (V3 (-9) 0 10, Q.qid)
_ -> (0, Q.qid)
equipPosition :: EquipSite -> Creature -> Point3Q -> SPic -> SPic
equipPosition es cr q =
equipPosition :: EquipSite -> World -> Creature -> Point3Q -> SPic -> SPic
equipPosition es w cr q =
overPosSP
(\x -> fst $ equipSitePQ es cr `Q.comp` q `Q.comp` (x, Q.qid))
(\x -> fst $ equipSitePQ es w cr `Q.comp` q `Q.comp` (x, Q.qid))
src/Dodge/Item/HeldOffset.hs
+14 -13
View File
@@ -7,6 +7,7 @@ module Dodge.Item.HeldOffset (
handHandleOrient,
) where
import Dodge.Data.World
import Dodge.Creature.HandPos
import Linear
import Dodge.Data.AimStance
@@ -49,28 +50,28 @@ handleOrient loc = case loc ^. locDT . dtValue . _1 . itType of
-- TwoHandUnder -> (V3 7 (-8) 15, Q.axisAngle (V3 0 0 1) (strideRot cr + 1.2))
-- TwoHandOver -> (V3 10 0 15, Q.axisAngle (V3 0 0 1) (strideRot cr + 1.2))
handOrient :: Creature -> AimStance -> Point3Q
handOrient cr = \case
handOrient :: World -> Creature -> AimStance -> Point3Q
handOrient w cr = \case
TwoHandTwist ->
let (rp,_) = rightHandPQ cr
(lp,_) = leftHandPQ cr
let (rp,_) = rightHandPQ w cr
(lp,_) = leftHandPQ w cr
-- in (rp,Q.qz (argV $ (lp - rp) ^. _xy))
in (rp,Q.qNoRoll (lp - rp))
OneHand -> rightHandPQ cr
OneHand -> rightHandPQ w cr
TwoHandFlat ->
let (rp,_) = rightHandPQ cr
(lp,_) = leftHandPQ cr
let (rp,_) = rightHandPQ w cr
(lp,_) = leftHandPQ w cr
in (0.5 *^ (rp + lp),Q.qz (argV (vNormal ((lp - rp) ^. _xy))))
locOrient :: LocationDT OItem -> Creature -> Point3Q
locOrient loc cr =
handHandleOrient ((\(x, y, _) -> (x, y)) <$> locToTop loc) cr
locOrient :: World -> LocationDT OItem -> Creature -> Point3Q
locOrient w loc cr =
handHandleOrient w ((\(x, y, _) -> (x, y)) <$> locToTop loc) cr
`Q.comp` (loc ^. locDT . dtValue . _3)
handHandleOrient :: LocationDT CItem -> Creature -> Point3Q
handHandleOrient loc cr =
handOrient cr (itemAimStance (l ^. locDT)) `Q.comp` handleOrient l
handHandleOrient :: World -> LocationDT CItem -> Creature -> Point3Q
handHandleOrient w loc cr =
handOrient w cr (itemAimStance (l ^. locDT)) `Q.comp` handleOrient l
where
l = locToTop loc
src/Dodge/Item/Location.hs
+4 -2
View File
@@ -25,14 +25,16 @@ import Dodge.Data.World
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 . imSelectedItem
itinvid <- w ^? hud. manObject . imSelectedItem
--revise1 itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem
itid <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid
Just $ (cWorld . lWorld . items . ix itid) f w
-- note the ilIsRoot/Selected/Attached booleans are irrelevant
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 . imRootSelectedItem
itinvid <- w ^? hud. manObject . imRootSelectedItem
--revise1 itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imRootSelectedItem
itid <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid
Just $ (cWorld . lWorld . items . ix itid) f w
src/Dodge/Projectile/Update.hs
+2 -1
View File
@@ -197,7 +197,8 @@ doBarrelSpin cid i pj w =
pjRemoteSetDirection :: RocketHoming -> Projectile -> World -> World
pjRemoteSetDirection ph pj w = case ph of
HomeUsingRemoteScreen screenid
| lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
| w ^? hud . manObject . imSelectedItem
--revise1 | w ^? hud . manObject . imSelectedItem
== lw ^? items . ix (_unNInt screenid) . itLocation . ilInvID ->
w
& pjlens
src/Dodge/Render/HUD.hs
+3 -2
View File
@@ -231,7 +231,7 @@ floorItemPickupInfo n itm
-- note the use of ^?!
-- it is probably desirable for this to crash hard for now
yourAugmentedItem :: (Item -> a) -> a -> (Either Item Button -> a) -> World -> a
yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
yourAugmentedItem f x g w = case w ^? hud . manObject of
Just (SelectedItem i _ _ _) -> f $ yourInv w ^?! ix i
Just (SelCloseItem i) -> fromMaybe x $ do
j <- w ^? hud . closeItems . ix i . unNInt
@@ -246,7 +246,8 @@ yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
drawRBOptions :: Config -> World -> Picture
drawRBOptions cfig w = fold $ do
guard $ ButtonRight `M.member` _mouseButtons (_input w)
invid <- you w ^? crManipulation . manObject . imSelectedItem
invid <- w ^? hud . manObject . imSelectedItem
--revise1 invid <- you w ^? crManipulation . manObject . imSelectedItem
itid <- you w ^? crInv . ix invid
eslist <-
fmap eqTypeToSites $
src/Dodge/TestString.hs
+2 -1
View File
@@ -122,7 +122,8 @@ testStringInit u = u ^.. uvWorld . hud . diSections . each . ssSet . to show
topTestPart :: Universe -> [String]
topTestPart u =
[ maybe "" showManObj $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
[ maybe "" showManObj $ u ^? uvWorld . hud . manObject
--revise1 [ maybe "" showManObj $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
]
showManObj :: ManipulatedObject -> String
src/Dodge/Update.hs
+3 -2
View File
@@ -350,7 +350,8 @@ pushYouOutFromWalls u
-- rotate creature as well? behaviour on ledges?
muzzleWallCheck :: World -> Creature -> Creature
muzzleWallCheck w cr = fromMaybe cr $ do
invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt
invid <- w ^? hud . manObject . imRootSelectedItem . unNInt
--revise1 invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt
loc <-
invIndents ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr)
^? ix invid . _2
@@ -368,7 +369,7 @@ muzzleWallCheck w cr = fromMaybe cr $ do
x = dotV v' v
in cr & crPos . _xy +~ min 1 x *^ v'
where
f loc = map (muzzlePos loc cr) (itemMuzzles loc)
f loc = map (muzzlePos w loc cr) (itemMuzzles loc)
g cp wls p = case collidePoint cp p wls of
(ep, Just wl) -> Just (ep - p, wl)
_ -> Nothing
src/Dodge/Update/Camera.hs
+6 -5
View File
@@ -101,7 +101,8 @@ moveZoomCamera cfig theinput cr w campos =
& camItemZoom .~ newItemZoom
where
mremotepos = do
i <- cr ^? crManipulation . manObject . imSelectedItem
i <- w^?hud . manObject . imSelectedItem
--revise1 i <- cr ^? crManipulation . manObject . imSelectedItem
itid <- cr ^? crInv . ix i
j <- w ^? cWorld . lWorld . items . ix itid . itUse . uaParams . apProjectiles . ix 0
guard $ Just REMOTESCREEN == w ^? cWorld . lWorld . items . ix itid . itType . ibtAttach
@@ -109,24 +110,24 @@ moveZoomCamera cfig theinput cr w campos =
docamrot = rotateV (campos ^. camRot)
offset = fromMaybe noscopeoffset $ do
guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
i <- cr ^? crManipulation . manObject . imSelectedItem
i <- w^?hud . manObject . imSelectedItem
itid <- cr ^? crInv . ix i
fmap docamrot (w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticPos)
noscopeoffset =
docamrot $
((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput
newzoom = fromMaybe (newDefaultZoom * newItemZoom) $ do
i <- cr ^? crManipulation . manObject . imSelectedItem
i <- w^?hud . manObject . imSelectedItem
itid <- cr ^? crInv . ix i
w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticZoom
idealDefaultZoom = clipZoom wallZoom
newDefaultZoom = fromMaybe (changeZoom (campos ^. camDefaultZoom) idealDefaultZoom) $ do
i <- cr ^? crManipulation . manObject . imSelectedItem
i <- w^?hud . manObject . imSelectedItem
itid <- cr ^? crInv . ix i
w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticZoom
idealItemZoom = fromMaybe 1 $ do
guard $ crIsAiming cr
i <- cr ^? crManipulation . manObject . imSelectedItem
i <- w^?hud . manObject . imSelectedItem
itid <- cr ^? crInv . ix i
getAimZoom <$> (w ^? cWorld . lWorld . items . ix itid)
newItemZoom = changeZoom (campos ^. camItemZoom) idealItemZoom
src/Dodge/Update/Scroll.hs
+3 -2
View File
@@ -42,13 +42,14 @@ updateBaseWheelEvent yi w
where
bdown b = w & has (input . mouseButtons . ix b)
rbscrollmax = fromMaybe 1 $ do
invid <- you w ^? crManipulation . manObject . imSelectedItem
invid <- w ^? hud . manObject . imSelectedItem
--revise1 invid <- you w ^? crManipulation . manObject . imSelectedItem
etype <- you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType
return . length $ eqTypeToSites etype
selectedItemScroll :: Int -> World -> Maybe World
selectedItemScroll yi w = do
i <- you w ^? crManipulation . manObject . imSelectedItem
i <- w ^? hud . manObject . imSelectedItem
itm <- you w ^? crInv . ix i >>= \k -> w ^? cWorld . lWorld . items . ix k
return $ itemScroll yi itm w