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

Start adding mouse control of inventory

Browse Source
This commit is contained in:
justin
2024-10-15 23:26:08 +01:00
parent e745238b8f
commit cf0873d73b
18 changed files with 333 additions and 269 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Item/Grammar.hs
+47 -40
View File
@@ -9,11 +9,11 @@ module Dodge.Item.Grammar (
allInvLocs,
) where
import Dodge.Data.ComposedItem
import Control.Applicative
import Data.Bifunctor
import qualified Data.IntMap.Strict as IM
import Data.Maybe
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
import Dodge.Data.Item
import Dodge.DoubleTree
@@ -21,15 +21,18 @@ import Dodge.Item.Orientation
import LensHelp
import ListHelp
useBreakL :: [(ItemStructuralFunction, ComposeLinkType)]
-> [(ItemStructuralFunction, ComposeLinkType)]
-> LinkTest
useBreakL ::
[(ItemStructuralFunction, ComposeLinkType)] ->
[(ItemStructuralFunction, ComposeLinkType)] ->
LinkTest
useBreakL x y = useBreakListsLinkTest (map (uncurry noa) x) (map (uncurry noa) y)
where
noa a b = (a, ILink b orientAttachment)
useBreakListsLinkTest :: [(ItemStructuralFunction, ItemLink)]
-> [(ItemStructuralFunction, ItemLink)] -> LinkTest
useBreakListsLinkTest ::
[(ItemStructuralFunction, ItemLink)] ->
[(ItemStructuralFunction, ItemLink)] ->
LinkTest
useBreakListsLinkTest llist rlist = LTest ltest rtest
where
ltest (_, sf, _) = do
@@ -41,40 +44,42 @@ useBreakListsLinkTest llist rlist = LTest ltest rtest
(_, linktype) <- safeHead xs
return $ LUpdate linktype (set _3 (useBreakListsLinkTest llist (tail xs))) id
itemToBreakLists
:: ComposedItem
-> ([(ItemStructuralFunction, ComposeLinkType)] , [(ItemStructuralFunction, ComposeLinkType)])
itemToBreakLists ci = case (itm ^. itType,ci ^. cItemFunction) of
-- HELD TORCH -> (getAmmoLinks itm,[])
(_,WeaponPlatformSF) ->
( getAmmoLinks itm
, [(WeaponTargetingSF,WeaponTargetingLink), (WeaponScopeSF,WeaponScopeLink)]
)
-- AMMOMAG {} -> fromMaybe ([],[]) $ do
(_,AmmoMagSF {}) -> fromMaybe ([],[]) $ do
itemToBreakLists ::
ComposedItem ->
([(ItemStructuralFunction, ComposeLinkType)], [(ItemStructuralFunction, ComposeLinkType)])
itemToBreakLists ci = case (itm ^. itType, ci ^. cItemFunction) of
(HELD TORCH,_) -> (getAmmoLinks itm,[])
(_, WeaponPlatformSF) ->
( getAmmoLinks itm
, [(WeaponTargetingSF, WeaponTargetingLink), (WeaponScopeSF, WeaponScopeLink)]
)
(_, AmmoMagSF{}) -> fromMaybe ([], []) $ do
atype <- itm ^? itUse . amagType
return
([ (AmmoModifierSF atype, AmmoModLink)
, (AmmoTargetingSF atype, AmmoTargetingLink)
, (AmmoPayloadSF atype, AmmoPayloadLink)
, (AmmoEffectSF atype, AmmoEffectLink)
, (RemoteScreenSF, RemoteScreenLink)
],[])
(_,WeaponTargetingSF) -> (getAmmoLinks itm ++ [(AugmentedHUDSF,AugmentedHUDLink)],[])
_ -> ([],[])
return
(
[ (AmmoModifierSF atype, AmmoModLink)
, (AmmoTargetingSF atype, AmmoTargetingLink)
, (AmmoPayloadSF atype, AmmoPayloadLink)
, (AmmoEffectSF atype, AmmoEffectLink)
, (RemoteScreenSF, RemoteScreenLink)
]
, []
)
(_, WeaponTargetingSF) -> (getAmmoLinks itm ++ [(AugmentedHUDSF, AugmentedHUDLink)], [])
_ -> ([], [])
where
itm = ci ^. cItem
getAmmoLinks :: Item -> [(ItemStructuralFunction, ComposeLinkType)]
getAmmoLinks itm = map
(\(i, a) -> (AmmoMagSF a,AmmoInLink i a))
(IM.toList $ itm ^. itAmmoSlots)
getAmmoLinks itm =
map
(\(i, a) -> (AmmoMagSF a, AmmoInLink i a))
(IM.toList $ itm ^. itAmmoSlots)
itemToFunction :: Item -> ItemStructuralFunction
itemToFunction itm = case itm ^. itType of
HELD TORCH -> WeaponScopeSF
HELD {} -> WeaponPlatformSF
AMMOMAG {} -> maybe UncomposableIsolateSF AmmoMagSF $ itm ^? itUse . amagType
HELD{} -> WeaponPlatformSF
AMMOMAG{} -> maybe UncomposableIsolateSF AmmoMagSF $ itm ^? itUse . amagType
ATTACH REMOTESCREEN -> RemoteScreenSF
ATTACH BULLETSYNTHESIZER -> AmmoModifierSF BulletAmmo
ATTACH ZOOMSCOPE -> WeaponScopeSF
@@ -87,7 +92,7 @@ itemToFunction itm = case itm ^. itType of
_ -> UncomposableIsolateSF
pciToCI :: PartiallyComposedItem -> ComposedItem
pciToCI (x,y,_) = CItem x y
pciToCI (x, y, _) = CItem x y
basePCI :: Item -> PartiallyComposedItem
basePCI itm = case _itType itm of
@@ -106,9 +111,11 @@ llright itm pci = case pci ^. _1 . itType of
_ -> _tryRightLink (uncurry useBreakL $ itemToBreakLists (CItem itm WeaponTargetingSF)) pci
toLasgunUpdate :: Item -> LinkUpdate
toLasgunUpdate itm = LUpdate (ILink FunctionChangeLink orientAttachment)
(\(par,_,_) -> (par,WeaponPlatformSF,uncurry useBreakL $ itemToBreakLists (CItem itm WeaponPlatformSF)))
(\(chi,_,up) -> (chi,FunctionChangeSF,up))
toLasgunUpdate itm =
LUpdate
(ILink FunctionChangeLink orientAttachment)
(\(par, _, _) -> (par, WeaponPlatformSF, uncurry useBreakL $ itemToBreakLists (CItem itm WeaponPlatformSF)))
(\(chi, _, up) -> (chi, FunctionChangeSF, up))
--itemLinkTestLeft :: Item -> PartiallyComposedItem -> Maybe LinkUpdate
--itemLinkTestLeft itm = _tryLeftLink $
@@ -197,15 +204,15 @@ invTrees' = IM.unions . map (ldtToIM getindex . fmap (^. _1)) . map (fmap (\(x,
-- returns an intmap with trees for root items, indexed by inventory position
invRootTrees :: IM.IntMap Item -> IM.IntMap (LabelDoubleTree ItemLink ComposedItem)
invRootTrees = IM.fromDistinctAscList . reverse . map (getid . fmap (\(x, y, _) -> CItem x y)) . invLDT
invRootTrees = IM.fromDistinctAscList . reverse . map (getid . fmap (\(x, y, _) -> CItem x y)) . invLDT
where
getid :: LabelDoubleTree ItemLink ComposedItem -> (Int,LabelDoubleTree ItemLink ComposedItem)
getid :: LabelDoubleTree ItemLink ComposedItem -> (Int, LabelDoubleTree ItemLink ComposedItem)
getid t = (t ^?! ldtValue . cItem . itLocation . ilInvID, t)
-- returns an intmap with indents and locations for all items
allInvLocs :: IM.IntMap Item -> IM.IntMap (Int,LocationLDT ItemLink ComposedItem)
allInvLocs :: IM.IntMap Item -> IM.IntMap (Int, LocationLDT ItemLink ComposedItem)
allInvLocs inv = foldMap (f . LocLDT TopLDT) (IM.elems (invRootTrees inv)) mempty
where
f t = cldtPropagateFold h h g 0 t id
h x _ _ _ = x + 1
g x ldt = (.) (IM.insert (ldt ^?! locLDT . ldtValue . cItem . itLocation . ilInvID) (x,ldt))
g x ldt = (.) (IM.insert (ldt ^?! locLDT . ldtValue . cItem . itLocation . ilInvID) (x, ldt))