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

Refactor, try to limit dependencies

Browse Source
This commit is contained in:
justin
2022-07-28 00:59:56 +01:00
parent 8aa5c17ab9
commit 160560af5f
418 changed files with 15104 additions and 13342 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Action.hs
+2 -1
View File
@@ -17,12 +17,13 @@ module Dodge.Creature.Action (
pickUpItem,
pickUpItemID,
) where
import Data.Bifunctor
import Data.List (findIndex)
import Data.Maybe
import Dodge.Base
import Dodge.CreatureEffect
import Dodge.Data
import Dodge.Data.World
import Dodge.Default
import Dodge.FloatFunction
import Dodge.FloorItem
src/Dodge/Creature/ArmourChase.hs
+43 -37
View File
@@ -1,45 +1,51 @@
module Dodge.Creature.ArmourChase
( armourChaseCrit
, flockArmourChaseCrit
) where
import Dodge.Data
module Dodge.Creature.ArmourChase (
armourChaseCrit,
flockArmourChaseCrit,
) where
import Control.Lens
import Dodge.Creature.ChaseCrit
import Dodge.Data.Creature
import Dodge.Data.FloatFunction
import Dodge.Default
import Dodge.Creature.ChaseCrit
import Dodge.Item.Equipment
import Dodge.Item.Consumable
import Dodge.Item.Equipment
import qualified IntMapHelp as IM
import Control.Lens
flockArmourChaseCrit :: Creature
flockArmourChaseCrit = defaultCreature
{ _crName = "armourChaseCrit"
, _crHP = 300
, _crInv = IM.fromList
[(0,frontArmour)
,(1,medkit 200)
]
, _crActionPlan = ActionPlan
{_apImpulse = []
,_apAction = []
,_apStrategy = FollowImpulses
,_apGoal = [Kill 0]
flockArmourChaseCrit =
defaultCreature
{ _crName = "armourChaseCrit"
, _crHP = 300
, _crInv =
IM.fromList
[ (0, frontArmour)
, (1, medkit 200)
]
, _crActionPlan =
ActionPlan
{ _apImpulse = []
, _apAction = []
, _apStrategy = FollowImpulses
, _apGoal = [Kill 0]
}
, _crMeleeCooldown = 0
, _crGroup = ShieldGroup
, _crMvType = defaultChaseMvType
}
, _crMeleeCooldown = 0
, _crGroup = ShieldGroup
, _crMvType = defaultChaseMvType
}
& crType . humanoidAI .~ FlockArmourChaseAI
& crType . humanoidAI .~ FlockArmourChaseAI
armourChaseCrit :: Creature
armourChaseCrit = chaseCrit
{ _crName = "armourChaseCrit"
--, _crUpdate = defaultImpulsive []
, _crInv = IM.fromList
[(0,frontArmour)
,(1,medkit 200)
]
, _crMvType = defaultChaseMvType {_mvTurnRad = FloatConst 0.05}
}
& crEquipment . at OnChest ?~ 0
& crInvEquipped . at 0 ?~ OnChest
armourChaseCrit =
chaseCrit
{ _crName = "armourChaseCrit"
, --, _crUpdate = defaultImpulsive []
_crInv =
IM.fromList
[ (0, frontArmour)
, (1, medkit 200)
]
, _crMvType = defaultChaseMvType{_mvTurnRad = FloatConst 0.05}
}
& crEquipment . at OnChest ?~ 0
& crInvEquipped . at 0 ?~ OnChest
src/Dodge/Creature/AutoCrit.hs
+17 -16
View File
@@ -1,21 +1,22 @@
module Dodge.Creature.AutoCrit
( autoCrit
) where
import Dodge.Data
module Dodge.Creature.AutoCrit (
autoCrit,
) where
import Dodge.Item.Held.Cane
import Control.Lens
import Dodge.Data.Creature
import Dodge.Default
import Dodge.Item.Weapon.BulletGuns
import Dodge.Item.Consumable
import qualified IntMapHelp as IM
import Picture
import qualified IntMapHelp as IM
import Control.Lens
autoCrit :: Creature
autoCrit = defaultCreature
{ _crInv = IM.fromList [(0,autoRifle),(1,medkit 100)]
, _crRad = 10
, _crHP = 300
, _crMvType = defaultAimMvType
}
& crType . skinUpper .~ light4 red
& crType . humanoidAI .~ AutoAI
autoCrit =
defaultCreature
{ _crInv = IM.fromList [(0, autoRifle), (1, medkit 100)]
, _crRad = 10
, _crHP = 300
, _crMvType = defaultAimMvType
}
& crType . skinUpper .~ light4 red
& crType . humanoidAI .~ AutoAI
src/Dodge/Creature/Boid.hs
+159 -142
View File
@@ -1,50 +1,50 @@
module Dodge.Creature.Boid
where
import Dodge.Data
import Dodge.Base
import Geometry
--import Geometry.ConvexPoly
module Dodge.Creature.Boid where
import Control.Monad.Reader
import Control.Lens
import Control.Monad.Reader
import Dodge.Base
import Dodge.Data.World
import Geometry
import qualified IntMapHelp as IM
interpWith :: Float -> Point2 -> Point2 -> Point2
interpWith x a b = x *.* a +.+ (1 - x) *.* b
invertEncircleDistP :: Float -> Creature -> Point2 -> Creature -> Point2
invertEncircleDistP d tcr cenp cr = ypos +.+
d *.* reflectIn (cenp -.- ypos) (squashNormalizeV (cpos -.- cenp))
where
invertEncircleDistP d tcr cenp cr =
ypos
+.+ d *.* reflectIn (cenp -.- ypos) (squashNormalizeV (cpos -.- cenp))
where
cpos = _crPos cr
ypos = _crPos tcr
encircleDistP :: Float -> Creature -> Point2 -> Creature -> Point2
encircleDistP d tcr cenp cr = ypos +.+ d *.* squashNormalizeV (cpos -.- cenp)
where
where
cpos = _crPos cr
ypos = _crPos tcr
encircleP :: Creature -> Point2 -> Creature -> Point2
encircleP tcr cenp cr = ypos +.+ 50 *.* squashNormalizeV (cpos -.- cenp)
where
where
cpos = _crPos cr
ypos = _crPos tcr
--f x = 150 * sigmoid (x-10)
--f x = 150 * sigmoid (x-10)
encircleCloseP :: Creature -> Point2 -> Creature -> Point2
encircleCloseP tcr cenp cr = ypos +.+ f (max 0 (magV (ypos -.- cenp) - 80) ) *.* squashNormalizeV (cpos -.- cenp)
where
encircleCloseP tcr cenp cr = ypos +.+ f (max 0 (magV (ypos -.- cenp) - 80)) *.* squashNormalizeV (cpos -.- cenp)
where
cpos = _crPos cr
ypos = _crPos tcr
f x = 150 * sigmoid (x-10)
f x = 150 * sigmoid (x -10)
forbidFlee
:: (Creature -> Point2 -> Creature -> Point2)
-> Creature
-> Point2
-> Creature
-> Point2
forbidFlee ::
(Creature -> Point2 -> Creature -> Point2) ->
Creature ->
Point2 ->
Creature ->
Point2
forbidFlee f tcr cenp cr
| ptargTest = tpos
| otherwise = ptarg
@@ -52,83 +52,85 @@ forbidFlee f tcr cenp cr
cpos = _crPos cr
tpos = _crPos tcr
ptarg = f tcr cenp cr
ptargTest = isLHS cpos (cpos +.+ rotateV (negate (pi/2)) (cpos -.- tpos)) ptarg
-- && isRHS cpos (cpos +.+ rotateV (pi/3) (cpos -.- tpos)) ptarg
--targBehindCrit = isLHS cpos (vNormal $ cpos +.+ unitVectorAtAngle (_crDir cr)) ptarg
ptargTest = isLHS cpos (cpos +.+ rotateV (negate (pi / 2)) (cpos -.- tpos)) ptarg
-- && isRHS cpos (cpos +.+ rotateV (pi/3) (cpos -.- tpos)) ptarg
--targBehindCrit = isLHS cpos (vNormal $ cpos +.+ unitVectorAtAngle (_crDir cr)) ptarg
pincerP :: Creature -> Point2 -> Creature -> Point2
pincerP tcr cenp cr = tpos +.+ splitp -- +.+ 25 *.* (normalizeV $ tpos -.- cenp)
where
where
cpos = _crPos cr
tpos = _crPos tcr
splitp
| isLHS cenp cpos tpos
= 150 *.* orthCenpTpos
| otherwise
= negate 150 *.* orthCenpTpos
splitp
| isLHS cenp cpos tpos =
150 *.* orthCenpTpos
| otherwise =
negate 150 *.* orthCenpTpos
--d = min 150 (dist cpos tpos)
--orthCenpTpos = safeNormalizeV (vNormal $ tpos -.- cpos)
orthCenpTpos = squashNormalizeV (vNormal $ tpos -.- cenp)
pincerP''' :: Creature -> Point2 -> Creature -> Point2
pincerP''' tcr cenp cr = interpWith (sigmoid $ 0.05 * dtcen) cenawayp cenclosep
where
where
cpos = _crPos cr
tpos = _crPos tcr
dtcen = dist tpos cenp
f x = 150 * sigmoid (x-10)
cenawayp
f x = 150 * sigmoid (x -10)
cenawayp
| dist cenp tpos < dist cpos tpos = tpos +.+ splitp
| otherwise = cenp +.+ splitp
splitp
| isLHS cenp cpos tpos
= f (max 0 (magV (tpos -.- cenp) - 80) ) *.* orthCenpTpos
| otherwise
= negate ( f $ max 0 $ magV (tpos -.- cenp) - 80) *.* orthCenpTpos
splitp
| isLHS cenp cpos tpos =
f (max 0 (magV (tpos -.- cenp) - 80)) *.* orthCenpTpos
| otherwise =
negate (f $ max 0 $ magV (tpos -.- cenp) - 80) *.* orthCenpTpos
orthCenpTpos = squashNormalizeV (vNormal $ tpos -.- cenp)
cenclosep
= tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* squashNormalizeV (cpos -.- cenp)
cenclosep =
tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80)) *.* squashNormalizeV (cpos -.- cenp)
pincerP' :: Creature -> Point2 -> Creature -> Point2
pincerP' tcr cenp cr
| dist cenp tpos > dist cpos tpos
= cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* squashNormalizeV (cpos -.- cenp)
| otherwise = tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* squashNormalizeV (cpos -.- cenp)
where
pincerP' tcr cenp cr
| dist cenp tpos > dist cpos tpos =
cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80)) *.* squashNormalizeV (cpos -.- cenp)
| otherwise = tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80)) *.* squashNormalizeV (cpos -.- cenp)
where
cpos = _crPos cr
tpos = _crPos tcr
f x = 150 * sigmoid (x-10)
f x = 150 * sigmoid (x -10)
pincerP'' :: Creature -> Point2 -> Creature -> Point2
pincerP'' tcr cenp cr
| dist cenp tpos > dist cpos tpos && isLHS cenp cpos tpos
= cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* squashNormalizeV (vNormal $ tpos -.- cenp)
| dist cenp tpos > dist cpos tpos
= cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* squashNormalizeV (vNormal $ cenp -.- tpos)
| otherwise = tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* squashNormalizeV (cpos -.- cenp)
where
pincerP'' tcr cenp cr
| dist cenp tpos > dist cpos tpos && isLHS cenp cpos tpos =
cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80)) *.* squashNormalizeV (vNormal $ tpos -.- cenp)
| dist cenp tpos > dist cpos tpos =
cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80)) *.* squashNormalizeV (vNormal $ cenp -.- tpos)
| otherwise = tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80)) *.* squashNormalizeV (cpos -.- cenp)
where
cpos = _crPos cr
tpos = _crPos tcr
f x = 150 * sigmoid (x-10)
f x = 150 * sigmoid (x -10)
encircle :: Creature -> IM.IntMap Creature -> Creature -> Point2
encircle tcr crs cr
encircle tcr crs cr
| length crs <= 1 = ypos
| otherwise = ypos +.+ f (max 0 (magV (ypos -.- cenp) - 80) ) *.* squashNormalizeV (cpos -.- cenp)
where
| otherwise = ypos +.+ f (max 0 (magV (ypos -.- cenp) - 80)) *.* squashNormalizeV (cpos -.- cenp)
where
cpos = _crPos cr
ypos = _crPos tcr
f x = 150 * sigmoid (x-10)
f x = 150 * sigmoid (x -10)
cenp = centroid (map _crPos $ IM.elems crs)
lineOrth :: Creature -> IM.IntMap Creature -> Creature -> Point2
lineOrth tcr crs cr = p
where
where
ypos = _crPos tcr
cpos = _crPos cr
ps = map _crPos $ IM.elems crs
ps = map _crPos $ IM.elems crs
cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
p | dist cen ypos < 20 = ypos
p
| dist cen ypos < 20 = ypos
| otherwise = errorClosestPointOnLine 500 ypos (ypos +.+ vNormal (cen -.- ypos)) cpos
holdForm :: Creature -> IM.IntMap Creature -> Creature -> Point2
@@ -136,9 +138,10 @@ holdForm ycr crs cr = p
where
ypos = _crPos ycr
cpos = _crPos cr
ps = map _crPos $ IM.elems crs
ps = map _crPos $ IM.elems crs
cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
p | dist cen ypos < 20 = ypos
p
| dist cen ypos < 20 = ypos
| otherwise = ypos +.+ cpos -.- cen
lineUp :: Creature -> IM.IntMap Creature -> Creature -> Point2
@@ -146,7 +149,7 @@ lineUp ycr crs cr = p
where
ypos = _crPos ycr
cpos = _crPos cr
ps = map _crPos $ IM.elems crs
ps = map _crPos $ IM.elems crs
cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
p = (0.05 *.* ypos) +.+ (0.95 *.* errorClosestPointOnLine 500 cen ypos cpos)
@@ -156,20 +159,21 @@ spreadOut ycr crs cr = p
where
ypos = _crPos ycr
cpos = _crPos cr
ps = map _crPos $ IM.elems crs
ps = map _crPos $ IM.elems crs
cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
p | dist cen ypos < 30 = ypos
p
| dist cen ypos < 30 = ypos
| otherwise = ypos +.+ (spreadFactor *.* cpos -.- cen)
spreadFactor
spreadFactor
| dist ypos cpos > 90 = 1
| otherwise = 1.5
swarmUsingCenter
:: (Creature -> Point2 -> Creature -> Creature)
-> (Point2 -> Creature -> Creature)
-> World
-> Creature
-> Creature
swarmUsingCenter ::
(Creature -> Point2 -> Creature -> Creature) ->
(Point2 -> Creature -> Creature) ->
World ->
Creature ->
Creature
swarmUsingCenter updT upd w cr = case _targetCr $ _crIntention cr of
Nothing -> upd cenp cr
Just tcr -> updT tcr cenp cr
@@ -177,12 +181,14 @@ swarmUsingCenter updT upd w cr = case _targetCr $ _crIntention cr of
cid = _crID cr
cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup $ _creatures (_cWorld w) IM.! cid)
flockChaseTarget
:: (Creature -> IM.IntMap Creature -> Creature -> Creature) -- ^ Update with target
-> (IM.IntMap Creature -> Creature -> Creature) -- ^ Update without target
-> World
-> Creature
-> Creature
flockChaseTarget ::
-- | Update with target
(Creature -> IM.IntMap Creature -> Creature -> Creature) ->
-- | Update without target
(IM.IntMap Creature -> Creature -> Creature) ->
World ->
Creature ->
Creature
flockChaseTarget updT upd w cr = case _targetCr $ _crIntention cr of
Nothing -> upd crs cr
Just tcr -> updT tcr crs cr
@@ -190,12 +196,13 @@ flockChaseTarget updT upd w cr = case _targetCr $ _crIntention cr of
is = _swarm $ _crGroup cr
crs = IM.restrictKeys (_creatures (_cWorld w)) is
flockPointTarget
:: (Creature -> IM.IntMap Creature -> Creature -> Point2)
-> (Creature -> World -> Maybe Creature) -- ^ Function for determining target
-> World
-> Creature
-> Creature
flockPointTarget ::
(Creature -> IM.IntMap Creature -> Creature -> Point2) ->
-- | Function for determining target
(Creature -> World -> Maybe Creature) ->
World ->
Creature ->
Creature
flockPointTarget f targFunc w cr = case targFunc cr w of
Nothing -> cr
Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
@@ -204,23 +211,24 @@ flockPointTarget f targFunc w cr = case targFunc cr w of
crs = IM.restrictKeys (_creatures (_cWorld w)) is
p = f crTarg crs cr
flockToPointUsing
:: (Creature -> Point2 -> Creature -> Point2)
-> (Point2 -> Creature -> Creature -> [Impulse])
-> Creature
-> Reader World Creature
flockToPointUsing ::
(Creature -> Point2 -> Creature -> Point2) ->
(Point2 -> Creature -> Creature -> [Impulse]) ->
Creature ->
Reader World Creature
flockToPointUsing pf mvf cr = reader $ \w -> case _targetCr $ _crIntention cr of
Nothing -> cr
Just tcr -> cr & crActionPlan . apImpulse .~ mvf ptarg cr tcr
where
cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr)
ptarg = pf tcr cenp cr
flockToPointUsing'
:: (Creature -> Point2 -> Creature -> Point2)
-> (Point2 -> Creature -> Creature -> [Impulse])
-> World
-> Creature
-> Creature
flockToPointUsing' ::
(Creature -> Point2 -> Creature -> Point2) ->
(Point2 -> Creature -> Creature -> [Impulse]) ->
World ->
Creature ->
Creature
flockToPointUsing' pf mvf w cr = case _targetCr $ _crIntention cr of
Nothing -> cr
Just tcr -> cr & crActionPlan . apImpulse .~ mvf ptarg cr tcr
@@ -228,11 +236,12 @@ flockToPointUsing' pf mvf w cr = case _targetCr $ _crIntention cr of
cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr)
ptarg = pf tcr cenp cr
flockFunc
:: (Creature -> Point2 -> Creature -> Point2)
-> (Creature -> World -> Maybe Creature) -- ^ Function for determining target
-> Creature
-> Reader World Creature
flockFunc ::
(Creature -> Point2 -> Creature -> Point2) ->
-- | Function for determining target
(Creature -> World -> Maybe Creature) ->
Creature ->
Reader World Creature
flockFunc f targFunc cr = reader $ \w -> case targFunc cr w of
Nothing -> cr
Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
@@ -240,11 +249,12 @@ flockFunc f targFunc cr = reader $ \w -> case targFunc cr w of
cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr)
p = f crTarg cenp cr
flockCenterFunc
:: (Creature -> Point2 -> Creature -> Point2)
-> (Creature -> World -> Maybe Creature) -- ^ Function for determining target
-> Creature
-> Reader World Creature
flockCenterFunc ::
(Creature -> Point2 -> Creature -> Point2) ->
-- | Function for determining target
(Creature -> World -> Maybe Creature) ->
Creature ->
Reader World Creature
flockCenterFunc f targFunc cr = reader $ \w -> case targFunc cr w of
Nothing -> cr
Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
@@ -252,11 +262,12 @@ flockCenterFunc f targFunc cr = reader $ \w -> case targFunc cr w of
cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr)
p = f crTarg cenp cr
flockPointTargetR
:: (Creature -> IM.IntMap Creature -> Creature -> Point2)
-> (Creature -> World -> Maybe Creature) -- ^ Function for determining target
-> Creature
-> Reader World Creature
flockPointTargetR ::
(Creature -> IM.IntMap Creature -> Creature -> Point2) ->
-- | Function for determining target
(Creature -> World -> Maybe Creature) ->
Creature ->
Reader World Creature
flockPointTargetR f targFunc cr = reader $ \w -> case targFunc cr w of
Nothing -> cr
Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
@@ -265,44 +276,50 @@ flockPointTargetR f targFunc cr = reader $ \w -> case targFunc cr w of
crs = IM.restrictKeys (_creatures (_cWorld w)) is
p = f crTarg crs cr
meleeHeadingMove
:: Float -- ^ max turn speed
-> Float -- ^ min turn speed
-> Float -- ^ turn speed cutoff angle
-> Float -- ^ move speed
-> Point2 -- ^ target point
-> Creature -- ^ start creature
-> Creature -- ^ target creature
-> [Impulse]
meleeHeadingMove ::
-- | max turn speed
Float ->
-- | min turn speed
Float ->
-- | turn speed cutoff angle
Float ->
-- | move speed
Float ->
-- | target point
Point2 ->
-- | start creature
Creature ->
-- | target creature
Creature ->
[Impulse]
meleeHeadingMove maxta minta tacutoff speed tp cr tcr
| dist tpos cpos < combinedRad + 5
&& abs (_crDir cr - argV (tpos -.- cpos)) < tacutoff
&& _crMeleeCooldown cr == 0
= [Melee (_crID tcr), Turn pi]
| dist tpos cpos < combinedRad + 5
&& abs (_crDir cr - argV (tpos -.- cpos)) < tacutoff
= [ TurnToward tpos minta ]
| abs (_crDir cr - argV (tp -.- cpos)) < tacutoff
= [MoveForward speed , TurnToward tp maxta , RandomTurn maxta ]
| otherwise = [MoveForward speed , TurnToward tp minta, RandomTurn maxta ]
| dist tpos cpos < combinedRad + 5
&& abs (_crDir cr - argV (tpos -.- cpos)) < tacutoff
&& _crMeleeCooldown cr == 0 =
[Melee (_crID tcr), Turn pi]
| dist tpos cpos < combinedRad + 5
&& abs (_crDir cr - argV (tpos -.- cpos)) < tacutoff =
[TurnToward tpos minta]
| abs (_crDir cr - argV (tp -.- cpos)) < tacutoff =
[MoveForward speed, TurnToward tp maxta, RandomTurn maxta]
| otherwise = [MoveForward speed, TurnToward tp minta, RandomTurn maxta]
where
cpos = _crPos cr
tpos = _crPos tcr
combinedRad = _crRad cr + _crRad tcr
mvPointMeleeTarg :: Point2 -> Creature -> Creature -> [Impulse]
mvPointMeleeTarg p cr crT
| dist tpos cpos < combinedRad + 5
&& abs (_crDir cr - argV (tpos -.- cpos)) < pi/4
&& _crMeleeCooldown cr == 0
= [Melee (_crID crT)]
| dist tpos cpos < combinedRad + 5
&& abs (_crDir cr - argV (tpos -.- cpos)) < pi/4
= [ TurnToward tpos 0.05 ]
| abs (_crDir cr - argV (p -.- cpos)) < pi/4
= [MoveForward 3 , TurnToward p 0.2 , RandomTurn 0.2 ]
| otherwise = [MoveForward 3 , TurnToward p 0.05, RandomTurn 0.2 ]
| dist tpos cpos < combinedRad + 5
&& abs (_crDir cr - argV (tpos -.- cpos)) < pi / 4
&& _crMeleeCooldown cr == 0 =
[Melee (_crID crT)]
| dist tpos cpos < combinedRad + 5
&& abs (_crDir cr - argV (tpos -.- cpos)) < pi / 4 =
[TurnToward tpos 0.05]
| abs (_crDir cr - argV (p -.- cpos)) < pi / 4 =
[MoveForward 3, TurnToward p 0.2, RandomTurn 0.2]
| otherwise = [MoveForward 3, TurnToward p 0.05, RandomTurn 0.2]
where
cpos = _crPos cr
tpos = _crPos crT
src/Dodge/Creature/ChainUpdates.hs
+6 -4
View File
@@ -1,11 +1,13 @@
module Dodge.Creature.ChainUpdates where
import Dodge.Data
import Data.Foldable
import Dodge.Data.World
chainCreatureUpdates
:: [World -> Creature -> Creature]
-> World -> Creature -> Creature
chainCreatureUpdates ::
[World -> Creature -> Creature] ->
World ->
Creature ->
Creature
chainCreatureUpdates ls w cr = foldl' unf cr ls
where
unf cr' g = g w cr'
src/Dodge/Creature/ChaseCrit.hs
+48 -40
View File
@@ -1,49 +1,57 @@
module Dodge.Creature.ChaseCrit
(smallChaseCrit
,invisibleChaseCrit
,chaseCrit
) where
import Dodge.Data
module Dodge.Creature.ChaseCrit (
smallChaseCrit,
invisibleChaseCrit,
chaseCrit,
) where
import Control.Lens
import Dodge.Data.Creature
import Dodge.Default
import Dodge.Item.Consumable
import Dodge.Item.Equipment
import Dodge.SoundLogic
import qualified IntMapHelp as IM
import Picture
import qualified IntMapHelp as IM
import Control.Lens
--import System.Random
smallChaseCrit :: Creature
smallChaseCrit = chaseCrit
{ _crHP = 1
, _crRad = 4
, _crInv = IM.fromList [(0,medkit 200)]
, _crCorpse = MakeDefaultCorpse
}
smallChaseCrit =
chaseCrit
{ _crHP = 1
, _crRad = 4
, _crInv = IM.fromList [(0, medkit 200)]
, _crCorpse = MakeDefaultCorpse
}
invisibleChaseCrit :: Creature
invisibleChaseCrit = chaseCrit
& crCamouflage .~ Invisible
& crInv . at 0 ?~ wristInvisibility
& crEquipment . at OnLeftWrist ?~ 0
& crInvEquipped . at 0 ?~ OnLeftWrist
invisibleChaseCrit =
chaseCrit
& crCamouflage .~ Invisible
& crInv . at 0 ?~ wristInvisibility
& crEquipment . at OnLeftWrist ?~ 0
& crInvEquipped . at 0 ?~ OnLeftWrist
chaseCrit :: Creature
chaseCrit = defaultCreature
{ _crName = "chaseCrit"
, _crHP = 150
, _crInv = IM.fromList [(0,medkit 200)]
, _crMeleeCooldown = 0
, _crFaction = ColorFaction green
, _crVocalization = Vocalization seagullChatterS
[seagullBarkS
,seagullChatterS
,seagullChatter1S
,seagullWhistleS
,seagullWhistle1S
,seagullCryS
,seagullCry1S
,seagullCry2S
] 50 0
, _crMvType = defaultChaseMvType
}
& crType . humanoidAI .~ ChaseAI
chaseCrit =
defaultCreature
{ _crName = "chaseCrit"
, _crHP = 150
, _crInv = IM.fromList [(0, medkit 200)]
, _crMeleeCooldown = 0
, _crFaction = ColorFaction green
, _crVocalization =
Vocalization
seagullChatterS
[ seagullBarkS
, seagullChatterS
, seagullChatter1S
, seagullWhistleS
, seagullWhistle1S
, seagullCryS
, seagullCry1S
, seagullCry2S
]
50
0
, _crMvType = defaultChaseMvType
}
& crType . humanoidAI .~ ChaseAI
src/Dodge/Creature/ChooseTarget.hs
+7 -9
View File
@@ -1,22 +1,20 @@
module Dodge.Creature.ChooseTarget
where
import Dodge.Data
import Dodge.Base
module Dodge.Creature.ChooseTarget where
import Control.Lens
--import qualified IntMapHelp as IM
import Dodge.Base
import Dodge.Data.World
targetYouLOS :: Creature -> World -> Maybe Creature
{-# INLINE targetYouLOS #-}
targetYouLOS cr w
targetYouLOS cr w
| hasLOS (_crPos cr) (_crPos $ you w) w = Just $ you w
| otherwise = Nothing
targetYouCognizant :: Creature -> World -> Maybe Creature
targetYouCognizant cr w
targetYouCognizant cr w
| hasLOS (_crPos cr) (_crPos $ you w) w
&& isCog (cr ^? crPerception . cpAwareness . ix 0)
= Just $ you w
&& isCog (cr ^? crPerception . cpAwareness . ix 0) =
Just $ you w
| otherwise = Nothing
where
isCog x = case x of
src/Dodge/Creature/Damage.hs
+29 -24
View File
@@ -1,14 +1,13 @@
module Dodge.Creature.Damage where
import Dodge.Data
import Dodge.Creature.Test
import Dodge.Spark
--import Dodge.Bullet
import Color
import Data.List
import Dodge.Creature.Test
import Dodge.Data.World
import Dodge.Spark
import Geometry
import LensHelp
import Data.List
applyNoDamage :: [Damage] -> Creature -> World -> World
applyNoDamage _ _ = id
@@ -16,34 +15,39 @@ applyCreatureDamage :: [Damage] -> Creature -> World -> World
applyCreatureDamage dms cr = case _crMaterial cr of
Flesh -> defaultApplyDamage dms cr
Crystal -> id
_-> defaultApplyDamage dms cr
_ -> defaultApplyDamage dms cr
defaultApplyDamage :: [Damage] -> Creature -> World -> World
defaultApplyDamage ds cr w = foldl' (applyIndividualDamage cr) w ds'
& cWorld . creatures . ix (_crID cr) %~ doPoisonDam
where
(ps,ds') = partition isPoison ds
isPoison Damage{_dmType=POISONDAM} = True
defaultApplyDamage ds cr w =
foldl' (applyIndividualDamage cr) w ds'
& cWorld . creatures . ix (_crID cr) %~ doPoisonDam
where
(ps, ds') = partition isPoison ds
isPoison Damage{_dmType = POISONDAM} = True
isPoison _ = False
poisonDam = quot (max 0 (sum (map _dmAmount ps))) 10
doPoisonDam = crHP -~ poisonDam
applyDamageEffect :: Damage -> DamageEffect -> Creature -> World -> World
applyDamageEffect dm de cr w = case de of
PushDamage push pushexp pushRad -> w
& cWorld . creatures . ix (_crID cr) . crPos .+.+~ pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir)
PushDamage push pushexp pushRad ->
w
& cWorld . creatures . ix (_crID cr) . crPos .+.+~ pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir)
where
pushAmount
| dist (_crPos cr) fromDir == 0 = 0
| otherwise = min 5 $ (push*5*pushRad / (dist (_crPos cr) fromDir * _crMass cr))**pushexp
PushBackDamage pback -> w
& cWorld . creatures . ix (_crID cr) . crPos .+.+~ (pback/_crMass cr) *.* (_dmTo dm -.- fromDir)
TorqueDamage rot -> w
& cWorld . creatures . ix (_crID cr) . crDir +~ rot
| otherwise = min 5 $ (push * 5 * pushRad / (dist (_crPos cr) fromDir * _crMass cr)) ** pushexp
PushBackDamage pback ->
w
& cWorld . creatures . ix (_crID cr) . crPos .+.+~ (pback / _crMass cr) *.* (_dmTo dm -.- fromDir)
TorqueDamage rot ->
w
& cWorld . creatures . ix (_crID cr) . crDir +~ rot
NoDamageEffect -> w
where
fromDir = _dmFrom dm
--p = _dmAt dm
--p = _dmAt dm
applyIndividualDamage :: Creature -> World -> Damage -> World
applyIndividualDamage cr w dm = applyDamageEffect dm (_dmEffect dm) cr $ applyIndividualDamage' cr w dm
@@ -62,7 +66,8 @@ applyPiercingDamage cr dm
p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr)
damageHP :: Creature -> Int -> World -> World
damageHP cr x = cWorld . creatures . ix (_crID cr) %~
( (crHP -~ x)
. (crPastDamage +~ x)
)
damageHP cr x =
cWorld . creatures . ix (_crID cr)
%~ ( (crHP -~ x)
. (crPastDamage +~ x)
)
src/Dodge/Creature/HandPos.hs
+53 -43
View File
@@ -1,33 +1,36 @@
module Dodge.Creature.HandPos where
import Dodge.Data
import Dodge.Creature.Test
--import Shape
import ShapePicture
import Geometry
import Control.Lens
import Data.Maybe
import Dodge.Creature.Test
import Dodge.Data.Creature
import Geometry
import ShapePicture
-- the position of a weapon handle
aimingWeaponHandlePos :: Creature -> Item -> Float
aimingWeaponHandlePos cr it = case it ^? itUse. useAim . aimStance of
Just TwoHandTwist -> -5
Just OneHand -> 14
Just TwoHandFlat -> 1.2 * _crRad cr
aimingWeaponHandlePos cr it = case it ^? itUse . heldAim . aimStance of
Just TwoHandTwist -> -5
Just OneHand -> 14
Just TwoHandFlat -> 1.2 * _crRad cr
Just LeaveHolstered -> 0
Nothing -> 0
Nothing -> 0
aimingWeaponZeroPos :: Creature -> Item -> Float
aimingWeaponZeroPos cr it = aimingWeaponHandlePos cr it
- fromMaybe 0 (it ^? itUse . useAim . aimHandlePos)
aimingWeaponZeroPos cr it =
aimingWeaponHandlePos cr it
- fromMaybe 0 (it ^? itUse . heldAim . aimHandlePos)
aimingMuzzlePos :: Creature -> Item -> Float
aimingMuzzlePos cr it = aimingWeaponZeroPos cr it
+ fromMaybe 0 (it ^? itUse . useAim . aimMuzPos)
aimingMuzzlePos cr it =
aimingWeaponZeroPos cr it
+ fromMaybe 0 (it ^? itUse . heldAim . aimMuzPos)
translatePointToRightHand :: Creature -> Point3 -> Point3
translatePointToRightHand cr = translatePointToRightHand' cr . mirrorV3xz
mirrorV3xz :: Point3 -> Point3
mirrorV3xz (V3 x y z) = V3 x (-y) z
mirrorV3xz (V3 x y z) = V3 x (- y) z
translatePointToRightHand' :: Creature -> Point3 -> Point3
translatePointToRightHand' cr
@@ -35,8 +38,8 @@ translatePointToRightHand' cr
| twists cr = (+.+.+ V3 0 5 20) . rotate3 (-1) . (+.+.+ V3 4 (-10) 0)
| twoFlat cr = (+.+.+ V3 4 (-8) 10)
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> (+.+.+ V3 (-f sa) (-off) 10)
_ -> (+.+.+ V3 0 (-off) 10)
Just (Walking sa LeftForward) -> (+.+.+ V3 (- f sa) (- off) 10)
_ -> (+.+.+ V3 0 (- off) 10)
where
off = 8
sLen = _strideLength $ _crStance cr
@@ -47,12 +50,12 @@ translateToRightHand cr = translateToRightHand' cr . mirrorSPxz
translateToRightHand' :: Creature -> SPic -> SPic
translateToRightHand' cr
| oneH cr = shoulderSP . translateSPf 11 (-3) . rotateSP (-0.5)-- . scaleSH (V3 1 1.5 1)
| oneH cr = shoulderSP . translateSPf 11 (-3) . rotateSP (-0.5) -- . scaleSH (V3 1 1.5 1)
| twists cr = shoulderSP . translateSPf 0 5 . rotateSP (-1) . translateSPf 4 (-10)
| twoFlat cr = waistSP . translateSPf 4 (-8)
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> waistSP . translateSPf (-f sa) (-off)
_ -> waistSP . translateSPf 0 (-off)
Just (Walking sa LeftForward) -> waistSP . translateSPf (- f sa) (- off)
_ -> waistSP . translateSPf 0 (- off)
where
off = 8
sLen = _strideLength $ _crStance cr
@@ -63,12 +66,12 @@ translateToRightWrist cr = translateToRightWrist' cr . mirrorSPxz
translateToRightWrist' :: Creature -> SPic -> SPic
translateToRightWrist' cr
| oneH cr = shoulderSP . translateSPf 11 (-3) . rotateSP (-0.5) . offTrans-- . scaleSH (V3 1 1.5 1)
| oneH cr = shoulderSP . translateSPf 11 (-3) . rotateSP (-0.5) . offTrans -- . scaleSH (V3 1 1.5 1)
| twists cr = shoulderSP . translateSPf 0 5 . rotateSP (-1) . translateSPf 4 (-10) . offTrans
| twoFlat cr = waistSP . translateSPf 4 (-8) . offTrans
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> waistSP . translateSPf (-f sa) (-off) . offTrans
_ -> waistSP . translateSPf 0 (-off) . offTrans
Just (Walking sa LeftForward) -> waistSP . translateSPf (- f sa) (- off) . offTrans
_ -> waistSP . translateSPf 0 (- off) . offTrans
where
offTrans = translateSP (V3 0 4 (-4))
off = 8
@@ -81,7 +84,7 @@ translatePointToLeftHand cr
| twists cr = (+.+.+ V3 0 5 20) . rotate3 (-1) . (+.+.+ V3 12 4 0) . rotate3 0.4
| twoFlat cr = (+.+.+ V3 4 8 10)
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa RightForward) -> (+.+.+ V3 (-f sa) off 10)
Just (Walking sa RightForward) -> (+.+.+ V3 (- f sa) off 10)
_ -> (+.+.+ V3 0 off 10)
where
off = 8
@@ -94,7 +97,7 @@ translateToLeftHand cr
| twists cr = shoulderSP . translateSPf 0 5 . rotateSP (-1) . translateSPf 12 4
| twoFlat cr = waistSP . translateSPf 4 8
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa RightForward) -> waistSP . translateSPf (-f sa) off
Just (Walking sa RightForward) -> waistSP . translateSPf (- f sa) off
_ -> waistSP . translateSPf 0 off
where
off = 8
@@ -107,7 +110,7 @@ translateToLeftWrist cr
| twists cr = shoulderSP . translateSPf 0 5 . rotateSP (-1) . translateSPf 12 4 . offTrans
| twoFlat cr = waistSP . translateSPf 4 8 . offTrans
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa RightForward) -> waistSP . translateSPf (-f sa) off . offTrans
Just (Walking sa RightForward) -> waistSP . translateSPf (- f sa) off . offTrans
_ -> waistSP . translateSPf 0 off . offTrans
where
offTrans = translateSP (V3 0 4 (-4))
@@ -116,20 +119,22 @@ translateToLeftWrist cr
f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
translateToLeftLeg :: Creature -> SPic -> SPic
translateToLeftLeg cr = rotateSP (_crMvDir cr - _crDir cr) . case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> translateSPf ( f sa) off
Just (Walking sa RightForward) -> translateSPf (-f sa) off
_ -> translateSPf 0 off
translateToLeftLeg cr =
rotateSP (_crMvDir cr - _crDir cr) . case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> translateSPf (f sa) off
Just (Walking sa RightForward) -> translateSPf (- f sa) off
_ -> translateSPf 0 off
where
off = 5
sLen = _strideLength $ _crStance cr
f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen
translateToRightLeg :: Creature -> SPic -> SPic
translateToRightLeg cr = rotateSP (_crMvDir cr - _crDir cr) . case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> translateSPf (-f sa) (-off)
Just (Walking sa RightForward) -> translateSPf ( f sa) (-off)
_ -> translateSPf 0 (-off)
translateToRightLeg cr =
rotateSP (_crMvDir cr - _crDir cr) . case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> translateSPf (- f sa) (- off)
Just (Walking sa RightForward) -> translateSPf (f sa) (- off)
_ -> translateSPf 0 (- off)
where
off = 5
sLen = _strideLength $ _crStance cr
@@ -137,35 +142,40 @@ translateToRightLeg cr = rotateSP (_crMvDir cr - _crDir cr) . case cr ^? crStanc
translateToHead :: Creature -> SPic -> SPic
translateToHead cr
| twists cr = translateSPz 20 . translateSPf 0 5 . rotateSP (-1) . translateSPf (negate 2.5) 0.25
| twists cr =
translateSPz 20 . translateSPf 0 5 . rotateSP (-1) . translateSPf (negate 2.5) 0.25
. rotateSP 1
| oneH cr = translateSPz 20 . rotateSP 0.5 . translateSPf 2.5 0
| oneH cr =
translateSPz 20 . rotateSP 0.5 . translateSPf 2.5 0
. rotateSP (negate 0.5)
| otherwise = translateSPz 20 . translateSPf 2.5 0
| otherwise = translateSPz 20 . translateSPf 2.5 0
translatePointToHead :: Creature -> Point3 -> Point3
translatePointToHead cr
| twists cr = (+.+.+ V3 0 5 20) . rotate3 (-1) . (+.+.+ V3 (negate 2.5) 0.25 0)
| twists cr =
(+.+.+ V3 0 5 20) . rotate3 (-1) . (+.+.+ V3 (negate 2.5) 0.25 0)
. rotate3 1
| oneH cr = (+.+.+ V3 0 0 20) . rotate3 0.5 . (+.+.+ V3 2.5 0 0)
| oneH cr =
(+.+.+ V3 0 0 20) . rotate3 0.5 . (+.+.+ V3 2.5 0 0)
. rotate3 (negate 0.5)
| otherwise = (+.+.+ V3 2.5 0 20)
translateToChest :: Creature -> SPic -> SPic
translateToChest cr
| oneH cr = rotateSP 0.5
-- | twists cr = translateSPf 0 5 . rotateSP (-1)
| oneH cr = rotateSP 0.5
-- | twists cr = translateSPf 0 5 . rotateSP (-1)
| twists cr = rotateSP (-1)
| otherwise = id
translateToBack :: Creature -> SPic -> SPic
translateToBack cr
| oneH cr = rotateSP 0.5
-- | twists cr = translateSPf 0 5 . rotateSP (-1)
| oneH cr = rotateSP 0.5
-- | twists cr = translateSPf 0 5 . rotateSP (-1)
| twists cr = rotateSP (-1)
| otherwise = id
shoulderSP :: SPic -> SPic
shoulderSP = translateSPz 20
waistSP :: SPic -> SPic
waistSP = translateSPz 10
src/Dodge/Creature/Impulse.hs
+75 -67
View File
@@ -1,91 +1,98 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Creature.Impulse
( impulsiveAIBefore
, followThenClearImpulses
) where
import Dodge.Data
import Dodge.FloatFunction
import Dodge.RandImpulse
import Dodge.CreatureEffect
import Dodge.Creature.Vocalization
import Dodge.Creature.Impulse.Movement
import Dodge.Creature.Impulse.UseItem
import Dodge.SoundLogic
import Geometry
import LensHelp
import qualified IntMapHelp as IM
import System.Random
module Dodge.Creature.Impulse (
impulsiveAIBefore,
followThenClearImpulses,
) where
import Control.Monad.State
import Data.Bifunctor
--import Data.Maybe
--
impulsiveAIBeforeAfter
:: (World -> Creature -> Creature)
-> (World -> Creature -> Creature)
-> Creature -> World -> World
import Dodge.Creature.Impulse.Movement
import Dodge.Creature.Impulse.UseItem
import Dodge.Creature.Vocalization
import Dodge.CreatureEffect
import Dodge.Data.World
import Dodge.FloatFunction
import Dodge.RandImpulse
import Dodge.SoundLogic
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import System.Random
impulsiveAIBeforeAfter ::
(World -> Creature -> Creature) ->
(World -> Creature -> Creature) ->
Creature ->
World ->
World
impulsiveAIBeforeAfter startup endup cr w = w' & cWorld . creatures . ix (_crID cr) .~ endup w' cr'
where
w' = g w
(g,cr') = impulsiveAI startup cr w
(g, cr') = impulsiveAI startup cr w
impulsiveAIBefore :: (World -> Creature -> Creature)
-> Creature -> World -> World
impulsiveAIBefore ::
(World -> Creature -> Creature) ->
Creature ->
World ->
World
impulsiveAIBefore f cr w = g w & cWorld . creatures . ix (_crID cr) .~ cr'
where
(g,cr') = impulsiveAI f cr w
(g, cr') = impulsiveAI f cr w
impulsiveAI
:: (World -> Creature -> Creature) -- | internal creature update
-> Creature
-> World
-> (World -> World , Creature)
impulsiveAI ::
(World -> Creature -> Creature) ->
Creature ->
World ->
(World -> World, Creature)
impulsiveAI f cr w = followImpulses w $ f w cr
followThenClearImpulses :: Creature -> World -> World
followThenClearImpulses = impulsiveAIBeforeAfter (const id) (const $ crActionPlan . apImpulse .~ [])
followImpulses :: World -> Creature -> (World -> World, Creature)
followImpulses w cr = foldr f (id, cr) (_apImpulse $ _crActionPlan cr)
where
f imp (theupdate,cr') = first (. theupdate) $ followImpulse cr' w imp
f imp (theupdate, cr') = first (. theupdate) $ followImpulse cr' w imp
followImpulse :: Creature -> World -> Impulse -> (World -> World , Creature)
followImpulse :: Creature -> World -> Impulse -> (World -> World, Creature)
followImpulse cr w imp = case imp of
ImpulseNothing -> (id,cr)
RandomImpulse rimp ->
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 cr)
Move p -> crup $ crMvBy p cr
MoveForward x -> crup $ crMvForward x cr
Turn a -> crup $ creatureTurn a cr
TurnToward p a -> crup $ creatureTurnToward p a cr
TurnTo p -> crup $ creatureTurnTo p cr
ChangePosture post -> crup $ cr & crStance . posture .~ post
UseItem -> (useItem cr, cr)
SwitchToItem i -> crup $ cr & crInvSel .~ InvSel i NoInvSelAction
Melee cid' -> (hitCr cid'
, crMvBy (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20)
RandomTurn a -> (randGen .~ snd (rr a), creatureTurn (fst $ rr a) cr)
MakeSound sid -> ( soundStart (CrSound (_crID cr)) (_crPos cr) sid Nothing , cr )
DropItem -> undefined
ChangeStrategy strat -> crup $ cr & crActionPlan . apStrategy .~ strat
AddGoal gl -> crup $ cr & crActionPlan . apGoal .:~ gl
ArbitraryImpulseFunction f -> crup $ doWdCrCr f w cr
ArbitraryImpulse f -> followImpulse cr w (doCrWdImp f cr w)
ImpulseNothing -> (id, cr)
RandomImpulse rimp ->
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 cr)
Move p -> crup $ crMvBy p cr
MoveForward x -> crup $ crMvForward x cr
Turn a -> crup $ creatureTurn a cr
TurnToward p a -> crup $ creatureTurnToward p a cr
TurnTo p -> crup $ creatureTurnTo p cr
ChangePosture post -> crup $ cr & crStance . posture .~ post
UseItem -> (useItem cr, cr)
SwitchToItem i -> crup $ cr & crInvSel .~ InvSel i NoInvSelAction
Melee cid' ->
( hitCr cid'
, crMvBy (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20
)
RandomTurn a -> (randGen .~ snd (rr a), creatureTurn (fst $ rr a) cr)
MakeSound sid -> (soundStart (CrSound (_crID cr)) (_crPos cr) sid Nothing, cr)
DropItem -> undefined
ChangeStrategy strat -> crup $ cr & crActionPlan . apStrategy .~ strat
AddGoal gl -> crup $ cr & crActionPlan . apGoal .:~ gl
ArbitraryImpulseFunction f -> crup $ doWdCrCr f w cr
ArbitraryImpulse f -> followImpulse cr w (doCrWdImp f cr w)
ArbitraryImpulseEffect f -> (doCrWdWd f cr, cr)
ImpulseUseTargetCID f -> case cr ^? crIntention . targetCr . _Just of
ImpulseUseTargetCID f -> case cr ^? crIntention . targetCr . _Just of
Just tcr -> followImpulse cr w (doIntImp f $ _crID tcr)
_ -> crup cr
_ -> crup cr
ImpulseUseTarget f -> case cr ^? crIntention . targetCr . _Just of
Just tcr -> followImpulse cr w (doCrImp f tcr)
_ -> crup cr
_ -> crup cr
ImpulseUseAheadPos f -> followImpulse cr w (doP2Imp f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
MvForward -> crup $ crMvForward speed cr
MvTurnToward p -> crup
$ creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr
MvForward -> crup $ crMvForward speed cr
MvTurnToward p ->
crup $
creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr
where
crup = (id,)
mvType = _crMvType cr
@@ -93,10 +100,11 @@ followImpulse cr w imp = case imp of
turnRad = doFloatFloat $ _mvTurnRad mvType
cpos = _crPos cr
cdir = _crDir cr
cid = _crID cr
cid = _crID cr
posFromID cid' = _crPos $ _creatures (_cWorld w) IM.! cid'
rr a = randomR (-a,a) $ _randGen w
hitCr i = (cWorld . creatures . ix i . crState . csDamage
.:~ Damage BLUNT 100 cpos (posFromID i) (posFromID i) NoDamageEffect
rr a = randomR (- a, a) $ _randGen w
hitCr i =
( cWorld . creatures . ix i . crState . csDamage
.:~ Damage BLUNT 100 cpos (posFromID i) (posFromID i) NoDamageEffect
)
. soundStart (CrSound cid) cpos hitS Nothing
. soundStart (CrSound cid) cpos hitS Nothing
src/Dodge/Creature/Impulse/Flee.hs
+12 -11
View File
@@ -1,16 +1,17 @@
module Dodge.Creature.Impulse.Flee
where
import Dodge.Data
import Geometry
import FoldableHelp
module Dodge.Creature.Impulse.Flee where
retreatPointForFrom
:: Float -> World -> Creature -> Point2 -> Maybe Point2
retreatPointForFrom d _ cr p
= safeMinimumOn (dist cpos)
$ divideCircle 10 p d
import Dodge.Data.World
import FoldableHelp
import Geometry
retreatPointForFrom ::
Float -> World -> Creature -> Point2 -> Maybe Point2
retreatPointForFrom d _ cr p =
safeMinimumOn (dist cpos) $
divideCircle 10 p d
where
cpos = _crPos cr
-- = head $ sortBy (compare `on` (\p -> dist p ypos < 300)) $ retreatP'' : retreatPs
-- where
-- retreatPs = sortBy (compare `on` dist cpos) $ map f $ nRaysRad 8 400
@@ -18,5 +19,5 @@ retreatPointForFrom d _ cr p
-- $ reflectPointWalls ypos (ypos +.+ p) (wallsAlongLine ypos (ypos +.+ p) w)
-- retreatP' = cpos +.+ 300 *.* (cpos -.- ypos)
-- retreatP'' = fromMaybe retreatP' $ fmap fst
-- $ reflectPointWalls ypos retreatP'
-- $ reflectPointWalls ypos retreatP'
-- $ wallsAlongLine ypos retreatP' w
src/Dodge/Creature/Impulse/Movement.hs
+51 -42
View File
@@ -1,26 +1,31 @@
module Dodge.Creature.Impulse.Movement where
import Dodge.Data
import Control.Lens
import Dodge.Creature.Statistics
import Dodge.Data.World
import Geometry
--import Data.Maybe
--import qualified IntMapHelp as IM
import Control.Lens
{- | Creature attempts to moves under its own steam.
The idea is that this may or may not work, depending on the status of the creature.
For now, though, this cannot fail. -}
crMvBy :: Point2 -- ^ Movement translation vector, will be made relative to creature direction
-> Creature -> Creature
The idea is that this may or may not work, depending on the status of the creature.
For now, though, this cannot fail.
-}
crMvBy ::
-- | Movement translation vector, will be made relative to creature direction
Point2 ->
Creature ->
Creature
crMvBy p cr = crMvAbsolute (rotateV (_crDir cr) p) cr
crMvAbsolute
:: Point2 -- ^ Movement translation vector
-> Creature
-> Creature
crMvAbsolute p' cr = advanceStepCounter (magV p) cr
& crPos %~ (+.+ p)
& crMvDir .~ argV p
where
crMvAbsolute ::
-- | Movement translation vector
Point2 ->
Creature ->
Creature
crMvAbsolute p' cr =
advanceStepCounter (magV p) cr
& crPos %~ (+.+ p)
& crMvDir .~ argV p
where
p = strengthFactor (getCrStrength cr) *.* p'
strengthFactor :: Int -> Float
@@ -29,18 +34,20 @@ strengthFactor i
| i < 1 = 0
| otherwise = 0.1 * fromIntegral i
crMvForward
:: Float -- ^ Speed
-> Creature
-> Creature
crMvForward ::
-- | Speed
Float ->
Creature ->
Creature
crMvForward speed = crMvBy (V2 speed 0)
advanceStepCounter
:: Float -- ^ Speed
-> Creature
-> Creature
advanceStepCounter ::
-- | Speed
Float ->
Creature ->
Creature
advanceStepCounter speed = crStance . carriage %~ f
where
where
f car = case car of
Standing -> f (Walking 0 RightForward)
Walking i ff -> Walking (i + ceiling speed) ff
@@ -50,25 +57,27 @@ creatureTurn :: Float -> Creature -> Creature
creatureTurn a = crDir +~ a
creatureTurnTo :: Point2 -> Creature -> Creature
creatureTurnTo p cr
creatureTurnTo p cr
| vToTarg == V2 0 0 = cr -- this should deal with the angleVV error
| otherwise = cr & crDir .~ dirToTarget
| otherwise = cr & crDir .~ dirToTarget
where
vToTarg = p -.- _crPos cr
dirToTarget = argV vToTarg
-- the following is perhaps not ideal because it mixes normalizeAngle with
-- angleVV, but it seems to work
creatureTurnTowardDir
:: Float -- ^ Angle
-> Float -- ^ Turn speed
-> Creature
-> Creature
creatureTurnTowardDir a turnSpeed cr
| normalizeAngle (abs (a - cdir)) <= turnSpeed
= cr & crDir .~ dirToTarget
| isLeftOfA (normalizeAngle dirToTarget) (normalizeAngle $ _crDir cr)
= cr & crDir +~ turnSpeed
creatureTurnTowardDir ::
-- | Angle
Float ->
-- | Turn speed
Float ->
Creature ->
Creature
creatureTurnTowardDir a turnSpeed cr
| normalizeAngle (abs (a - cdir)) <= turnSpeed =
cr & crDir .~ dirToTarget
| isLeftOfA (normalizeAngle dirToTarget) (normalizeAngle $ _crDir cr) =
cr & crDir +~ turnSpeed
| otherwise = cr & crDir -~ turnSpeed
where
cdir = _crDir cr
@@ -76,16 +85,16 @@ creatureTurnTowardDir a turnSpeed cr
dirToTarget = argV vToTarg
creatureTurnToward :: Point2 -> Float -> Creature -> Creature
creatureTurnToward p turnSpeed cr
creatureTurnToward p turnSpeed cr
| vToTarg == V2 0 0 = cr -- this should deal with the angleVV error
| errorAngleVV 3 vToTarg (unitVectorAtAngle (_crDir cr)) <= turnSpeed
= cr & crDir .~ dirToTarget
| errorAngleVV 3 vToTarg (unitVectorAtAngle (_crDir cr)) <= turnSpeed =
cr & crDir .~ dirToTarget
| isLeftOfA (normalizeAngle dirToTarget) (normalizeAngle $ _crDir cr) = cr & crDir +~ turnSpeed
| otherwise = cr & crDir -~ turnSpeed
| otherwise = cr & crDir -~ turnSpeed
where
vToTarg = p -.- _crPos cr
dirToTarget = argV vToTarg
{- | Speed modifier of an item when not aiming. -}
-- | Speed modifier of an item when not aiming.
equipSpeed :: Item -> Float
equipSpeed _ = 1
src/Dodge/Creature/Impulse/UseItem.hs
+8 -9
View File
@@ -4,12 +4,11 @@ module Dodge.Creature.Impulse.UseItem (
itemEffect,
) where
--import qualified Data.IntSet as IS
import Control.Lens
import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Cuse
import Dodge.Data
import Dodge.Data.World
import Dodge.Euse
import Dodge.HeldUse
import Dodge.Inventory
@@ -29,7 +28,7 @@ useItem cr' w = fromMaybe (f w) $ do
itemEffect :: Creature -> Item -> World -> World
itemEffect cr it w = case it ^. itUse of
RightUse{_rUse = eff, _useMods = usemods} ->
HeldUse{_heldUse = eff, _heldMods = usemods} ->
hammerTest $ tryReload cr it w $ foldr ($) (useHeld eff) (useMod usemods) it cr
LeftUse{} -> doequipmentchange
EquipUse{} -> doequipmentchange
@@ -53,7 +52,7 @@ tryReload cr it w f
| _crID cr == _yourID (_cWorld w) && itNeedsLoading it && _mouseButtons w M.!? SDL.ButtonLeft == Just False =
crToggleReloading cr
| otherwise =
(runIdentity . pointerToItemLocation (_itLocation it) (return . (itUse . useHammer .~ HammerDown)))
(runIdentity . pointerToItemLocation (_itLocation it) (return . (itUse . heldHammer .~ HammerDown)))
. f
itNeedsLoading :: Item -> Bool
@@ -104,8 +103,8 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
crpoint = cWorld . creatures . ix (_crID cr)
itmat i = _crInv cr IM.! i
itm = itmat (crSel cr)
onequip itm' = useE ((_eqOnEquip . _eqEq . _itUse) itm') itm'
onremove itm' = useE ((_eqOnRemove . _eqEq . _itUse) itm') itm'
onequip itm' = useE ((_eeOnEquip . _equipEffect . _itUse) itm') itm'
onremove itm' = useE ((_eeOnRemove . _equipEffect . _itUse) itm') itm'
useLeftItem :: Int -> World -> World
useLeftItem cid w
@@ -114,16 +113,16 @@ useLeftItem cid w
| otherwise = fromMaybe w $ do
invid <- _crLeftInvSel cr
itm <- cr ^? crInv . ix invid
f <- cr ^? crInv . ix invid . itUse . lUse
f <- cr ^? crInv . ix invid . itUse . leftUse
return
. (runIdentity . pointerToItemLocation (_itLocation itm) (return . (itUse . useHammer .~ HammerDown)))
. (runIdentity . pointerToItemLocation (_itLocation itm) (return . (itUse . leftHammer .~ HammerDown)))
. useL f itm cr
$ w
where
cr = _creatures (_cWorld w) IM.! cid
itmShouldBeUsed =
isJust (cr ^? crInv . ix (crSel cr) . itUse . cUse)
|| ( isJust (cr ^? crInv . ix (crSel cr) . itUse . eqEq . eqUse)
|| ( isJust (cr ^? crInv . ix (crSel cr) . itUse . equipEffect . eeUse)
&& _crLeftInvSel cr /= Just (crSel cr)
)
src/Dodge/Creature/Inanimate.hs
+26 -21
View File
@@ -2,34 +2,39 @@
{-
Inanimate objects such as lamps, barrels, etc
-}
module Dodge.Creature.Inanimate
( barrel
, explosiveBarrel
, module Dodge.Creature.Lamp
) where
import Dodge.Data
module Dodge.Creature.Inanimate (
barrel,
explosiveBarrel,
module Dodge.Creature.Lamp,
) where
import Dodge.Creature.Lamp
import Dodge.Data.Creature
import Dodge.Default
import qualified IntMapHelp as IM
import LensHelp
barrel :: Creature
barrel = defaultInanimate
{ _crHP = 500
, _crType = Barreloid PlainBarrel
, _crState = defaultState
{_csSpState = Barrel []
barrel =
defaultInanimate
{ _crHP = 500
, _crType = Barreloid PlainBarrel
, _crState =
defaultState
{ _csSpState = Barrel []
}
, _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
}
, _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
}
explosiveBarrel :: Creature
explosiveBarrel = defaultInanimate
{ _crHP = 400
, _crType = Barreloid ExplosiveBarrel
, _crState = defaultState
{_csSpState = Barrel []
explosiveBarrel =
defaultInanimate
{ _crHP = 400
, _crType = Barreloid ExplosiveBarrel
, _crState =
defaultState
{ _csSpState = Barrel []
}
, _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
}
, _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
}
& crMaterial .~ Crystal
& crMaterial .~ Crystal
src/Dodge/Creature/Lamp.hs
+19 -15
View File
@@ -1,19 +1,23 @@
module Dodge.Creature.Lamp
( lamp
, colorLamp
) where
import Dodge.Data
module Dodge.Creature.Lamp (
lamp,
colorLamp,
) where
import Dodge.Data.Creature
import Dodge.Default
import Geometry.Data
colorLamp
:: Point3 -- color of lamp
-> Float -- height of lamp
-> Creature
colorLamp col h = defaultInanimate
{ _crHP = 100
, _crType = Lampoid h col Nothing
, _crRad = 3
, _crMass = 3
}
colorLamp ::
Point3 -> -- color of lamp
Float -> -- height of lamp
Creature
colorLamp col h =
defaultInanimate
{ _crHP = 100
, _crType = Lampoid h col Nothing
, _crRad = 3
, _crMass = 3
}
lamp :: Float -> Creature
lamp = colorLamp 0.75
src/Dodge/Creature/LauncherCrit.hs
+17 -20
View File
@@ -1,24 +1,21 @@
module Dodge.Creature.LauncherCrit
( launcherCrit
)
where
import Dodge.Data
module Dodge.Creature.LauncherCrit (
launcherCrit,
) where
import Dodge.Item.Held.Launcher
import Control.Lens
import Dodge.Data.Creature
import Dodge.Default
import Dodge.Item.Weapon.Launcher
import qualified IntMapHelp as IM
import Picture
import qualified IntMapHelp as IM
import Control.Lens
launcherCrit :: Creature
launcherCrit = defaultCreature
{ _crInv = IM.fromList [(0,launcher)]
, _crRad = 10
, _crState = defaultState
, _crHP = 300
}
& crType . skinUpper .~ light4 red
& crType . humanoidAI .~ LauncherAI
launcherCrit =
defaultCreature
{ _crInv = IM.fromList [(0, launcher)]
, _crRad = 10
, _crState = defaultState
, _crHP = 300
}
& crType . skinUpper .~ light4 red
& crType . humanoidAI .~ LauncherAI
src/Dodge/Creature/LtAutoCrit.hs
+16 -16
View File
@@ -1,21 +1,21 @@
module Dodge.Creature.LtAutoCrit
( ltAutoCrit
) where
import Dodge.Data
module Dodge.Creature.LtAutoCrit (
ltAutoCrit,
) where
import Control.Lens
import Dodge.Data.Creature
import Dodge.Default
import Dodge.Item.Weapon.BulletGuns
import Dodge.Item.Consumable
import Dodge.Item.Held.Stick
import qualified IntMapHelp as IM
import Picture
import qualified IntMapHelp as IM
import Control.Lens
ltAutoCrit :: Creature
ltAutoCrit = defaultCreature
{ _crInv = IM.fromList [(0,autoPistol),(1,medkit 100)]
, _crRad = 10
, _crHP = 500
}
& crType . humanoidAI .~ LtAutoAI
& crType . skinUpper .~ light4 red
ltAutoCrit =
defaultCreature
{ _crInv = IM.fromList [(0, autoPistol), (1, medkit 100)]
, _crRad = 10
, _crHP = 500
}
& crType . humanoidAI .~ LtAutoAI
& crType . skinUpper .~ light4 red
src/Dodge/Creature/Perception.hs
+110 -95
View File
@@ -1,98 +1,106 @@
--{-# LANGUAGE TupleSections #-}
module Dodge.Creature.Perception
( perceptionUpdate
, chaseCritPerceptionUpdate
-- , newSounds
) where
import Dodge.Data
import Dodge.FloatFunction
import Dodge.Creature.Vocalization
import Dodge.Base.Collide
import RandomHelp
--import Dodge.SoundLogic
import Geometry.Vector
--import Geometry.Data
import Geometry.Data
import Sound.Data
--import StrictHelp
module Dodge.Creature.Perception (
perceptionUpdate,
chaseCritPerceptionUpdate,
) where
import Data.Maybe
import Control.Lens
import qualified IntMapHelp as IM
import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Base.Collide
import Dodge.Creature.Vocalization
import Dodge.Data.World
import Dodge.FloatFunction
import Geometry.Data
import Geometry.Vector
import qualified IntMapHelp as IM
import RandomHelp
import Sound.Data
perceptionUpdate
:: [Int] -- ^ List of creature ids that may direct attention and awareness
-> World
-> Creature
-> Creature
perceptionUpdate ::
-- | List of creature ids that may direct attention and awareness
[Int] ->
World ->
Creature ->
Creature
perceptionUpdate is w = rememberSounds w . basicAwarenessUpdate . basicAttentionUpdate is w
chaseCritPerceptionUpdate :: [Int] -> World -> Creature -> Creature
chaseCritPerceptionUpdate is w =
chaseCritPerceptionUpdate is w =
rememberSounds w . chaseCritAwarenessUpdate w . basicAttentionUpdate is w
{- | Update a creatures awareness based upon the creatures' current direction
of attention -} -- TODO delete?
of attention
-} -- TODO delete?
basicAwarenessUpdate :: Creature -> Creature
basicAwarenessUpdate cr = case _cpAttention $ _crPerception cr of
Fixated i -> cr & crPerception . cpAwareness
%~ (IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
AttentiveTo is -> cr
& crPerception . cpAwareness
%~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
& maybeBark
Fixated i ->
cr & crPerception . cpAwareness
%~ (IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
AttentiveTo is ->
cr
& crPerception . cpAwareness
%~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
& maybeBark
where
oldAwareness = _cpAwareness $ _crPerception cr
newAwareness = (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) oldAwareness
becomesCognizant = any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness
thejitter = RandImpulseCircMove 1
--do
--p <- randInCirc 1
--return $ Move p
thejitter = RandImpulseCircMove 1
--do
--p <- randInCirc 1
--return $ Move p
maybeBark
| becomesCognizant = case vocalizationTest cr of
Just sid -> crActionPlan . apAction .~
[ImpulsesList
[[Bark sid]
,[RandomImpulse thejitter]
,[RandomImpulse thejitter]
,[RandomImpulse thejitter]
,[RandomImpulse thejitter]
,[RandomImpulse thejitter]
]
]
Just sid ->
crActionPlan . apAction
.~ [ ImpulsesList
[ [Bark sid]
, [RandomImpulse thejitter]
, [RandomImpulse thejitter]
, [RandomImpulse thejitter]
, [RandomImpulse thejitter]
, [RandomImpulse thejitter]
]
]
Nothing -> id
| otherwise = id
-- TODO fold in randgen update, requires that this is a world to world function
chaseCritAwarenessUpdate :: World -> Creature -> Creature
chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
Fixated i -> cr & crPerception . cpAwareness
%~ (IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
AttentiveTo is -> cr
& crPerception . cpAwareness
%~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
& maybeBark
Fixated i ->
cr & crPerception . cpAwareness
%~ (IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
AttentiveTo is ->
cr
& crPerception . cpAwareness
%~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
& maybeBark
where
oldAwareness = _cpAwareness $ _crPerception cr
newAwareness = (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) oldAwareness
becomesCognizant = any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness
--randBool = takeOne [False,True] & evalState $ _randGen w
thejitter = RandImpulseCircMove 2
thejitter = RandImpulseCircMove 2
-- do
-- p <- randInCirc 2
-- return $ Move p
maybeBark
| becomesCognizant -- && randBool
&& cr ^? crVocalization . vcCoolDown == Just 0
= let soundid = evalState (takeOne (_vcWarnings (_crVocalization cr))) (_randGen w)
numjits = fst $ randomR (15,25) (_randGen w)
in crActionPlan . apStrategy .~ StrategyActions WarningCry
[ImpulsesList ([Bark soundid]: replicate numjits [RandomImpulse thejitter]++
[[ChangeStrategy $ CloseToMelee 0] ])
, AimAt 0 (_crPos $ _creatures (_cWorld w) IM.! 0)
]
| becomesCognizant -- && randBool
&& cr ^? crVocalization . vcCoolDown == Just 0 =
let soundid = evalState (takeOne (_vcWarnings (_crVocalization cr))) (_randGen w)
numjits = fst $ randomR (15, 25) (_randGen w)
in crActionPlan . apStrategy
.~ StrategyActions
WarningCry
[ ImpulsesList
( [Bark soundid] :
replicate numjits [RandomImpulse thejitter]
++ [[ChangeStrategy $ CloseToMelee 0]]
)
, AimAt 0 (_crPos $ _creatures (_cWorld w) IM.! 0)
]
| otherwise = id
cogRaised :: Awareness -> Awareness -> Awareness
@@ -100,19 +108,18 @@ cogRaised Suspicious{} Cognizant{} = Cognizant 100
cogRaised _ _ = Suspicious 0
isCognizant :: Awareness -> Bool
isCognizant Cognizant {} = True
isCognizant Cognizant{} = True
isCognizant _ = False
combineAwareness :: Awareness -> Awareness -> Awareness
combineAwareness (Suspicious x) (Suspicious y)
combineAwareness (Suspicious x) (Suspicious y)
| x + y < 5000 = Suspicious $ x + y
| otherwise = Cognizant 1000
| otherwise = Cognizant 1000
combineAwareness (Suspicious x) (Cognizant y) = Cognizant $ min 10000 $ x + y
combineAwareness (Cognizant x) (Suspicious y) = Cognizant $ min 10000 $ x + y
combineAwareness (Cognizant x) (Cognizant y) = Cognizant $ min 10000 $ x + y
combineAwareness (Cognizant x) (Cognizant y) = Cognizant $ min 10000 $ x + y
{- | Decrease awareness level. Returns 'Maybe' value for use with 'IM.mapMaybe'
-}
-- | Decrease awareness level. Returns 'Maybe' value for use with 'IM.mapMaybe'
decreaseAwareness :: Awareness -> Maybe Awareness
decreaseAwareness (Suspicious 0) = Nothing
decreaseAwareness (Suspicious x) = Just $ Suspicious (x - 50)
@@ -120,20 +127,25 @@ decreaseAwareness (Cognizant 0) = Just $ Suspicious 1000
decreaseAwareness (Cognizant x) = Just $ Cognizant $ x - 50
{- | Given a fixed group of creatures, direct attention to those of them that
- are in view. -}
basicAttentionUpdate
:: [Int] -- ^ Creatures that may attract this creature's attention
-> World
-> Creature
-> Creature
basicAttentionUpdate cids w cr = cr & crPerception . cpAttention .~
AttentiveTo (IM.mapMaybe (newExtraAwareness cr w) $ IM.fromList $ zip cids cids)
- are in view.
-}
basicAttentionUpdate ::
-- | Creatures that may attract this creature's attention
[Int] ->
World ->
Creature ->
Creature
basicAttentionUpdate cids w cr =
cr & crPerception . cpAttention
.~ AttentiveTo (IM.mapMaybe (newExtraAwareness cr w) $ IM.fromList $ zip cids cids)
newExtraAwareness
:: Creature -- ^ source creature
-> World
-> Int -- ^ target creature id
-> Maybe Awareness
newExtraAwareness ::
-- | source creature
Creature ->
World ->
-- | target creature id
Int ->
Maybe Awareness
newExtraAwareness cr w cid
| not $ canSeeIndirect (_crID cr) cid w = Nothing
| otherwise = Just . Suspicious $ doFloatFloat (_viFOV vi) ang * doFloatFloat (_viDist vi) d * awakeLevelPerception cr
@@ -141,18 +153,18 @@ newExtraAwareness cr w cid
vi = _cpVision $ _crPerception cr
tpos = _crPos $ _creatures (_cWorld w) IM.! cid
cpos = _crPos cr
ang = angleVV (unitVectorAtAngle (_crDir cr)) (tpos - cpos)
ang = angleVV (unitVectorAtAngle (_crDir cr)) (tpos - cpos)
d = dist tpos cpos
awakeLevelPerception :: Creature -> Float
awakeLevelPerception cr = case _cpVigilance $ _crPerception cr of
Comatose -> 0
Asleep -> 10
Lethargic -> 200
Vigilant -> 500
Overstrung -> 10000
Comatose -> 0
Asleep -> 10
Lethargic -> 200
Vigilant -> 500
Overstrung -> 10000
newSounds :: World -> [(Point2,Float)]
newSounds :: World -> [(Point2, Float)]
newSounds = mapMaybe f . M.elems . _playingSounds
where
f s = case _playStatus $ _soundStatus s of
@@ -160,18 +172,21 @@ newSounds = mapMaybe f . M.elems . _playingSounds
_ -> Nothing
rememberSounds :: World -> Creature -> Creature
rememberSounds w cr = cr
& crMemory . soundsToInvestigate .~ closesounds
& awakeupdate
rememberSounds w cr =
cr
& crMemory . soundsToInvestigate .~ closesounds
& awakeupdate
where
awakeupdate | null closesounds = id
awakeupdate
| null closesounds = id
| otherwise = crPerception . cpVigilance .~ Vigilant
closesounds = map fst (filter (soundIsClose w cr) (newSounds w))
-- TODO work out correct form for sounds passing through walls
soundIsClose :: World -> Creature -> (Point2,Float) -> Bool
soundIsClose w cr (pos,vol) = dist cpos pos < 2000
&& vol > doFloatFloat (_auDist . _cpAudition $ _crPerception cr) (dist pos cpos)
&& hasLOS cpos pos w
soundIsClose :: World -> Creature -> (Point2, Float) -> Bool
soundIsClose w cr (pos, vol) =
dist cpos pos < 2000
&& vol > doFloatFloat (_auDist . _cpAudition $ _crPerception cr) (dist pos cpos)
&& hasLOS cpos pos w
where
cpos = _crPos cr
src/Dodge/Creature/Picture.hs
+121 -99
View File
@@ -1,56 +1,59 @@
--{-# LANGUAGE TupleSections #-}
{- |
Drawing of creatures.
Takes into account damage etc. -}
module Dodge.Creature.Picture
( basicCrPict
, drawCrEquipment
, circLine
, picAtCrPos
, shapeAtCrPos
, picAtCrPosNoRot
-- , basicCrCorpse
, deadScalp
, deadUpperBody
, deadFeet
) where
import Dodge.Data
import Dodge.Creature.HandPos (translateToRightHand,translateToLeftHand)
import Dodge.Creature.Test
import Dodge.Damage
import Dodge.Item.Draw
import Picture
import Geometry
import Shape
import ShapePicture
import qualified Quaternion as Q
Drawing of creatures.
Takes into account damage etc.
-}
module Dodge.Creature.Picture (
basicCrPict,
drawCrEquipment,
circLine,
picAtCrPos,
shapeAtCrPos,
picAtCrPosNoRot,
deadScalp,
deadUpperBody,
deadFeet,
) where
import Control.Lens
import Dodge.Creature.HandPos (translateToLeftHand, translateToRightHand)
import Dodge.Creature.Test
import Dodge.Damage
import Dodge.Data.Creature
import Dodge.Item.Draw
import Geometry
import Picture
import qualified Quaternion as Q
import Shape
import ShapePicture
basicCrPict :: Creature -> SPic
basicCrPict cr = drawCrEquipment cr <> (basicCrShape cr , mempty)
basicCrPict cr = drawCrEquipment cr <> (basicCrShape cr, mempty)
drawCrEquipment :: Creature -> SPic
drawCrEquipment cr = uncurryV translateSPf (_crPos cr) (rotateSP (_crDir cr) $ drawEquipment cr)
shapeAtCrPos :: Shape -> Creature -> SPic
shapeAtCrPos sh cr =
shapeAtCrPos sh cr =
( uncurryV translateSHf (_crPos cr) $ rotateSH (_crDir cr) sh
, mempty
)
basicCrShape
:: Creature
-> Shape
basicCrShape cr
basicCrShape ::
Creature ->
Shape
basicCrShape cr
| _crCamouflage cr == Invisible = mempty
| otherwise = tr . scaleSH (V3 crsize crsize crsize) $ mconcat
[ --rotdir . _spShape $ drawEquipment cr
rotdir . colorSH (_skinHead cskin) . translateSHz 20 $ scalp cr
, rotdir $ colorSH (_skinUpper cskin) $ upperBody cr
, rotmdir $ colorSH (_skinLower cskin) $ feet cr
]
where
| otherwise =
tr . scaleSH (V3 crsize crsize crsize) $
mconcat
[ --rotdir . _spShape $ drawEquipment cr
rotdir . colorSH (_skinHead cskin) . translateSHz 20 $ scalp cr
, rotdir $ colorSH (_skinUpper cskin) $ upperBody cr
, rotmdir $ colorSH (_skinLower cskin) $ feet cr
]
where
cskin = _crType cr
crsize = 0.1 * _crRad cr
tr = uncurryV translateSHf (_crPos cr)
@@ -79,18 +82,21 @@ basicCrShape cr
feet :: Creature -> Shape
{-# INLINE feet #-}
feet cr = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> mconcat
[ translateSHf ( f sa) off aFoot
, translateSHf (-f sa) (-off) aFoot
]
Just (Walking sa RightForward) -> mconcat
[ translateSHf (-f sa) off aFoot
, translateSHf ( f sa) (-off) aFoot
]
_ -> mconcat
[ translateSHf 0 off aFoot
, translateSHf 0 (-off) aFoot
]
Just (Walking sa LeftForward) ->
mconcat
[ translateSHf (f sa) off aFoot
, translateSHf (- f sa) (- off) aFoot
]
Just (Walking sa RightForward) ->
mconcat
[ translateSHf (- f sa) off aFoot
, translateSHf (f sa) (- off) aFoot
]
_ ->
mconcat
[ translateSHf 0 off aFoot
, translateSHf 0 (- off) aFoot
]
where
aFoot :: Shape
aFoot = upperPrismPoly 10 $ polyCirc 3 4
@@ -101,18 +107,21 @@ feet cr = case cr ^? crStance . carriage of
deadFeet :: Creature -> Shape
{-# INLINE deadFeet #-}
deadFeet cr = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> mconcat
[ translateSHf ( f sa) off aFoot
, translateSHf (-f sa) (-off) aFoot
]
Just (Walking sa RightForward) -> mconcat
[ translateSHf (-f sa) off aFoot
, translateSHf ( f sa) (-off) aFoot
]
_ -> mconcat
[ translateSHf 0 off aFoot
, translateSHf 0 (-off) aFoot
]
Just (Walking sa LeftForward) ->
mconcat
[ translateSHf (f sa) off aFoot
, translateSHf (- f sa) (- off) aFoot
]
Just (Walking sa RightForward) ->
mconcat
[ translateSHf (- f sa) off aFoot
, translateSHf (f sa) (- off) aFoot
]
_ ->
mconcat
[ translateSHf 0 off aFoot
, translateSHf 0 (- off) aFoot
]
where
aFoot :: Shape
aFoot = upperPrismPoly 3 $ polyCirc 3 4
@@ -122,23 +131,27 @@ deadFeet cr = case cr ^? crStance . carriage of
arms :: Creature -> Shape
{-# INLINE arms #-}
arms cr = fst $ translateToRightHand cr aHand
<> translateToLeftHand cr aHand
--arms cr
-- | oneH cr = shoulderSH . translateSHf 11 (-3) . rotateSH (-0.5) $ scaleSH (V3 1 1.5 1) aHand
-- | twists cr = shoulderSH . translateSHf 0 5 . rotateSH (-1) $ mconcat
-- [ translateSHf 12 4 aHand
-- , translateSHf 4 (-10) aHand
-- ]
-- | twoFlat cr = waistSH $ translateSHf 4 8 aHand
-- <> translateSHf 4 (-8) aHand
-- | otherwise = case cr ^? crStance . carriage of
-- Just (Walking sa LeftForward) -> waistSH $ translateSHf (-f sa) (-off) aHand
-- Just (Walking sa RightForward) -> waistSH $ translateSHf (-f sa) off aHand
-- _ -> emptySH
arms cr =
fst $
translateToRightHand cr aHand
<> translateToLeftHand cr aHand
where
--arms cr
-- | oneH cr = shoulderSH . translateSHf 11 (-3) . rotateSH (-0.5) $ scaleSH (V3 1 1.5 1) aHand
-- | twists cr = shoulderSH . translateSHf 0 5 . rotateSH (-1) $ mconcat
-- [ translateSHf 12 4 aHand
-- , translateSHf 4 (-10) aHand
-- ]
-- | twoFlat cr = waistSH $ translateSHf 4 8 aHand
-- <> translateSHf 4 (-8) aHand
-- | otherwise = case cr ^? crStance . carriage of
-- Just (Walking sa LeftForward) -> waistSH $ translateSHf (-f sa) (-off) aHand
-- Just (Walking sa RightForward) -> waistSH $ translateSHf (-f sa) off aHand
-- _ -> emptySH
aHand :: SPic
aHand = noPic $ translateSHz (-4) . upperPrismPolyHalf 4 $ polyCirc 3 4
-- off = 8
-- sLen = _strideLength $ _crStance cr
-- f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
@@ -149,14 +162,17 @@ deadScalp cr = deadRot cr . translateSHz 10 . scalp $ cr
deadRot :: Creature -> Shape -> Shape
deadRot cr = overPosSH (Q.rotateToZ d)
where
d = maybe (V3 1 0 0) (addZ 0 . unitVectorAtAngle . subtract (_crDir cr+pi))
(damageDirection . _csDamage $ _crState cr)
d =
maybe
(V3 1 0 0)
(addZ 0 . unitVectorAtAngle . subtract (_crDir cr + pi))
(damageDirection . _csDamage $ _crState cr)
scalp :: Creature -> Shape
{-# INLINE scalp #-}
scalp cr
| twists cr = translateSHf 0 5 . rotateSH (-1) $ translateSHf (negate 2.5) 0.25 fhead
| oneH cr = rotateSH 0.5 $ translateSHf 2.5 0 fhead
| oneH cr = rotateSH 0.5 $ translateSHf 2.5 0 fhead
| otherwise = translateSHf 2.5 0 fhead
where
fhead = colorSH (greyN 0.9) . upperPrismPolyHalf 5 $ polyCirc 4 5
@@ -168,19 +184,24 @@ scalp cr
torso :: Creature -> Shape
{-# INLINE torso #-}
torso cr
| oneH cr = rotateSH 0.5 $ mconcat
[ translateSHf 0 3 . rotateSH (negate 0.2) $ aShoulder
, translateSHf 0 (negate 3) . rotateSH 0.2 $ aShoulder
]
| twists cr = translateSHf 0 5 . rotateSH (-1) $ mconcat
[ rotateSH (negate 0.2) . translateSHf 2 3 . rotateSH (negate 0.4) $ aShoulder
, rotateSH (negate 0.2) . translateSHf 0 (negate 3) . rotateSH 0.2 $ aShoulder
]
| otherwise = mconcat
[ translateSHf 0 3 . rotateSH (negate 0.2) $ aShoulder
, translateSHf 0 (negate 3) . rotateSH 0.2 $ aShoulder
]
torso cr
| oneH cr =
rotateSH 0.5 $
mconcat
[ translateSHf 0 3 . rotateSH (negate 0.2) $ aShoulder
, translateSHf 0 (negate 3) . rotateSH 0.2 $ aShoulder
]
| twists cr =
translateSHf 0 5 . rotateSH (-1) $
mconcat
[ rotateSH (negate 0.2) . translateSHf 2 3 . rotateSH (negate 0.4) $ aShoulder
, rotateSH (negate 0.2) . translateSHf 0 (negate 3) . rotateSH 0.2 $ aShoulder
]
| otherwise =
mconcat
[ translateSHf 0 3 . rotateSH (negate 0.2) $ aShoulder
, translateSHf 0 (negate 3) . rotateSH 0.2 $ aShoulder
]
where
--aShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . upperPrismPoly 10 $ polyCirc 3 crad
aShoulder = scaleSH (V3 10 10 1) baseShoulder
@@ -195,17 +216,18 @@ baseShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalf 10
upperBody :: Creature -> Shape
{-# INLINE upperBody #-}
--upperBody col cr = colorSH (light4 col) $ mconcat
upperBody cr = mconcat
[ arms cr
, shoulderSH $ torso cr
]
upperBody cr =
mconcat
[ arms cr
, shoulderSH $ torso cr
]
shoulderSH :: Shape -> Shape
shoulderSH = translateSHz 20
--waistSH :: Shape -> Shape
--waistSH = translateSHz 10
--drawAwakeLevel
-- :: Creature
-- -> Picture
@@ -218,12 +240,13 @@ shoulderSH = translateSHz 20
drawEquipment :: Creature -> SPic
{-# INLINE drawEquipment #-}
drawEquipment cr = foldMap (itemEquipPict cr) (_crInv cr)
--drawEquipment cr = foldMap f (_crInv cr)
-- where
-- where
-- f itm = _itEquipPict itm cr itm
circLine :: Float -> Picture
circLine x = line [V2 0 0,V2 x 0]
circLine x = line [V2 0 0, V2 x 0]
picAtCrPos :: Picture -> Creature -> SPic
--{-# INLINE picAtCrPos #-}
@@ -232,4 +255,3 @@ picAtCrPos thePic cr = (,) emptySH $ tranRot (_crPos cr) (_crDir cr) thePic
picAtCrPosNoRot :: Picture -> Creature -> SPic
--{-# INLINE picAtCrPos #-}
picAtCrPosNoRot thePic cr = (,) emptySH $ uncurryV translate (_crPos cr) thePic
src/Dodge/Creature/Picture/Awareness.hs
+25 -20
View File
@@ -1,25 +1,30 @@
module Dodge.Creature.Picture.Awareness where
import Dodge.Data
import Dodge.Clock
import Picture
import Geometry
import qualified Data.Vector as V
import Dodge.Clock
import Dodge.Data.World
import Geometry
import Picture
creatureDisplayText :: World -> Creature -> Picture
creatureDisplayText w cr = setLayer DebugLayer
. setDepth 20
. translate x y
. color white
. rotate (0.5 * pi)
-- . rotate (argV v - 0.5 * pi)
. scale theScale theScale
. stackText
$ clockCycle 25 (V.fromList
[ \cr' -> [crDisplayVigilance cr']
, \cr' -> [crDisplayAwareness cr']
]
) w cr
creatureDisplayText w cr =
setLayer DebugLayer
. setDepth 20
. translate x y
. color white
. rotate (0.5 * pi)
-- . rotate (argV v - 0.5 * pi)
. scale theScale theScale
. stackText
$ clockCycle
25
( V.fromList
[ \cr' -> [crDisplayVigilance cr']
, \cr' -> [crDisplayAwareness cr']
]
)
w
cr
where
campos = _cameraViewFrom (_cWorld w)
theScale = 0.15 / _cameraZoom (_cWorld w)
@@ -30,12 +35,12 @@ creatureDisplayText w cr = setLayer DebugLayer
crDisplayAwareness :: Creature -> String
crDisplayAwareness cr
| isSuspicious = "?"
| isCognizant = "!"
| otherwise = "."
| isCognizant = "!"
| otherwise = "."
where
imAwarenesses = _cpAwareness (_crPerception cr)
isSuspicious = any f imAwarenesses && not (null imAwarenesses)
isCognizant = any g imAwarenesses && not (null imAwarenesses)
isCognizant = any g imAwarenesses && not (null imAwarenesses)
f (Suspicious _) = True
f _ = False
g (Cognizant _) = True
src/Dodge/Creature/PistolCrit.hs
+16 -18
View File
@@ -1,23 +1,21 @@
module Dodge.Creature.PistolCrit
( pistolCrit
) where
import Dodge.Data
module Dodge.Creature.PistolCrit (
pistolCrit,
) where
import Control.Lens
import Dodge.Data.Creature
import Dodge.Default
import Dodge.Item.Weapon.BulletGuns
import Dodge.Item.Consumable
import Dodge.Item.Held.Stick
import qualified IntMapHelp as IM
import Picture
import qualified IntMapHelp as IM
import Control.Lens
pistolCrit :: Creature
pistolCrit = defaultCreature
{ _crInv = IM.fromList [(0,pistol),(1,medkit 100)]
, _crRad = 10
, _crHP = 500
}
& crType . humanoidAI .~ PistolAI
& crType . skinUpper .~ light4 red
pistolCrit =
defaultCreature
{ _crInv = IM.fromList [(0, pistol), (1, medkit 100)]
, _crRad = 10
, _crHP = 500
}
& crType . humanoidAI .~ PistolAI
& crType . skinUpper .~ light4 red
src/Dodge/Creature/ReaderUpdate.hs
+113 -91
View File
@@ -1,31 +1,32 @@
{- | Functions updating a creature in a Reader World environment -}
module Dodge.Creature.ReaderUpdate
( doStrategyActions
, setTargetMv
, targetYouWhenCognizant
, overrideMeleeCloseTarget
, watchUpdateStrat
, reloadOverride
, overrideInternal
, searchIfDamaged
, goToTarget
, flockACC
, chaseCritMv
, setMvPos
, setViewPos
) where
-- | Functions updating a creature in a Reader World environment
module Dodge.Creature.ReaderUpdate (
doStrategyActions,
setTargetMv,
targetYouWhenCognizant,
overrideMeleeCloseTarget,
watchUpdateStrat,
reloadOverride,
overrideInternal,
searchIfDamaged,
goToTarget,
flockACC,
chaseCritMv,
setMvPos,
setViewPos,
) where
import Control.Applicative
import Control.Lens
import Data.Bifunctor
import Data.Maybe
import Dodge.Base
import Dodge.Creature.Volition
import Dodge.Data.CreatureEffect
import Dodge.Data.World
import Dodge.Zoning.Creature
import FoldableHelp
import Dodge.Data
import Dodge.Creature.Volition
import Dodge.Base
import Geometry
import qualified IntMapHelp as IM
import Control.Lens
import Control.Applicative
import Data.Maybe
import Data.Bifunctor
overrideMeleeCloseTarget :: Creature -> Creature
overrideMeleeCloseTarget cr = maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr)
@@ -33,9 +34,9 @@ overrideMeleeCloseTarget cr = maybe cr (tryMeleeAttack cr) (_targetCr $ _crInten
tryMeleeAttack :: Creature -> Creature -> Creature
tryMeleeAttack cr tcr
| _crMeleeCooldown cr == 0
&& dist (_crPos tcr) cpos < _crRad cr + _crRad tcr + 5
&& abs (_crDir cr - argV (_crPos tcr -.- cpos)) < pi/4
= cr & crActionPlan . apImpulse .~ [Melee $ _crID tcr]
&& dist (_crPos tcr) cpos < _crRad cr + _crRad tcr + 5
&& abs (_crDir cr - argV (_crPos tcr -.- cpos)) < pi / 4 =
cr & crActionPlan . apImpulse .~ [Melee $ _crID tcr]
| otherwise = cr
where
cpos = _crPos cr
@@ -49,8 +50,10 @@ setMvPos w cr = cr & crIntention . mvToPoint .~ mpos
if hasLOSIndirect (_crPos cr) tpos w
then Just tpos
else Nothing
mpos = mtpos
<|> _mvToPoint int
mpos =
mtpos
<|> _mvToPoint int
-- <|> listToMaybe (_soundsToInvestigate $ _crMemory cr)
setViewPos :: Creature -> Creature
@@ -58,44 +61,54 @@ setViewPos cr = cr & crIntention . viewPoint %~ (<|> mpos)
where
mpos = listToMaybe (_soundsToInvestigate $ _crMemory cr)
setTargetMv :: (World -> Creature -> Maybe Creature) -- ^ Function for determining target
-> World -> Creature -> Creature
setTargetMv targFunc w cr = maybe
cr
(\ctarg -> cr & crIntention . mvToPoint ?~ _crPos ctarg)
(targFunc w cr)
setTargetMv ::
-- | Function for determining target
(World -> Creature -> Maybe Creature) ->
World ->
Creature ->
Creature
setTargetMv targFunc w cr =
maybe
cr
(\ctarg -> cr & crIntention . mvToPoint ?~ _crPos ctarg)
(targFunc w cr)
-- ugly
flockACC :: World -> Creature -> Creature
flockACC w cr = case cr ^? crIntention . targetCr . _Just of
Nothing -> cr
Just tcr ->
Just tcr ->
let tpos = _crPos tcr
cpos = _crPos cr
isFarACC cr' = _crGroup cr' == _crGroup cr
&& _crID cr' /= _crID cr
&& dist (_crPos cr') tpos > dist cpos tpos
macr = safeMinimumOn (dist cpos . _crPos)
. filter isFarACC
$ crsNearCirc cpos 50 w
in case macr of
Nothing -> cr
isFarACC cr' =
_crGroup cr' == _crGroup cr
&& _crID cr' /= _crID cr
&& dist (_crPos cr') tpos > dist cpos tpos
macr =
safeMinimumOn (dist cpos . _crPos)
. filter isFarACC
$ crsNearCirc cpos 50 w
in case macr of
Nothing -> cr
Just acr ->
let r = _crRad acr + _crRad cr + 10
horDir = normalizeV (vNormal (cpos -.- tpos))
horShift = if isLHS tpos cpos (_crPos acr)
then r *.* horDir
else negate r *.* horDir
in cr & crIntention . mvToPoint ?~ tpos +.+ horShift
horShift =
if isLHS tpos cpos (_crPos acr)
then r *.* horDir
else negate r *.* horDir
in cr & crIntention . mvToPoint ?~ tpos +.+ horShift
chaseCritMv :: World -> Creature -> Creature
chaseCritMv w cr = case _apStrategy (_crActionPlan cr) of
StrategyActions _ _ -> cr
WarningCry -> cr
_ -> case cr ^? crIntention . mvToPoint . _Just of
Just p | dist (_crPos cr) p > _crRad cr -> cr & crActionPlan . apAction .~ [PathTo p]
| otherwise -> cr & crActionPlan . apAction .~ [bfsThenReturn 500]
& crIntention . mvToPoint .~ Nothing
Just p
| dist (_crPos cr) p > _crRad cr -> cr & crActionPlan . apAction .~ [PathTo p]
| otherwise ->
cr & crActionPlan . apAction .~ [bfsThenReturn 500]
& crIntention . mvToPoint .~ Nothing
_ -> viewTarget w cr
goToTarget :: World -> Creature -> Creature
@@ -105,45 +118,51 @@ goToTarget w cr =
_ -> viewTarget w cr
lookAroundSelf :: Action
lookAroundSelf = UseSelf CrTurnAround -- $ \cr -> TurnToPoint (_crPos cr -.- 10 *.* unitVectorAtAngle (_crDir cr))
lookAroundSelf = UseSelf CrTurnAround
viewTarget :: World -> Creature -> Creature
viewTarget w cr = do
case cr ^? crIntention . viewPoint . _Just of
Just p | hasLOSIndirect p (_crPos cr) w -> cr'
& crActionPlan . apAction %~ replaceNullWith
(TurnToPoint p
`DoActionThen` 40 `WaitThen` lookAroundSelf
`DoActionThen` 20 `WaitThen` lookAroundSelf
)
Just p
| hasLOSIndirect p (_crPos cr) w ->
cr'
& crActionPlan . apAction
%~ replaceNullWith
( TurnToPoint p
`DoActionThen` 40 `WaitThen` lookAroundSelf
`DoActionThen` 20 `WaitThen` lookAroundSelf
)
& crIntention . viewPoint .~ Nothing
| otherwise -> cr' & crActionPlan . apAction %~ replaceNullWith (PathTo p)
Nothing -> cr-- & crPerception . crAwakeLevel .~ Lethargic
| otherwise -> cr' & crActionPlan . apAction %~ replaceNullWith (PathTo p)
Nothing -> cr -- & crPerception . crAwakeLevel .~ Lethargic
where
cr' = cr & crPerception . cpVigilance .~ Vigilant
replaceNullWith :: a -> [a] -> [a]
replaceNullWith x [] = [x]
replaceNullWith _ xs = xs
doStrategyActions :: Creature -> Creature
doStrategyActions cr = case cr ^? crActionPlan . apStrategy of
Just (StrategyActions strat acs) -> cr
& crActionPlan . apAction .~ acs
& crActionPlan . apStrategy .~ strat
Just (StrategyActions strat acs) ->
cr
& crActionPlan . apAction .~ acs
& crActionPlan . apStrategy .~ strat
_ -> cr
reloadOverride :: Creature -> Creature
reloadOverride cr
| cr ^? crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded == Just 0
&& cr ^. crStance . posture == Aiming
= cr & crActionPlan . apStrategy .~ StrategyActions Reload reloadActions
| cr ^? crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded == Just 0
&& cr ^. crStance . posture == Aiming =
cr & crActionPlan . apStrategy .~ StrategyActions Reload reloadActions
| otherwise = cr
where
reloadActions =
reloadActions =
[ holsterWeapon
, 1 `WaitThen`
DoActionWhileInterrupt NoAction (WdCrBlfromCrBl CrIsReloading)
, 1
`WaitThen` DoActionWhileInterrupt
NoAction
(WdCrBlfromCrBl CrIsReloading)
(DoImpulses [ChangeStrategy WatchAndWait])
]
@@ -152,42 +171,47 @@ overrideInternal test update cr
| test cr = update cr
| otherwise = cr
watchUpdateStrat
:: [ (World -> Creature -> Bool, World -> Creature -> Strategy) ]
-> World
-> Creature
-> Creature
watchUpdateStrat ::
[(World -> Creature -> Bool, World -> Creature -> Strategy)] ->
World ->
Creature ->
Creature
watchUpdateStrat fs w cr = case cr ^? crActionPlan . apStrategy of
Just WatchAndWait -> cr
& crActionPlan . apStrategy .~ listGuard (map (first uncurry) fs, \_ _ -> WatchAndWait) (w, cr) w cr
Just WatchAndWait ->
cr
& crActionPlan . apStrategy .~ listGuard (map (first uncurry) fs, \_ _ -> WatchAndWait) (w, cr) w cr
_ -> cr
listGuard :: ([(a -> Bool, b)] , b) -> a -> b
listGuard ( (test,y):ps, z ) x
listGuard :: ([(a -> Bool, b)], b) -> a -> b
listGuard ((test, y) : ps, z) x
| test x = y
| otherwise = listGuard (ps, z) x
listGuard (_,z) _ = z
listGuard (_, z) _ = z
targetYouWhenCognizant :: World -> Creature -> Creature
targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of
-- so this caused a space leak: be careful with ?~
-- consider changing targeted creature to be just an index
Just (Cognizant _) -> _creatures (_cWorld w) IM.! 0 `seq` cr & crIntention . targetCr ?~ _creatures (_cWorld w) IM.! 0
_ -> cr & crIntention . targetCr .~ Nothing
-- so this caused a space leak: be careful with ?~
-- consider changing targeted creature to be just an index
Just (Cognizant _) -> _creatures (_cWorld w) IM.! 0 `seq` cr & crIntention . targetCr ?~ _creatures (_cWorld w) IM.! 0
_ -> cr & crIntention . targetCr .~ Nothing
searchIfDamaged :: Creature -> Creature
searchIfDamaged cr
| _crPastDamage cr > 0 = case _apStrategy (_crActionPlan cr) of
WatchAndWait -> cr & crPerception . cpVigilance .~ Vigilant
& crActionPlan . apStrategy .~ StrategyActions LookAround
[TurnToPoint (_crPos cr -.- unitVectorAtAngle (_crDir cr))
`DoActionThen` 40 `WaitThen` bfsThenReturn 500
]
WatchAndWait ->
cr & crPerception . cpVigilance .~ Vigilant
& crActionPlan . apStrategy
.~ StrategyActions
LookAround
[ TurnToPoint (_crPos cr -.- unitVectorAtAngle (_crDir cr))
`DoActionThen` 40 `WaitThen` bfsThenReturn 500
]
_ -> cr
| otherwise = cr
bfsThenReturn :: Int -> Action
bfsThenReturn t = ArbitraryAction (CrWdBFSThenReturn t)
-- theaction
-- where
-- theaction cr w = fromMaybe NoAction $ do
@@ -195,5 +219,3 @@ bfsThenReturn t = ArbitraryAction (CrWdBFSThenReturn t)
-- let as = take 20 $ map PathTo $ bfsNodePoints n w
-- return $ DoReplicate t $
-- foldr DoActionThen NoAction as
src/Dodge/Creature/SentinelAI.hs
+86 -73
View File
@@ -1,39 +1,44 @@
module Dodge.Creature.SentinelAI
( sentinelAI
, sentinelFireType
, sentinelExtraWatchUpdate
) where
import Dodge.Data
module Dodge.Creature.SentinelAI (
sentinelAI,
sentinelFireType,
sentinelExtraWatchUpdate,
) where
import Control.Lens
import Data.Maybe
import Dodge.Creature.Action
import Dodge.Creature.ChainUpdates
import Dodge.Creature.Test
import Dodge.Creature.Volition
import Dodge.Creature.Perception
import Dodge.Creature.ReaderUpdate
import Dodge.Creature.Strategy
import Dodge.Creature.Action
import Dodge.Creature.Perception
import Dodge.Creature.Test
import Dodge.Creature.Volition
import Dodge.Data.CreatureEffect
import Dodge.Data.World
import Geometry.Data
import Data.Maybe
import Control.Lens
sentinelAI :: World -> Creature -> Creature
sentinelAI w = reloadOverride .
sentinelExtraWatchUpdate
[ (crHasTargetLOS
, \ _ cr -> StrategyActions (ShootAt (fromJust $ tcid cr))
[ DoActionIf
(WdCrNegate $ WdCrBlfromCrBl CrIsAiming)
(drawWeapon `DoActionThen` (50 `WaitThen` NoAction))
`DoActionThen` lostest
`DoActionWhile` advanceShoot
`DoActionThen` 75
`DoReplicate` advanceShoot
`DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
, AimAt { _targetID = fromJust $ tcid cr , _targetSeenAt = V2 0 0 }
]
)
]
w
sentinelAI w =
reloadOverride
. sentinelExtraWatchUpdate
[
( crHasTargetLOS
, \_ cr ->
StrategyActions
(ShootAt (fromJust $ tcid cr))
[ DoActionIf
(WdCrNegate $ WdCrBlfromCrBl CrIsAiming)
(drawWeapon `DoActionThen` (50 `WaitThen` NoAction))
`DoActionThen` lostest
`DoActionWhile` advanceShoot
`DoActionThen` 75
`DoReplicate` advanceShoot
`DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
, AimAt{_targetID = fromJust $ tcid cr, _targetSeenAt = V2 0 0}
]
)
]
w
where
advanceShoot = DoImpulses [UseItem, MoveForward 3]
tcid cr = _crID <$> _targetCr (_crIntention cr)
@@ -42,50 +47,58 @@ sentinelAI w = reloadOverride .
--chainCreatureUpdates :: [World -> Creature -> Creature] -> World -> Creature -> Creature
--chainCreatureUpdates ls w cr = foldr (\f -> f w) cr ls
sentinelFireType :: (Int -> Action) -> World -> Creature -> Creature
sentinelFireType f = chainCreatureUpdates
[ performActions
, watchUpdateStrat
[ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0)
[ drawwp `DoActionThen` f 0 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
, aiming
sentinelFireType f =
chainCreatureUpdates
[ performActions
, watchUpdateStrat
[
( crHasTargetLOS
, \_ _ ->
StrategyActions
(ShootAt 0)
[ drawwp `DoActionThen` f 0 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
, aiming
]
)
, (const crAwayFromPost, const goToPostStrat)
]
)
, (const crAwayFromPost, const goToPostStrat)
]
, perceptionUpdate [0]
-- , Left $ perceptionUp 0
, const doStrategyActions
, const reloadOverride
, targetYouWhenCognizant
, const $ overrideInternal
(\cr -> crHasTarget cr && crStratConMatches (GetTo (V2 0 0)) cr)
(crActionPlan . apStrategy .~ WatchAndWait)
]
, perceptionUpdate [0]
, -- , Left $ perceptionUp 0
const doStrategyActions
, const reloadOverride
, targetYouWhenCognizant
, const $
overrideInternal
(\cr -> crHasTarget cr && crStratConMatches (GetTo (V2 0 0)) cr)
(crActionPlan . apStrategy .~ WatchAndWait)
]
where
drawwp = DoActionIfElse NoAction (WdCrBlfromCrBl CrIsAiming) (DoActionThen drawWeapon (WaitThen 50 NoAction))
aiming = AimAt
{ _targetID = 0
, _targetSeenAt = V2 0 0 -- hack
}
aiming =
AimAt
{ _targetID = 0
, _targetSeenAt = V2 0 0 -- hack
}
sentinelExtraWatchUpdate
:: [(World -> Creature -> Bool , World -> Creature -> Strategy)]
-> World
-> Creature
-> Creature
sentinelExtraWatchUpdate xs = chainCreatureUpdates
[ performActions
, watchUpdateStrat
( xs ++ [(const crAwayFromPost, const goToPostStrat)] )
, perceptionUpdate [0]
, const doStrategyActions
, targetYouWhenCognizant
, const $ overrideInternal
(\cr -> crHasTarget cr && crStratConMatches (GetTo (V2 0 0)) cr)
(crActionPlan . apStrategy .~ WatchAndWait)
]
sentinelExtraWatchUpdate ::
[(World -> Creature -> Bool, World -> Creature -> Strategy)] ->
World ->
Creature ->
Creature
sentinelExtraWatchUpdate xs =
chainCreatureUpdates
[ performActions
, watchUpdateStrat
(xs ++ [(const crAwayFromPost, const goToPostStrat)])
, perceptionUpdate [0]
, const doStrategyActions
, targetYouWhenCognizant
, const $
overrideInternal
(\cr -> crHasTarget cr && crStratConMatches (GetTo (V2 0 0)) cr)
(crActionPlan . apStrategy .~ WatchAndWait)
]
--shootAtAdvance :: Int -> [Action]
--shootAtAdvance tcid =
@@ -93,7 +106,7 @@ sentinelExtraWatchUpdate xs = chainCreatureUpdates
-- `DoActionThen`
-- lostest `DoActionWhile`
-- advanceShoot `DoActionThen`
-- 75 `DoReplicate`
-- 75 `DoReplicate`
-- advanceShoot `DoActionThen`
-- DoImpulses [ChangeStrategy WatchAndWait]
-- , AimAt
@@ -102,7 +115,7 @@ sentinelExtraWatchUpdate xs = chainCreatureUpdates
-- }
-- ]
-- where
-- lostest (w,cr') = canSee (_crID cr') tcid w
-- lostest (w,cr') = canSee (_crID cr') tcid w
-- advanceShoot = ImpulsesList [[UseItem, MoveForward 3]]
--
--shootAtWhileContinueTime :: Int -> World -> Creature -> Strategy
@@ -111,7 +124,7 @@ sentinelExtraWatchUpdate xs = chainCreatureUpdates
-- `DoActionThen`
-- lostest `DoActionWhile`
-- advanceShoot `DoActionThen`
-- 75 `DoReplicate`
-- 75 `DoReplicate`
-- advanceShoot `DoActionThen`
-- DoImpulses [ChangeStrategy WatchAndWait]
-- , AimAt
@@ -120,5 +133,5 @@ sentinelExtraWatchUpdate xs = chainCreatureUpdates
-- }
-- ]
-- where
-- lostest (w,cr') = canSee (_crID cr') tcid w
-- lostest (w,cr') = canSee (_crID cr') tcid w
-- advanceShoot = ImpulsesList [[UseItem, MoveForward 3]]
src/Dodge/Creature/SetTarget.hs
+10 -10
View File
@@ -1,15 +1,15 @@
{- | Deals with setting a target for creatures -}
-- | Deals with setting a target for creatures
module Dodge.Creature.SetTarget where
import Dodge.Data
import Control.Lens
import Dodge.Data.World
import qualified IntMapHelp as IM
{- | Assumes that you are id 0: if creature is cognizant of you, sets you as target -}
targetYouWhenCognizant
:: World
-> Creature
-> Creature
targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of
Just (Cognizant _) -> cr & crIntention . targetCr ?~ _creatures (_cWorld w) IM.! 0
_ -> cr & crIntention . targetCr .~ Nothing
-- | Assumes that you are id 0: if creature is cognizant of you, sets you as target
targetYouWhenCognizant ::
World ->
Creature ->
Creature
targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of
Just (Cognizant _) -> cr & crIntention . targetCr ?~ _creatures (_cWorld w) IM.! 0
_ -> cr & crIntention . targetCr .~ Nothing
src/Dodge/Creature/SpreadGunCrit.hs
+16 -16
View File
@@ -1,21 +1,21 @@
module Dodge.Creature.SpreadGunCrit
( spreadGunCrit
) where
import Dodge.Data
module Dodge.Creature.SpreadGunCrit (
spreadGunCrit,
) where
import Control.Lens
import Dodge.Data.Creature
import Dodge.Default
import Dodge.Item.Weapon.BulletGuns
import Dodge.Item.Consumable
import Dodge.Item.Held.Stick
import qualified IntMapHelp as IM
import Picture
import qualified IntMapHelp as IM
import Control.Lens
spreadGunCrit :: Creature
spreadGunCrit = defaultCreature
{ _crInv = IM.fromList [(0,bangStick 6),(1,medkit 100)]
, _crRad = 10
, _crHP = 500
}
& crType . humanoidAI .~ SpreadGunAI
& crType . skinUpper .~ light4 red
spreadGunCrit =
defaultCreature
{ _crInv = IM.fromList [(0, bangStick 6), (1, medkit 100)]
, _crRad = 10
, _crHP = 500
}
& crType . humanoidAI .~ SpreadGunAI
& crType . skinUpper .~ light4 red
src/Dodge/Creature/State.hs
+188 -146
View File
@@ -1,124 +1,143 @@
module Dodge.Creature.State
( stateUpdate
, doDamage
) where
import Dodge.Corpse.Make
import Dodge.Data
import Dodge.Targeting
import Dodge.ItEffect
import Dodge.Euse
import Dodge.EnergyBall
import Dodge.Damage
import Dodge.Hammer
import Dodge.Reloading
import Dodge.Prop.Gib
module Dodge.Creature.State (
stateUpdate,
doDamage,
) where
import Dodge.Base
import Dodge.Creature.State.WalkCycle
import Dodge.Creature.Impulse.Movement
import Dodge.Creature.Damage
import Dodge.LightSource.Torch
import Dodge.SoundLogic
import RandomHelp
import Dodge.Corpse.Make
import Dodge.Creature.Action
import Dodge.Creature.Damage
import Dodge.Creature.Impulse.Movement
import Dodge.Creature.State.WalkCycle
import Dodge.Damage
import Dodge.Data.World
import Dodge.EnergyBall
import Dodge.Euse
import Dodge.Hammer
import Dodge.ItEffect
import Dodge.LightSource.Torch
import Dodge.Prop.Gib
import Dodge.Reloading
import Dodge.SoundLogic
import Dodge.Targeting
import Geometry
import Picture
import Shape
import ShapePicture
import qualified IntMapHelp as IM
import LensHelp
import Picture
import RandomHelp
import Shape
import ShapePicture
foldCr :: [Creature -> World -> World]
-> Creature -> World -> World
foldCr ::
[Creature -> World -> World] ->
Creature ->
World ->
World
--foldCr xs cr w = foldr ($ cr) w xs
foldCr xs cr w = foldr f w xs
where
f g w' = case w' ^? cWorld . creatures . ix (_crID cr) of
Just cr' -> g cr' w'
Nothing -> w'
Nothing -> w'
-- | this seems to work, but I am not sure about the ordering:
-- previously, the movement was updated before the ai in order to correctly set the oldpos.
-- This should be made more sensible: should the movement side effects apply to
-- the creature before or after it has moved?
-- at what point invSideEffects is applied wrt to when the creature moves
-- may affect whether the shield moves correctly
{- | this seems to work, but I am not sure about the ordering:
previously, the movement was updated before the ai in order to correctly set the oldpos.
This should be made more sensible: should the movement side effects apply to
the creature before or after it has moved?
at what point invSideEffects is applied wrt to when the creature moves
may affect whether the shield moves correctly
-}
stateUpdate :: (Creature -> World -> World) -> Creature -> World -> World
stateUpdate f = foldCr
[ equipmentEffects
, invSideEff
, upInv -- upInv must be called before invSideEff 22.05.23
, movementSideEff
, f
, internalUpdate
, clearDamage -- these three
, checkDeath -- must be in
, doDamage -- this order 22/06/05
]
stateUpdate f =
foldCr
[ equipmentEffects
, invSideEff
, upInv -- upInv must be called before invSideEff 22.05.23
, movementSideEff
, f
, internalUpdate
, clearDamage -- these three
, checkDeath -- must be in
, doDamage -- this order 22/06/05
]
checkDeath :: Creature -> World -> World
checkDeath cr w
| _crHP cr > 0 = w
| otherwise = w
-- & creatures . at (_crID cr) .~ Nothing
& dropByState cr
& removecr
& stopSoundFrom (CrWeaponSound (_crID cr) 0)
& corpseOrGib cr
| otherwise =
w
-- & creatures . at (_crID cr) .~ Nothing
& dropByState cr
& removecr
& stopSoundFrom (CrWeaponSound (_crID cr) 0)
& corpseOrGib cr
where
removecr
| _crID cr == 0 = (cWorld . creatures . ix (_crID cr) . crType .~ NonDrawnCreature)
. (cWorld . creatures . ix (_crID cr) . crHP .~ 0)
-- hack to get around player creature being killed but left with more than 0 hp
| otherwise = cWorld . creatures . at (_crID cr) .~ Nothing
| _crID cr == 0 =
(cWorld . creatures . ix (_crID cr) . crType .~ NonDrawnCreature)
. (cWorld . creatures . ix (_crID cr) . crHP .~ 0)
-- hack to get around player creature being killed but left with more than 0 hp
| otherwise = cWorld . creatures . at (_crID cr) .~ Nothing
corpseOrGib :: Creature -> World -> World
corpseOrGib cr w = case maxDamageType (_csDamage (_crState cr)) of
Just (FLAMING,_) -> w & plNew (cWorld . corpses) cpID (thecorpse & cpSPic %~ scorchSPic)
Just (ELECTRICAL,_) -> w & plNew (cWorld . corpses) cpID thecorpse
Just (POISONDAM,_) -> w & plNew (cWorld . corpses) cpID (thecorpse & cpSPic %~ poisonSPic)
_ | _crPastDamage cr > 200 -> w & addCrGibs cr
& bloodPuddleAt cpos
& bloodPuddleAt cpos
& bloodPuddleAt cpos
_ -> w
& bloodPuddleAt cpos
& bloodPuddleAt cpos
& plNew (cWorld . corpses) cpID thecorpse
Just (FLAMING, _) -> w & plNew (cWorld . corpses) cpID (thecorpse & cpSPic %~ scorchSPic)
Just (ELECTRICAL, _) -> w & plNew (cWorld . corpses) cpID thecorpse
Just (POISONDAM, _) -> w & plNew (cWorld . corpses) cpID (thecorpse & cpSPic %~ poisonSPic)
_
| _crPastDamage cr > 200 ->
w & addCrGibs cr
& bloodPuddleAt cpos
& bloodPuddleAt cpos
& bloodPuddleAt cpos
_ ->
w
& bloodPuddleAt cpos
& bloodPuddleAt cpos
& plNew (cWorld . corpses) cpID thecorpse
where
cpos = _crPos cr
thecorpse = makeDefaultCorpse cr
scorchSPic :: SPic -> SPic
scorchSPic = over _1 $
overColSH (mixColors 0.9 0.1 black . normalizeColor)
scorchSPic =
over _1 $
overColSH (mixColors 0.9 0.1 black . normalizeColor)
poisonSPic :: SPic -> SPic
poisonSPic = over _1 $
overColSH (mixColors 0.5 0.5 green . normalizeColor)
poisonSPic =
over _1 $
overColSH (mixColors 0.5 0.5 green . normalizeColor)
--scorchSPic :: World -> SPic -> SPic
--scorchSPic w sp = evalState (scorchSPic' sp) (_randGen w)
--
--scorchSPic' :: SPic -> State StdGen SPic
--scorchSPic' = _1 $ overColSHM $ \col -> takeOne [col,black]
---- (return . mixColorsLinear 0.9 0.1 black)
---- (return . mixColorsLinear 0.9 0.1 black)
bloodPuddleAt :: Point2 -> World -> World
bloodPuddleAt p w = w
& snd . plNewID (cWorld . decorations)
(color (dark $ dark red) . setDepth 01 . uncurryV translate (p +.+ q) $ circleSolid 10)
& randGen .~ g
bloodPuddleAt p w =
w
& snd
. plNewID
(cWorld . decorations)
(color (dark $ dark red) . setDepth 01 . uncurryV translate (p +.+ q) $ circleSolid 10)
& randGen .~ g
where
(q,g) = randInCirc 10 & runState $ _randGen w
(q, g) = randInCirc 10 & runState $ _randGen w
internalUpdate :: Creature -> World -> World
internalUpdate cr = cWorld . creatures . ix (_crID cr) %~
( (crHammerPosition %~ moveHammerUp)
. stepReloading
. updateMovement
)
internalUpdate cr =
cWorld . creatures . ix (_crID cr)
%~ ( (crHammerPosition %~ moveHammerUp)
. stepReloading
. updateMovement
)
-- | Drop items according to the creature state.
-- TODO make sure this doesn't mess up any ItemPosition
{- | Drop items according to the creature state.
TODO make sure this doesn't mess up any ItemPosition
-}
dropByState :: Creature -> World -> World
dropByState cr w = foldr (dropItem cr) w $ case cr ^. crState . csDropsOnDeath of
DropAll -> IM.keys $ _crInv cr
@@ -126,79 +145,91 @@ dropByState cr w = foldr (dropItem cr) w $ case cr ^. crState . csDropsOnDeath o
DropAmount n -> take n $ evalState (shuffle $ IM.keys $ _crInv cr) (_randGen w)
clearDamage :: Creature -> World -> World
clearDamage cr w = w
& cWorld . creatures . ix (_crID cr) . crState . csDamage .~ []
clearDamage cr w =
w
& cWorld . creatures . ix (_crID cr) . crState . csDamage .~ []
doDamage :: Creature -> World -> World
doDamage cr w = w
& applyPastDamages cr
& applyCreatureDamage dams cr
where
doDamage cr w =
w
& applyPastDamages cr
& applyCreatureDamage dams cr
where
dams = _csDamage $ _crState cr
-- TODO generalise shake to arbitrary damage amounts
applyPastDamages :: Creature -> World -> World
applyPastDamages cr w
| _crPastDamage cr > 200 = let (p,g) = runState (randInCirc 3) (_randGen w)
in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 100))
& randGen .~ g
| _crPastDamage cr > 20 = let (p,g) = runState (randInCirc 2) (_randGen w)
in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 10))
& randGen .~ g
| _crPastDamage cr > 0 = let (p,g) = runState (randInCirc 1) (_randGen w)
in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 1))
& randGen .~ g
| _crPastDamage cr > 200 =
let (p, g) = runState (randInCirc 3) (_randGen w)
in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 100))
& randGen .~ g
| _crPastDamage cr > 20 =
let (p, g) = runState (randInCirc 2) (_randGen w)
in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 10))
& randGen .~ g
| _crPastDamage cr > 0 =
let (p, g) = runState (randInCirc 1) (_randGen w)
in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 1))
& randGen .~ g
| otherwise = w
movementSideEff :: Creature -> World -> World
movementSideEff cr w
| hasJetPack = case cr ^? crStance . carriage of
Just (Boosting v) -> w
& randGen .~ g
& makeFlamelet
(oldPos +.+ (_crRad cr + 3) *.* unitVectorAtAngle (_crDir cr + pi))
20
(momentum +.+ 1 *.* rotateV randDir (vInverse v))
1
20
_ -> w
Just (Boosting v) ->
w
& randGen .~ g
& makeFlamelet
(oldPos +.+ (_crRad cr + 3) *.* unitVectorAtAngle (_crDir cr + pi))
20
(momentum +.+ 1 *.* rotateV randDir (vInverse v))
1
20
_ -> w
| otherwise = footstepSideEffect cr w
where
where
hasJetPack = any (\it -> it ^? itType . iyBase == Just (EQUIP JETPACK)) $ _crInv cr
oldPos = _crOldPos cr
momentum' = 0.97 *.* (_crPos cr -.- _crOldPos cr)
momentum'' | magV momentum' > 3 = 3 *.* normalizeV momentum'
| otherwise = momentum'
momentum''
| magV momentum' > 3 = 3 *.* normalizeV momentum'
| otherwise = momentum'
momentum = momentum'' +.+ 0.01 *.* unitVectorAtAngle randAng
(randDir,g) = randomR (-0.5,0.5) $ _randGen w
(randAng,_) = randomR (0,2*pi) $ _randGen w
(randDir, g) = randomR (-0.5, 0.5) $ _randGen w
(randAng, _) = randomR (0, 2 * pi) $ _randGen w
useUpdate :: ItemUse -> ItemUse
useUpdate = (useHammer %~ moveHammerUp)
. (useDelay . warmTime %~ decreaseToZero)
. (useDelay . rateTime %~ decreaseToZero)
useUpdate =
(heldHammer %~ moveHammerUp)
. (heldDelay . warmTime %~ decreaseToZero)
. (heldDelay . rateTime %~ decreaseToZero)
useEquipment :: Creature -> Int -> World -> World
useEquipment cr i = useE (_eqUse (_eqEq $ _itUse itm)) itm cr
useEquipment cr i = useE (_eeUse (_equipEffect $ _itUse itm)) itm cr
where
itm = _crInv cr IM.! i
-- a map updating all inventory items
upInv :: Creature -> World -> World
upInv cr = cWorld . creatures . ix (_crID cr) . crInv %~ IM.mapWithKey (itemUpdate cr)
-- a loop going over equipped items
equipmentEffects :: Creature -> World -> World
equipmentEffects cr = flip (foldr $ useEquipment cr) (IM.keys $ _crInvEquipped cr)
-- a loop going over all inventory items
invSideEff :: Creature -> World -> World
invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr)
where
f i it w' = itemInvSideEffect cr it
$ doItemTargeting i cr w' & maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
where
f i it w' =
itemInvSideEffect cr it $
doItemTargeting i cr w' & maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
itemInvSideEffect :: Creature -> Item -> World -> World
itemInvSideEffect cr it
| hastorchattach = createAttachLight cr it
| otherwise = id
| otherwise = id
where
hastorchattach = it ^? itType . iyModules . ix ModHeldAttach == Just ATTACHTORCH && _itIsHeld it
@@ -210,57 +241,68 @@ createAttachLight cr it = createTorchLightOffset cr it attachoff
itemUpdate :: Creature -> Int -> Item -> Item
itemUpdate cr i
| i == crSel cr = baseupdate True
| otherwise = baseupdate False
| otherwise = baseupdate False
where
baseupdate bool = updateAutoRecharge . (itUse %~ useUpdate)
. (itLocation .~ InInv (_crID cr) i)
. (itIsHeld .~ bool)
baseupdate bool =
updateAutoRecharge . (itUse %~ useUpdate)
. (itLocation .~ InInv (_crID cr) i)
. (itIsHeld .~ bool)
updateAutoRecharge :: Item -> Item
updateAutoRecharge it = case it ^? itUse . leftConsumption of
Just (AutoRecharging l m t p)
| l < m && p <= 0 -> it & itUse . leftConsumption .~ AutoRecharging (l+1) m t t
| l < m && p <= 0 -> it & itUse . leftConsumption .~ AutoRecharging (l + 1) m t t
| l < m -> it & itUse . leftConsumption . arProgress -~ 1
_ -> it
doItemTargeting :: Int -> Creature -> World -> World
doItemTargeting invid cr w = case cr ^? crInv . ix invid . itTargeting of
Nothing -> w
Just NoTargeting -> w
Just t -> let (w',t') = updateTargeting (_tgUpdate t) (_crInv cr IM.! invid) cr w t
in w' & cWorld . creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ t'
Just t ->
let (w', t') = updateTargeting (_tgUpdate t) (_crInv cr IM.! invid) cr w t
in w' & cWorld . creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ t'
weaponReloadSounds :: Creature -> World -> World
weaponReloadSounds cr w = case cr ^? crInvSel . iselAction of
Just ReloadAction{_reloadAction = la} -> soundContinue
(CrReloadSound cid) (_crPos cr) (_actionSound la) (Just 1) w
Just ReloadAction{_reloadAction = la} ->
soundContinue
(CrReloadSound cid)
(_crPos cr)
(_actionSound la)
(Just 1)
w
_ -> w
-- PassiveReload stype | Just (_laReloadTime am) == am ^? laTransfer . transferTime
-- -> soundContinue (CrReloadSound 0) (_crPos cr) stype Nothing w
-- PassiveReload _ -> w
-- ActiveClear | am ^? laTransfer . transferTime == Just 0 -> stopSoundFrom (CrReloadSound cid) w
-- ActiveClear | _laTransfer am == NoTransfer -> w
-- ActiveClear -> soundContinue (CrReloadSound cid) (_crPos cr) reloadS (Just 1) w
-- ActivePartial{} | am ^? laTransfer . transferTime == Just 0 -> stopSoundFrom (CrReloadSound cid) w
-- ActivePartial{} | _laTransfer am == NoTransfer -> w
-- ActivePartial{} -> soundContinue (CrReloadSound cid) (_crPos cr) reloadS (Just 1) w
-- Just ChargeableAmmo {} -> w
-- Just NoConsumption {} -> w
-- Just ItemItselfConsumable {} -> w
-- Nothing -> w
where
where
-- PassiveReload stype | Just (_laReloadTime am) == am ^? laTransfer . transferTime
-- -> soundContinue (CrReloadSound 0) (_crPos cr) stype Nothing w
-- PassiveReload _ -> w
-- ActiveClear | am ^? laTransfer . transferTime == Just 0 -> stopSoundFrom (CrReloadSound cid) w
-- ActiveClear | _laTransfer am == NoTransfer -> w
-- ActiveClear -> soundContinue (CrReloadSound cid) (_crPos cr) reloadS (Just 1) w
-- ActivePartial{} | am ^? laTransfer . transferTime == Just 0 -> stopSoundFrom (CrReloadSound cid) w
-- ActivePartial{} | _laTransfer am == NoTransfer -> w
-- ActivePartial{} -> soundContinue (CrReloadSound cid) (_crPos cr) reloadS (Just 1) w
-- Just ChargeableAmmo {} -> w
-- Just NoConsumption {} -> w
-- Just ItemItselfConsumable {} -> w
-- Nothing -> w
cid = _crID cr
updateMovement :: Creature -> Creature
updateMovement cr
updateMovement cr
| isFrictionless cr = over crPos (+.+ momentum) cr
| otherwise = updateWalkCycle cr
where
momentum' = 0.98 *.* (_crPos cr -.- _crOldPos cr)
momentum'' | magV momentum' > 1 = 1 *.* normalizeV momentum'
| otherwise = momentum'
momentum''
| magV momentum' > 1 = 1 *.* normalizeV momentum'
| otherwise = momentum'
momentum = momentum''
isFrictionless :: Creature -> Bool
isFrictionless cr = case cr ^? crStance . carriage of
Just (Boosting _) -> True
Just Floating -> True
_ -> False
Just Floating -> True
_ -> False
src/Dodge/Creature/State/WalkCycle.hs
+8 -9
View File
@@ -1,15 +1,14 @@
module Dodge.Creature.State.WalkCycle
( updateWalkCycle
, footstepSideEffect
)
where
import Dodge.Data
module Dodge.Creature.State.WalkCycle (
updateWalkCycle,
footstepSideEffect,
) where
import Control.Lens
import Dodge.Data.World
import Dodge.SoundLogic
import Geometry.Data
import Sound.Data
import Control.Lens
updateWalkCycle :: Creature -> Creature
updateWalkCycle cr = case cr ^? crStance . carriage of
Just (Walking x ff) | x > maxStride -> cr & crStance . carriage .~ Walking 0 (normalGait ff)
@@ -35,7 +34,7 @@ makeFootstepSound currentStride maxStride ff p
| currentStride > maxStride = soundMultiFrom footor p (chooseFootSound ff) Nothing
| otherwise = id
where
footor = [FootstepSound 0,FootstepSound 1]
footor = [FootstepSound 0, FootstepSound 1]
chooseFootSound :: FootForward -> SoundID
chooseFootSound LeftForward = foot1S
src/Dodge/Creature/Statistics.hs
+2 -3
View File
@@ -3,11 +3,10 @@ module Dodge.Creature.Statistics (
getCrDexterity,
) where
--import Data.Strict.IntMap.Autogen.Merge.Strict
import Data.IntMap.Merge.Strict
import Data.Maybe
import Dodge.Creature.Test
import Dodge.Data
import Dodge.Data.Creature
import qualified IntMapHelp as IM
import LensHelp
@@ -38,5 +37,5 @@ crCurrentEquipment cr =
strFromHeldItem :: Creature -> Int
strFromHeldItem cr
| _posture (_crStance cr) == Aiming || crIsReloading cr =
negate $ fromMaybe 0 $ cr ^? crInv . ix (crSel cr) . itUse . useAim . aimWeight
negate $ fromMaybe 0 $ cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimWeight
| otherwise = 0
src/Dodge/Creature/Strategy.hs
+17 -15
View File
@@ -1,25 +1,27 @@
module Dodge.Creature.Strategy
( goToPostStrat
)
where
import Dodge.Data
import Dodge.Creature.Test
import Dodge.Creature.Volition
module Dodge.Creature.Strategy (
goToPostStrat,
) where
import Data.List
import Dodge.Creature.Test
import Dodge.Creature.Volition
import Dodge.Data.Creature
goToPostStrat :: Creature -> Strategy
goToPostStrat cr = case find sentinelGoal $ _apGoal $ _crActionPlan cr of
Just (SentinelAt p _) -> StrategyActions (GetTo p)
[DoActionThen (WaitThen 150 holsterIfAiming)
$ DoActionThen (PathTo p)
NoAction
-- $ DoImpulses [ChangeStrategy WatchAndWait]
]
Just (SentinelAt p _) ->
StrategyActions
(GetTo p)
[ DoActionThen (WaitThen 150 holsterIfAiming) $
DoActionThen
(PathTo p)
NoAction
-- $ DoImpulses [ChangeStrategy WatchAndWait]
]
_ -> WatchAndWait
where
sentinelGoal (SentinelAt _ _) = True
sentinelGoal _ = False
holsterIfAiming
holsterIfAiming
| crIsAiming cr = holsterWeapon
| otherwise = NoAction
| otherwise = NoAction
src/Dodge/Creature/SwarmCrit.hs
+19 -20
View File
@@ -1,29 +1,28 @@
module Dodge.Creature.SwarmCrit
( swarmCrit
) where
import Dodge.Data
module Dodge.Creature.SwarmCrit (
swarmCrit,
) where
import Control.Lens
import Dodge.Data.Creature
import Dodge.Default
import Picture
import Control.Lens
swarmCrit :: Creature
swarmCrit = defaultCreature
{ _crHP = 1
, _crRad = 2
, _crMass = 2
, _crCorpse = MakeDefaultCorpse
, _crFaction = ColorFaction yellow
, _crMeleeCooldown = 0
}
& crType . skinUpper .~ light4 yellow
& crType . humanoidAI .~ SwarmAI
swarmCrit =
defaultCreature
{ _crHP = 1
, _crRad = 2
, _crMass = 2
, _crCorpse = MakeDefaultCorpse
, _crFaction = ColorFaction yellow
, _crMeleeCooldown = 0
}
& crType . skinUpper .~ light4 yellow
& crType . humanoidAI .~ SwarmAI
--swarmCritMoveFunc :: Creature -> Point2 -> Creature -> Point2
--swarmCritMoveFunc tcr cenp cr
-- | targBehindCrit
--swarmCritMoveFunc tcr cenp cr
-- | targBehindCrit
-- where
-- cpos = _crPos cr
-- ypos = _crPos tcr
src/Dodge/Creature/Test.hs
+39 -38
View File
@@ -1,42 +1,39 @@
{- |
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,
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.Data
import Dodge.Base.Collide
import Geometry
--import SameConstr
module Dodge.Creature.Test (
crIsAiming,
crIsReloading,
crIsArmouredFrom,
oneH,
twists,
twoFlat,
crWeaponReady,
crInAimStance,
crNearPoint,
isAnimate,
crCanShoot,
crHasTargetLOS,
crAwayFromPost,
crHasTarget,
crStratConMatches,
crSafeDistFromTarg,
) where
import Control.Lens
import Data.List (find)
import Data.Maybe
--import qualified IntMapHelp as IM
import Control.Lens
import Dodge.Base.Collide
import Dodge.Data.World
import Geometry
crIsReloading :: Creature -> Bool
crIsReloading cr = case cr ^? crInvSel . iselAction of
Just ReloadAction {} -> True
Just ReloadAction{} -> True
_ -> False
crWeaponReady :: Creature -> Bool
@@ -45,7 +42,7 @@ crWeaponReady cr = fromMaybe False $ do
return (_laLoaded ic > 0 && _laPrimed ic)
crCanSeeCr :: Creature -> (World, Creature) -> Bool
crCanSeeCr tcr (w,cr) = hasLOS (_crPos cr) (_crPos tcr) w
crCanSeeCr tcr (w, cr) = hasLOS (_crPos cr) (_crPos tcr) w
crIsAiming :: Creature -> Bool
crIsAiming cr = _posture (_crStance cr) == Aiming
@@ -55,7 +52,7 @@ 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)
Just i -> crCanSeeCr i (w, cr)
Nothing -> False
crSafeDistFromTarg :: Float -> Creature -> Bool
@@ -65,7 +62,8 @@ crSafeDistFromTarg d cr = case cr ^? crIntention . targetCr . _Just of
crStratConMatches :: Strategy -> Creature -> Bool
crStratConMatches strat cr = strat == _apStrategy (_crActionPlan cr)
-- this equality check might be slow...
-- this equality check might be slow...
crAwayFromPost :: Creature -> Bool
crAwayFromPost cr = case find sentinelGoal . _apGoal $ _crActionPlan cr of
@@ -79,8 +77,9 @@ crCanShoot :: Creature -> Bool
crCanShoot cr = crIsAiming cr && crWeaponReady cr
crInAimStance :: AimStance -> Creature -> Bool
crInAimStance as cr = crIsAiming cr
&& cr ^? crInv . ix (crSel cr) . itUse . useAim . aimStance == Just as
crInAimStance as cr =
crIsAiming cr
&& cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimStance == Just as
oneH :: Creature -> Bool
oneH = crInAimStance OneHand
@@ -101,11 +100,13 @@ hasFrontArmour :: Point2 -> Creature -> Bool
hasFrontArmour p cr = fromMaybe False $ do
invid <- cr ^? crEquipment . ix OnChest
ittype <- cr ^? crInv . ix invid . itType . iyBase
return $ EQUIP FRONTARMOUR == ittype
&& p /= _crOldPos cr
&& angleVV (unitVectorAtAngle (_crDir cr + frontarmdirection)) (p -.- _crOldPos cr) < pi/2
-- even though angleVV can generate NaN, the comparison seems to deal with it
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 TwoHandTwist cr = negate 1
@@ -124,4 +125,4 @@ isAnimate :: Creature -> Bool
{-# INLINE isAnimate #-}
isAnimate cr = case _crActionPlan cr of
Inanimate -> False
_ -> True
_ -> True
src/Dodge/Creature/Update.hs
+19 -16
View File
@@ -1,29 +1,32 @@
module Dodge.Creature.Update where
import Dodge.Data
import Dodge.Creature.State
import Dodge.Creature.Impulse
import Dodge.Creature.ChainUpdates
import Dodge.Lampoid
import Dodge.Humanoid
import Dodge.Turretoid
import Dodge.Barreloid
import LensHelp
import Dodge.Barreloid
import Dodge.Creature.ChainUpdates
import Dodge.Creature.Impulse
import Dodge.Creature.State
import Dodge.Data.World
import Dodge.Humanoid
import Dodge.Lampoid
import Dodge.Turretoid
import LensHelp
import System.Random
updateCreature :: Creature -> World -> World
updateCreature cr = case _crType cr of
Lampoid{} -> updateLampoid cr
Humanoid{} -> updateHumanoid cr
Lampoid{} -> updateLampoid cr
Humanoid{} -> updateHumanoid cr
Turretoid{} -> updateTurretoid cr
Barreloid{} -> updateBarreloid cr
NonDrawnCreature -> id
-- bit of a hack to get new random generators after each creature's update
defaultImpulsive :: [World -> Creature -> Creature]
-> Creature -> World -> World
defaultImpulsive ::
[World -> Creature -> Creature] ->
Creature ->
World ->
World
defaultImpulsive = fmap (fmap updateRandGen) . stateUpdate . impulsiveAIBefore . chainCreatureUpdates
where
updateRandGen w = let (_,g) = randomR (0,1::Int) (_randGen w)
in w & randGen .~ g
updateRandGen w =
let (_, g) = randomR (0, 1 :: Int) (_randGen w)
in w & randGen .~ g
src/Dodge/Creature/Vocalization.hs
+4 -4
View File
@@ -1,15 +1,15 @@
module Dodge.Creature.Vocalization where
import Dodge.Data
import Sound.Data
import Control.Lens
import Dodge.Data.Creature
import Sound.Data
vocalizationTest :: Creature -> Maybe SoundID
vocalizationTest cr = case cr ^? crVocalization . vcCoolDown of
Just 0 -> Just $ _vcSound $ _crVocalization cr
_ -> Nothing
_ -> Nothing
resetCrVocCoolDown :: Creature -> Creature
resetCrVocCoolDown cr = case cr ^? crVocalization . vcMaxCoolDown of
Just i -> cr & crVocalization . vcCoolDown .~ i
Just i -> cr & crVocalization . vcCoolDown .~ i
Nothing -> cr
src/Dodge/Creature/Volition.hs
+19 -18
View File
@@ -1,12 +1,13 @@
{- | Not a good name, perhaps: internal creature actions. -}
module Dodge.Creature.Volition
( holsterWeapon
, drawWeapon
, shootTillEmpty
-- , fleeFrom
, shootFirstMiss
) where
import Dodge.Data
-- | Not a good name, perhaps: internal creature actions.
module Dodge.Creature.Volition (
holsterWeapon,
drawWeapon,
shootTillEmpty,
shootFirstMiss,
) where
import Dodge.Data.Creature
import Dodge.Data.CreatureEffect
import Dodge.SoundLogic.LoadSound
import Geometry
@@ -14,24 +15,24 @@ holsterWeapon, drawWeapon :: Action
holsterWeapon = DoImpulses [ChangePosture AtEase, MakeSound whiteNoiseFadeOutS]
drawWeapon = DoImpulses [ChangePosture Aiming, MakeSound whiteNoiseFadeInS]
shootTillEmpty :: Action
--shootTillEmpty = (crCanShoot `DoActionWhile` DoImpulses [UseItem])
shootTillEmpty = (WdCrBlfromCrBl CrCanShoot `DoActionWhile` DoImpulses [UseItem])
`DoActionThen` 20 `WaitThen` holsterWeapon
shootTillEmpty =
(WdCrBlfromCrBl CrCanShoot `DoActionWhile` DoImpulses [UseItem])
`DoActionThen` 20 `WaitThen` holsterWeapon
--advanceShoot :: Int -> Action
--advanceShoot tcid = lostest `DoActionWhile`
-- advanceShoot' `DoActionThen`
-- 75 `DoReplicate`
-- 75 `DoReplicate`
-- advanceShoot'
-- where
-- lostest (w,cr) = canSee (_crID cr) tcid w
-- lostest (w,cr) = canSee (_crID cr) tcid w
-- advanceShoot' = ImpulsesList [[UseItem, MoveForward 3]]
shootFirstMiss :: Action
shootFirstMiss =
LeadTarget (V2 30 50) `DoActionThen`
DoImpulses [UseItem] `DoActionThen`
(WdCrBlfromCrBl CrCanShoot `DoActionWhile` DoActions [LeadTarget (V2 0 0),DoImpulses [UseItem]])
`DoActionThen` 20 `WaitThen` holsterWeapon
LeadTarget (V2 30 50)
`DoActionThen` DoImpulses [UseItem]
`DoActionThen` (WdCrBlfromCrBl CrCanShoot `DoActionWhile` DoActions [LeadTarget (V2 0 0), DoImpulses [UseItem]])
`DoActionThen` 20 `WaitThen` holsterWeapon
src/Dodge/Creature/YourControl.hs
+42 -38
View File
@@ -1,49 +1,53 @@
module Dodge.Creature.YourControl
( yourControl
) where
import Dodge.Data
import Dodge.LightSource
module Dodge.Creature.YourControl (
yourControl,
) where
import qualified Data.Map.Strict as M
import Dodge.Base.Coordinate
import Dodge.Creature.Impulse.Movement
import Dodge.Creature.Test
import Dodge.Update.UsingInput
import Dodge.Data.World
import Dodge.InputFocus
import Dodge.LightSource
import Dodge.Update.UsingInput
import Geometry
import LensHelp
import qualified SDL
import qualified Data.Map.Strict as M
{- | The AI equivalent for your control. -}
-- | The AI equivalent for your control.
yourControl :: Creature -> World -> World
yourControl cr w
yourControl cr w
| inTermFocus w = dimCreatureLight cr w & updateUsingInput
| otherwise = dimCreatureLight cr w
& cWorld . creatures . ix (_crID cr) %~
(wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons w))
& updateUsingInput
| otherwise =
dimCreatureLight cr w
& cWorld . creatures . ix (_crID cr)
%~ (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons w))
& updateUsingInput
dimCreatureLight :: Creature -> World -> World
dimCreatureLight cr = cWorld . tempLightSources .:~ tlsTimeRadColPos 1 300 0.1 (addZ 100 $ _crPos cr)
-- note the order of operation, setting the posture first--this prevents the twist fire bug
{- | Turn key presses into creature movement. -}
wasdWithAiming
:: World
-> Float -- ^ Base speed
-> Creature
-> Creature
-- | Turn key presses into creature movement.
wasdWithAiming ::
World ->
-- | Base speed
Float ->
Creature ->
Creature
wasdWithAiming w speed cr
| isAiming = addAnyTwist $ set crDir mouseDir $ theMovement cr
| crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons w
= addAnyTwist $ set crDir (mouseDir + anytwist) $ theMovement cr
| isAiming = addAnyTwist $ set crDir mouseDir $ theMovement cr
| crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons w =
addAnyTwist $ set crDir (mouseDir + anytwist) $ theMovement cr
| otherwise = theMovement $ theTurn $ removeTwist cr
where
where
twistamount = 1.6
removeTwist cr' = cr'
& crDir +~ _crTwist cr'
& crTwist .~ 0
anytwist = case cr ^? crInv . ix (crSel cr) . itUse . useAim . aimStance of
removeTwist cr' =
cr'
& crDir +~ _crTwist cr'
& crTwist .~ 0
anytwist = case cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimStance of
Just TwoHandTwist -> twistamount * pi
_ -> 0
addAnyTwist = crTwist .~ anytwist
@@ -53,7 +57,7 @@ wasdWithAiming w speed cr
theTurn cr' = creatureTurnTowardDir (_crMvDir cr') 0.2 cr'
movDir = wasdDir w
dir = _cameraRot (_cWorld w) + argV movDir
movAbs = rotateV (_cameraRot (_cWorld w)) $ normalizeV movDir
movAbs = rotateV (_cameraRot (_cWorld w)) $ normalizeV movDir
isAiming = _posture (_crStance cr) == Aiming
mouseDir = case cr ^? crInv . ix (crSel cr) . itScope . scopePos of
Just _ -> argV $ mouseWorldPos w -.- _crPos cr
@@ -61,20 +65,20 @@ wasdWithAiming w speed cr
wasdM :: SDL.Scancode -> Point2
wasdM scancode = case scancode of
SDL.ScancodeW -> V2 0 1
SDL.ScancodeS -> V2 0 (-1)
SDL.ScancodeD -> V2 1 0
SDL.ScancodeA -> V2 (-1) 0
_ -> V2 0 0
SDL.ScancodeW -> V2 0 1
SDL.ScancodeS -> V2 0 (-1)
SDL.ScancodeD -> V2 1 0
SDL.ScancodeA -> V2 (-1) 0
_ -> V2 0 0
wasdDir :: World -> Point2
wasdDir = foldr ((+.+) . wasdM) (V2 0 0) . _keys
{- | Set posture according to mouse presses. -}
-- | Set posture according to mouse presses.
mouseActionsCr :: M.Map SDL.MouseButton Bool -> Creature -> Creature
mouseActionsCr pkeys cr
| rbPressed && cr ^?! crInvSel . iselAction == NoInvSelAction
= cr & crStance . posture .~ Aiming
| rbPressed && cr ^?! crInvSel . iselAction == NoInvSelAction =
cr & crStance . posture .~ Aiming
| otherwise = cr & crStance . posture .~ AtEase
where
where
rbPressed = SDL.ButtonRight `M.member` pkeys