Work on pickup and putdown of inventory items

src/Dodge/Creature.hs

@@ -167,10 +167,9 @@ startInvList =
     , hvAutoGun
     ]
 startInventory :: IM.IntMap Item
-startInventory = IM.fromList $ zip [0..defaultInvSize -1] $ startInvList ++ repeat NoItem
+startInventory = IM.fromList $ zip [0..] startInvList
 stackedInventory :: IM.IntMap Item
-stackedInventory = IM.fromList (zip [0..25] 
+stackedInventory = IM.fromList $ zip [0..] 
-    (
     [spreadGun
     ,rewindGun
     ,tractorGun
@@ -205,8 +204,6 @@ stackedInventory = IM.fromList (zip [0..25]
     --,medkit 50
     --,bezierGun
     ]
-      ++ 
-    repeat NoItem))
 smokeGenGun :: Item
 smokeGenGun = effectGun "smoke" $ const spawnSmokeAtCursor
 

src/Dodge/Creature/Action.hs

@@ -198,16 +198,12 @@ blinkShockwave
 blinkShockwave i p = makeShockwaveAt [i] p 60 1 2 cyan 
 
 setMinInvSize :: Int -> Creature -> World -> World
-setMinInvSize n cr = creatures . ix (_crID cr) . crInv %~ f 
+setMinInvSize n cr = creatures . ix (_crID cr) . crInvCapacity .~ n
-  where
-    f inv = IM.unionWith const inv $ IM.fromList $ [0..n-1] <&> (, NoItem)
 
+-- maybe this should be removed...
 stripNoItems :: Creature -> World -> World
 stripNoItems cr = organiseInvKeys (_crID cr) .
-    ( creatures . ix (_crID cr) . crInv %~ IM.mapMaybe f )
+    ( creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just )
-  where
-    f NoItem = Nothing
-    f x      = Just x
 
 organiseInvKeys :: Int -> World -> World
 organiseInvKeys cid w = w & creatures . ix cid %~
@@ -245,25 +241,17 @@ youDropItem w = case yourItem w ^? itCurseStatus of
     cr = you w
 {- | Copy an inventory item to the floor. -}
 copyInvItemToFloor :: Creature -> Int -> World -> World
-copyInvItemToFloor cr i w = case _crInv cr IM.! i of
+copyInvItemToFloor cr i w = copyItemToFloor (_crPos cr) (_crInv cr IM.! i) w
-    NoItem  -> w
-    it      -> copyItemToFloor (_crPos cr) it w
-
-    
 
 {- | Pick up a specific item. -}
-pickUpItem 
+pickUpItem :: Int -> FloorItem -> World -> World
-    :: Int  -- ^ Creature id
-    -> FloorItem 
-    -> World 
-    -> World
 pickUpItem cid flit w = case maybeInvSlot of
     Nothing -> w
     Just i  -> w
         & soundStart (CrSound cid) (_flItPos flit) pickUpS Nothing
         & updateItLocation i
         & floorItems                      %~ IM.delete (_flItID flit)
-        & creatures . ix cid . crInv . ix i %~ addItem it
+        & creatures . ix cid . crInv %~ IM.insertWith (const $ itAmount +~ 1) i it
   where 
     it = _flIt flit
     maybeInvSlot = checkInvSlotsYou it w

src/Dodge/Creature/Impulse/Movement.hs

@@ -107,7 +107,6 @@ equipSpeed :: Item -> Float
 equipSpeed _ = 1
 {- | Speed modifier of an item when aiming. -}
 equipAimSpeed :: Item -> Float
-equipAimSpeed NoItem = 1
 equipAimSpeed it 
     | _itIdentity it == FrontArmour = 0.5
     | _itIdentity it == FlameShield = 0.5

src/Dodge/Data.hs

@@ -358,6 +358,7 @@ data Item
         , _itEquipPict :: Creature -> Int -> SPic
         , _itIdentity :: ItemIdentity
         , _itID :: Maybe Int
+        , _itInvSize    :: Int
         , _itInvDisplay :: Item -> [String]
         , _itInvColor :: Color
         , _itEffect :: ItEffect
@@ -372,6 +373,7 @@ data Item
         , _itEquipPict :: Creature -> Int -> SPic
         , _itIdentity :: ItemIdentity
         , _itID :: Maybe Int
+        , _itInvSize    :: Int
         , _itInvDisplay :: Item -> [String]
         , _itInvColor :: Color
         , _itCurseStatus :: CurseStatus
@@ -385,6 +387,7 @@ data Item
         , _itEffect :: ItEffect
         , _itID :: Maybe Int
         , _itZoom :: ItZoom
+        , _itInvSize    :: Int
         , _itInvDisplay :: Item -> [String]
         , _itInvColor :: Color
         , _itCurseStatus :: CurseStatus
@@ -403,6 +406,7 @@ data Item
         , _itIdentity   :: ItemIdentity
         , _itID         :: Maybe Int
         , _itAttachment :: ItAttachment
+        , _itInvSize    :: Int
         , _itInvDisplay :: Item -> [String]
         , _itInvColor   :: Color
         , _itEffect     :: ItEffect
@@ -410,7 +414,7 @@ data Item
         , _itCurseStatus :: CurseStatus
         , _itDimension  :: ItemDimension
         }
-     | NoItem
+--     | NoItem
 
 data ItemDimension = ItemDimension
     { _itDim    :: Point3 -- length width height

src/Dodge/Default.hs

@@ -141,6 +141,7 @@ defaultEquipment = Equipment
     , _itZoom    = defaultItZoom
     , _itInvColor = yellow
     , _itInvDisplay = \it -> [_itName it]
+    , _itInvSize = 1
     , _itDimension = defaultItemDimension
     }
 defaultItZoom :: ItZoom
@@ -148,6 +149,7 @@ defaultItZoom = ItZoom 20 0.2 1
 defaultConsumable :: Item
 defaultConsumable = Consumable
     { _itIdentity = Generic
+    , _itInvSize = 1
     , _itCurseStatus = Uncursed
     , _itName = "genericConsumable"
     , _itMaxStack = 9
@@ -195,6 +197,7 @@ defaultFlIt = FlIt {_flItRot=0,_flIt = defaultIt, _flItPos = V2 0 0, _flItID = 0
 defaultIt :: Item
 defaultIt = Consumable
     { _itIdentity = Medkit25
+    , _itInvSize = 1
     , _itDimension = defaultItemDimension
     , _itCurseStatus = Uncursed
     , _itName = "defaultIt"

src/Dodge/Event/Keyboard.hs

@@ -1,8 +1,7 @@
 {- | Deals with keyboard events.  -}
 module Dodge.Event.Keyboard
     ( handleKeyboardEvent
-    )
+    ) where
-    where
 import Dodge.Data
 import Dodge.Save
 import Dodge.Base

src/Dodge/Inventory.hs

@@ -1,7 +1,6 @@
 module Dodge.Inventory
     ( checkInvSlotsYou
     , rmSelectedInvItem
-    , addItem
     , rmInvItem
     , updateCloseObjects
     , closeObjScrollDir
@@ -22,32 +21,22 @@ import Data.List
 --import System.Random
 import Control.Lens
 
--- | Finds first available slot where a new item may be placed in your inventory
+-- | checks whether or not an item will fit in your inventory
+-- if so return Just the next slot to be used
 checkInvSlotsYou :: Item -> World -> Maybe Int
-checkInvSlotsYou it w = checkInvSlotsH it invListSelFirst
+checkInvSlotsYou it w
+    | _crInvCapacity ycr >= curinvsize + _itInvSize it 
+                = Just $ maybe 0 ((+1) . fst) $ IM.lookupMax inv
+    | otherwise = Nothing
   where 
-    youCr = you w
+    ycr = you w
-    youSel = _crInvSel youCr
+    inv = _crInv ycr
-    invList = _crInv youCr
+    curinvsize = sum $ fmap _itInvSize inv
-    invListSelFirst = (youSel , invList IM.! youSel) : IM.toList invList
-
-checkInvSlotsH :: Item -> [(Int,Item)] -> Maybe Int
-checkInvSlotsH it = fmap fst . find cond
-  where 
-    cond (_,NoItem) = True
-    cond (_,it'   ) = itNotFull it' && _itName it == _itName it'
 
 ---- | Finds first available slot where a new item may be placed in the inventory
 --checkInvSlots :: Item -> IM.IntMap Item -> Maybe Int
 --checkInvSlots it = checkInvSlotsH it . IM.toList
 
-addItem :: Item -> Item -> Item
-addItem it NoItem = it
-addItem _ it'     = it' & itAmount +~ 1
-
---numInventorySlots :: Int 
---numInventorySlots = 9
-
 itNotFull :: Item -> Bool
 itNotFull it = case it ^? itMaxStack of
     Just themax -> themax > _itAmount it
@@ -58,9 +47,17 @@ rmInvItem
     -> Int      -- ^ Inventory position
     -> World 
     -> World
-rmInvItem cid itid w = case w ^? creatures . ix cid . crInv . ix itid . itAmount of
+rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itAmount of
-    Just x | x > 1 -> w & creatures . ix cid . crInv . ix itid . itAmount %~ subtract 1
+    Just x | x > 1 -> w & creatures . ix cid . crInv . ix invid . itAmount %~ subtract 1
-    _ -> w & creatures . ix cid . crInv . ix itid .~ NoItem
+    _ -> w & creatures . ix cid . crInv %~ f
+        & creatures . ix cid . crInvSel %~ g
+        & creatures . ix cid . crLeftInvSel . _Just %~ g
+  where
+    maxk = fmap fst $ IM.lookupMax $ _crInv $ _creatures w IM.! cid
+    f inv = let (xs,ys) = IM.split invid inv
+        in xs `IM.union` IM.mapKeys (subtract 1) ys
+    g x | x > invid || Just x == maxk = x - 1
+        | otherwise = x 
 {- Delete a creature's selected item, the item will no longer exist.  -}
 rmSelectedInvItem 
     :: Int  -- ^ Creature id

src/Dodge/Item/Craftable.hs

@@ -8,6 +8,7 @@ import Geometry
 pipe :: Item
 pipe = Craftable
     { _itIdentity = Generic
+    , _itInvSize = 1
     , _itDimension = defaultItemDimension
     , _itCurseStatus = Uncursed
     , _itName = "PIPE"

src/Dodge/Item/Weapon/Grenade.hs

@@ -25,6 +25,7 @@ import Control.Lens
 grenade :: Item
 grenade = Throwable
     { _itName = "GRENADE " ++ show fuseTime
+    , _itInvSize = 1
     , _itDimension = defaultItemDimension
     , _itCurseStatus = Uncursed
     , _itIdentity = Grenade

src/Dodge/Render/HUD.hs

@@ -59,16 +59,10 @@ subInventoryDisplay cfig w = case _inventoryMode w of
     cursPos = crInvSelPos cr
 
 crInvSelSize :: Creature -> Int
-crInvSelSize cr = theitinvsize $ _crInv cr IM.! _crInvSel cr
+crInvSelSize cr = _itInvSize $ _crInv cr IM.! _crInvSel cr
-  where
-    theitinvsize NoItem = 1       -- this should be removable later
-    theitinvsize x = _itInvSize x
 
 crInvSelPos :: Creature -> Int
-crInvSelPos cr = sum . fmap theitinvsize . fst $ IM.split (_crInvSel cr) (_crInv cr)
+crInvSelPos cr = sum . fmap _itInvSize . fst $ IM.split (_crInvSel cr) (_crInv cr)
-  where
-    theitinvsize NoItem = 1       -- this should be removable later
-    theitinvsize x = _itInvSize x
 
 cursorsZ :: Configuration -> Int -> Item -> Picture
 cursorsZ cfig ipos it = case it ^? itTweaks . tweakSel of
@@ -205,7 +199,6 @@ itemText :: Item -> [Picture]
 {-# INLINE itemText #-}
 --itemText NoItem = dShadCol (greyN 0.5) $ text "----"
 --itemText it = dShadCol (_itInvColor it) $ text (_itInvDisplay it it)
-itemText NoItem = [text "----"]
 itemText it = case _itCurseStatus it of
     UndroppableIdentified -> map (color yellow . text) (_itInvDisplay it it)
 --        <> color (withAlpha 0.9 thecolor) (polygon (rectNSEW 110 (-65) 885 (-90)))