Rewrite of item color in inventory, runs slowly

src/Dodge/Inventory/SelectionList.hs

@@ -4,6 +4,8 @@ module Dodge.Inventory.SelectionList (
     closeObjectToSelectionItem,
 ) where
 
+import Dodge.Item.Grammar
+import Dodge.Data.ComposedItem
 import Padding
 import Dodge.Equipment.Text
 import Dodge.Data.SelectionList
@@ -13,7 +15,7 @@ import Dodge.Item.InventoryColor
 import LensHelp
 import Picture.Base
 
-invSelectionItem' :: Creature -> Int -> Item -> SelectionItem ()
+invSelectionItem' :: Creature -> Int -> ComposedItem -> SelectionItem ()
 invSelectionItem' cr i it = invSelectionItem cr i it 0
 --    SelectionItem
 --        { _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey)
@@ -31,21 +33,22 @@ invSelectionItem' cr i it = invSelectionItem cr i it 0
 --        UndroppableIdentified -> itemDisplay cr it
 --        _ -> itemDisplay cr it
 
-invSelectionItem :: Creature -> Int -> Item -> Int -> SelectionItem ()
-invSelectionItem cr i it indent =
+invSelectionItem :: Creature -> Int -> ComposedItem -> Int -> SelectionItem ()
+invSelectionItem cr i ci indent =
     SelectionItem
         { _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey)
-        , _siHeight = _itInvSize it
+        , _siHeight = _itInvSize itm
         , _siIsSelectable = True
         , _siColor = col
         , _siOffX = indent
         , _siPayload = ()
         }
   where
+    itm = _cItem ci
     anyhotkey = maybe [] ((' ':) .hotkeyToString) (cr ^? crInvHotkeys . ix i)
     anyequippos = maybe [] (rightPad 8 ' ' . (' ':) . eqPosText) (cr ^? crInvEquipped . ix i)
-    col = itemInvColor it
-    pics = itemDisplay cr it
+    col = itemInvColor ci
+    pics = itemDisplay cr ci
 
 hotkeyToString :: Hotkey -> String
 hotkeyToString x = case x of
@@ -79,5 +82,5 @@ closeObjectToSelectionItem e =
 --
 closeObjectToTextPictures :: Either FloorItem Button -> ([String], Color)
 closeObjectToTextPictures e = case e of
-    Left flit -> let it = _flIt flit in (basicItemDisplay it, itemInvColor it)
+    Left flit -> let it = _flIt flit in (basicItemDisplay it, itemInvColor . pciToCI $ basePCI it)
     Right bt -> ([_btText bt], yellow)