Tidying

src/Dodge/Inventory.hs

@@ -26,6 +26,7 @@ module Dodge.Inventory (
 ) where
 
 import Color
+import Dodge.Inventory.Color
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import Dodge.Base
@@ -141,9 +142,6 @@ selNumMidHeight cfig w i = V2 (150 - hw) (hh + bump - (20 * fromIntegral ipos +
 selNumCol :: Int -> World -> Color
 selNumCol i w = fromMaybe white $ trimapAugmentInv _itInvColor invDimColor closeObjectCol w IM.!? i
 
-invDimColor :: Color
-invDimColor = greyN 0.7
-
 invSelPos :: World -> Int
 invSelPos w = splitgap + (foldl' (+) 0 . fst $ IM.split invsel (augmentedInvSizes w))
   where

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

src/Dodge/Render/HUD.hs

@@ -321,10 +321,6 @@ invHead cfig s =
         . scale 0.4 0.4
         $ text s
 
-
---clObjFloatIn :: Float
---clObjFloatIn = fromIntegral clObjIntIn * 9
-
 drawCarte :: Configuration -> World -> Picture
 drawCarte cfig w =
     pictures $

src/Dodge/Render/List.hs

@@ -101,17 +101,6 @@ listCursorChooseBorderScale ygap s borders xoff yoff cfig yint col cursxsize cur
 listCursorChooseBorder ::
     Set CardinalPoint -> Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
 listCursorChooseBorder = listCursorChooseBorderScale 10 1
---listCursorChooseBorder borders xoff yoff cfig yint col cursxsize cursysize =
---    winScale cfig
---        . translate
---            (6 + xoff - halfWidth cfig)
---            (halfHeight cfig + 12.5 - (20 * fromIntegral yint + yoff + 20 + hgt))
---        . color col
---        $ chooseCursorBorders wth hgt borders
---  where
---    x = 9
---    wth = x * fromIntegral cursxsize + 9
---    hgt = 20 * fromIntegral cursysize
 
 -- note we cannot simply scale lines because they are drawn as solid rectangles
 chooseCursorBorders :: Float -> Float -> Set CardinalPoint -> Picture