Work on inventory management
This commit is contained in:
+91
-33
@@ -1,8 +1,7 @@
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
module Dodge.Render.HUD
|
||||
( hudDrawings
|
||||
)
|
||||
where
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Dodge.WinScale
|
||||
import Dodge.Base
|
||||
@@ -14,6 +13,7 @@ import Picture
|
||||
import Geometry
|
||||
import Padding
|
||||
|
||||
import Data.Foldable
|
||||
import Data.Maybe
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import qualified Data.Set as S
|
||||
@@ -25,23 +25,16 @@ hudDrawings :: Configuration -> World -> Picture
|
||||
hudDrawings cfig w = pictures
|
||||
[ winScale cfig . dShadCol white $ displayHP 0 cfig w
|
||||
, renderListAt (halfWidth cfig) 0 cfig $ map (,white) (_testString w w)
|
||||
, selectionText
|
||||
]
|
||||
where
|
||||
selectionText = if _carteDisplay w
|
||||
, if _carteDisplay w
|
||||
then drawLocations cfig w
|
||||
else drawInventory cfig w
|
||||
|
||||
|
||||
drawInventory :: Configuration -> World -> Picture
|
||||
drawInventory cfig w = subInventoryDisplay cfig w `appendPic` displayInv 0 cfig w
|
||||
else subInventoryDisplay cfig w `appendPic` displayInv 0 cfig w
|
||||
]
|
||||
|
||||
subInventoryDisplay :: Configuration -> World -> Picture
|
||||
subInventoryDisplay cfig w = case _inventoryMode w of
|
||||
LockedInventory -> mempty -- topInvCursor col cursPos cfig w
|
||||
TopInventory -> pictures
|
||||
[ closeObjectTexts cfig w
|
||||
-- , topInvCursor col cursPos cfig w
|
||||
[ --closeObjectTexts cfig w
|
||||
]
|
||||
TweakInventory -> pictures
|
||||
[ mCurs it cfig w
|
||||
@@ -52,20 +45,45 @@ subInventoryDisplay cfig w = case _inventoryMode w of
|
||||
CombineInventory -> invHead cfig "COMBINE"
|
||||
InspectInventory -> invHead cfig "INSPECT"
|
||||
where
|
||||
itCol = fromMaybe (greyN 0.5) . (^? itInvColor)
|
||||
cr = you w
|
||||
itCol = fromMaybe (greyN 0.5) . (^? _Just . itInvColor)
|
||||
--cr = you w
|
||||
it = yourItem w
|
||||
col = itCol it
|
||||
cursPos = crInvSelPos cr
|
||||
cursPos = invSelPos w
|
||||
|
||||
crInvSelSize :: Creature -> Int
|
||||
crInvSelSize cr = _itInvSize $ _crInv cr IM.! _crInvSel cr
|
||||
--crInvSelSize :: Creature -> Int
|
||||
--crInvSelSize cr = fromMaybe 1 $ fmap _itInvSize $ _crInv cr IM.!? _crInvSel cr
|
||||
|
||||
crInvSelPos :: Creature -> Int
|
||||
crInvSelPos cr = sum . fmap _itInvSize . fst $ IM.split (_crInvSel cr) (_crInv cr)
|
||||
--crInvSelPos :: Creature -> Int
|
||||
--crInvSelPos cr = foldl' (+) 0 . fmap _itInvSize . fst $ IM.split (_crInvSel cr) (_crInv cr)
|
||||
|
||||
cursorsZ :: Configuration -> Int -> Item -> Picture
|
||||
cursorsZ cfig ipos it = case it ^? itTweaks . tweakSel of
|
||||
invSelPos :: World -> Int
|
||||
invSelPos w = splitgap + (foldl' (+) 0 . fst $ IM.split invsel (augmentedInvSizes w))
|
||||
where
|
||||
invsel = yourInvSel w
|
||||
splitgap
|
||||
| yourInvSel w < length (yourInv w) = 0
|
||||
| otherwise = 1
|
||||
|
||||
augmentedInvSizes :: World -> IM.IntMap Int
|
||||
augmentedInvSizes w = IM.union (fmap _itInvSize $ yourInv w)
|
||||
(IM.fromAscList $ zip [length (yourInv w) ..] $ map closeObjectSize $ _closeObjects w)
|
||||
--augmentedInvSizesWithGap :: World -> IM.IntMap Int
|
||||
--augmentedInvSizesWithGap w = IM.union (safeUpdateMax (Just . (+1)) $ fmap _itInvSize $ yourInv w)
|
||||
-- (IM.fromAscList $ zip [length (yourInv w) ..] $ (map closeObjectSize $ _closeObjects w))
|
||||
--
|
||||
--safeUpdateMax :: (a -> Maybe a) -> IM.IntMap a -> IM.IntMap a
|
||||
--safeUpdateMax f m
|
||||
-- | IM.null m = m
|
||||
-- | otherwise = IM.updateMax f m
|
||||
|
||||
closeObjectSize :: Either FloorItem Button -> Int
|
||||
closeObjectSize e = case e of
|
||||
Left flit -> _itInvSize $ _flIt flit
|
||||
Right bt -> 1
|
||||
|
||||
cursorsZ :: Configuration -> Int -> Maybe Item -> Picture
|
||||
cursorsZ cfig ipos it = case it ^? _Just . itTweaks . tweakSel of
|
||||
Nothing -> f $ zConnect sp (V2 (155- hw) ( hh - 77.5))
|
||||
Just jpos -> f $ zConnect sp (V2 (155 - hw) ( hh - (20 * fromIntegral jpos + 77.5)))
|
||||
where
|
||||
@@ -74,13 +92,13 @@ cursorsZ cfig ipos it = case it ^? itTweaks . tweakSel of
|
||||
hw = halfWidth cfig
|
||||
sp = V2 (125 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
|
||||
|
||||
ammoTweakStrings :: Item -> [String]
|
||||
ammoTweakStrings it = case it ^? itTweaks . tweakParams of
|
||||
ammoTweakStrings :: Maybe Item -> [String]
|
||||
ammoTweakStrings it = case it ^? _Just . itTweaks . tweakParams of
|
||||
Just l -> map tweakString $ IM.elems l
|
||||
_ -> ["NOT TWEAKABLE"]
|
||||
|
||||
mCurs :: Item -> Configuration -> World -> Picture
|
||||
mCurs it cfig w = case it ^? itTweaks . tweakSel of
|
||||
mCurs :: Maybe Item -> Configuration -> World -> Picture
|
||||
mCurs it cfig w = case it ^? _Just . itTweaks . tweakSel of
|
||||
Nothing -> []
|
||||
Just i
|
||||
| ButtonRight `S.member` _mouseButtons w ->
|
||||
@@ -111,19 +129,41 @@ invHead cfig s = winScale cfig
|
||||
--{-# INLINE renderItemMapAt #-}
|
||||
--renderItemMapAt tx ty cfig = concatMapPic (uncurry $ listItemAt tx ty cfig) . IM.toList
|
||||
|
||||
|
||||
displayInv :: Int -> Configuration -> World -> Picture
|
||||
displayInv n cfig w = listTextPicturesAt 0 0 cfig (concatMap itemToTextPictures $ IM.elems $ _crInv cr)
|
||||
displayInv n cfig w = listTextPicturesAt 0 0 cfig invlist
|
||||
<> equipcursor
|
||||
<> listCursorAt 0 0 cfig curpos white curx cury
|
||||
<> selcursor
|
||||
where
|
||||
curpos = crInvSelPos $ you w
|
||||
selcursor
|
||||
| IM.null inv && null (_closeObjects w) = mempty
|
||||
| otherwise = listCursorAt 0 0 cfig curpos white curx cury
|
||||
inv = _crInv cr
|
||||
invlist = (concatMap itemToTextPictures $ IM.elems inv)
|
||||
++ displayFreeSlots ++ concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w)
|
||||
nfreeslots = crNumFreeSlots cr
|
||||
displayFreeSlots = case nfreeslots of
|
||||
0 -> [color invDimColor . text $ " INVENTORY FULL"]
|
||||
1 -> [color invDimColor . text $ " +1 FREE SLOT"]
|
||||
x -> [color invDimColor . text $ " +" ++ show x ++ " FREE SLOTS"]
|
||||
curpos = invSelPos w
|
||||
curx = 10
|
||||
cury = crInvSelSize $ you w
|
||||
--cury = crInvSelSize $ you w
|
||||
cury = fromMaybe 1 $ augmentedInvSizes w IM.!? _crInvSel (you w)
|
||||
equipcursor = case _crLeftInvSel cr of
|
||||
Nothing -> mempty
|
||||
Just invid -> openCursorAt 20 yellow 0 0 invid cfig
|
||||
cr = _creatures w IM.! n
|
||||
invDimColor :: Color
|
||||
invDimColor = greyN 0.7
|
||||
closeObjectToTextPictures :: Int -> Either FloorItem Button -> [Picture]
|
||||
closeObjectToTextPictures nfreeslots e = case e of
|
||||
Left flit -> let it = _flIt flit in map (applycolor it . textindent) $ _itInvDisplay it it
|
||||
Right bt -> [color yellow $ textindent $ _btText bt]
|
||||
where
|
||||
textindent = text . (" "++)
|
||||
applycolor it
|
||||
| nfreeslots >= _itInvSize it = color $ _itInvColor it
|
||||
| otherwise = color invDimColor
|
||||
|
||||
drawLocations :: Configuration -> World -> Picture
|
||||
drawLocations cfig w = pictures $
|
||||
@@ -160,6 +200,26 @@ mapWall cfig w wl =
|
||||
n2 = 20 *.* vNormal t
|
||||
(x,y) = _wlLine wl
|
||||
c = _wlColor wl
|
||||
|
||||
bestCloseObjectIndex :: World -> Maybe Int
|
||||
bestCloseObjectIndex w = Nothing
|
||||
|
||||
selectedCloseObject :: World -> Maybe (Int,Either FloorItem Button)
|
||||
selectedCloseObject w
|
||||
| invsel > length inv = Just $ selectNthCloseObject w (invsel - length inv)
|
||||
| otherwise = fmap (selectNthCloseObject w) $ bestCloseObjectIndex w
|
||||
where
|
||||
invsel = _crInvSel cr
|
||||
cr = you w
|
||||
inv = _crInv cr
|
||||
invsize = crInvSize (you w)
|
||||
|
||||
selectNthCloseObject :: World -> Int -> (Int,Either FloorItem Button)
|
||||
selectNthCloseObject w n = undefined
|
||||
|
||||
selectedCloseObjectLink :: Configuration -> World -> Picture
|
||||
selectedCloseObjectLink cfig w = mempty
|
||||
|
||||
{- | Pictures of popup text for items close to your position.-}
|
||||
closeObjectTexts :: Configuration -> World -> Picture
|
||||
closeObjectTexts cfig w = pictures $
|
||||
@@ -197,8 +257,6 @@ itemToTextPictures it = itemText it
|
||||
|
||||
itemText :: Item -> [Picture]
|
||||
{-# INLINE itemText #-}
|
||||
--itemText NoItem = dShadCol (greyN 0.5) $ text "----"
|
||||
--itemText it = dShadCol (_itInvColor it) $ text (_itInvDisplay it it)
|
||||
itemText it = case _itCurseStatus it of
|
||||
UndroppableIdentified -> map (color yellow . text) (_itInvDisplay it it)
|
||||
-- <> color (withAlpha 0.9 thecolor) (polygon (rectNSEW 110 (-65) 885 (-90)))
|
||||
|
||||
@@ -42,22 +42,9 @@ listTextPictureAt xoff yoff cfig yint = winScale cfig
|
||||
hh = halfHeight cfig
|
||||
|
||||
renderListAt :: Float -> Float -> Configuration -> [(String,Color)] -> Picture
|
||||
renderListAt tx ty cfig =
|
||||
concatMapPic (winScale cfig) . zipWith (listPairAt tx ty cfig) [0..]
|
||||
renderListAt tx ty cfig = listTextPicturesAt tx ty cfig . map (\(str,col) -> color col $ text str)
|
||||
-- concatMapPic (winScale cfig) . zipWith (listPairAt tx ty cfig) [0..]
|
||||
|
||||
listPairAt
|
||||
:: Float -- ^ x offset
|
||||
-> Float -- ^ y offset
|
||||
-> Configuration
|
||||
-> Int -- ^ y offset (discrete)
|
||||
-> (String,Color) -- ^ The text item
|
||||
-> Picture
|
||||
{-# INLINE listPairAt #-}
|
||||
listPairAt xoff yoff cfig yint (s,col)
|
||||
= translate (xoff + 15 - halfWidth cfig) (yoff + halfHeight cfig - (20 * (fromIntegral yint+1)))
|
||||
. scale 0.1 0.1
|
||||
. dShadCol col
|
||||
$ text s
|
||||
--TODO put the following functions in an appropriate place
|
||||
{- | Colour picture and add black drop shadow. -}
|
||||
dShadCol :: Color -> Picture -> Picture
|
||||
|
||||
Reference in New Issue
Block a user