Continue tree based inventory update

ghcidOutput

@@ -1,40 +1 @@
-/home/justin/Haskell/loop/src/Dodge/DisplayInventory.hs:25:1-25: warning: [-Wunused-imports]
+All good (614 modules, at 16:33:21)
-    The import of ‘Dodge.Item.Grammar’ is redundant
-   |
-25 | import Dodge.Item.Grammar
-   | ^^^^^^^^^^^^^^^^^^^^^^^^^
-/home/justin/Haskell/loop/src/Dodge/Item/Draw/SPic.hs:20:1: warning: [-Wunused-top-binds]
-    Defined but not used: ‘itemHeldAmmoPic’
-   |
-20 | itemHeldAmmoPic itm amit = itemSPic itm <> addAmmoClip itm amit
-   | ^^^^^^^^^^^^^^^
-/home/justin/Haskell/loop/src/Dodge/Item/Draw/SPic.hs:23:1: warning: [-Wunused-top-binds]
-    Defined but not used: ‘addAmmoClip’
-   |
-23 | addAmmoClip itm amit = fromMaybe mempty $ do
-   | ^^^^^^^^^^^
-/home/justin/Haskell/loop/src/Dodge/Item/Draw/SPic.hs:23:17: warning: [-Wunused-matches]
-    Defined but not used: ‘amit’
-   |
-23 | addAmmoClip itm amit = fromMaybe mempty $ do
-   |                 ^^^^
-/home/justin/Haskell/loop/src/Dodge/Item/Draw/SPic.hs:24:5: warning: [-Wunused-matches]
-    Defined but not used: ‘hit’
-   |
-24 |     hit <- itm ^? itType . iyBase . ibtHeld
-   |     ^^^
-/home/justin/Haskell/loop/src/Dodge/Inventory/CheckSlots.hs:7:1: warning: [-Wunused-imports]
-    The import of ‘Control.Lens’ is redundant
-  |
-7 | import Control.Lens
-  | ^^^^^^^^^^^^^^^^^^^
-/home/justin/Haskell/loop/src/Dodge/Inventory/CheckSlots.hs:8:1: warning: [-Wunused-imports]
-    The import of ‘Data.Maybe’ is redundant
-  |
-8 | import Data.Maybe
-  | ^^^^^^^^^^^^^^^^^
-/home/justin/Haskell/loop/src/Dodge/Inventory/CheckSlots.hs:28:14: warning: [-Wunused-matches]
-    Defined but not used: ‘it’
-   |
-28 | findItemSlot it inv = maybe 0 ((+ 1) . fst) $ IM.lookupMax inv
-   |              ^^

src/Dodge/Creature.hs

@@ -238,6 +238,7 @@ inventoryX c = case c of
             , rifle
             , shellMag
             ]
+    'P' -> [burstRifle , tinMag, bulletSynthesizer]
     'T' -> testInventory
     _ -> []
 
@@ -269,6 +270,7 @@ stackedInventory :: [Item]
 stackedInventory =
     [ burstRifle
     , tinMag
+    , bulletSynthesizer
     , drumMag
     , launcher
     , shellMag

src/Dodge/Data/ComposedItem.hs

@@ -11,6 +11,8 @@ import Data.Aeson.TH
 
 
 data ComposedItem = WeaponCI
+    | WeaponScopeCI
+    | AmmoModifierCI
     | BulletAmmoCI
     | UncomposableCI
     deriving (Eq,Ord,Show,Read)

src/Dodge/Data/Item/Combine.hs

@@ -97,6 +97,7 @@ data ItemBaseType
 data AttachType
     = SCROLLATTACH ScrollAttachType
     | TARGETATTACH {_ibtAttachTarget :: TargetType}
+    | BULLETSYNTHESIZER
 --    | BULPAYLOADATTACH
 --    | BULTRAJECTORYATTACH
     deriving (Eq, Ord, Show, Read)

src/Dodge/Data/Item/Use.hs

@@ -77,6 +77,7 @@ data HeldParams
 data AttachParams
     = ScrollAttachParams {_scrollAttachParams :: ScrollAttachParams}
     | TargetAttachParams
+    | NoAttachParams
 
 data AmmoParams = BulletParams {_ampBullet :: Bullet}
     | ProjectileParams

src/Dodge/DisplayInventory.hs

@@ -11,6 +11,7 @@ module Dodge.DisplayInventory (
 
 import Control.Monad
 import qualified Data.IntMap.Strict as IM
+import qualified Data.IntMap.Merge.Strict as MIM
 import Data.Maybe
 import Dodge.Base.You
 import Dodge.Combine
@@ -112,9 +113,11 @@ updateDisplaySections w cfig sss =
     coitems' =
         IM.fromDistinctAscList . zip [0 ..] $
             map closeObjectToSelectionItem (w ^. hud . closeObjects)
-    invitems' = IM.mapWithKey (invSelectionItem cr) inv
+    invitems' = MIM.merge MIM.dropMissing MIM.dropMissing (MIM.zipWithMatched $ const addindent) indents $ IM.mapWithKey (invSelectionItem cr) inv
+    addindent x y = y & siPictures %~ map (x ++)
     cr = you w
     inv = _crInv (you w)
+    indents = indentInv inv
     --inv = indentInv $ _crInv (you w)
     nfreeslots = crNumFreeSlots cr
     filtpair i itms filtdescription =

src/Dodge/Inventory/CheckSlots.hs

@@ -4,8 +4,6 @@ module Dodge.Inventory.CheckSlots (
     crInvSize,
 ) where
 
-import Control.Lens
-import Data.Maybe
 import Dodge.Base.You
 import Dodge.Data.World
 import Dodge.Item.SlotsTaken
@@ -17,15 +15,15 @@ import qualified IntMapHelp as IM
 checkInvSlotsYou :: Item -> World -> Maybe Int
 checkInvSlotsYou it w
     | crNumFreeSlots ycr >= ceiling (_itInvSize it) =
-        Just $ findItemSlot it (_crInv ycr)
+        Just $ findItemSlot (_crInv ycr)
     | otherwise = Nothing
   where
     ycr = you w
 
 -- Assumes that the item is singular.
 -- Do not want to stack floor items for now
-findItemSlot :: Item -> IM.IntMap Item -> Int
+findItemSlot :: IM.IntMap Item -> Int
-findItemSlot it inv = maybe 0 ((+ 1) . fst) $ IM.lookupMax inv
+findItemSlot = maybe 0 ((+ 1) . fst) . IM.lookupMax
 --findItemSlot it inv = case it ^? itUse . useAmount of
 --    Just _ ->
 --        fromMaybe newslot $ IM.findIndex (\it' -> _itType it == _itType it') inv

src/Dodge/Item.hs

@@ -39,6 +39,7 @@ itemFromAttachType :: AttachType -> Item
 itemFromAttachType at = case at of
     SCROLLATTACH ZOOMSCOPE -> zoomScope
     TARGETATTACH tt -> targetingScope tt
+    BULLETSYNTHESIZER -> bulletSynthesizer
 
 
 itemFromConsumableType :: ConsumableItemType -> Item

src/Dodge/Item/Ammo.hs

@@ -71,3 +71,8 @@ battery =
                         , _iaLoaded = 100
                         }
                 }
+
+bulletSynthesizer :: Item
+bulletSynthesizer = defaultHeldItem
+    & itType . iyBase .~ ATTACH BULLETSYNTHESIZER
+    & itUse .~ AttachUse NoAttachParams

src/Dodge/Item/Display.hs

@@ -88,6 +88,7 @@ showAttachItem :: AttachType -> String
 showAttachItem t = case t of
     SCROLLATTACH x -> show x
     TARGETATTACH x -> show x
+    BULLETSYNTHESIZER -> "BSYNTH"
 
 showEquipItem :: EquipItemType -> String
 showEquipItem eit = case eit of

src/Dodge/Item/Draw/SPic.hs

@@ -14,15 +14,15 @@ import LensHelp
 import Picture
 import Shape
 import ShapePicture
-import Data.Maybe
+--import Data.Maybe
 
-itemHeldAmmoPic :: Item -> Item -> SPic
+--itemHeldAmmoPic :: Item -> Item -> SPic
-itemHeldAmmoPic itm amit = itemSPic itm <> addAmmoClip itm amit
+--itemHeldAmmoPic itm amit = itemSPic itm <> addAmmoClip itm amit
 
-addAmmoClip :: Item -> Item -> SPic
+--addAmmoClip :: Item -> Item -> SPic
-addAmmoClip itm amit = fromMaybe mempty $ do
+--addAmmoClip itm amit = fromMaybe mempty $ do
-    hit <- itm ^? itType . iyBase . ibtHeld
+--    hit <- itm ^? itType . iyBase . ibtHeld
-    return mempty
+--    return mempty
 
 itemSPic :: Item -> SPic
 itemSPic it =

src/Dodge/Item/Grammar.hs

@@ -19,7 +19,9 @@ singleDT x = DT x [] []
 baseComposedItem :: ItemBaseType -> PCI
 baseComposedItem ibt = case ibt of
     HELD BURSTRIFLE -> (WeaponCI, [BulletAmmoCI])
-    AMMOMAG TINMAG -> (BulletAmmoCI, [])
+    AMMOMAG TINMAG -> (BulletAmmoCI, [AmmoModifierCI])
+    AMMOMAG DRUMMAG -> (BulletAmmoCI, [AmmoModifierCI])
+    ATTACH BULLETSYNTHESIZER -> (AmmoModifierCI, [])
     _ -> (UncomposableCI, [])
 
 baseCI :: Item -> PCI'
@@ -34,7 +36,7 @@ joinItems t@(DT (itm,px,cx) ls' rs') s@(DT (_,py,_) _ _)
     checkdepth a a'@(DT b ls rs) = fromMaybe (checktop a a') $ do
         c <- safeHead ls
         d <- checkdepth a c
-        return $ Just $ DT b (d:ls) rs
+        return $ Just $ DT b (d:tail ls) rs
     checktop a@(DT (_,pa,_) _ _) (DT (itm2,pb,cb) ls rs)
         | pa `elem` cb = Just (DT (itm2,pb, delete pa cb) (a:ls) rs)
         | otherwise = Nothing
@@ -107,9 +109,17 @@ iDTboth fspace fline flink (DT x l r) = DT (flink x)
 flattenDT :: DoubleTree a -> [a]
 flattenDT (DT x l r) = concatMap flattenDT l ++ (x : concatMap flattenDT r)
 
-indentInv :: IM.IntMap Item -> [String]
+prettyDT :: (a -> String) -> DoubleTree a -> [String]
-indentInv = 
+prettyDT f (DT x l r) = concatMap (map ('/':) . prettyDT f) r 
-    concatMap (flattenDT .indentDoubleTreeWith (' ':) ('|':) ('+':) . fmap (const "")) .
+    ++ (f x : concatMap (map ('\\':) . prettyDT f) l)
+
+invTree :: IM.IntMap Item -> [String]
+invTree = concatMap (prettyDT (\(itm,_,_) -> show (_itType itm))) .
+      joinItemsInList joinItems . IM.elems .    fmap (singleDT . baseCI)
+
+indentInv :: IM.IntMap Item -> IM.IntMap String
+indentInv = IM.fromList . zip [0..] .
+    reverse . concatMap (flattenDT .indentDoubleTreeWith (' ':) ('|':) ('+':) . fmap (const "")) .
       joinItemsInList joinItems . IM.elems .    fmap (singleDT . baseCI)
 
 --indentInv :: IM.IntMap Item -> [String]

src/Dodge/TestString.hs

@@ -1,6 +1,7 @@
 {-# OPTIONS_GHC -Wno-unused-imports #-}
 module Dodge.TestString where
 
+import Dodge.Item.Grammar
 import Dodge.Item.Display
 import AesonHelp
 import Dodge.SmoothScroll
@@ -19,10 +20,7 @@ import Dodge.Data.Universe
 --import qualified Data.Map.Strict as M
 import qualified IntMapHelp as IM
 testStringInit :: Universe -> [String]
-testStringInit u = [fromMaybe "" $ do
+testStringInit u = maybe [] invTree (u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInv)
-    proj <- u ^? uvWorld . cWorld . lWorld . projectiles
-    return $ show $ IM.size proj
-    ] 
 --    [fromMaybe "" $ do
 --    cr <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0
 --    i <- cr ^? crManipulation . manObject . inInventory . ispItem