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

Continue inventory refactor

Browse Source
This commit is contained in:
justin
2024-11-24 22:08:36 +00:00
parent 81fcfea1be
commit 82c53fc8e3
10 changed files with 187 additions and 149 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/HUD.hs
+4 -4
View File
@@ -5,12 +5,12 @@
module Dodge.Data.HUD where
import Dodge.Data.Item.Location
import NewInt
import Control.Lens
import Data.IntMap
import Data.IntSet (IntSet)
import Dodge.Data.Button
import Dodge.Data.Combine
import Dodge.Data.FloorItem
import Dodge.Data.SelectionList
import Geometry.Data
@@ -50,8 +50,8 @@ data HUD = HUD
, _carteCenter :: Point2
, _carteZoom :: Float
, _carteRot :: Float
, _closeItems :: [FloorItem]
, _closeInterfaces :: [Button]
, _closeItems :: [NewInt FloorInt]
, _closeInterfaces :: [Int]
}
makeLenses ''HUD
src/Dodge/Data/Item/Use/Consumption/LoadAction.hs
+5 -4
View File
@@ -12,7 +12,6 @@ import Data.Aeson.TH
--import Sound.Data
data Manipulation -- should be ManipulatedObject?
-- = InvSel {_isel :: SelPos}
= Manipulator {_manObject :: ManipulatedObject
}
| Brute
@@ -20,14 +19,16 @@ data Manipulation -- should be ManipulatedObject?
data ManipulatedObject
= SortInventory
| SelectedItem
| SelectedItem
{ _imSelectedItem :: Int
, _imRootSelectedItem :: Int
, _imAttachedItems :: IS.IntSet
}
| SelNothing
| SortNearby
| SelCloseObject {_ispCloseObject :: Int}
| SortCloseItem
| SelCloseItem {_ispCloseItem :: Int}
| SortCloseButton
| SelCloseButton {_ispCloseButton :: Int}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''ManipulatedObject
src/Dodge/DisplayInventory.hs
+10 -8
View File
@@ -13,7 +13,6 @@ import Control.Lens
import Control.Monad
import Data.Bifunctor
import qualified Data.IntMap.Strict as IM
--import qualified Data.List as List
import Data.Maybe
import Data.Monoid
import Dodge.Base.You
@@ -135,7 +134,8 @@ updateDisplaySections w cfig =
displayIndents
mselpos
(getAvailableListLines (invDisplayParams w) cfig)
[statushead,statusdisplay,invhead,invx,youx, nearbyhead, closex]
[statushead,statusdisplay,invhead,invx,youx, nearbyhead, closex
,interfaceshead,interfaces]
where
mselpos = w ^? hud . hudElement . diSelection . _Just
invfiltcurs = mselpos ^? _Just . _1 == Just (-1)
@@ -152,6 +152,11 @@ updateDisplaySections w cfig =
then if null sclose then (2,mempty) else makehead "NEARBY ITEMS" 2
else filtclose
youx = (1, youitems)
interfaceshead = if null btitems then (4,mempty) else makehead "NEARBY INTERFACES" 4
interfaces = (5,btitems)
btitems =
IM.fromDistinctAscList . zip [0 ..] $
mapMaybe (closeButtonToSelectionItem w) (w ^. hud . closeInterfaces)
makehead str i = (i,IM.singleton 0 $ SelectionInfo [str] 1 False white 0)
statushead = (-4,IM.singleton 0 $ SelectionInfo ["STATUS"] 1 False white 0)
statusdisplay = (-3,IM.singleton 0 $ SelectionInfo ["HEALTH: "++show (_crHP cr)] 1 False white 0)
@@ -160,7 +165,7 @@ updateDisplaySections w cfig =
thetext = displayFreeSlots (crNumFreeSlots cr)
closeitms =
IM.fromDistinctAscList . zip [0 ..] $
map closeItemToSelectionItem (w ^. hud . closeItems)
mapMaybe (closeItemToSelectionItem w) (w ^. hud . closeItems)
invitems =
IM.mapWithKey
(\k (indent, x) -> invSelectionItem indent cr k (x ^. locLDT . ldtValue))
@@ -269,7 +274,6 @@ updateSectionsPositioning f h mselpos allavailablelines lsss sss =
guard $ k == k'
return i
ls = IM.fromList lsss
-- h = IM.intersectionWith ($)
-- defaults non-existing offsets to 0
g = merge (mapMissing (const ($ 0))) dropMissing (zipWithMatched (const ($)))
lk = maybe [] ((: []) . fst) mselpos
@@ -308,11 +312,9 @@ updateSection indent mcsel sis availablelines oldoffset =
pos | pos == 0 || length allstrings <= availablelines -> 0
pos | pos - 1 < oldoffset -> pos - 1
pos | maxcsel == csel -> pos - availablelines + xselsize
pos
| pos + 1 + xselsize - availablelines > oldoffset ->
pos | pos + 1 + xselsize - availablelines > oldoffset ->
pos - availablelines + 1 + xselsize
_
| length allstrings - oldoffset < availablelines ->
_ | length allstrings - oldoffset < availablelines ->
length allstrings - availablelines
_ -> oldoffset
tweakfirst (x : xs)
src/Dodge/Inventory.hs
+19 -14
View File
@@ -129,15 +129,10 @@ updateCloseObjects w =
& hud . closeItems %~ f
& hud . closeInterfaces %~ g
where
-- the following should update any changed properties of flits/bts
g oldbts = intersectBy bteq cbts oldbts `btunion` cbts
f olditems = intersectBy feq citems olditems `itunion` citems
itunion = unionBy feq
btunion = unionBy bteq
feq = (==) `on` _flItID
bteq = (==) `on` _btID
cbts = filter (isclose . _btPos) activeButtons
citems =
g oldbts = intersect oldbts cbts `union` cbts
f olditems = intersect olditems citems `union` citems
cbts = fmap _btID $ filter (isclose . _btPos) activeButtons
citems = fmap _flItID .
filter (isclose . _flItPos)
. IM.elems
$ w ^. cWorld . lWorld . floorItems . unNIntMap
@@ -171,13 +166,22 @@ changeSwapClose ::
changeSwapClose f i w = fromMaybe w $ do
ss <- w ^? hud . hudElement . diSections . ix 3 . ssItems
k <- f i ss
let doswap j
| j == i= k
| j == k = i
| otherwise = j
-- updateselection = case w ^? hud . hudElement . diSelection . _Just of
-- Just (0, j) | j == k -> hud . hudElement . diSelection . _Just . _2 .~ i
-- Just (0, j) | j == i -> hud . hudElement . diSelection . _Just . _2 .~ k
-- _ -> id
return $
w
& swapAnyExtraSelection i k
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . ispCloseObject
.~ k
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . ispCloseItem
%~ doswap
& hud . closeItems %~ swapIndices i k
& hud . hudElement . diSelection . _Just . _2 .~ k
& hud . hudElement . diSelection . _Just . _2 %~ doswap
-- & updateselection
& worldEventFlags . at InventoryChange ?~ ()
-- can be specialised for when we know that item i is selected
@@ -309,6 +313,7 @@ scrollAugNextInSection w =
selectedCloseItem :: World -> Maybe FloorItem
selectedCloseItem w = do
i <-
you w ^? crManipulation . manObject . ispCloseObject
you w ^? crManipulation . manObject . ispCloseItem
<|> fmap fst (IM.lookupMin =<< w ^? hud . hudElement . diSections . ix 3 . ssItems)
w ^? hud . closeItems . ix i
flitid <- w ^? hud . closeItems . ix i . unNInt
w ^? cWorld . lWorld . floorItems . unNIntMap . ix flitid
src/Dodge/Inventory/Location.hs
+4 -2
View File
@@ -95,6 +95,8 @@ setInvPosFromSS w =
, _imAttachedItems = aset
}
1 -> Just SelNothing
2 -> Just SortNearby
3 -> Just $ SelCloseObject j
2 -> Just SortCloseItem
3 -> Just $ SelCloseItem j
4 -> Just SortCloseButton
5 -> Just $ SelCloseButton j
_ -> error "selection out of bounds"
src/Dodge/Inventory/SelectionList.hs
+21 -8
View File
@@ -4,8 +4,10 @@ module Dodge.Inventory.SelectionList (
invSelectionItem,
invSelectionItem',
closeItemToSelectionItem,
closeButtonToSelectionItem,
) where
import NewInt
import Dodge.Data.ComposedItem
import Dodge.Data.SelectionList
import Dodge.Data.World
@@ -51,23 +53,34 @@ hotkeyToString x = case x of
Hotkey9 -> "[9]"
Hotkey0 -> "[0]"
closeItemToSelectionItem :: FloorItem -> SelectionItem ()
closeItemToSelectionItem e =
SelectionItem
closeItemToSelectionItem :: World -> NewInt FloorInt -> Maybe (SelectionItem ())
closeItemToSelectionItem w (NInt i) = do
e <- w ^? cWorld . lWorld . floorItems . unNIntMap . ix i
let (pics, col) = closeItemToTextPictures e
return SelectionItem
{ _siPictures = pics
, _siHeight = length pics
, _siIsSelectable = True
, --, _siWidth = 15
_siColor = col
, _siColor = col
, _siOffX = 0
, _siPayload = ()
}
closeButtonToSelectionItem :: World -> Int -> Maybe (SelectionItem ())
closeButtonToSelectionItem w i = do
bt <- w ^? cWorld . lWorld . buttons . ix i
return SelectionItem
{ _siPictures = [_btText bt]
, _siHeight = 1
, _siIsSelectable = True
, _siColor = yellow
, _siOffX = 0
, _siPayload = ()
}
where
(pics, col) = closeItemToTextPictures e
closeItemToTextPictures :: FloorItem -> ([String], Color)
closeItemToTextPictures flit =
let it = _flIt flit
in (basicItemDisplay it, itemInvColor . pciToCI $ basePCI it)
-- Right bt -> ([_btText bt], yellow)
src/Dodge/Render/HUD.hs
+10 -1
View File
@@ -4,6 +4,7 @@ module Dodge.Render.HUD (
drawHUD,
) where
import NewInt
import Control.Applicative
import Control.Lens
import Control.Monad
@@ -217,7 +218,15 @@ floorItemPickupInfo n itm
yourAugmentedItem :: (Item -> a) -> a -> (Either FloorItem Button -> a) -> World -> a
yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
Just (SelectedItem i _ _) -> f $ yourInv w ^?! ix i
Just (SelCloseObject i) -> g . Left $ w ^?! hud . closeItems . ix i
Just (SelCloseItem i) -> fromMaybe x $ do
j <- w ^? hud . closeItems . ix i . unNInt
flit <- w ^? cWorld . lWorld . floorItems . unNIntMap . ix j
return . g $ Left flit
-- g . Left $ w ^?! hud . closeItems . ix i
Just (SelCloseButton i) -> fromMaybe x $ do
j <- w ^? hud . closeInterfaces . ix i
flit <- w ^? cWorld . lWorld . buttons . ix j
return . g $ Right flit
_ -> x
drawRBOptions :: Configuration -> World -> Picture
src/Dodge/TestString.hs
+4 -2
View File
@@ -50,8 +50,10 @@ showManObj :: ManipulatedObject -> String
showManObj SortInventory = "SortInventory"
showManObj (SelectedItem x y z) = "SelItem: "++ show x++ " Root: "++show y++" Attached: "++show z
showManObj SelNothing = "SelNothing"
showManObj SortNearby = "SortNearby"
showManObj (SelCloseObject x) = "Close " ++ show x
showManObj SortCloseItem = "SortCloseItem"
showManObj (SelCloseItem x) = "CloseItem " ++ show x
showManObj SortCloseButton = "SortCloseButton"
showManObj (SelCloseButton x) = "CloseButton " ++ show x
--testStringInit u = fromMaybe mempty $ do