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