Move towards unifying (your) creature manipulation with selection

src/Dodge/Creature/Action.hs

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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