Use NewIntMap InvInt for crInv
This commit is contained in:
File diff suppressed because one or more lines are too long
@@ -5,8 +5,9 @@ module Dodge.Base.You
|
|||||||
, yourRootItem
|
, yourRootItem
|
||||||
)where
|
)where
|
||||||
|
|
||||||
|
import NewInt
|
||||||
import Dodge.Data.World
|
import Dodge.Data.World
|
||||||
import qualified IntMapHelp as IM
|
--import qualified IntMapHelp as IM
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
|
|
||||||
you :: World -> Creature
|
you :: World -> Creature
|
||||||
@@ -15,15 +16,15 @@ you w = w ^?! cWorld . lWorld . creatures . ix 0
|
|||||||
yourSelectedItem :: World -> Maybe Item
|
yourSelectedItem :: World -> Maybe Item
|
||||||
yourSelectedItem w = do
|
yourSelectedItem w = do
|
||||||
i <- you w ^? crManipulation . manObject . imSelectedItem
|
i <- you w ^? crManipulation . manObject . imSelectedItem
|
||||||
j <- _crInv (you w) IM.!? i
|
j <- _crInv (you w) ^? ix i
|
||||||
w ^? cWorld . lWorld . items . ix j
|
w ^? cWorld . lWorld . items . ix j
|
||||||
|
|
||||||
yourRootItem :: World -> Maybe Item
|
yourRootItem :: World -> Maybe Item
|
||||||
yourRootItem w = do
|
yourRootItem w = do
|
||||||
i <- you w ^? crManipulation . manObject . imRootSelectedItem
|
i <- you w ^? crManipulation . manObject . imRootSelectedItem
|
||||||
j <- _crInv (you w) IM.!? i
|
j <- _crInv (you w) ^? ix i
|
||||||
w ^? cWorld . lWorld . items . ix j
|
w ^? cWorld . lWorld . items . ix j
|
||||||
|
|
||||||
yourInv :: World -> IM.IntMap Item
|
yourInv :: World -> NewIntMap InvInt Item
|
||||||
yourInv w = fmap (\i -> w ^?! cWorld . lWorld . items . ix i) . _crInv . you $ w
|
yourInv w = fmap (\i -> w ^?! cWorld . lWorld . items . ix i) . _crInv . you $ w
|
||||||
|
|
||||||
|
|||||||
@@ -1,6 +1,7 @@
|
|||||||
--{-# LANGUAGE TupleSections #-}
|
--{-# LANGUAGE TupleSections #-}
|
||||||
module Dodge.Combine (combineList) where
|
module Dodge.Combine (combineList) where
|
||||||
|
|
||||||
|
import NewInt
|
||||||
import Dodge.Data.CombAmount
|
import Dodge.Data.CombAmount
|
||||||
import Dodge.Item.InvSize
|
import Dodge.Item.InvSize
|
||||||
import Dodge.Item.Grammar
|
import Dodge.Item.Grammar
|
||||||
@@ -32,7 +33,7 @@ combineList = map f . combineItemListYouX
|
|||||||
}
|
}
|
||||||
|
|
||||||
combineItemListYouX :: World -> [([Int], Item)]
|
combineItemListYouX :: World -> [([Int], Item)]
|
||||||
combineItemListYouX = map (first concat) . flatLookupItems . yourInv
|
combineItemListYouX = map (first concat) . flatLookupItems . _unNIntMap . yourInv
|
||||||
|
|
||||||
flatLookupItems :: IM.IntMap Item -> [([[Int]], Item)]
|
flatLookupItems :: IM.IntMap Item -> [([[Int]], Item)]
|
||||||
flatLookupItems =
|
flatLookupItems =
|
||||||
|
|||||||
@@ -57,7 +57,7 @@ spawnerCrit :: Creature
|
|||||||
spawnerCrit =
|
spawnerCrit =
|
||||||
defaultCreature
|
defaultCreature
|
||||||
& crHP .~ 300
|
& crHP .~ 300
|
||||||
& crInv .~ IM.empty
|
-- & crInv .~ IM.empty
|
||||||
-- & crType . skinUpper .~ lightx4 blue
|
-- & crType . skinUpper .~ lightx4 blue
|
||||||
|
|
||||||
miniGunCrit :: Creature
|
miniGunCrit :: Creature
|
||||||
|
|||||||
@@ -13,6 +13,7 @@ module Dodge.Creature.Action (
|
|||||||
youDropItem,
|
youDropItem,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import NewInt
|
||||||
import Dodge.Creature.MoveType
|
import Dodge.Creature.MoveType
|
||||||
import Dodge.Creature.Radius
|
import Dodge.Creature.Radius
|
||||||
import Dodge.Item.BackgroundEffect
|
import Dodge.Item.BackgroundEffect
|
||||||
@@ -166,14 +167,15 @@ performAction cr w ac = case ac of
|
|||||||
dropExcept :: Creature -> Int -> World -> World
|
dropExcept :: Creature -> Int -> World -> World
|
||||||
dropExcept cr invid w =
|
dropExcept cr invid w =
|
||||||
foldr (dropItem cr) w . IM.keys $
|
foldr (dropItem cr) w . IM.keys $
|
||||||
invid `IM.delete` _crInv cr
|
-- invid `IM.delete` _crInv cr
|
||||||
|
invid `IM.delete` (_unNIntMap $ _crInv cr)
|
||||||
|
|
||||||
-- why not a cid (Int)?
|
-- why not a cid (Int)?
|
||||||
dropItem :: Creature -> Int -> World -> World
|
dropItem :: Creature -> Int -> World -> World
|
||||||
dropItem cr invid w' =
|
dropItem cr invid w' =
|
||||||
doanyitemdropeffect
|
doanyitemdropeffect
|
||||||
. maybeshiftseldown
|
. maybeshiftseldown
|
||||||
. rmInvItem (_crID cr) invid
|
. rmInvItem (_crID cr) (NInt invid)
|
||||||
. copyItemToFloor (_crPos cr) itm -- . mayberemoveequip
|
. copyItemToFloor (_crPos cr) itm -- . mayberemoveequip
|
||||||
. soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
|
. soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
|
||||||
$ w'
|
$ w'
|
||||||
@@ -183,7 +185,7 @@ dropItem cr invid w' =
|
|||||||
-- return $ doInvEffect rmf itm cr
|
-- return $ doInvEffect rmf itm cr
|
||||||
doanyitemdropeffect = itEffectOnDrop itm cr
|
doanyitemdropeffect = itEffectOnDrop itm cr
|
||||||
itm = fromMaybe (error "dropItem cannot find item") $ do
|
itm = fromMaybe (error "dropItem cannot find item") $ do
|
||||||
itid <- cr ^? crInv . ix invid
|
itid <- cr ^? crInv . ix (NInt invid)
|
||||||
w' ^? cWorld . lWorld . items . ix itid
|
w' ^? cWorld . lWorld . items . ix itid
|
||||||
maybeshiftseldown w = fromMaybe w $ do
|
maybeshiftseldown w = fromMaybe w $ do
|
||||||
3 <- w ^? hud . hudElement . diSelection . _Just . _1
|
3 <- w ^? hud . hudElement . diSelection . _Just . _1
|
||||||
@@ -193,8 +195,8 @@ dropItem cr invid w' =
|
|||||||
youDropItem :: World -> World
|
youDropItem :: World -> World
|
||||||
youDropItem w = fromMaybe w $ do
|
youDropItem w = fromMaybe w $ do
|
||||||
curpos <-
|
curpos <-
|
||||||
cr ^? crManipulation . manObject . imSelectedItem
|
cr ^? crManipulation . manObject . imSelectedItem . unNInt
|
||||||
<|> fmap fst (IM.lookupMax (cr ^. crInv))
|
<|> fmap fst (IM.lookupMax (cr ^. crInv . unNIntMap))
|
||||||
--guard $ not $ _crInvLock cr
|
--guard $ not $ _crInvLock cr
|
||||||
guard $ not $ w ^. cWorld . lWorld . lInvLock
|
guard $ not $ w ^. cWorld . lWorld . lInvLock
|
||||||
return $ case cr ^. crStance . posture of
|
return $ case cr ^. crStance . posture of
|
||||||
|
|||||||
@@ -9,17 +9,17 @@ import Dodge.Creature.ChaseCrit
|
|||||||
import Dodge.Data.Creature
|
import Dodge.Data.Creature
|
||||||
import Dodge.Default
|
import Dodge.Default
|
||||||
--import Dodge.Item.Equipment
|
--import Dodge.Item.Equipment
|
||||||
import qualified IntMapHelp as IM
|
--import qualified IntMapHelp as IM
|
||||||
|
|
||||||
flockArmourChaseCrit :: Creature
|
flockArmourChaseCrit :: Creature
|
||||||
flockArmourChaseCrit =
|
flockArmourChaseCrit =
|
||||||
defaultCreature
|
defaultCreature
|
||||||
{ _crName = "armourChaseCrit"
|
{ _crName = "armourChaseCrit"
|
||||||
, _crHP = 300
|
, _crHP = 300
|
||||||
, _crInv =
|
, _crInv = mempty
|
||||||
IM.fromList
|
-- IM.fromList
|
||||||
[ --(0, frontArmour)
|
-- [ --(0, frontArmour)
|
||||||
]
|
-- ]
|
||||||
, _crActionPlan =
|
, _crActionPlan =
|
||||||
ActionPlan
|
ActionPlan
|
||||||
{ _apImpulse = []
|
{ _apImpulse = []
|
||||||
@@ -36,11 +36,11 @@ armourChaseCrit :: Creature
|
|||||||
armourChaseCrit =
|
armourChaseCrit =
|
||||||
chaseCrit
|
chaseCrit
|
||||||
{ _crName = "armourChaseCrit"
|
{ _crName = "armourChaseCrit"
|
||||||
, --, _crUpdate = defaultImpulsive []
|
-- , --, _crUpdate = defaultImpulsive []
|
||||||
_crInv =
|
-- _crInv =
|
||||||
IM.fromList
|
-- IM.fromList
|
||||||
[ --(0, frontArmour)
|
-- [ --(0, frontArmour)
|
||||||
]
|
-- ]
|
||||||
-- , _crMvType = defaultChaseMvType{_mvTurnRad = FloatConst 0.05}
|
-- , _crMvType = defaultChaseMvType{_mvTurnRad = FloatConst 0.05}
|
||||||
}
|
}
|
||||||
& crEquipment . at OnChest ?~ 0
|
& crEquipment . at OnChest ?~ 0
|
||||||
|
|||||||
@@ -4,6 +4,7 @@ module Dodge.Creature.Impulse (
|
|||||||
impulsiveAIBefore,
|
impulsiveAIBefore,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import NewInt
|
||||||
import Dodge.Creature.MoveType
|
import Dodge.Creature.MoveType
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
@@ -51,7 +52,7 @@ followImpulse cr w imp = case imp of
|
|||||||
UseItem -> undefined
|
UseItem -> undefined
|
||||||
-- UseItem -> (useSelectedItem $ _crID cr
|
-- UseItem -> (useSelectedItem $ _crID cr
|
||||||
-- , cr)
|
-- , cr)
|
||||||
SwitchToItem i -> crup $ cr & crManipulation . manObject .~ SelectedItem i i mempty
|
SwitchToItem i -> crup $ cr & crManipulation . manObject .~ SelectedItem (NInt i) (NInt i) mempty
|
||||||
Melee cid' ->
|
Melee cid' ->
|
||||||
( hitCr cid'
|
( hitCr cid'
|
||||||
, crMvAbsolute (w ^. cWorld . lWorld) (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crType . meleeCooldown .~ 20
|
, crMvAbsolute (w ^. cWorld . lWorld) (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crType . meleeCooldown .~ 20
|
||||||
|
|||||||
@@ -2,6 +2,7 @@
|
|||||||
|
|
||||||
module Dodge.Creature.Impulse.UseItem (useItem) where
|
module Dodge.Creature.Impulse.UseItem (useItem) where
|
||||||
|
|
||||||
|
import NewInt
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Dodge.Data.ComposedItem
|
import Dodge.Data.ComposedItem
|
||||||
@@ -13,7 +14,7 @@ import Dodge.HeldUse
|
|||||||
import Dodge.Inventory
|
import Dodge.Inventory
|
||||||
import Dodge.Item.Grammar
|
import Dodge.Item.Grammar
|
||||||
import Dodge.Item.Location
|
import Dodge.Item.Location
|
||||||
import qualified IntMapHelp as IM
|
--import qualified IntMapHelp as IM
|
||||||
|
|
||||||
useItem :: Int -> Int -> World -> Maybe World
|
useItem :: Int -> Int -> World -> Maybe World
|
||||||
useItem invid pt w = fmap (worldEventFlags . at InventoryChange ?~ ()) $ do
|
useItem invid pt w = fmap (worldEventFlags . at InventoryChange ?~ ()) $ do
|
||||||
@@ -62,7 +63,7 @@ activateDetonator det = fromMaybe id $ do
|
|||||||
pjid <- det ^? dtValue . _1 . itUse . uaParams . apProjectiles . ix 0
|
pjid <- det ^? dtValue . _1 . itUse . uaParams . apProjectiles . ix 0
|
||||||
return $ cWorld . lWorld . projectiles . ix pjid . pjTimer .~ 0
|
return $ cWorld . lWorld . projectiles . ix pjid . pjTimer .~ 0
|
||||||
|
|
||||||
toggleEquipmentAt :: Int -> Creature -> World -> World
|
toggleEquipmentAt :: NewInt InvInt -> Creature -> World -> World
|
||||||
toggleEquipmentAt invid cr w = case getEquipmentAllocation invid w of
|
toggleEquipmentAt invid cr w = case getEquipmentAllocation invid w of
|
||||||
DoNotMoveEquipment -> w
|
DoNotMoveEquipment -> w
|
||||||
PutOnEquipment{_allocNewPos = newp} ->
|
PutOnEquipment{_allocNewPos = newp} ->
|
||||||
@@ -94,11 +95,12 @@ toggleEquipmentAt invid cr w = case getEquipmentAllocation invid w of
|
|||||||
& toitems . ix itid . itLocation . ilEquipSite .~ Nothing
|
& toitems . ix itid . itLocation . ilEquipSite .~ Nothing
|
||||||
& onremove itm cr
|
& onremove itm cr
|
||||||
where
|
where
|
||||||
invidtoitid i = _crInv cr IM.! i
|
invidtoitid :: NewInt InvInt -> Int
|
||||||
|
invidtoitid i = cr ^?! crInv . ix i -- _crInv cr IM.! i
|
||||||
toitems = cWorld . lWorld . items
|
toitems = cWorld . lWorld . items
|
||||||
itid = _crInv cr IM.! invid
|
itid = invidtoitid invid
|
||||||
crpoint = cWorld . lWorld . creatures . ix (_crID cr)
|
crpoint = cWorld . lWorld . creatures . ix (_crID cr)
|
||||||
itmat i = w ^?! cWorld . lWorld . items . ix (_crInv cr IM.! i)
|
itmat i = w ^?! cWorld . lWorld . items . ix (invidtoitid i)
|
||||||
itm = itmat invid
|
itm = itmat invid
|
||||||
onequip itm' = effectOnEquip itm'
|
onequip itm' = effectOnEquip itm'
|
||||||
onremove itm' = effectOnRemove itm'
|
onremove itm' = effectOnRemove itm'
|
||||||
|
|||||||
@@ -11,7 +11,7 @@ module Dodge.Creature.Inanimate (
|
|||||||
import Dodge.Creature.Lamp
|
import Dodge.Creature.Lamp
|
||||||
import Dodge.Data.Creature
|
import Dodge.Data.Creature
|
||||||
import Dodge.Default
|
import Dodge.Default
|
||||||
import qualified IntMapHelp as IM
|
--import qualified IntMapHelp as IM
|
||||||
--import LensHelp
|
--import LensHelp
|
||||||
|
|
||||||
barrel :: Creature
|
barrel :: Creature
|
||||||
@@ -19,7 +19,7 @@ barrel =
|
|||||||
defaultInanimate
|
defaultInanimate
|
||||||
{ _crHP = 500
|
{ _crHP = 500
|
||||||
, _crType = BarrelCrit PlainBarrel
|
, _crType = BarrelCrit PlainBarrel
|
||||||
, _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
|
-- , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
|
||||||
}
|
}
|
||||||
|
|
||||||
explosiveBarrel :: Creature
|
explosiveBarrel :: Creature
|
||||||
@@ -27,6 +27,6 @@ explosiveBarrel =
|
|||||||
defaultInanimate
|
defaultInanimate
|
||||||
{ _crHP = 400
|
{ _crHP = 400
|
||||||
, _crType = BarrelCrit (ExplosiveBarrel [])
|
, _crType = BarrelCrit (ExplosiveBarrel [])
|
||||||
, _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
|
-- , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
|
||||||
}
|
}
|
||||||
-- & crMaterial .~ Crystal
|
-- & crMaterial .~ Crystal
|
||||||
|
|||||||
@@ -132,8 +132,8 @@ copierItemUpdate itm cr w = fromMaybe w $ do
|
|||||||
x <- itm ^? itScroll . itsInt
|
x <- itm ^? itScroll . itsInt
|
||||||
invid <- itm ^? itLocation . ilInvID
|
invid <- itm ^? itLocation . ilInvID
|
||||||
ip <- itm ^? itType . ibtPathing
|
ip <- itm ^? itType . ibtPathing
|
||||||
i <- getInventoryPath x ip invid cr
|
i <- getInventoryPath x ip (_unNInt invid) cr
|
||||||
itm' <- cr ^? crInv . ix i >>= \k -> w ^? cWorld . lWorld . items . ix k
|
itm' <- cr ^? crInv . ix (NInt i) >>= \k -> w ^? cWorld . lWorld . items . ix k
|
||||||
v <- getItemValue itm' w cr
|
v <- getItemValue itm' w cr
|
||||||
return $ w & pointerToItem itm . itUse . uValue .~ v
|
return $ w & pointerToItem itm . itUse . uValue .~ v
|
||||||
|
|
||||||
@@ -170,7 +170,7 @@ trySynthBullet loc w = fromMaybe w $ do
|
|||||||
if x < 100
|
if x < 100
|
||||||
then do
|
then do
|
||||||
bat <- loc ^? locDT . dtLeft . ix 0 . dtValue . _1
|
bat <- loc ^? locDT . dtLeft . ix 0 . dtValue . _1
|
||||||
j <- bat ^? itLocation . ilInvID
|
j <- bat ^? itID . unNInt
|
||||||
y <- bat ^. itConsumables
|
y <- bat ^. itConsumables
|
||||||
guard $ y > 0
|
guard $ y > 0
|
||||||
return $ w
|
return $ w
|
||||||
|
|||||||
@@ -6,6 +6,7 @@ module Dodge.Creature.Statistics (
|
|||||||
crIntelligence,
|
crIntelligence,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import NewInt
|
||||||
import Dodge.Data.LWorld
|
import Dodge.Data.LWorld
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import qualified IntMapHelp as IM
|
import qualified IntMapHelp as IM
|
||||||
@@ -54,8 +55,8 @@ equipmentStrValue itm = case _itType itm of
|
|||||||
EQUIP POWERLEGS -> 3
|
EQUIP POWERLEGS -> 3
|
||||||
_ -> 0
|
_ -> 0
|
||||||
|
|
||||||
crCurrentEquipment :: LWorld -> Creature -> IM.IntMap Item
|
crCurrentEquipment :: LWorld -> Creature -> NewIntMap InvInt Item
|
||||||
crCurrentEquipment lw = IM.filter (isJust . (^? itLocation . ilEquipSite . _Just)) . fmap f . _crInv
|
crCurrentEquipment lw = over unNIntMap (IM.filter (isJust . (^? itLocation . ilEquipSite . _Just))) . fmap f . _crInv
|
||||||
where
|
where
|
||||||
f i = lw ^?! items . ix i
|
f i = lw ^?! items . ix i
|
||||||
|
|
||||||
@@ -63,7 +64,8 @@ strFromHeldItem :: LWorld -> Creature -> Int
|
|||||||
strFromHeldItem lw cr = fromMaybe 0 $ do
|
strFromHeldItem lw cr = fromMaybe 0 $ do
|
||||||
Aiming <- cr ^? crStance . posture
|
Aiming <- cr ^? crStance . posture
|
||||||
i <- cr ^? crManipulation . manObject . imRootSelectedItem
|
i <- cr ^? crManipulation . manObject . imRootSelectedItem
|
||||||
fmap (negate . itemWeight) $ lw ^? items . ix i
|
j <- cr ^? crInv . ix i
|
||||||
|
fmap (negate . itemWeight) $ lw ^? items . ix j
|
||||||
|
|
||||||
itemWeight :: Item -> Int
|
itemWeight :: Item -> Int
|
||||||
itemWeight it = case it ^. itType of
|
itemWeight it = case it ^. itType of
|
||||||
|
|||||||
@@ -24,6 +24,7 @@ module Dodge.Creature.Test (
|
|||||||
crSafeDistFromTarg,
|
crSafeDistFromTarg,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import NewInt
|
||||||
import qualified Data.IntMap.Strict as IM
|
import qualified Data.IntMap.Strict as IM
|
||||||
import Dodge.Item.Grammar
|
import Dodge.Item.Grammar
|
||||||
import Dodge.Creature.Radius
|
import Dodge.Creature.Radius
|
||||||
@@ -97,7 +98,7 @@ crInAimStance as m cr = crIsAiming cr && mitstance == Just as
|
|||||||
mitstance = do
|
mitstance = do
|
||||||
i <- cr ^? crManipulation . manObject . imRootSelectedItem
|
i <- cr ^? crManipulation . manObject . imRootSelectedItem
|
||||||
--itm <- invRootTrees' (cr ^. crInv) ^? ix i
|
--itm <- invRootTrees' (cr ^. crInv) ^? ix i
|
||||||
itm <- fmap (fmap (\(a,b,_) -> (a,b))) $ invIMDT (fmap (\k -> m ^?! ix k) (cr ^. crInv)) ^? ix i
|
itm <- fmap (fmap (\(a,b,_) -> (a,b))) $ invIMDT (fmap (\k -> m ^?! ix k) (cr ^. crInv)) ^? ix (_unNInt i)
|
||||||
return $ aimStance itm
|
return $ aimStance itm
|
||||||
--cr ^? crInv . ix i . itUse . heldAim . aimStance
|
--cr ^? crInv . ix i . itUse . heldAim . aimStance
|
||||||
|
|
||||||
|
|||||||
@@ -1,5 +1,6 @@
|
|||||||
module Dodge.Creature.Update (updateCreature) where
|
module Dodge.Creature.Update (updateCreature) where
|
||||||
|
|
||||||
|
import NewInt
|
||||||
import Color
|
import Color
|
||||||
import qualified Data.IntMap.Strict as IM
|
import qualified Data.IntMap.Strict as IM
|
||||||
import qualified Data.List as List
|
import qualified Data.List as List
|
||||||
@@ -116,7 +117,7 @@ poisonSPic = _1 %~ overColSH (mixColors 0.5 0.5 green . normalizeColor)
|
|||||||
|
|
||||||
-- reverse keys, otherwise two or more inv items will cause errors
|
-- reverse keys, otherwise two or more inv items will cause errors
|
||||||
dropAll :: Creature -> World -> World
|
dropAll :: Creature -> World -> World
|
||||||
dropAll cr w = foldl' (flip (dropItem cr)) w . reverse . IM.keys $ _crInv cr
|
dropAll cr w = foldl' (flip (dropItem cr)) w . reverse . IM.keys . _unNIntMap $ _crInv cr
|
||||||
|
|
||||||
chasmTest :: Creature -> World -> World
|
chasmTest :: Creature -> World -> World
|
||||||
chasmTest cr w
|
chasmTest cr w
|
||||||
|
|||||||
@@ -57,7 +57,7 @@ handleHotkeys w
|
|||||||
w ^. input . pressedKeys
|
w ^. input . pressedKeys
|
||||||
, Just itid <- lw ^? hotkeys . ix hk . unNInt
|
, Just itid <- lw ^? hotkeys . ix hk . unNInt
|
||||||
, Just invid <- lw ^? items . ix itid . itLocation . ilInvID =
|
, Just invid <- lw ^? items . ix itid . itLocation . ilInvID =
|
||||||
w & invSetSelectionPos 0 invid
|
w & invSetSelectionPos 0 (_unNInt invid)
|
||||||
| otherwise =
|
| otherwise =
|
||||||
M.foldl'
|
M.foldl'
|
||||||
useHotkey
|
useHotkey
|
||||||
@@ -70,7 +70,7 @@ handleHotkeys w
|
|||||||
|
|
||||||
useHotkey :: World -> (NewInt ItmInt, Int) -> World
|
useHotkey :: World -> (NewInt ItmInt, Int) -> World
|
||||||
useHotkey w (NInt itid, pt) = fromMaybe w $ do
|
useHotkey w (NInt itid, pt) = fromMaybe w $ do
|
||||||
invid <- w ^? cWorld . lWorld . items . ix itid . itLocation . ilInvID
|
invid <- w ^? cWorld . lWorld . items . ix itid . itLocation . ilInvID . unNInt
|
||||||
useItem invid pt w
|
useItem invid pt w
|
||||||
|
|
||||||
hotkeyToScancode :: Hotkey -> SDL.Scancode
|
hotkeyToScancode :: Hotkey -> SDL.Scancode
|
||||||
@@ -231,6 +231,6 @@ tryClickUse pkeys w = fromMaybe w $ do
|
|||||||
^? cWorld . lWorld . creatures . ix 0
|
^? cWorld . lWorld . creatures . ix 0
|
||||||
. crManipulation
|
. crManipulation
|
||||||
. manObject
|
. manObject
|
||||||
. imSelectedItem of
|
. imSelectedItem . unNInt of
|
||||||
Just invid -> useItem invid ltime w
|
Just invid -> useItem invid ltime w
|
||||||
Nothing -> interactWithCloseObj <$> getSelectedCloseObj w ?? w
|
Nothing -> interactWithCloseObj <$> getSelectedCloseObj w ?? w
|
||||||
|
|||||||
@@ -17,6 +17,7 @@ module Dodge.Data.Creature (
|
|||||||
module Dodge.Data.Item.Use.Consumption.LoadAction,
|
module Dodge.Data.Item.Use.Consumption.LoadAction,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import NewInt
|
||||||
import Dodge.Data.Item.Use.Consumption.LoadAction
|
import Dodge.Data.Item.Use.Consumption.LoadAction
|
||||||
import Dodge.Data.Equipment.Misc
|
import Dodge.Data.Equipment.Misc
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
@@ -32,7 +33,7 @@ import Dodge.Data.Creature.State
|
|||||||
import Dodge.Data.Item
|
import Dodge.Data.Item
|
||||||
import Dodge.Data.Material
|
import Dodge.Data.Material
|
||||||
import Geometry.Data
|
import Geometry.Data
|
||||||
import qualified IntMapHelp as IM
|
--import qualified IntMapHelp as IM
|
||||||
|
|
||||||
data Creature = Creature
|
data Creature = Creature
|
||||||
{ _crPos :: Point2
|
{ _crPos :: Point2
|
||||||
@@ -45,9 +46,9 @@ data Creature = Creature
|
|||||||
, _crType :: CreatureType
|
, _crType :: CreatureType
|
||||||
, _crID :: Int
|
, _crID :: Int
|
||||||
, _crHP :: Int
|
, _crHP :: Int
|
||||||
, _crInv :: IM.IntMap Int
|
, _crInv :: NewIntMap InvInt Int
|
||||||
, _crManipulation :: Manipulation
|
, _crManipulation :: Manipulation
|
||||||
, _crEquipment :: M.Map EquipSite Int
|
, _crEquipment :: M.Map EquipSite (NewInt InvInt)
|
||||||
, _crDamage :: [Damage]
|
, _crDamage :: [Damage]
|
||||||
, _crPain :: Int
|
, _crPain :: Int
|
||||||
, _crStance :: Stance
|
, _crStance :: Stance
|
||||||
|
|||||||
@@ -5,6 +5,7 @@
|
|||||||
{-# LANGUAGE EmptyDataDeriving #-}
|
{-# LANGUAGE EmptyDataDeriving #-}
|
||||||
module Dodge.Data.Item.Location where
|
module Dodge.Data.Item.Location where
|
||||||
|
|
||||||
|
import NewInt
|
||||||
import ShortShow
|
import ShortShow
|
||||||
import Dodge.Data.Equipment.Misc
|
import Dodge.Data.Equipment.Misc
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
@@ -13,9 +14,6 @@ import Data.Aeson.TH
|
|||||||
|
|
||||||
-- it would be nice to have these as empty types, but I'm not sure how to get
|
-- it would be nice to have these as empty types, but I'm not sure how to get
|
||||||
-- aeson to handle that
|
-- aeson to handle that
|
||||||
data FloorInt = FloorInt
|
|
||||||
deriving (Eq,Ord,Show,Read)
|
|
||||||
-- should use these..
|
|
||||||
data InvInt = InvInt
|
data InvInt = InvInt
|
||||||
deriving (Eq,Ord,Show,Read)
|
deriving (Eq,Ord,Show,Read)
|
||||||
data TurretInt
|
data TurretInt
|
||||||
@@ -28,7 +26,7 @@ data ItmInt = ItmInt
|
|||||||
data ItemLocation
|
data ItemLocation
|
||||||
= InInv
|
= InInv
|
||||||
{ _ilCrID :: Int
|
{ _ilCrID :: Int
|
||||||
, _ilInvID :: Int
|
, _ilInvID :: NewInt InvInt
|
||||||
, _ilIsRoot :: Bool -- of any item
|
, _ilIsRoot :: Bool -- of any item
|
||||||
, _ilIsSelected :: Bool
|
, _ilIsSelected :: Bool
|
||||||
, _ilIsAttached :: Bool -- to selected item
|
, _ilIsAttached :: Bool -- to selected item
|
||||||
@@ -41,7 +39,7 @@ data ItemLocation
|
|||||||
|
|
||||||
instance ShortShow ItemLocation where
|
instance ShortShow ItemLocation where
|
||||||
shortShow (InInv cid invid rootb selb attb esite)
|
shortShow (InInv cid invid rootb selb attb esite)
|
||||||
= "InInv:cid" <> shortShow cid <> "invid"<> shortShow invid
|
= "InInv:cid" <> shortShow cid <> "invid"<> shortShow (_unNInt invid)
|
||||||
<>"root"<>shortShow rootb<>"sel"<>shortShow selb<>"att"<>shortShow attb<>
|
<>"root"<>shortShow rootb<>"sel"<>shortShow selb<>"att"<>shortShow attb<>
|
||||||
shortShow (fmap (SString . show) esite)
|
shortShow (fmap (SString . show) esite)
|
||||||
shortShow x = show x
|
shortShow x = show x
|
||||||
@@ -51,7 +49,6 @@ instance ShortShow ItemLocation where
|
|||||||
|
|
||||||
makeLenses ''ItemLocation
|
makeLenses ''ItemLocation
|
||||||
deriveJSON defaultOptions ''InvInt
|
deriveJSON defaultOptions ''InvInt
|
||||||
deriveJSON defaultOptions ''FloorInt
|
|
||||||
deriveJSON defaultOptions ''ItemLocation
|
deriveJSON defaultOptions ''ItemLocation
|
||||||
deriveJSON defaultOptions ''ItmInt
|
deriveJSON defaultOptions ''ItmInt
|
||||||
deriveJSON defaultOptions ''CrInt
|
deriveJSON defaultOptions ''CrInt
|
||||||
|
|||||||
@@ -5,6 +5,8 @@
|
|||||||
|
|
||||||
module Dodge.Data.Item.Use.Consumption.LoadAction where
|
module Dodge.Data.Item.Use.Consumption.LoadAction where
|
||||||
|
|
||||||
|
import Dodge.Data.Item.Location
|
||||||
|
import NewInt
|
||||||
import qualified Data.IntSet as IS
|
import qualified Data.IntSet as IS
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
@@ -20,9 +22,9 @@ data Manipulation -- should be ManipulatedObject?
|
|||||||
data ManipulatedObject
|
data ManipulatedObject
|
||||||
= SortInventory
|
= SortInventory
|
||||||
| SelectedItem
|
| SelectedItem
|
||||||
{ _imSelectedItem :: Int -- this should probably be the itmid, not the invid
|
{ _imSelectedItem :: NewInt InvInt
|
||||||
, _imRootSelectedItem :: Int
|
, _imRootSelectedItem :: NewInt InvInt
|
||||||
, _imAttachedItems :: IS.IntSet
|
, _imAttachedItems :: IS.IntSet -- this should probably be NewIntSet InvInt also
|
||||||
}
|
}
|
||||||
| SelNothing
|
| SelNothing
|
||||||
| SortCloseItem
|
| SortCloseItem
|
||||||
|
|||||||
@@ -5,6 +5,8 @@
|
|||||||
|
|
||||||
module Dodge.Data.RightButtonOptions where
|
module Dodge.Data.RightButtonOptions where
|
||||||
|
|
||||||
|
import Dodge.Data.Item.Location
|
||||||
|
import NewInt
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.Aeson.TH
|
import Data.Aeson.TH
|
||||||
@@ -27,11 +29,11 @@ data EquipmentAllocation
|
|||||||
| SwapEquipment
|
| SwapEquipment
|
||||||
{ _allocNewPos :: EquipSite
|
{ _allocNewPos :: EquipSite
|
||||||
, _allocOldPos :: EquipSite
|
, _allocOldPos :: EquipSite
|
||||||
, _allocSwapID :: Int
|
, _allocSwapID :: NewInt InvInt
|
||||||
}
|
}
|
||||||
| ReplaceEquipment
|
| ReplaceEquipment
|
||||||
{ _allocNewPos :: EquipSite
|
{ _allocNewPos :: EquipSite
|
||||||
, _allocRemoveID :: Int
|
, _allocRemoveID :: NewInt InvInt
|
||||||
}
|
}
|
||||||
| RemoveEquipment
|
| RemoveEquipment
|
||||||
{ _allocOldPos :: EquipSite
|
{ _allocOldPos :: EquipSite
|
||||||
|
|||||||
@@ -5,6 +5,8 @@
|
|||||||
|
|
||||||
module Dodge.Data.WorldEffect where
|
module Dodge.Data.WorldEffect where
|
||||||
|
|
||||||
|
import Dodge.Data.Item.Location
|
||||||
|
import NewInt
|
||||||
import Dodge.Data.LightSource
|
import Dodge.Data.LightSource
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.Aeson.TH
|
import Data.Aeson.TH
|
||||||
@@ -31,7 +33,7 @@ data WdWd
|
|||||||
-- | WdWdFromItCrixWdWd (LabelDoubleTree ComposeLinkType Item) Int ItCrWdWd
|
-- | WdWdFromItCrixWdWd (LabelDoubleTree ComposeLinkType Item) Int ItCrWdWd
|
||||||
| MakeTempLight LSParam Int
|
| MakeTempLight LSParam Int
|
||||||
| UseInvItem Int Int -- invid presstime
|
| UseInvItem Int Int -- invid presstime
|
||||||
| WdWdBurstFireRepetition Int Int
|
| WdWdBurstFireRepetition Int (NewInt InvInt)
|
||||||
--deriving (Eq, Show, Read) --, Generic)
|
--deriving (Eq, Show, Read) --, Generic)
|
||||||
--h--deriving (Eq, Show, Read) --Generic, Flat)
|
--h--deriving (Eq, Show, Read) --Generic, Flat)
|
||||||
|
|
||||||
|
|||||||
@@ -5,7 +5,7 @@ import qualified Data.Map.Strict as M
|
|||||||
import Dodge.Data.Creature
|
import Dodge.Data.Creature
|
||||||
import Dodge.Data.FloatFunction
|
import Dodge.Data.FloatFunction
|
||||||
import Geometry.Data
|
import Geometry.Data
|
||||||
import qualified IntMapHelp as IM
|
--import qualified IntMapHelp as IM
|
||||||
--import Picture
|
--import Picture
|
||||||
--import MaybeHelp
|
--import MaybeHelp
|
||||||
|
|
||||||
@@ -25,7 +25,7 @@ defaultCreature =
|
|||||||
-- , _crRad = 10
|
-- , _crRad = 10
|
||||||
, _crHP = 100
|
, _crHP = 100
|
||||||
-- , _crMaxHP = 150
|
-- , _crMaxHP = 150
|
||||||
, _crInv = IM.empty
|
, _crInv = mempty
|
||||||
, _crManipulation = Manipulator SelNothing
|
, _crManipulation = Manipulator SelNothing
|
||||||
-- , _crInvCapacity = 25
|
-- , _crInvCapacity = 25
|
||||||
, _crDamage = []
|
, _crDamage = []
|
||||||
|
|||||||
@@ -62,7 +62,7 @@ updateCombineSections w cfig =
|
|||||||
(IM.fromDistinctAscList . zip [0 ..] $ combineList w)
|
(IM.fromDistinctAscList . zip [0 ..] $ combineList w)
|
||||||
"COMBINATIONS"
|
"COMBINATIONS"
|
||||||
$ w ^? hud . hudElement . subInventory . ciFilter . _Just
|
$ w ^? hud . hudElement . subInventory . ciFilter . _Just
|
||||||
invitms = fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $ fold $ w ^? cWorld . lWorld . creatures . ix 0 . crInv
|
invitms = _unNIntMap $ fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $ fold $ w ^? cWorld . lWorld . creatures . ix 0 . crInv
|
||||||
sclose'
|
sclose'
|
||||||
| null sclose =
|
| null sclose =
|
||||||
IM.singleton 0 $
|
IM.singleton 0 $
|
||||||
|
|||||||
@@ -165,6 +165,7 @@ dtToUpDownAdj f (DT x l r) =
|
|||||||
|
|
||||||
-- returns an adjacency map with oldest ancestor and direct parent if they exist
|
-- returns an adjacency map with oldest ancestor and direct parent if they exist
|
||||||
-- and any left and right children
|
-- and any left and right children
|
||||||
|
-- this should be all involving invids
|
||||||
dtToLRAdj :: (a -> Int) -> DTree a -> IM.IntMap (Maybe (Int, Int), [Int], [Int])
|
dtToLRAdj :: (a -> Int) -> DTree a -> IM.IntMap (Maybe (Int, Int), [Int], [Int])
|
||||||
dtToLRAdj f (DT x l r) =
|
dtToLRAdj f (DT x l r) =
|
||||||
IM.insert i (Nothing, map g l, map g r)
|
IM.insert i (Nothing, map g l, map g r)
|
||||||
|
|||||||
@@ -1118,7 +1118,8 @@ mcUseHeld hit = case hit of
|
|||||||
LASER -> mcShootLaser
|
LASER -> mcShootLaser
|
||||||
_ -> mcShootAuto
|
_ -> mcShootAuto
|
||||||
|
|
||||||
useGasParams :: Maybe Int -> Muzzle -> LocationDT OItem -> Creature -> World -> World
|
useGasParams :: Maybe (NewInt InvInt)
|
||||||
|
-> Muzzle -> LocationDT OItem -> Creature -> World -> World
|
||||||
useGasParams mmagid mz loc cr w =
|
useGasParams mmagid mz loc cr w =
|
||||||
w
|
w
|
||||||
& createGas gastype pressure pos dir cr
|
& createGas gastype pressure pos dir cr
|
||||||
@@ -1413,7 +1414,7 @@ dropInventoryPath ::
|
|||||||
World ->
|
World ->
|
||||||
World
|
World
|
||||||
dropInventoryPath i ip loc cr = fromMaybe id $ do
|
dropInventoryPath i ip loc cr = fromMaybe id $ do
|
||||||
invid <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID
|
invid <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
|
||||||
j <- getInventoryPath i ip invid cr
|
j <- getInventoryPath i ip invid cr
|
||||||
return $ dropItem cr j
|
return $ dropItem cr j
|
||||||
|
|
||||||
@@ -1446,15 +1447,15 @@ useInventoryPath ::
|
|||||||
World
|
World
|
||||||
useInventoryPath pt i ip loc cr w = case ip of
|
useInventoryPath pt i ip loc cr w = case ip of
|
||||||
ABSOLUTE -> fromMaybe w $ do
|
ABSOLUTE -> fromMaybe w $ do
|
||||||
guard $ i `IM.member` (cr ^. crInv)
|
guard $ i `IM.member` (cr ^. crInv . unNIntMap)
|
||||||
return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem i pt)
|
return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem i pt)
|
||||||
RELCURS -> fromMaybe w $ do
|
RELCURS -> fromMaybe w $ do
|
||||||
j <- cr ^? crManipulation . manObject . imSelectedItem
|
j <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
|
||||||
guard $ (i + j) `IM.member` (cr ^. crInv)
|
guard $ (i + j) `IM.member` (cr ^. crInv . unNIntMap)
|
||||||
return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt)
|
return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt)
|
||||||
RELITEM -> fromMaybe w $ do
|
RELITEM -> fromMaybe w $ do
|
||||||
j <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID
|
j <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
|
||||||
guard $ (i + j) `IM.member` (cr ^. crInv)
|
guard $ (i + j) `IM.member` (cr ^. crInv . unNIntMap)
|
||||||
return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt)
|
return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt)
|
||||||
|
|
||||||
--useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of
|
--useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of
|
||||||
|
|||||||
@@ -39,7 +39,7 @@ import NewInt
|
|||||||
|
|
||||||
-- should consider never fully destroying items, but assigning a flag saying how
|
-- should consider never fully destroying items, but assigning a flag saying how
|
||||||
-- they were moved from play
|
-- they were moved from play
|
||||||
destroyInvItem :: Int -> Int -> World -> World
|
destroyInvItem :: Int -> NewInt InvInt -> World -> World
|
||||||
destroyInvItem cid invid w =
|
destroyInvItem cid invid w =
|
||||||
rmInvItem cid invid w & removeitloc
|
rmInvItem cid invid w & removeitloc
|
||||||
& removeithotkey
|
& removeithotkey
|
||||||
@@ -58,7 +58,9 @@ destroyAllInvItems :: Creature -> World -> World
|
|||||||
destroyAllInvItems cr w =
|
destroyAllInvItems cr w =
|
||||||
foldl' (flip $ destroyInvItem (cr ^. crID)) w
|
foldl' (flip $ destroyInvItem (cr ^. crID)) w
|
||||||
. reverse
|
. reverse
|
||||||
|
. fmap NInt
|
||||||
. IM.keys
|
. IM.keys
|
||||||
|
. _unNIntMap
|
||||||
$ cr ^. crInv
|
$ cr ^. crInv
|
||||||
|
|
||||||
destroyItem :: Int -> World -> World
|
destroyItem :: Int -> World -> World
|
||||||
@@ -73,7 +75,7 @@ destroyItem itid w = case w ^? cWorld . lWorld . items . ix itid . itLocation of
|
|||||||
|
|
||||||
-- note rmInvItem does not fully destroy the item, other updates to the item
|
-- note rmInvItem does not fully destroy the item, other updates to the item
|
||||||
-- location are required
|
-- location are required
|
||||||
rmInvItem :: Int -> Int -> World -> World
|
rmInvItem :: Int -> NewInt InvInt -> World -> World
|
||||||
rmInvItem cid invid w =
|
rmInvItem cid invid w =
|
||||||
w
|
w
|
||||||
& dounequipfunction --the ordering of these is
|
& dounequipfunction --the ordering of these is
|
||||||
@@ -95,7 +97,7 @@ rmInvItem cid invid w =
|
|||||||
| otherwise =
|
| otherwise =
|
||||||
pointcid . crManipulation . manObject . imSelectedItem %~ g
|
pointcid . crManipulation . manObject . imSelectedItem %~ g
|
||||||
cr = w ^?! cWorld . lWorld . creatures . ix cid
|
cr = w ^?! cWorld . lWorld . creatures . ix cid
|
||||||
itid = _crInv cr IM.! invid
|
itid = _crInv cr ^?! ix invid
|
||||||
itm = w ^?! cWorld . lWorld . items . ix itid
|
itm = w ^?! cWorld . lWorld . items . ix itid
|
||||||
dounequipfunction = effectOnRemove itm cr
|
dounequipfunction = effectOnRemove itm cr
|
||||||
-- fromMaybe id $ do
|
-- fromMaybe id $ do
|
||||||
@@ -110,13 +112,13 @@ rmInvItem cid invid w =
|
|||||||
. ilEquipSite
|
. ilEquipSite
|
||||||
. _Just
|
. _Just
|
||||||
return $ pointcid . crEquipment . at epos .~ Nothing
|
return $ pointcid . crEquipment . at epos .~ Nothing
|
||||||
maxk = fmap fst $ IM.lookupMax $ cr ^. crInv
|
maxk = fmap fst $ IM.lookupMax $ _unNIntMap $ cr ^. crInv
|
||||||
f inv =
|
f inv =
|
||||||
let (xs, ys) = IM.split invid inv
|
let (xs, ys) = IM.split (_unNInt invid) $ _unNIntMap inv
|
||||||
in xs `IM.union` IM.mapKeysMonotonic (subtract 1) ys
|
in NIntMap $ xs `IM.union` IM.mapKeysMonotonic (subtract 1) ys
|
||||||
-- the following might not work if a non-player creature drops their last item
|
-- the following might not work if a non-player creature drops their last item
|
||||||
g x
|
g x
|
||||||
| x > invid || Just x == maxk = max 0 $ x - 1
|
| x > invid || Just x == fmap NInt maxk = max 0 $ x - 1
|
||||||
| otherwise = x
|
| otherwise = x
|
||||||
|
|
||||||
updateCloseObjects :: World -> World
|
updateCloseObjects :: World -> World
|
||||||
|
|||||||
@@ -20,7 +20,7 @@ import NewInt
|
|||||||
|
|
||||||
-- should check that the item is not already in your inventory
|
-- should check that the item is not already in your inventory
|
||||||
-- this assumes that this is a floor item
|
-- this assumes that this is a floor item
|
||||||
tryPutItemInInv :: Int -> Int -> World -> Maybe (Int,World)
|
tryPutItemInInv :: Int -> Int -> World -> Maybe (NewInt InvInt,World)
|
||||||
tryPutItemInInv cid itid w = do
|
tryPutItemInInv cid itid w = do
|
||||||
itm <- w ^? cWorld . lWorld . items . ix itid
|
itm <- w ^? cWorld . lWorld . items . ix itid
|
||||||
invid <- checkInvSlotsYou itm w
|
invid <- checkInvSlotsYou itm w
|
||||||
@@ -51,8 +51,8 @@ tryPutItemInInv cid itid w = do
|
|||||||
tryPutItemInInvAt :: Int -> Int -> Int -> World -> Maybe World
|
tryPutItemInInvAt :: Int -> Int -> Int -> World -> Maybe World
|
||||||
tryPutItemInInvAt i cid itid w = do
|
tryPutItemInInvAt i cid itid w = do
|
||||||
(j, w') <- tryPutItemInInv cid itid w
|
(j, w') <- tryPutItemInInv cid itid w
|
||||||
guard (i <= j)
|
guard (i <= _unNInt j)
|
||||||
return $ foldr f w' [i + 1 .. j]
|
return $ foldr f w' [i + 1 .. _unNInt j]
|
||||||
where
|
where
|
||||||
f j = swapInvItems (\_ _ -> Just (j -1)) j
|
f j = swapInvItems (\_ _ -> Just (j -1)) j
|
||||||
|
|
||||||
|
|||||||
@@ -4,6 +4,7 @@ module Dodge.Inventory.CheckSlots (
|
|||||||
maxInvSlots,
|
maxInvSlots,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import NewInt
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Dodge.Item.InvSize
|
import Dodge.Item.InvSize
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
@@ -14,11 +15,11 @@ import qualified IntMapHelp as IM
|
|||||||
{- | checks whether or not an item will fit in your inventory
|
{- | checks whether or not an item will fit in your inventory
|
||||||
if so return Just the next slot to be used
|
if so return Just the next slot to be used
|
||||||
-}
|
-}
|
||||||
checkInvSlotsYou :: Item -> World -> Maybe Int
|
checkInvSlotsYou :: Item -> World -> Maybe (NewInt InvInt)
|
||||||
checkInvSlotsYou it w = do
|
checkInvSlotsYou it w = do
|
||||||
ycr <- w ^? cWorld . lWorld . creatures . ix 0
|
ycr <- w ^? cWorld . lWorld . creatures . ix 0
|
||||||
guard $ crNumFreeSlots (w ^. cWorld . lWorld . items) ycr >= itInvHeight it
|
guard $ crNumFreeSlots (w ^. cWorld . lWorld . items) ycr >= itInvHeight it
|
||||||
Just . IM.newKey $ _crInv ycr
|
Just . NInt . IM.newKey . _unNIntMap $ _crInv ycr
|
||||||
|
|
||||||
crNumFreeSlots :: IM.IntMap Item -> Creature -> Int
|
crNumFreeSlots :: IM.IntMap Item -> Creature -> Int
|
||||||
--crNumFreeSlots cr = _crInvCapacity cr - invSize (_crInv cr)
|
--crNumFreeSlots cr = _crInvCapacity cr - invSize (_crInv cr)
|
||||||
@@ -29,5 +30,5 @@ crNumFreeSlots m cr = maxInvSlots - invSize (fmap f (_crInv cr))
|
|||||||
maxInvSlots :: Int
|
maxInvSlots :: Int
|
||||||
maxInvSlots = 25
|
maxInvSlots = 25
|
||||||
|
|
||||||
invSize :: IM.IntMap Item -> Int
|
invSize :: NewIntMap InvInt Item -> Int
|
||||||
invSize = alaf Sum foldMap itInvHeight
|
invSize = alaf Sum foldMap itInvHeight
|
||||||
|
|||||||
@@ -20,12 +20,13 @@ import qualified IntMapHelp as IM
|
|||||||
import NewInt
|
import NewInt
|
||||||
|
|
||||||
-- assumes all item locations inside the items are correct
|
-- assumes all item locations inside the items are correct
|
||||||
tryGetRootAttachedFromInvID :: Int -> IM.IntMap Item -> Maybe (Int, IS.IntSet)
|
tryGetRootAttachedFromInvID :: NewInt InvInt
|
||||||
tryGetRootAttachedFromInvID invid im = do
|
-> NewIntMap InvInt Item -> Maybe (Int, IS.IntSet)
|
||||||
|
tryGetRootAttachedFromInvID (NInt invid) im = do
|
||||||
let imroots = invRootMap im
|
let imroots = invRootMap im
|
||||||
theroot = fromMaybe invid $ imroots ^? ix invid . _1 . _Just
|
theroot = fromMaybe invid $ imroots ^? ix invid . _1 . _Just
|
||||||
t <- imroots ^? ix theroot . _2
|
t <- imroots ^? ix theroot . _2
|
||||||
return (theroot, foldMap (IS.singleton . (^?! itLocation . ilInvID)) t)
|
return (theroot, foldMap (IS.singleton . (^?! itLocation . ilInvID . unNInt)) t)
|
||||||
|
|
||||||
-- this assumes the creature inventory is well formed, specifically the
|
-- this assumes the creature inventory is well formed, specifically the
|
||||||
-- location ids
|
-- location ids
|
||||||
@@ -37,9 +38,9 @@ tryGetRootItemInvID m i cr = do
|
|||||||
|
|
||||||
updateRootItemID :: IM.IntMap Item -> Creature -> Creature
|
updateRootItemID :: IM.IntMap Item -> Creature -> Creature
|
||||||
updateRootItemID m cr = fromMaybe cr $ do
|
updateRootItemID m cr = fromMaybe cr $ do
|
||||||
i <- cr ^? crManipulation . manObject . imSelectedItem
|
i <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
|
||||||
j <- tryGetRootItemInvID m i cr
|
j <- tryGetRootItemInvID m i cr
|
||||||
return $ cr & crManipulation . manObject . imRootSelectedItem .~ j
|
return $ cr & crManipulation . manObject . imRootSelectedItem .~ NInt j
|
||||||
|
|
||||||
-- the following assumes that the crManipulation is correct
|
-- the following assumes that the crManipulation is correct
|
||||||
crUpdateItemLocations :: Int -> LWorld -> LWorld
|
crUpdateItemLocations :: Int -> LWorld -> LWorld
|
||||||
@@ -48,7 +49,7 @@ crUpdateItemLocations crid lw = fromMaybe lw $ do
|
|||||||
cinv <- lw ^? creatures . ix crid . crInv
|
cinv <- lw ^? creatures . ix crid . crInv
|
||||||
--let crinv = IM.restrictKeys (lw ^. items) (IS.fromList $ IM.elems itids)
|
--let crinv = IM.restrictKeys (lw ^. items) (IS.fromList $ IM.elems itids)
|
||||||
let crinv = fmap (\k -> lw ^?! items . ix k) cinv
|
let crinv = fmap (\k -> lw ^?! items . ix k) cinv
|
||||||
return $ crSetRoots crid $ IM.foldlWithKey' (crUpdateInvidLocations mo crid) lw crinv
|
return $ crSetRoots crid $ IM.foldlWithKey' (crUpdateInvidLocations mo crid) lw $ _unNIntMap crinv
|
||||||
|
|
||||||
crSetRoots :: Int -> LWorld -> LWorld
|
crSetRoots :: Int -> LWorld -> LWorld
|
||||||
crSetRoots cid w = fromMaybe w $ do
|
crSetRoots cid w = fromMaybe w $ do
|
||||||
@@ -61,19 +62,20 @@ crSetRoots cid w = fromMaybe w $ do
|
|||||||
f w' x = w'
|
f w' x = w'
|
||||||
& items . ix (x ^. dtValue . _1 . itID . unNInt) . itLocation . ilIsRoot .~ True
|
& items . ix (x ^. dtValue . _1 . itID . unNInt) . itLocation . ilIsRoot .~ True
|
||||||
|
|
||||||
crUpdateInvidLocations :: ManipulatedObject -> Int -> LWorld -> Int -> Item -> LWorld
|
crUpdateInvidLocations :: ManipulatedObject -> Int -> LWorld -> Int
|
||||||
|
-> Item -> LWorld
|
||||||
crUpdateInvidLocations mo crid lw invid itm =
|
crUpdateInvidLocations mo crid lw invid itm =
|
||||||
lw
|
lw
|
||||||
& creatures . ix crid . crInv . ix invid .~ itid -- . itLocation .~ newloc
|
& creatures . ix crid . crInv . ix (NInt invid) .~ itid -- . itLocation .~ newloc
|
||||||
& items . ix itid .~ (itm & itLocation .~ newloc)
|
& items . ix itid .~ (itm & itLocation .~ newloc)
|
||||||
where
|
where
|
||||||
itid = itm ^. itID . unNInt
|
itid = itm ^. itID . unNInt
|
||||||
newloc =
|
newloc =
|
||||||
InInv
|
InInv
|
||||||
{ _ilCrID = crid
|
{ _ilCrID = crid
|
||||||
, _ilInvID = invid
|
, _ilInvID = NInt invid
|
||||||
, _ilIsRoot = Just invid == mo ^? imRootSelectedItem
|
, _ilIsRoot = Just (NInt invid) == mo ^? imRootSelectedItem
|
||||||
, _ilIsSelected = Just invid == mo ^? imSelectedItem
|
, _ilIsSelected = Just (NInt invid) == mo ^? imSelectedItem
|
||||||
, _ilIsAttached = invid `IS.member` (mo ^. imAttachedItems)
|
, _ilIsAttached = invid `IS.member` (mo ^. imAttachedItems)
|
||||||
, _ilEquipSite = do
|
, _ilEquipSite = do
|
||||||
lw ^? items . ix itid . itLocation . ilEquipSite . _Just
|
lw ^? items . ix itid . itLocation . ilEquipSite . _Just
|
||||||
@@ -83,8 +85,7 @@ crUpdateInvidLocations mo crid lw invid itm =
|
|||||||
-- concern the player creature
|
-- concern the player creature
|
||||||
-- this might not work if the selpos is in the inventory but too large
|
-- this might not work if the selpos is in the inventory but too large
|
||||||
setInvPosFromSS :: World -> World
|
setInvPosFromSS :: World -> World
|
||||||
setInvPosFromSS w =
|
setInvPosFromSS w = w
|
||||||
w
|
|
||||||
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel
|
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel
|
||||||
where
|
where
|
||||||
thesel = fromMaybe SelNothing $ do
|
thesel = fromMaybe SelNothing $ do
|
||||||
@@ -92,12 +93,12 @@ setInvPosFromSS w =
|
|||||||
case i of
|
case i of
|
||||||
(-1) -> Just SortInventory
|
(-1) -> Just SortInventory
|
||||||
0 -> do
|
0 -> do
|
||||||
(rootid, aset) <- tryGetRootAttachedFromInvID j (fmap (\k -> w ^?! cWorld . lWorld . items . ix k )
|
(rootid, aset) <- tryGetRootAttachedFromInvID (NInt j) (fmap (\k -> w ^?! cWorld . lWorld . items . ix k )
|
||||||
$ you w ^. crInv)
|
$ you w ^. crInv)
|
||||||
return
|
return
|
||||||
SelectedItem
|
SelectedItem
|
||||||
{ _imSelectedItem = j
|
{ _imSelectedItem = NInt j
|
||||||
, _imRootSelectedItem = rootid
|
, _imRootSelectedItem = NInt rootid
|
||||||
, _imAttachedItems = aset
|
, _imAttachedItems = aset
|
||||||
}
|
}
|
||||||
1 -> Just SelNothing
|
1 -> Just SelNothing
|
||||||
|
|||||||
@@ -1,5 +1,6 @@
|
|||||||
module Dodge.Inventory.Path (getInventoryPath) where
|
module Dodge.Inventory.Path (getInventoryPath) where
|
||||||
|
|
||||||
|
import NewInt
|
||||||
import Dodge.Data.Creature
|
import Dodge.Data.Creature
|
||||||
import qualified Data.IntMap.Strict as IM
|
import qualified Data.IntMap.Strict as IM
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
@@ -9,10 +10,10 @@ getInventoryPath :: Int -> InventoryPathing -> Int -> Creature -> Maybe Int
|
|||||||
getInventoryPath x ip itid cr = case ip of
|
getInventoryPath x ip itid cr = case ip of
|
||||||
ABSOLUTE -> checkinvid x
|
ABSOLUTE -> checkinvid x
|
||||||
RELCURS -> do
|
RELCURS -> do
|
||||||
selid <- cr ^? crManipulation . manObject . imSelectedItem
|
selid <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
|
||||||
checkinvid (x + selid)
|
checkinvid (x + selid)
|
||||||
RELITEM -> checkinvid (itid + x)
|
RELITEM -> checkinvid (itid + x)
|
||||||
where
|
where
|
||||||
checkinvid y = do
|
checkinvid y = do
|
||||||
guard $ y `IM.member` (cr ^. crInv)
|
guard $ y `IM.member` (cr ^. crInv . unNIntMap)
|
||||||
return y
|
return y
|
||||||
|
|||||||
@@ -4,6 +4,7 @@ module Dodge.Inventory.RBList (
|
|||||||
eqSiteToPositions,
|
eqSiteToPositions,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import NewInt
|
||||||
import qualified Data.IntMap.Strict as IM
|
import qualified Data.IntMap.Strict as IM
|
||||||
import Dodge.Data.Equipment.Misc
|
import Dodge.Data.Equipment.Misc
|
||||||
import Dodge.Data.EquipType
|
import Dodge.Data.EquipType
|
||||||
@@ -46,7 +47,7 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
|
|||||||
where
|
where
|
||||||
hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep
|
hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep
|
||||||
|
|
||||||
getEquipmentAllocation :: Int -> World -> EquipmentAllocation
|
getEquipmentAllocation :: NewInt InvInt -> World -> EquipmentAllocation
|
||||||
getEquipmentAllocation invid w = fromMaybe DoNotMoveEquipment $ do
|
getEquipmentAllocation invid w = fromMaybe DoNotMoveEquipment $ do
|
||||||
esite <- you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType-- . itUse . uequipEffect . eeType
|
esite <- you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType-- . itUse . uequipEffect . eeType
|
||||||
i <-
|
i <-
|
||||||
|
|||||||
@@ -3,6 +3,7 @@ module Dodge.Inventory.Swap (
|
|||||||
swapAnyExtraSelection
|
swapAnyExtraSelection
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import NewInt
|
||||||
import Dodge.SoundLogic
|
import Dodge.SoundLogic
|
||||||
import Dodge.Item.Grammar
|
import Dodge.Item.Grammar
|
||||||
import Dodge.Base.You
|
import Dodge.Base.You
|
||||||
@@ -43,13 +44,13 @@ swapInvItems f i w = fromMaybe w $ do
|
|||||||
& checkConnection InventoryConnectSound connectItemS i k
|
& checkConnection InventoryConnectSound connectItemS i k
|
||||||
where
|
where
|
||||||
updatecreature k =
|
updatecreature k =
|
||||||
(crInv %~ IM.safeSwapKeys i k)
|
(crInv . unNIntMap %~ IM.safeSwapKeys i k)
|
||||||
. (crManipulation . manObject . imSelectedItem .~ k)
|
. (crManipulation . manObject . imSelectedItem .~ NInt k)
|
||||||
. swapSite i k
|
. swapSite i k
|
||||||
. swapSite k i
|
. swapSite k i
|
||||||
cr = you w
|
cr = you w
|
||||||
swapSite a b = case cr ^? crInv . ix a >>= \k -> w ^? cWorld . lWorld . items . ix k . itLocation . ilEquipSite . _Just of
|
swapSite a b = case cr ^? crInv . ix (NInt a) >>= \k -> w ^? cWorld . lWorld . items . ix k . itLocation . ilEquipSite . _Just of
|
||||||
Just epos -> crEquipment . ix epos .~ b
|
Just epos -> crEquipment . ix epos .~ NInt b
|
||||||
Nothing -> id
|
Nothing -> id
|
||||||
|
|
||||||
swapAnyExtraSelection :: Int -> Int -> World -> World
|
swapAnyExtraSelection :: Int -> Int -> World -> World
|
||||||
|
|||||||
+12
-11
@@ -9,6 +9,7 @@ module Dodge.Item.Grammar (
|
|||||||
invIndents,
|
invIndents,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import NewInt
|
||||||
import Dodge.Item.Orientation
|
import Dodge.Item.Orientation
|
||||||
import Dodge.ItemUseCondition
|
import Dodge.ItemUseCondition
|
||||||
import Dodge.Data.UseCondition
|
import Dodge.Data.UseCondition
|
||||||
@@ -212,22 +213,22 @@ joinItemsInList f = fst . h . ([],)
|
|||||||
Just w -> h ( zs,w : ys)
|
Just w -> h ( zs,w : ys)
|
||||||
|
|
||||||
-- this puts the first elements in the intmap at the end of the list
|
-- this puts the first elements in the intmap at the end of the list
|
||||||
invDT :: IM.IntMap Item -> [DTree CItem]
|
invDT :: NewIntMap InvInt Item -> [DTree CItem]
|
||||||
invDT =
|
invDT =
|
||||||
joinItemsInList tryAttachItems . IM.elems
|
joinItemsInList tryAttachItems . IM.elems . _unNIntMap
|
||||||
. fmap (singleDT . baseCI)
|
. fmap (singleDT . baseCI)
|
||||||
|
|
||||||
invDT' :: IM.IntMap Item -> [DTree OItem]
|
invDT' :: NewIntMap InvInt Item -> [DTree OItem]
|
||||||
invDT' = fmap propagateOrientation' . invDT
|
invDT' = fmap propagateOrientation' . invDT
|
||||||
|
|
||||||
-- this assumes the creature inventory is well formed, specifically the
|
-- this assumes the creature inventory is well formed, specifically the
|
||||||
-- location ids
|
-- location ids
|
||||||
-- consider explicitly reseting the inventory ids (but this probably really
|
-- consider explicitly reseting the inventory ids (but this probably really
|
||||||
-- should be done upstream anyway in the actually creature inventory)
|
-- should be done upstream anyway in the actually creature inventory)
|
||||||
invRootMap :: IM.IntMap Item -> IM.IntMap (Maybe Int, DTree Item)
|
invRootMap :: NewIntMap InvInt Item -> IM.IntMap (Maybe Int, DTree Item)
|
||||||
invRootMap =
|
invRootMap =
|
||||||
foldMap
|
foldMap
|
||||||
(dtToIntMapWithRoot (^?! itLocation . ilInvID) . fmap (^. _1) )
|
(dtToIntMapWithRoot (^?! itLocation . ilInvID . unNInt) . fmap (^. _1) )
|
||||||
. invDT
|
. invDT
|
||||||
|
|
||||||
-- this assumes the creature inventory is well formed, specifically the
|
-- this assumes the creature inventory is well formed, specifically the
|
||||||
@@ -235,24 +236,24 @@ invRootMap =
|
|||||||
-- consider explicitly reseting the inventory ids (but this probably really
|
-- consider explicitly reseting the inventory ids (but this probably really
|
||||||
-- should be done upstream anyway in the actually creature inventory)
|
-- should be done upstream anyway in the actually creature inventory)
|
||||||
-- The first Int in the maybe is the root, the second the parent
|
-- The first Int in the maybe is the root, the second the parent
|
||||||
invAdj :: IM.IntMap Item -> IM.IntMap (Maybe (Int, Int), [Int], [Int])
|
invAdj :: NewIntMap InvInt Item -> IM.IntMap (Maybe (Int, Int), [Int], [Int])
|
||||||
invAdj = IM.unions . map g . invDT
|
invAdj = IM.unions . map g . invDT
|
||||||
where
|
where
|
||||||
g = dtToLRAdj getid
|
g = dtToLRAdj getid
|
||||||
getid (itm, _) =
|
getid (itm, _) =
|
||||||
fromMaybe
|
fromMaybe
|
||||||
(error ("invAdj item " ++ show (_itID itm) ++ " location: " ++ show (itm ^? itLocation)))
|
(error ("invAdj item " ++ show (_itID itm) ++ " location: " ++ show (itm ^? itLocation)))
|
||||||
$ itm ^? itLocation . ilInvID
|
$ itm ^? itLocation . ilInvID . unNInt
|
||||||
|
|
||||||
---- returns an intmap with trees for (only!) root items, indexed by inventory position
|
---- returns an intmap with trees for (only!) root items, indexed by inventory position
|
||||||
invIMDT :: IM.IntMap Item -> IM.IntMap (DTree OItem)
|
invIMDT :: NewIntMap InvInt Item -> IM.IntMap (DTree OItem)
|
||||||
invIMDT = fmap propagateOrientation' . IM.fromDistinctAscList . reverse . map getid . invDT
|
invIMDT = fmap propagateOrientation' . IM.fromDistinctAscList . reverse . map getid . invDT
|
||||||
where
|
where
|
||||||
getid :: DTree CItem -> (Int, DTree CItem)
|
getid :: DTree CItem -> (Int, DTree CItem)
|
||||||
getid t = (t ^?! dtValue . _1 . itLocation . ilInvID, t)
|
getid t = (t ^?! dtValue . _1 . itLocation . ilInvID . unNInt, t)
|
||||||
|
|
||||||
---- returns an intmap with indents and locations for all items
|
---- returns an intmap with indents and locations for all items
|
||||||
invIndents :: IM.IntMap Item -> IM.IntMap (Int, LocationDT OItem)
|
invIndents :: NewIntMap InvInt Item -> IM.IntMap (Int, LocationDT OItem)
|
||||||
invIndents inv = foldMap (f . LocDT TopDT) (IM.elems (invIMDT inv)) mempty
|
invIndents inv = foldMap (f . LocDT TopDT) (IM.elems (invIMDT inv)) mempty
|
||||||
where
|
where
|
||||||
f t = cdtPropagateFold h h g 0 t id
|
f t = cdtPropagateFold h h g 0 t id
|
||||||
@@ -268,6 +269,6 @@ invIndents inv = foldMap (f . LocDT TopDT) (IM.elems (invIMDT inv)) mempty
|
|||||||
g x ldt =
|
g x ldt =
|
||||||
(.)
|
(.)
|
||||||
( IM.insert
|
( IM.insert
|
||||||
(ldt ^?! locDT . dtValue . _1 . itLocation . ilInvID)
|
(ldt ^?! locDT . dtValue . _1 . itLocation . ilInvID . unNInt)
|
||||||
(x, ldt)
|
(x, ldt)
|
||||||
)
|
)
|
||||||
|
|||||||
@@ -82,7 +82,7 @@ drawRootCursor w sss msel ldp cfig = fromMaybe mempty $ do
|
|||||||
guard $ i == 0
|
guard $ i == 0
|
||||||
inv' <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
|
inv' <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
|
||||||
let inv = fmap (\k -> w ^?! cWorld . lWorld . items . ix k) inv'
|
let inv = fmap (\k -> w ^?! cWorld . lWorld . items . ix k) inv'
|
||||||
(x, y) <- getRootItemBounds j inv
|
(x, y) <- getRootItemBounds j $ _unNIntMap inv
|
||||||
return $
|
return $
|
||||||
drawSSMultiCursor
|
drawSSMultiCursor
|
||||||
sss
|
sss
|
||||||
@@ -94,11 +94,11 @@ drawRootCursor w sss msel ldp cfig = fromMaybe mempty $ do
|
|||||||
|
|
||||||
getRootItemBounds :: Int -> IM.IntMap Item -> Maybe (Int, Int)
|
getRootItemBounds :: Int -> IM.IntMap Item -> Maybe (Int, Int)
|
||||||
getRootItemBounds i inv = do
|
getRootItemBounds i inv = do
|
||||||
let ia = invIndents inv -- why indents? why OItem?
|
let ia = invIndents $ NIntMap inv -- why indents? why OItem?
|
||||||
itm <- ia ^? ix i . _2
|
itm <- ia ^? ix i . _2
|
||||||
let root = locToTop itm
|
let root = locToTop itm
|
||||||
x <- locDTRightmost root ^? locDT . dtValue . _1 . itLocation . ilInvID
|
x <- locDTRightmost root ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
|
||||||
y <- locDTLeftmost root ^? locDT . dtValue . _1 . itLocation . ilInvID
|
y <- locDTLeftmost root ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
|
||||||
return (x, y)
|
return (x, y)
|
||||||
|
|
||||||
drawMouseOver :: Configuration -> World -> Picture
|
drawMouseOver :: Configuration -> World -> Picture
|
||||||
|
|||||||
@@ -33,7 +33,7 @@ import Data.Foldable
|
|||||||
testStringInit :: Universe -> [String]
|
testStringInit :: Universe -> [String]
|
||||||
testStringInit u = map f (IM.toList $ u ^. uvWorld . cWorld . lWorld . items)
|
testStringInit u = map f (IM.toList $ u ^. uvWorld . cWorld . lWorld . items)
|
||||||
<> ["---"]
|
<> ["---"]
|
||||||
<> map show (IM.toList . fold $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInv)
|
<> map show (IM.toList . fold $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInv . unNIntMap)
|
||||||
<> ["---"]
|
<> ["---"]
|
||||||
<> map show (IM.keys $ u ^. uvWorld . cWorld . lWorld . floorItems)
|
<> map show (IM.keys $ u ^. uvWorld . cWorld . lWorld . floorItems)
|
||||||
|
|
||||||
|
|||||||
@@ -237,7 +237,7 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
|
|||||||
OverCombFiltInv (0, j) -> fromMaybe w $ do
|
OverCombFiltInv (0, j) -> fromMaybe w $ do
|
||||||
str <-
|
str <-
|
||||||
fmap (take 5) $
|
fmap (take 5) $
|
||||||
w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix j
|
w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix (NInt j)
|
||||||
>>= \k -> w ^? cWorld . lWorld . items . ix k
|
>>= \k -> w ^? cWorld . lWorld . items . ix k
|
||||||
>>= (listToMaybe . basicItemDisplay)
|
>>= (listToMaybe . basicItemDisplay)
|
||||||
return . (worldEventFlags . at CombineInventoryChange ?~ ()) $
|
return . (worldEventFlags . at CombineInventoryChange ?~ ()) $
|
||||||
@@ -542,7 +542,7 @@ tryCombine (i, j) w = fromMaybe w $ do
|
|||||||
CombinableItem is it <- sss ^? ix i . ssItems . ix j . siPayload . _Just
|
CombinableItem is it <- sss ^? ix i . ssItems . ix j . siPayload . _Just
|
||||||
p <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
|
p <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
|
||||||
return $
|
return $
|
||||||
(createItemYou it (foldr (destroyInvItem 0) w (sort is)))
|
(createItemYou it (foldr (destroyInvItem 0 . NInt) w (sort is)))
|
||||||
& soundStart InventorySound p wrench1S Nothing
|
& soundStart InventorySound p wrench1S Nothing
|
||||||
& hud . hudElement . diSelection . _Just . _3 .~ mempty
|
& hud . hudElement . diSelection . _Just . _3 .~ mempty
|
||||||
|
|
||||||
|
|||||||
@@ -52,7 +52,7 @@ selectedItemScroll :: Int -> World -> Maybe World
|
|||||||
selectedItemScroll yi w = do
|
selectedItemScroll yi w = do
|
||||||
i <- you w ^? crManipulation . manObject . imSelectedItem
|
i <- you w ^? crManipulation . manObject . imSelectedItem
|
||||||
itm <- you w ^? crInv . ix i >>= \k -> w ^? cWorld . lWorld . items . ix k
|
itm <- you w ^? crInv . ix i >>= \k -> w ^? cWorld . lWorld . items . ix k
|
||||||
return $ itemScroll yi i itm w
|
return $ itemScroll yi (_unNInt i) itm w
|
||||||
|
|
||||||
itemScroll :: Int -> Int -> Item -> World -> World
|
itemScroll :: Int -> Int -> Item -> World -> World
|
||||||
itemScroll yi invid itm w
|
itemScroll yi invid itm w
|
||||||
@@ -84,7 +84,7 @@ updateScopeZoom i w
|
|||||||
w & wppointer %~ doScopeZoom (w ^. input . smoothScrollAmount) (w ^. input . mousePos)
|
w & wppointer %~ doScopeZoom (w ^. input . smoothScrollAmount) (w ^. input . mousePos)
|
||||||
| otherwise = w & wppointer %~ resetscope
|
| otherwise = w & wppointer %~ resetscope
|
||||||
where
|
where
|
||||||
itid = w ^?! cWorld . lWorld . creatures . ix 0 . crInv . ix i
|
itid = w ^?! cWorld . lWorld . creatures . ix 0 . crInv . ix (NInt i)
|
||||||
wppointer = cWorld . lWorld . items . ix itid . itUse . uScope
|
wppointer = cWorld . lWorld . items . ix itid . itUse . uScope
|
||||||
resetscope (OpticScope _ _ defz) = OpticScope (V2 0 0) defz defz
|
resetscope (OpticScope _ _ defz) = OpticScope (V2 0 0) defz defz
|
||||||
|
|
||||||
|
|||||||
@@ -6,6 +6,7 @@ module Dodge.WorldEffect (
|
|||||||
doTmWdWd,
|
doTmWdWd,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import NewInt
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
@@ -46,7 +47,7 @@ doWdWd we = case we of
|
|||||||
WdWdBurstFireRepetition cid invid -> \w -> fromMaybe w $ do
|
WdWdBurstFireRepetition cid invid -> \w -> fromMaybe w $ do
|
||||||
cr <- w ^? cWorld . lWorld . creatures . ix cid
|
cr <- w ^? cWorld . lWorld . creatures . ix cid
|
||||||
--itree <- allInvLocs (cr ^. crInv) ^? ix invid . _2 . locLDT
|
--itree <- allInvLocs (cr ^. crInv) ^? ix invid . _2 . locLDT
|
||||||
loc <- invIndents (fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $ cr ^. crInv) ^? ix invid . _2
|
loc <- invIndents (fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $ cr ^. crInv) ^? ix (_unNInt invid) . _2
|
||||||
return $ heldEffectMuzzles loc cr w
|
return $ heldEffectMuzzles loc cr w
|
||||||
|
|
||||||
accessTerminal :: Int -> World -> World
|
accessTerminal :: Int -> World -> World
|
||||||
|
|||||||
+5
-2
@@ -8,7 +8,7 @@
|
|||||||
--{-# LANGUAGE StandaloneDeriving #-}
|
--{-# LANGUAGE StandaloneDeriving #-}
|
||||||
module NewInt where
|
module NewInt where
|
||||||
|
|
||||||
--import qualified Data.IntSet as IS
|
import qualified Data.IntSet as IS
|
||||||
import qualified Data.IntMap.Strict as IM
|
import qualified Data.IntMap.Strict as IM
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
@@ -17,8 +17,11 @@ import Data.Aeson.TH
|
|||||||
newtype NewInt a = NInt { _unNInt :: Int}
|
newtype NewInt a = NInt { _unNInt :: Int}
|
||||||
deriving newtype (Eq,Ord,Show,Num,Read,Integral,Real,Enum)
|
deriving newtype (Eq,Ord,Show,Num,Read,Integral,Real,Enum)
|
||||||
|
|
||||||
|
newtype NewIntSet a = NIntSet { _unNIntSet :: IS.IntSet}
|
||||||
|
deriving newtype (Eq,Ord,Show,Read)
|
||||||
|
|
||||||
newtype NewIntMap a b = NIntMap { _unNIntMap :: IM.IntMap b}
|
newtype NewIntMap a b = NIntMap { _unNIntMap :: IM.IntMap b}
|
||||||
deriving newtype (Monoid,Semigroup)
|
deriving newtype (Foldable,Functor,Monoid,Semigroup)
|
||||||
deriving (Eq,Ord,Show,Read)
|
deriving (Eq,Ord,Show,Read)
|
||||||
|
|
||||||
type instance Index (NewIntMap a b) = NewInt a
|
type instance Index (NewIntMap a b) = NewInt a
|
||||||
|
|||||||
Reference in New Issue
Block a user