Cleanup

More tweaking needs to be done, after deciding a max width for selection
items.

src/AesonHelp.hs

@@ -6,7 +6,8 @@ import Data.ByteString.Lazy.Char8 (unpack)
 import Data.Maybe
 
 getPretty :: ToJSON a => a -> [String]
-getPretty = lines . unpack . AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False)
+--getPretty = lines . unpack . AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False)
+getPretty = lines . unpack . AEP.encodePretty' (AEP.Config (AEP.Spaces 2) mempty AEP.Generic False)
 
 prettyShort :: ToJSON a => a -> [String]
 prettyShort = mapMaybe cullPretty . getPretty

src/Dodge/Base/Collide.hs

@@ -34,6 +34,7 @@ module Dodge.Base.Collide (
     collide3WallsFloor,
     collide3,
     crHeight,
+    crMid,
 ) where
 
 import AesonHelp
@@ -174,32 +175,41 @@ collide3Wall sp wl (ep, mo) = maybe (ep, mo) (,Just (n, OWall wl)) $ intersectSe
 
 collide3Creature :: Point3 -> Creature -> (Point3, MPO) -> (Point3, MPO)
 collide3Creature sp cr (ep, m) = fromMaybe (ep, m) $ do
-    h <- crHeight cr
-    (p, n) <-
-        fst $
-            intersectCylSeg
-                (cr ^. crPos)
-                (crRad $ cr ^. crType)
-                h
-                sp
-                ep
+    let h = crHeight cr
+    (p, n) <- fst $ intersectCylSeg (cr ^. crPos) (crRad $ cr ^. crType) h sp ep
     return (p, Just (n, OCreature cr))
 
-crHeight :: Creature -> Maybe Float
+crHeight :: Creature -> Float
 crHeight cr = case cr ^. crHP of
-    HP{} -> Just $ case cr ^. crType of
+    HP{} -> case cr ^. crType of
         HoverCrit {} -> 10
         ChaseCrit {} -> 25
         Avatar {} -> 25
         CrabCrit {} -> 25
         SlinkCrit {} -> 25
-        SlimeCrit {_slimeSlime = r} -> min 15 $ slimeToRad r
+        SlimeCrit {_slimeSlime = r} -> min 25 $ 2 * slimeToRad r
         BeeCrit {} -> 10
         HiveCrit {} -> 25
         BarrelCrit{} -> 20
         _ -> error $ "Need to define crHeight for this crType:\n" <> unlines (prettyShort (cr ^. crType))
-    CrIsCorpse{} -> Just 5
-    AvatarDestroyed{} -> Nothing
+    CrIsCorpse{} -> 5
+    AvatarDestroyed{} -> 0
+
+crMid :: Creature -> Float
+crMid cr = case cr ^. crHP of
+    HP{} -> case cr ^. crType of
+        HoverCrit {} -> 2
+        ChaseCrit {} -> 20
+        Avatar {} -> 20
+        CrabCrit {} -> 20
+        SlinkCrit {} -> 20
+        SlimeCrit {_slimeSlime = r} -> max 3 . min 20 $ 2 * slimeToRad r - 5
+        BeeCrit {} -> 2
+        HiveCrit {} -> 20
+        BarrelCrit{} -> 20
+        _ -> error $ "Need to define crHeight for this crType:\n" <> unlines (prettyShort (cr ^. crType))
+    CrIsCorpse{} -> 2
+    AvatarDestroyed{} -> 0
 
 wallToSurface :: Wall -> (Point3, Point3, [(Point3, Point3)])
 wallToSurface wl = (g x, g $ vNormal (x - y), [(g x, g (y - x)), (g y, g (x - y))])
@@ -271,7 +281,7 @@ circHitWall sp ep r w =
     xep = ep + x
 
 -- | note that this does not push the circle away from the wall at all
-collideCircWalls :: Point2 -> Point2 -> Float -> [Wall] -> (Point2, Maybe Wall)
+collideCircWalls :: Foldable t => Point2 -> Point2 -> Float -> t Wall -> (Point2, Maybe Wall)
 {-# INLINE collideCircWalls #-}
 collideCircWalls sp ep rad = foldl' findPoint (ep, Nothing)
   where
@@ -282,14 +292,11 @@ collideCircWalls sp ep rad = foldl' findPoint (ep, Nothing)
             . _wlLine
             $ wl
     shiftbyrad (a, b) =
-        bimap
-            f
-            f
-            ( a +.+ rad *.* normalizeV (a -.- b)
-            , b +.+ rad *.* normalizeV (b -.- a)
+            ( f $ a + rad *^ normalizeV (a - b)
+            , f $ b + rad *^ normalizeV (b - a)
             )
       where
-        f = (+.+) (rad *.* normalizeV (vNormal $ a -.- b))
+        f = (+ rad *^ normalizeV (vNormal $ a - b))
 
 overlapCircWallsClosest :: Point2 -> Float -> [Wall] -> Maybe (Point2, Wall)
 {-# INLINE overlapCircWallsClosest #-}

src/Dodge/Base/You.hs

@@ -19,19 +19,19 @@ you w = w ^?! cWorld . lWorld . creatures . ix 0
 
 yourSelectedItem :: World -> Maybe Item
 yourSelectedItem w = do
-    i <- you w ^? crManipulation . manObject . imSelectedItem
-    j <- _crInv (you w) ^? ix i
+    Sel 0 i <- w ^? hud . diSelection . _Just
+    j <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix (NInt i)
     w ^? cWorld . lWorld . items . ix j
 
 yourRootItem :: World -> Maybe Item
 yourRootItem w = do
-    i <- you w ^? crManipulation . manObject . imRootSelectedItem
-    j <- _crInv (you w) ^? ix i
+    i <- w ^? hud . manObject . hiRootSelectedItem
+    j <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix i
     w ^? cWorld . lWorld . items . ix j
 
 yourRootItemDT :: World -> Maybe (DTree OItem)
 yourRootItemDT w = do
-    i <- you w ^? crManipulation . manObject . imRootSelectedItem . unNInt
+    i <- w^?hud. manObject . hiRootSelectedItem . unNInt
     invIMDT ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> you w ^. crInv) ^? ix i
 
 yourInv :: World -> NewIntMap InvInt Item

src/Dodge/Bullet.hs

@@ -108,11 +108,11 @@ updateBulVel bt = bt & buVel .*.*~ _buDrag bt
 --            return $ BezierTrajectory sp tpos (mouseWorldPos (w ^. input) (w ^. wCam))
 
 -- might want to restrict what/how bounces by material type
-bounceDir :: IM.IntMap Item -> (Point2, Either Creature Wall) -> Maybe Point2
-bounceDir _ (_, Right wl) = Just $ uncurry (-) (_wlLine wl)
-bounceDir m (p, Left cr) | crIsArmouredFrom m p cr 
+bounceDir :: World -> IM.IntMap Item -> (Point2, Either Creature Wall) -> Maybe Point2
+bounceDir _ _ (_, Right wl) = Just $ uncurry (-) (_wlLine wl)
+bounceDir w m (p, Left cr) | crIsArmouredFrom m p w cr 
     = Just $ vNormal $ p - (cr ^. crPos . _xy)
-bounceDir _ _ = Nothing
+bounceDir _ _ _ = Nothing
 
 useBulletPayload :: Bullet -> Point2 -> World -> World
 useBulletPayload bu = case _buPayload bu of
@@ -160,7 +160,7 @@ hitEffFromBul w bu = case _buEffect bu of
     PenetrateBullet -> movePenBullet bu hitstream w
     BounceBullet -> fromMaybe (expireAndDamage bu hitstream w) $ do
         (hp, crwl) <- hitstream ^? _head
-        dir <- bounceDir (w ^. cWorld . lWorld . items) (hp, crwl)
+        dir <- bounceDir w (w ^. cWorld . lWorld . items) (hp, crwl)
         return
             ( w
             , bu

src/Dodge/Creature.hs

@@ -13,7 +13,6 @@ module Dodge.Creature (
     module Dodge.Creature.ReaderUpdate,
     module Dodge.Creature.State,
     module Dodge.Creature.Test,
-    module Dodge.Creature.Volition,
     module Dodge.Creature.YourControl,
 ) where
 
@@ -35,7 +34,6 @@ import Dodge.Creature.ReaderUpdate
 import Dodge.Creature.SpreadGunCrit
 import Dodge.Creature.State
 import Dodge.Creature.Test
-import Dodge.Creature.Volition
 import Dodge.Creature.YourControl
 import Dodge.Data.Creature
 import Dodge.Default

src/Dodge/Creature/Action.hs

@@ -10,6 +10,9 @@ module Dodge.Creature.Action (
     youDropItem,
 ) where
 
+import qualified IntSetHelp as IS
+import Dodge.DisplayInventory
+import Dodge.Data.SelectionList
 import RandomHelp
 import Dodge.WorldEvent.ThingsHit
 import Control.Applicative
@@ -39,14 +42,16 @@ import qualified Data.Set as S
 -- it is desirable to be able to determine when an action is finished,
 -- so that DoActionThen and the like are easy to define
 performActions :: Int -> World -> World
-performActions cid w =
-    foldl'
+performActions cid w = fromMaybe w $ do
+    a <- cr ^?crActionPlan.apAction
+    let (iss, mayas) = performAction cr w a
+    return $ foldl'
         (followImpulse cid)
         (w & cWorld . lWorld . creatures . ix cid . crActionPlan . apAction .~ mayas)
         iss
   where
     cr = w ^?! cWorld . lWorld . creatures . ix cid
-    (iss, mayas) = fromMaybe ([],NoAction) $ performAction cr w <$> cr ^? crActionPlan . apAction
+--    (iss, mayas) = maybe ([],NoAction) (performAction cr w) (cr ^? crActionPlan . apAction)
 
 type ActionUpdate = ([Impulse], Action)
 
@@ -55,6 +60,9 @@ type ActionUpdate = ([Impulse], Action)
 -}
 performAction :: Creature -> World -> Action -> ActionUpdate
 performAction cr w ac = case ac of
+    Eat i x -> ([],Eat i x)
+--    Eat i x | x <= 0 -> ([],NoAction)
+--    Eat i x -> ([],Eat i (x-1))
     AimAt tcid p -> performAimAt cr w tcid p
     WaitThen 0 newAc -> ([], newAc)
     WaitThen t newAc -> ([], WaitThen (t -1) newAc)
@@ -65,7 +73,7 @@ performAction cr w ac = case ac of
     DoActionThen fsta afta -> case performAction cr w fsta of
         (imps, NoAction) -> (imps, afta)
         (imps, nxta) -> (imps, DoActionThen nxta afta)
-    DoActionWhile f act -> performAction cr w $ DoActionWhilePartial act f act
+--    DoActionWhile f act -> performAction cr w $ DoActionWhilePartial act f act
     DoActionWhilePartial partAc f resetAc
         | doWdCrBl f w cr -> case performAction cr w partAc of
             (imps, NoAction) -> (imps, DoActionWhilePartial resetAc f resetAc)
@@ -80,11 +88,6 @@ performAction cr w ac = case ac of
     DoActionWhileInterrupt repa f afta
         | doWdCrBl f w cr -> (fst $ performAction cr w repa, DoActionWhileInterrupt repa f afta)
         | otherwise -> performAction cr w afta
---    DoActions [] -> ([], NoAction)
---    DoActions acs ->
---        let (imps, newAcs) = foldMap (performAction cr w) acs
---         in (imps, newAcs)
---    StartSentinelPost -> ([AddGoal $ SentinelAt (cr ^. crPos . _xy) (_crDir cr)], NoAction)
     PathTo p a -> performPathTo a cr w p
     EvadeAim -> tryEvadeSideways cr w
     TurnToPoint p -> performTurnToA cr p
@@ -92,8 +95,6 @@ performAction cr w ac = case ac of
         i <- cr ^? crIntention . targetCr . _Just
         tcr <- w ^? cWorld . lWorld . creatures . ix i
         return ([TurnTo (tcr ^. crPos . _xy +.+ rotateV (_crDir tcr) p)], NoAction)
---    UseSelf f -> performAction cr w $ doCrAc f cr
---    ArbitraryAction f -> performAction cr w (doCrWdAc f cr w)
     DoImpulsesAlongside sideImp mainAc -> performAction cr w mainAc & _1 <>~ sideImp
     DoReplicate t nxtac -> performAction cr w $ DoReplicatePartial nxtac t nxtac
     DoReplicatePartial _ 0 pac -> performAction cr w pac
@@ -160,56 +161,48 @@ performTurnToA cr p
     dirv = p -.- cpos
     jit = _mvTurnJit $ crMvType cr
 
---setMinInvSize :: Int -> Creature -> World -> World
---setMinInvSize n cr = cWorld . lWorld . creatures . ix (_crID cr) . crInvCapacity .~ n
-
---organiseInvKeys :: Int -> World -> World
---organiseInvKeys cid w =
---    w & cWorld . lWorld . creatures . ix cid
---        %~ ( (crInvSel . iselPos .~ newSelKey)
---                . (crInv .~ newInv)
---                . (crInvSel . iselAction .~ NoInvSelAction)
---           )
---  where
---    cr = w ^?! cWorld . lWorld . creatures . ix cid -- _creatures (_cWorld w) IM.! cid
---    pairs = IM.toList (_crInv cr)
---    newSelKey = fromMaybe 0 $ findIndex ((== crSel cr) . fst) pairs
---    newInv = IM.fromAscList $ zip [0 ..] $ map snd pairs
-
 -- why not a cid (Int)?
 dropItem :: Creature -> Int -> World -> World
-dropItem cr invid w' =
-    doanyitemdropeffect
+dropItem cr invid w =
+    itEffectOnDrop itm cr
+        . maybesetdropped
+        . (hud . diSections . ix 3 . ssSet %~ IS.map (+ 1))
+        . (hud . diSections . ix 0 . ssSet %~ IS.deleteShift invid)
         . maybeshiftseldown
         . copyItemToFloor (cr ^. crPos . _xy) itm -- . mayberemoveequip
         . rmInvItem (_crID cr) (NInt invid) -- it is important
         -- to do this before copying the item to the floor!
         . soundStart (CrSound (_crID cr)) (cr ^. crPos . _xy) whiteNoiseFadeOutS Nothing
-        $ w'
+        $ w
   where
-    --doanyitemdropeffect = fromMaybe id $ do
-    --    rmf <- itm ^? itEffect . ieOnDrop
-    --    return $ doInvEffect rmf itm cr
-    doanyitemdropeffect = itEffectOnDrop itm cr
     itm = fromMaybe (error "dropItem cannot find item") $ do
         itid <- cr ^? crInv . ix (NInt invid)
-        w' ^? cWorld . lWorld . items . ix itid
-    maybeshiftseldown w = fromMaybe w $ do
+        w ^? cWorld . lWorld . items . ix itid
+    t = fromMaybe True $ do
+        s <- w ^? hud . diCloseFilter . _Just
+        si <- w ^? hud . diSections . ix 0 . ssItems . ix invid
+        return $ plainRegex s si
+    maybesetdropped = fromMaybe id $ do
+        guard $ t && (invid `IS.member` (w ^?! hud . diSections . ix 0 . ssSet))
+        return $ hud . diSections . ix 3 . ssSet %~ IS.insert 0
+    maybeshiftseldown = fromMaybe id $ do
+        guard t
         3 <- w ^? hud . diSelection . _Just . slSec
-        return $ w & hud . diSelection . _Just . slInt +~ 1
+        return $ hud . diSelection . _Just . slInt +~ 1
 
 -- | Get your creature to drop the item under the cursor.
 youDropItem :: World -> World
 youDropItem w = fromMaybe w $ do
-    curpos <-
-        cr ^? crManipulation . manObject . imSelectedItem . unNInt
-            <|> fmap fst (IM.lookupMax (cr ^. crInv . unNIntMap))
+    curpos <- mi <|> fmap fst (IM.lookupMax (cr ^. crInv . unNIntMap))
     guard $ not $ w ^. cWorld . lWorld . lInvLock
     return $ case cr ^. crStance . posture of
         Aiming{} -> throwItem w
-        AtEase -> dropItem cr curpos w
+        AtEase -> setInvPosFromSS $ dropItem cr curpos w
   where
     cr = you w
+    mi = do
+        Sel 0 i <- w^?hud.diSelection._Just
+        return i
 
 -- placeholder, remember to deal with two handed weapon twist
 -- should throw all attached items?

src/Dodge/Creature/ArmourChase.hs

@@ -20,12 +20,12 @@ flockArmourChaseCrit =
 --            IM.fromList
 --                [ --(0, frontArmour)
 --                ]
-        , _crActionPlan =
-            ActionPlan
-                { _apAction = NoAction
-                , _apStrategy = FollowImpulses
-                , _apGoal = Kill 0
-                }
+--        , _crActionPlan =
+--            ActionPlan
+--                { _apAction = NoAction
+----                , _apStrategy = FollowImpulses
+--                , _apGoal = Kill 0
+--                }
         , _crGroup = ShieldGroup
 --        , _crMvType = defaultChaseMvType
         }

src/Dodge/Creature/ChaseCrit.hs

@@ -38,6 +38,8 @@ chaseCrit =
         & crName .~ "chaseCrit"
         & crHP .~ HP 150
         & crFaction .~ ColorFaction green
+        & crActionPlan . apGoal .~ SearchForFood
+        & crActionPlan . apStrategy .~ Search
 
 crabCrit :: Creature
 crabCrit = defaultCreature
@@ -70,7 +72,7 @@ slimeCrit = defaultCreature
         & crName .~ "slimeCrit"
         & crHP .~ HP 1000
 --        & crType .~ SlimeCrit r 0 0 (V2 (slimeToRad r) 0) False 0
-        & crType .~ SlimeCrit r 0 Nothing 1 False 0
+        & crType .~ SlimeCrit r 0 NoSlimeDistortion 1 False 0
         & crFaction .~ ColorFaction (light green)
         & crPerception . cpVision . viFOV .~ FloatFOV pi
         & crActionPlan .~ SlimeIntelligence

src/Dodge/Creature/HandPos.hs

@@ -16,32 +16,32 @@ module Dodge.Creature.HandPos (
     strideLength,
 ) where
 
+import Dodge.Data.World
 import Control.Monad
 import qualified Data.IntMap.Strict as IM
 import Linear
 import Control.Lens
 import Dodge.Creature.Test
-import Dodge.Data.Creature
 import Dodge.Data.Equipment.Misc
 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 +61,14 @@ 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 . hiAimStance
         = (V3 6 (-6) 10, Q.qid)
-    | Just TwoHandFlat <- cr ^? crManipulation . manObject . imAimStance
+    | Just TwoHandFlat <- w ^? hud . manObject . hiAimStance
         = (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 +109,22 @@ 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 . hiAimStance
         = (V3 (10 + twoHandOffY cr) 6 20, Q.qid)
-    | Just TwoHandFlat <- cr ^? crManipulation . manObject . imAimStance
+    | Just TwoHandFlat <- w ^? hud . manObject . hiAimStance
         = (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 +137,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 +171,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/Impulse/UseItem.hs

@@ -2,6 +2,7 @@
 
 module Dodge.Creature.Impulse.UseItem (useItem) where
 
+import qualified Data.IntSet as IS
 import Dodge.Euse
 import NewInt
 import Control.Lens
@@ -14,7 +15,9 @@ import Dodge.HeldUse
 import Dodge.Inventory
 import Dodge.Item.Grammar
 import Dodge.Item.Location
---import qualified IntMapHelp as IM
+
+--note :: a -> Maybe b -> Either a b
+--note x = maybe (Left x) Right
 
 useItem :: Int -> Int -> World -> Maybe World
 useItem invid pt w = fmap (worldEventFlags . at InventoryChange ?~ ()) $ do
@@ -26,7 +29,10 @@ useItem invid pt w = fmap (worldEventFlags . at InventoryChange ?~ ()) $ do
 useItemLoc :: Creature -> LocationDT OItem -> Int -> World -> Maybe World
 useItemLoc cr loc pt w
     | aimuse
-      , fromMaybe False $ loc ^? locDT . dtValue . _1 . itLocation . ilIsAttached
+      , fromMaybe False $ do
+            i <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
+            is <- w ^? hud . manObject . hiAttachedItems
+            return $ i `IS.member` is
       , Aiming{} <- cr ^. crStance . posture =
         return $ gadgetEffect pt loc cr w
     | GadgetPlatformSF <- sf =

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
@@ -62,24 +62,20 @@ drawSlimeCrit cr =
     r = slimeToRad $ cr ^?! crType . slimeSlime - cr ^?! crType . slimeSlimeChange
     so = slimeOutline cr
     ps = fromMaybe so $ do
-        (x', qs) <- cr ^? crType . slimeSplitTimer . _Just
+        SlimeDistortion x' qs _ <- cr ^? crType . slimeDistortion
         let x = fromIntegral x'
         guard $ length qs == 12
         return $ zipWith (+) (fmap (0.1 * (10 - x) *^) so) (fmap (0.1 * x *^) qs)
 
--- assumes d is a unit vector
-scaleAlong :: Point2 -> Float -> Point2 -> Point2
-scaleAlong d s p = ((s - 1) * dot d p) *^ d + p
+basicCrPict :: World -> IM.IntMap Item -> Creature -> SPic
+basicCrPict w m cr = drawEquipment w m cr <> noPic (basicCrShape w cr)
 
-basicCrPict :: IM.IntMap Item -> Creature -> SPic
-basicCrPict m cr = drawEquipment m cr <> noPic (basicCrShape 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
@@ -122,20 +118,17 @@ drawBeeCrit cr =
     colorSH
         col
         (f . upperPrismPolyHalfMI 3 $ polyCirc 6 r)
-        <> colorSH (dark col) (overPosSH (Q.apply (beakpos)) $ upperPrismPolyHalfST 1 $ [V2 0 (-2), V2 4 0, V2 0 2])
+        <> colorSH (dark col) (overPosSH (Q.apply beakpos) $ upperPrismPolyHalfST 1 [V2 0 (-2), V2 4 0, V2 0 2])
   where
     r = cr ^. crType . to crRad
     beakpos = (V3 (r - 1) 0 0, Q.qid)
-    col
-        | cr ^?! crType . beeAggro > 0 = red
+    col | cr ^?! crType . beeAggro > 0 = red
         | otherwise = yellow
-    f
-        | Mounted{} <- cr ^. crStance . carriage =
-            each . sfVs . each . _xy %~ scaleAlong (V2 0 1) (1 + g (modTo 1 (cr ^?! crType . beeSlime . to ((/ 100) . fromIntegral))))
+    f   | Mounted{} <- cr ^. crStance . carriage =
+            each.sfVs.each._y *~ g (modTo 1 $ cr ^?! crType . beeSlime . to ((/ 100) . fromIntegral))
         | otherwise = id
-    g x
-        | x > 0.5 = 1 - x
-        | otherwise = x
+    g x | x > 0.5 = 2 - x
+        | otherwise = 1 + x
 
 drawCrabCrit :: World -> Creature -> Shape
 drawCrabCrit w cr =
@@ -187,8 +180,8 @@ crabUpperBody _ cr =
 
 chaseUpperBody :: World -> Creature -> Shape
 chaseUpperBody w cr =
-    colorSH
-        (_skinUpper cskin)
+--    colorSH
+--        (_skinUpper cskin)
         ( overPosSH
             (Q.apply torsoq)
             ( upperPrismPolyHalfMI tz $
@@ -196,19 +189,36 @@ chaseUpperBody w cr =
                     & each %~ vNormal
                     & each . _y *~ 0.6
             )
-            <> overPosSH (Q.apply neckq) (upperPrismPolyHalfMI 3 $ (+ V2 8 0) . vNormal <$> trapTBH 2 5 8)
+           <> overPosSH (Q.apply neckq) lneckshape
+        <> overPosSH (Q.apply neckq2) uneckshape
         )
         <> colorSH
-            (_skinHead cskin)
-            (overPosSH (Q.apply headq) (upperBox Medium Important 2 [V2 0 (-4), V2 9 0, V2 0 4]))
+--            (_skinHead cskin)
+            yellow headshape
   where
     --    time = fromIntegral (mod (w ^. unpauseClock) 100) / 5
     tz = 4
     cskin = crShape $ _crType cr
-    torsoq = (V3 0 0 (10 + tz + tbob), Q.qid)
+    torsoq = (V3 0 0 (10 + tz + tbob), Q.qy (-cr ^?! crType . chaseqy0))
     mcool = 1 - min 10 (fromIntegral . _meleeCooldown $ _crType cr) / 10
-    neckq = torsoq `Q.comp` (V3 6 0 0, Q.qz aimrot * Q.axisAngle (V3 0 1 0) (-1.8 * mcool))
-    headq = neckq `Q.comp` (V3 16 0 0, Q.axisAngle (V3 0 1 0) (2 * mcool + vocaltilt) * Q.qz aimrot)
+--    (qy1,qy2,qy3)  
+----        | CloseToMelee i <- cr ^?!crActionPlan.apStrategy
+----            = (0,0,0)
+--        | otherwise = (pi/3,-2*pi/3,pi/3)
+--        | otherwise = (pi * w^.cWorld.cClock.to ((*0.01).fromIntegral),0,0)
+--        | otherwise = (-1.8 * mcool , 0, 2 * mcool + vocaltilt)
+    qy1 = cr ^?! crType . chaseqy1
+    qy2 = cr ^?! crType . chaseqy2
+    qy3 = cr ^?! crType . chaseqy3
+    lneckshape = colorSH red $ upperPrismPolyHalfMI 4 (vNormal <$> trapTBH 2 5 (nlen/4))
+        & each . sfVs . each +~ V3 (nlen/4) 0 (-2)
+    uneckshape = colorSH green $ upperPrismPolyHalfMI 3 (vNormal <$> trapTBH 3 2 (nlen/4))
+        & each . sfVs . each +~ V3 (nlen/4) 0 (-1.5)
+    headshape = overPosSH (Q.apply headq) (upperBox Medium Important 2 [V2 0 (-4), V2 9 0, V2 0 4])
+    neckq = torsoq `Q.comp` (V3 8 0 4, Q.qz aimrot * Q.qy (pi + qy1))
+    neckq2 = neckq `Q.comp` (V3 (nlen/2) 0 0, Q.qy qy2)
+    headq = neckq2 `Q.comp` (V3 (nlen/2) 0 0, Q.qy (pi + qy3) * Q.qz aimrot)
+    nlen = 16
     vocaltilt = case cr ^? crVocalization . vcTime of
         Just x | x < 20 -> -pi * 0.05 * (10 - abs (fromIntegral x - 10))
         _ -> 0
@@ -227,6 +237,29 @@ chaseUpperBody w cr =
         guard $ hasLOSIndirect cxy tcxy w
         return . (0.5 *) . nearZeroAngle $ argV (tcxy - cxy) - cr ^. crDir
 
+{- NECK ARTICULATION   
+Viewed from side, all hinges, torso/lower neck also hinges in Q.qz (not shown)
+    na1 na2 na3    <- angles, in diagram all == 0, in Q.qy
+     |   |   |
+  ---.---.---.---       z
+   |   |   |   |        ^>x                           
+ torso | u.neck|                                   
+     l.neck   head                  
+Rough examples
+Flat aim:           Resting:
+                        .\\
+                        \  \\
+      .                  .
+     / \                /
+ ---.   .---        ---.
+a1 = 60             a1 = 60
+a2 = -120           a2 = 60
+a3 = 60             a3 = -160
+-}
+
+--ikTwoArms :: Point3 -> Point3 -> Point3 -> Point3 -> (QFloat,QFloat)
+--ikTwoArms 
+
 oneSmooth :: Float -> Float
 oneSmooth x = sin (pi * x * 0.5)
 
@@ -301,8 +334,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
@@ -312,7 +345,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
@@ -382,12 +415,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
 
@@ -411,28 +444,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

@@ -4,6 +4,7 @@ module Dodge.Creature.State (
     invItemEffs,
 ) where
 
+import qualified Data.IntSet as IS
 import Dodge.Creature.Radius
 import qualified Data.IntMap.Strict as IM
 import Linear
@@ -70,7 +71,7 @@ hivePainEffect cr w
     | otherwise = w
   where
     (a,g') = randomR (0,2*pi) $ w ^. randGen
-    (b,g) = runState randOnUnitSphere $ g'
+    (b,g) = runState randOnUnitSphere g'
     p = (crRad (cr ^. crType) + 5) *^ unitVectorAtAngle a
     v = 3 *^ b
 
@@ -83,7 +84,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
 
@@ -106,19 +107,23 @@ invItemLocUpdate cr loc w = doAnyEquipmentEffect loc cr $ case itm ^. itType of
     HELD MINIGUNX{} -> coolMinigun itm w
     HELD MACHINEPISTOL{} -> coolMachinePistol cr itm w
     LASER | loc ^. locDT . dtValue . _2 == WeaponTargetingSF
-        , itm ^? itLocation . ilIsAttached == Just True -> shineTargetLaser cr loc w
+        , isattached -> shineTargetLaser cr loc w
     HELD LED 
-        | itm ^? itLocation . ilIsAttached == Just True -> shineTorch cr loc w
+        | isattached -> shineTorch cr loc w
     TARGETING tt 
-        | itm ^? itLocation . ilIsAttached == Just True -> updateItemTargeting tt cr itm w
+        | isattached -> updateItemTargeting tt cr itm w
     ARHUD
-        | itm ^? itLocation . ilIsAttached == Just True -> drawARHUD loc w
+        | isattached -> drawARHUD loc w
     _ -> w
   where
     haspulse =
         w ^? cWorld . lWorld . creatures . ix 0 . crType . avatarPulse . pulseProgress
             == Just 0
     itm = loc ^. locDT . dtValue . _1
+    isattached = fromMaybe False $ do
+        i <- itm ^? itLocation . ilInvID . unNInt
+        is <- w ^? hud . manObject . hiAttachedItems
+        return $ i `IS.member` is
 
 coolMinigun :: Item -> World -> World
 coolMinigun itm
@@ -161,7 +166,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
@@ -235,7 +240,7 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d
     magitid <- mag ^? dtValue . _1 . itID . unNInt
     return $
         w
-            & worldEventFlags . at InventoryChange ?~ ()
+            & worldEventFlags . at InventoryChange ?~ () -- why?
             & cWorld . lWorld . items
                 . ix magitid
                 . itConsumables
@@ -251,7 +256,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 +269,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
@@ -312,7 +317,10 @@ updateItemTargeting tt cr itm w = case tt of
   where
     pointittarg = cWorld . lWorld . items . ix itid . itTargeting
     itid = itm ^. itID . unNInt
-    isattached = itm ^?! itLocation . ilIsAttached
+    isattached = fromMaybe False $ do
+        i <- itm ^? itLocation . ilInvID . unNInt
+        is <- w ^? hud . manObject . hiAttachedItems
+        return $ i `IS.member` is
     rbpressed = SDL.ButtonRight `M.member` _mouseButtons (_input w)
 
 setRBCreatureTargeting :: Creature -> World -> ItemTargeting -> ItemTargeting

src/Dodge/Creature/State/WalkCycle.hs

@@ -57,8 +57,10 @@ updateCarriage' cid cr w = \case
         mcr <- w ^? cWorld . lWorld . creatures . ix mid
         mp <- mcr ^? crPos
         d <- mcr ^? crType . slimeCompression
-        return $ w & tocr . crPos .~ mp + (p & _x *~ d & _y %~ (/d))
+        return $ w & tocr . crPos .~ mp + (oxyrot (mcr ^. crDir) 
+            (oxyrot (-mcr^.crDir) p & _x *~ d & _y %~ (/d)))
   where
+    oxyrot a = over _xy (rotateV a)
     tocr = cWorld . lWorld . creatures . ix cid
     oop = cr ^. crOldOldPos
     f v | norm v > 10 = 10 *^ signorm v
@@ -79,7 +81,6 @@ pushAgainst x y
     | a > 0 = y - project y x
     | otherwise = y
   where
-    -- project y x is the projection of x onto y
     a = dotV (normalize y) (project y x)
 
 walkCliffPush :: Creature -> [(Point2,Point2)] -> Point2

src/Dodge/Creature/Statistics.hs

@@ -6,10 +6,10 @@ module Dodge.Creature.Statistics (
 --    crIntelligence,
 ) where
 
+import Dodge.Data.World
 import Dodge.Data.Equipment.Misc
 import qualified Data.Map.Strict as M
 import NewInt
-import Dodge.Data.LWorld
 import Data.Maybe
 --import qualified IntMapHelp as IM
 import qualified Data.IntMap.Strict as IM
@@ -53,8 +53,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 +70,12 @@ 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 . hiAttachedItems
     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,24 @@ 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 . hiAimStance == 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 +112,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

@@ -2,6 +2,11 @@
 
 module Dodge.Creature.Update (updateCreature) where
 
+import qualified Data.Semigroup as Semi
+import Dodge.WorldEvent.ThingsHit
+import Dodge.Humanoid
+import Dodge.Creature.Perception
+import Dodge.Creature.ReaderUpdate
 import Dodge.Creature.Slime
 import Dodge.Creature.Radius
 import Dodge.Creature.MoveType
@@ -25,7 +30,6 @@ import Dodge.Creature.YourControl
 import Dodge.Damage
 import Dodge.Data.Damage.Type
 import Dodge.Data.World
-import Dodge.Humanoid
 import Dodge.Inventory
 import Dodge.Lampoid
 import Dodge.Prop.Gib
@@ -62,14 +66,14 @@ updateLivingCreature cr = case cr ^. crType of
             . yourControl
     LampCrit{} -> updateLampoid cr
     BarrelCrit bt -> updateBarreloid bt cr
-    ChaseCrit{} -> crUpdate cid . performActions cid . updateChaseCrit cid
+    ChaseCrit{} -> crUpdate cid . performActions cid . setChaseCritKinematics cid . updateChaseCrit cid cr
     CrabCrit{} -> crUpdate cid . performActions cid . crabCritInternal cid
     AutoCrit{} -> crUpdate cid
     SwarmCrit{} -> crUpdate cid
     HoverCrit{} -> crUpdate cid . performActions cid . hoverCritHoverSound cr .
             updateHoverCrit cid
     SlinkCrit{} -> slinkCritUpdate cid
-    SlimeCrit{} -> slimeCritUpdate cid
+    SlimeCrit{} -> updateSlimeCrit cid
     BeeCrit{} -> crUpdate cid . performActions cid . updateBeeFromPheremones cr cid . updateBeeCrit cr cid
     HiveCrit{} -> crUpdate cid . performActions cid . updateHiveCrit cr cid
   where
@@ -196,7 +200,9 @@ updateCalmBee cr cid w
     , distance (cr ^. crPos . _xy) (tcr ^. crPos . _xy) < 0.8*crRad (tcr ^. crType) 
     , Just d <- tcr ^? crType . slimeCompression
         = w
-        & tocr . crStance . carriage .~ Mounted ti (cr ^. crPos - tcr ^. crPos & _x %~ (/d) & _y *~ d)
+        & tocr . crStance . carriage .~ Mounted ti 
+            (oxyrot (tcr^.crDir) 
+                (oxyrot (-tcr^.crDir) (cr ^. crPos - tcr ^. crPos) & _x %~ (/d) & _y *~ d))
         & tocr . crActionPlan . apAction .~ NoAction
     | Just (tcr,_) <- gettarg = w
             & tocr . crActionPlan . apAction .~ PathTo (tcr ^. crPos . _xy) NoAction
@@ -206,6 +212,7 @@ updateCalmBee cr cid w
         & tocr . crActionPlan . apStrategy . searchTimer %~ (max 0 . subtract 1)
     | otherwise = startsearch
   where
+    oxyrot a = over _xy (rotateV a)
     (sa,gsa) = runState (takeOne [0,1]) (w ^. randGen)
     starthivereturn = fromMaybe w $ do
         hcr <- gethive
@@ -223,10 +230,10 @@ updateCalmBee cr cid w
         & tocr . crActionPlan . apStrategy .~ SearchTimed 200
     (p,g) = runState (randOnCirc 200) (w ^. randGen)
     cxy = cr ^. crPos . _xy
-    mountshakeoff mid = fromMaybe True $ do
+    mountshakeoff mid = fromMaybe False $ do
         mcr <- w ^? cWorld . lWorld . creatures . ix mid
-        SlimeCrit {_slimeSplitTimer = x} <- mcr ^? crType
-        return $ isJust x
+        x <- mcr ^? crType . slimeDistortion . sdTime
+        return $ x > 8
     sspeed = 5
     gettarg = do
         i <- cr ^? crActionPlan . apStrategy . harvestTarget 
@@ -242,37 +249,34 @@ updateCalmBee cr cid w
         r <- tcr ^? crType . slimeSlime . to slimeToRad
         return $ r > 12
 
-slimeCritUpdate :: Int -> World -> World
-slimeCritUpdate cid w 
-    | r < 5 = w & cWorld . lWorld . creatures . at cid .~ Nothing
+updateSlimeCrit :: Int -> World -> World
+updateSlimeCrit cid w 
+    | cr ^?! crType . slimeSlime < 2500 
+        = w & cWorld . lWorld . creatures . at cid .~ Nothing
     | Just hitp <- w ^? cWorld . lWorld . creatures . ix cid . crDamage . ix 0 . dmPos
         , Just hitv <-  w ^? cWorld . lWorld . creatures . ix cid . crDamage . ix 0 . dmVector
         , Just w' <- splitSlimeCrit' hitp hitv cid cr w = w'
     | (cr ^?! crType . slimeIsCompressing) && 1 > p
-        = let (w',g) = runState (setSlimeDir cid (cr & crDamage .~ []) w) (w ^. randGen)
+        = let (w',g) = runState (setSlimeDir cid cr w) (w ^. randGen)
             in w' & randGen .~ g
     | otherwise = updateCarriage cid $ w
-        & cWorld . lWorld . creatures . ix cid .~ mvslime
+        & cWorld . lWorld . creatures . ix cid %~ mvslime
         & cWorld . lWorld . creatures . ix cid . crDamage .~ []
         & tocr %~ doSlimeRadChange
-        & tocr . crType . slimeSplitTimer %~ fsst
+        & tocr . crType . slimeDistortion %~ fsst
         & tocr . crType . slimeEngulfProgress %~ (max 0 . subtract 0.5)
   where
-    fsst Nothing = Nothing
-    fsst (Just (x,ps))
-        | x > 0 = Just (x-1,ps)
-        | otherwise = Nothing
+    fsst (SlimeDistortion x ps t) | x > 0 = SlimeDistortion (x-1) ps t
+    fsst _ = NoSlimeDistortion
     tocr = cWorld . lWorld . creatures . ix cid
     cr = w ^?! cWorld . lWorld . creatures . ix cid
-    v = 0.1 *^ unitVectorAtAngle (cr ^. crDir)
-    mvslime = cr & crType . slimeCompression +~ f (0.1/r)
-        & crPos . _xy +~ v
+    mvslime cr' = cr' & crType . slimeCompression +~ f (0.1/r)
+        & crPos . _xy +~ 0.1 *^ unitVectorAtAngle (cr' ^. crDir)
         & crType . slimeIsCompressing %~ f'
-    f | t = negate
+    f | cr ^?! crType . slimeIsCompressing = negate
       | otherwise = id
     f'  | p > 1.5 = const True
         | otherwise = id
-    t = cr ^?! crType . slimeIsCompressing
     r = cr ^?! crType . slimeSlime . to slimeToRad
     p = cr ^?! crType . slimeCompression
 
@@ -286,6 +290,7 @@ setSlimeDir cid cr w = do
             return $ fromMaybe w $ splitSlimeCrit' (x + cxy) (unitVectorAtAngle d) cid cr w
         else return $ w & tocr . crDir .~ d
                 & tocr . crType . slimeIsCompressing .~ False
+                & tocr . crDamage .~ mempty
   where
     tocr = cWorld . lWorld . creatures . ix cid
     cxy = cr ^. crPos . _xy
@@ -331,8 +336,8 @@ splitSlimeCrit p v cr = do
                 & crDir .~ argV (-mvdir)
         c1ps = qs' & each +~ cxy - (mp + r1 *^ mvdir) & each %~ rotateV (- c1 ^. crDir)
         c2ps = ps' & each +~ cxy - (mp - r2 *^ mvdir) & each %~ rotateV (- c2 ^. crDir)
-    return (c1 & crType . slimeSplitTimer . _Just . _2 .~ f c1ps c1
-        ,c2 & crType . slimeSplitTimer . _Just . _2 .~ f c2ps c2
+    return (c1 & crType . slimeDistortion . sdShape .~ f c1ps c1
+        ,c2 & crType . slimeDistortion . sdShape .~ f c2ps c2
         )
   where
     f xs@(_:_) c = polyInPoly (centroid xs) xs (slimeOutline c)
@@ -341,9 +346,9 @@ splitSlimeCrit p v cr = do
     r = cr ^?! crType . slimeSlime . to slimeToRad
     cr' = cr & crDamage .~ []
         & crType . slimeSlimeChange .~ 0
-        & crType . slimeSplitTimer .~ Just (10, mempty)
+        & crType . slimeDistortion .~ SlimeDistortion 10  mempty True
         & crType . slimeIsCompressing .~ False
-        & crType . slimeCompression .~ 1 -- rotateV (argV mvdir) (V2 r1 0)
+        & crType . slimeCompression .~ 1
     (ps,qs) = cutPoly (p-cxy) (p+v-cxy) $ slimeOutline cr & each %~ rotateV (cr ^. crDir)
     
 -- h is the height of the segment, ie r - distance to center
@@ -363,17 +368,146 @@ slinkCritUpdate cid w =
         . _2
         *~ Q.axisAngle (V3 0 1 0) (pi / 1000)
 
+setChaseCritKinematics :: Int -> World -> World
+setChaseCritKinematics cid w = w
+    & cWorld . lWorld . creatures . ix cid %~ setChaseCritKinematics' w
+
+ccAngles :: World -> Creature -> (Float,Float,Float,Float)
+ccAngles w cr
+    | Eat i _ <- cr^?!crActionPlan.apAction = fromMaybe (0,0,0,0) $ do
+        tcr <- w ^? cWorld . lWorld . creatures . ix i
+        let tp = tcr ^. crPos + V3 0 0 (crMid tcr)
+            (np,_) = (cr ^. crPos, Q.qz (cr ^. crDir)) 
+                `Q.comp` (V3 8 0 14, Q.qid)
+            v = tp - np
+            a = angleVV3 v (v & _z .~ 0)
+        return $ f (-a) 0 0
+    | CloseToMelee i<-cr^?!crActionPlan.apStrategy = fromMaybe (0,0,0,0) $ do
+        tcr <- w ^? cWorld . lWorld . creatures . ix i
+        let tp = tcr ^. crPos + V3 0 0 (crMid tcr)
+            (np,_) = (cr ^. crPos, Q.qz (cr ^. crDir)) 
+                `Q.comp` (V3 8 0 14, Q.qid)
+            v = tp - np
+            a = angleVV3 v (v & _z .~ 0)
+        return $ f 
+            (0.45*pi - a)
+            (-0.9*pi)
+            (0.45*pi)
+    | otherwise = f (0.6*pi) (-0.2*pi) (-0.4*pi)
+  where
+    f a b c = (0,a,b,c)
+
+ccKState :: World -> Creature -> ChaseKState
+ccKState _ cr
+    | Eat i _ <- cr^?!crActionPlan.apAction = PeckingCK i
+    | CloseToMelee i <- cr^?!crActionPlan.apStrategy = AimingCK i
+    | otherwise = UprightCK
+
+setChaseCritKinematics' :: World -> Creature -> Creature
+setChaseCritKinematics' w = f . g
+  where
+    g cr | ccKState w cr == cr ^?! crType . chaseKState = cr
+        | PeckingCK i <- ccKState w cr = cr
+            & crType . chaseLerp .~ 3
+            & crType . chaseKState .~ PeckingCK i
+        | otherwise = cr & crType . chaseLerp .~ 20
+            & crType . chaseKState .~ ccKState w cr
+    f cr = 
+        let (a,b,c,d) = ccAngles w cr
+            x = cr ^?! crType . chaseLerp
+        in if x <= 1
+            then cr & crType . chaseqy0 .~ a
+              & crType . chaseqy1 .~ b
+              & crType . chaseqy2 .~ c
+              & crType . chaseqy3 .~ d
+            else cr 
+              & crType . chaseqy0 %~ h x a
+              & crType . chaseqy1 %~ h x b
+              & crType . chaseqy2 %~ h x c
+              & crType . chaseqy3 %~ h x d
+              & crType . chaseLerp -~ 1
+    h x a b = 1/fromIntegral x * a + (1-1/fromIntegral x) * b
+
+updateChaseCrit :: Int -> Creature -> World -> World
+updateChaseCrit cid cr 
+    | SearchForFood <- cr ^?! crActionPlan . apGoal = updateFoodSearchChaseCrit cid cr
+    | Flee <- cr^?!crActionPlan.apGoal
+        , NoAction <- cr^?!crActionPlan.apAction = tocr.crActionPlan.apGoal.~SearchForFood
+    | Flee <- cr^?!crActionPlan.apGoal = id
+    | otherwise = updateCalmChaseCrit cid
+  where
+    tocr = cWorld.lWorld.creatures.ix cid
+
+updateFoodSearchChaseCrit :: Int -> Creature -> World -> World
+updateFoodSearchChaseCrit cid cr w 
+    | (tcr:_) <- sortOn f . IM.elems . IM.filter avoidcr $ crsNearCirc cxy 60 w 
+        = let p = fleePoint cr cxy (20 *^ normalize (cxy - tcr^.crPos._xy)) w
+          in w &tocr.crActionPlan.apAction.~PathTo p NoAction
+                &tocr.crActionPlan.apGoal.~Flee
+    | Eat i 0 <- cr^?! crActionPlan.apAction = w
+            & cWorld .lWorld.creatures . at i .~ Nothing
+            & tocr . crActionPlan.apAction.~NoAction
+            & tocr . crActionPlan.apStrategy.~Search
+    | Eat i x <- cr^?! crActionPlan.apAction = w
+            & tocr .crActionPlan.apAction.acTimer-~1
+    | CloseToMelee i<-cr^?!crActionPlan.apStrategy 
+        ,Nothing <- w ^?cWorld.lWorld.creatures.ix i = w & tocr . crActionPlan.apStrategy .~ Search
+    | CloseToMelee i<-cr^?!crActionPlan.apStrategy 
+        ,Just tcr <-w^?cWorld.lWorld.creatures.ix i
+        ,distance cxy (tcr^.crPos._xy) < 15 = w
+            & tocr.crActionPlan.apAction.~Eat i 5
+--            & tocr.crActionPlan.apAction.~NoAction
+--            & tocr.crActionPlan.apStrategy.~Search
+--            & cWorld.lWorld.creatures.at i.~Nothing
+    | CloseToMelee{}<-cr^?!crActionPlan.apStrategy 
+        ,PathTo{}<-cr^?!crActionPlan.apAction= w
+    | xs@(_:_) <- IM.elems . IM.filter istarget $ crsNearCirc cxy 100 w 
+    , (tcr,g) <- runState (takeOne xs) (w ^. randGen) = w&tocr.crActionPlan.apAction.~DoImpulses[MvForward]
+        &tocr.crActionPlan.apStrategy.~CloseToMelee (tcr^.crID)
+        &tocr.crActionPlan.apAction.~PathTo (tcr^.crPos._xy) NoAction
+        &randGen.~g
+    | otherwise = w
+  where
+    f c = fromMaybe 100 $ do
+        s <- cr^?crType.slimeSlime
+        return $ dist cxy (c^.crPos._xy) - sqrt(0.01*fromIntegral s)
+    tocr = cWorld . lWorld . creatures . ix cid
+    cxy = cr ^. crPos . _xy
+    avoidcr c | ct@SlimeCrit{} <- c^.crType = distance cxy (c^.crPos._xy)-crRad ct < 10
+        | otherwise = False
+    istarget tcr 
+        | BeeCrit{} <- tcr^.crType 
+        , CrIsCorpse{} <- tcr^.crHP = True
+        | otherwise = False
+    
+fleePoint :: Creature -> Point2 -> Point2 -> World -> Point2
+fleePoint c p v w = g . minimum $ f <$> [p+v, p+0.9*^vNormal v, p-0.9*^vNormal v]
+  where
+    f ep = let q = walkablePoint c p ep w
+            in Semi.Arg (-distance q p) q
+    g (Semi.Arg _ x) = x
+
+
+updateCalmChaseCrit :: Int -> World -> World
+updateCalmChaseCrit cid w = w
+    & tocr %~ overrideMeleeCloseTarget w
+    & tocr %~ setViewPos w
+    & tocr %~ setMvPosToTargetCr w
+    & tocr %~ chaseCritMv w
+    & tocr %~ perceptionUpdate [0] w
+    & tocr %~ targetYouWhenCognizant w
+    & tocr %~ searchIfDamaged
+    & tocr . crType . meleeCooldown %~ max 0 . subtract 1
+    & tocr . crVocalization %~ updateVocTimer
+  where
+    tocr = cWorld . lWorld . creatures . ix cid
+
+
 hoverCritHoverSound :: Creature -> World -> World
-hoverCritHoverSound cr w = fromMaybe w $ do
-    guard $ d < 100
-    return $
-        soundContinueVol
-            (0.5 * (1 - 0.01 * d))
-            (CrSound cid)
-            cxy
-            buzz1S
-            (Just 2)
-            w
+hoverCritHoverSound cr w
+    | d < 100 
+        = soundContinueVol (0.5 * (1 - 0.01 * d)) (CrSound cid) cxy buzz1S (Just 2) w
+    | otherwise = w
   where
     cxy = cr ^. crPos . _xy
     d = max 0 (dist (you w ^. crPos . _xy) cxy - 100)
@@ -469,7 +603,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/Volition.hs

@@ -1,38 +0,0 @@
--- | Not a good name, perhaps: internal creature actions.
-module Dodge.Creature.Volition (
-    holsterWeapon,
-    drawWeapon,
-    shootTillEmpty,
-    shootFirstMiss,
-) where
-
-import Dodge.Data.Creature
-import Dodge.Data.CreatureEffect
-import Dodge.SoundLogic.LoadSound
-import Geometry
-
-holsterWeapon, drawWeapon :: Action
-holsterWeapon = DoImpulses [ChangePosture AtEase, MakeSound whiteNoiseFadeOutS]
-drawWeapon = DoImpulses [ChangePosture Aiming, MakeSound whiteNoiseFadeInS]
-
-shootTillEmpty :: Action
---shootTillEmpty = (crCanShoot `DoActionWhile` DoImpulses [UseItem])
-shootTillEmpty =
-    (WdCrBlfromCrBl CrCanShoot `DoActionWhile` DoImpulses [UseItem])
-        `DoActionThen` 20 `WaitThen` holsterWeapon
-
---advanceShoot :: Int -> Action
---advanceShoot tcid = lostest `DoActionWhile`
---    advanceShoot' `DoActionThen`
---    75 `DoReplicate`
---    advanceShoot'
---  where
---    lostest (w,cr) = canSee (_crID cr) tcid w
---    advanceShoot' = ImpulsesList [[UseItem, MoveForward 3]]
-
-shootFirstMiss :: Action
-shootFirstMiss =
-    LeadTarget (V2 30 50)
-        `DoActionThen` DoImpulses [UseItem]
---        `DoActionThen` (WdCrBlfromCrBl CrCanShoot `DoActionWhile` DoActions [LeadTarget (V2 0 0), DoImpulses [UseItem]])
-        `DoActionThen` 20 `WaitThen` holsterWeapon

src/Dodge/Creature/YourControl.hs

@@ -38,8 +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 itid <- lw ^? creatures . ix 0 . crInv . ix invid =
+    , Just (Sel 0 invid) <- w ^. hud .diSelection
+    , Just itid <- lw ^? creatures . ix 0 . crInv . ix (NInt invid) =
         w & cWorld . lWorld %~ assignHotkey (NInt itid) hk
     | ispressed SDL.ScancodeLCtrl || ispressed SDL.ScancodeRCtrl
     , (hk : _) <- mapMaybe scancodeToHotkey . M.keys $ pkeys
@@ -106,7 +106,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
@@ -116,17 +116,15 @@ wasdWithAiming w cr
 wasdAim :: Input -> World -> Creature -> Creature
 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
-    | Aiming{} <- cr ^. crStance . posture = setposture AtEase twoHandTwistAmount
---    | otherwise = creatureTurnTowardDir (_crMvAim cr) 0.2 cr
+    , AtEase <- cr ^. crStance . posture = setposture Aiming (-twistAmount)
+    | SDL.ButtonRight `M.member` _mouseButtons inp = aimTurn w mousedir cr
+    | Aiming{} <- cr ^. crStance . posture = setposture AtEase twistAmount
     | otherwise = creatureTurnTowardDir (_crMvDir cr) 0.2 cr
   where
     setposture x r =
         cr
             & crStance . posture .~ x
-            & doAimTwist (cr ^? crManipulation . manObject . imAimStance) r
+            & doAimTwist (w ^? hud . manObject . hiAimStance) r
     mousedir = argV $ w ^. cWorld . lWorld . lAimPos - (cr ^. crPos . _xy)
 
 doAimTwist :: Maybe AimStance -> Float -> Creature -> Creature
@@ -134,11 +132,11 @@ doAimTwist as x
     | as == Just TwoHandTwist = crDir +~ x
     | otherwise = id
 
-twoHandTwistAmount :: Float
-twoHandTwistAmount = 1.6 * pi
+twistAmount :: Float
+twistAmount = 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 +145,14 @@ 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 . hiRootSelectedItem
+        fmap itemBulkiness $ cr ^? crInv . ix itRef >>= \k -> lw ^?cWorld.lWorld. items . ix k . itType
 
 itemBulkiness :: ItemType -> Float
 itemBulkiness = \case
@@ -209,14 +207,6 @@ 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
-        Just invid -> useItem invid ltime w
-        Nothing -> interactWithCloseObj <$> getSelectedCloseObj w ?? w
+    case w ^.hud.diSelection of
+        Just (Sel 0 invid) -> useItem invid ltime w
+        _ -> interactWithCloseObj <$> getSelectedCloseObj w ?? w

src/Dodge/Data/ActionPlan.hs

@@ -62,7 +62,7 @@ infixr 9 `WaitThen`
 
 infixr 9 `DoActionThen`
 
-infixr 9 `DoActionWhile`
+--infixr 9 `DoActionWhile`
 
 infixr 9 `DoReplicate`
 
@@ -74,6 +74,7 @@ data Action
         , _targetSeenAt :: Point2
         }
     | PathTo { _pathToPoint :: Point2, _pathFailAction :: Action }
+    | Eat {_targetID :: Int, _acTimer :: Int}
     | EvadeAim
     | TurnToPoint { _turnToPoint :: Point2 }
     | ImpulsesList { _impulsesListList :: [[Impulse]], _acAction :: Action }
@@ -82,10 +83,6 @@ data Action
         { _waitThenTimer :: Int
         , _waitThenAction :: Action
         }
-    | DoActionWhile
-        { _doActionWhileCondition :: WdCrBl
-        , _doActionWhileAction :: Action
-        }
     | DoActionWhilePartial
         { _doActionWhilePartial :: Action
         , _doActionWhileCondition :: WdCrBl
@@ -121,9 +118,6 @@ data Action
         }
     | LeadTarget { _leadTargetBy :: Point2 }
     | NoAction
---    | StartSentinelPost
---    | UseSelf { _useSelf :: CrAc }
---    | ArbitraryAction {_arbitraryAction :: CrWdAc}
 -- | Repeatedly perform impulses alongside a main action until the main action terminates
     | DoImpulsesAlongside
         { _sideImpulses :: [Impulse]
@@ -138,7 +132,7 @@ data Strategy
     | Lure Int Point2
     | Patrol [Point2]
     | ShootAt Int
-    | FollowImpulses
+--    | FollowImpulses
     | WatchAndWait
     | Investigate
     | WarningCry
@@ -146,7 +140,6 @@ data Strategy
     | Wander
     | CloseToMelee {_meleeTarget :: Int}
     | GetTo Point2
-    | Flee
     | Search
     | SearchTimed {_searchTimer :: Int}
     | ReturnToHive
@@ -157,6 +150,8 @@ data Strategy
 
 data Goal
     = LiveLongAndProsper
+    | SearchForFood
+    | Flee
     | Kill {_killTarget :: Int}
     | SentinelAt {_sentinelPos :: Point2, _sentinelDir :: Float}
     deriving (Eq, Ord, Show) --Generic, Flat)

src/Dodge/Data/CardinalPoint.hs

@@ -44,4 +44,9 @@ data CardinalCover
 data XInfinity a = NegInf | NonInf {_nonInf :: a} | PosInf
     deriving (Eq, Ord, Show)
 
+instance Functor XInfinity where
+    fmap f (NonInf x) = NonInf (f x)
+    fmap _ NegInf = NegInf
+    fmap _ PosInf = PosInf
+
 makeLenses ''XInfinity

src/Dodge/Data/Creature.hs

@@ -42,7 +42,7 @@ data Creature = Creature
     , _crID :: Int
     , _crHP :: CrHP
     , _crInv :: NewIntMap InvInt Int
-    , _crManipulation :: Manipulation
+--    , _crManipulation :: Manipulation
     , _crEquipment :: M.Map EquipSite (NewInt ItmInt)
     , _crDamage :: [Damage]
     , _crPain :: Int

src/Dodge/Data/Creature/Misc.hs

@@ -59,6 +59,13 @@ data CreatureType
     | ChaseCrit {_meleeCooldown :: Int
         , _footForward :: FootForward
         , _strideAmount :: Float
+        , _chaseqy0 :: Float
+        , _chaseqy1 :: Float
+        , _chaseqy2 :: Float
+        , _chaseqy3 :: Float
+        , _chaseqz :: Float
+        , _chaseLerp :: Int
+        , _chaseKState :: ChaseKState
         }
     | CrabCrit 
         { _meleeCooldownL :: Int
@@ -78,7 +85,7 @@ data CreatureType
         , _slimeSlimeChange :: Int
 --        , _slimeRadWobble :: Float
         --, _slimeSplitTimer :: Int
-        , _slimeSplitTimer :: Maybe (Int, [Point2])
+        , _slimeDistortion :: SlimeShapeDistortion
         , _slimeCompression :: Float
         , _slimeIsCompressing :: Bool
         , _slimeEngulfProgress :: Float
@@ -102,6 +109,19 @@ data CreatureType
     | BarrelCrit {_barrelType :: BarrelType}
     | LampCrit {_lampHeight :: Float, _lampColor :: Point3, _lampLSID :: Maybe Int}
 
+data ChaseKState
+    = UprightCK
+    | AimingCK Int
+    | PeckingCK Int
+    deriving (Eq)
+
+data SlimeShapeDistortion = SlimeDistortion
+    { _sdTime :: Int
+    , _sdShape :: [Point2]
+    , _sdIsSplit :: Bool
+    }
+    | NoSlimeDistortion
+
 slimeToRad :: Int -> Float
 slimeToRad x = sqrt $ fromIntegral x * 0.01
 
@@ -128,6 +148,9 @@ makeLenses ''Vocalization
 makeLenses ''CrMvType
 makeLenses ''CreatureType
 makeLenses ''CreatureShape
+makeLenses ''SlimeShapeDistortion
+deriveJSON defaultOptions ''ChaseKState
+deriveJSON defaultOptions ''SlimeShapeDistortion
 deriveJSON defaultOptions ''Pulse
 deriveJSON defaultOptions ''Vocalization
 deriveJSON defaultOptions ''BarrelType

src/Dodge/Data/HUD.hs

@@ -3,13 +3,14 @@
 
 module Dodge.Data.HUD where
 
+import Dodge.Data.Item.Use.Consumption.LoadAction
 import Control.Lens
-import qualified Data.IntSet as IS
 import Dodge.Data.Combine
 import Dodge.Data.Item.Location
 import Dodge.Data.SelectionList
 import Geometry.Data
 import NewInt
+import qualified Data.IntMap.Strict as IM
 
 data SubInventory
     = NoSubInventory
@@ -32,11 +33,14 @@ data HUD = HUD
     , _diSelection :: Maybe Selection
     , _diInvFilter :: Maybe String
     , _diCloseFilter :: Maybe String
-    , _closeItems :: [NewInt ItmInt]
+    , _closeItems :: [NewInt ItmInt]  -- add bool showing whether in ssSet?
     , _closeButtons :: [Int]
+    , _manObject :: ManipulatedObject
+    , _closeItemsInv :: IM.IntMap Int
     }
 
-data Selection = Sel {_slSec :: Int, _slInt :: Int, _slSet :: IS.IntSet}
+data Selection = Sel {_slSec :: Int, _slInt :: Int}
+  deriving (Eq,Show)
 
 makeLenses ''HUD
 makeLenses ''Selection

src/Dodge/Data/Input.hs

@@ -3,6 +3,7 @@
 
 module Dodge.Data.Input where
 
+import Dodge.Data.CardinalPoint
 import Dodge.Data.Config
 import Dodge.Data.Terminal.Status
 import Control.Lens
@@ -15,8 +16,8 @@ data MouseContext
     | MouseAiming
     | MouseInGame
     | MouseMenu {_mcoMenuClick :: Maybe Int}
-    | OverInvDrag {_mcoDragSection :: Int , _mcoMaybeSelect :: Maybe (Int,Int) }
-    | OverInvDragSelect { _mcoSecSelStart :: Maybe (Int,Int), _mcoSelEnd :: Maybe Int }
+    | OverInvDrag {_mcoDragSection :: Int }
+    | OverInvDragSelect { _mcoSecSelStart :: XInfinity (Int,Int) }
     | OverInvSelect { _mcoInvSelect :: (Int,Int)}
     | OverCombFiltInv { _mcoInvFilt :: (Int,Int)}
     | OverCombSelect { _mcoCombSelect :: (Int,Int)}

src/Dodge/Data/Item/Location.hs

@@ -29,25 +29,17 @@ data ItemLocation
     = InInv
         { _ilCrID :: Int
         , _ilInvID :: NewInt InvInt
-        , _ilIsRoot :: Bool -- of any item
-        , _ilIsSelected :: Bool
-        , _ilIsAttached :: Bool -- to selected item.  question: downwards and upwards?
         , _ilEquipSite :: Maybe EquipSite
         }
     | OnTurret {_ilTuID :: Int}
-    | OnFloor -- {_ilFlID :: NewInt FloorInt}
+    | OnFloor 
     | InVoid
     deriving (Eq, Show, Ord, Read) --Generic, Flat)
 
 instance ShortShow ItemLocation where
-    shortShow (InInv cid invid rootb selb attb esite) =
+    shortShow (InInv cid invid esite) =
         "InInv:cid" <> shortShow cid <> "invid" <> shortShow (_unNInt invid)
-            <> "root"
-            <> shortShow rootb
-            <> "sel"
-            <> shortShow selb
-            <> "att"
-            <> shortShow attb
+            <> "esite"
             <> shortShow (fmap (SString . show) esite)
     shortShow x = show x
 

src/Dodge/Data/Item/Use/Consumption/LoadAction.hs

@@ -10,29 +10,14 @@ import qualified Data.IntSet as IS
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
---import Sound.Data
-
-data Manipulation -- should be ManipulatedObject?
-    = Manipulator {_manObject :: ManipulatedObject }
-    | Brute
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data ManipulatedObject
-    = SortInventory
-    | SelectedItem
-        { _imSelectedItem :: NewInt InvInt
-        , _imRootSelectedItem :: NewInt InvInt
-        , _imAimStance :: AimStance
-        , _imAttachedItems :: IS.IntSet -- this should probably be NewIntSet InvInt also
+    = HeldItem
+        { _hiRootSelectedItem :: NewInt InvInt
+        , _hiAimStance :: AimStance
+        , _hiAttachedItems :: IS.IntSet -- this should probably be NewIntSet InvInt also
         }    
-    | SelNothing
-    | SortCloseItem
-    | SelCloseItem {_ispCloseItem :: Int}
-    | SortCloseButton
-    | SelCloseButton {_ispCloseButton :: Int}
-     deriving (Eq, Ord, Show, Read) --Generic, Flat)
+    | HandsFree
 
 makeLenses ''ManipulatedObject
-makeLenses ''Manipulation
 deriveJSON defaultOptions ''ManipulatedObject
-deriveJSON defaultOptions ''Manipulation

src/Dodge/Data/LWorld.hs

@@ -146,7 +146,7 @@ data LWorld = LWorld
     , _hotkeys :: M.Map Hotkey (NewInt ItmInt)
     , _imHotkeys :: NewIntMap ItmInt Hotkey
     , _lAimPos :: Point2
-    , _lInvLock :: Bool
+    , _lInvLock :: Bool -- used eg burstRifle fire
     , _respawnPos :: (Point2, Float)
     }
 

src/Dodge/Data/SelectionList.hs

@@ -10,6 +10,7 @@ import Dodge.Data.CardinalPoint
 import Dodge.Data.ScreenPos
 import Picture.Data
 import Linear
+import qualified Data.IntSet as IS
 
 data LDParams = LDP -- List display parameters
     { _ldpPos :: ScreenPos
@@ -30,10 +31,11 @@ data SectionCursor = SectionCursor
 
 data SelSection a = SelSection
     { _ssItems :: IntMap (SelectionItem a)
-    , _ssOffset :: Int
+    , _ssYOffset :: Int
     , _ssShownItems :: [Picture]
     , _ssShownLength :: Int
     , _ssIndent :: Int
+    , _ssSet :: IS.IntSet
     }
 
 type IMSS a = IntMap (SelSection a)

src/Dodge/Data/World.hs

@@ -43,6 +43,7 @@ data World = World
     , _wSoundFilter :: SoundFilter
     , _input :: Input
     , _testFloat :: Float
+    , _testString :: String
     , _rbState :: RightButtonState
     , _hud :: HUD
     , _worldEventFlags :: Set WorldEventFlag

src/Dodge/Debug.hs

@@ -320,12 +320,12 @@ drawCreatureRad cr = setLayer DebugLayer
 showMuzzlePositions :: Universe -> Picture
 showMuzzlePositions  u = fold $ do
     cr <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0
-    invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt
+    invid <- u ^?uvWorld.hud . manObject . hiRootSelectedItem . unNInt
     loc <- invIndents ((\k -> u ^?! uvWorld . cWorld . lWorld . items . ix k) <$> _crInv cr) 
         ^? ix invid . _2
     return . color red $ setLayer DebugLayer $ reduceLocDT (f cr) loc
   where
-    f cr loc = foldMap (g . muzzlePos loc cr)  (itemMuzzles loc)
+    f cr loc = foldMap (g . muzzlePos (u^.uvWorld) loc cr)  (itemMuzzles loc)
       where
         g :: Point3Q -> Picture
         g pq = translate3 (pq ^. _1) $ crossPic 5

src/Dodge/Default/Creature.hs

@@ -5,9 +5,10 @@ import qualified Data.Map.Strict as M
 import Dodge.Data.Creature
 import Dodge.Data.FloatFunction
 import Geometry.Data
---import qualified IntMapHelp as IM
---import Picture
---import MaybeHelp
+
+-- import qualified IntMapHelp as IM
+-- import Picture
+-- import MaybeHelp
 
 defaultCreature :: Creature
 defaultCreature =
@@ -15,28 +16,27 @@ defaultCreature =
         { _crPos = V3 0 0 0
         , _crOldPos = V3 0 0 0
         , _crOldOldPos = V3 0 0 0
---        , _crZ = 0
---        , _crZVel = 0
         , _crDir = 0
         , _crMvDir = 0
---        , _crMvAim = 0
---        , _crTwist = 0
         , _crID = 1
-        , _crType = ChaseCrit 0 LeftForward 0
---        , _crRad = 10
+        , _crType =
+            ChaseCrit
+                { _meleeCooldown = 0
+                , _footForward = LeftForward
+                , _strideAmount = 0
+                , _chaseqy0 = 0
+                , _chaseqy1 = 0.45 * pi
+                , _chaseqy2 = -0.9*pi
+                , _chaseqy3 = 0.45*pi
+                , _chaseqz = 0
+                , _chaseLerp = 0
+                , _chaseKState = UprightCK
+                }
         , _crHP = HP 100
---        , _crMaxHP = 150
         , _crInv = mempty
-        , _crManipulation = Manipulator SelNothing
---        , _crInvCapacity = 25
         , _crDamage = []
---        , _crCorpse = MakeDefaultCorpse
---        , _crMaterial = Flesh
         , _crPain = 0
---        , _crInvEquipped = mempty
         , _crEquipment = M.empty
---        , _crInvHotkeys = mempty
---        , _crHotkeys = M.empty
         , _crStance =
             Stance
                 { _carriage = Walking
@@ -50,13 +50,12 @@ defaultCreature =
         , _crIntention = defaultIntention
         , _crGroup = LoneWolf
         , _crName = "DEFAULTCRNAME"
---        , _crStatistics = CreatureStatistics 50 50 50
         , _crDeathTimer = Nothing
         , _crWallTouch = mempty
         }
 
---defaultCreatureSkin :: CreatureType
---defaultCreatureSkin = Humanoid (greyN 0.9) (lightx4 green) (greyN 0.3) InanimateAI
+-- defaultCreatureSkin :: CreatureType
+-- defaultCreatureSkin = Humanoid (greyN 0.9) (lightx4 green) (greyN 0.3) InanimateAI
 
 defaultInanimate :: Creature
 defaultInanimate = defaultCreature & crActionPlan .~ Inanimate
@@ -102,15 +101,14 @@ defaultIntention =
         , _viewPoint = Nothing
         }
 
-
 defaultAimingCrit :: Creature
 defaultAimingCrit = defaultCreature
 
 yourDefaultStrideLength :: Float
 yourDefaultStrideLength = 35
 
---defaultState :: CreatureState
---defaultState =
+-- defaultState :: CreatureState
+-- defaultState =
 --    CrSt
 --        { _csDamage = []
 ----        , _csSpState = GenCr

src/Dodge/Default/World.hs

@@ -43,6 +43,7 @@ defaultWorld =
         , _playingSounds = M.empty
         , _randGen = mkStdGen 2
         , _testFloat = 0
+        , _testString = ""
         , _rbState = NoRightButtonState
         , _hud = defaultHUD
         , _worldEventFlags = mempty
@@ -177,9 +178,11 @@ defaultHUD =
     HUD
         { _subInventory = NoSubInventory
         , _diSections = mempty
-        , _diSelection = Just (Sel 1 0 mempty)
+        , _diSelection = Just (Sel 1 0)
         , _diInvFilter = mempty
         , _diCloseFilter = mempty
         , _closeItems = mempty
         , _closeButtons = mempty
+        , _manObject = HandsFree
+        , _closeItemsInv = mempty
         }

src/Dodge/DisplayInventory.hs

@@ -8,8 +8,10 @@ module Dodge.DisplayInventory (
     updateInventoryPositioning,
     updateCombinePositioning,
     toggleCombineInv,
+    plainRegex,
 ) where
 
+import qualified Data.IntSet as IS
 import Control.Applicative
 import Control.Lens
 import Control.Monad
@@ -95,16 +97,15 @@ checkInventorySelectionExists w
     | isJust $ w ^? hud . diSections . ix i . ssItems . ix j = w
     | otherwise = scrollAugNextInSection w
   where
-    Sel i j _ = fromMaybe (Sel 1 (-1) mempty) $ w ^? hud . diSelection . _Just
+    Sel i j = fromMaybe (Sel 1 (-1)) $ w ^? hud . diSelection . _Just
 
 checkCombineSelectionExists :: SubInventory -> SubInventory
 checkCombineSelectionExists si
     | Just sss <- si ^? ciSections
-      , Sel i j _ <- fromMaybe (Sel 0 0 mempty) $ si ^? ciSelection . _Just
+      , Sel i j <- fromMaybe (Sel 0 0) $ si ^? ciSelection . _Just
       , isNothing $ si ^? ciSections . ix i . ssItems . ix j =
-        si & ciSelection ?~ Sel 0 (-1) mempty
-            & ciSelection
-            %~ scrollSelectionSections (-1) sss
+        si & ciSelection ?~ Sel 0 (-1)
+            & ciSelection %~ scrollSelectionSections (-1) sss
     | otherwise = si
 
 displayIndents :: Int -> Int
@@ -246,27 +247,27 @@ updateSectionsPositioning ::
     IM.IntMap (SelSection a) ->
     IM.IntMap (SelSection a)
 updateSectionsPositioning h mselpos allavailablelines lsss sss =
-    IM.intersectionWithKey (\k -> updateSection (h k) (m k)) ls ssizes `g` offsets
+    IM.intersectionWithKey (\k -> updateSection (h k) (m k)) lsss ssizes `g` offsets
   where
-    offsets = fmap _ssOffset sss
+    offsets = fmap (\ss -> (ss^.ssYOffset, ss^.ssSet)) sss
     m k = do
-        Sel k' i _ <- mselpos
+        Sel k' i <- mselpos
         guard $ k == k'
         return i
-    ls = lsss
     -- defaults non-existing offsets to 0
-    g = merge (mapMissing (const ($ 0))) dropMissing (zipWithMatched (const ($)))
+    g = merge (mapMissing (const ($ (0,mempty)))) dropMissing (zipWithMatched (const ($)))
     lk = mselpos ^.. _Just . slSec
-    ssizes = sectionsSizes allavailablelines lk $ sectionsDesiredLines ls
+    ssizes = sectionsSizes allavailablelines lk $ sectionsDesiredLines lsss
 
-updateSection :: Int -> Maybe Int -> IMSI a -> Int -> Int -> SelSection a
-updateSection indent mcsel sis availablelines oldoffset =
+updateSection :: Int -> Maybe Int -> IMSI a -> Int -> (Int,IS.IntSet) -> SelSection a
+updateSection indent mcsel sis availablelines (oldoffset,sset) =
     SelSection
         { _ssItems = sis
-        , _ssOffset = offset
+        , _ssYOffset = offset
         , _ssShownItems = shownitems
         , _ssShownLength = min aslength availablelines
         , _ssIndent = indent
+        , _ssSet = sset
         }
   where
     shownitems = tweakfirst . tweaklast $ take availablelines shownstrings
@@ -323,8 +324,7 @@ enterCombineInv cfig w =
     w & hud . subInventory
         .~ CombineInventory
             { _ciSections = updateCombineSections w cfig mempty
-            , _ciSelection = Just (Sel 0 0 mempty)
+            , _ciSelection = Just (Sel 0 0)
             , _ciFilter = Nothing
             }
-        & hud . diInvFilter
-        .~ Nothing
+        & hud . diInvFilter .~ Nothing

src/Dodge/Euse.hs

@@ -62,12 +62,12 @@ useMagShield mt _ cr w =
 --    _ -> w
 
 createHeadLamp :: Item -> Creature -> World -> World
-createHeadLamp _ cr =
+createHeadLamp _ cr w = w &
     cWorld
         . lWorld
         . lights
         .:~ LSParam
-            (_crPos cr + rotate3z (_crDir cr) (translateToES cr OnHead (V3 5 0 3)))
+            (_crPos cr + rotate3z (_crDir cr) (translateToES w cr OnHead (V3 5 0 3)))
             200
             0.7
 
@@ -122,7 +122,7 @@ setWristShieldPos itm cr esite w = w & moveWallIDUnsafe i wlline
         . itLocation
         . ilEquipSite
         . _Just of
-        Just x -> translateToES cr x -- . g
+        Just x -> translateToES w cr x -- . g
         _ -> undefined
     --    g
     --        | twists cr = (+.+.+ V3 (-5) 10 0)

src/Dodge/FloorItem.hs

@@ -14,10 +14,12 @@ import System.Random
 copyItemToFloor :: Point2 -> Item -> World -> World
 copyItemToFloor p it w =
     w'
-        & cWorld . lWorld . floorItems . at (it ^. itID . unNInt) ?~ FlIt q r
-        & cWorld . lWorld . items . at (it ^. itID . unNInt) ?~ (it & itLocation .~ OnFloor)
+        & cWorld . lWorld . floorItems . at i ?~ FlIt q r
+        & cWorld . lWorld . items . at i ?~ (it & itLocation .~ OnFloor)
         & hud . closeItems .:~ _itID it -- puts item at top of close items
+        & cWorld . highlightItems . at i ?~ 20
   where
+    i = it ^. itID . unNInt
     (q, w') = findWallFreeDropPoint (_dimRad $ itDim it) p w
     r = fst . randomR (- pi, pi) $ _randGen w
 

src/Dodge/HeldUse.hs

@@ -454,8 +454,7 @@ itemSidePush = \case
 
 applyInvLock :: Item -> Creature -> World -> World
 applyInvLock itm cr = case itemInvLock itm of
-    i
-        | i > 0 && cid == 0 ->
+    i | i > 0 && cid == 0 ->
             (cWorld . lWorld . delayedEvents .:~ (i, UnlockInv)) . lockInv
     _ -> id
   where
@@ -470,7 +469,7 @@ heldItemInvLock :: HeldItemType -> Int
 heldItemInvLock = \case
     FLAMESPITTER -> 10
     VOLLEYGUN i -> i + 1
-    BURSTRIFLE -> 70
+    BURSTRIFLE -> 8
     _ -> 0
 
 applySoundCME :: Item -> Creature -> World -> World
@@ -484,12 +483,12 @@ applySoundCME itm cr = fromMaybe id $ do
     cid = _crID cr
 
 applyRecoil :: LocationDT OItem -> Creature -> World -> World
-applyRecoil loc cr =
+applyRecoil loc cr w = w &
     cWorld . lWorld . creatures . ix (_crID cr) . crPos . _xy
         +~ rotateV (_crDir cr + Q.qToAng q) (V2 ((- recoilAmount itm) / crMass (_crType cr)) 0)
   where
     itm = loc ^. locDT . dtValue . _1
-    (_, q) = locOrient loc cr
+    (_, q) = locOrient w loc cr
 
 recoilAmount :: Item -> Float
 recoilAmount itm
@@ -777,29 +776,29 @@ useLoadedAmmo loc cr mz m w =
         MuzzleScroller -> useTimeScrollGun itm cr w
   where
     o = CrWeaponO $ cr ^. crID
-    pq = muzzlePos loc cr mz
-    (pq', g) = muzzleRandPos loc cr mz `runState` (w ^. randGen)
+    pq = muzzlePos w loc cr mz
+    (pq', g) = muzzleRandPos w loc cr mz `runState` (w ^. randGen)
     itmtree = loc ^. locDT
     mitid = magtree ^. dtValue . _1 . itID
     itm = itmtree ^. dtValue . _1
     (x, magtree) = fromJust m
 
-muzzlePos :: LocationDT OItem -> Creature -> Muzzle -> Point3Q
-muzzlePos m cr muz = (p1, q1) `Q.comp` pq `Q.comp` (p3, q3)
+muzzlePos :: World -> LocationDT OItem -> Creature -> Muzzle -> Point3Q
+muzzlePos w m cr muz = (p1, q1) `Q.comp` pq `Q.comp` (p3, q3)
   where
-    pq = locOrient m cr
+    pq = locOrient w m cr
     p1 = cr ^. crPos
     q1 = Q.qz $ cr ^. crDir
     p3 = addZ 0 $ muz ^. mzPos
     q3 = Q.qz $ muz ^. mzRot
 
-muzzleRandPos :: LocationDT OItem -> Creature -> Muzzle -> State StdGen Point3Q
-muzzleRandPos m cr muz = do
+muzzleRandPos :: World -> LocationDT OItem -> Creature -> Muzzle -> State StdGen Point3Q
+muzzleRandPos w m cr muz = do
     a <- state $ randomR (- inacc, inacc)
     y <- case muz ^. mzRandomOffset of
         0 -> return 0
         i -> state $ randomR (- i, i)
-    return $ muzzlePos m cr muz `Q.comp` (V3 0 y 0, Q.qz a)
+    return $ muzzlePos w m cr muz `Q.comp` (V3 0 y 0, Q.qz a)
   where
     inacc = _mzInaccuracy muz
 
@@ -1004,7 +1003,7 @@ shootBullets loc cr (mz, x, magtree) w = fromMaybe w $ do
 shootBullet :: Bullet -> LocationDT OItem -> Creature -> Muzzle -> World -> World
 shootBullet bu loc cr mz w = makeBullet bu itm pq . (randGen .~ g) $ w
   where
-    (pq, g) = muzzleRandPos loc cr mz `runState` (w ^. randGen)
+    (pq, g) = muzzleRandPos w loc cr mz `runState` (w ^. randGen)
     itm = loc ^. locDT . dtValue . _1
 
 makeBullet :: Bullet -> Item -> Point3Q -> World -> World
@@ -1384,10 +1383,10 @@ dropInventoryPath ::
     Creature ->
     World ->
     World
-dropInventoryPath i ip loc cr = fromMaybe id $ do
+dropInventoryPath i ip loc cr w = fromMaybe w $ do
     invid <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
-    j <- getInventoryPath i ip invid cr
-    return $ dropItem cr j
+    j <- getInventoryPath w i ip invid cr
+    return $ dropItem cr j w
 
 --dropInventoryPath i ip loc cr w = case ip of
 --    ABSOLUTE -> fromMaybe w $ do
@@ -1416,18 +1415,23 @@ useInventoryPath ::
     Creature ->
     World ->
     World
-useInventoryPath pt i ip loc cr w = case ip of
-    ABSOLUTE -> fromMaybe w $ do
-        guard $ i `IM.member` (cr ^. crInv . unNIntMap)
-        return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem i pt)
-    RELCURS -> fromMaybe w $ do
-        j <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
-        guard $ (i + j) `IM.member` (cr ^. crInv . unNIntMap)
-        return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt)
-    RELITEM -> fromMaybe w $ do
-        j <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
-        guard $ (i + j) `IM.member` (cr ^. crInv . unNIntMap)
-        return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt)
+useInventoryPath pt i ip loc cr w = fromMaybe w $ do
+    invid <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
+    j <- getInventoryPath w i ip invid cr
+    return $ w & cWorld . lWorld . delayedEvents .:~ (1,UseInvItem j pt)
+-- = case ip of
+--    ABSOLUTE -> fromMaybe w $ useat i
+--    RELCURS -> fromMaybe w $ do
+--        Sel 0 j <- w ^? hud .diSelection._Just
+--        useat $ i + j
+--    RELITEM -> fromMaybe w $ do
+--        j <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
+--        useat $ i + j
+--  where
+--    useat k = do
+--        guard $ k `IM.member` (cr ^. crInv . unNIntMap)
+--        return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem k pt)
+        
 
 --useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of
 --    [w'] -> w & cwTime . maybeWorld .~ Just' w'

src/Dodge/Humanoid.hs

@@ -1,27 +1,13 @@
 module Dodge.Humanoid (
-    updateChaseCrit,
     crabCritInternal,
     updateHoverCrit,
+    updateVocTimer,
 ) where
 
 import Dodge.Creature
 import Dodge.Data.World
 import LensHelp
 
-updateChaseCrit :: Int -> World -> World
-updateChaseCrit cid w = w
-    & tocr %~ overrideMeleeCloseTarget w
-    & tocr %~ setViewPos w
-    & tocr %~ setMvPosToTargetCr w
-    & tocr %~ chaseCritMv w
-    & tocr %~ perceptionUpdate [0] w
-    & tocr %~ targetYouWhenCognizant w
-    & tocr %~ searchIfDamaged
-    & tocr . crType . meleeCooldown %~ max 0 . subtract 1
-    & tocr . crVocalization %~ updateVocTimer
-  where
-    tocr = cWorld . lWorld . creatures . ix cid
-
 crabCritInternal :: Int -> World -> World
 crabCritInternal cid w = w
     & tocr %~ setViewPos w

src/Dodge/Inventory.hs

@@ -12,7 +12,6 @@ module Dodge.Inventory (
     swapInvItems,
     scrollAugNextInSection,
     swapItemWith,
-    destroyItem,
     destroyAllInvItems,
     multiSelScroll,
     changeSwapSelSet,
@@ -68,19 +67,9 @@ destroyAllInvItems cr w =
         . _unNIntMap
         $ cr ^. crInv
 
-destroyItem :: Int -> World -> World
-destroyItem itid w = case w ^? cWorld . lWorld . items . ix itid . itLocation of
-    Nothing -> error $ "Tried to destroy item that does not exist; item id: " ++ show itid
-    Just InInv{_ilCrID = cid, _ilInvID = invid} -> destroyInvItem cid invid w
-    Just OnTurret{} -> error "need to write code for destroying items on turrets"
-    Just OnFloor ->
-        w
-            & cWorld . lWorld . items . at itid .~ Nothing
-            & cWorld . lWorld . floorItems . at itid .~ Nothing
-    Just InVoid -> w & cWorld . lWorld . items . at itid .~ Nothing
-
 -- note rmInvItem does not fully destroy the item, other updates to the item
 -- location are required
+-- note if this gets called ssInvPosFromSS might be necessary elsewhere
 rmInvItem :: Int -> NewInt InvInt -> World -> World
 rmInvItem cid invid w =
     w
@@ -89,39 +78,23 @@ rmInvItem cid invid w =
         & removeAnySlotEquipment
         & cWorld . lWorld . items . ix itid . itLocation . ilEquipSite .~ Nothing
         & updateselection
-        & updateselectionextra
-        & pointcid %~ updateRootItemID (w ^. cWorld . lWorld . items)
         & worldEventFlags . at InventoryChange ?~ ()
   where
     pointcid = cWorld . lWorld . creatures . ix cid
-    updateselectionextra
-        | cid == 0 = hud . diSelection . _Just . slSet %~ const mempty
-        | otherwise = id
     updateselection
-        | cid == 0 && cr ^? crManipulation . manObject . imSelectedItem == Just invid =
+        | cid == 0 && (w ^? hud .diSelection._Just) == Just (Sel 0 (invid^.unNInt)) =
             scrollAugInvSel (-1) . scrollAugInvSel 1
-        | otherwise =
-            pointcid . crManipulation . manObject . imSelectedItem %~ g
+        | otherwise = id
     cr = w ^?! cWorld . lWorld . creatures . ix cid
-    itid = _crInv cr ^?! ix invid
+    itid = cr ^?! crInv . ix invid
     itm = w ^?! cWorld . lWorld . items . ix itid
     dounequipfunction = effectOnRemove itm cr
     removeAnySlotEquipment = fromMaybe id $ do
-        epos <-
-            itm
-                ^? itLocation
-                . ilEquipSite
-                . _Just
+        epos <- itm ^? itLocation . ilEquipSite . _Just
         return $ pointcid . crEquipment . at epos .~ Nothing
-    --        return $ pointcid . crEquipment .~ mempty
-    maxk = fmap fst $ IM.lookupMax $ _unNIntMap $ cr ^. crInv
     f inv =
         let (xs, ys) = IM.split (_unNInt invid) $ _unNIntMap inv
          in NIntMap $ xs `IM.union` IM.mapKeysMonotonic (subtract 1) ys
-    -- the following might not work if a non-player creature drops their last item
-    g x
-        | x > invid || Just x == fmap NInt maxk = max 0 $ x - 1
-        | otherwise = x
 
 updateCloseObjects :: World -> World
 updateCloseObjects w =
@@ -156,7 +129,8 @@ changeSwapSelSet yi w
 
 swapSelSet :: (Int -> IS.IntSet -> World -> World) -> World -> World
 swapSelSet f w = fromMaybe w $ do
-    Sel j i is' <- w ^. hud . diSelection
+    Sel j i <- w ^. hud . diSelection
+    is' <- w ^? hud . diSections . ix j . ssSet
     let is = if IS.null is' 
         then IS.singleton i
         else is'
@@ -204,13 +178,14 @@ concurrentIS = go . IS.minView
 
 collectInvItems :: Int -> IS.IntSet -> World -> World
 collectInvItems secid is w = fromMaybe w $ do
-    guard $ secid == 0
+    guard $ secid == 0 || secid == 3
     (j, js) <- IS.minView is
     return $ h j js w
   where
     h j js w' = fromMaybe w' $ do
         (k, ks) <- IS.minView js
-        return . h (j + 1) ks $ swapInvItems (\_ _ -> Just (j + 1)) k w'
+--        return . h (j + 1) ks $ swapInvItems (\_ _ -> Just (j + 1)) k w'
+        return . h (j + 1) ks $ swapItemWith (\_ _ -> Just (j + 1)) (secid,k) w'
 
 changeSwapSel :: Int -> World -> World
 changeSwapSel yi w
@@ -228,7 +203,8 @@ multiSelScroll yi w
 
 multiSelScroll' :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
 multiSelScroll' f w = fromMaybe w $ do
-    Sel j i is <- w ^. hud . diSelection
+    Sel j i <- w ^. hud . diSelection
+    is <- w ^? hud . diSections . ix j . ssSet
     ss <- w ^? hud . diSections . ix j . ssItems
     k <- f i ss
     let insertordelete 
@@ -237,17 +213,16 @@ multiSelScroll' f w = fromMaybe w $ do
             | otherwise = IS.insert i . IS.insert k
     return $
         w
-            & hud . diSelection . _Just . slSet %~ insertordelete
+            & hud . diSections . ix j . ssSet %~ insertordelete
             & hud . diSelection . _Just . slInt .~ k
 
 changeSwapOther ::
-    ((Int -> Identity Int) -> ManipulatedObject -> Identity ManipulatedObject) ->
     Int ->
     (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) ->
     Int ->
     World ->
     World
-changeSwapOther manlens n f i w = fromMaybe w $ do
+changeSwapOther n f i w = fromMaybe w $ do
     ss <- w ^? hud . diSections . ix n . ssItems
     k <- f i ss
     let doswap j
@@ -256,15 +231,7 @@ changeSwapOther manlens n f i w = fromMaybe w $ do
             | otherwise = j
     return $
         w
-            & swapAnyExtraSelection i k
-            & cWorld
-                . lWorld
-                . creatures
-                . ix 0
-                . crManipulation
-                . manObject
-                . manlens
-                %~ doswap
+            & hud . diSections . ix 3 . ssSet %~ swapInIntSet i k
             & hud . closeItems %~ swapIndices i k
             & hud . diSelection . _Just . slInt %~ doswap
             & worldEventFlags . at InventoryChange ?~ ()
@@ -276,13 +243,13 @@ swapItemWith ::
     World
 swapItemWith f (j, i) = case j of
     0 -> swapInvItems f i
-    3 -> changeSwapOther ispCloseItem 3 f i
-    5 -> changeSwapOther ispCloseButton 5 f i
+    3 -> changeSwapOther 3 f i
+    5 -> changeSwapOther 5 f i
     _ -> id
 
 changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
 changeSwapWith f w
-    | Just (Sel j i _) <- w ^. hud . diSelection = swapItemWith f (j, i) w
+    | Just (Sel j i) <- w ^. hud . diSelection = swapItemWith f (j, i) w
     | otherwise = w
 
 invSetSelection :: Selection -> World -> World
@@ -290,11 +257,12 @@ invSetSelection sel w =
     w
         & hud . diSelection ?~ sel
         & worldEventFlags . at InventoryChange ?~ ()
-        & setInvPosFromSS
-        & cWorld . lWorld %~ crUpdateItemLocations 0
+--        & crUpdateItemLocations
+        & setInvPosFromSS -- is this necessary here?
+        & crUpdateItemLocations
 
 invSetSelectionPos :: Int -> Int -> World -> World
-invSetSelectionPos i j = invSetSelection (Sel i j mempty)
+invSetSelectionPos i j = invSetSelection (Sel i j)
 
 scrollAugInvSel :: Int -> World -> World
 scrollAugInvSel yi w
@@ -303,8 +271,9 @@ scrollAugInvSel yi w
         w
             & hud %~ doscroll
             & worldEventFlags . at InventoryChange ?~ ()
+            & crUpdateItemLocations
             & setInvPosFromSS
-            & cWorld . lWorld %~ crUpdateItemLocations 0
+            & crUpdateItemLocations
   where
     doscroll he = fromMaybe he $ do
         sss <- he ^? diSections
@@ -315,8 +284,9 @@ scrollAugNextInSection w =
     w
         & hud %~ doscroll
         & worldEventFlags . at InventoryChange ?~ ()
+        & crUpdateItemLocations
         & setInvPosFromSS
-        & cWorld . lWorld %~ crUpdateItemLocations 0
+        & crUpdateItemLocations
   where
     doscroll he = fromMaybe he $ do
         sss <- he ^? diSections

src/Dodge/Inventory/Add.hs

@@ -6,8 +6,9 @@ module Dodge.Inventory.Add (
     pickUpItemAt,
 ) where
 
+import qualified IntSetHelp as IS
+import Dodge.Data.SelectionList
 import Linear
-import qualified Data.IntSet as IS
 import Control.Lens
 import Control.Monad
 import Data.Maybe
@@ -21,46 +22,55 @@ import qualified IntMapHelp as IM
 import NewInt
 
 -- this assumes that this item is currently on the floor
-tryPutItemInInv :: Int -> Int -> World -> Maybe (NewInt InvInt, World)
-tryPutItemInInv cid itid w = do
+tryPutItemInInv :: Maybe Int -> Int -> World -> Maybe (NewInt InvInt, World)
+tryPutItemInInv mcipos itid w = do
     itm <- w ^? cWorld . lWorld . items . ix itid
     invid <- checkInvSlotsYou itm w
     let itloc = InInv
-            { _ilCrID = cid
+            { _ilCrID = 0
             , _ilInvID = invid
-            , _ilIsRoot = False
-            , _ilIsSelected = False
-            , _ilIsAttached = False
             , _ilEquipSite = Nothing
             }
     return $ (invid,) $
             w
-                & cWorld . lWorld %~ crUpdateItemLocations cid
                 -- not sure about the order of these...
-                & cWorld . lWorld . creatures . ix cid . crInv . at invid ?~ itid
+                & cWorld . lWorld . creatures . ix 0 . crInv . at invid ?~ itid
                 & cWorld . lWorld . items . ix itid . itLocation .~ itloc
                 & cWorld . lWorld . floorItems . at itid .~ Nothing
                 & updateselectionextra invid
+                & updateselection (invid ^. unNInt)
+                & updatecloseitemset
+                & maybeselect invid
                 & cWorld . highlightItems . at itid ?~ 20
+                & setInvPosFromSS
+                & crUpdateItemLocations
+                & setInvPosFromSS
   where
-    updateselectionextra i
-        | cid == 0 = (hud . diSelection . _Just . slSet %~ IS.map (f i))
-            . (hud . diSelection . _Just . slInt %~ f i)
-        | otherwise = id
+    maybeselect invid = fromMaybe id $ do
+        i <- mcipos
+        is <- w ^? hud . diSections . ix 3 . ssSet
+        guard $ i `IS.member` is
+        return $ hud . diSections . ix 0 . ssSet %~ IS.insert (invid ^. unNInt)
+    updatecloseitemset = fromMaybe id $ do
+        i <- mcipos
+        return $ hud . diSections . ix 3 . ssSet %~ IS.deleteShift i
+    updateselectionextra i = hud . diSections . ix 0 . ssSet %~ IS.map (f i)
+    updateselection i = case w ^. hud . diSelection of
+        Just (Sel 0 j) | j >= i -> hud . diSelection . _Just . slInt +~ 1
+        _ -> id
     f j i | i >= _unNInt j = i + 1
           | otherwise = i
 
--- not sure why we have the cid here, this will probably only work for cid == 0
-tryPutItemInInvAt :: Int -> Int -> Int -> World -> Maybe World
-tryPutItemInInvAt i cid itid w = do
-    (j, w') <- tryPutItemInInv cid itid w
+tryPutItemInInvAt :: Maybe Int -> Int -> Int -> World -> Maybe World
+tryPutItemInInvAt mcipos i itid w = do
+    (j, w') <- tryPutItemInInv mcipos itid w
     guard (i <= _unNInt j)
     return $ foldr f w' [i + 1 .. _unNInt j]
   where
     f j = swapInvItems (\_ _ -> Just (j -1)) j
 
 createItemYou :: Item -> World -> World
-createItemYou itm w = maybe w' snd $ tryPutItemInInv 0 itid w'
+createItemYou itm w = maybe w' snd $ tryPutItemInInv Nothing itid w'
   where
     itid = IM.newKey $ w ^. cWorld . lWorld . items
     pos = w ^?! cWorld . lWorld . creatures . ix 0 . crPos . _xy
@@ -68,11 +78,11 @@ createItemYou itm w = maybe w' snd $ tryPutItemInInv 0 itid w'
 
 -- the duplication is annoying...
 pickUpItem :: Int -> Int -> World -> World
-pickUpItem cid itid w = fromMaybe w $ do
+pickUpItem i itid w = fromMaybe w $ do
     p <- w ^? cWorld . lWorld . floorItems . ix itid . flItPos
-    soundStart (CrSound cid) p pickUpS Nothing . snd <$> tryPutItemInInv cid itid w
+    soundStart (CrSound 0) p pickUpS Nothing . snd <$> tryPutItemInInv (Just i) itid w
 
-pickUpItemAt :: Int -> Int -> Int -> World -> World
-pickUpItemAt invid cid itid w = fromMaybe w $ do
+pickUpItemAt :: Int -> (Int,Int) -> World -> World
+pickUpItemAt invid (i,itid) w = fromMaybe w $ do
     p <- w ^? cWorld . lWorld . floorItems . ix itid . flItPos
-    soundStart (CrSound cid) p pickUpS Nothing <$> tryPutItemInInvAt invid cid itid w
+    soundStart (CrSound 0) p pickUpS Nothing <$> tryPutItemInInvAt (Just i) invid itid w

src/Dodge/Inventory/Location.hs

@@ -1,20 +1,15 @@
 module Dodge.Inventory.Location (
-    updateRootItemID,
     crUpdateItemLocations,
     setInvPosFromSS,
 ) where
 
-import Dodge.Item.AimStance
 import Control.Lens
-import Data.Foldable
---import Data.IntMap.Merge.Strict
 import qualified Data.IntSet as IS
 import Data.Maybe
 import Dodge.Base.You
-import Dodge.Data.ComposedItem
-import Dodge.Data.DoubleTree
 import Dodge.Data.Item.Use.Consumption.LoadAction
 import Dodge.Data.World
+import Dodge.Item.AimStance
 import Dodge.Item.Grammar
 import qualified IntMapHelp as IM
 import NewInt
@@ -30,93 +25,39 @@ tryGetRootAttachedFromInvID (NInt invid) im = do
     t <- imroots ^? ix theroot . _2
     return (theroot, foldMap (IS.singleton . (^?! itLocation . ilInvID . unNInt)) t)
 
--- this assumes the creature inventory is well formed, specifically the
--- location ids
--- note the item intmap is all items
-getRootItemInvID :: IM.IntMap Item -> Int -> Creature -> Int
-getRootItemInvID m i cr = fromMaybe i $ do
-    let adj = invAdj $ fmap (\k -> m ^?! ix k) (_crInv cr)
-    theroot <- adj ^? ix i
-    theroot ^? _1 . _Just . _1
+crUpdateItemLocations :: World -> World
+crUpdateItemLocations lw = fromMaybe lw $ do
+    cinv <- lw ^? cWorld . lWorld . creatures . ix 0 . crInv
+    let crinv = fmap (\k -> lw ^?! cWorld . lWorld . items . ix k) cinv
+    return $ IM.foldlWithKey' crUpdateInvidLocations lw $ _unNIntMap crinv
 
-updateRootItemID :: IM.IntMap Item -> Creature -> Creature
-updateRootItemID m cr = fromMaybe cr $ do
-    i <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
-    let j = getRootItemInvID m i cr
-    return $ cr & crManipulation . manObject . imRootSelectedItem .~ NInt j
-
--- the following assumes that the crManipulation is correct
-crUpdateItemLocations :: Int -> LWorld -> LWorld
-crUpdateItemLocations crid lw = fromMaybe lw $ do
-    mo <- lw ^? creatures . ix crid . crManipulation . manObject
-    cinv <- lw ^? creatures . ix crid . crInv
-    let crinv = fmap (\k -> lw ^?! items . ix k) cinv
-    return $ crSetRoots crid $ IM.foldlWithKey' (crUpdateInvidLocations mo crid) lw $ _unNIntMap crinv
-
-crSetRoots :: Int -> LWorld -> LWorld
-crSetRoots cid w = fromMaybe w $ do
-    inv <- w ^? creatures . ix cid . crInv
-    let cinv = invIMDT $ fmap (\i -> w ^?! items . ix i) inv
-    return $ foldl' f (foldl' g w inv) cinv
-  where
-    g w' i = w' & items . ix i . itLocation . ilIsRoot .~ False
-    f :: LWorld -> DTree OItem -> LWorld
-    f w' x =
-        w' & items . ix (x ^. dtValue . _1 . itID . unNInt) . itLocation . ilIsRoot .~ True
-
-crUpdateInvidLocations ::
-    ManipulatedObject ->
-    Int ->
-    LWorld ->
-    Int ->
-    Item ->
-    LWorld
-crUpdateInvidLocations mo crid lw invid itm =
-    lw
-        & creatures . ix crid . crInv . ix (NInt invid) .~ itid
-        & items . ix itid .~ (itm & itLocation .~ newloc)
+crUpdateInvidLocations :: World -> Int -> Item -> World
+crUpdateInvidLocations w invid itm =
+    w
+        & cWorld . lWorld . creatures . ix 0 . crInv . ix (NInt invid) .~ itid
+        & cWorld . lWorld . items . ix itid .~ (itm & itLocation .~ newloc)
   where
     itid = itm ^. itID . unNInt
     newloc =
         InInv
-            { _ilCrID = crid
+            { _ilCrID = 0
             , _ilInvID = NInt invid
-            , _ilIsRoot = Just (NInt invid) == mo ^? imRootSelectedItem
-            , _ilIsSelected = Just (NInt invid) == mo ^? imSelectedItem
-            , _ilIsAttached = invid `IS.member` (mo ^. imAttachedItems)
-            , _ilEquipSite = lw ^? items . ix itid . itLocation . ilEquipSite . _Just
+            , _ilEquipSite = w ^? cWorld . lWorld . items . ix itid . itLocation . ilEquipSite . _Just
             }
 
--- this should be looked at, as it is sometimes used in functions that need not
--- concern the player creature
--- this might not work if the selpos is in the inventory but too large
 setInvPosFromSS :: World -> World
-setInvPosFromSS w = w
-        & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel
+setInvPosFromSS w = w & hud . manObject .~ thesel
   where
-    thesel = fromMaybe SelNothing $ do
-        Sel i j _ <- w ^? hud . diSelection . _Just
-        case i of
-            (-1) -> Just SortInventory
-            0 -> do
-                (rootid, aset) <-
-                    tryGetRootAttachedFromInvID
-                        (NInt j)
-                        ( fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $
-                            you w ^. crInv
-                        )
-                dt <- invIMDT ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> you w ^. crInv) ^? ix rootid
-                -- there is redundancy above
-                return
-                    SelectedItem
-                        { _imSelectedItem = NInt j
-                        , _imRootSelectedItem = NInt rootid
-                        , _imAimStance = itemAimStance ((\(x,y,_) -> (x,y)) <$> dt)
-                        , _imAttachedItems = aset
-                        }
-            1 -> Just SelNothing
-            2 -> Just SortCloseItem
-            3 -> Just $ SelCloseItem j
-            4 -> Just SortCloseButton
-            5 -> Just $ SelCloseButton j
-            _ -> error "selection out of bounds"
+    invitemmap =
+        (\k -> w ^?! cWorld . lWorld . items . ix k)
+            <$> you w ^. crInv
+    thesel = fromMaybe HandsFree $ do
+        Sel 0 j <- w ^? hud . diSelection . _Just
+        (rootid, aset) <- tryGetRootAttachedFromInvID (NInt j) invitemmap
+        dt <- invIMDT invitemmap ^? ix rootid
+        return
+            HeldItem
+                { _hiRootSelectedItem = NInt rootid
+                , _hiAimStance = itemAimStance ((\(x, y, _) -> (x, y)) <$> dt)
+                , _hiAttachedItems = aset
+                }

src/Dodge/Inventory/Path.hs

@@ -1,18 +1,18 @@
 module Dodge.Inventory.Path (getInventoryPath) where
 
+import Dodge.Data.World
 import NewInt
-import Dodge.Data.Creature
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
 import Control.Monad
 
-getInventoryPath :: Int -> InventoryPathing -> Int -> Creature -> Maybe Int
-getInventoryPath x ip itid cr = case ip of
+getInventoryPath :: World -> Int -> InventoryPathing -> Int -> Creature -> Maybe Int
+getInventoryPath w x ip invid cr = case ip of
     ABSOLUTE -> checkinvid x
     RELCURS -> do
-        selid <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
+        Sel 0 selid <- w ^? hud .diSelection._Just
         checkinvid (x + selid)
-    RELITEM -> checkinvid (itid + x)
+    RELITEM -> checkinvid (invid + x)
   where
     checkinvid y = do
         guard $ y `IM.member` (cr ^. crInv . unNIntMap)

src/Dodge/Inventory/RBList.hs

@@ -24,8 +24,9 @@ updateRBList w = case w ^. rbState of
     _ | norightclick -> w & rbState .~ NoRightButtonState
     EquipOptions{} -> w
     _ -> fromMaybe (w & rbState .~ NoRightButtonState) $ do
-        i <- cr ^? crManipulation . manObject . imSelectedItem
-        itid <- cr ^? crInv . ix i
+        Sel 0 i <- w^?hud .diSelection._Just
+--revise2        i <- w^?hud . manObject . imSelectedItem
+        itid <- cr ^? crInv . ix (NInt i)
         itm <- w ^? cWorld . lWorld . items . ix itid
         etype <- equipType itm
         return $

src/Dodge/Inventory/SelectionList.hs

@@ -33,9 +33,9 @@ import Picture.Base
 invSelectionItem :: World -> Int -> LocationDT OItem -> SelectionItem ()
 invSelectionItem w indent loc =
     SelItem
-        { _siPictures = itemDisplay w cr ci
+        { _siPictures = itemDisplay w (Just cr) $ ci ^. _1
         , _siHeight = itInvHeight $ ci ^. _1
-        , _siWidth = maximum (15 : (length <$> itemDisplay w cr ci))
+        , _siWidth = maximum (15 : (length <$> itemDisplay w (Just cr) (ci^._1)))
         , _siIsSelectable = True
         , _siColor = itemInvColor ci
         , _siOffX = indent
@@ -51,10 +51,9 @@ invSelectionItem w indent loc =
 
 -- note the convoluted display of the hotkey/equipment, this was done to avoid a
 -- space leak
-itemDisplay :: World -> Creature -> CItem -> [String]
-itemDisplay w cr ci = basicItemDisplay itm `g` anyextra
+itemDisplay :: World -> Maybe Creature -> Item -> [String]
+itemDisplay w mcr itm = basicItemDisplay itm `g` anyextra
   where
-    itm = ci ^. _1
     NInt itid = itm ^. itID
     g (x:xs) (Just y) = (x <> y) : xs
     g xs _ = xs
@@ -62,11 +61,11 @@ itemDisplay w cr ci = basicItemDisplay itm `g` anyextra
     anyhotkey = fmap hotkeyToString
         (w ^? cWorld . lWorld . imHotkeys . unNIntMap . ix itid)
     anyequippos = do
-        _ <- ci ^? _1 . itType . ibtEquip
-        epText <$> ci ^? _1 . itLocation . ilEquipSite
-    anyscroll = fmap absurround $ itemScrollDisplay =<< (ci ^? _1)
+        _ <- itm ^? itType . ibtEquip
+        epText <$> itm ^? itLocation . ilEquipSite
+    anyscroll = fmap absurround $ itemScrollDisplay =<< Just itm
     absurround str = " <" ++ str ++ ">"
-    anyexternal = fae <$> itemExternalValue itm w cr
+    anyexternal = fae <$> (itemExternalValue itm w =<< mcr)
     -- will probably want to remote the !
     fae (Left i) = " !"++shortShow i
     fae (Right s) = " !" ++ s
@@ -220,8 +219,9 @@ hotkeyToChar = \case
 
 closeItemToSelectionItem :: World -> Int -> Maybe (SelectionItem ())
 closeItemToSelectionItem w i = do
-    e <- w ^? cWorld . lWorld . items . ix i
-    let (pics, col) = closeItemToTextPictures e
+    itm <- w ^? cWorld . lWorld . items . ix i
+    let pics = itemDisplay w Nothing itm
+        col = itemInvColor (baseCI itm)
     return
         SelItem
             { _siPictures = pics
@@ -231,8 +231,12 @@ closeItemToSelectionItem w i = do
             , _siColor = col
             , _siOffX = 0
             , _siPayload = Nothing
-            , _siDisplayMod = DropShadowSI
+            , _siDisplayMod = dmod
             }
+  where
+    dmod = maybe DropShadowSI (const HighlightSI) 
+        $ w ^? cWorld . highlightItems . ix i
+    
 
 closeButtonToSelectionItem :: World -> Int -> Maybe (SelectionItem ())
 closeButtonToSelectionItem w i = do
@@ -256,6 +260,3 @@ btText bt = case _btEvent bt of
     ButtonSwitch {} -> "SWITCH"
     ButtonDumbSwitch {} -> "SWITCH"  -- do we want to show switch status?
     ButtonAccessTerminal i -> "TERMINAL " ++ show i
-
-closeItemToTextPictures :: Item -> ([String], Color)
-closeItemToTextPictures it = (basicItemDisplay it, itemInvColor $ baseCI it)

src/Dodge/Inventory/Swap.hs

@@ -1,6 +1,6 @@
 module Dodge.Inventory.Swap (
     swapInvItems,
-    swapAnyExtraSelection
+    swapInIntSet,
 ) where
 
 import Linear
@@ -11,13 +11,14 @@ import Dodge.Base.You
 import Dodge.Inventory.Location
 import Dodge.Data.DoubleTree
 import Sound.Data
-import qualified Data.IntSet as IS
+--import qualified Data.IntSet as IS
 import Data.Maybe
 import Control.Lens
 import Dodge.Data.SelectionList
 import qualified IntMapHelp as IM
 import Dodge.Data.World
 import Control.Monad
+import qualified Data.IntSet as IS
 
 swapInvItems ::
     (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) ->
@@ -28,25 +29,24 @@ swapInvItems f i w = fromMaybe w $ do
     ss <- w ^? hud . diSections . ix 0 . ssItems
     k <- f i ss
     let updateselection = case w ^? hud . diSelection . _Just of
-            Just (Sel 0 j _) | j == k -> hud . diSelection . _Just . slInt .~ i
-            Just (Sel 0 j _) | j == i -> hud . diSelection . _Just . slInt .~ k
+            Just (Sel 0 j) | j == k -> hud . diSelection . _Just . slInt .~ i
+            Just (Sel 0 j) | j == i -> hud . diSelection . _Just . slInt .~ k
             _ -> id
     return $
         w
-            & swapAnyExtraSelection i k
+            & hud . diSections . ix 0 . ssSet %~ swapInIntSet i k
             & checkConnection InventorySound disconnectItemS i k
             & cWorld . lWorld . creatures . ix 0 %~ updatecreature k
             & updateselection
             & worldEventFlags . at InventoryChange ?~ ()
-            & cWorld . lWorld %~ crUpdateItemLocations 0
+            & crUpdateItemLocations
             & setInvPosFromSS
-            & cWorld . lWorld %~ crUpdateItemLocations 0 -- the double application is inefficient, but necessary without further changes
+            & crUpdateItemLocations
             -- a rethink is maybe in order
             & checkConnection InventoryConnectSound connectItemS i k
   where
     updatecreature k =
         (crInv . unNIntMap %~ IM.safeSwapKeys i k)
-            . (crManipulation . manObject . imSelectedItem .~ NInt k)
             . swapSite i k
             . swapSite k i
     cr = you w
@@ -54,14 +54,11 @@ swapInvItems f i w = fromMaybe w $ do
         Just epos -> crEquipment . ix epos .~ NInt b
         Nothing -> id
 
-swapAnyExtraSelection :: Int -> Int -> World -> World
-swapAnyExtraSelection i k w = fromMaybe w $ do
-    is <- w ^? hud . diSelection . _Just . slSet
-    let f = if i `IS.member` is then IS.insert k else id
-        g = if k `IS.member` is then IS.insert i else id
-    return $
-        w & hud . diSelection . _Just . slSet
-            %~ (f . g . IS.delete i . IS.delete k)
+swapInIntSet :: Int -> Int -> IS.IntSet -> IS.IntSet
+swapInIntSet i k is
+        | i `IS.member` is && not (k `IS.member` is) = IS.insert k $ IS.delete i is
+        | k `IS.member` is && not (i `IS.member` is) = IS.insert i $ IS.delete k is
+        | otherwise = is
 
 checkConnection :: SoundOrigin -> SoundID -> Int -> Int -> World -> World
 checkConnection so s i j w = fromMaybe w $ do

src/Dodge/Item/BackgroundEffect.hs

@@ -7,6 +7,7 @@ module Dodge.Item.BackgroundEffect (
     removeShieldWall,
 ) where
 
+import NewInt
 import Linear
 import Control.Lens
 import Dodge.Creature.Radius
@@ -19,6 +20,8 @@ import Dodge.Wall.Create
 import Dodge.Wall.Delete
 import Dodge.Wall.Move
 import Geometry.Vector
+import qualified Data.IntSet as IS
+import Data.Maybe
 
 cancelExamineInventory :: World -> World
 cancelExamineInventory = hud . subInventory %~ f
@@ -33,9 +36,14 @@ rootNotrootEff ::
     Creature ->
     World ->
     World
-rootNotrootEff f g it
-    | it ^? itLocation . ilIsRoot == Just True = f it
-    | otherwise = g it
+rootNotrootEff f g it cr w
+    | isroot = f it cr w
+    | otherwise = g it cr w
+  where
+    isroot = fromMaybe False $ do
+        i <- it ^? itLocation . ilInvID
+        j <- w ^? hud . manObject . hiRootSelectedItem
+        return $ i == j
 
 rootAndAttNotEff ::
     (Item -> Creature -> World -> World) ->
@@ -44,11 +52,19 @@ rootAndAttNotEff ::
     Creature ->
     World ->
     World
-rootAndAttNotEff f g it
-    | it ^? itLocation . ilIsRoot == Just True 
-        && it ^? itLocation . ilIsAttached == Just True
-        = f it
-    | otherwise = g it
+rootAndAttNotEff f g it cr w
+    | isroot && isattached
+        = f it cr w
+    | otherwise = g it cr w
+  where
+    isattached = fromMaybe False $ do
+        i <- it ^? itLocation . ilInvID . unNInt
+        is <- w ^? hud . manObject . hiAttachedItems
+        return $ i `IS.member` is
+    isroot = fromMaybe False $ do
+        i <- it ^? itLocation . ilInvID
+        j <- w ^? hud . manObject . hiRootSelectedItem
+        return $ i == j
 
 createShieldWall :: Item -> Creature -> World -> World
 createShieldWall it cr w = case it ^? itParams . flatShieldWlMIX . _Just of

src/Dodge/Item/Draw.hs

@@ -2,11 +2,11 @@
 
 module Dodge.Item.Draw (itemEquipPict) where
 
+import Dodge.Data.World
 import Dodge.Item.Draw.SPicTree
 import Control.Lens
 import Dodge.Creature.HandPos
 import Dodge.Data.ComposedItem
-import Dodge.Data.Creature
 import Dodge.Data.DoubleTree
 import Dodge.Data.Equipment.Misc
 import Dodge.Item.Draw.SPic
@@ -15,13 +15,13 @@ import Geometry.Data
 import qualified Quaternion as Q
 import ShapePicture
 
-itemEquipPict :: Creature -> DTree CItem -> SPic
-itemEquipPict cr itmtree
+itemEquipPict :: World -> Creature -> DTree CItem -> SPic
+itemEquipPict w cr itmtree
     | Just esite <- itm ^? itLocation . ilEquipSite . _Just
       , Just attachpos <- equipAttachPos <$> itm ^? itType . ibtEquip =
-        equipPosition esite cr attachpos (itemSPic itm)
-    | itm ^? itLocation . ilInvID == cr ^? crManipulation . manObject . imRootSelectedItem =
-        overPosSP (Q.apply $ handHandleOrient loc cr) (itemTreeSPic itmtree)
+        equipPosition esite w cr attachpos (itemSPic itm)
+    | itm ^? itLocation . ilInvID == w ^? hud . manObject . hiRootSelectedItem =
+        overPosSP (Q.apply $ handHandleOrient w loc cr) (itemTreeSPic itmtree)
     | otherwise = mempty
   where
     itm = itmtree ^. dtValue . _1
@@ -35,7 +35,7 @@ equipAttachPos = \case
     BULLETBELTBRACER -> (V3 (-9) 0 10, Q.qid)
     _ -> (0, Q.qid)
 
-equipPosition :: EquipSite -> Creature -> Point3Q -> SPic -> SPic
-equipPosition es cr q =
+equipPosition :: EquipSite -> World -> Creature -> Point3Q -> SPic -> SPic
+equipPosition es w cr q =
     overPosSP
-        (\x -> fst $ equipSitePQ es cr `Q.comp` q `Q.comp` (x, Q.qid))
+        (\x -> fst $ equipSitePQ es w cr `Q.comp` q `Q.comp` (x, Q.qid))

src/Dodge/Item/HeldOffset.hs

@@ -7,13 +7,11 @@ module Dodge.Item.HeldOffset (
     handHandleOrient,
 ) where
 
+import Dodge.Data.World
 import Dodge.Creature.HandPos
 import Linear
-import Dodge.Data.AimStance
 import Dodge.Data.ComposedItem
-import Dodge.Data.Creature
 import Dodge.Data.DoubleTree
-import Dodge.Data.Machine
 import Dodge.DoubleTree
 import Dodge.Item.AimStance
 import Geometry
@@ -49,28 +47,28 @@ handleOrient loc = case loc ^. locDT . dtValue . _1 . itType of
 --        TwoHandUnder -> (V3 7 (-8) 15, Q.axisAngle (V3 0 0 1) (strideRot cr + 1.2))
 --        TwoHandOver -> (V3 10 0 15, Q.axisAngle (V3 0 0 1) (strideRot cr + 1.2))
 
-handOrient :: Creature -> AimStance -> Point3Q
-handOrient cr = \case
+handOrient :: World -> Creature -> AimStance -> Point3Q
+handOrient w cr = \case
     TwoHandTwist -> 
-        let (rp,_) = rightHandPQ cr
-            (lp,_) = leftHandPQ cr
+        let (rp,_) = rightHandPQ w cr
+            (lp,_) = leftHandPQ w cr
 --        in (rp,Q.qz (argV $ (lp - rp) ^. _xy))
         in (rp,Q.qNoRoll (lp - rp))
-    OneHand -> rightHandPQ cr
+    OneHand -> rightHandPQ w cr
     TwoHandFlat -> 
-        let (rp,_) = rightHandPQ cr
-            (lp,_) = leftHandPQ cr
+        let (rp,_) = rightHandPQ w cr
+            (lp,_) = leftHandPQ w cr
         in (0.5 *^ (rp + lp),Q.qz (argV (vNormal ((lp - rp) ^. _xy))))
 
 
-locOrient :: LocationDT OItem -> Creature -> Point3Q
-locOrient loc cr =
-    handHandleOrient ((\(x, y, _) -> (x, y)) <$> locToTop loc) cr
+locOrient :: World -> LocationDT OItem -> Creature -> Point3Q
+locOrient w loc cr =
+    handHandleOrient w ((\(x, y, _) -> (x, y)) <$> locToTop loc) cr
         `Q.comp` (loc ^. locDT . dtValue . _3)
 
-handHandleOrient :: LocationDT CItem -> Creature -> Point3Q
-handHandleOrient loc cr =
-    handOrient cr (itemAimStance (l ^. locDT)) `Q.comp` handleOrient l
+handHandleOrient :: World -> LocationDT CItem -> Creature -> Point3Q
+handHandleOrient w loc cr =
+    handOrient w cr (itemAimStance (l ^. locDT)) `Q.comp` handleOrient l
   where
     l = locToTop loc
 

src/Dodge/Item/Location.hs

@@ -2,13 +2,11 @@ module Dodge.Item.Location (
     pointerToItemID,
     --pointerToItemLocation,
     pointerToItem,
-    pointerYourSelectedItem,
-    pointerYourRootItem,
 ) where
 
 import NewInt
 import Control.Lens
-import Data.Maybe
+--import Data.Maybe
 import Dodge.Data.World
 
 --pointerToItemLocation ::
@@ -23,18 +21,17 @@ import Dodge.Data.World
 ----    cWorld . lWorld . floorItems . ix (_unNInt flid) . flIt
 --pointerToItemLocation _ = const pure
 
-pointerYourSelectedItem :: Applicative a => (Item -> a Item) -> World -> a World
-pointerYourSelectedItem f w = fromMaybe (pure w) $ do
-    itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem
-    itid <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid
-    Just $ (cWorld . lWorld . items . ix itid) f w
-    -- note the ilIsRoot/Selected/Attached booleans are irrelevant
-
-pointerYourRootItem :: Applicative a => (Item -> a Item) -> World -> a World
-pointerYourRootItem f w = fromMaybe (pure w) $ do
-    itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imRootSelectedItem
-    itid <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid
-    Just $ (cWorld . lWorld . items . ix itid) f w
+--pointerYourSelectedItem :: Applicative a => (Item -> a Item) -> World -> a World
+--pointerYourSelectedItem f w = fromMaybe (pure w) $ do
+--    Sel 0 itinvid <- w ^? hud.diSelection._Just
+--    itid <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix (NInt itinvid)
+--    Just $ (cWorld . lWorld . items . ix itid) f w
+--
+--pointerYourRootItem :: Applicative a => (Item -> a Item) -> World -> a World
+--pointerYourRootItem f w = fromMaybe (pure w) $ do
+--    itinvid <- w ^? hud. manObject . hiRootSelectedItem
+--    itid <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid
+--    Just $ (cWorld . lWorld . items . ix itid) f w
 
 pointerToItem :: Applicative f => Item -> (Item -> f Item) -> World -> f World
 pointerToItem x = cWorld . lWorld . items . ix (x ^. itID . unNInt)

src/Dodge/Projectile/Update.hs

@@ -1,7 +1,8 @@
 -- {-# LANGUAGE LambdaCase #-}
 -- {-# OPTIONS_GHC -Wno-unused-imports #-}
-module Dodge.Projectile.Update (updateProjectile) where
+module Dodge.Projectile.Update (updateProjectile,slimeEatSound) where
 
+import Dodge.Creature.Slime
 import Control.Monad
 import Data.List (delete)
 import Data.Maybe
@@ -81,8 +82,19 @@ stickHitSound pj =
         [slapS, slap1S, slap2S, slap3S, slap4S, slap5S, slap6S, slap7S]
         (pj ^. pjPos . _xy)
 
+slimeEatSound :: Int -> Point2 -> World -> World
+slimeEatSound i p w = w & soundStart (CrSound i) p s Nothing
+        & randGen .~ g
+      where
+        (s,g) = runState (takeOne [slurp1S,slurp2S,slurp3S,slurp4S,slurp5S]) (w ^. randGen)
+    
 shellHitCreature :: Point3 -> Creature -> Projectile -> World -> World
 shellHitCreature p cr pj
+    | SlimeCrit{} <- cr ^. crType = (cWorld . lWorld . projectiles . at (pj ^. pjID) .~ Nothing)
+        . (cWorld . lWorld . creatures . ix (cr ^. crID) . crType . slimeSlime +~ 100)
+        . (cWorld . lWorld . creatures . ix (cr ^. crID) . crType . slimeSlimeChange +~ 100)
+        . (cWorld . lWorld . creatures . ix (cr ^. crID) %~ slimeBulge (pj ^. pjPos))
+        . slimeEatSound (cr ^. crID) (cr ^. crPos . _xy)
     | Just GStick <- pj ^? pjType . gnHitEffect =
         (pjlens . pjType .~ Grenade gren)
             . stickHitSound pj
@@ -95,6 +107,13 @@ shellHitCreature p cr pj
             (rotate3z (-cr ^. crDir) (p - cr ^. crPos))
             (pj ^. pjDir - cr ^. crDir)
 
+slimeBulge :: Point3 -> Creature -> Creature
+slimeBulge p cr = cr
+    & crType . slimeDistortion .~ SlimeDistortion 10 (f <$>slimeOutline cr) False
+  where
+    v = rotateV (-cr ^. crDir) (normalize $ p ^. _xy - cr ^. crPos . _xy)
+    f x = x + (10 * max 0 (dot v (normalize x))) *^ v
+
 shellHitFloor :: Point3 -> Projectile -> World -> World
 shellHitFloor p pj =
     (topj . pjPos .~ (p & _z .~ 0.1))
@@ -197,26 +216,16 @@ doBarrelSpin cid i pj w =
 pjRemoteSetDirection :: RocketHoming -> Projectile -> World -> World
 pjRemoteSetDirection ph pj w = case ph of
     HomeUsingRemoteScreen screenid
-        | lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
-            == lw ^? items . ix (_unNInt screenid) . itLocation . ilInvID ->
+        | w ^. hud .diSelection
+            == fmap (\i -> Sel 0 (i^.unNInt)) (lw ^? items . ix (_unNInt screenid) . itLocation . ilInvID) ->
             w
-                & pjlens
-                . pjDir
-                .~ mousedir
-                & pjlens
-                . pjSpin
-                .~ 0.5
-                * diffAngles mousedir pjdir
+                & pjlens . pjDir .~ mousedir
+                & pjlens . pjSpin .~ 0.5 * diffAngles mousedir pjdir
     HomeUsingTargeting itid
         | Just tp <- w ^? pointerToItemID itid . itTargeting . itTgPos . _Just ->
             w
-                & pjlens
-                . pjDir
-                %~ turnTo 0.2 (pj ^. pjPos . _xy) tp
-                & pjlens
-                . pjSpin
-                .~ 0.5
-                * diffAngles
+                & pjlens . pjDir %~ turnTo 0.2 (pj ^. pjPos . _xy) tp
+                & pjlens . pjSpin .~ 0.5 * diffAngles
                     (turnTo 0.2 (pj ^. pjPos . _xy) tp pjdir)
                     pjdir
     _ -> w
@@ -259,15 +268,9 @@ moveProjectile pj w
         (_, Just (_, OChasmWall)) -> w & pjlens . pjTimer .~ 0 -- no stick or bounce for now
         _ ->
             w
-                & pjlens
-                . pjSpin
-                *~ 0.99
-                & pjlens
-                . pjPos
-                +~ _pjVel pj
-                & pjlens
-                . pjDir
-                +~ _pjSpin pj
+                & pjlens . pjSpin *~ 0.99
+                & pjlens . pjPos +~ _pjVel pj
+                & pjlens . pjDir +~ _pjSpin pj
   where
     pjlens = cWorld . lWorld . projectiles . ix (pj ^. pjID)
     sp = _pjPos pj

src/Dodge/Render/HUD.hs

@@ -24,7 +24,7 @@ import Dodge.Data.DoubleTree
 import Dodge.Data.EquipType
 import Dodge.Data.SelectionList
 import Dodge.Data.Terminal.Status
-import Dodge.Data.World
+import Dodge.Data.Universe
 import Dodge.DoubleTree
 import Dodge.Equipment.Text
 import Dodge.Inventory
@@ -50,27 +50,29 @@ import NewInt
 import Picture
 import SDL (MouseButton (..))
 
-drawHUD :: Config -> World -> Picture
-drawHUD cfig w =
-    drawInventory sections w cfig subinv
+drawHUD :: Universe -> Picture
+drawHUD u =
+    drawInventory (w ^. hud . diSections) u cfig subinv
         <> drawSubInventory subinv cfig w
   where
-    sections = w ^. hud . diSections
+    w = u ^. uvWorld
+    cfig = u ^. uvConfig
     subinv = w ^. hud . subInventory
 
-drawInventory :: IMSS () -> World -> Config -> SubInventory -> Picture
-drawInventory sss w cfig = \case
+drawInventory :: IMSS () -> Universe -> Config -> SubInventory -> Picture
+drawInventory sss u cfig = \case
     DisplayTerminal{} ->
         drawSelectionSections sss invDP cfig
             <> itemconnections
-            <> drawMouseOver cfig w
+            <> drawMouseOver u
     _ ->
         drawSelectionSections sss invDP cfig
             <> foldMap (drawSSCursor sss invDP curs cfig) (w ^. hud . diSelection)
             <> drawRootCursor w sss (w ^. hud . diSelection) invDP cfig
             <> itemconnections
-            <> drawMouseOver cfig w
+            <> drawMouseOver u
   where
+    w = u ^. uvWorld
     curs = invCursorParams w
     itemconnections = fromMaybe mempty $ do
         inv' <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
@@ -94,14 +96,7 @@ drawRootCursor w sss msel ldp cfig = fromMaybe mempty $ do
             if null (w ^? rbState . opSel)
                 then BoundCurs [minBound ..]
                 else BoundCurs [North, South, West]
-    return $
-        drawSSMultiCursor
-            sss
-            (0, x)
-            (y - x)
-            ldp
-            curs
-            cfig
+    return $ drawSSMultiCursor sss (0, x) (y - x) ldp curs cfig
 
 getRootItemBounds :: Int -> IM.IntMap Item -> Maybe (Int, Int)
 getRootItemBounds i inv = do
@@ -112,63 +107,67 @@ getRootItemBounds i inv = do
     y <- locDTLeftmost root ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
     return (x, y)
 
-drawMouseOver :: Config -> World -> Picture
-drawMouseOver cfig w =
+drawMouseOver :: Universe -> Picture
+drawMouseOver u =
     concat
-        (invsel <|> combinvsel <|> drawDragSelecting cfig w)
+        (invsel <|> combinvsel <|> drawDragSelecting u)
         <> concat (drawDragSelected cfig w)
   where
+    w = u ^. uvWorld
+    cfig = u ^. uvConfig
     invsel = do
         (j, i) <-
             w ^? input . mouseContext . mcoInvSelect
                 <|> w ^? input . mouseContext . mcoInvFilt
         sss <- w ^? hud . diSections
-        return
-            . translateScreenPos cfig (invDP ^. ldpPos)
-            . color (0.3 *^ white)
-            --            . color white
-            $ selSecDrawCursor invDP curs sss (Sel j i mempty)
-    --    curs = BoundaryCursor [West]
-    curs = BackdropCurs
+        drawcursor invDP sss j i
     combinvsel = do
         (j, i) <-
             (w ^? input . mouseContext . mcoCombSelect)
                 <|> (w ^? input . mouseContext . mcoCombCombine)
         sss <- w ^? hud . subInventory . ciSections
-        let idp = secondColumnLDP
+        drawcursor secondColumnLDP sss j i
+    drawcursor idp sss j i = 
         return
             . translateScreenPos cfig (idp ^. ldpPos)
             . color (0.3 * white)
-            $ selSecDrawCursor idp curs sss (Sel j i mempty)
+            $ selSecDrawCursor idp BackdropCurs sss (Sel j i)
 
 drawDragSelected :: Config -> World -> Maybe Picture
 drawDragSelected cfig w = do
-    ys <- w ^? hud . diSelection . _Just . slSet
-    guard $
-        not (IS.null ys)
-            && ( case w ^? hud . subInventory of
+    ys0 <- w ^? hud . diSections . ix 0 . ssSet
+    ys3 <- w ^? hud . diSections . ix 3 . ssSet
+    ys5 <- w ^? hud . diSections . ix 5 . ssSet
+    guard $ case w ^? hud . subInventory of
                     Just NoSubInventory -> True
                     _ -> False
-               )
-    Sel i _ _ <- w ^? hud . diSelection . _Just
     sss <- w ^? hud . diSections
-    let f x = (selSecDrawCursor invDP BackdropCurs sss (Sel i x mempty) <>)
+    let f i x = (selSecDrawCursor invDP BackdropCurs sss (Sel i x) <>)
     return
         . translateScreenPos cfig (invDP ^. ldpPos)
         . color (0.2 *^ white)
-        . IS.foldr f mempty
-        $ ys
+        $ IS.foldr (f 0) mempty ys0
+        <> IS.foldr (f 3) mempty ys3
+        <> IS.foldr (f 5) mempty ys5
 
-drawDragSelecting :: Config -> World -> Maybe Picture
-drawDragSelecting cfig w = do
-    OverInvDragSelect (Just (i, j)) (Just b) <- w ^? input . mouseContext
-    sss <- w ^? hud . diSections
-    let f x = selSecDrawCursor invDP BackdropCurs sss (Sel i x mempty)
+drawDragSelecting :: Universe -> Maybe Picture
+drawDragSelecting u = do
+    x <- w ^? input . mouseContext . mcoSecSelStart
+    y <- mouseInvPosFixWidth u
     return
         . translateScreenPos cfig (invDP ^. ldpPos)
         . color (0.2 *^ white)
-        . foldMap f
-        $ [min j b .. max j b]
+        . IM.foldMapWithKey f
+        $ sssSelectionSlice sss x y
+  where
+    f i ss 
+        | i ==0 || i == 3 = IM.foldMapWithKey 
+            (\j _ -> selSecDrawCursorFixWidth invDP BackdropCurs sss (Sel i j))
+            (ss ^. ssItems)
+        | otherwise = mempty
+    sss = w ^. hud . diSections
+    w = u ^. uvWorld
+    cfig = u ^. uvConfig
 
 drawSubInventory :: SubInventory -> Config -> World -> Picture
 drawSubInventory subinv cfig w = case subinv of
@@ -226,7 +225,7 @@ drawExamineInventory cfig w =
             }
 
 closeObjectInfo :: Int -> Either Item Button -> String
-closeObjectInfo n x = case x of
+closeObjectInfo n = \case
     Left itm -> itemInfo itm ++ " It is on the floor" ++ floorItemPickupInfo n itm
     Right _ -> "Some sort of switch or button."
 
@@ -238,22 +237,34 @@ floorItemPickupInfo n itm
 -- note the use of ^?!
 -- it is probably desirable for this to crash hard for now
 yourAugmentedItem :: (Item -> a) -> a -> (Either Item Button -> a) -> World -> a
-yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
-    Just (SelectedItem i _ _ _) -> f $ yourInv w ^?! ix i
-    Just (SelCloseItem i) -> fromMaybe x $ do
+yourAugmentedItem f x g w = case w ^. hud .diSelection of
+    Just (Sel 0 i) -> f $ yourInv w ^?! ix (NInt i)
+    Just (Sel 3 i) -> fromMaybe x $ do
         j <- w ^? hud . closeItems . ix i . unNInt
         flit <- w ^? cWorld . lWorld . items . ix j
         return . g $ Left flit
-    Just (SelCloseButton i) -> fromMaybe x $ do
+    Just (Sel 5 i) -> fromMaybe x $ do
         j <- w ^? hud . closeButtons . ix i
         but <- w ^? cWorld . lWorld . buttons . ix j
         return . g $ Right but
     _ -> x
+--revise2 yourAugmentedItem f x g w = case w ^? hud . manObject of
+--revise2     Just (SelectedItem i _ _ _) -> f $ yourInv w ^?! ix i
+--revise2     Just (SelCloseItem i) -> fromMaybe x $ do
+--revise2         j <- w ^? hud . closeItems . ix i . unNInt
+--revise2         flit <- w ^? cWorld . lWorld . items . ix j
+--revise2         return . g $ Left flit
+--revise2     Just (SelCloseButton i) -> fromMaybe x $ do
+--revise2         j <- w ^? hud . closeButtons . ix i
+--revise2         but <- w ^? cWorld . lWorld . buttons . ix j
+--revise2         return . g $ Right but
+--revise2     _ -> x
 
 drawRBOptions :: Config -> World -> Picture
 drawRBOptions cfig w = fold $ do
     guard $ ButtonRight `M.member` _mouseButtons (_input w)
-    invid <- you w ^? crManipulation . manObject . imSelectedItem
+    Sel 0 invid' <- w^.hud.diSelection
+    let invid = NInt invid'
     itid <- you w ^? crInv . ix invid
     eslist <-
         fmap eqTypeToSites $
@@ -261,7 +272,7 @@ drawRBOptions cfig w = fold $ do
     i <- w ^? rbState . opSel
     let ae = equipmentDesignation invid w
     sss <- w ^? hud . diSections
-    Sel i' j _ <- w ^? hud . diSelection . _Just
+    Sel i' j <- w ^? hud . diSelection . _Just
     curpos <- selSecYint i' j sss
     itext <- sss ^? ix i' . ssItems . ix j . siPictures . ix 0
     ind <- sss ^? ix i' . ssItems . ix j . siOffX
@@ -280,16 +291,7 @@ drawRBOptions cfig w = fold $ do
             <> translate
                 (120 - xt)
                 0
-                ( listCursor
-                    0
-                    1
-                    (BoundCurs [North, South])
-                    curpos
-                    0
-                    white
-                    25
-                    1
-                )
+                ( listCursor 0 1 (BoundCurs [North, South]) curpos 0 white 25 1)
             <> translate
                 (380 - xt)
                 0
@@ -330,10 +332,9 @@ drawItemConnections sss cfig =
         . fmap (\(_, a, b) -> a <> b)
 
 drawItemChildrenConnect :: IMSS () -> Config -> Int -> [Int] -> Picture
-drawItemChildrenConnect sss cfig i is = fromMaybe mempty $ do
+drawItemChildrenConnect sss cfig i is = fold $ do
     p <- snum i
-    let ps = mapMaybe snum is
-    return $ color white $ lConnectMulti ps p
+    return $ color white $ lConnectMulti (mapMaybe snum is) p
   where
     snum = selNumPos cfig invDP sss 0
 
@@ -352,7 +353,7 @@ combineInventoryExtra sss msel cfig w = fold $ do
                 invDP
                 (BoundCurs [North, South, East, West])
                 (w ^. hud . diSections)
-                (Sel 0 i mempty)
+                (Sel 0 i)
 
 drawTerminalDisplay :: World -> Config -> Int -> Picture
 drawTerminalDisplay w cfig tid = fold $ do
@@ -407,7 +408,7 @@ drawTerminalCursorLink w cfig tm = fold $ do
                 invDP
                 (BoundCurs [North, South, East, West])
                 (w ^. hud . diSections)
-                (Sel 5 j mempty)
+                (Sel 5 j)
             )
             <> 
             lConnectCol (lp + V2 155 0) rp lcol white white

src/Dodge/Render/List.hs

@@ -12,6 +12,7 @@ module Dodge.Render.List (
     toTopLeft,
     listCursor,
     selSecDrawCursor,
+    selSecDrawCursorFixWidth,
     drawTitleBackground, -- should be renamed, made sensible
     drawCursorAt,
     drawLabelledList,
@@ -116,6 +117,26 @@ selSecDrawCursor ldp curs sss sel = fold $ do
             (_siWidth si)
             (_siHeight si)
 
+selSecDrawCursorFixWidth :: LDParams -> CursorDisplay -> IMSS a -> Selection -> Picture
+selSecDrawCursorFixWidth ldp curs sss sel = fold $ do
+    let i = sel ^. slSec
+        j = sel ^. slInt
+    yint <- selSecYint i j sss
+    sindent <- sss ^? ix i . ssIndent
+    si <- sss ^? ix i . ssItems . ix j
+    return $
+        listCursor
+            (ldp ^. ldpVerticalGap)
+            (ldp ^. ldpScale)
+            curs
+            yint
+            --(_siOffX si)
+            sindent
+            (_siColor si)
+            --(_siWidth si + sindent)
+            16
+            (_siHeight si)
+
 -- displays a cursor that should match up to list text pictures
 listCursor ::
     Float ->

src/Dodge/Render/Picture.hs

@@ -2,6 +2,9 @@
 
 module Dodge.Render.Picture (fixedCoordPictures) where
 
+import Dodge.ListDisplayParams
+import Dodge.SelectionSections
+import Dodge.Data.CardinalPoint
 import Linear hiding (rotate)
 import qualified SDL
 import Control.Lens
@@ -20,7 +23,7 @@ import Picture
 fixedCoordPictures :: Universe -> Picture
 fixedCoordPictures u =
     aimDelaySweep u
-        <> drawMenuOrHUD cfig u
+        <> drawMenuOrHUD u
         <> drawConcurrentMessage u
         <> toTopLeft cfig (translate (hw - 100) 0 $ drawList (map text (_uvTestString u u)))
         <> toTopLeft cfig
@@ -64,10 +67,11 @@ fpsText x = scale 0.2 0.2 . color col . text $ "ms/frame " ++ show x
         | x < 50 = orange
         | otherwise = red
 
-drawMenuOrHUD :: Config -> Universe -> Picture
-drawMenuOrHUD cf u = case u ^. uvScreenLayers of
-    [] -> drawHUD (u ^. uvConfig) (u ^. uvWorld)
-    (x : _) -> drawMenuScreen (u ^? uvWorld . input . mouseContext . mcoMenuClick . _Just) x cf
+-- why config and universe here?
+drawMenuOrHUD :: Universe -> Picture
+drawMenuOrHUD u = case u ^. uvScreenLayers of
+    [] -> drawHUD u
+    (x : _) -> drawMenuScreen (u ^? uvWorld . input . mouseContext . mcoMenuClick . _Just) x (u ^. uvConfig)
 
 drawConcurrentMessage :: Universe -> Picture
 drawConcurrentMessage u =
@@ -95,15 +99,15 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
     MouseMenu{} -> drawMenuClick 5
 --    MouseMenuCursor -> drawMenuCursor 5
     MouseInGame -> drawPlus 5
-    OverInvDrag 0 (Just (3, _)) -> drawDragDrop 5
-    OverInvDrag 0 Nothing -> drawDragDrop 5
-    OverInvDrag 0 (Just (0, _)) -> drawDrag 5
-    OverInvDrag 0 _ -> drawEmptySet 5
-    OverInvDrag 3 (Just (3, _)) -> drawDrag 5
-    OverInvDrag 3 (Just (0, _)) -> drawDragPickup 5
-    OverInvDrag 3 (Just (1, _)) -> drawDragPickup 5
-    OverInvDrag 3 Nothing -> drawDragPickup 5
-    OverInvDrag 3 _ -> drawEmptySet 5
+    OverInvDrag 0 | Just 3 <- mover ^? _Just.nonInf._1 -> drawDragDrop 5
+    OverInvDrag 0 | Nothing <- mover ^?_Just.nonInf -> drawDragDrop 5
+    OverInvDrag 0 | Just 0 <- mover ^? _Just.nonInf._1 -> drawDrag 5
+    OverInvDrag 0 -> drawEmptySet 5
+    OverInvDrag 3 | Just 3 <- mover ^?_Just.nonInf._1 -> drawDrag 5
+    OverInvDrag 3 | Just 0 <- mover ^?_Just.nonInf._1 -> drawDragPickup 5
+    OverInvDrag 3 | Just 1 <- mover ^?_Just.nonInf._1 -> drawDragPickup 5
+    OverInvDrag 3 | Nothing <-mover^?_Just.nonInf -> drawDragPickup 5
+    OverInvDrag 3 -> drawEmptySet 5
     OverInvDrag{} -> drawEmptySet 5
     OverInvDragSelect{} -> drawDragSelect 5
     OverInvSelect (-1, _) | selsec == Just (-1) -> drawJumpDown 5
@@ -128,6 +132,7 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
         return . toClosestMultiple (pi / 32) $
             argV (w ^. cWorld . lWorld . lAimPos -.- cpos)
                 - w ^. wCam . camRot
+    mover = inverseSelNumPos (u^.uvConfig) invDP (w^.input.mousePos) (w^.hud.diSections)
 
 drawAnySelectionBox :: Universe -> Picture
 drawAnySelectionBox  u = case u ^. uvWorld . input . mouseContext of

src/Dodge/SelectedClose.hs

@@ -1,19 +1,31 @@
 module Dodge.SelectedClose (getSelectedCloseObj, interactWithCloseObj) where
 
+import Dodge.Inventory
 import Control.Lens
 import Dodge.Button.Event
 import Dodge.Data.World
 import Dodge.Inventory.Add
 import NewInt
+import Data.Maybe
+import qualified Data.Map.Strict as M
+import qualified SDL
 
 interactWithCloseObj :: Either (NewInt ItmInt) Button -> World -> World
 interactWithCloseObj e w = worldEventFlags . at InventoryChange ?~ () $ case e of
-    (Left flit) -> pickUpItem 0 (_unNInt flit) w
+    (Left flit) 
+        | SDL.ScancodeCapsLock `M.member` (w ^. input . pressedKeys)
+        , Just (Sel 0 j) <- w ^. hud . diSelection
+            -> scrollAugInvSel 1 $ pickUpItemAt j (i,_unNInt flit) w
+    (Left flit) -> pickUpItem i (_unNInt flit) w
     (Right but) -> doButtonEvent (but ^. btEvent) but w
+  where
+    i = fromMaybe 0 $ do
+        Sel 3 j <- w ^. hud . diSelection
+        return j
 
 getSelectedCloseObj :: World -> Maybe (Either (NewInt ItmInt) Button)
 getSelectedCloseObj w = do
-    Sel i j _ <- w ^? hud . diSelection . _Just
+    Sel i j <- w ^? hud . diSelection . _Just
     case i of
         3 -> Left <$> w ^? hud . closeItems . ix j
         5 -> do

src/Dodge/SelectionSections.hs

@@ -8,20 +8,26 @@ module Dodge.SelectionSections (
     inverseSelSecYint,
     posSelSecYint,
     inverseSelNumPos,
+    inverseSelNumPosFixedWidth,
+    mouseInvPosFixWidth,
+    ssLookupGE,
+    ssLookupLE,
+    sssSelectionSlice,
+    ssScrollUsing,
+    ssLookupSecGTLoop,
+    ssLookupSecLTLoop,
 ) where
 
+import Dodge.ListDisplayParams
+import Dodge.Data.Universe
 import Control.Applicative
 import qualified Control.Foldl as L
 import Control.Lens
 import Control.Monad
 import Data.Foldable
 import qualified Data.IntMap.Strict as IM
-import qualified Data.IntSet as IS
 import Data.Maybe
 import Dodge.Data.CardinalPoint
-import Dodge.Data.Config
-import Dodge.Data.HUD
-import Dodge.Data.SelectionList
 import Dodge.ScreenPos
 import Geometry.Data
 
@@ -41,47 +47,25 @@ ssScrollUsing ::
     Maybe Selection
 ssScrollUsing g = ssScrollMinOnFail g . fmap (ssItems %~ IM.filter _siIsSelectable)
 
--- 
 ssScrollMinOnFail ::
     (Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)) ->
     IMSS a ->
     Maybe Selection ->
     Maybe Selection
-ssScrollMinOnFail f sss msel = fmap (\(i, j, _) -> Sel i j q) $ l <|> ssLookupMin sss
+ssScrollMinOnFail f sss msel = fmap (\(i, j, _) -> Sel i j) $ l <|> ssLookupMin sss
   where
-    q = fold (msel ^? _Just . slSet)
     l = do
-        Sel i j _ <- msel
+        Sel i j <- msel
         f i j sss
 
----- this version removes the selected set when scrolling outside it
---ssScrollMinOnFail' ::
---    (Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)) ->
---    IMSS a ->
---    Maybe Selection ->
---    Maybe Selection
---ssScrollMinOnFail' f sss msel = fmap (\(i, j, _) -> Sel i j (q i j)) $ l <|> ssLookupMin sss
---  where
---    q i j = fromMaybe mempty $ do
---        Sel k _ xs <- msel ^? _Just
---        guard $ j `IS.member` xs && i == k
---        return xs
---    l = do
---        Sel i j _ <- msel
---        f i j sss
-
 ssSetCursor ::
     (IMSS a -> Maybe (Int, Int, SelectionItem a)) ->
     IMSS a ->
     Maybe Selection ->
     Maybe Selection
 ssSetCursor f sss msel = fromMaybe msel $ do
-    (i, j, _) <- f sss
-    let newxs = fromMaybe mempty $ do
-            Sel k _ xs <- msel
-            guard $ k == i && j `IS.member` xs
-            return xs
-    return $ Just (Sel i j newxs)
+    (i,j,_) <- f sss
+    return $ Just (Sel i j)
 
 ssLookupMax :: IMSS a -> Maybe (Int, Int, SelectionItem a)
 ssLookupMax sss = do
@@ -110,24 +94,27 @@ ssLookupMaxInSection i sss = do
     return (i, j, s)
 
 ssLookupLT :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
-ssLookupLT i j sss = fromMaybe (ssLookupLT' i sss) $ do
+ssLookupLT i j sss = fromMaybe (ssLookupSecLT i sss) $ do
     ss <- sss ^? ix i
     (j', si) <- IM.lookupLT j (ss ^. ssItems)
     return $ Just (i, j', si)
 
-ssLookupLT' :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
-ssLookupLT' i sss = do
+ssLookupSecLTLoop :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
+ssLookupSecLTLoop i sss = ssLookupSecLT i sss <|> ssLookupMax sss
+
+ssLookupSecLT :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
+ssLookupSecLT i sss = do
     (i', ss) <- IM.lookupLT i sss
     case IM.lookupMax (ss ^. ssItems) of
         Just (j', si) -> return (i', j', si)
-        Nothing -> ssLookupLT' i' sss
+        Nothing -> ssLookupSecLT i' sss
 
 ssLookupLE' :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
 ssLookupLE' i sss = do
     (i', ss) <- IM.lookupLE i sss
     case IM.lookupMax (ss ^. ssItems) of
         Just (j', si) -> return (i', j', si)
-        Nothing -> ssLookupLT' i' sss
+        Nothing -> ssLookupSecLT i' sss
 
 ssLookupMin :: IMSS a -> Maybe (Int, Int, SelectionItem a)
 ssLookupMin sss = do
@@ -135,24 +122,43 @@ ssLookupMin sss = do
     ssLookupGE' i sss
 
 ssLookupGT :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
-ssLookupGT i j sss = fromMaybe (ssLookupGT' i sss) $ do
+ssLookupGT i j sss = fromMaybe (ssLookupSecGT i sss) $ do
     ss <- sss ^? ix i
     (j', si) <- IM.lookupGT j (ss ^. ssItems)
     return $ Just (i, j', si)
 
-ssLookupGT' :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
-ssLookupGT' i sss = do
+ssLookupSecGT :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
+ssLookupSecGT i sss = do
     (i', ss) <- IM.lookupGT i sss
     case IM.lookupMin (ss ^. ssItems) of
         Just (j', si) -> return (i', j', si)
-        Nothing -> ssLookupGT' i' sss
+        Nothing -> ssLookupSecGT i' sss
+
+ssLookupSecGTLoop :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
+ssLookupSecGTLoop i sss = ssLookupSecGT i sss <|> ssLookupMin sss
+
+ssLookupGE :: XInfinity (Int,Int) -> IMSS a -> Maybe (Int,Int,SelectionItem a)
+ssLookupGE x sss = case x of
+    NegInf -> ssLookupMin sss
+    PosInf -> Nothing
+    NonInf (i,j) -> case sss ^? ix i . ssItems . ix j of
+        Nothing -> ssLookupGT i j sss
+        Just s -> Just (i,j,s)
+
+ssLookupLE :: XInfinity (Int,Int) -> IMSS a -> Maybe (Int,Int,SelectionItem a)
+ssLookupLE x sss = case x of
+    NegInf -> Nothing
+    PosInf -> ssLookupMax sss
+    NonInf (i,j) -> case sss ^? ix i . ssItems . ix j of
+        Nothing -> ssLookupLT i j sss
+        Just s -> Just (i,j,s)
 
 ssLookupGE' :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
 ssLookupGE' i sss = do
     (i', ss) <- IM.lookupGE i sss
     case IM.lookupMin (ss ^. ssItems) of
         Just (j', si) -> return (i', j', si)
-        Nothing -> ssLookupGT' i' sss
+        Nothing -> ssLookupSecGT i' sss
 
 selSecSelSize :: Int -> Int -> IMSS a -> Maybe Int
 selSecSelSize i j = (^? ix i . ssItems . ix j . siHeight)
@@ -168,7 +174,7 @@ selSecYint i j sss = do
     ss <- sss ^? ix i
     return
         . (secpos +)
-        . subtract (ss ^. ssOffset)
+        . subtract (ss ^. ssYOffset)
         . sum
         . fmap _siHeight
         . fst
@@ -186,7 +192,7 @@ inverseSelSecYint yint sss
             then return $ inverseSelSecYint (yint - l) othersss
             else do
                 let ls = L.postscan (L.premap _siHeight L.sum) (_ssItems ss)
-                (j, _) <- L.fold (L.find (\(_, x) -> x - _ssOffset ss > yint)) $ IM.toList ls
+                (j, _) <- L.fold (L.find (\(_, x) -> x - _ssYOffset ss > yint)) $ IM.toList ls
                 return $ NonInf (i, j)
 
 inverseSelSecYintXPosCheck ::
@@ -208,6 +214,49 @@ inverseSelSecYintXPosCheck cfig ldp x yint sss = do
     guard $ x - x1 < 160 && x > x1
     return sel
 
+inverseSelSecYintXPosCheckFixedWidth ::
+    Config -> LDParams -> Float -> Int -> IMSS a -> Maybe (XInfinity (Int, Int))
+inverseSelSecYintXPosCheckFixedWidth cfig ldp x yint sss = do
+    let sel = inverseSelSecYint yint sss
+    (i,_) <- case sel of
+        NonInf v -> Just v
+        NegInf -> do 
+            (i',j',_) <- ssLookupMin sss
+            return (i',j')
+        PosInf -> do
+            (i',j',_) <- ssLookupMax sss
+            return (i',j')
+    let V2 x0 _ = screenPosAbs cfig (ldp ^. ldpPos)
+    sindent <- sss ^? ix i . ssIndent
+--    itindent <- sss ^? ix i . ssItems . ix j . siOffX
+    --let x1 = x0 + _ldpScale ldp * 10 * (fromIntegral (sindent + itindent) - 0.5)
+    let x1 = x0 + _ldpScale ldp * 10 * (fromIntegral (sindent) - 0.5)
+    guard $ x - x1 < 170 && x > x1
+    return sel
+
+mouseInvPosFixWidth :: Universe -> Maybe (XInfinity (Int,Int))
+mouseInvPosFixWidth u = inverseSelNumPosFixedWidth
+    (u^.uvConfig) 
+    invDP 
+    (u^.uvWorld. input . mousePos) 
+    (u ^.uvWorld. hud . diSections)
+
+
 inverseSelNumPos :: Config -> LDParams -> Point2 -> IMSS a -> Maybe (XInfinity (Int, Int))
 inverseSelNumPos cfig ldp (V2 x y) =
     inverseSelSecYintXPosCheck cfig ldp x (posSelSecYint cfig ldp y)
+
+inverseSelNumPosFixedWidth :: Config -> LDParams -> Point2 -> IMSS a -> Maybe (XInfinity (Int, Int))
+inverseSelNumPosFixedWidth cfig ldp (V2 x y) =
+    inverseSelSecYintXPosCheckFixedWidth cfig ldp x (posSelSecYint cfig ldp y)
+
+sssSelectionSlice :: IMSS a -> XInfinity (Int,Int) -> XInfinity (Int,Int) -> IMSS a
+sssSelectionSlice sss x1 x2 = fromMaybe mempty $ do
+    let (xmin,xmax) | x1 < x2 = (x1,x2)
+            | otherwise = (x2,x1)
+    (mini,minj,_) <- ssLookupGE xmin sss
+    (maxi,maxj,_) <- ssLookupLE xmax sss
+    return $ fst (IM.split (maxi+1) . snd $ IM.split (mini-1) sss)
+            & ix mini . ssItems %~ snd . IM.split (minj-1)
+            & ix maxi . ssItems %~ fst . IM.split (maxj+1)
+

src/Dodge/TestString.hs

@@ -58,7 +58,19 @@ crs :: Universe -> [Creature]
 crs u = u ^.. uvWorld . cWorld . lWorld . creatures . each
 
 testStringInit :: Universe -> [String]
-testStringInit _ = mempty
+testStringInit u = [ u ^. uvWorld . testString 
+    ] 
+    <> fold (u ^? uvWorld . cWorld . lWorld . creatures . ix 5 . crActionPlan . to prettyShort)
+    -- ] <> u ^.. uvWorld . cWorld . lWorld . creatures . each . crType . to (concat . prettyShort)
+--    <> u ^.. uvWorld . cWorld . lWorld . projectiles . each . pjPos . _z . to show
+--    <> u ^.. uvWorld . cWorld . lWorld . creatures . each . crType . slimeSlime .  to (show . slimeToRad)
+--    , u ^. uvWorld . input . mouseContext . to show
+--    , u ^. uvWorld . hud . diSelection . to show
+--    , u ^. uvWorld . cWorld . lWorld . lInvLock . to show
+--    ] 
+--    <>    u ^. uvWorld . hud . manObject . to prettyShort
+--    <> u ^.. uvWorld . hud . diSections . each . ssSet . to show
+--testStringInit u = u ^. uvWorld . cWorld . lWorld . creatures . ix 5 . crActionPlan . to prettyShort
     --[show . getSum $ foldMap (Sum . crslime) (crs u)]
 --     u ^.. tocrs . each . crType . slimeSplitTimer . to show
 --    u ^.. tocrs . ix 1 . crPos . _xy . to show
@@ -121,25 +133,24 @@ testStringInit _ = mempty
 
 topTestPart :: Universe -> [String]
 topTestPart u =
-    [ maybe "" showManObj $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
+    [ maybe "" showManObj $ u ^? uvWorld . hud . manObject
     ]
 
 showManObj :: ManipulatedObject -> String
-showManObj SortInventory = "SortInventory"
-showManObj (SelectedItem x y as z) =
-    "SelItem: "
-        ++ show x
-        ++ " Root: "
+--showManObj SortInventory = "SortInventory"
+showManObj (HeldItem y as z) =
+        " Root: "
         ++ show y
         ++ " Attached: "
         ++ show z
         ++ " AimStance: "
         ++ show as
-showManObj SelNothing = "SelNothing"
-showManObj SortCloseItem = "SortCloseItem"
-showManObj (SelCloseItem x) = "CloseItem " ++ show x
-showManObj SortCloseButton = "SortCloseButton"
-showManObj (SelCloseButton x) = "CloseButton " ++ show x
+showManObj HandsFree = "HandsFree"
+--showManObj SelNothing = "SelNothing"
+--showManObj SortCloseItem = "SortCloseItem"
+--showManObj (SelCloseItem x) = "CloseItem " ++ show x
+--showManObj SortCloseButton = "SortCloseButton"
+--showManObj (SelCloseButton x) = "CloseButton " ++ show x
 
 showTimeFlow :: TimeFlowStatus -> String
 showTimeFlow tfs = case tfs of

src/Dodge/Update.hs

@@ -129,6 +129,7 @@ updateWorldEventFlags u =
 updateWorldEventFlag :: WorldEventFlag -> Universe -> Universe
 updateWorldEventFlag wef = case wef of
     InventoryChange -> id -- updateInventoryPositioning
+        -- setInvPosFromSS ?
     -- for now update inventory positioning every tick
     CombineInventoryChange -> updateCombinePositioning
 
@@ -193,10 +194,8 @@ updateUniverseMid u = case _uvScreenLayers u of
             --            . (uvWorld . cWorld . highlightItems . filteredBy . non 0 -~ 1)
             . timeFlowUpdate
             . updateUseInputInGame
-            $ over
-                uvWorld
-                (updateMouseInGame (u ^. uvConfig) . updateCamera (u ^. uvConfig))
-                u
+            . updateMouseInGame
+            $ over uvWorld (updateCamera (u ^. uvConfig)) u
   where
     minusone x
         | x > 0 = Just $ x - 1
@@ -350,7 +349,7 @@ pushYouOutFromWalls u
 -- rotate creature as well? behaviour on ledges?
 muzzleWallCheck :: World -> Creature -> Creature
 muzzleWallCheck w cr = fromMaybe cr $ do
-    invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt
+    invid <- w ^? hud . manObject . hiRootSelectedItem . unNInt
     loc <-
         invIndents ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr)
             ^? ix invid . _2
@@ -368,7 +367,7 @@ muzzleWallCheck w cr = fromMaybe cr $ do
                     x = dotV v' v
                  in cr & crPos . _xy +~ min 1 x *^ v'
   where
-    f loc = map (muzzlePos loc cr) (itemMuzzles loc)
+    f loc = map (muzzlePos w loc cr) (itemMuzzles loc)
     g cp wls p = case collidePoint cp p wls of
         (ep, Just wl) -> Just (ep - p, wl)
         _ -> Nothing
@@ -425,7 +424,8 @@ updateMouseContext cfig u = case u ^? uvScreenLayers . ix 0 of
 
 updateMouseContextGame :: Config -> Universe -> MouseContext -> MouseContext
 updateMouseContextGame cfig u = \case
-    OverInvDrag i _ -> OverInvDrag i (inverseSelNumPos cfig invDP mpos disss ^? _Just . nonInf)
+    --OverInvDrag i -> OverInvDrag i -- (inverseSelNumPos cfig invDP mpos disss ^? _Just . nonInf)
+    x@OverInvDrag{} -> x
     x@OverInvDragSelect{} -> x
     MouseGameRotate x
         | ButtonRight `M.member` (w ^. input . mouseButtons) -> MouseGameRotate x
@@ -450,7 +450,7 @@ updateMouseContextGame cfig u = \case
                 return $ OverInvSelect selpos
     overcomb = do
         sss <- w ^? hud . subInventory . ciSections
-        Sel xl xr _ <- w ^? hud . subInventory . ciSelection . _Just
+        Sel xl xr <- w ^? hud . subInventory . ciSelection . _Just
         let msel = (xl, xr)
         let mpossel = inverseSelNumPos cfig secondColumnLDP (w ^. input . mousePos) sss ^? _Just . nonInf
         return $ case mpossel of
@@ -1026,18 +1026,16 @@ crCrSpring c1 c2
     , slimeFood c2
     , distance xy1 xy2 < r1 - (r2 + 5)
         = feedSlime c1 c2
-    | Just Nothing <- c1 ^? crType . slimeSplitTimer 
+    | maybe True not (c1 ^? crType . slimeDistortion . sdIsSplit) 
+        , SlimeCrit{} <- c1 ^. crType
         , slimeFood c2 = slimeSuck c1 c2
     | SlimeCrit{} <- c1 ^. crType = id
     | SlimeCrit{} <- c2 ^. crType = id
     | otherwise = cWorld . lWorld . creatures %~ ( olap c1 c2 . olap' c2 c1)
   where
     z c = c ^. crPos . _z
-    h c = fmap (+ z c) (crHeight c)
-    diffheight = fromMaybe True $ do
-        h1 <- h c1
-        h2 <- h c2
-        return $ z c1 > h2 || z c2 > h1
+    h c = crHeight c + z c
+    diffheight = z c1 > h c2 || z c2 > h c1
     olap a b = ix (a ^. crID) . crPos . _xy +~ overlap b
     olap' a b = ix (a ^. crID) . crPos . _xy -~ overlap b
     id1 = _crID c1
@@ -1058,7 +1056,7 @@ crCrSpring c1 c2
 slimeSuck :: Creature -> Creature -> World -> World
 slimeSuck c1 c2 = cWorld . lWorld . creatures %~ (rolap . rolap')
   where
-    suckx = (min 1 $ 2 * (1 - distance xy1 xy2 / (r1 + r2))) ^ (2:: Int)
+    suckx = min 1 (2 * (1 - distance xy1 xy2 / (r1 + r2))) ^ (2:: Int)
     rolap = ix id1 . crPos . _xy +~ f (suckx * 1.5 * m2 / (m1+m2)) *^ normalize (xy2 - xy1)
     rolap' = ix id2 . crPos . _xy +~ f (suckx * 1.5*m1 / (m1+m2)) *^ normalize (xy1 - xy2)
     f = min (distance xy1 xy2/2)
@@ -1080,22 +1078,18 @@ slimeFood cr = case cr ^. crType of
     _ -> False
 
 feedSlime :: Creature -> Creature -> World -> World
-feedSlime s c w = fromMaybe w $ do
-    ch <- crHeight c
-    return $ if min 10 r1 + s ^?! crType . slimeEngulfProgress < max 15 (ch + 2)
+feedSlime s c w = if min 10 r1 + s ^?! crType . slimeEngulfProgress < max 15 (ch + 2)
         then w & cWorld.lWorld.creatures.ix (s^.crID).crType.slimeEngulfProgress%~ (min r1.(+0.7))
                 & slimeSuck s c
-        else
-             w
+        else w
             & cWorld . lWorld . creatures . at (c ^. crID) %~ destroyCreature
-            & cWorld . lWorld . creatures . ix (s ^. crID) %~ f
+            & cWorld . lWorld . creatures . ix (s ^. crID) . crType . slimeSlime +~ x
+            & cWorld . lWorld . creatures . ix (s ^. crID) . crType . slimeSlimeChange +~ x
             & slimeEatSound (s ^. crID) (s ^. crPos . _xy)
   where
-    f cr = cr
-            & crType . slimeSlime +~ round (r2^(2::Int) * 100)
-            & crType . slimeSlimeChange +~ round (r2^(2::Int) * 100)
+    ch = crHeight c
+    x = round $ (c^.crType.to crRad)^(2::Int) * 100
     r1 = s ^?! crType . slimeSlime . to slimeToRad
-    r2 = c ^. crType . to crRad
 
 fuseSlimes :: Creature -> Creature -> World -> World
 fuseSlimes c1 c2 = (cWorld . lWorld . creatures . ix mini .~ c)
@@ -1113,12 +1107,6 @@ fuseSlimes c1 c2 = (cWorld . lWorld . creatures . ix mini .~ c)
             & crID .~ mini
     eslime = min (c1 ^?! crType . slimeSlime) (c2 ^?! crType . slimeSlime)
 
-slimeEatSound :: Int -> Point2 -> World -> World
-slimeEatSound i p w = w & soundStart (CrSound i) p s Nothing
-        & randGen .~ g
-      where
-        (s,g) = runState (takeOne [slurp1S,slurp2S,slurp3S,slurp4S,slurp5S]) (w ^. randGen)
-    
 
 updateDelayedEvents :: World -> World
 updateDelayedEvents w =

src/Dodge/Update/Camera.hs

@@ -6,6 +6,7 @@ module Dodge.Update.Camera (
     updateCamera,
 ) where
 
+import NewInt
 import Dodge.Update.Camera.Rotate
 import Linear.V3
 import Dodge.Creature.Radius
@@ -101,33 +102,33 @@ moveZoomCamera cfig theinput cr w campos =
         & camItemZoom .~ newItemZoom
   where
     mremotepos = do
-        i <- cr ^? crManipulation . manObject . imSelectedItem
-        itid <- cr ^? crInv . ix i
+        Sel 0 i <- w^?hud .diSelection._Just
+        itid <- cr ^? crInv . ix (NInt i)
         j <- w ^? cWorld . lWorld . items . ix itid . itUse . uaParams . apProjectiles . ix 0
         guard $ Just REMOTESCREEN == w ^? cWorld . lWorld . items . ix itid . itType . ibtAttach
         w ^? cWorld . lWorld . projectiles . ix j . pjPos . _xy
     docamrot = rotateV (campos ^. camRot)
     offset = fromMaybe noscopeoffset $ do
         guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
-        i <- cr ^? crManipulation . manObject . imSelectedItem
-        itid <- cr ^? crInv . ix i
+        Sel 0 i <- w^?hud.diSelection._Just
+        itid <- cr ^? crInv . ix (NInt i)
         fmap docamrot (w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticPos)
     noscopeoffset =
         docamrot $
             ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput
     newzoom = fromMaybe (newDefaultZoom * newItemZoom) $ do
-        i <- cr ^? crManipulation . manObject . imSelectedItem
-        itid <- cr ^? crInv . ix i
+        Sel 0 i <- w^?hud .diSelection._Just
+        itid <- cr ^? crInv . ix (NInt i)
         w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticZoom
     idealDefaultZoom = clipZoom wallZoom
     newDefaultZoom = fromMaybe (changeZoom (campos ^. camDefaultZoom) idealDefaultZoom) $ do
-        i <- cr ^? crManipulation . manObject . imSelectedItem
-        itid <- cr ^? crInv . ix i
+        Sel 0 i <- w^?hud .diSelection._Just
+        itid <- cr ^? crInv . ix (NInt i)
         w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticZoom
     idealItemZoom = fromMaybe 1 $ do
         guard $ crIsAiming cr
-        i <- cr ^? crManipulation . manObject . imSelectedItem
-        itid <- cr ^? crInv . ix i
+        Sel 0 i <- w^?hud .diSelection._Just
+        itid <- cr ^? crInv . ix (NInt i)
         getAimZoom <$> (w ^? cWorld . lWorld . items . ix itid)
     newItemZoom = changeZoom (campos ^. camItemZoom) idealItemZoom
     changeZoom curZoom idealZoom

src/Dodge/Update/Input/InGame.hs

@@ -5,24 +5,23 @@ module Dodge.Update.Input.InGame (
     updateMouseInGame,
 ) where
 
-import Dodge.Data.ScreenPos
-import Geometry.Data
-import Dodge.Base.Coordinate
-import Dodge.Button.Event
 import Control.Applicative
 import Control.Monad
 import Data.Foldable
 import qualified Data.IntMap.Strict as IM
-import qualified Data.IntSet as IS
+import qualified IntSetHelp as IS
 import Data.List (sort)
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import Data.Monoid
 import Dodge.Base.Collide
+import Dodge.Base.Coordinate
+import Dodge.Button.Event
 import Dodge.Camera
 import Dodge.Creature.Action
 import Dodge.Data.CardinalPoint
 import Dodge.Data.Combine
+import Dodge.Data.ScreenPos
 import Dodge.Data.Terminal.Status
 import Dodge.Data.Universe
 import Dodge.DisplayInventory
@@ -41,6 +40,7 @@ import Dodge.SoundLogic
 import Dodge.Terminal
 import Dodge.Update.Input.DebugTest
 import Dodge.Update.Input.Text
+import Geometry.Data
 import Geometry.Vector
 import LensHelp
 import NewInt
@@ -49,257 +49,240 @@ import SDL
 updateUseInputInGame :: Universe -> Universe
 updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . subInventory of
     DisplayTerminal tmid -> updateKeysInTerminal tmid u
-    CombineInventory{_ciSections = sss, _ciSelection = msel@(Just (Sel (-1) _ _))} ->
+    CombineInventory{_ciSections = sss, _ciSelection = msel@(Just (Sel (-1) _))} ->
         u
-            & tohud . subInventory %~ docombineregexinput sss msel
+            & uvWorld . hud . subInventory %~ docombineregexinput sss msel
             & uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
-    _ | disel == Just (-1) ->
-            u
-                & tohud %~ dodisplayregexinput diInvFilter diInvFilter (-1)
-                & uvWorld . worldEventFlags . at InventoryChange ?~ ()
-                & uvWorld %~ setInvPosFromSS
-    _ | disel == Just 2 ->
-            u
-                & tohud %~ dodisplayregexinput diCloseFilter diCloseFilter 2
-                & uvWorld . worldEventFlags . at InventoryChange ?~ ()
-                & uvWorld %~ setInvPosFromSS
+    NoSubInventory | Just 0 <- u ^. uvWorld . input . pressedKeys . at ScancodeTab
+        -> tabSections u
+    _ | Just (-1) <- disel -> f diInvFilter diInvFilter (-1)
+    _ | Just 2 <- disel -> f diCloseFilter diCloseFilter 2
     _ -> updateKeysInGame u
   where
     disel = u ^? uvWorld . hud . diSelection . _Just . slSec
-    tohud = uvWorld . hud
+    f x y i = u
+            & uvWorld . hud %~ dodisplayregexinput x y i
+            & uvWorld . worldEventFlags . at InventoryChange ?~ ()
+            & uvWorld %~ setInvPosFromSS -- not sure if this is necessary
     dodisplayregexinput filterprism filterlens x di = fromMaybe di $ do
         sss <- di ^? diSections
         msel <- di ^? diSelection
         filts <- di ^? filterprism
-        let (sss', msel', filts') = doRegexInput (u ^. uvWorld . input) x sss msel filts
-        return $
-            di & diSections .~ sss'
+        let ( msel', filts') = doRegexInput (u ^. uvWorld . input) x sss msel filts
+        return $ di
                 & diSelection .~ msel'
                 & filterlens .~ filts'
     docombineregexinput sss msel ci = fromMaybe ci $ do
         filts <- ci ^? ciFilter
-        let (sss', msel', filts') = doRegexInput (u ^. uvWorld . input) (-1) sss msel filts
-        return $
-            ci & ciSections .~ sss'
+        let ( msel', filts') = doRegexInput (u ^. uvWorld . input) (-1) sss msel filts
+        return $ ci
                 & ciSelection .~ msel'
                 & ciFilter .~ filts'
 
 updateKeysInGame :: Universe -> Universe
 updateKeysInGame u = M.foldlWithKey' updateKeyInGame u (u ^. uvWorld . input . pressedKeys)
 
-updateMouseInGame :: Config -> World -> World
-updateMouseInGame cfig w
-    | Just 0 <- lbpress = updateMouseClickInGame cfig w
-    | Just _ <- lbpress = updateMouseHeldInGame cfig w
-    | Just 0 <- lbrelease = updateMouseReleaseInGame w
-    | otherwise = w
+updateMouseInGame :: Universe -> Universe
+updateMouseInGame u
+    | Just 0 <- lbpress = updateMouseClickInGame u
+    | Just _ <- lbpress = updateMouseHeldInGame u
+    | Just 0 <- lbrelease = updateMouseReleaseInGame u
+    | otherwise = u
   where
-    lbpress = w ^? input . mouseButtons . ix ButtonLeft
-    lbrelease = w ^? input . mouseButtonsReleased . ix ButtonLeft
+    lbpress = u ^? uvWorld . input . mouseButtons . ix ButtonLeft
+    lbrelease = u ^? uvWorld . input . mouseButtonsReleased . ix ButtonLeft
 
-updateMouseHeldInGame :: Config -> World -> World
-updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
+updateMouseHeldInGame :: Universe -> Universe
+updateMouseHeldInGame u = case u ^. uvWorld . input . mouseContext of
     OverInvDragSelect{}
-        | ButtonRight `M.member` (w ^. input . mouseButtons) ->
-            w & input . mouseContext .~ MouseGameRotate (dist (mouseWorldPosW w) (w ^. wCam . camCenter))
-    OverInvDragSelect (Just sstart) _ ->
-        let sss = w ^. hud . diSections
-         in case inverseSelNumPos cfig invDP (w ^. input . mousePos) sss of
-                Nothing -> w & input . mouseContext . mcoSelEnd .~ Nothing
-                Just (NonInf (i, j))
-                    | i == fst sstart -> w & input . mouseContext . mcoSelEnd ?~ j
-                    | i < fst sstart -> w & input . mouseContext . mcoSelEnd ?~ 0
-                    | otherwise -> w 
-                        & input . mouseContext . mcoSelEnd
-                            .~ fmap
-                                fst
-                                (IM.lookupMax =<< sss ^? ix (fst sstart) . ssItems)
-                Just NegInf -> w & input . mouseContext . mcoSelEnd ?~ 0
-                Just PosInf -> 
-                        w & input . mouseContext . mcoSelEnd
-                            .~ fmap
-                                fst
-                                (IM.lookupMax =<< sss ^? ix (fst sstart) . ssItems)
-    -- not sure how the above performs when filtering...
-    OverInvDragSelect Nothing _ -> fromMaybe w $ do
-        sss <- w ^? hud . diSections
-        ysel <-
-            inverseSelSecYint
-                (posSelSecYint cfig invDP (w ^. input . mousePos . _y))
-                sss
-                ^? nonInf
-        guard (isGroupSelectableSection $ fst ysel)
-        return $ w & input . mouseContext .~ OverInvDragSelect (Just ysel) Nothing
-    OverInvDrag k mmouseover -> doDrag cfig 30 k mmouseover w
-    OverTerminalBar p -> w & tmLDP %~ setPixelOffsetBounded cfig (p + w ^. input . mousePos)
-    _ -> w
+        | ButtonRight `M.member` (u ^. uvWorld . input . mouseButtons) ->
+            u & uvWorld . input . mouseContext .~ MouseGameRotate 
+                (dist (mouseWorldPosW w) (w ^. wCam . camCenter))
+    OverInvDrag k -> u & doDrag 30 k
+    OverTerminalBar p -> u & uvWorld . tmLDP %~ setPixelOffsetBounded cfig (p + w ^. input . mousePos)
+    _ -> u
+  where
+    w = u ^. uvWorld
+    cfig = u ^. uvConfig
 
 setPixelOffsetBounded :: Config -> Point2 -> LDParams -> LDParams
 setPixelOffsetBounded cfig (V2 x y) ldp = ldp & ldpPos . spPixelOff .~ V2 x' y'
   where
     h = fromIntegral $ cfig ^. windowY
     w = fromIntegral $ cfig ^. windowX
-    x' = min (w - (w*a + 1+10*ldp ^?! ldpSize . _Just . _x . to fromIntegral)) 
-        $ max (1 - w * a) x
-    y' = min (h-(h*b + 20)) 
-        $ max (1+20*(ldp^.ldpVerticalGap + ldp^?!ldpSize._Just._y.to fromIntegral)-h*b) y
+    x' =
+        min (w - (w * a + 1 + 10 * ldp ^?! ldpSize . _Just . _x . to fromIntegral)) $
+            max (1 - w * a) x
+    y' =
+        min (h - (h * b + 20)) $
+            max (1 + 20 * (ldp ^. ldpVerticalGap + ldp ^?! ldpSize . _Just . _y . to fromIntegral) - h * b) y
     V2 a b = ldp ^. ldpPos . spScreenOff
 
-doDrag :: Config -> Int -> Int -> Maybe (Int, Int) -> World -> World
-doDrag cfig n k mmouseover w = fromMaybe w $ do
+doDrag :: Int -> Int -> Universe -> Universe
+doDrag n k u = fromMaybe u $ do
     guard (n /= 0)
     ss <- w ^? hud . diSections . ix k . ssItems
-    x <- mmouseover
-    is <- selectionSet w
+    x <- mouseInvPos u ^? _Just . nonInf
+    is <- selectionSet $ u ^. uvWorld . hud
     return $
         if concurrentIS is
-            then shiftInvItems cfig n k x is ss w
-            else collectInvItems k is w
+            then u & shiftInvItems n k x is ss
+            else u & uvWorld %~ collectInvItems k is
+  where
+    w = u ^. uvWorld
 
-tryDropSelected :: Maybe (Int, Int) -> World -> Maybe World
-tryDropSelected mpos w = do
-    guard $ maybe True (\(i, _) -> i == 3) mpos
+tryDropSelected :: Universe -> Maybe Universe
+tryDropSelected u = do
+    guard $ maybe True (== 3) $ mouseInvPos u ^? _Just . nonInf . _1
     cr <- w ^? cWorld . lWorld . creatures . ix 0
-    0 <- w ^? hud . diSelection . _Just . slSec
-    j <- w ^? hud . diSelection . _Just . slInt
-    xs <- selectionSet w
+    Sel 0 j <- w ^. hud . diSelection
+    xs <- selectionSet $ u ^. uvWorld . hud
     let xmin = IS.findMin xs
-    return 
-        . (hud . diSelection ?~ Sel 3 (j-xmin) (IS.fromDistinctAscList [0..IS.size xs - 1]))
-        . foldl' (flip $ dropItem cr) w . IS.toDescList $ xs
+    return $ u & uvWorld %~ (\w' -> setInvPosFromSS
+        . (hud . diSelection ?~ Sel 3 (j - xmin))
+        . foldl' (flip $ dropItem cr) w'
+        . IS.toDescList
+        $ xs)
+  where
+    w = u ^. uvWorld
 
-selectionSet :: World -> Maybe IS.IntSet
-selectionSet w = case w ^? hud . diSelection . _Just . slSet of
-        Just is' | not $ IS.null is' -> Just is'
-        _ -> IS.singleton <$> w ^? hud . diSelection . _Just . slInt
+selectionSet :: HUD -> Maybe IS.IntSet
+selectionSet h = do
+    j <- h ^? diSelection . _Just . slSec
+    case h ^? diSections . ix j . ssSet of
+        Just is | not $ IS.null is -> Just is
+        _ -> IS.singleton <$> h ^? diSelection . _Just . slInt
 
-
-tryPickupSelected :: Int -> Maybe (Int, Int) -> World -> Maybe World
-tryPickupSelected k mpos w = do
+tryPickupSelected :: Int -> Universe -> Maybe Universe
+tryPickupSelected k u = do
     guard $ k == 3
-    guard $ maybe True (\(i, _) -> i == 0 || i == 1) mpos
+    let mij = mouseInvPos u ^? _Just . nonInf
+    guard $ maybe True (\(i,_) -> i == 0 || i == 1) mij
     cr <- w ^? cWorld . lWorld . creatures . ix 0
-    xs <- selectionSet w
+    xs <- selectionSet $ u ^. uvWorld . hud
     sli <- w ^? hud . diSelection . _Just . slInt
     let xmin = IS.findMin xs
         joff = sli - xmin
     let nfreeslots = crNumFreeSlots (w ^. cWorld . lWorld . items) cr
-        itmstopickup = mapMaybe g $ IS.toList xs
+        is = IS.toList xs
+        itmstopickup = mapMaybe g is
         slotsneeded = alaf Sum foldMap itInvHeight itmstopickup
         ispickup = map (_unNInt . _itID) itmstopickup
     guard $ nfreeslots >= slotsneeded
-    return $ case mpos of
-        Just (0, j) -> foldr (pickUpItemAt j 0) w ispickup & newdisel j joff xs
-        _ -> foldl' (flip $ pickUpItem 0) w ispickup & newdisel (length (cr ^. crInv)) joff xs
+    return $ case mij of
+        Just (0, j) -> u & uvWorld %~ (\w' -> foldr (pickUpItemAt j) w' (zip is ispickup) & newdisel j joff)
+        _ -> u & uvWorld %~ (\w' -> foldl' (flip $ pickUpItem (head is)) w' ispickup & newdisel (length (cr ^. crInv)) joff)
   where
-    newdisel j joff xs =
-        hud . diSelection ?~ Sel 0 (j+joff) (IS.fromDistinctAscList [j .. j + IS.size xs -1])
+    w = u ^. uvWorld
+    newdisel j joff = hud . diSelection ?~ Sel 0 (j + joff)
     g i = do
         NInt j <- w ^? hud . closeItems . ix i
         w ^? cWorld . lWorld . items . ix j
 
-updateMouseReleaseInGame :: World -> World
-updateMouseReleaseInGame w = case w ^. input . mouseContext of
-    OverInvDrag k mpos ->
-        input . mouseContext .~ MouseInGame $
-            fromMaybe w $ tryDropSelected mpos w <|> tryPickupSelected k mpos w
-    OverInvDragSelect (Just ssel) mesel
-        | ScancodeLShift `M.member` (w ^. input . pressedKeys) ->
-            w & input . mouseContext .~ MouseInGame
-                & hud . diSelection . _Just . slSet
-                    %~ getuniques
-                        ( maybe
-                            mempty
-                            (h ssel)
-                            (guard (ssel ^? _1 == w ^? hud . diSelection . _Just . slSec) >> mesel ^? _Just)
-                        )
-    OverInvDragSelect (Just ssel) (Just esel) ->
-        w & input . mouseContext .~ MouseInGame
-            & invSetSelection (f (fst ssel, esel) (h ssel esel))
-    OverInvDragSelect{} ->
-        w & input . mouseContext .~ MouseInGame
-            & hud . diSelection . _Just . slSet %~ const mempty
-    _ -> w
+updateMouseReleaseInGame :: Universe -> Universe
+updateMouseReleaseInGame u = uvWorld . input . mouseContext .~ MouseInGame 
+    $ case u ^. uvWorld . input . mouseContext of
+        OverInvDrag k -> fromMaybe u $ tryDropSelected u <|> tryPickupSelected k u
+        OverInvDragSelect ssel -> doDragSelect ssel $ mresetssset u
+        _ -> u
   where
-    getuniques x y = IS.union x y IS.\\ IS.intersection x y
-    f (x, y) = Sel x y
-    h (k, i) j = fold $ do
-        sss <- w ^? hud . diSections . ix k . ssItems
-        let (_, xss) = IM.split (min i j -1) sss
-            (yss, _) = IM.split (max i j + 1) xss
-        return . IM.keysSet $ yss
+    mresetssset
+        | ScancodeLShift `M.member` (u ^. uvWorld . input . pressedKeys) = id
+        | otherwise = uvWorld . hud . diSections . each . ssSet .~ mempty
 
-isGroupSelectableSection :: Int -> Bool
-isGroupSelectableSection = \case
-    0 -> True
-    3 -> True
-    _ -> False
+doDragSelect :: XInfinity (Int, Int) -> Universe -> Universe
+doDragSelect x u = fromMaybe u $ do
+    sss <- u ^? uvWorld . hud . diSections
+    y <- mouseInvPosFixWidth u
+    return $ IM.foldlWithKey' f u $ sssSelectionSlice sss x y
+  where
+    f u' i ss
+        | i == 0 || i == 3 =
+            u' & uvWorld . hud . diSections . ix i . ssSet %~ IS.symmetricDifference (IM.keysSet (ss ^. ssItems))
+        | otherwise = u'
 
-updateMouseClickInGame :: Config -> World -> World
-updateMouseClickInGame cfig w = case w ^. input . mouseContext of
-    MouseInGame -> fromMaybe (w & input . mouseContext .~ OverInvDragSelect Nothing Nothing) $ do
-        let sss = w ^. hud . diSections
-        ysel <-
-            inverseSelSecYint
-                (posSelSecYint cfig invDP (w ^. input . mousePos . _y))
-                sss
-                ^? nonInf
-        guard (isGroupSelectableSection $ fst ysel)
-        return $ w & input . mouseContext .~ OverInvDragSelect (Just ysel) Nothing
+mouseInvHeight :: Universe -> XInfinity (Int,Int)
+mouseInvHeight u = 
+    inverseSelSecYint 
+        (posSelSecYint (u^.uvConfig) 
+        invDP 
+        (u ^.uvWorld . input . mousePos . _y)) 
+        (u ^.uvWorld . hud . diSections)
+
+mouseInvPos :: Universe -> Maybe (XInfinity (Int,Int))
+mouseInvPos u = inverseSelNumPos 
+    (u^.uvConfig) 
+    invDP 
+    (u^.uvWorld. input . mousePos) 
+    (u ^.uvWorld. hud . diSections)
+
+updateMouseClickInGame :: Universe -> Universe
+updateMouseClickInGame u = case w ^. input . mouseContext of
+    MouseInGame -> u & uvWorld . input . mouseContext .~ OverInvDragSelect (mouseInvHeight u)
+    OverInvSelect x
+        | ScancodeLShift `M.member` (w ^. input . pressedKeys) ->
+            u & uvWorld . input . mouseContext .~ OverInvDragSelect (NonInf x)
+                & maybeselectselected x
     OverInvSelect (-1, _)
         | selsec == Just (-1) ->
-            w & hud . diSelection %~ endRegex (-1) w
-                & hud . diInvFilter .~ Nothing
+            u
+                & uvWorld . hud . diSelection %~ endRegex (-1) w
+                & uvWorld . hud . diInvFilter .~ Nothing
     OverInvSelect (2, _)
         | selsec == Just 2 ->
-            w & hud . diSelection %~ endRegex 2 w
-                & hud . diCloseFilter .~ Nothing
-    OverInvSelect (5, j) -> fromMaybe w $ do
+            u
+                & uvWorld . hud . diSelection %~ endRegex 2 w
+                & uvWorld . hud . diCloseFilter .~ Nothing
+    OverInvSelect (5, j) -> fromMaybe u $ do
         k <- w ^? hud . closeButtons . ix j
         but <- w ^? cWorld . lWorld . buttons . ix k
-        return $ doButtonEvent (but ^. btEvent) but w
-    OverInvSelect x
-        | ScancodeLShift `M.member` (w ^. input . pressedKeys)
-            && isGroupSelectableSection (fst x) ->
-            w & input . mouseContext .~ OverInvDragSelect (Just x) (Just $ snd x)
-    OverInvSelect x -> startDrag x w
-    OverTerminal tmid TerminalTextInput{} -> terminalReturnEffect tmid w
-    OverTerminal tmid TerminalPressTo{} -> continueTerminal tmid w
-    OutsideTerminal -> w & hud . subInventory .~ NoSubInventory
+        return $ u & uvWorld %~ doButtonEvent (but ^. btEvent) but
+    OverInvSelect x -> u & uvWorld %~ startDrag x
+    OverTerminal tmid TerminalTextInput{} -> u & uvWorld %~ terminalReturnEffect tmid
+    OverTerminal tmid TerminalPressTo{} -> u & uvWorld %~ continueTerminal tmid
+    OutsideTerminal -> u & uvWorld . hud . subInventory .~ NoSubInventory
     OverCombSelect x ->
-        w & hud . subInventory . ciSelection ?~ f x
-            & worldEventFlags . at CombineInventoryChange ?~ ()
+        u
+            & uvWorld .hud . subInventory . ciSelection ?~ f x
+            & uvWorld .worldEventFlags . at CombineInventoryChange ?~ ()
     OverCombFilter ->
-        w & hud . subInventory . ciFilter .~ Nothing
-            & worldEventFlags . at CombineInventoryChange ?~ ()
-            & hud . subInventory . ciSelection %~ endCombineRegex w
+        u
+            & uvWorld . hud . subInventory . ciFilter .~ Nothing
+            & uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
+            & uvWorld . hud . subInventory . ciSelection %~ endCombineRegex w
     OverCombCombine x ->
-        w
-            & tryCombine x
-            & worldEventFlags . at CombineInventoryChange ?~ ()
-            & worldEventFlags . at InventoryChange ?~ ()
-            & maybeExitCombine
+        u
+            & uvWorld %~ tryCombine x
+            & uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
+            & uvWorld . worldEventFlags . at InventoryChange ?~ ()
+            & uvWorld %~ maybeExitCombine
     OverCombEscape ->
-        w
-            & worldEventFlags . at InventoryChange ?~ ()
-            & hud . subInventory .~ NoSubInventory
-    OverCombFiltInv (0, j) -> fromMaybe w $ do
+        u
+            & uvWorld . worldEventFlags . at InventoryChange ?~ ()
+            & uvWorld . hud . subInventory .~ NoSubInventory
+    OverCombFiltInv (0, j) -> u & uvWorld %~ (\w' -> fromMaybe w' $ do
         str <-
             fmap (take 5) $
-                w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix (NInt j)
+                w' ^? cWorld . lWorld . creatures . ix 0 . crInv . ix (NInt j)
                     >>= \k ->
-                        w ^? cWorld . lWorld . items . ix k
+                        w' ^? cWorld . lWorld . items . ix k
                             >>= (listToMaybe . basicItemDisplay)
         return . (worldEventFlags . at CombineInventoryChange ?~ ()) $
-            case w ^? hud . subInventory . ciFilter . _Just of
+            case w' ^? hud . subInventory . ciFilter . _Just of
                 Just ('#' : xs)
                     | str == xs ->
-                        w & hud . subInventory . ciFilter .~ Nothing
-                _ -> w & hud . subInventory . ciFilter ?~ ("#" ++ str)
-    _ -> w
+                        w' & hud . subInventory . ciFilter .~ Nothing
+                _ -> w' & hud . subInventory . ciFilter ?~ ("#" ++ str)
+            )
+    _ -> u
   where
-    f (x, y) = Sel x y mempty
+    w = u ^. uvWorld
+    f (x, y) = Sel x y
     selsec = w ^? hud . diSelection . _Just . slSec
+    maybeselectselected (i,_) = fromMaybe id $ do
+        Sel i' j <- w ^. hud . diSelection
+        guard $ i' == i && w ^? hud . diSections . ix i . ssSet == Just IS.empty
+        return $ uvWorld . hud . diSections . ix i . ssSet .~ IS.singleton j
 
 endRegex :: Int -> World -> Maybe Selection -> Maybe Selection
 endRegex i w = ssSetCursor (ssLookupDown i j) sss
@@ -314,56 +297,66 @@ endCombineRegex w = ssSetCursor (ssLookupDown 0 j) sss
     j = fromMaybe 0 $ do
         itms <- sss ^? ix 0 . ssItems
         (k, _) <- IM.lookupMin itms
-        return (k -1)
+        return (k - 1)
 
 startDrag :: (Int, Int) -> World -> World
-startDrag (a, b) w = setcontext $ case w ^? hud . diSelection . _Just of
-    Just (Sel i _ xs) | i == a && b `IS.member` xs -> w
---    _ -> invSetSelection (Sel a b (IS.singleton b)) w
-    _ -> invSetSelection (Sel a b mempty) w
+startDrag (a, b) w =
+    w
+        & input . mouseContext .~ OverInvDrag a
+        & invSetSelectionPos a b
+        & f
   where
-    setcontext = input . mouseContext .~ OverInvDrag a (Just (a, b))
-
+    f = fromMaybe id $ do
+        is <- w ^? hud . diSections . ix a . ssSet
+        guard $ not $ b `IS.member` is
+        return $ hud . diSections . ix a . ssSet .~ mempty
 
 shiftInvItems ::
-    Config ->
     Int -> -- recurse limit
     Int -> -- section where drag started
     (Int, Int) -> -- selection item mouse is over
     IS.IntSet ->
     IM.IntMap (SelectionItem a) ->
-    World ->
-    World
-shiftInvItems cfig n k x xs ss w = setSelWhileDragging . fromMaybe w $ do
+    Universe ->
+    Universe
+shiftInvItems n k x xs ss u = setSelWhileDragging . fromMaybe u $ do
     let xk = fst x
-    let yint = posSelSecYint cfig invDP (w ^. input . mousePos . _y)
+    let yint = posSelSecYint (u^.uvConfig) invDP (w ^. input . mousePos . _y)
         bn =
             (\v -> inverseSelSecYint (yint + 1) v ^? nonInf)
                 =<< w ^? hud . diSections
         ab =
             (\v -> inverseSelSecYint (yint - 1) v ^? nonInf)
                 =<< w ^? hud . diSections
-    guard $ xk == k || xk + 1 == k || xk -1 == k
+    guard $ xk == k || xk + 1 == k || xk - 1 == k
     (maxi, _) <- IS.maxView xs
     (mini, _) <- IS.minView xs
     case True of
         _ | x < (k, mini) -> do
             guard $ not . null . fst $ IM.split mini ss
-            guard $ Just (k, mini -1) /= ab
-            return . doDrag cfig (n -1) k (Just x) $ shiftInvItemsUp k xs w
+            guard $ Just (k, mini - 1) /= ab
+            return . doDrag (n - 1) k $ (uvWorld %~ shiftInvItemsUp k xs) u
         _ | x > (k, maxi) -> do
             guard $ not . null . snd $ IM.split maxi ss
             guard $ Just (k, maxi + 1) /= bn
-            return . doDrag cfig (n -1) k (Just x) $ shiftInvItemsDown k xs w
+            return . doDrag (n - 1) k $ (uvWorld %~ shiftInvItemsDown k xs) u
         _ -> Nothing
+  where
+    w = u ^. uvWorld
 
-setSelWhileDragging :: World -> World
-setSelWhileDragging w = fromMaybe w $ do
-    Sel i _ xs <- w ^? hud . diSelection . _Just
-    (k, j) <- w ^? input . mouseContext . mcoMaybeSelect . _Just
+setSelWhileDragging :: Universe -> Universe
+setSelWhileDragging u = fromMaybe u $ do
+    Sel i _ <- u ^? uvWorld . hud . diSelection . _Just
+    xs <- u ^? uvWorld . hud . diSections . ix i . ssSet
+    -- (k, j) <- w ^? input . mouseContext . mcoMaybeSelect . _Just
+    (k, j) <- mouseInvPos u ^? _Just . nonInf
     guard $ i == k && j `IS.member` xs
-    return $ w & hud . diSelection . _Just . slInt .~ j
+    return $ u & uvWorld . hud . diSelection . _Just . slInt .~ j
 
+--    Sel i _ xs <- w ^? hud . diSelection . _Just
+--    (k, j) <- w ^? input . mouseContext . mcoMaybeSelect . _Just
+--    guard $ i == k && j `IS.member` xs
+--    return $ w & hud . diSelection . _Just . slInt .~ j
 
 updateFunctionKeys :: Universe -> Universe
 updateFunctionKeys u =
@@ -418,7 +411,14 @@ updateKeysTextInputTerminal tmid u =
             (uvWorld . cWorld . lWorld . terminals . ix tmid . tmStatus . tiText)
         & checkEndStatus
         & tryTabComplete
-        & uvWorld . cWorld . lWorld . terminals . ix tmid . tmStatus . tiText %~ take 42
+        & uvWorld
+        . cWorld
+        . lWorld
+        . terminals
+        . ix tmid
+        . tmStatus
+        . tiText
+        %~ take 42
   where
     checkEndStatus
         | u ^. uvWorld . input . pressedKeys . at ScancodeReturn == Just 0 =
@@ -446,8 +446,45 @@ updateInitialPressInGame uv = \case
     -- the following should be put in a more sensible place
     ScancodeSlash -> uv & uvWorld %~ updateEnterRegex
     ScancodeBackspace -> uv & uvWorld %~ updateBackspaceRegex
+--    ScancodeTab | NoSubInventory <- uv ^. uvWorld . hud . subInventory 
+--        -> uv & uvWorld %~ tabSections
     _ -> uv
 
+tabSections :: Universe -> Universe
+tabSections u = u
+    & uvWorld .hud . diInvFilter %~ (<|> Just "")
+    & uvWorld .hud . diCloseFilter %~ (<|> Just "")
+    & updateInventoryPositioning
+    & h
+    & f
+    & g
+    & updateInventoryPositioning
+  where
+    scroll
+        | ScancodeLShift `M.member` (u ^. uvWorld . input . pressedKeys)
+            || ScancodeRShift `M.member` (u ^. uvWorld . input . pressedKeys)
+            = ssLookupSecLTLoop
+        | otherwise = ssLookupSecGTLoop
+    h u' = u' & uvWorld.hud . diSelection %~ ssScrollUsing (\i _ -> scroll i) (u' ^. uvWorld . hud . diSections)
+    f u' = fromMaybe u' $ do
+        i <- u' ^? uvWorld . hud . diSelection . _Just . slSec
+        guard $ Just "" == (u' ^. uvWorld . hud . diInvFilter) && (-1) /= i
+        return $ u' & uvWorld . hud . diInvFilter .~ Nothing
+    g u' = fromMaybe u' $ do
+        i <- u' ^? uvWorld . hud . diSelection . _Just . slSec
+        guard $ Just "" == (u' ^.uvWorld .  hud . diCloseFilter) && (2) /= i
+        return $ u' & uvWorld . hud . diCloseFilter .~ Nothing
+        
+--    | Just (-1) <- ssec = w & scrollAugInvSel 1 & hud . diInvFilter %~ mclose
+--    | Just 0 <- ssec = w & hud . diSelection ?~ Sel 2 0 & hud . diCloseFilter %~ (<|> Just "")
+--    | Just 1 <- ssec = w & hud . diSelection ?~ Sel 2 0 & hud . diCloseFilter %~ (<|> Just "")
+--    | Just 2 <- ssec = w & hud . diCloseFilter %~ mclose & scrollAugInvSel 1
+--    | otherwise = w
+--  where
+--    mclose (Just "") = Nothing
+--    mclose x = x
+--    ssec = w ^? hud . diSelection . _Just . slSec
+
 updateLongPressInGame :: Universe -> Scancode -> Universe
 updateLongPressInGame uv = \case
     ScancodeF -> over uvWorld youDropItem uv
@@ -460,19 +497,17 @@ doRegexInput ::
     IMSS a ->
     Maybe Selection ->
     Maybe String ->
-    (IMSS a, Maybe Selection, Maybe String)
+    (Maybe Selection, Maybe String)
 doRegexInput inp i sss msel filts
     | backspacetonothing || escapekey = endregex i 0
-    | endkeys = endregex (i + 1) (j -1)
+    | endkeys = endregex (i + 1) (j - 1)
     | otherwise =
-        ( sss
-        , msel
+        ( msel
         , filts & doTextInputOver inp _Just
         )
   where
     endregex a b =
-        ( sss
-        , msel & ssSetCursor (ssLookupDown a b) sss
+        ( msel & ssSetCursor (ssLookupDown a b) sss
         , Nothing
         )
     j = fromMaybe 0 $ do
@@ -489,14 +524,17 @@ updateBackspaceRegex :: World -> World
 updateBackspaceRegex w = case di ^? subInventory of
     Just NoSubInventory{}
         | secfocus (-1) 0 ->
-            w & hud %~ trybackspace (-1) diInvFilter diInvFilter diSelection
+            w
+                & hud %~ trybackspace (-1) diInvFilter diInvFilter diSelection
                 & worldEventFlags . at InventoryChange ?~ ()
     Just NoSubInventory{}
         | secfocus 2 3 ->
-            w & hud %~ trybackspace 2 diCloseFilter diCloseFilter diSelection
+            w
+                & hud %~ trybackspace 2 diCloseFilter diCloseFilter diSelection
                 & worldEventFlags . at InventoryChange ?~ ()
     Just CombineInventory{} ->
-        w & hud . subInventory %~ trybackspace (-1) ciFilter ciFilter ciSelection
+        w
+            & hud . subInventory %~ trybackspace (-1) ciFilter ciFilter ciSelection
             & worldEventFlags . at InventoryChange ?~ ()
     _ -> w
   where
@@ -507,8 +545,9 @@ updateBackspaceRegex w = case di ^? subInventory of
         str <- he ^? filtget . _Just
         return $ case str of
             (_ : _) ->
-                he & filtset . _Just %~ init
-                    & selset ?~ Sel x 0 mempty
+                he
+                    & filtset . _Just %~ init
+                    & selset ?~ Sel x 0
             [] -> he & filtset .~ Nothing
     di = w ^. hud
 
@@ -516,20 +555,21 @@ updateEnterRegex :: World -> World
 updateEnterRegex w = case w ^? hud . subInventory of
     Just NoSubInventory{}
         | secfocus [-1, 0, 1] ->
-            w & hud . diSelection ?~ Sel (-1) 0 mempty
+            w
+                & hud . diSelection ?~ Sel (-1) 0
                 & hud . diInvFilter %~ enterregex
     Just NoSubInventory{}
         | secfocus [2, 3] ->
-            w & hud . diSelection ?~ Sel 2 0 mempty
+            w
+                & hud . diSelection ?~ Sel 2 0
                 & hud . diCloseFilter %~ enterregex
     Just CombineInventory{} ->
-        w & hud . subInventory . ciFilter %~ enterregex
-            & hud . subInventory . ciSelection ?~ Sel (-1) 0 mempty
+        w
+            & hud . subInventory . ciFilter %~ enterregex
+            & hud . subInventory . ciSelection ?~ Sel (-1) 0
     _ -> w
   where
-    secfocus xs = fromMaybe False $ do
-        i <- w ^? hud . diSelection . _Just . slSec
-        return $ i `elem` xs
+    secfocus xs = maybe False (`elem` xs) $ w ^? hud . diSelection . _Just . slSec
     enterregex = (<|> Just "")
 
 pauseGame :: Universe -> Universe
@@ -555,19 +595,12 @@ getCloseObj w = getSelectedCloseObj w <|> topcitem <|> topcbut
 tryCombine :: (Int, Int) -> World -> World
 tryCombine (i, j) w = fromMaybe w $ do
     CombItem is it <-
-        w
-            ^? hud . subInventory
-                . ciSections
-                . ix i
-                . ssItems
-                . ix j
-                . siPayload
-                . _Just
+        w ^? hud . subInventory . ciSections . ix i . ssItems . ix j . siPayload . _Just
     p <- w ^? cWorld . lWorld . creatures . ix 0 . crPos . _xy
     return $
         createItemYou it (foldr (destroyInvItem 0 . NInt) w (sort is))
             & soundStart InventorySound p wrench1S Nothing
-            & hud . diSelection . _Just . slSet .~ mempty
+            & hud . diSections . ix 1 . ssSet .~ mempty
 
 maybeExitCombine :: World -> World
 maybeExitCombine w

src/Dodge/Update/Scroll.hs

@@ -34,22 +34,23 @@ updateBaseWheelEvent yi w
         EquipOptions{} -> w & rbState . opSel %~ scrollRBOption yi rbscrollmax
         NoRightButtonState -> fromMaybe w (selectedItemScroll yi w)
     | bdown ButtonLeft = w & wCam . camZoom +~ fromIntegral yi
-    | ScancodeCapsLock `M.member` _pressedKeys (_input w) 
-        , ScancodeLShift `M.member` (w ^. input . pressedKeys) = changeSwapSel yi w
-    | ScancodeCapsLock `M.member` _pressedKeys (_input w) = changeSwapSelSet yi w
-    | ScancodeLShift `M.member` (w ^. input . pressedKeys) = multiSelScroll yi w
+    | kdown ScancodeCapsLock
+        , kdown ScancodeLShift = changeSwapSel yi w
+    | kdown ScancodeCapsLock = changeSwapSelSet yi w
+    | kdown ScancodeLShift = multiSelScroll yi w
     | otherwise = scrollAugInvSel yi w
   where
+    kdown k = k `M.member` (w ^. input . pressedKeys)
     bdown b = w & has (input . mouseButtons . ix b)
     rbscrollmax = fromMaybe 1 $ do
-        invid <- you w ^? crManipulation . manObject . imSelectedItem
-        etype <- you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType
+        Sel 0 invid <- w ^. hud.diSelection
+        etype <- you w ^? crInv . ix (NInt invid) >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType
         return . length $ eqTypeToSites etype
 
 selectedItemScroll :: Int -> World -> Maybe World
 selectedItemScroll yi w = do
-    i <- you w ^? crManipulation . manObject . imSelectedItem
-    itm <- you w ^? crInv . ix i >>= \k -> w ^? cWorld . lWorld . items . ix k
+    Sel 0 i <- w ^.hud.diSelection
+    itm <- you w ^? crInv . ix (NInt i) >>= \k -> w ^? cWorld . lWorld . items . ix k
     return $ itemScroll yi itm w
 
 itemScroll :: Int -> Item -> World -> World

src/Dodge/WorldEvent/ThingsHit.hs

@@ -20,6 +20,7 @@ module Dodge.WorldEvent.ThingsHit (
     isWalkable,
     isFlyable,
     crOnSeg,
+    walkablePoint,
 ) where
 
 import ListHelp
@@ -235,6 +236,10 @@ isFlyable p1 p2 =
         . foldMap (^. _2 . to getWallPathing)
         . wlsHitUnsorted p1 p2
 
+walkablePoint :: Creature -> Point2 -> Point2 -> World -> Point2
+{-#INLINE walkablePoint#-}
+walkablePoint cr p1 p2 w = fst $ collideCircWalls p1 p2 (crRad (cr^.crType)) (wlsNearSeg p1 p2 w)
+
 isWalkable :: Point2 -> Point2 -> World -> Bool
 {-# INLINE isWalkable #-}
 isWalkable p1 p2 w = isFlyable p1 p2 w && not (any f (w ^. cWorld . cliffs))

src/Geometry/Intersect.hs

@@ -374,6 +374,7 @@ intersectCircLine c r x y =
     f :: Float -> Point2
     f a = x + (a *.* (y - x))
 
+--I believe the Maybes are entry or exit points, and reflections in these points
 intersectCylSeg :: Point3 -> Float -> Float -> Point3 -> Point3 ->
     (Maybe (Point3, Point3), Maybe (Point3, Point3))
 intersectCylSeg p r h s e = fromMaybe (Nothing, Nothing) $ do

src/IntSetHelp.hs

@@ -0,0 +1,19 @@
+module IntSetHelp (
+    module Data.IntSet,
+    deleteShift,
+    symmetricDifference,
+) where
+
+-- import qualified Prelude
+
+import Data.IntSet
+import Prelude hiding (map)
+
+deleteShift :: Int -> IntSet -> IntSet
+deleteShift i x = y <> map (subtract 1) z
+  where
+    (y, z) = split i x
+
+-- this is in Data.IntSet 0.8
+symmetricDifference :: IntSet -> IntSet -> IntSet
+symmetricDifference x y = (x `union` y) \\ (x `intersection` y)

src/Loop.hs

@@ -28,7 +28,7 @@ import Data.Foldable
  
 -- | Create a game loop with an SDL window.
 setupLoop ::
-    -- | Target seconds per frame
+    -- | Target mseconds per frame
     Int ->
     -- | Window title
     T.Text ->
@@ -101,7 +101,7 @@ applyEventIO fn mw e = case eventPayload e of
 
 -- | Create a game loop with an SDL window.
 setupConLoop ::
-    -- | Target seconds per frame
+    -- | Target mseconds per frame
     Int ->
     -- | Window title
     T.Text ->
@@ -191,7 +191,7 @@ doConLoop themvar spf window coneffs worldSideEffects eventFn !startWorld = go s
 
 -- | Create a game loop with an SDL window.
 setupConLoop' ::
-    -- | Target seconds per frame
+    -- | Target mseconds per frame
     Int ->
     -- | Window title
     T.Text ->

src/Quaternion.hs

@@ -8,6 +8,8 @@ The warnings have been disabled.
 module Quaternion (
     qid,
     qz,
+    qx,
+    qy,
     qToV3,
     qToV2,
     qToAng,
@@ -81,4 +83,10 @@ apply (p,q) p1 = p + Q.rotate q p1
 qz :: Float -> Q.Quaternion Float
 qz = Q.axisAngle (V3 0 0 1)
 
+qx :: Float -> Q.Quaternion Float
+qx = Q.axisAngle (V3 1 0 0)
+
+qy :: Float -> Q.Quaternion Float
+qy = Q.axisAngle (V3 0 1 0)
+
 --deriving instance (Flat a => Flat (Quaternion a))