diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 2b280ce1c..67dd2cf27 100644 --- a/src/Dodge/Inventory.hs +++ b/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 diff --git a/src/Dodge/Inventory/Color.hs b/src/Dodge/Inventory/Color.hs new file mode 100644 index 000000000..f3700f7eb --- /dev/null +++ b/src/Dodge/Inventory/Color.hs @@ -0,0 +1,6 @@ +module Dodge.Inventory.Color where +import Color + +invDimColor :: Color +invDimColor = greyN 0.7 + diff --git a/src/Dodge/Inventory/SelectionList.hs b/src/Dodge/Inventory/SelectionList.hs new file mode 100644 index 000000000..04018da24 --- /dev/null +++ b/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 diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index f084902bc..086e13911 100644 --- a/src/Dodge/Render/HUD.hs +++ b/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 $ diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index 76f29f401..f6c573382 100644 --- a/src/Dodge/Render/List.hs +++ b/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