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

Tweak inventory management

Browse Source
This commit is contained in:
justin
2021-12-01 01:55:20 +00:00
parent 0ed260c9b7
commit b9e4a80a46
12 changed files with 138 additions and 109 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base.hs
+4 -11
View File
@@ -4,6 +4,9 @@
Basic helpers.
Consider splitting. -}
module Dodge.Base
( module Dodge.Base
, module Dodge.Base.You
)
where
import Dodge.Data
import Dodge.WinScale
@@ -14,6 +17,7 @@ import Geometry
--import Picture
import qualified IntMapHelp as IM
import FoldableHelp
import Dodge.Base.You
import Control.Lens
import qualified Control.Foldl as L
@@ -42,20 +46,9 @@ errorHead :: String -> [a] -> a
errorHead _ (x:_) = x
errorHead s [] = error s
you :: World -> Creature
you w = _creatures w IM.! _yourID w
aCrPos :: Int -> World -> Point2
aCrPos i w = _crPos $ _creatures w IM.! i
yourItem :: World -> Maybe Item
yourItem w = _crInv (you w) IM.!? _crInvSel (you w)
yourInv :: World -> IM.IntMap Item
yourInv w = _crInv (you w)
yourInvSel :: World -> Int
yourInvSel w = _crInvSel (you w)
selectedObject :: World -> Maybe (Either FloorItem Button)
selectedObject w = lookup (_crInvSel ycr) $ zip [n..] $ _closeObjects w
src/Dodge/Base/You.hs
+17
View File
@@ -0,0 +1,17 @@
module Dodge.Base.You where
import Dodge.Data
--import Picture
import qualified IntMapHelp as IM
--import Control.Lens
you :: World -> Creature
you w = _creatures w IM.! _yourID w
yourItem :: World -> Maybe Item
yourItem w = _crInv (you w) IM.!? _crInvSel (you w)
yourInv :: World -> IM.IntMap Item
yourInv w = _crInv (you w)
yourInvSel :: World -> Int
yourInvSel w = _crInvSel (you w)
src/Dodge/Debug/Terminal.hs
+1
View File
@@ -8,6 +8,7 @@ import Control.Lens
applyTerminalString :: String -> Universe -> Universe
applyTerminalString "NOCLIP" w = w & config . debug_noclip %~ not
applyTerminalString "LOADME" w = w & uvWorld . creatures . ix 0 . crInv .~ stackedInventory
& uvWorld . creatures . ix 0 . crInvCapacity .~ 50
applyTerminalString "LM" w = applyTerminalString "LOADME" w
applyTerminalString _ w = w
src/Dodge/Event.hs
+3 -3
View File
@@ -110,11 +110,11 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of
Nothing -> closeObjScrollDir y w
Just f -> w & creatures . ix 0 . crInv . ix (_crInvSel $ you w) %~ f y (you w)
| lbDown -> w & cameraZoom +~ y
| invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeSwapInvPos yi w
| otherwise -> stopSoundFrom (CrReloadSound 0) $ changeInvCloseObjectsPos yi w
| invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeSwapInvSel yi w
| otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
(_, TweakInventory)
| invKeyDown && rbDown -> w & moveTweakSel yi
| invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvPos yi w
| invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w
| rbDown -> w & changeTweakParam yi
| otherwise -> w & moveTweakSel yi
(_, _) -> w
src/Dodge/Event/Keyboard.hs
+6 -4
View File
@@ -9,6 +9,7 @@ import Dodge.Creature.Action
import Dodge.Event.Test
import Dodge.Event.Menu
import Dodge.Menu
import Dodge.Inventory
import qualified Data.IntMap.Strict as IM
import SDL
@@ -65,13 +66,14 @@ gotoTerminal w = case _menuLayers w of
spaceAction :: World -> World
spaceAction w = if _carteDisplay w
then w & carteCenter .~ theLoc
else case (_inventoryMode w, listToMaybe $ _closeObjects w) of
(TopInventory,Just (Left flit)) -> pickUpItem 0 flit w
(TopInventory,Just (Right but)) -> updateTopCloseObject (_btID but) $ _btEvent but but w
else case (_inventoryMode w, selectedCloseObject w) of
(TopInventory,(Just (_,Left flit))) -> pickUpItem 0 flit w
--(TopInventory,(Just (_,Right but))) -> updateTopCloseObject (_btID but) $ _btEvent but but w
(TopInventory,(Just (_,Right but))) -> _btEvent but but w
_ -> w & inventoryMode .~ TopInventory
where
theLoc = fst (_seenLocations w IM.! _selLocation w) w
updateTopCloseObject i w' = w' & closeObjects %~ ( Right (_buttons w' IM.! i) : ) . tail
-- updateTopCloseObject i w' = w' & closeObjects %~ ( Right (_buttons w' IM.! i) : ) . tail
pauseGame :: World -> World
pauseGame w = w & sideEffects %~ (. (menuLayers .~ [pauseMenu]))
src/Dodge/Inventory.hs
+37 -56
View File
@@ -8,16 +8,17 @@ module Dodge.Inventory
, rmInvItem
, updateCloseObjects
, closeObjScrollDir
, swapInvDir
, changeInvPos
, changeSwapInvPos
, changeInvCloseObjectsPos
-- , swapInvDir
, changeInvSel
, changeSwapInvSel
, changeAugInvSel
, crNumFreeSlots
, crInvSize
, selectedCloseObject
)
where
import Dodge.Data
import Dodge.Inventory.CloseObject
import Dodge.Base
import Dodge.Base.Collide
import Geometry
@@ -41,7 +42,6 @@ checkInvSlotsYou it w
where
ycr = you w
inv = _crInv ycr
-- curinvsize = invSize inv
crNumFreeSlots :: Creature -> Int
crNumFreeSlots cr = _crInvCapacity cr - invSize (_crInv cr)
@@ -52,6 +52,7 @@ crInvSize = invSize . _crInv
invSize :: IM.IntMap Item -> Int
invSize = sum . fmap _itInvSize
-- | after this the item at the inventory position will no longer exist
rmInvItem :: Int -- ^ Creature id
-> Int -- ^ Inventory position
-> World -> World
@@ -66,16 +67,17 @@ rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itAmou
in xs `IM.union` IM.mapKeys (subtract 1) ys
g x | x > invid || Just x == maxk = max 0 $ x - 1
| otherwise = x
{- Delete a creature's selected item, the item will no longer exist. -}
rmSelectedInvItem
:: Int -- ^ Creature id
-> World
-> World
rmSelectedInvItem :: Int -> World -> World
rmSelectedInvItem cid w = rmInvItem cid (_crInvSel (_creatures w IM.! cid)) w
augmentedInvSizes :: World -> IM.IntMap Int
augmentedInvSizes w = IM.union (fmap _itInvSize $ yourInv w)
(IM.fromAscList $ zip [length (yourInv w) ..] $ map closeObjectSize $ _closeObjects w)
augmentedInvSizes = bimapAugmentInv _itInvSize closeObjectSize
bimapAugmentInv :: (Item -> a) -> (Either FloorItem Button -> a) -> World -> IM.IntMap a
bimapAugmentInv f g w = IM.union
(fmap f $ yourInv w)
(IM.fromAscList $ zip [length (yourInv w) ..] $ map g $ _closeObjects w)
invSelSize :: Int -> World -> Int
invSelSize i w = fromMaybe 1 $ augmentedInvSizes w IM.!? i
@@ -89,7 +91,7 @@ selNumPos :: Int -> World -> Int
selNumPos i w = splitgap + (foldl' (+) 0 . fst $ IM.split i (augmentedInvSizes w))
where
splitgap
| yourInvSel w < length (yourInv w) = 0
| i < length (yourInv w) = 0
| otherwise = 1
invSelPos :: World -> Int
@@ -100,28 +102,23 @@ invSelPos w = splitgap + (foldl' (+) 0 . fst $ IM.split invsel (augmentedInvSize
| yourInvSel w < length (yourInv w) = 0
| otherwise = 1
-- this looks ugly...
updateCloseObjects :: World -> World
updateCloseObjects w = w & closeObjects .~ unionBy eTest oldCloseFiltered currentClose
& creatures . ix 0 . crInvSel %~ updateinvsel
updateCloseObjects w = w & closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
& creatures . ix (_yourID w) . crInvSel %~ updateinvsel
where
updateinvsel curinvsel
| length (augmentedInvSizes w) <= curinvsel = length (augmentedInvSizes w) - 1
| otherwise = curinvsel
filt = filter $ \obj -> dist ypos (pos obj) < 40 && hasLOS ypos (pos obj) w
filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasLOS ypos (closeObjPos obj) w
ypos = _crPos $ you w
objs = map Left (IM.elems $ _floorItems w) ++ activeButtons
activeButtons = map Right
. filter ( (/=) BtNoLabel . _btState)
. IM.elems
$ _buttons w
pos (Right x) = _btPos x
pos (Left x) = _flItPos x
eTest (Right x) (Right y) = _btID x == _btID y
eTest (Left x) (Left y) = _flItID x == _flItID y
eTest _ _ = False
currentClose = filt objs
currentClose = filt $ map Left (IM.elems $ _floorItems w) ++ activeButtons
oldClose = filt $ _closeObjects w
oldCloseFiltered = intersectBy eTest oldClose currentClose
oldCloseFiltered = intersectBy closeObjEq oldClose currentClose
closeObjScrollDir :: Float -> World -> World
closeObjScrollDir x
@@ -129,43 +126,27 @@ closeObjScrollDir x
| x < 0 = over closeObjects rotD
| otherwise = id
swapInvDir :: Int -> World -> World
swapInvDir k w
| n == 0 = w
| i < n = w & creatures . ix (_yourID w) %~ updatecreature
| otherwise = w
where
updatecreature = ( crInv %~ IM.swapKeys (i `mod` n) swapi )
. (crLeftInvSel . _Just %~ updateLeftInvSel)
swapi = (i + k) `mod` n
updateLeftInvSel li | i == li = swapi
| swapi == li = i
| otherwise = li
i = _crInvSel $ you w
n = length $ _crInv $ _creatures w IM.! _yourID w
--numCO = length $ _closeObjects w
changeInvPos :: Int -> World -> World
changeInvPos i w
changeInvSel :: Int -> World -> World
changeInvSel i w
| n == 0 = w
| yourInvSel w < n = w & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i
| otherwise = w & creatures . ix (_yourID w) . crInvSel %~ ((+n) . (`mod` numCO) . subtract (i+n))
-- arguably this should jump the invpos into the inventory proper
where
n = length $ _crInv $ _creatures w IM.! _yourID w
numCO = length $ _closeObjects w
changeSwapInvPos :: Int -> World -> World
changeSwapInvPos k w
changeSwapInvSel :: Int -> World -> World
changeSwapInvSel k w
| n == 0 = w
| yourInvSel w < n = w
& creatures . ix (_yourID w) %~ updatecreature
& creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract k
-- | otherwise = w & creatures . ix (_yourID w) . crInvSel %~ ((+n) . (`mod` numCO) . subtract (k+n))
| otherwise = w & creatures . ix (_yourID w) . crInvSel .~ ico'
& closeObjects %~ listSwapIndices (i - n) (ico' - n)
& closeObjects %~ swapIndices (i - n) (ico' - n)
where
updatecreature = ( crInv %~ IM.swapKeys (i `mod` n) swapi )
. (crLeftInvSel . _Just %~ updateLeftInvSel)
. (crInvSel %~ (`mod` n) . subtract k)
swapi = (i - k) `mod` n
updateLeftInvSel li | i == li = swapi
| swapi == li = i
@@ -175,18 +156,19 @@ changeSwapInvPos k w
n = length $ _crInv $ _creatures w IM.! _yourID w
numCO = length $ _closeObjects w
listSwapIndices :: Int -> Int -> [a] -> [a]
listSwapIndices i j xs = insertOver i (xs !! j) . insertOver j (xs !! i) $ xs
changeInvCloseObjectsPos :: Int -> World -> World
changeInvCloseObjectsPos i w
changeAugInvSel :: Int -> World -> World
changeAugInvSel i w
| n == 0 = w
| otherwise = w & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i
| otherwise = w & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i
where
n = (length $ IM.keys $ _crInv $ _creatures w IM.! _yourID w) + length (_closeObjects w)
n = length (yourInv w) + length (_closeObjects w)
bestCloseObjectIndex :: World -> Maybe Int
bestCloseObjectIndex w = Nothing
bestCloseObjectIndex w = findIndex f $ _closeObjects w
where
f (Right _) = True
f (Left flit) = _itInvSize (_flIt flit) <= _crInvCapacity ycr - crInvSize ycr
ycr = you w
selectedCloseObject :: World -> Maybe (Int,Either FloorItem Button)
selectedCloseObject w
@@ -196,7 +178,6 @@ selectedCloseObject w
invsel = _crInvSel cr
cr = you w
inv = _crInv cr
invsize = crInvSize (you w)
selectNthCloseObject :: World -> Int -> (Int,Either FloorItem Button)
selectNthCloseObject w n = (length (yourInv w) + n, _closeObjects w !! n)
src/Dodge/Inventory/CloseObject.hs
+14
View File
@@ -0,0 +1,14 @@
module Dodge.Inventory.CloseObject where
import Dodge.Data
import Geometry
closeObjPos :: Either FloorItem Button -> Point2
closeObjPos e = case e of
Right x -> _btPos x
Left x -> _flItPos x
closeObjEq :: Either FloorItem Button -> Either FloorItem Button -> Bool
closeObjEq (Right x) (Right y) = _btID x == _btID y
closeObjEq (Left x) (Left y) = _flItID x == _flItID y
closeObjEq _ _ = False
src/Dodge/Item/Weapon/BulletGuns.hs
+12 -3
View File
@@ -14,10 +14,11 @@ module Dodge.Item.Weapon.BulletGuns
import Dodge.Data
import Dodge.TweakBullet
import Dodge.Default.Weapon
import Dodge.Item.Weapon.InventoryDisplay
import Dodge.Default
import Dodge.Item.Attachment
import Dodge.Item.Weapon.ExtraEffect
import Dodge.Item.Weapon.InventoryDisplay
--import Dodge.Item.Weapon.InventoryDisplay
import Dodge.Item.Weapon.AmmoParams
import Dodge.Item.Draw
import Dodge.Item.Weapon.Bullet
@@ -28,6 +29,7 @@ import Geometry
import ShapePicture
import Shape
import Data.Maybe
import qualified Data.Sequence as Seq
import Control.Lens
@@ -256,10 +258,17 @@ miniGun = defaultAutoGun
, _itFloorPict = miniGunPictItem
, _itEquipPict = pictureWeaponAim miniGunPictItem
, _itTweaks = defaultBulletSelTweak
, _itInvSize = 2
, _itInvDisplay = \it -> basicWeaponDisplay it ++ [" COLD"]
, _itInvSize = 4
, _itInvDisplay = \it -> basicWeaponDisplay it ++
["*" ++ replicate 8 ' ' ++ "*"
,"* " ++ fromMaybe " " (maybeWarmupStatus it) ++ " *"
,"*" ++ replicate 8 ' ' ++ "*" ]
-- [" " ++ replicate 8 ch
-- ," " ++ replicate 2 ch ++ fromMaybe " " (maybeWarmupStatus it) ++ replicate 2 ch
-- ," " ++ replicate 8 ch]
} & itDimension . muzzleLength .~ 15
where
--ch = '*'
recoilAmount = 5
[vm1,vm2,vm3,vm4] =
[ 0.25
src/Dodge/Item/Weapon/InventoryDisplay.hs
+4 -3
View File
@@ -3,6 +3,7 @@ Display of weapon strings in the inventory.
-}
module Dodge.Item.Weapon.InventoryDisplay
( basicWeaponDisplay
, maybeWarmupStatus
) where
import Dodge.Data
import Padding
@@ -26,7 +27,7 @@ basicWeaponDisplay it = [midPadL 10 ' ' thename (' ' : thenumber) ++ theparam]
. listToMaybe
$ mapMaybe ($ it)
[ maybeModeStatus
, maybeWarmupStatus
-- , maybeWarmupStatus
, maybeRateStatus
]
@@ -45,6 +46,6 @@ maybeWarmupStatus :: Item -> Maybe String
maybeWarmupStatus it = case it ^? itUse . useDelay . warmMax of
Nothing -> Nothing
Just m -> case m - (_warmTime . _useDelay $ _itUse it) of
x | x <= 1 -> Just " WARM"
x | x <= 1 -> Just "WARM"
| otherwise -> let n = show x
in Just $ ' ' : Prelude.take (4 - Prelude.length n) "WARM" ++ n
in Just $ Prelude.take (4 - Prelude.length n) "WARM" ++ n
src/Dodge/Item/Weapon/Launcher.hs
+7
View File
@@ -5,6 +5,7 @@ module Dodge.Item.Weapon.Launcher
import Dodge.Data
import Dodge.Default
import Dodge.Default.Weapon
import Dodge.Item.Weapon.InventoryDisplay
import Dodge.Default.Shell
import Dodge.SoundLogic.LoadSound
import Dodge.WorldEvent.Explosion
@@ -67,7 +68,13 @@ launcher = defaultGun
{ _tweakSel = 0
, _tweakParams = basicAmPjMoves
}
, _itInvSize = 3
, _itInvDisplay = \it -> basicWeaponDisplay it ++
["!" ++ replicate 8 ch ++ "!"
,"!" ++ replicate 8 ch ++ "!"]
}
where
ch = ' '
defaultShellAmmo :: AmmoType
defaultShellAmmo = ProjectileAmmo
src/Dodge/Render/HUD.hs
+29 -29
View File
@@ -13,7 +13,7 @@ import Picture
import Geometry
import Padding
import Data.Foldable
--import Data.Foldable
import Data.Maybe
import qualified Data.IntMap.Strict as IM
import qualified Data.Set as S
@@ -174,36 +174,36 @@ mapWall cfig w wl =
c = _wlColor wl
selectedCloseObjectLink :: Configuration -> World -> Picture
selectedCloseObjectLink cfig w = mempty
--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 $
renderListAt pushout (negate 20 * fromIntegral invPos) cfig (map colAndText $ _closeObjects w)
: maybeToList maybeLine
where
colAndText (Left x) = ( _itName $ _flIt x, _itInvColor $ _flIt x)
colAndText (Right x) = (_btText x,yellow)
youSel = _crInvSel $ you w
freeSlot = mayIt >>= \it -> checkInvSlotsYou (_flIt it) w
invPos = fromMaybe youSel freeSlot
mayObj = listToMaybe $ _closeObjects w
mayIt = mayObj >>= maybeLeft
maybeLeft (Left x) = Just x
maybeLeft _ = Nothing
pushout = 120
objPos obj = case obj of
Left flit -> _flItPos flit
Right bt -> _btPos bt
mayScreenPos = fmap (worldPosToScreen w . objPos) mayObj
maybeLine = do
itScreenPos <- mayScreenPos
(theText,col) <- fmap colAndText mayObj
let textWidth = 9 * fromIntegral (length theText)
let p = V2 (textWidth + 15 + pushout - halfWidth cfig)
( halfHeight cfig - 20* (fromIntegral invPos +1) + 2.5)
return . winScale cfig . color col $ lConnect p itScreenPos
--closeObjectTexts :: Configuration -> World -> Picture
--closeObjectTexts cfig w = pictures $
-- renderListAt pushout (negate 20 * fromIntegral invPos) cfig (map colAndText $ _closeObjects w)
-- : maybeToList maybeLine
-- where
-- colAndText (Left x) = ( _itName $ _flIt x, _itInvColor $ _flIt x)
-- colAndText (Right x) = (_btText x,yellow)
-- youSel = _crInvSel $ you w
-- freeSlot = mayIt >>= \it -> checkInvSlotsYou (_flIt it) w
-- invPos = fromMaybe youSel freeSlot
-- mayObj = listToMaybe $ _closeObjects w
-- mayIt = mayObj >>= maybeLeft
-- maybeLeft (Left x) = Just x
-- maybeLeft _ = Nothing
-- pushout = 120
-- objPos obj = case obj of
-- Left flit -> _flItPos flit
-- Right bt -> _btPos bt
-- mayScreenPos = fmap (worldPosToScreen w . objPos) mayObj
-- maybeLine = do
-- itScreenPos <- mayScreenPos
-- (theText,col) <- fmap colAndText mayObj
-- let textWidth = 9 * fromIntegral (length theText)
-- let p = V2 (textWidth + 15 + pushout - halfWidth cfig)
-- ( halfHeight cfig - 20* (fromIntegral invPos +1) + 2.5)
-- return . winScale cfig . color col $ lConnect p itScreenPos
mainListCursor :: Color -> Int -> Configuration -> Picture
mainListCursor c = openCursorAt 120 c 5 0
src/ListHelp.hs
+4
View File
@@ -2,6 +2,7 @@ module ListHelp
(module Data.List
,initOrNull
, insertOver
, swapIndices
)where
import Data.List
@@ -11,3 +12,6 @@ initOrNull xs = init xs
insertOver :: Int -> a -> [a] -> [a]
insertOver i x xs = take i xs ++ x : drop (i+1) xs
swapIndices :: Int -> Int -> [a] -> [a]
swapIndices i j xs = insertOver i (xs !! j) . insertOver j (xs !! i) $ xs