Major item refactor, still broken
This commit is contained in:
@@ -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
@@ -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
|
||||
|
||||
@@ -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
|
||||
]
|
||||
)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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}
|
||||
}
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 =
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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'
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
@@ -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
@@ -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)
|
||||
|
||||
|
||||
@@ -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
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -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
|
||||
}
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -10,5 +10,5 @@ eqPosText ep = case ep of
|
||||
OnLeftWrist -> "L.WRIST"
|
||||
OnRightWrist -> "R.WRIST"
|
||||
OnLegs -> "LEGS"
|
||||
OnSpecial -> "EQUIPPED"
|
||||
-- OnSpecial -> "EQUIPPED"
|
||||
|
||||
|
||||
+8
-6
@@ -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
|
||||
|
||||
@@ -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
@@ -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
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user