Major item refactor, still broken

This commit is contained in:
2025-08-24 19:34:09 +01:00
parent 22b4be440a
commit 94f6d5c630
62 changed files with 820 additions and 805 deletions
+5 -3
View File
@@ -15,13 +15,15 @@ you w = w ^?! cWorld . lWorld . creatures . ix 0
yourSelectedItem :: World -> Maybe Item
yourSelectedItem w = do
i <- you w ^? crManipulation . manObject . imSelectedItem
_crInv (you w) IM.!? i
j <- _crInv (you w) IM.!? i
w ^? cWorld . lWorld . items . ix j
yourRootItem :: World -> Maybe Item
yourRootItem w = do
i <- you w ^? crManipulation . manObject . imRootSelectedItem
_crInv (you w) IM.!? i
j <- _crInv (you w) IM.!? i
w ^? cWorld . lWorld . items . ix j
yourInv :: World -> IM.IntMap Item
yourInv = _crInv . you
yourInv w = fmap (\i -> w ^?! cWorld . lWorld . items . ix i) . _crInv . you $ w
+6 -5
View File
@@ -1,5 +1,6 @@
module Dodge.Bullet (updateBullet) where
import qualified Data.IntMap.Strict as IM
import Dodge.Damage
import Data.Bifunctor
import Data.Foldable
@@ -105,10 +106,10 @@ updateBulVel bt = bt & buVel .*.*~ _buDrag bt
-- tpos <- cr ^? crTargeting . ctPos . _Just
-- return $ BezierTrajectory sp tpos (mouseWorldPos (w ^. input) (w ^. wCam))
bounceDir :: (Point2, Either Creature Wall) -> Maybe Point2
bounceDir (_, Right wl) | _wlBouncy wl = Just $ uncurry (-) (_wlLine wl)
bounceDir (p, Left cr) | crIsArmouredFrom p cr = Just $ vNormal $ p - _crPos cr
bounceDir _ = Nothing
bounceDir :: IM.IntMap Item -> (Point2, Either Creature Wall) -> Maybe Point2
bounceDir _ (_, Right wl) | _wlBouncy wl = Just $ uncurry (-) (_wlLine wl)
bounceDir m (p, Left cr) | crIsArmouredFrom m p cr = Just $ vNormal $ p - _crPos cr
bounceDir _ _ = Nothing
useBulletPayload :: Bullet -> Point2 -> World -> World
useBulletPayload bu = case _buPayload bu of
@@ -154,7 +155,7 @@ hitEffFromBul w bu = case _buEffect bu of
PenetrateBullet -> movePenBullet bu hitstream w
BounceBullet -> fromMaybe (expireAndDamage bu hitstream w) $ do
(hp, crwl) <- hitstream ^? _head
dir <- bounceDir (hp, crwl)
dir <- bounceDir (w ^. cWorld . lWorld . items) (hp, crwl)
return
( w
, bu
+5 -7
View File
@@ -9,12 +9,10 @@ import Dodge.Data.Creature
import Geometry
import Shape
import ShapePicture
import qualified Data.IntMap.Strict as IM
makeCorpse :: Creature -> Corpse
makeCorpse = makeDefaultCorpse
makeDefaultCorpse :: Creature -> Corpse
makeDefaultCorpse cr =
makeCorpse :: IM.IntMap Item -> Creature -> Corpse
makeCorpse m cr =
defaultCorpse
& cpPos .~ _crPos cr
& cpDir .~ _crDir cr
@@ -22,8 +20,8 @@ makeDefaultCorpse cr =
.~ noPic
( scaleSH (V3 crsize crsize crsize) $
mconcat
[ colorSH (_skinHead cskin) $ deadScalp cr
, colorSH (_skinUpper cskin) $ deadUpperBody cr
[ colorSH (_skinHead cskin) $ deadScalp m cr
, colorSH (_skinUpper cskin) $ deadUpperBody m cr
, rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
]
)
+6 -7
View File
@@ -3,7 +3,7 @@ module Dodge.Creature (
module Dodge.Creature.ChaseCrit,
module Dodge.Creature.Inanimate,
launcherCrit,
pistolCrit,
-- pistolCrit,
ltAutoCrit,
spreadGunCrit,
autoCrit,
@@ -38,7 +38,6 @@ import Dodge.Creature.Inanimate
import Dodge.Creature.LauncherCrit
import Dodge.Creature.LtAutoCrit
import Dodge.Creature.Perception
import Dodge.Creature.PistolCrit
import Dodge.Creature.ReaderUpdate
import Dodge.Creature.SentinelAI
import Dodge.Creature.SpreadGunCrit
@@ -64,28 +63,28 @@ spawnerCrit =
miniGunCrit :: Creature
miniGunCrit =
defaultCreature
& crInv .~ IM.fromList [(0, miniGunX 3)]
-- & crInv .~ IM.fromList [(0, miniGunX 3)]
-- & crType . skinUpper .~ lightx4 red
-- & crType . humanoidAI .~ MiniGunAI
longCrit :: Creature
longCrit =
defaultCreature
& crInv .~ IM.fromList [(0, sniperRifle)]
-- & crInv .~ IM.fromList [(0, sniperRifle)]
-- & crType . humanoidAI .~ LongAI
-- & crType . skinUpper .~ lightx4 red
multGunCrit :: Creature
multGunCrit =
defaultCreature
& crInv .~ IM.fromList [(0, volleyGun 4)]
-- & crInv .~ IM.fromList [(0, volleyGun 4)]
-- & crType . skinUpper .~ lightx4 red
-- & crType . humanoidAI .~ MultGunAI
addArmour :: Creature -> Creature
addArmour = over crInv insarmour
where
insarmour xs = IM.insert (IM.newKey xs) frontArmour xs
insarmour xs = xs -- IM.insert (IM.newKey xs) frontArmour xs
{- | The creature you control.
ID 0.
@@ -99,7 +98,7 @@ startCr =
& crMvDir .~ pi / 2
& crID .~ 0
& crHP .~ 10000
& crInv .~ startInventory
& crInv .~ mempty
& crFaction .~ PlayerFaction
-- & crMvType .~ MvWalking yourDefaultSpeed
& crType .~ Avatar (PulseStatus 55 0) Flesh 50 50 50 3
+5 -2
View File
@@ -170,18 +170,21 @@ dropExcept cr invid w =
-- why not a cid (Int)?
dropItem :: Creature -> Int -> World -> World
dropItem cr invid =
dropItem cr invid w' =
doanyitemdropeffect
. maybeshiftseldown
. rmInvItem (_crID cr) invid
. copyItemToFloor (_crPos cr) itm -- . mayberemoveequip
. soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
$ w'
where
--doanyitemdropeffect = fromMaybe id $ do
-- rmf <- itm ^? itEffect . ieOnDrop
-- return $ doInvEffect rmf itm cr
doanyitemdropeffect = itEffectOnDrop itm cr
itm = fromMaybe (error "dropItem cannot find item") $ cr ^? crInv . ix invid
itm = fromMaybe (error "dropItem cannot find item") $ do
itid <- cr ^? crInv . ix invid
w' ^? cWorld . lWorld . items . ix itid
maybeshiftseldown w = fromMaybe w $ do
3 <- w ^? hud . hudElement . diSelection . _Just . _1
return $ w & hud . hudElement . diSelection . _Just . _2 +~ 1
+2 -2
View File
@@ -18,7 +18,7 @@ flockArmourChaseCrit =
, _crHP = 300
, _crInv =
IM.fromList
[ (0, frontArmour)
[ --(0, frontArmour)
]
, _crActionPlan =
ActionPlan
@@ -39,7 +39,7 @@ armourChaseCrit =
, --, _crUpdate = defaultImpulsive []
_crInv =
IM.fromList
[ (0, frontArmour)
[ --(0, frontArmour)
]
-- , _crMvType = defaultChaseMvType{_mvTurnRad = FloatConst 0.05}
}
+2 -2
View File
@@ -12,8 +12,8 @@ import qualified IntMapHelp as IM
autoCrit :: Creature
autoCrit =
defaultCreature
{ _crInv = IM.fromList [(0, autoRifle)]
, _crHP = 300
{ --_crInv = IM.fromList [(0, autoRifle)]
_crHP = 300
-- , _crMvType = defaultAimMvType
}
-- & crType . skinUpper .~ lightx4 red
+2 -2
View File
@@ -21,8 +21,8 @@ smallChaseCrit =
invisibleChaseCrit :: Creature
invisibleChaseCrit =
chaseCrit
& crInv . at 0 ?~ wristInvisibility
& crEquipment . at OnLeftWrist ?~ 0
-- & crInv . at 0 ?~ wristInvisibility
-- & crEquipment . at OnLeftWrist ?~ 0
chaseCrit :: Creature
chaseCrit =
+4 -3
View File
@@ -20,9 +20,10 @@ applyIndividualDamage cr w dm = damMatSideEffect dm (crMaterial (_crType cr)) (L
_ -> w & damageHP cr (_dmAmount dm)
applyPiercingDamage :: Creature -> Damage -> World -> World
applyPiercingDamage cr dm
| crIsArmouredFrom p cr = f . makeSpark NormalSpark p1 (argV (p1 - p))
| otherwise = f . damageHP cr (_dmAmount dm)
applyPiercingDamage cr dm w
| crIsArmouredFrom (w ^. cWorld . lWorld . items) p cr
= f . makeSpark NormalSpark p1 (argV (p1 - p)) $ w
| otherwise = f . damageHP cr (_dmAmount dm) $ w
where
f = cWorld . lWorld . creatures . ix (_crID cr) . crPos +~ _dmVector dm
/ V2 x x
+51 -40
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Creature.HandPos (
translatePointToLeftHand,
translatePointToRightHand,
@@ -14,6 +15,8 @@ module Dodge.Creature.HandPos (
headPQ,
) where
import Dodge.Data.Equipment.Misc
import qualified Data.IntMap.Strict as IM
import qualified Quaternion as Q
import Control.Lens
import Dodge.Creature.Test
@@ -21,14 +24,22 @@ import Dodge.Data.Creature
import Geometry
import ShapePicture
translatePointToRightHand :: Creature -> Point3 -> Point3
translatePointToRightHand cr p = fst (rightHandPQ cr `Q.comp` (p,Q.qID))
translatePointToRightHand :: IM.IntMap Item -> Creature -> Point3 -> Point3
translatePointToRightHand m cr p = fst (rightHandPQ m cr `Q.comp` (p,Q.qID))
rightHandPQ :: Creature -> Point3Q
rightHandPQ cr
| oneH cr = (V3 11 (-3) 20, Q.qID)
| twists cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 4 (-10) 0,Q.qID)
| twoFlat cr = (V3 4 (-8) 10, Q.qID)
equipSitePQ :: EquipSite -> IM.IntMap Item -> Creature -> Point3Q
equipSitePQ = \case
OnRightWrist -> rightHandPQ
OnLeftWrist -> leftHandPQ
OnBack -> backPQ
OnChest -> chestPQ
_ -> undefined
rightHandPQ :: IM.IntMap Item -> Creature -> Point3Q
rightHandPQ m cr
| oneH m cr = (V3 11 (-3) 20, Q.qID)
| twists m cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 4 (-10) 0,Q.qID)
| twoFlat m cr = (V3 4 (-8) 10, Q.qID)
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> (V3 (- f sa) (- off) 10, Q.qID)
Just (Walking sa RightForward) -> (V3 (- g sa) (- off) 10, Q.qID)
@@ -39,18 +50,18 @@ rightHandPQ cr
f i = negate 2 + negate 6 * (sLen - i) / sLen
g i = negate 2 + negate 6 * i / sLen
translateToRightHand :: Creature -> SPic -> SPic
translateToRightHand = overPosSP . translatePointToRightHand
translateToRightHand :: IM.IntMap Item -> Creature -> SPic -> SPic
translateToRightHand m = overPosSP . translatePointToRightHand m
translateToRightWrist :: Creature -> SPic -> SPic
translateToRightWrist cr = overPosSP
(\p -> fst $ rightHandPQ cr `Q.comp` (V3 0 (-4) (-4)+p, Q.qID))
translateToRightWrist :: IM.IntMap Item -> Creature -> SPic -> SPic
translateToRightWrist m cr = overPosSP
(\p -> fst $ rightHandPQ m cr `Q.comp` (V3 0 (-4) (-4)+p, Q.qID))
leftHandPQ :: Creature -> Point3Q
leftHandPQ cr
| oneH cr = (V3 0 off 10, Q.qz 0.4)
| twists cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 12 4 0, Q.qz 0.4)
| twoFlat cr = (V3 4 8 10, Q.qID)
leftHandPQ :: IM.IntMap Item -> Creature -> Point3Q
leftHandPQ m cr
| oneH m cr = (V3 0 off 10, Q.qz 0.4)
| twists m cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 12 4 0, Q.qz 0.4)
| twoFlat m cr = (V3 4 8 10, Q.qID)
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa RightForward) -> (V3 (- f sa) off 10 , Q.qID)
Just (Walking sa LeftForward) -> (V3 (- g sa) off 10 , Q.qID)
@@ -61,15 +72,15 @@ leftHandPQ cr
f i = negate 2 + negate 6 * (sLen - i) / sLen
g i = negate 2 + negate 6 * i / sLen
translatePointToLeftHand :: Creature -> Point3 -> Point3
translatePointToLeftHand cr p = fst (leftHandPQ cr `Q.comp` (p,Q.qID))
translatePointToLeftHand :: IM.IntMap Item -> Creature -> Point3 -> Point3
translatePointToLeftHand m cr p = fst (leftHandPQ m cr `Q.comp` (p,Q.qID))
translateToLeftHand :: Creature -> SPic -> SPic
translateToLeftHand = overPosSP . translatePointToLeftHand
translateToLeftHand :: IM.IntMap Item -> Creature -> SPic -> SPic
translateToLeftHand m = overPosSP . translatePointToLeftHand m
translateToLeftWrist :: Creature -> SPic -> SPic
translateToLeftWrist cr = overPosSP
(\p -> fst $ leftHandPQ cr `Q.comp` (V3 0 4 (-4)+p, Q.qID))
translateToLeftWrist :: IM.IntMap Item -> Creature -> SPic -> SPic
translateToLeftWrist m cr = overPosSP
(\p -> fst $ leftHandPQ m cr `Q.comp` (V3 0 4 (-4)+p, Q.qID))
leftLegPQ :: Creature -> Point3Q
leftLegPQ cr = Q.comp (0,Q.qz (_crMvDir cr - _crDir cr))
@@ -102,26 +113,26 @@ rightLegPQ cr = Q.comp (0,Q.qz (_crMvDir cr - _crDir cr))
translateToRightLeg :: Creature -> SPic -> SPic
translateToRightLeg cr = overPosSP (\p -> fst (rightLegPQ cr `Q.comp` (p,Q.qID)))
translateToHead :: Creature -> SPic -> SPic
translateToHead cr = overPosSP (\p -> fst (headPQ cr `Q.comp` (p,Q.qID)))
translateToHead :: IM.IntMap Item -> Creature -> SPic -> SPic
translateToHead m cr = overPosSP (\p -> fst (headPQ m cr `Q.comp` (p,Q.qID)))
headPQ :: Creature -> Point3Q
headPQ cr
| twists cr = (V3 0 2 20, Q.qz (-1)) `Q.comp` (V3 (negate 2.5) 0.25 0, Q.qz 1)
| oneH cr = (V3 0 0 20, Q.qz 0.5) `Q.comp` (V3 2.5 0 0, Q.qz (-0.5))
headPQ :: IM.IntMap Item -> Creature -> Point3Q
headPQ m cr
| twists m cr = (V3 0 2 20, Q.qz (-1)) `Q.comp` (V3 (negate 2.5) 0.25 0, Q.qz 1)
| oneH m cr = (V3 0 0 20, Q.qz 0.5) `Q.comp` (V3 2.5 0 0, Q.qz (-0.5))
| otherwise = (V3 2.5 0 20, Q.qID)
translatePointToHead :: Creature -> Point3 -> Point3
translatePointToHead cr p = fst (headPQ cr `Q.comp` (p,Q.qID))
translatePointToHead :: IM.IntMap Item -> Creature -> Point3 -> Point3
translatePointToHead m cr p = fst (headPQ m cr `Q.comp` (p,Q.qID))
chestPQ :: Creature -> Point3Q
chestPQ cr = backPQ cr `Q.comp` (0,Q.qz pi)
chestPQ :: IM.IntMap Item -> Creature -> Point3Q
chestPQ m cr = backPQ m cr `Q.comp` (0,Q.qz pi)
translateToChest :: Creature -> SPic -> SPic
translateToChest cr = overPosSP (\p -> fst $ chestPQ cr `Q.comp` (p,Q.qID))
translateToChest :: IM.IntMap Item -> Creature -> SPic -> SPic
translateToChest m cr = overPosSP (\p -> fst $ chestPQ m cr `Q.comp` (p,Q.qID))
backPQ :: Creature -> Point3Q
backPQ cr
| oneH cr = (V3 0 0 10, Q.qz 0.5)
| twists cr = (V3 0 3 10, Q.qz (-1.5))
backPQ :: IM.IntMap Item -> Creature -> Point3Q
backPQ m cr
| oneH m cr = (V3 0 0 10, Q.qz 0.5)
| twists m cr = (V3 0 3 10, Q.qz (-1.5))
| otherwise = (V3 0 0 10, Q.qz 0)
+4 -4
View File
@@ -42,8 +42,8 @@ followImpulse cr w imp = case imp of
let (newimp, newgen) = runState (doRandImpulse rimp) (_randGen w)
in first ((randGen .~ newgen) .) $ followImpulse cr w newimp
Bark sid -> (soundStart (CrMouth cid) cpos sid Nothing, resetCrVocCoolDown w cr)
Move p -> crup $ crMvBy p cr
MoveForward x -> crup $ crMvForward x cr
Move p -> crup $ crMvBy p (w ^. cWorld . lWorld) cr
MoveForward x -> crup $ crMvForward x (w ^. cWorld . lWorld) cr
Turn a -> crup $ cr & crDir +~ a
TurnToward p a -> crup $ creatureTurnToward p a cr
TurnTo p -> crup $ creatureTurnTo p cr
@@ -54,7 +54,7 @@ followImpulse cr w imp = case imp of
SwitchToItem i -> crup $ cr & crManipulation . manObject .~ SelectedItem i i mempty
Melee cid' ->
( hitCr cid'
, crMvAbsolute (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crType . meleeCooldown .~ 20
, crMvAbsolute (w ^. cWorld . lWorld) (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crType . meleeCooldown .~ 20
)
RandomTurn a -> (randGen .~ snd (rr a), cr & crDir +~ fst (rr a))
MakeSound sid -> (soundStart (CrSound (_crID cr)) (_crPos cr) sid Nothing, cr)
@@ -71,7 +71,7 @@ followImpulse cr w imp = case imp of
Just tcr -> followImpulse cr w (doCrImp f tcr)
_ -> crup cr
ImpulseUseAheadPos f -> followImpulse cr w (doP2Imp f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
MvForward -> crup $ crMvForward speed cr
MvForward -> crup $ crMvForward speed (w ^. cWorld . lWorld) cr
MvTurnToward p ->
crup $
creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr
+6 -5
View File
@@ -20,17 +20,18 @@ For now, though, this cannot fail.
crMvBy ::
-- | Movement translation vector, will be made relative to creature direction
Point2 ->
LWorld ->
Creature ->
Creature
crMvBy p cr = crMvAbsolute (rotateV (_crDir cr) p) cr
crMvBy p lw cr = crMvAbsolute lw (rotateV (_crDir cr) p) cr
crMvAbsolute :: Point2 -> Creature -> Creature
crMvAbsolute p' cr =
crMvAbsolute :: LWorld -> Point2 -> Creature -> Creature
crMvAbsolute lw p' cr =
advanceStepCounter (magV p) cr
& crPos +~ p
& crMvDir .~ argV p
where
p = strengthFactor (getCrMoveSpeed cr) *.* p'
p = strengthFactor (getCrMoveSpeed lw cr) *.* p'
strengthFactor :: Int -> Float
strengthFactor i
@@ -38,7 +39,7 @@ strengthFactor i
| i < 1 = 0
| otherwise = 0.02 * fromIntegral i
crMvForward :: Float -> Creature -> Creature
crMvForward :: Float -> LWorld -> Creature -> Creature
crMvForward speed = crMvBy (V2 speed 0)
advanceStepCounter :: Float -> Creature -> Creature
+12 -9
View File
@@ -18,7 +18,7 @@ import qualified IntMapHelp as IM
useItem :: Int -> Int -> World -> Maybe World
useItem invid pt w = fmap (worldEventFlags . at InventoryChange ?~ ()) $ do
cr <- w ^? cWorld . lWorld . creatures . ix 0
itmloc <- invIndents (_crInv cr) ^? ix invid . _2
itmloc <- invIndents (fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $ _crInv cr) ^? ix invid . _2
useItemLoc cr itmloc pt w
useItemLoc :: Creature -> LocationDT OItem -> Int -> World -> Maybe World
@@ -68,34 +68,37 @@ toggleEquipmentAt invid cr w = case getEquipmentAllocation invid w of
PutOnEquipment{_allocNewPos = newp} ->
w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
& toitems . ix itid . itLocation . ilEquipSite ?~ newp
& onequip itm cr
MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crEquipment . at oldp .~ Nothing
& crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
& toitems . ix itid . itLocation . ilEquipSite ?~ newp
SwapEquipment{_allocNewPos = newp, _allocOldPos = oldp, _allocSwapID = sid} ->
w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crEquipment . at oldp ?~ sid
& crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
& crpoint . crInv . ix sid . itLocation . ilEquipSite ?~ oldp
& toitems . ix itid . itLocation . ilEquipSite ?~ newp
& toitems . ix (invidtoitid sid) . itLocation . ilEquipSite ?~ oldp
ReplaceEquipment{_allocNewPos = newp, _allocRemoveID = rid} ->
w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
& crpoint . crInv . ix rid . itLocation . ilEquipSite .~ Nothing
& toitems . ix itid . itLocation . ilEquipSite ?~ newp
& toitems . ix (invidtoitid rid) . itLocation . ilEquipSite .~ Nothing
& onremove (itmat rid) cr
& onequip itm cr
RemoveEquipment{_allocOldPos = oldp} ->
w
& crpoint . crEquipment . at oldp .~ Nothing
& crpoint . crInv . ix invid . itLocation . ilEquipSite .~ Nothing
& toitems . ix itid . itLocation . ilEquipSite .~ Nothing
& onremove itm cr
where
invidtoitid i = _crInv cr IM.! i
toitems = cWorld . lWorld . items
itid = _crInv cr IM.! invid
crpoint = cWorld . lWorld . creatures . ix (_crID cr)
itmat i = _crInv cr IM.! i
itmat i = w ^?! cWorld . lWorld . items . ix (_crInv cr IM.! i)
itm = itmat invid
onequip itm' = effectOnEquip itm'
onremove itm' = effectOnRemove itm'
+2 -2
View File
@@ -12,8 +12,8 @@ import qualified IntMapHelp as IM
launcherCrit :: Creature
launcherCrit =
defaultCreature
{ _crInv = IM.fromList [(0, rLauncher)]
, _crHP = 300
{ -- _crInv = IM.fromList [(0, rLauncher)]
_crHP = 300
}
-- & crType . skinUpper .~ lightx4 red
-- & crType . humanoidAI .~ LauncherAI
+4 -4
View File
@@ -5,15 +5,15 @@ module Dodge.Creature.LtAutoCrit (
--import Control.Lens
import Dodge.Data.Creature
import Dodge.Default
import Dodge.Item.Held.Stick
import qualified IntMapHelp as IM
--import Dodge.Item.Held.Stick
--import qualified IntMapHelp as IM
--import Picture
ltAutoCrit :: Creature
ltAutoCrit =
defaultCreature
{ _crInv = IM.fromList [(0, autoPistol)]
, _crHP = 500
{ --_crInv = IM.fromList [(0, autoPistol)]
_crHP = 500
}
-- & crType .~ LtAutoCrit
-- & crType . humanoidAI .~ LtAutoAI
+23 -22
View File
@@ -10,6 +10,7 @@ module Dodge.Creature.Picture (
) where
import Dodge.Creature.HandPos
import qualified Data.IntMap.Strict as IM
import Control.Lens
import Dodge.Creature.Radius
import Dodge.Creature.Shape
@@ -25,20 +26,20 @@ import Shape
--import Shape
import ShapePicture
basicCrPict :: Creature -> SPic
basicCrPict cr = drawEquipment cr <> noPic (basicCrShape cr)
basicCrPict :: IM.IntMap Item -> Creature -> SPic
basicCrPict m cr = drawEquipment m cr <> noPic (basicCrShape m cr)
crCamouflage :: Creature -> CamouflageStatus
crCamouflage _ = FullyVisible
basicCrShape :: Creature -> Shape
basicCrShape cr
basicCrShape :: IM.IntMap Item -> Creature -> Shape
basicCrShape m cr
| crCamouflage cr == Invisible = mempty
| otherwise =
scaleSH (V3 crsize crsize crsize) $
mconcat
[ colorSH (_skinHead cskin) $ scalp cr
, colorSH (_skinUpper cskin) $ upperBody cr
[ colorSH (_skinHead cskin) $ scalp m cr
, colorSH (_skinUpper cskin) $ upperBody m cr
, rotmdir $ colorSH (_skinLower cskin) $ feet cr
]
where
@@ -67,17 +68,17 @@ deadFeet :: Creature -> Shape
{-# INLINE deadFeet #-}
deadFeet = feet
arms :: Creature -> Shape
arms :: IM.IntMap Item -> Creature -> Shape
{-# INLINE arms #-}
arms cr =
arms m cr =
(^. _1) $
translateToRightHand cr aHand
<> translateToLeftHand cr aHand
translateToRightHand m cr aHand
<> translateToLeftHand m cr aHand
where
aHand = noPic $ translateSHz (-4) . upperPrismPolyHalfST 4 $ polyCirc 3 4
deadScalp :: Creature -> Shape
deadScalp cr = deadRot cr . translateSHz 10 . scalp $ cr
deadScalp :: IM.IntMap Item -> Creature -> Shape
deadScalp m cr = deadRot cr . translateSHz 10 . scalp m $ cr
deadRot :: Creature -> Shape -> Shape
deadRot cr = overPosSH (Q.rotateToZ d)
@@ -88,18 +89,18 @@ deadRot cr = overPosSH (Q.rotateToZ d)
(addZ 0 . unitVectorAtAngle . subtract (_crDir cr + pi))
(damageDirection $ _crDamage cr)
scalp :: Creature -> Shape
scalp :: IM.IntMap Item -> Creature -> Shape
{-# INLINE scalp #-}
scalp cr = overPosSH (\p -> fst (headPQ cr `Q.comp` (p,Q.qID))) fhead
scalp m cr = overPosSH (\p -> fst (headPQ m cr `Q.comp` (p,Q.qID))) fhead
-- | twists cr = translateSHxy 0 5 . rotateSH (-1) $ translateSHxy (negate 2.5) 0.25 fhead
-- | oneH cr = rotateSH 0.5 $ translateSHxy 2.5 0 fhead
-- | otherwise = translateSHxy 2.5 0 fhead
where
fhead = colorSH (greyN 0.9) . upperPrismPolyHalfST 5 $ polyCirc 3 5
torso :: Creature -> Shape
torso :: IM.IntMap Item -> Creature -> Shape
{-# INLINE torso #-}
torso cr = overPosSH (\p -> fst (backPQ cr `Q.comp` (p,Q.qID))) tsh
torso m cr = overPosSH (\p -> fst (backPQ m cr `Q.comp` (p,Q.qID))) tsh
-- | oneH cr = rotateSH 0.5 tsh
-- | twists cr =
-- translateSHxy 0 3 . rotateSH (-1.3) $ tsh
@@ -116,20 +117,20 @@ torso cr = overPosSH (\p -> fst (backPQ cr `Q.comp` (p,Q.qID))) tsh
]
aShoulder = scaleSH (V3 10 10 1) baseShoulder
deadUpperBody :: Creature -> Shape
deadUpperBody cr = deadRot cr . translateSHz (negate 10) . upperBody $ cr
deadUpperBody :: IM.IntMap Item -> Creature -> Shape
deadUpperBody m cr = deadRot cr . translateSHz (negate 10) . upperBody m $ cr
baseShoulder :: Shape
{-# INLINE baseShoulder #-}
baseShoulder = translateSHz (-20) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1
upperBody :: Creature -> Shape
upperBody :: IM.IntMap Item -> Creature -> Shape
{-# INLINE upperBody #-}
upperBody cr = arms cr <> shoulderSH (torso cr)
upperBody m cr = arms m cr <> shoulderSH (torso m cr)
shoulderSH :: Shape -> Shape
shoulderSH = translateSHz 20
drawEquipment :: Creature -> SPic
drawEquipment :: IM.IntMap Item -> Creature -> SPic
{-# INLINE drawEquipment #-}
drawEquipment cr = foldMap (itemEquipPict cr) (invDT $ _crInv cr)
drawEquipment m cr = foldMap (itemEquipPict m cr) (invDT . fmap (\i -> m ^?! ix i) $ _crInv cr)
-19
View File
@@ -1,19 +0,0 @@
module Dodge.Creature.PistolCrit (
pistolCrit,
) where
--import Control.Lens
import Dodge.Data.Creature
import Dodge.Default
import Dodge.Item.Held.Stick
import qualified IntMapHelp as IM
--import Picture
pistolCrit :: Creature
pistolCrit =
defaultCreature
{ _crInv = IM.fromList [(0, pistol)]
, _crHP = 500
}
-- & crType . humanoidAI .~ PistolAI
-- & crType . skinUpper .~ lightx4 red
+2 -2
View File
@@ -12,8 +12,8 @@ import qualified IntMapHelp as IM
spreadGunCrit :: Creature
spreadGunCrit =
defaultCreature
{ _crInv = IM.fromList [(0, bangStick 6)]
, _crHP = 500
{ --_crInv = IM.fromList [(0, bangStick 6)]
_crHP = 500
}
-- & crType . humanoidAI .~ SpreadGunAI
-- & crType . skinUpper .~ lightx4 red
+19 -21
View File
@@ -4,6 +4,7 @@ module Dodge.Creature.State (
invItemEffs,
) where
import NewInt
import Control.Applicative
import Control.Monad
import qualified Data.Map.Strict as M
@@ -53,7 +54,7 @@ applyPastDamages cr w
where
dojitter x y =
let (p, g) = runState (randInCirc x) (_randGen w)
in w & cWorld . lWorld . creatures . ix (_crID cr) %~ crMvBy p
in w & cWorld . lWorld . creatures . ix (_crID cr) %~ crMvBy p (w ^. cWorld . lWorld)
& cWorld . lWorld . creatures . ix (_crID cr) . crPain -~ y
& randGen .~ g
@@ -64,7 +65,7 @@ invItemEffs cid w = fromMaybe w $ do
return . appEndo (
foldMap
(reduceLocDT (Endo . invItemLocUpdate cr) . LocDT TopDT)
(invDT' (_crInv cr))) $ w
(invDT' $ fmap (\k -> w ^?! cWorld . lWorld . items . ix k) (_crInv cr))) $ w
invItemLocUpdate :: Creature -> LocationDT OItem -> World -> World
invItemLocUpdate cr loc w = doAnyEquipmentEffect loc cr $ case itm ^. itType of
@@ -132,7 +133,7 @@ copierItemUpdate itm cr w = fromMaybe w $ do
invid <- itm ^? itLocation . ilInvID
ip <- itm ^? itType . ibtPathing
i <- getInventoryPath x ip invid cr
itm' <- cr ^? crInv . ix i
itm' <- cr ^? crInv . ix i >>= \k -> w ^? cWorld . lWorld . items . ix k
v <- getItemValue itm' w cr
return $ w & pointerToItem itm . itUse . uValue .~ v
@@ -149,22 +150,22 @@ tryUseParent loc w = fromMaybe w $ do
tryDrawToCapacitor :: LocationDT OItem -> World -> World
tryDrawToCapacitor loc w = fromMaybe w $ do
itm <- loc ^? locDT . dtValue . _1
i <- itm ^? itLocation . ilInvID
i <- itm ^? itID . unNInt
x <- loc ^? locDT . dtValue . _1 . itConsumables . _Just
guard $ x < 200
bat <- loc ^? locDT . dtLeft . ix 0 . dtValue . _1
j <- bat ^? itLocation . ilInvID
j <- bat ^? itID . unNInt
y <- bat ^? itConsumables . _Just
let z = min y 10
return $ w
& invpoint . ix i . itConsumables . _Just +~ z
& invpoint . ix j . itConsumables . _Just -~ z
where
invpoint = cWorld . lWorld . creatures . ix 0 . crInv
invpoint = cWorld . lWorld . items
trySynthBullet :: LocationDT OItem -> World -> World
trySynthBullet loc w = fromMaybe w $ do
i <- itm ^? itLocation . ilInvID
i <- itm ^? itID . unNInt
x <- itm ^? itUse . uaParams . apInt
if x < 100
then do
@@ -177,7 +178,7 @@ trySynthBullet loc w = fromMaybe w $ do
& invpoint . ix j . itConsumables . _Just -~ 1
else do
mag <- loc ^? locDtContext . cdtParent . _1
j <- mag ^? itLocation . ilInvID
j <- mag ^? itID . unNInt
y <- mag ^. itConsumables
ymax <- maxAmmo mag
guard $ y < ymax
@@ -186,7 +187,7 @@ trySynthBullet loc w = fromMaybe w $ do
& invpoint . ix j . itConsumables . _Just +~ 1
where
itm = loc ^. locDT . dtValue . _1
invpoint = cWorld . lWorld . creatures . ix 0 . crInv
invpoint = cWorld . lWorld . items
drawARHUD :: LocationDT OItem -> World -> World
drawARHUD (LocDT con _) w = fromMaybe w $ do
@@ -202,13 +203,12 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d
mag <- find (isammolink . (^. dtValue . _2)) (itmtree ^. dtLeft)
i <- mag ^. dtValue . _1 . itConsumables
guard $ i >= x
maginvid <- mag ^? dtValue . _1 . itLocation . ilInvID
magitid <- mag ^? dtValue . _1 . itID . unNInt
return $
w
& worldEventFlags . at InventoryChange ?~ ()
& cWorld . lWorld . creatures . ix (_crID cr)
. crInv
. ix maginvid
& cWorld . lWorld . items
. ix magitid
. itConsumables
. _Just
-~ x
@@ -230,9 +230,8 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d
pos = _crPos cr + xyV3 (rotate3 cdir p)
cdir = _crDir cr
itm = itmtree ^. dtValue . _1
pointittarg = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itTargeting
cid = _crID cr
invid = _ilInvID $ _itLocation itm
pointittarg = cWorld . lWorld . items . ix itid . itTargeting
itid = itm ^. itID . unNInt
col = blue -- mixColors reloadFrac (1-reloadFrac) blue red
shineTorch :: Creature -> LocationDT OItem -> World -> World
@@ -241,10 +240,10 @@ shineTorch cr loc = fromMaybe id $ do
i <- mag ^. dtValue . _1 . itConsumables
guard $ crIsAiming cr
guard $ i >= x
invid <- mag ^? dtValue . _1 . itLocation . ilInvID
itid <- mag ^? dtValue . _1 . itID . unNInt
return $
(cWorld . lWorld . lights .:~ LSParam pos 250 0.7)
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itConsumables . _Just -~ x)
. (cWorld . lWorld . items . ix itid . itConsumables . _Just -~ x)
where
itmtree = loc ^. locDT
(p, q) = locOrient loc cr
@@ -281,9 +280,8 @@ updateItemTargeting tt cr itm w = case tt of
Nothing
True
where
pointittarg = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itTargeting
cid = _crID cr
invid = _ilInvID $ _itLocation itm
pointittarg = cWorld . lWorld . items . ix itid . itTargeting
itid = itm ^. itID . unNInt
isattached = itm ^?! itLocation . ilIsAttached
rbpressed = SDL.ButtonRight `M.member` _mouseButtons (_input w)
+12 -9
View File
@@ -6,6 +6,7 @@ module Dodge.Creature.Statistics (
crIntelligence,
) where
import Dodge.Data.LWorld
import Data.Maybe
import Dodge.Data.Creature
import qualified IntMapHelp as IM
@@ -42,11 +43,11 @@ crIntelligence cr = case cr ^. crType of
LampCrit {} -> 0
getCrMoveSpeed :: Creature -> Int
getCrMoveSpeed cr = strFromHeldItem cr + strFromEquipment cr + crStrength cr
getCrMoveSpeed :: LWorld -> Creature -> Int
getCrMoveSpeed lw cr = strFromHeldItem lw cr + strFromEquipment lw cr + crStrength cr
strFromEquipment :: Creature -> Int
strFromEquipment = sum . fmap equipmentStrValue . crCurrentEquipment
strFromEquipment :: LWorld -> Creature -> Int
strFromEquipment lw = sum . fmap equipmentStrValue . crCurrentEquipment lw
equipmentStrValue :: Item -> Int
equipmentStrValue itm = case _itType itm of
@@ -54,14 +55,16 @@ equipmentStrValue itm = case _itType itm of
EQUIP POWERLEGS -> 3
_ -> 0
crCurrentEquipment :: Creature -> IM.IntMap Item
crCurrentEquipment = IM.filter (isJust . (^? itLocation . ilEquipSite . _Just)) . _crInv
crCurrentEquipment :: LWorld -> Creature -> IM.IntMap Item
crCurrentEquipment lw = IM.filter (isJust . (^? itLocation . ilEquipSite . _Just)) . fmap f . _crInv
where
f i = lw ^?! items . ix i
strFromHeldItem :: Creature -> Int
strFromHeldItem cr = fromMaybe 0 $ do
strFromHeldItem :: LWorld -> Creature -> Int
strFromHeldItem lw cr = fromMaybe 0 $ do
Aiming <- cr ^? crStance . posture
i <- cr ^? crManipulation . manObject . imRootSelectedItem
fmap (negate . itemWeight) $ cr ^? crInv . ix i
fmap (negate . itemWeight) $ lw ^? items . ix i
itemWeight :: Item -> Int
itemWeight it = case it ^. itType of
+15 -16
View File
@@ -24,6 +24,7 @@ module Dodge.Creature.Test (
crSafeDistFromTarg,
) where
import qualified Data.IntMap.Strict as IM
import Dodge.Item.Grammar
import Dodge.Creature.Radius
import Dodge.Data.Equipment.Misc
@@ -90,35 +91,33 @@ crAwayFromPost cr = case find sentinelGoal . _apGoal $ _crActionPlan cr of
--crCanShoot :: Creature -> Bool
--crCanShoot cr = crIsAiming cr && crWeaponReady cr
crInAimStance :: AimStance -> Creature -> Bool
crInAimStance as cr = crIsAiming cr && mitstance == Just as
crInAimStance :: AimStance -> IM.IntMap Item -> Creature -> Bool
crInAimStance as m cr = crIsAiming cr && mitstance == Just as
where
mitstance = do
i <- cr ^? crManipulation . manObject . imRootSelectedItem
--itm <- invRootTrees' (cr ^. crInv) ^? ix i
itm <- fmap (fmap (\(a,b,_) -> (a,b))) $ invIMDT (cr ^. crInv) ^? ix i
itm <- fmap (fmap (\(a,b,_) -> (a,b))) $ invIMDT (fmap (\i -> m ^?! ix i) (cr ^. crInv)) ^? ix i
return $ aimStance itm
--cr ^? crInv . ix i . itUse . heldAim . aimStance
oneH :: Creature -> Bool
oneH :: IM.IntMap Item -> Creature -> Bool
oneH = crInAimStance OneHand
twoFlat :: Creature -> Bool
twoFlat :: IM.IntMap Item -> Creature -> Bool
twoFlat = crInAimStance TwoHandFlat
twists :: Creature -> Bool
twists cr = crInAimStance TwoHandUnder cr || crInAimStance TwoHandOver cr
twists :: IM.IntMap Item -> Creature -> Bool
twists m cr = crInAimStance TwoHandUnder m cr || crInAimStance TwoHandOver m cr
-- the use of crOldPos is because the damage position is calculated on the
-- previous frame
-- Not sure if it is a good idea
crIsArmouredFrom :: Point2 -> Creature -> Bool
crIsArmouredFrom = hasFrontArmour
hasFrontArmour :: Point2 -> Creature -> Bool
hasFrontArmour p cr = fromMaybe False $ do
crIsArmouredFrom :: IM.IntMap Item -> Point2 -> Creature -> Bool
crIsArmouredFrom m p cr = fromMaybe False $ do
invid <- cr ^? crEquipment . ix OnChest
ittype <- cr ^? crInv . ix invid . itType
itid <- cr ^? crInv . ix invid
ittype <- m ^? ix itid . itType
return $
EQUIP FRONTARMOUR == ittype
&& p /= _crOldPos cr
@@ -127,9 +126,9 @@ hasFrontArmour p cr = fromMaybe False $ do
-- even though angleVV can generate NaN, the comparison seems to deal with it
frontarmdirection
| crInAimStance OneHand cr = 0.5
| crInAimStance TwoHandUnder cr = negate 1
| crInAimStance TwoHandOver cr = negate 1
| crInAimStance OneHand m cr = 0.5
| crInAimStance TwoHandUnder m cr = negate 1
| crInAimStance TwoHandOver m cr = negate 1
| otherwise = 0
--crOnSeg :: Point2 -> Point2 -> Creature -> Bool
+2 -2
View File
@@ -99,14 +99,14 @@ destroyCreature cr
-- could look at the amount of damage here (given by maxDamage) too
corpseOrGib :: Creature -> World -> World
corpseOrGib cr = case cr ^? crDamage . to maxDamageType . _Just . _1 of
corpseOrGib cr w = w & case cr ^? crDamage . to maxDamageType . _Just . _1 of
Just CookingDamage -> addcorpse (thecorpse & cpSPic %~ scorchSPic)
Just PoisonDamage -> addcorpse (thecorpse & cpSPic %~ poisonSPic)
Just PhysicalDamage | _crPain cr > 200 -> addCrGibs cr
_ -> addcorpse thecorpse
where
addcorpse ctype = plNew (cWorld . lWorld . corpses) cpID ctype
thecorpse = makeCorpse cr
thecorpse = makeCorpse (w ^. cWorld . lWorld . items) cr
scorchSPic :: SPic -> SPic
scorchSPic = _1 %~ overColSH (mixColors 0.9 0.1 black . normalizeColor)
+25 -21
View File
@@ -4,6 +4,7 @@ module Dodge.Creature.YourControl (
yourControl,
) where
import qualified Data.IntMap.Strict as IM
import Dodge.Creature.MoveType
import Dodge.Data.Equipment.Misc
import Control.Monad
@@ -48,14 +49,14 @@ handleHotkeys w
, Just hk <-
listToMaybe . mapMaybe scancodeToHotkey . M.keys $ w ^. input . pressedKeys
, Just invid <- lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
, Just itid <- lw ^? creatures . ix 0 . crInv . ix invid . itID =
w & cWorld . lWorld %~ assignHotkey itid hk
, Just itid <- lw ^? creatures . ix 0 . crInv . ix invid =
w & cWorld . lWorld %~ assignHotkey (NInt itid) hk
| ispressed SDL.ScancodeLCtrl || ispressed SDL.ScancodeRCtrl
, Just hk <-
listToMaybe . mapMaybe scancodeToHotkey . M.keys $
w ^. input . pressedKeys
, Just itid <- lw ^? hotkeys . ix hk . unNInt
, Just invid <- lw ^? itemLocations . ix itid . ilInvID =
, Just invid <- lw ^? items . ix itid . itLocation . ilInvID =
w & invSetSelectionPos 0 invid
| otherwise =
M.foldl'
@@ -69,7 +70,7 @@ handleHotkeys w
useHotkey :: World -> (NewInt ItmInt, Int) -> World
useHotkey w (NInt itid, pt) = fromMaybe w $ do
invid <- w ^? cWorld . lWorld . itemLocations . ix itid . ilInvID
invid <- w ^? cWorld . lWorld . items . ix itid . itLocation . ilInvID
useItem invid pt w
hotkeyToScancode :: Hotkey -> SDL.Scancode
@@ -117,7 +118,7 @@ scancodeToHotkey x = case x of
within wasdMovement should probably be done first
-}
wasdWithAiming :: World -> Creature -> Creature
wasdWithAiming w cr = wasdAim inp w $ wasdMovement inp cam speed cr
wasdWithAiming w cr = wasdAim inp w $ wasdMovement (w ^. cWorld . lWorld) inp cam speed cr
where
speed = _mvSpeed $ crMvType cr
inp = w ^. input
@@ -127,31 +128,34 @@ wasdAim :: Input -> World -> Creature -> Creature
wasdAim inp w cr
| Just 0 <- inp ^? mouseButtons . ix SDL.ButtonRight
, Nothing <- inp ^? mouseButtons . ix SDL.ButtonLeft =
setAimPosture cr
| SDL.ButtonRight `M.member` _mouseButtons inp = aimTurn mousedir cr
| Aiming <- cr ^. crStance . posture = removeAimPosture cr
setAimPosture (w ^. cWorld . lWorld . items) cr
| SDL.ButtonRight `M.member` _mouseButtons inp = aimTurn (w ^. cWorld . lWorld)
mousedir cr
| Aiming <- cr ^. crStance . posture = removeAimPosture m cr
| otherwise = creatureTurnTowardDir (_crMvAim cr) 0.2 cr
where
m = w ^. cWorld . lWorld . items
mousedir = argV $ w ^. cWorld . lWorld . lAimPos - (cr ^. crPos)
setAimPosture :: Creature -> Creature
setAimPosture = (crStance . posture .~ Aiming) . doAimTwist (- twoHandTwistAmount)
setAimPosture :: IM.IntMap Item -> Creature -> Creature
setAimPosture m = (crStance . posture .~ Aiming) . doAimTwist m (- twoHandTwistAmount)
doAimTwist :: Float -> Creature -> Creature
doAimTwist x cr = fromMaybe cr $ do
doAimTwist :: IM.IntMap Item -> Float -> Creature -> Creature
doAimTwist m x cr = fromMaybe cr $ do
itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
astance <- fmap itemBaseStance $ cr ^? crInv . ix itRef
itid <- cr ^? crInv . ix itRef
astance <- fmap itemBaseStance $ m ^? ix itid
guard $ astance == TwoHandOver || astance == TwoHandUnder
return $ cr & crDir +~ x
removeAimPosture :: Creature -> Creature
removeAimPosture = (crStance . posture .~ AtEase) . doAimTwist twoHandTwistAmount
removeAimPosture :: IM.IntMap Item -> Creature -> Creature
removeAimPosture m = (crStance . posture .~ AtEase) . doAimTwist m twoHandTwistAmount
twoHandTwistAmount :: Float
twoHandTwistAmount = 1.6 * pi
wasdMovement :: Input -> Camera -> Float -> Creature -> Creature
wasdMovement inp cam speed = theMovement . setMvAim
wasdMovement :: LWorld -> Input -> Camera -> Float -> Creature -> Creature
wasdMovement lw inp cam speed = theMovement . setMvAim
where
setMvAim = fromMaybe id $ do
dir <- safeArgV movDir
@@ -160,14 +164,14 @@ wasdMovement inp cam speed = theMovement . setMvAim
movAbs = rotateV (cam ^. camRot) $ normalizeV movDir
theMovement
| movDir == V2 0 0 = id
| otherwise = crMvAbsolute (speed *.* movAbs)
| otherwise = crMvAbsolute lw (speed *.* movAbs)
aimTurn :: Float -> Creature -> Creature
aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
aimTurn :: LWorld -> Float -> Creature -> Creature
aimTurn lw a cr = creatureTurnTowardDir a (x * 0.2) cr
where
x = fromMaybe 1 $ do
itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
fmap itemBulkiness $ cr ^? crInv . ix itRef . itType
fmap itemBulkiness $ cr ^? crInv . ix itRef >>= \k -> lw ^? items . ix k . itType
itemBulkiness :: ItemType -> Float
itemBulkiness = \case
+1 -1
View File
@@ -45,7 +45,7 @@ data Creature = Creature
, _crType :: CreatureType
, _crID :: Int
, _crHP :: Int
, _crInv :: IM.IntMap Item
, _crInv :: IM.IntMap Int
, _crManipulation :: Manipulation
, _crEquipment :: M.Map EquipSite Int
, _crDamage :: [Damage]
+1 -1
View File
@@ -25,7 +25,7 @@ data EquipSite
| OnLeftWrist
| OnRightWrist
| OnLegs
| OnSpecial
-- | OnSpecial
deriving (Eq, Ord, Show, Read)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
@@ -20,7 +20,7 @@ data Manipulation -- should be ManipulatedObject?
data ManipulatedObject
= SortInventory
| SelectedItem
{ _imSelectedItem :: Int
{ _imSelectedItem :: Int -- this should probably be the itmid, not the invid
, _imRootSelectedItem :: Int
, _imAttachedItems :: IS.IntSet
}
+1 -1
View File
@@ -99,7 +99,7 @@ import Picture.Data
data LWorld = LWorld
{ _creatures :: IM.IntMap Creature
, _creatureGroups :: IM.IntMap CrGroupParams
, _itemLocations :: IM.IntMap ItemLocation
-- , _itemLocations :: IM.IntMap ItemLocation
, _items :: IM.IntMap Item
, _clouds :: [Cloud]
, _dusts :: [Dust]
+7 -7
View File
@@ -3,7 +3,7 @@
module Dodge.Debug.Terminal where
import Data.Foldable
import Dodge.Item.Location.Initialize
--import Dodge.Item.Location.Initialize
import Control.Applicative
import Control.Lens
--import Control.Monad
@@ -14,7 +14,7 @@ import Dodge.Data.Universe
import Dodge.Inventory.Add
import Dodge.Item
--import Dodge.Menu.PushPop
import qualified IntMapHelp as IM
--import qualified IntMapHelp as IM
import LensHelp
import MaybeHelp
import Text.Read (readMaybe)
@@ -28,22 +28,22 @@ applyTerminalString ss = case ss of
applyTerminalCommand :: String -> Universe -> Universe
applyTerminalCommand s = case s of
"NOCLIP" -> uvConfig . debug_booleans . at Noclip %~ toggleJust
['L', x] ->
(uvWorld . cWorld . lWorld %~ initSpecificCrItemLocations 0)
. (uvWorld . cWorld . lWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0 ..] $ inventoryX x))
['L', x] -> uvWorld %~ \w -> foldr createItemYou w (inventoryX x)
-- (uvWorld . cWorld . lWorld %~ initSpecificCrItemLocations 0)
-- . (uvWorld . cWorld . lWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0 ..] $ inventoryX x))
-- . (uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ 50)
-- ['I','S',x,y] -> uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ read [x,y]
"GODON" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crType . avatarMaterial .~ Crystal
"GODOFF" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crType . avatarMaterial .~ Flesh
x -> fromMaybe id $ do
(ibt, n) <- parseItem [x]
return $ uvWorld %~ flip (foldl' (&)) (replicate n (snd . createItemYou (itemFromBase ibt)))
return $ uvWorld %~ flip (foldl' (&)) (replicate n ( createItemYou (itemFromBase ibt)))
applyTerminalCommandArguments :: String -> [String] -> Universe -> Universe
applyTerminalCommandArguments command args u = case command of
"IT" -> fromMaybe u $ do
(ibt, n) <- parseItem args
return $ u & uvWorld %~ flip (foldl' (&)) (replicate n (snd . createItemYou (itemFromBase ibt)))
return $ u & uvWorld %~ flip (foldl' (&)) (replicate n ( createItemYou (itemFromBase ibt)))
"DEX" -> fromMaybe u $ do
x <- readMaybe =<< args ^? _head
return $ u & ypoint . crType . avDexterity .~ x
+1 -1
View File
@@ -102,7 +102,7 @@ defaultLWorld =
, _clouds = mempty
, _dusts = mempty
, _gusts = IM.empty
, _itemLocations = IM.empty
-- , _itemLocations = IM.empty
, _items = mempty
, _props = IM.empty
, _debris = mempty
+3 -3
View File
@@ -62,7 +62,7 @@ updateCombineSections w cfig =
(IM.fromDistinctAscList . zip [0 ..] $ combineList w)
"COMBINATIONS"
$ w ^? hud . hudElement . subInventory . ciFilter . _Just
invitms = fold $ w ^? cWorld . lWorld . creatures . ix 0 . crInv
invitms = fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $ fold $ w ^? cWorld . lWorld . creatures . ix 0 . crInv
sclose'
| null sclose =
IM.singleton 0 $
@@ -130,7 +130,7 @@ updateDisplaySections w cfig =
[ invhead
, sinv
, IM.singleton 0
$ SelItem [displayFreeSlots (crNumFreeSlots cr)] 1 15 True invDimColor 2 Nothing
$ SelItem [displayFreeSlots (crNumFreeSlots (w ^. cWorld . lWorld . items) cr)] 1 15 True invDimColor 2 Nothing
, nearbyhead
, sclose
, interfaceshead
@@ -163,7 +163,7 @@ updateDisplaySections w cfig =
invitems =
IM.map
(uncurry (invSelectionItem w))
(invIndents $ _crInv cr)
(invIndents $ fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $ _crInv cr)
filterSectionsPair ::
Bool -> -- check for whether filter is in focus, changes string at the end
+5 -4
View File
@@ -50,12 +50,13 @@ setWristShieldPos :: Item -> Creature -> World -> World
setWristShieldPos itm cr w = w & moveWallIDUnsafe i wlline
where
i = _itParamID $ _itParams itm
m = w ^. cWorld . lWorld . items
wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
invid = _ilInvID (_itLocation itm)
handtrans = case cr ^? crInv . ix invid . itLocation . ilEquipSite . _Just of
Just OnLeftWrist -> \cr' -> translatePointToLeftHand cr' . g
_ -> translatePointToRightHand
handtrans = case cr ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k . itLocation . ilEquipSite . _Just of
Just OnLeftWrist -> \cr' -> translatePointToLeftHand m cr' . g
_ -> translatePointToRightHand m
g
| twists cr = (+.+.+ V3 (-5) 10 0)
| twists m cr = (+.+.+ V3 (-5) 10 0)
| otherwise = id
f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr
+1 -1
View File
@@ -10,5 +10,5 @@ eqPosText ep = case ep of
OnLeftWrist -> "L.WRIST"
OnRightWrist -> "R.WRIST"
OnLegs -> "LEGS"
OnSpecial -> "EQUIPPED"
-- OnSpecial -> "EQUIPPED"
+8 -6
View File
@@ -33,15 +33,16 @@ useMagShield mt _ cr w =
}
setWristShieldPos :: Item -> Creature -> EquipSite -> World -> World
setWristShieldPos itm cr x = moveWallIDUnsafe i wlline
setWristShieldPos itm cr x w = moveWallIDUnsafe i wlline w
where
m = w ^. cWorld . lWorld . items
i = _itParamID $ _itParams itm
wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
handtrans = case x of
OnLeftWrist -> \cr' -> translatePointToLeftHand cr' . g
_ -> translatePointToRightHand
OnLeftWrist -> \cr' -> translatePointToLeftHand m cr' . g
_ -> translatePointToRightHand m
g
| twists cr = (+.+.+ V3 (-5) 10 0)
| twists m cr = (+.+.+ V3 (-5) 10 0)
| otherwise = id
f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr
@@ -53,9 +54,10 @@ setWristShieldPos itm cr x = moveWallIDUnsafe i wlline
-- _ -> w
createHeadLamp :: Item -> Creature -> World -> World
createHeadLamp _ cr =
createHeadLamp _ cr w = w &
cWorld . lWorld . lights
.:~ LSParam
((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr)
(translatePointToHead (w ^. cWorld . lWorld . items) cr (V3 5 0 3)))
200
0.7
-1
View File
@@ -23,7 +23,6 @@ copyItemToFloorID :: Point2 -> Item -> World -> World
copyItemToFloorID pos it w =
w'
& cWorld . lWorld . floorItems %~ IM.insert (_unNInt $ _itID it) theflit
& cWorld . lWorld . itemLocations %~ IM.insert (_unNInt $ _itID it) OnFloor
& cWorld . lWorld . items . ix (_unNInt $ _itID it) . itLocation .~ OnFloor
& hud . closeItems %~ (_itID it:)
-- & hud . hudElement . diSections . ix 3 . ssOffset .~ 0
+53 -60
View File
@@ -1,6 +1,6 @@
{-# LANGUAGE TupleSections #-}
{-# OPTIONS -Wno-incomplete-uni-patterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
module Dodge.HeldUse (
gadgetEffect,
@@ -102,7 +102,7 @@ hammerCheck f pt loc cr w = case itemTriggerType loc of
in w & f loc cr
& cWorld . lWorld . delayedEvents .++~ map g is
& randGen .~ gen
HammerTrigger t | timetest t , pt == 0 -> f loc cr w
HammerTrigger t | timetest t, pt == 0 -> f loc cr w
SemiAutoTrigger t
| timetest t
, pt < w ^. cWorld . lWorld . lClock - timelastused ->
@@ -117,7 +117,7 @@ hammerCheck f pt loc cr w = case itemTriggerType loc of
-- the following is unsafe, but if ilInvID isn't correctly set we probably
-- will have problems elsewhere also
invid = it ^?! itLocation . ilInvID
itmset = cWorld . lWorld . creatures . ix cid . crInv . ix invid
itmset = cWorld . lWorld . items . ix (it ^. itID . unNInt)
setwarming = itmset . itParams . isWarming %~ const True
timelastused = it ^. itTimeLastUsed
g x = (x, WdWdBurstFireRepetition (_crID cr) invid)
@@ -129,7 +129,7 @@ getVolleyBurst i g =
heldEffectMuzzles :: LocationDT OItem -> Creature -> World -> World
heldEffectMuzzles loc cr w =
setusetime
setusetime
. doHeldUseEffect t cr
. uncurry (applyCME loc cr)
$ bw
@@ -137,9 +137,9 @@ heldEffectMuzzles loc cr w =
t = loc ^. locDT
bw = foldl' (loadMuzzle loc cr) (False, w) (locMuzzles loc)
setusetime =
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itid . itTimeLastUsed
cWorld . lWorld . items . ix itid . itTimeLastUsed
.~ w ^. cWorld . lWorld . lClock
itid = t ^?! dtValue . _1 . itLocation . ilInvID
itid = t ^?! dtValue . _1 . itID . unNInt
locMuzzles :: LocationDT OItem -> [Muzzle]
locMuzzles loc
@@ -196,7 +196,7 @@ heldItemMuzzles = \case
& ix 0 . mzFlareType .~ NoLightFlare
& ix (i `div` 2) . mzFlareType .~ BasicFlare
& ix (i -1) . mzFlareType .~ NoLightFlare
PISTOL -> [Muzzle (V2 10 0) 0 0.05 maguse1 BasicFlare MuzzleShootBullet 0]
PISTOL -> [Muzzle (V2 10 0) 0 0.05 maguse1 BasicFlare MuzzleShootBullet 0]
MACHINEPISTOL -> [Muzzle (V2 10 0) 0 0.3 maguse1 MiniGunFlare MuzzleShootBullet 0]
AUTOPISTOL -> [Muzzle (V2 10 0) 0 0 maguse1 BasicFlare MuzzleShootBullet 0]
SMG -> [Muzzle (V2 20 0) 0 0.05 maguse1 BasicFlare MuzzleShootBullet 0]
@@ -341,26 +341,20 @@ vgunMuzzles i =
)
doHeldUseEffect :: DTree OItem -> Creature -> World -> World
doHeldUseEffect t cr w = case t ^. dtValue . _1 . itType of
doHeldUseEffect t _ w = case t ^. dtValue . _1 . itType of
HELD (VOLLEYGUN j) -> case itm ^? itParams . unfiredBarrels of
Just [_] -> fromMaybe w $ do
let (is, g) = runState (shuffle [0 .. j -1]) $ w ^. randGen
i <- itm ^? itLocation . ilInvID
return $
w
& randGen .~ g
& crinvset . ix i . itParams . unfiredBarrels %~ const is
Just (_ : _ : _) -> fromMaybe w $ do
i <- itm ^? itLocation . ilInvID
return $ w & crinvset . ix i . itParams . unfiredBarrels %~ tail
& crinvset . itParams . unfiredBarrels %~ const is
Just (_ : _ : _) -> w & crinvset . itParams . unfiredBarrels %~ tail
_ -> w
HELD ALTERIFLE -> fromMaybe w $ do
i <- t ^? dtValue . _1 . itLocation . ilInvID
return $
w & crinvset . ix i . itParams . alteRifleSwitch %~ ((`mod` 2) . (+ 1))
HELD ALTERIFLE -> w & crinvset . itParams . alteRifleSwitch %~ ((`mod` 2) . (+ 1))
_ -> w
where
crinvset = cWorld . lWorld . creatures . ix (_crID cr) . crInv
crinvset = cWorld . lWorld . items . ix (itm ^. itID . unNInt)
itm = t ^. dtValue . _1
-- should probably unify failure with time use check in some way...
@@ -637,8 +631,8 @@ loadMuzzle loc cr (b, w) mz = maybe (b, w) (True,) $ do
find
((== PulseBallSF) . (^. dtValue . _2))
(loc ^. locDT . dtLeft)
mid <- mag ^? dtValue . _1 . itLocation . ilInvID
availableammo <- w ^? cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix mid . itConsumables . _Just
mid <- mag ^? dtValue . _1 . itID . unNInt
availableammo <- w ^? cWorld . lWorld . items . ix mid . itConsumables . _Just
let usedammo = case as ^?! aps of
UseUpTo x -> min x availableammo
UseExactly x
@@ -719,12 +713,12 @@ isAmmoIntLink i sf = Just i == sf ^? amsfLink
useLoadedAmmo ::
LocationDT OItem ->
Creature ->
Muzzle ->
Muzzle ->
Maybe (Int, DTree OItem) ->
World ->
World
useLoadedAmmo loc cr mz m w =
removeAmmoFromMag m cr . makeMuzzleFlare mz loc cr $ case _mzEffect mz of
useLoadedAmmo loc cr mz m w =
removeAmmoFromMag m . makeMuzzleFlare mz loc cr $ case _mzEffect mz of
MuzzleShootBullet -> shootBullets loc cr (mz, x, magtree) w
MuzzleLaser -> creatureShootLaser loc cr mz w
MuzzlePulseLaser -> creatureShootPulseLaser loc cr mz w
@@ -741,7 +735,7 @@ useLoadedAmmo loc cr mz m w =
mz
cr
w
MuzzleNozzle{} -> useGasParams mid mz loc cr $ walkNozzle mz itm cr w
MuzzleNozzle{} -> useGasParams mid mz loc cr $ walkNozzle mz itm w
MuzzleShatter -> shootShatter itm cr w
MuzzleDetector ->
itemDetectorEffect
@@ -782,17 +776,15 @@ itemDetectorEffect itm mitid armitid cr w = fromMaybe w $ do
f CREATUREDETECTOR = OTCreature
f WALLDETECTOR = OTWall
walkNozzle :: Muzzle -> Item -> Creature -> World -> World
walkNozzle mz itm cr w = fromMaybe w $ do
invid <- itm ^? itLocation . ilInvID
return $
w
& cWorld . lWorld . creatures . ix (_crID cr) . crInv
. ix invid
. itParams
. nzAngle
%~ f
& randGen .~ g
walkNozzle :: Muzzle -> Item -> World -> World
walkNozzle mz itm w =
w
& cWorld . lWorld . items
. ix (itm ^. itID . unNInt)
. itParams
. nzAngle
%~ f
& randGen .~ g
where
nz = _mzEffect mz
(walkamount, g) = randomR (- aspeed, aspeed) (_randGen w)
@@ -927,14 +919,12 @@ shootPulseBall p dir w =
i = IM.newKey $ w ^. cWorld . lWorld . pulseBalls
--removeAmmoFromMag :: Int -> Maybe Int -> Creature -> World -> World
removeAmmoFromMag :: Maybe (Int, DTree OItem) -> Creature -> World -> World
removeAmmoFromMag m cr = fromMaybe id $ do
removeAmmoFromMag :: Maybe (Int, DTree OItem) -> World -> World
removeAmmoFromMag m = fromMaybe id $ do
(x, magtree) <- m
magid <- magtree ^? dtValue . _1 . itLocation . ilInvID
magid <- magtree ^? dtValue . _1 . itID . unNInt
return $
cWorld . lWorld . creatures
. ix (_crID cr)
. crInv
cWorld . lWorld . items
. ix magid
. itConsumables
. _Just
@@ -1139,7 +1129,7 @@ useGasParams mmagid mz loc cr w =
gastype = fromMaybe (error "cannot find gas ammo") $ do
magid <- mmagid
hit <- itm ^? itType . ibtHeld
fueltype <- cr ^? crInv . ix magid >>= magAmmoParams >>= (^? ampCreateGas)
fueltype <- cr ^? crInv . ix magid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= magAmmoParams >>= (^? ampCreateGas)
gasType hit fueltype
(V3 x y _, q) =
locOrient loc cr
@@ -1224,11 +1214,11 @@ mcShootAuto itm mc w
-- | assumes that the item is held
shootTeslaArc :: LocationDT OItem -> Creature -> Muzzle -> World -> World
shootTeslaArc loc cr mz w =
w' & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itParams .~ ip
w' & cWorld . lWorld . items . ix itid . itParams .~ ip
& soundContinue (CrWeaponSound (_crID cr) 0) pos elecCrackleS (Just 2)
where
itm = loc ^. locDT . dtValue . _1
invid = itm ^?! itLocation . ilInvID
itid = itm ^. itID . unNInt
(w', ip) = makeTeslaArc (itm ^. itParams) pos dir w
(V3 x y _, q) =
locOrient loc cr
@@ -1328,22 +1318,25 @@ createProjectile ::
Creature ->
World ->
World
createProjectile x pjtype magtree stab muz cr = fromMaybe failsound $ do
magid <- magtree ^? dtValue . _1 . itLocation . ilInvID
ammoitem <- cr ^? crInv . ix magid
let rdetonate =
(^. dtValue . _1 . itID)
<$> find isrdet (magtree ^. dtLeft)
rscreen =
(^. dtValue . _1 . itID)
<$> find isrscreen (magtree ^. dtLeft)
aparams <-
((magtree ^? dtLeft) >>= find isampay >>= (^? dtValue . _1 . itType . ibtAttach . shellPayload))
-- <|> ammoitem ^? itConsumables . magParams . ampPayload
<|> magAmmoParams ammoitem ^? _Just . ampPayload
return $
createShell x rdetonate rscreen stab pjtype aparams muz cr
. startthesound
createProjectile x pjtype magtree stab muz cr w =
w
& ( fromMaybe failsound $ do
magid <- magtree ^? dtValue . _1 . itLocation . ilInvID
ammoitem <- cr ^? crInv . ix magid >>= \k -> w ^? cWorld . lWorld . items . ix k
let rdetonate =
(^. dtValue . _1 . itID)
<$> find isrdet (magtree ^. dtLeft)
rscreen =
(^. dtValue . _1 . itID)
<$> find isrscreen (magtree ^. dtLeft)
aparams <-
((magtree ^? dtLeft) >>= find isampay >>= (^? dtValue . _1 . itType . ibtAttach . shellPayload))
-- <|> ammoitem ^? itConsumables . magParams . ampPayload
<|> magAmmoParams ammoitem ^? _Just . ampPayload
return $
createShell x rdetonate rscreen stab pjtype aparams muz cr
. startthesound
)
where
isrdet :: DTree OItem -> Bool
isrdet y = case y ^. dtValue . _2 of
+10 -8
View File
@@ -45,10 +45,10 @@ destroyInvItem cid invid w =
& removeithotkey
where
removeitloc = fromMaybe id $ do
itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid . itID . unNInt
return $ cWorld . lWorld . itemLocations . at itid .~ Nothing
itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
return $ cWorld . lWorld . items . at itid .~ Nothing
removeithotkey = fromMaybe id $ do
itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid . itID . unNInt
itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
hk <- w ^? cWorld . lWorld . imHotkeys . unNIntMap . ix itid
return $
(cWorld . lWorld . imHotkeys . unNIntMap . at itid .~ Nothing)
@@ -62,14 +62,14 @@ destroyAllInvItems cr w =
$ cr ^. crInv
destroyItem :: Int -> World -> World
destroyItem itid w = case w ^? cWorld . lWorld . itemLocations . ix itid of
destroyItem itid w = case w ^? cWorld . lWorld . items . ix itid . itLocation of
Nothing -> error $ "Tried to destroy item that does not exist; item id: " ++ show itid
Just InInv{_ilCrID = cid, _ilInvID = invid} -> destroyInvItem cid invid w
Just OnTurret{} -> error "need to write code for destroying items on turrets"
Just OnFloor ->
w & cWorld . lWorld . itemLocations . at itid .~ Nothing
w & cWorld . lWorld . items . at itid .~ Nothing
& cWorld . lWorld . floorItems . at itid .~ Nothing
Just InVoid -> w & cWorld . lWorld . itemLocations . at itid .~ Nothing
Just InVoid -> w & cWorld . lWorld . items . at itid .~ Nothing
-- note rmInvItem does not fully destroy the item, other updates to the item
-- location are required
@@ -82,7 +82,7 @@ rmInvItem cid invid w =
& pointcid . crEquipment . each %~ g
& updateselection
& updateselectionextra
& pointcid %~ updateRootItemID
& pointcid %~ updateRootItemID (w ^. cWorld . lWorld . items)
& worldEventFlags . at InventoryChange ?~ ()
where
pointcid = cWorld . lWorld . creatures . ix cid
@@ -95,7 +95,8 @@ rmInvItem cid invid w =
| otherwise =
pointcid . crManipulation . manObject . imSelectedItem %~ g
cr = w ^?! cWorld . lWorld . creatures . ix cid
itm = _crInv cr IM.! invid
itid = _crInv cr IM.! invid
itm = w ^?! cWorld . lWorld . items . ix itid
dounequipfunction = effectOnRemove itm cr
-- fromMaybe id $ do
-- rmf <- itm ^? itUse . uequipEffect . eeOnRemove
@@ -104,6 +105,7 @@ rmInvItem cid invid w =
epos <-
w
^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
>>= \k -> w ^? cWorld . lWorld . items . ix k
. itLocation
. ilEquipSite
. _Just
+5 -8
View File
@@ -36,9 +36,9 @@ tryPutItemInInv cid itid w = do
return $ (invid,) $ w
& cWorld . lWorld %~ crUpdateItemLocations cid
-- not sure about the order of these...
& cWorld . lWorld . creatures . ix cid . crInv . at invid ?~ newitm
& cWorld . lWorld . creatures . ix cid . crInv . at invid ?~ itid
& cWorld . lWorld . items . at itid ?~ newitm
& cWorld . lWorld . itemLocations . at itid ?~ itloc
-- & cWorld . lWorld . itemLocations . at itid ?~ itloc
& cWorld . lWorld . floorItems . at itid .~ Nothing
& updateselectionextra
where
@@ -110,13 +110,10 @@ tryPutItemInInvAt i cid itid w = do
-- copyItemToFloorID (_crPos $ you w) (applyModules it) w
-- return (Just i, w')
createItemYou :: Item -> World -> (ItemLocation, World)
createItemYou itm w = fromMaybe (OnFloor, w') $ do
(invid, w'') <- tryPutItemInInv 0 itid w'
itloc <- w'' ^? cWorld . lWorld . creatures . ix 0 . crInv . ix invid . itLocation
return (itloc, w'')
createItemYou :: Item -> World -> World
createItemYou itm w = fromMaybe w' $ fmap snd $ tryPutItemInInv 0 itid w'
where
itid = IM.newKey $ w ^. cWorld . lWorld . itemLocations
itid = IM.newKey $ w ^. cWorld . lWorld . items
pos = w ^?! cWorld . lWorld . creatures . ix 0 . crPos
w' = copyItemToFloorID pos (itm & itID .~ NInt itid) w
+5 -3
View File
@@ -17,12 +17,14 @@ import qualified IntMapHelp as IM
checkInvSlotsYou :: Item -> World -> Maybe Int
checkInvSlotsYou it w = do
ycr <- w ^? cWorld . lWorld . creatures . ix 0
guard $ crNumFreeSlots ycr >= itInvHeight it
guard $ crNumFreeSlots (w ^. cWorld . lWorld . items) ycr >= itInvHeight it
Just . IM.newKey $ _crInv ycr
crNumFreeSlots :: Creature -> Int
crNumFreeSlots :: IM.IntMap Item -> Creature -> Int
--crNumFreeSlots cr = _crInvCapacity cr - invSize (_crInv cr)
crNumFreeSlots cr = maxInvSlots - invSize (_crInv cr)
crNumFreeSlots m cr = maxInvSlots - invSize (fmap f (_crInv cr))
where
f i = m ^?! ix i
maxInvSlots :: Int
maxInvSlots = 25
+25 -21
View File
@@ -4,9 +4,12 @@ module Dodge.Inventory.Location (
setInvPosFromSS,
) where
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
import Data.Foldable
import Control.Applicative
import Control.Lens
import Data.IntMap.Merge.Strict
--import Data.IntMap.Merge.Strict
import qualified Data.IntSet as IS
import Data.Maybe
import Dodge.Base.You
@@ -26,43 +29,43 @@ tryGetRootAttachedFromInvID invid im = do
-- this assumes the creature inventory is well formed, specifically the
-- location ids
tryGetRootItemInvID :: Int -> Creature -> Maybe Int
tryGetRootItemInvID i cr = do
let adj = invAdj (_crInv cr)
tryGetRootItemInvID :: IM.IntMap Item -> Int -> Creature -> Maybe Int
tryGetRootItemInvID m i cr = do
let adj = invAdj $ fmap (\k -> m ^?! ix k) (_crInv cr)
theroot <- adj ^? ix i
theroot ^? _1 . _Just . _1 <|> Just i
updateRootItemID :: Creature -> Creature
updateRootItemID cr = fromMaybe cr $ do
updateRootItemID :: IM.IntMap Item -> Creature -> Creature
updateRootItemID m cr = fromMaybe cr $ do
i <- cr ^? crManipulation . manObject . imSelectedItem
j <- tryGetRootItemInvID i cr
j <- tryGetRootItemInvID m i cr
return $ cr & crManipulation . manObject . imRootSelectedItem .~ j
-- the following assumes that the crManipulation is correct
crUpdateItemLocations :: Int -> LWorld -> LWorld
crUpdateItemLocations crid lw = fromMaybe lw $ do
mo <- lw ^? creatures . ix crid . crManipulation . manObject
crinv <- lw ^? creatures . ix crid . crInv
itids <- lw ^? creatures . ix crid . crInv
let crinv = IM.restrictKeys (lw ^. items) (IS.fromList $ IM.elems itids)
return $ crSetRoots crid $ IM.foldlWithKey' (crUpdateInvidLocations mo crid) lw crinv
crSetRoots :: Int -> LWorld -> LWorld
crSetRoots cid w = fromMaybe w $ do
inv <- w ^? creatures . ix cid . crInv
return $
w & creatures . ix cid . crInv
%~ merge
dropMissing
preserveMissing
(zipWithMatched f)
(invIMDT inv)
let cinv = invIMDT $ fmap (\i -> w ^?! items . ix i) inv
return $ foldl' f (foldl' g w inv) cinv
where
f _ _ = itLocation . ilIsRoot .~ True
g w' i = w' & items . ix i . itLocation . ilIsRoot .~ False
f :: LWorld -> DTree OItem -> LWorld
f w' x = w'
& items . ix (x ^. dtValue . _1 . itID . unNInt) . itLocation . ilIsRoot .~ True
crUpdateInvidLocations :: ManipulatedObject -> Int -> LWorld -> Int -> Item -> LWorld
crUpdateInvidLocations mo crid lw invid itm =
lw
& creatures . ix crid . crInv . ix invid . itLocation .~ newloc
& itemLocations %~ IM.insert itid newloc
& creatures . ix crid . crInv . ix invid .~ itid -- . itLocation .~ newloc
& items . ix invid .~ (itm & itLocation .~ newloc)
-- & itemLocations %~ IM.insert itid newloc
where
itid = itm ^. itID . unNInt
newloc =
@@ -72,8 +75,8 @@ crUpdateInvidLocations mo crid lw invid itm =
, _ilIsRoot = Just invid == mo ^? imRootSelectedItem
, _ilIsSelected = Just invid == mo ^? imSelectedItem
, _ilIsAttached = invid `IS.member` (mo ^. imAttachedItems)
, _ilEquipSite = lw ^? creatures . ix crid . crInv . ix invid
. itLocation . ilEquipSite . _Just
, _ilEquipSite = do
lw ^? items . ix itid . itLocation . ilEquipSite . _Just
}
-- this should be looked at, as it is sometimes used in functions that need not
@@ -89,7 +92,8 @@ setInvPosFromSS w =
case i of
(-1) -> Just SortInventory
0 -> do
(rootid, aset) <- tryGetRootAttachedFromInvID j (you w ^. crInv)
(rootid, aset) <- tryGetRootAttachedFromInvID j (fmap (\k -> w ^?! cWorld . lWorld . items . ix k )
$ you w ^. crInv)
return
SelectedItem
{ _imSelectedItem = j
+10 -8
View File
@@ -4,6 +4,7 @@ module Dodge.Inventory.RBList (
eqSiteToPositions,
) where
import qualified Data.IntMap.Strict as IM
import Dodge.Data.Equipment.Misc
import Dodge.Data.EquipType
import Control.Applicative
@@ -21,11 +22,11 @@ updateRBList w = case w ^. rbOptions of
EquipOptions{} -> w
_ -> fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
i <- cr ^? crManipulation . manObject . imSelectedItem
esite <- cr ^? crInv . ix i >>= equipType -- . itUse . uequipEffect . eeType
esite <- cr ^? crInv . ix i >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType -- . itUse . uequipEffect . eeType
return $
w & rbOptions
.~ EquipOptions
{ _opSel = chooseEquipPosition cr (eqSiteToPositions esite)
{ _opSel = chooseEquipPosition (w ^. cWorld . lWorld . items) cr (eqSiteToPositions esite)
}
where
norightclick = not $ SDL.ButtonRight `M.member` (w ^. input . mouseButtons)
@@ -33,10 +34,11 @@ updateRBList w = case w ^. rbOptions of
-- want to choose the current position if the item is equipped, otherwise try to
-- find a free equipment slot
chooseEquipPosition :: Creature -> [EquipSite] -> Int
chooseEquipPosition cr eps = fromMaybe (chooseFreeSite cr eps) $ do
chooseEquipPosition :: IM.IntMap Item -> Creature -> [EquipSite] -> Int
chooseEquipPosition m cr eps = fromMaybe (chooseFreeSite cr eps) $ do
i <- cr ^? crManipulation . manObject . imSelectedItem
ep <- cr ^? crInv . ix i . itLocation . ilEquipSite . _Just
itid <- cr ^? crInv . ix i
ep <- m ^? ix itid . itLocation . ilEquipSite . _Just
elemIndex ep eps
chooseFreeSite :: Creature -> [EquipSite] -> Int
@@ -46,12 +48,12 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
getEquipmentAllocation :: Int -> World -> EquipmentAllocation
getEquipmentAllocation invid w = fromMaybe DoNotMoveEquipment $ do
esite <- you w ^? crInv . ix invid >>= equipType-- . itUse . uequipEffect . eeType
esite <- you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType-- . itUse . uequipEffect . eeType
i <-
w ^? rbOptions . opSel
<|> Just (chooseEquipPosition (you w) (eqSiteToPositions esite))
<|> Just (chooseEquipPosition (w ^. cWorld . lWorld . items) (you w) (eqSiteToPositions esite))
es <- eqSiteToPositions esite ^? ix i
return $ case you w ^? crInv . ix invid . itLocation . ilEquipSite . _Just of
return $ case you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k . itLocation . ilEquipSite . _Just of
Just epos
| es == epos -> RemoveEquipment{_allocOldPos = epos}
Just epos
+6 -3
View File
@@ -92,15 +92,18 @@ itemExternalValue itm w cr
= Just (Right "ON")
| BINGATE <- itm ^. itType = do
invid <- itm ^? itLocation . ilInvID
litm <- cr ^? crInv . ix (invid -2)
ritm <- cr ^? crInv . ix (invid -1)
litid <- cr ^? crInv . ix (invid -2)
ritid <- cr ^? crInv . ix (invid -1)
litm <- w ^? cWorld . lWorld . items . ix litid
ritm <- w ^? cWorld . lWorld . items . ix ritid
x <- itm ^? itScroll . itsRangeInt
l <- getItemValue litm w cr ^? _Just . _Left
r <- getItemValue ritm w cr ^? _Just . _Left
Just . Left $ bgateCalc x l r
| UNIGATE <- itm ^. itType = do
invid <- itm ^? itLocation . ilInvID
itm' <- cr ^? crInv . ix (invid -1)
itid' <- cr ^? crInv . ix (invid -1)
itm' <- w ^? cWorld . lWorld . items . ix itid'
x <- itm ^? itScroll . itsRangeInt
y <- getItemValue itm' w cr ^? _Just . _Left
Just . Left $ ugateCalc x y
+3 -2
View File
@@ -48,7 +48,7 @@ swapInvItems f i w = fromMaybe w $ do
. swapSite i k
. swapSite k i
cr = you w
swapSite a b = case cr ^? crInv . ix a . itLocation . ilEquipSite . _Just of
swapSite a b = case cr ^? crInv . ix a >>= \k -> w ^? cWorld . lWorld . items . ix k . itLocation . ilEquipSite . _Just of
Just epos -> crEquipment . ix epos .~ b
Nothing -> id
@@ -63,8 +63,9 @@ swapAnyExtraSelection i k w = fromMaybe w $ do
checkConnection :: SoundOrigin -> SoundID -> Int -> Int -> World -> World
checkConnection so s i j w = fromMaybe w $ do
inv <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
inv' <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
let inv = fmap (\k -> w ^?! cWorld . lWorld . items . ix k) inv'
let locs = invIndents inv -- why indents?
iit <- locs ^? ix i . _2
jit <- locs ^? ix j . _2
+13 -12
View File
@@ -4,6 +4,7 @@ module Dodge.Item.Draw (
itemEquipPict,
) where
import qualified Data.IntMap.Strict as IM
import qualified Quaternion as Q
import Dodge.Data.Equipment.Misc
import Dodge.Data.ComposedItem
@@ -16,12 +17,12 @@ import Dodge.Item.Draw.SPic
import Dodge.Item.HeldOffset
import ShapePicture
itemEquipPict :: Creature -> DTree CItem -> SPic
itemEquipPict cr itmtree
itemEquipPict :: IM.IntMap Item -> Creature -> DTree CItem -> SPic
itemEquipPict m cr itmtree
| Just i <- itm ^? itLocation . ilInvID
, Just esite <- cr ^? crInv . ix i . itLocation . ilEquipSite . _Just
, Just esite <- itm ^? itLocation . ilEquipSite . _Just
, Just attachpos <- equipAttachPos <$> itm ^? itType . ibtEquip
= equipPosition esite cr attachpos (itemSPic itm)
= equipPosition esite m cr attachpos (itemSPic itm)
| itm ^? itLocation . ilInvID == cr ^? crManipulation . manObject . imRootSelectedItem
= overPosSP (Q.prePos $ handHandleOrient loc cr) (itemTreeSPic itmtree)
| otherwise = mempty
@@ -37,15 +38,15 @@ equipAttachPos = \case
BULLETBELTBRACER -> V3 (-9) 0 10
_ -> 0
equipPosition :: EquipSite -> Creature -> Point3 -> SPic -> SPic
equipPosition epos cr p sh = case epos of
OnLeftWrist -> translateToLeftWrist cr sh
OnRightWrist -> translateToRightWrist cr sh
equipPosition :: EquipSite -> IM.IntMap Item -> Creature -> Point3 -> SPic -> SPic
equipPosition epos m cr p sh = case epos of
OnLeftWrist -> translateToLeftWrist m cr sh
OnRightWrist -> translateToRightWrist m cr sh
OnLegs ->
translateToLeftLeg cr sh
<> translateToRightLeg cr sh-- (mirrorSPxz sh)
OnHead -> translateToHead cr sh
OnChest -> translateToChest cr sh
OnHead -> translateToHead m cr sh
OnChest -> translateToChest m cr sh
--OnBack -> translateToBack cr p sh
OnBack -> overPosSP (\x -> fst $ backPQ cr `Q.comp` (p + x,Q.qID)) sh
OnSpecial -> sh
OnBack -> overPosSP (\x -> fst $ backPQ m cr `Q.comp` (p + x,Q.qID)) sh
-- OnSpecial -> sh
+6 -14
View File
@@ -26,26 +26,18 @@ import Dodge.Data.World
pointerYourSelectedItem :: Applicative a => (Item -> a Item) -> World -> a World
pointerYourSelectedItem f w = fromMaybe (pure w) $ do
itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem
Just $ (cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid) f w
itid <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid
Just $ (cWorld . lWorld . items . ix itid) f w
-- note the ilIsRoot/Selected/Attached booleans are irrelevant
pointerYourRootItem :: Applicative a => (Item -> a Item) -> World -> a World
pointerYourRootItem f w = fromMaybe (pure w) $ do
itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imRootSelectedItem
Just $ (cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid) f w
itid <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid
Just $ (cWorld . lWorld . items . ix itid) f w
pointerToItem :: Applicative f => Item -> (Item -> f Item) -> World -> f World
pointerToItem x = case x ^. itLocation of
OnFloor -> cWorld . lWorld . items . ix (x ^. itID . unNInt)
OnTurret _ -> cWorld . lWorld . items . ix (x ^. itID . unNInt)
InInv cid invid _ _ _ _ -> cWorld . lWorld . creatures . ix cid . crInv . ix invid
InVoid -> const pure
pointerToItem x = cWorld . lWorld . items . ix (x ^. itID . unNInt)
pointerToItemID :: Applicative f => NewInt ItmInt -> (Item -> f Item) -> World -> f World
pointerToItemID itid f w = fromMaybe (pure w) $ do
itloc <- w ^? cWorld . lWorld . itemLocations . ix (_unNInt itid)
return $ (\x -> x f w) $ case itloc of
OnFloor -> cWorld . lWorld . items . ix (itid ^. unNInt)
OnTurret _ -> cWorld . lWorld . items . ix (itid ^. unNInt)
InInv cid invid _ _ _ _ -> cWorld . lWorld . creatures . ix cid . crInv . ix invid
InVoid -> const pure
pointerToItemID itid = cWorld . lWorld . items . ix (itid ^. unNInt)
+64 -64
View File
@@ -1,6 +1,6 @@
module Dodge.Item.Location.Initialize
( initSpecificCrItemLocations
, initItemLocations
( -- initSpecificCrItemLocations
--, initItemLocations
)
where
import NewInt
@@ -9,68 +9,68 @@ import Control.Lens
import qualified IntMapHelp as IM
import Data.Traversable
initItemLocations :: LWorld -> LWorld
--initItemLocations = initCrsItemLocations . initFlItemsLocations . initTusItemLocations
initItemLocations = initCrsItemLocations -- . initTusItemLocations
initCrsItemLocations :: LWorld -> LWorld
initCrsItemLocations w = w' & creatures .~ newcreatures
where
(w', newcreatures) = mapAccumR initCrItemLocations w (w ^. creatures)
--initFlItemsLocations :: LWorld -> LWorld
--initFlItemsLocations w = w' & floorItems .~ newfloorItems
--initItemLocations :: LWorld -> LWorld
----initItemLocations = initCrsItemLocations . initFlItemsLocations . initTusItemLocations
--initItemLocations = initCrsItemLocations -- . initTusItemLocations
--
--initCrsItemLocations :: LWorld -> LWorld
--initCrsItemLocations w = w' & creatures .~ newcreatures
-- where
-- (w', newfloorItems) = mapAccumR initFlItemLocation w (w ^. floorItems)
--initTusItemLocations :: LWorld -> LWorld
--initTusItemLocations w = w' & machines .~ newmachines
-- (w', newcreatures) = mapAccumR initCrItemLocations w (w ^. creatures)
--
----initFlItemsLocations :: LWorld -> LWorld
----initFlItemsLocations w = w' & floorItems .~ newfloorItems
---- where
---- (w', newfloorItems) = mapAccumR initFlItemLocation w (w ^. floorItems)
--
----initTusItemLocations :: LWorld -> LWorld
----initTusItemLocations w = w' & machines .~ newmachines
---- where
---- (w', newmachines) = mapAccumR initTuItemLocation w (w ^. machines)
--
--initSpecificCrItemLocations :: Int -> LWorld -> LWorld
--initSpecificCrItemLocations crid w = w' & creatures . ix crid .~ newcr
-- where
-- (w', newmachines) = mapAccumR initTuItemLocation w (w ^. machines)
initSpecificCrItemLocations :: Int -> LWorld -> LWorld
initSpecificCrItemLocations crid w = w' & creatures . ix crid .~ newcr
where
(w',newcr) = initCrItemLocations w (w ^?! creatures . ix crid)
initCrItemLocations :: LWorld -> Creature -> (LWorld, Creature)
initCrItemLocations w cr = (w', cr & crInv .~ newinv)
where
(w',newinv) = imapAccumR (initCrItemLocation cr) w (_crInv cr)
-- does not worry about creature manipulation for now
initCrItemLocation :: Creature -> Int -> LWorld -> Item -> (LWorld,Item)
initCrItemLocation cr invid w it = (w & itemLocations . at locid ?~ loc
,it & itID .~ NInt locid
& itLocation .~ loc)
where
locid = IM.newKey ( w ^. itemLocations)
loc = InInv
{ _ilCrID = _crID cr
, _ilInvID = invid
, _ilIsRoot = False
, _ilIsSelected = False
, _ilIsAttached = False
, _ilEquipSite = Nothing
}
--initFlItemLocation :: LWorld -> FloorItem -> (LWorld, FloorItem)
--initFlItemLocation w flit = (w & itemLocations . at locid ?~ loc
-- , flit & flIt . itID .~ NInt locid
-- & flIt . itLocation .~ loc
-- )
-- (w',newcr) = initCrItemLocations w (w ^?! creatures . ix crid)
--
--initCrItemLocations :: LWorld -> Creature -> (LWorld, Creature)
--initCrItemLocations w cr = (w', cr & crInv .~ newinv)
-- where
-- locid = IM.newKey (w ^. itemLocations )
-- loc = OnFloor (_flItID flit)
--initTuItemLocation :: LWorld -> Machine -> (LWorld, Machine)
--initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of
-- Nothing -> (w, mc)
-- Just _ ->
-- let locid = IM.newKey ( w ^. itemLocations)
-- loc = OnTurret (_mcID mc)
-- in ( w & itemLocations . at locid ?~ loc
-- , mc & mcType . _McTurret . tuWeapon . itID .~ NInt locid
-- & mcType . _McTurret . tuWeapon . itLocation .~ loc
-- )
-- (w',newinv) = imapAccumR (initCrItemLocation cr) w (_crInv cr)
--
---- does not worry about creature manipulation for now
--initCrItemLocation :: Creature -> Int -> LWorld -> Int -> (LWorld,Item)
--initCrItemLocation cr invid w itid = (w & itemLocations . at locid ?~ loc
-- ,it & itID .~ NInt locid
-- & itLocation .~ loc)
-- where
-- locid = IM.newKey ( w ^. itemLocations)
-- loc = InInv
-- { _ilCrID = _crID cr
-- , _ilInvID = invid
-- , _ilIsRoot = False
-- , _ilIsSelected = False
-- , _ilIsAttached = False
-- , _ilEquipSite = Nothing
-- }
--
--
----initFlItemLocation :: LWorld -> FloorItem -> (LWorld, FloorItem)
----initFlItemLocation w flit = (w & itemLocations . at locid ?~ loc
---- , flit & flIt . itID .~ NInt locid
---- & flIt . itLocation .~ loc
---- )
---- where
---- locid = IM.newKey (w ^. itemLocations )
---- loc = OnFloor (_flItID flit)
--
----initTuItemLocation :: LWorld -> Machine -> (LWorld, Machine)
----initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of
---- Nothing -> (w, mc)
---- Just _ ->
---- let locid = IM.newKey ( w ^. itemLocations)
---- loc = OnTurret (_mcID mc)
---- in ( w & itemLocations . at locid ?~ loc
---- , mc & mcType . _McTurret . tuWeapon . itID .~ NInt locid
---- & mcType . _McTurret . tuWeapon . itLocation .~ loc
---- )
+2 -2
View File
@@ -17,7 +17,7 @@ import Data.Traversable
import Dodge.Data.GenWorld
import Dodge.Default.Wall
import Dodge.GameRoom
import Dodge.Item.Location.Initialize
--import Dodge.Item.Location.Initialize
import Dodge.LevelGen.LevelStructure
import Dodge.LevelGen.StaticWalls
import Dodge.Path
@@ -36,7 +36,7 @@ generateLevelFromRoomList gr' w =
over gwWorld initWallZoning
. over gwWorld randomCompass
. over gwWorld setupWorldBounds
. over (gwWorld . cWorld . lWorld) initItemLocations
-- . over (gwWorld . cWorld . lWorld) initItemLocations
. doAfterPlacements
. doInPlacements
. doOutPlacements
+1 -1
View File
@@ -121,7 +121,7 @@ someCrits :: RandomGen g => State g [Creature]
someCrits = do
nCrits <- state $ randomR (1, 3)
fmap (take nCrits) . shuffle $
[spreadGunCrit, pistolCrit, autoCrit, armourChaseCrit]
[spreadGunCrit, autoCrit, armourChaseCrit]
++ replicate 20 chaseCrit
--addcrits :: RandomGen g => [Item] -> State g (Tree Room)
+2 -1
View File
@@ -153,7 +153,8 @@ mcProximitySensorUpdate mc w = case ( _proxStatus sens
mcProxTest :: Machine -> World -> Bool
mcProxTest mc w = case mc ^? mcType . _McSensor . proxRequirement of
Just (RequireHealth x) -> _crHP cr >= x
Just (RequireEquipment ct) -> any (\itm -> _itType itm == ct) (_crInv cr)
Just (RequireEquipment ct) -> any (\itm -> _itType itm == ct)
(fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $ _crInv cr)
_ -> False
where
cr = you w
+3 -4
View File
@@ -109,8 +109,8 @@ placeSpotID' ps pt w = case pt of
PutProp prp -> plNewUpID (cWorld . lWorld . props) prID (mvProp p rot prp) w
PutButton bt -> plNewUpID (cWorld . lWorld . buttons) btID (mvButton p rot bt) w
PutTerminal tm -> plNewUpID (cWorld . lWorld . terminals) tmID tm w
PutFlIt itm -> let i = IM.newKey (w ^. cWorld . lWorld . itemLocations)
in (i, w & cWorld . lWorld . itemLocations . at i ?~ OnFloor
PutFlIt itm -> let i = IM.newKey (w ^. cWorld . lWorld . items)
in (i, w
& cWorld . lWorld . floorItems . at i ?~ createFlIt p rot
& cWorld . lWorld . items . at i ?~ (itm & itID .~ NInt i
& itLocation .~ OnFloor)
@@ -205,12 +205,11 @@ plTurret wallpoly mc wl itm p rot gw =
, gw & cWorld . lWorld . machines %~ addMc
& cWorld . lWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid
& cWorld . lWorld . items . at itid ?~ itm'
& cWorld . lWorld . itemLocations . at itid ?~ OnTurret mcid
)
where
itm' = itm & itID .~ NInt itid
& itLocation .~ OnTurret mcid
itid = IM.newKey $ gw ^. cWorld . lWorld . itemLocations
itid = IM.newKey $ gw ^. cWorld . lWorld . items
col = _mcColor mc
mcid = IM.newKey $ gw ^. cWorld . lWorld . machines
wlid = IM.newKey $ gw ^. cWorld . lWorld . walls
+1 -1
View File
@@ -228,7 +228,7 @@ pjRemoteSetDirection :: Maybe RocketHoming -> Projectile -> World -> World
pjRemoteSetDirection ph pj w = case ph of
Just (HomeUsingRemoteScreen screenid)
| lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
== lw ^? itemLocations . ix (_unNInt screenid) . ilInvID ->
== lw ^? items . ix (_unNInt screenid) . itLocation . ilInvID ->
w
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjDir
.~ (w ^. wCam . camRot) + argV (w ^. input . mousePos)
+8 -5
View File
@@ -62,7 +62,8 @@ drawInventory sss w cfig =
f = fmap (\(x, y, _) -> (x, y))
curs = invCursorParams w
itemconnections = fromMaybe mempty $ do
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'
case w ^? hud . hudElement . diInvFilter . _Just of
Just (_ : _) -> Nothing
_ -> return . drawItemConnections sss cfig $ invAdj inv
@@ -79,7 +80,8 @@ drawRootCursor w sss msel ldp cfig = fromMaybe mempty $ do
guard $ crIsAiming cr
(i, j) <- msel
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'
(x, y) <- getRootItemBounds j inv
return $
drawSSMultiCursor
@@ -201,7 +203,7 @@ drawExamineInventory cfig w =
yourAugmentedItem
itemInfo
(yourInfo (you w))
(closeObjectInfo (crNumFreeSlots (you w)))
(closeObjectInfo (crNumFreeSlots (w ^. cWorld . lWorld . items) (you w)))
w
)
)
@@ -248,7 +250,7 @@ drawRBOptions cfig w = fold $ do
invid <- you w ^? crManipulation . manObject . imSelectedItem
eslist <-
fmap eqSiteToPositions $
you w ^? crInv . ix invid >>= equipType -- . itUse . uequipEffect . eeType
you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType -- . itUse . uequipEffect . eeType
i <- w ^? rbOptions . opSel
let ae = getEquipmentAllocation invid w
sss <- w ^? hud . hudElement . diSections
@@ -297,7 +299,8 @@ drawRBOptions cfig w = fold $ do
| a == b - 1 = listCursorChooseBorderScale 0 1 (bc South) curpos 0 white 7 1
| otherwise = mempty
otheritem j = fromMaybe "" $ do
itype <- you w ^? crInv . ix j . itType
itid <- you w ^? crInv . ix j
itype <- w ^? cWorld . lWorld . items . ix itid . itType
return $ itemBaseName itype
equipAllocString :: EquipmentAllocation -> String
+5 -4
View File
@@ -28,7 +28,8 @@ worldSPic cfig u =
<> foldup (shiftDraw _blPos _blDir (drawBlock . _blDraw)) (filtOn _blPos _blocks)
<> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _foregroundShapes)
<> foldup (shiftDraw' _cpPos _cpDir _cpSPic) (filtOn _cpPos _corpses)
<> foldup drawCreature (filtOn _crPos _creatures)
<> foldup (drawCreature (u ^. uvWorld . cWorld . lWorld . items))
(filtOn _crPos _creatures)
<> foldup (Prelude.uncurry floorItemSPic) (IM.intersectionWith (,) (u^.uvWorld.cWorld.lWorld.items) (filtOn _flItPos (_floorItems)))
<> foldup btSPic (filtOn _btPos _buttons)
<> foldup (mcSPic (u ^. uvWorld . cWorld . lWorld)) (filtOn _mcPos _machines)
@@ -57,12 +58,12 @@ drawPulseBall pb =
. setLayer BloomLayer
$ circleSolidCol green white 10
drawCreature :: Creature -> SPic
drawCreature cr = translateSPz (_crZ cr) . uncurryV translateSPxy (_crPos cr) . rotateSP (_crDir cr) $
drawCreature :: IM.IntMap Item -> Creature -> SPic
drawCreature m cr = translateSPz (_crZ cr) . uncurryV translateSPxy (_crPos cr) . rotateSP (_crDir cr) $
case cr ^. crType of
BarrelCrit{} -> barrelShape
LampCrit{_lampHeight = h} -> lampCrSPic h
_ -> basicCrPict cr
_ -> basicCrPict m cr
barrelShape :: SPic
barrelShape = noPic $ cylinderPoly Medium Important (map (addZ 20) ps) (map (addZ 0) ps)
+1 -1
View File
@@ -268,7 +268,7 @@ randomFourCornerRoom its = do
nCrits <- state $ randomR (1, 3)
crits <-
takeN nCrits <=< shuffle $
[spreadGunCrit, pistolCrit, autoCrit, armourChaseCrit]
[spreadGunCrit, autoCrit, armourChaseCrit]
++ replicate 20 chaseCrit
randomFourCornerRoomCrsIts crits its
+1 -1
View File
@@ -326,7 +326,7 @@ pistolerRoom = do
3
( psPtPl
(rprBool $ \rp _ -> _rpPlacementUse rp == 0 && rpIsOnPath rp)
(PutCrit pistolCrit)
(PutCrit chaseCrit)
)
shootingRange :: RandomGen g => State g (MetaTree Room String)
+1 -1
View File
@@ -29,7 +29,7 @@ import qualified Data.Map.Strict as M
import NewInt
testStringInit :: Universe -> [String]
testStringInit u = map show (IM.keys $ u ^. uvWorld . cWorld . lWorld . itemLocations)
testStringInit u = map show (IM.keys $ u ^. uvWorld . cWorld . lWorld . items)
<> map show (IM.keys $ u ^. uvWorld . cWorld . lWorld . floorItems)
<> map show (u ^. uvWorld . hud . closeItems)
-- map shortShow (u ^.. uvWorld . cWorld . lWorld . debris . each . to g)
+11 -6
View File
@@ -95,28 +95,33 @@ moveZoomCamera cfig theinput cr w campos =
where
mremotepos = do
i <- cr ^? crManipulation . manObject . imSelectedItem
j <- cr ^? crInv . ix i . itUse . uaParams . apProjectiles . ix 0
guard $ Just REMOTESCREEN == cr ^? crInv . ix i . itType . ibtAttach
itid <- cr ^? crInv . ix i
j <- w ^? cWorld . lWorld . items . ix itid . itUse . uaParams . apProjectiles . ix 0
guard $ Just REMOTESCREEN == w ^? cWorld . lWorld . items . ix itid . itType . ibtAttach
w ^? cWorld . lWorld . projectiles . ix j . pjPos . _xy
docamrot = rotateV (campos ^. camRot)
offset = fromMaybe noscopeoffset $ do
guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
i <- cr ^? crManipulation . manObject . imSelectedItem
fmap docamrot (cr ^? crInv . ix i . itUse . uScope . opticPos)
itid <- cr ^? crInv . ix i
fmap docamrot (w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticPos)
noscopeoffset =
docamrot $
((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput
newzoom = fromMaybe (newDefaultZoom * newItemZoom) $ do
i <- cr ^? crManipulation . manObject . imSelectedItem
cr ^? crInv . ix i . itUse . uScope . opticZoom
itid <- cr ^? crInv . ix i
w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticZoom
idealDefaultZoom = clipZoom wallZoom
newDefaultZoom = fromMaybe (changeZoom (campos ^. camDefaultZoom) idealDefaultZoom) $ do
i <- cr ^? crManipulation . manObject . imSelectedItem
cr ^? crInv . ix i . itUse . uScope . opticZoom
itid <- cr ^? crInv . ix i
w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticZoom
idealItemZoom = fromMaybe 1 $ do
guard $ crIsAiming cr
i <- cr ^? crManipulation . manObject . imSelectedItem
getAimZoom <$> (cr ^? crInv . ix i)
itid <- cr ^? crInv . ix i
getAimZoom <$> (w ^? cWorld . lWorld . items . ix itid)
newItemZoom = changeZoom (campos ^. camItemZoom) idealItemZoom
changeZoom curZoom idealZoom
| curZoom > idealZoom + 0.01 = ((zoomOutSpeed -1) * curZoom + idealZoom) / zoomOutSpeed
+3 -2
View File
@@ -131,7 +131,7 @@ tryPickupSelected k mpos w = do
guard $ k == 3
guard $ maybe True (\(i, _) -> i == 0 || i == 1) mpos
cr <- w ^? cWorld . lWorld . creatures . ix 0
let nfreeslots = crNumFreeSlots cr
let nfreeslots = crNumFreeSlots (w ^. cWorld . lWorld . items) cr
xs <- w ^? hud . hudElement . diSelection . _Just . _3
let itmstopickup = mapMaybe g $ IS.toList xs
let slotsneeded = alaf Sum foldMap itInvHeight itmstopickup
@@ -238,6 +238,7 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
str <-
fmap (take 5) $
w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix j
>>= \k -> w ^? cWorld . lWorld . items . ix k
>>= (listToMaybe . basicItemDisplay)
return . (worldEventFlags . at CombineInventoryChange ?~ ()) $
case w ^? hud . hudElement . subInventory . ciFilter . _Just of
@@ -541,7 +542,7 @@ tryCombine (i, j) w = fromMaybe w $ do
CombinableItem is it <- sss ^? ix i . ssItems . ix j . siPayload . _Just
p <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
return $
snd (createItemYou it (foldr (destroyInvItem 0) w (sort is)))
(createItemYou it (foldr (destroyInvItem 0) w (sort is)))
& soundStart InventorySound p wrench1S Nothing
& hud . hudElement . diSelection . _Just . _3 .~ mempty
+7 -4
View File
@@ -3,6 +3,7 @@ module Dodge.Update.Scroll (
updateWheelEvent,
) where
import NewInt
import Control.Applicative
import qualified Data.ListTrie.Patricia.Map.Enum as PTE
import Dodge.Data.Terminal.Status
@@ -44,13 +45,13 @@ updateBaseWheelEvent yi w
bdown b = w & has (input . mouseButtons . ix b)
rbscrollmax = fromMaybe 1 $ do
invid <- you w ^? crManipulation . manObject . imSelectedItem
esite <- you w ^? crInv . ix invid >>= equipType -- . itUse . uequipEffect . eeType
esite <- you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType -- . itUse . uequipEffect . eeType
return . length $ eqSiteToPositions esite
selectedItemScroll :: Int -> World -> Maybe World
selectedItemScroll yi w = do
i <- you w ^? crManipulation . manObject . imSelectedItem
itm <- you w ^? crInv . ix i
itm <- you w ^? crInv . ix i >>= \k -> w ^? cWorld . lWorld . items . ix k
return $ itemScroll yi i itm w
itemScroll :: Int -> Int -> Item -> World -> World
@@ -69,7 +70,8 @@ itemScroll yi invid itm w
%~ ((`mod` y) . (+ yi))
| otherwise = w
where
itmlens = cWorld . lWorld . creatures . ix 0 . crInv . ix invid
--itmlens = cWorld . lWorld . creatures . ix 0 . crInv . ix invid
itmlens = cWorld . lWorld . items . ix (itm ^. itID . unNInt)
-- note that your _crInvLock does not apply to this TODO check that this is what
-- is wanted
@@ -82,7 +84,8 @@ updateScopeZoom i w
w & wppointer %~ doScopeZoom (w ^. input . smoothScrollAmount) (w ^. input . mousePos)
| otherwise = w & wppointer %~ resetscope
where
wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix i . itUse . uScope
itid = w ^?! cWorld . lWorld . creatures . ix 0 . crInv . ix i
wppointer = cWorld . lWorld . items . ix itid . itUse . uScope
resetscope (OpticScope _ _ defz) = OpticScope (V2 0 0) defz defz
doScopeZoom :: Int -> Point2 -> Scope -> Scope
+1 -1
View File
@@ -46,7 +46,7 @@ doWdWd we = case we of
WdWdBurstFireRepetition cid invid -> \w -> fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix cid
--itree <- allInvLocs (cr ^. crInv) ^? ix invid . _2 . locLDT
loc <- invIndents (cr ^. crInv) ^? ix invid . _2
loc <- invIndents (fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $ cr ^. crInv) ^? ix invid . _2
return $ heldEffectMuzzles loc cr w
accessTerminal :: Int -> World -> World
+6
View File
@@ -19,6 +19,12 @@ newtype NewIntMap a b = NIntMap { _unNIntMap :: IM.IntMap b}
deriving newtype (Monoid,Semigroup)
deriving (Eq,Ord,Show,Read)
--instance Ixed (NewIntMap (NewInt a)) where
-- type Index (NewIntMap (NewInt a)) = NewInt a
-- type Index (NewIntMap (NewInt a)) = NewInt a
-- ix :: (NewInt a) -> IndexedTraversal' (NewIntMap (NewInt a))
-- ix (NInt k) (NewIntMap m) = NIntMap <$> ix k m
makeLenses ''NewInt
makeLenses ''NewIntMap
deriveJSON defaultOptions ''NewInt