Cleanup inventory management, arbitrary limit on cloud height

src/Dodge/Inventory.hs

@@ -190,7 +190,7 @@ updateRBList w
 chooseEquipmentPosition :: Creature -> [EquipPosition] -> Int
 chooseEquipmentPosition cr eps = fromMaybe (chooseFreeSite cr eps) $ do
     ep <- cr ^? crInvEquipped . ix (_crInvSel cr)
-    findIndex (==ep) eps
+    elemIndex ep eps
 
 chooseFreeSite :: Creature -> [EquipPosition] -> Int
 chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
@@ -238,7 +238,7 @@ setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
             Just i | i == invsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
             Just i | invselcanactivate -> w & rbOptions . opActivateEquipment .~ ActivateDeactivateEquipment
                 {_activateEquipment = invsel,_deactivateEquipment = i}
-            Just i | Just i == rbos ^? allocSwapID || Just i == rbos ^? allocRemoveID
+            Just i | Just i == rbos ^? allocRemoveID
                    -> w & rbOptions . opActivateEquipment .~ DeactivateEquipment i
             Just _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
             Nothing | invselcanactivate -> w & rbOptions . opActivateEquipment .~ ActivateEquipment

src/Dodge/Item/Equipment.hs

@@ -221,10 +221,10 @@ brainHat = defaultEquipment
     }
     & itUse . eqSite .~ GoesOnHead
 
-headLamp :: Item
-headLamp = defaultEquipment
+headLamp1 :: Item
+headLamp1 = defaultEquipment
     { _itType = HEADLAMP
-    , _itName = "HEADLAMP"
+    , _itName = "HEADLAMP1"
     , _itEquipPict = pictureOnEquip (noPic $ colorSH yellow $ 
             translateSHf 5 2 (upperPrismPoly 8 $ rectWH 4 1)
             <> translateSHf 5 (-2) (upperPrismPoly 8 $ rectWH 4 1)
@@ -235,6 +235,23 @@ headLamp = defaultEquipment
     }
     & itUse . eqUse .~ createHeadLamp
     & itUse . eqSite .~ GoesOnHead
+headLamp :: Item
+headLamp = defaultEquipment
+    { _itType = HEADLAMP
+    , _itName = "HEADLAMP"
+    , _itEquipPict = pictureOnEquip (noPic headLampShape)
+    , _itEffect = NoItEffect
+    , _itID = Nothing
+    }
+    & itUse . eqUse .~ createHeadLamp
+    & itUse . eqSite .~ GoesOnHead
+
+headLampShape :: Shape
+headLampShape = colorSH yellow $ 
+    translateSH (V3 5 2 4) (upperPrismPoly 4 $ rectWH 4 1)
+    <> translateSH (V3 5 2 0) (upperPrismPoly 4 $ rectWH 4 1)
+    <> translateSH (V3 5 (-2) 4) (upperPrismPoly 4 $ rectWH 4 1)
+    <> translateSH (V3 5 (-2) 0) (upperPrismPoly 4 $ rectWH 4 1)
 
 createHeadLamp :: Creature -> Int -> World -> World
 createHeadLamp cr _ = tempLightSources .:~ tlsTimeRadColPos 1 200 0.7 

src/Dodge/Render/HUD.hs

@@ -132,10 +132,6 @@ subInventoryDisplay subinv cfig w = case subinv of
         _ -> mempty
     equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr)
     f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
---        | _crInvSel cr /= invid || not (ButtonRight `S.member` _mouseButtons w)
---            = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
---        | otherwise = mempty
-    --rboptions = listTextPicturesAtOffset 200 0 cfig (selNumPos invid w) ["TEST","ME"]
     rboptions = if ButtonRight `S.member` _mouseButtons w
         then drawRBOptions cfig w (_rbOptions w)
         else mempty

src/Dodge/Update.hs

@@ -307,7 +307,8 @@ updateCloud w c
     newPos2 = stripZ newPos
     -- the following only tests for the first collision with a wall
     hitWl = collidePointAnyWallsReflect oldPos2 newPos2 $ wallsNearPoint newPos2 w
-    finalPos = addZ npz $ maybe newPos2 fst hitWl
+    finalPos = addZ (min 74 npz) $ maybe newPos2 fst hitWl
+        -- allowing clouds to height 75 causes graphical glitches 22.05.23
     finalVel = addZ nvz $ maybe newVel2 snd hitWl
 
 --updateCloud :: World -> Cloud -> Maybe Cloud