Fix more item bugs

src/Dodge/Creature.hs

@@ -238,7 +238,7 @@ inventoryX c = case c of
             , rifle
             , shellMag
             ]
-    'P' -> [burstRifle , tinMag, bulletSynthesizer]
+    'P' -> [burstRifle , tinMag, battery, bulletSynthesizer]
     'T' -> testInventory
     'U' ->
         [targetingScope tt | tt <- [minBound .. maxBound]]

src/Dodge/Data/Item/Location.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE EmptyDataDeriving #-}
 module Dodge.Data.Item.Location where
 
+import ShortShow
 import Dodge.Data.Equipment.Misc
 import Control.Lens
 import Data.Aeson
@@ -38,6 +39,16 @@ data ItemLocation
     | InVoid
     deriving (Eq, Show, Ord, Read) --Generic, Flat)
 
+instance ShortShow ItemLocation where
+    shortShow (InInv cid invid rootb selb attb esite)
+        = "InInv:cid" <> shortShow cid <> "invid"<> shortShow invid
+            <>"root"<>shortShow rootb<>"sel"<>shortShow selb<>"att"<>shortShow attb<>
+            shortShow (fmap (SString . show) esite)
+    shortShow x = show x
+--    | OnTurret {_ilTuID :: Int}
+--    | OnFloor-- {_ilFlID :: NewInt FloorInt}
+--    | InVoid
+
 makeLenses ''ItemLocation
 deriveJSON defaultOptions ''InvInt
 deriveJSON defaultOptions ''FloorInt

src/Dodge/FloorItem.hs

@@ -1,15 +1,12 @@
-module Dodge.FloorItem (
-    copyItemToFloor,
-    --    copyItemToFloorID,
-) where
+module Dodge.FloorItem (copyItemToFloor) where
 
-import Control.Lens
 import Data.Maybe
 import Data.Monoid
 import Dodge.Base
 import Dodge.Data.World
 import Dodge.Item.InvSize
 import Geometry
+import LensHelp
 --import qualified IntMapHelp as IM
 import NewInt
 import System.Random
@@ -20,7 +17,7 @@ copyItemToFloor pos it w =
     w'
         & cWorld . lWorld . floorItems . at (_unNInt $ _itID it) ?~ theflit
         & cWorld . lWorld . items . at (_unNInt $ _itID it) ?~ (it & itLocation .~ OnFloor)
-        & hud . closeItems %~ (_itID it :)
+        & hud . closeItems .:~ _itID it
   where
     --            & hud . hudElement . diSections . ix 3 . ssOffset .~ 0
     -- ensures dropped item is at the top of the close item selection list
@@ -29,12 +26,7 @@ copyItemToFloor pos it w =
     theflit = FlIt{_flItPos = p', _flItRot = rot}
 
 cardinalVectors :: [Point2]
-cardinalVectors =
-    [ V2 1 0
-    , V2 0 1
-    , V2 (-1) 0
-    , V2 0 (-1)
-    ]
+cardinalVectors = [ V2 1 0 , V2 0 1 , V2 (-1) 0 , V2 0 (-1) ]
 
 findWallFreeDropPoint :: Float -> Point2 -> World -> (Point2, World)
 findWallFreeDropPoint r p w =

src/Dodge/Inventory/Add.hs

@@ -111,7 +111,7 @@ tryPutItemInInvAt i cid itid w = do
 --    return (Just i, w')
 
 createItemYou :: Item -> World -> World
-createItemYou itm w = w' -- fromMaybe w' $ fmap snd $ tryPutItemInInv 0 itid w'
+createItemYou itm w = fromMaybe w' $ fmap snd $ tryPutItemInInv 0 itid w'
   where
     itid = IM.newKey $ w ^. cWorld . lWorld . items
     pos = w ^?! cWorld . lWorld . creatures . ix 0 . crPos

src/Dodge/Inventory/Location.hs

@@ -45,9 +45,9 @@ updateRootItemID m cr = fromMaybe cr $ do
 crUpdateItemLocations :: Int -> LWorld -> LWorld
 crUpdateItemLocations crid lw = fromMaybe lw $ do
     mo <- lw ^? creatures . ix crid . crManipulation . manObject
-    itids <- lw ^? creatures . ix crid . crInv
+    cinv <- lw ^? creatures . ix crid . crInv
     --let crinv = IM.restrictKeys  (lw ^. items) (IS.fromList $ IM.elems itids)
-    let crinv = fmap (\k -> lw ^?! items . ix k) itids
+    let crinv = fmap (\k -> lw ^?! items . ix k) cinv
     return $ crSetRoots crid $ IM.foldlWithKey' (crUpdateInvidLocations mo crid) lw crinv
 
 crSetRoots :: Int -> LWorld -> LWorld
@@ -65,8 +65,7 @@ crUpdateInvidLocations :: ManipulatedObject -> Int -> LWorld -> Int -> Item -> L
 crUpdateInvidLocations mo crid lw invid itm =
     lw
         & creatures . ix crid . crInv . ix invid .~ itid -- . itLocation .~ newloc
-        & items . ix invid .~ (itm & itLocation .~ newloc)
---        & itemLocations %~ IM.insert itid newloc
+        & items . ix itid .~ (itm & itLocation .~ newloc)
   where
     itid = itm ^. itID . unNInt
     newloc =

src/Dodge/Render/Picture.hs

@@ -20,7 +20,7 @@ fixedCoordPictures u =
     aimDelaySweep u
         <> drawMenuOrHUD cfig u
         <> drawConcurrentMessage u
-        <> ttl (translate hw 0 $ drawList (map text (_uvTestString u u)))
+        <> ttl (translate (hw - 100) 0 $ drawList (map text (_uvTestString u u)))
         <> ttl
             ( translate (0.5 * hw) (- hh)
                 . drawList

src/Dodge/TestString.hs

@@ -1,6 +1,7 @@
 {-# OPTIONS_GHC -Wno-unused-imports #-}
 module Dodge.TestString where
 
+import Data.List ((\\))
 import ShortShow
 import Geometry
 import qualified SDL
@@ -30,13 +31,14 @@ import NewInt
 import Data.Foldable
 
 testStringInit :: Universe -> [String]
-testStringInit u = map f (IM.elems $ u ^. uvWorld . cWorld . lWorld . items)
+testStringInit u = map f (IM.toList $ u ^. uvWorld . cWorld . lWorld . items)
     <> ["---"]
     <> map show (IM.toList . fold $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInv)
     <> ["---"]
     <> map show (IM.keys $ u ^. uvWorld . cWorld . lWorld . floorItems)
+    
   where
-    f itm = show (itm ^. itID . unNInt) <> ":"<> show (itm ^. itLocation)
+    f (i,itm) = show i <> ":" <> show (itm ^. itID . unNInt) <> ":"<> shortShow (itm ^. itLocation)
 -- map shortShow (u ^.. uvWorld . cWorld . lWorld . debris . each . to g)
 --  where
 --    g db = (pz,z,norm v)

src/ShortShow.hs

@@ -1,6 +1,4 @@
-module ShortShow (
-    shortShow,
-) where
+module ShortShow (shortShow, ShortShow, ShortString (..)) where
 
 import Geometry
 import Numeric
@@ -11,9 +9,22 @@ class ShortShow a where
 instance ShortShow a => ShortShow (V2 a) where
     shortShow (V2 x y) = shortShow x ++ "#" ++ shortShow y
 
+newtype ShortString = SString String
+
+instance ShortShow ShortString where
+    shortShow (SString x) = show x
+
 instance ShortShow Float where
     shortShow x = showFFloat (Just 2) x ""
 
+instance ShortShow Bool where
+    shortShow True = "T"
+    shortShow False = "F"
+
+instance ShortShow a => ShortShow (Maybe a) where
+    shortShow (Just x) = "J#" <> shortShow x
+    shortShow Nothing = "NTHNG"
+
 instance ShortShow Int where
     shortShow x
         | x < k' = show x