justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Keep inventory as intmap, start to allow items of different sizes

Browse Source
This commit is contained in:
justin
2021-11-30 15:33:15 +00:00
parent 184c0c09c1
commit 27b1a6da9e
8 changed files with 87 additions and 57 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+5 -5
View File
@@ -341,7 +341,7 @@ data Item
, _itID :: Maybe Int
, _itEffect :: ItEffect
, _itInvSize :: Int
, _itInvDisplay :: Item -> String
, _itInvDisplay :: Item -> [String]
, _itInvColor :: Color
, _itTargeting :: Maybe (World -> Maybe Point2, Int -> Item -> Creature -> World -> Picture)
, _itDimension :: ItemDimension
@@ -358,7 +358,7 @@ data Item
, _itEquipPict :: Creature -> Int -> SPic
, _itIdentity :: ItemIdentity
, _itID :: Maybe Int
, _itInvDisplay :: Item -> String
, _itInvDisplay :: Item -> [String]
, _itInvColor :: Color
, _itEffect :: ItEffect
, _itCurseStatus :: CurseStatus
@@ -372,7 +372,7 @@ data Item
, _itEquipPict :: Creature -> Int -> SPic
, _itIdentity :: ItemIdentity
, _itID :: Maybe Int
, _itInvDisplay :: Item -> String
, _itInvDisplay :: Item -> [String]
, _itInvColor :: Color
, _itCurseStatus :: CurseStatus
, _itDimension :: ItemDimension
@@ -385,7 +385,7 @@ data Item
, _itEffect :: ItEffect
, _itID :: Maybe Int
, _itZoom :: ItZoom
, _itInvDisplay :: Item -> String
, _itInvDisplay :: Item -> [String]
, _itInvColor :: Color
, _itCurseStatus :: CurseStatus
, _itDimension :: ItemDimension
@@ -403,7 +403,7 @@ data Item
, _itIdentity :: ItemIdentity
, _itID :: Maybe Int
, _itAttachment :: ItAttachment
, _itInvDisplay :: Item -> String
, _itInvDisplay :: Item -> [String]
, _itInvColor :: Color
, _itEffect :: ItEffect
, _itScroll :: Float -> Creature -> Item -> Item
src/Dodge/Default.hs
+3 -3
View File
@@ -140,7 +140,7 @@ defaultEquipment = Equipment
, _itID = Nothing
, _itZoom = defaultItZoom
, _itInvColor = yellow
, _itInvDisplay = _itName
, _itInvDisplay = \it -> [_itName it]
, _itDimension = defaultItemDimension
}
defaultItZoom :: ItZoom
@@ -157,7 +157,7 @@ defaultConsumable = Consumable
, _itEquipPict = \_ _ -> (,) emptySH blank
, _itID = Nothing
, _itInvColor = blue
, _itInvDisplay = \it -> _itName it ++ " x" ++ show (_itAmount it)
, _itInvDisplay = \it -> [_itName it ++ " x" ++ show (_itAmount it)]
, _itEffect = NoItEffect
, _itDimension = defaultItemDimension
}
@@ -204,7 +204,7 @@ defaultIt = Consumable
, _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ square 3
, _itEquipPict = \_ _ -> (,) emptySH blank
, _itID = Nothing
, _itInvDisplay = _itName
, _itInvDisplay = (:[]) . _itName
, _itInvColor = blue
, _itEffect = NoItEffect
}
src/Dodge/Item.hs
+1 -2
View File
@@ -20,7 +20,7 @@ keyToken n = defaultEquipment
, _itID = Nothing
-- , _itZoom = defaultItZoom
, _itInvColor = yellow
, _itInvDisplay = _itName
, _itInvDisplay = (:[]) . _itName
}
keyPic :: Picture
keyPic = color green $
@@ -41,7 +41,6 @@ latchkey n = defaultEquipment
, _itID = Nothing
-- , _itZoom = defaultItZoom
, _itInvColor = yellow
, _itInvDisplay = _itName
}
latchkeyPic :: Picture
latchkeyPic = color yellow $
src/Dodge/Item/Craftable.hs
+1 -1
View File
@@ -17,6 +17,6 @@ pipe = Craftable
$ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> mempty
, _itID = Nothing
, _itInvDisplay = _itName
, _itInvDisplay = (:[]) . _itName
, _itInvColor = green
}
src/Dodge/Item/Weapon/BulletGuns.hs
+1
View File
@@ -257,6 +257,7 @@ miniGun = defaultAutoGun
, _itEquipPict = pictureWeaponAim miniGunPictItem
, _itTweaks = defaultBulletSelTweak
, _itInvSize = 2
, _itInvDisplay = \it -> basicWeaponDisplay it ++ [" COLD"]
} & itDimension . muzzleLength .~ 15
where
recoilAmount = 5
src/Dodge/Item/Weapon/InventoryDisplay.hs
+2 -2
View File
@@ -11,8 +11,8 @@ import Data.Maybe
import Data.Sequence
import Control.Lens
{- | Displays the item name, ammo if loaded, and any selected '_itCharMode'. -}
basicWeaponDisplay :: Item -> String
basicWeaponDisplay it = midPadL 10 ' ' thename (' ' : thenumber) ++ theparam
basicWeaponDisplay :: Item -> [String]
basicWeaponDisplay it = [midPadL 10 ' ' thename (' ' : thenumber) ++ theparam]
where
thename = _itName it
thenumber = case it ^? itConsumption of
src/Dodge/Render/HUD.hs
+36 -38
View File
@@ -38,24 +38,37 @@ drawInventory cfig w = subInventoryDisplay cfig w `appendPic` displayInv 0 cfig
subInventoryDisplay :: Configuration -> World -> Picture
subInventoryDisplay cfig w = case _inventoryMode w of
LockedInventory -> topInvCursor col iPos cfig w
LockedInventory -> mempty -- topInvCursor col cursPos cfig w
TopInventory -> pictures
[ closeObjectTexts cfig w
, topInvCursor col iPos cfig w
-- , topInvCursor col cursPos cfig w
]
TweakInventory -> pictures
[ mCurs it cfig w
, cursorAt 120 col 5 0 iPos cfig
, cursorsZ cfig iPos it
, cursorAt 120 col 5 0 cursPos cfig
, cursorsZ cfig cursPos it
, displayMidList cfig (ammoTweakStrings it) "TWEAK"
]
CombineInventory -> invHead cfig "COMBINE"
InspectInventory -> invHead cfig "INSPECT"
where
itCol = fromMaybe (greyN 0.5) . (^? itInvColor)
iPos = _crInvSel $ _creatures w IM.! _yourID w
cr = you w
it = yourItem w
col = itCol it
cursPos = crInvSelPos cr
crInvSelSize :: Creature -> Int
crInvSelSize cr = theitinvsize $ _crInv cr IM.! _crInvSel cr
where
theitinvsize NoItem = 1 -- this should be removable later
theitinvsize x = _itInvSize x
crInvSelPos :: Creature -> Int
crInvSelPos cr = sum . fmap theitinvsize . fst $ IM.split (_crInvSel cr) (_crInv cr)
where
theitinvsize NoItem = 1 -- this should be removable later
theitinvsize x = _itInvSize x
cursorsZ :: Configuration -> Int -> Item -> Picture
cursorsZ cfig ipos it = case it ^? itTweaks . tweakSel of
@@ -67,13 +80,6 @@ cursorsZ cfig ipos it = case it ^? itTweaks . tweakSel of
hw = halfWidth cfig
sp = V2 (125 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
topInvCursor :: Color -> Int -> Configuration -> World -> Picture
topInvCursor col iPos cfig w
| ButtonRight `S.member` _mouseButtons w =
cursorAt 100 col 5 0 iPos cfig
`appendPic` openCursorAt 20 col 105 0 iPos cfig
| otherwise = mainListCursor col iPos cfig
ammoTweakStrings :: Item -> [String]
ammoTweakStrings it = case it ^? itTweaks . tweakParams of
Just l -> map tweakString $ IM.elems l
@@ -107,17 +113,22 @@ invHead cfig s = winScale cfig
. scale 0.4 0.4
$ text s
renderItemMapAt :: Float -> Float -> Configuration -> IM.IntMap Item -> Picture
{-# INLINE renderItemMapAt #-}
renderItemMapAt tx ty cfig = concatMapPic (uncurry $ listItemAt tx ty cfig) . IM.toList
--renderItemMapAt :: Float -> Float -> Configuration -> IM.IntMap Item -> Picture
--{-# INLINE renderItemMapAt #-}
--renderItemMapAt tx ty cfig = concatMapPic (uncurry $ listItemAt tx ty cfig) . IM.toList
displayInv :: Int -> Configuration -> World -> Picture
displayInv n cfig w = renderItemMapAt 0 0 cfig (_crInv cr)
displayInv n cfig w = listTextPicturesAt 0 0 cfig (concatMap itemToTextPictures $ IM.elems $ _crInv cr)
<> equipcursor
<> listCursorAt 0 0 cfig curpos white curx cury
where
curpos = crInvSelPos $ you w
curx = 10
cury = crInvSelSize $ you w
equipcursor = case _crLeftInvSel cr of
Nothing -> mempty
Just invid -> openCursorAt 20 yellow 105 0 invid cfig
Just invid -> openCursorAt 20 yellow 0 0 invid cfig
cr = _creatures w IM.! n
drawLocations :: Configuration -> World -> Picture
@@ -186,32 +197,19 @@ closeObjectTexts cfig w = pictures $
mainListCursor :: Color -> Int -> Configuration -> Picture
mainListCursor c = openCursorAt 120 c 5 0
listItemAt
:: Float -- ^ x offset
-> Float -- ^ y offset
-> Configuration
-> Int -- ^ y offset (discrete)
-> Item -- ^ The item
-> Picture
{-# INLINE listItemAt #-}
listItemAt xoff yoff w yint
= winScale w
. translate (xoff + 15 - hw) (yoff + hh - (20 * (fromIntegral yint+1)))
. scale 0.1 0.1
. itemText
where
hw = halfWidth w
hh = halfHeight w
itemToTextPictures :: Item -> [Picture]
itemToTextPictures it = itemText it
itemText :: Item -> Picture
itemText :: Item -> [Picture]
{-# INLINE itemText #-}
--itemText NoItem = dShadCol (greyN 0.5) $ text "----"
--itemText it = dShadCol (_itInvColor it) $ text (_itInvDisplay it it)
itemText NoItem = text "----"
itemText NoItem = [text "----"]
itemText it = case _itCurseStatus it of
UndroppableIdentified -> color black (text (_itInvDisplay it it))
<> color (withAlpha 0.9 thecolor) (polygon (rectNSEW 110 (-65) 885 (-90)))
_ -> color thecolor $ text (_itInvDisplay it it)
UndroppableIdentified -> map (color yellow . text) (_itInvDisplay it it)
-- <> color (withAlpha 0.9 thecolor) (polygon (rectNSEW 110 (-65) 885 (-90)))
_ -> map (color thecolor . text) (_itInvDisplay it it)
where
thecolor = _itInvColor it
src/Dodge/Render/List.hs
+38 -6
View File
@@ -1,13 +1,45 @@
module Dodge.Render.List
( renderListAt
, dShadCol
, winScale
)
where
module Dodge.Render.List where
import Dodge.Data
import Dodge.Base.Window
import Dodge.WinScale
import Picture
import Geometry
-- given a list of pictures that are each the size of a "text" call, displays them as
-- a list on the screen
listTextPicturesAt :: Float -> Float -> Configuration -> [Picture] -> Picture
listTextPicturesAt tx ty cfig = mconcat . zipWith (listTextPictureAt tx ty cfig) [0..]
-- displays a cursor that should match up to list text pictures
-- the width of a character appears to be 9(?!)
listCursorAt :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
listCursorAt xoff yoff cfig yint col cursxsize cursysize = winScale cfig
. translate (10.5+xoff-halfWidth cfig) (halfHeight cfig - (20* fromIntegral yint + yoff) - 20)
$ lineCol
[(V2 0 12.5 , col)
,(V2 wth 12.5 ,col)
] <>
lineCol
[(V2 0 (12.5 - hgt),col)
,(V2 wth (12.5 - hgt),col)
]
--[(V2 wth 12.5 ,withAlpha 0 col)
--,(V2 0 12.5 ,col)
--,(V2 0 (12.5 - hgt),col)
--,(V2 wth (12.5 - hgt),withAlpha 0 col)
--]
where
x = 9
wth = x * fromIntegral cursxsize
hgt = 20 * fromIntegral cursysize
listTextPictureAt :: Float -> Float -> Configuration -> Int -> Picture -> Picture
listTextPictureAt xoff yoff cfig yint = winScale cfig
. translate (xoff + 15 - hw) (yoff + hh - (20 * (fromIntegral yint+1)))
. scale 0.1 0.1
where
hw = halfWidth cfig
hh = halfHeight cfig
renderListAt :: Float -> Float -> Configuration -> [(String,Color)] -> Picture
renderListAt tx ty cfig =