Tidying

src/Dodge/Inventory/Color.hs

@@ -0,0 +1,6 @@
+module Dodge.Inventory.Color where
+import Color
+
+invDimColor :: Color
+invDimColor = greyN 0.7
+

src/Dodge/Inventory/SelectionList.hs

@@ -0,0 +1,87 @@
+module Dodge.Inventory.SelectionList where
+
+import Dodge.Inventory.Color
+import Dodge.Item.Display
+import Dodge.Inventory.ItemSpace
+import Picture.Base
+import Dodge.Inventory.CheckSlots
+import Dodge.Base.You
+import Dodge.SelectionList
+import Dodge.Data.SelectionList
+import Dodge.Data.World
+import qualified Data.IntMap.Strict as IM
+import LensHelp
+
+makeInventorySelectionList :: World -> SelectionList ()
+makeInventorySelectionList w = defaultSelectionList
+    & slItems .~ inventorySelectionList w
+    & slSelPos .~ inventoryCursorPos w
+
+inventorySelectionList :: World -> [SelectionItem ()]
+inventorySelectionList w = map (invSelectionItem cr) (IM.toList inv)
+    ++ [SelectionItem displayFreeSlots 1 True (length thetext) invDimColor 2 ()]
+            ++ map (closeObjectToSelectionItem nfreeslots) (w ^. cWorld . lWorld . closeObjects)
+  where
+    cr = you w
+    inv = _crInv cr
+    nfreeslots = crNumFreeSlots cr
+    thetext = case nfreeslots of
+        0 -> "  INVENTORY FULL"
+        1 -> "  +1 FREE SLOT"
+        x -> "  +" ++ show x ++ " FREE SLOTS"
+    displayFreeSlots = [color invDimColor $ text thetext]
+
+inventoryCursorPos :: World -> Maybe Int
+inventoryCursorPos w = case w ^? cWorld . lWorld . hud . hudElement . subInventory of
+    Just CombineInventory{} -> Nothing
+    _ -> Just $ yourInvSel w
+
+invSelectionItem :: Creature -> (Int,Item) -> SelectionItem ()
+invSelectionItem cr (i,it) = SelectionItem
+    { _siPictures = pics
+    , _siHeight = length pics
+    , _siIsSelectable = True
+    , _siWidth = 15
+    , _siColor = col
+    , _siOffX = 0
+    , _siPayload = ()
+    }
+  where
+    col = _itInvColor it
+    pics = take (itSlotsTaken it) . (++ replicate 10 (color col $ text "*")) $ case _itCurseStatus it of
+        UndroppableIdentified -> map (color yellow . text) (itemDisplay it)
+        _ | crSel cr == i -> map (color col . text) (selectedItemDisplay cr it)
+        _ -> map (color col . text) (itemDisplay it)
+
+closeObjectToSelectionItem :: Int -> Either FloorItem Button -> SelectionItem ()
+closeObjectToSelectionItem n e = SelectionItem
+    { _siPictures = pics
+    , _siHeight = length pics
+    , _siIsSelectable = True
+    , _siWidth = 15
+    , _siColor = col
+    , _siOffX = 2
+    , _siPayload = ()
+    }
+  where
+    (pics,col) = closeObjectToTextPictures' n e
+
+closeObjectToTextPictures' :: Int -> Either FloorItem Button -> ([Picture],Color)
+closeObjectToTextPictures' nfreeslots e = case e of
+    Left flit -> let it = _flIt flit 
+        in (map (applycolor it . textindent) $ itemDisplay it, thecol it)
+    Right bt -> ([color yellow $ textindent $ _btText bt], yellow)
+  where
+    textindent = text . (replicate clObjIntIn ' ' ++)
+    applycolor it
+        | nfreeslots >= itSlotsTaken it = color $ _itInvColor it
+        | otherwise = color invDimColor
+    thecol it
+        | nfreeslots >= itSlotsTaken it = _itInvColor it
+        | otherwise = invDimColor
+
+clObjIntIn :: Int
+clObjIntIn = 2
+
+clObjFloatIn :: Float
+clObjFloatIn = fromIntegral clObjIntIn * 9