148 lines
4.6 KiB
Haskell
148 lines
4.6 KiB
Haskell
{- |
|
|
Module testing for properties of creatures, whether they are reloading, etc.
|
|
Each function takes a creature, and possibly other parameters, and returns a bool.
|
|
Note that if there is a world parameter,
|
|
the creature NEED NOT be the same as the creature with that id in the world,
|
|
in fact a creature with that id need not exist.
|
|
-}
|
|
module Dodge.Creature.Test (
|
|
crIsAiming,
|
|
-- crIsReloading,
|
|
crIsArmouredFrom,
|
|
oneH,
|
|
twists,
|
|
twoFlat,
|
|
-- crWeaponReady,
|
|
crInAimStance,
|
|
crNearPoint,
|
|
isAnimate,
|
|
-- crCanShoot,
|
|
crHasTargetLOS,
|
|
crAwayFromPost,
|
|
crHasTarget,
|
|
crStratConMatches,
|
|
crSafeDistFromTarg,
|
|
) where
|
|
|
|
import Dodge.Item.Grammar
|
|
import Dodge.Creature.Radius
|
|
import Dodge.Data.Equipment.Misc
|
|
import Dodge.Data.AimStance
|
|
import Dodge.Item.AimStance
|
|
import Control.Lens
|
|
import Data.List (find)
|
|
import Data.Maybe
|
|
import Dodge.Base.Collide
|
|
import Dodge.Data.World
|
|
import Geometry
|
|
|
|
--crIsReloading :: Creature -> Bool
|
|
--crIsReloading cr = case cr ^? crManipulation . manObject . inInventory . iselAction of
|
|
-- Just ReloadAction{} -> True
|
|
-- _ -> False
|
|
|
|
---- Assumes the ammotype below the selected item is correct
|
|
--crWeaponReady :: Creature -> Bool
|
|
--crWeaponReady cr = fromMaybe False $ do
|
|
-- i <- cr ^? crManipulation . manObject . inInventory . ispItem
|
|
-- x <- cr ^? crInv . ix (i + 1) . itUse . amagLoadStatus . iaLoaded
|
|
-- return (x > 0)
|
|
|
|
crCanSeeCr :: Creature -> (World, Creature) -> Bool
|
|
crCanSeeCr tcr (w, cr) = hasLOS (_crPos cr) (_crPos tcr) w
|
|
|
|
--crCanSeeCrid :: Int -> (World, Creature) -> Bool
|
|
--crCanSeeCrid tcid (w, cr) = fromMaybe False $ do
|
|
-- tcr <- w ^? cWorld . lWorld . creatures . ix tcid
|
|
-- return $ hasLOS (_crPos cr) (_crPos tcr) w
|
|
|
|
crIsAiming :: Creature -> Bool
|
|
crIsAiming cr = case _posture (_crStance cr) of
|
|
Aiming {} -> True
|
|
_ -> False
|
|
|
|
crHasTarget :: Creature -> Bool
|
|
crHasTarget cr = isJust $ cr ^? crIntention . targetCr . _Just
|
|
|
|
crHasTargetLOS :: World -> Creature -> Bool
|
|
crHasTargetLOS w cr = case cr ^? crIntention . targetCr . _Just of
|
|
Just i -> crCanSeeCr i (w, cr)
|
|
Nothing -> False
|
|
|
|
crSafeDistFromTarg :: Float -> Creature -> Bool
|
|
crSafeDistFromTarg d cr = case cr ^? crIntention . targetCr . _Just of
|
|
Just tcr -> dist (_crPos cr) (_crPos tcr) > d
|
|
Nothing -> True
|
|
|
|
crStratConMatches :: Strategy -> Creature -> Bool
|
|
crStratConMatches strat cr = strat == _apStrategy (_crActionPlan cr)
|
|
|
|
-- this equality check might be slow...
|
|
|
|
crAwayFromPost :: Creature -> Bool
|
|
crAwayFromPost cr = case find sentinelGoal . _apGoal $ _crActionPlan cr of
|
|
Just (SentinelAt p _) -> dist p (_crPos cr) > 15
|
|
_ -> False
|
|
where
|
|
sentinelGoal (SentinelAt _ _) = True
|
|
sentinelGoal _ = False
|
|
|
|
--crCanShoot :: Creature -> Bool
|
|
--crCanShoot cr = crIsAiming cr && crWeaponReady cr
|
|
|
|
crInAimStance :: AimStance -> Creature -> Bool
|
|
crInAimStance as cr = crIsAiming cr && mitstance == Just as
|
|
where
|
|
mitstance = do
|
|
i <- cr ^? crManipulation . manObject . imRootSelectedItem
|
|
itm <- invRootTrees (cr ^. crInv) ^? ix i
|
|
return $ aimStance itm
|
|
--cr ^? crInv . ix i . itUse . heldAim . aimStance
|
|
|
|
oneH :: Creature -> Bool
|
|
oneH = crInAimStance OneHand
|
|
|
|
twoFlat :: Creature -> Bool
|
|
twoFlat = crInAimStance TwoHandFlat
|
|
|
|
twists :: Creature -> Bool
|
|
twists cr = crInAimStance TwoHandUnder cr || crInAimStance TwoHandOver 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
|
|
invid <- cr ^? crEquipment . ix OnChest
|
|
ittype <- cr ^? crInv . ix invid . itType
|
|
return $
|
|
EQUIP FRONTARMOUR == ittype
|
|
&& p /= _crOldPos cr
|
|
&& angleVV (unitVectorAtAngle (_crDir cr + frontarmdirection)) (p -.- _crOldPos cr) < pi / 2
|
|
where
|
|
-- 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
|
|
| otherwise = 0
|
|
|
|
--crOnSeg :: Point2 -> Point2 -> Creature -> Bool
|
|
--crOnSeg p1 p2 cr = circOnSeg p1 p2 (_crPos cr) (_crRad cr)
|
|
|
|
--crNearSeg :: Float -> Point2 -> Point2 -> Creature -> Bool
|
|
--crNearSeg d p1 p2 cr = circOnSeg p1 p2 (_crPos cr) (_crRad cr + d)
|
|
|
|
crNearPoint :: Float -> Point2 -> Creature -> Bool
|
|
crNearPoint d p cr = dist (_crPos cr) p < d + crRad (cr ^. crType)
|
|
|
|
isAnimate :: Creature -> Bool
|
|
{-# INLINE isAnimate #-}
|
|
isAnimate cr = case _crActionPlan cr of
|
|
Inanimate -> False
|
|
_ -> True
|