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

Refactor crPos to be a V3

Browse Source
This commit is contained in:
justin
2025-10-10 13:47:31 +01:00
parent 98ece551c7
commit 49fb982877
58 changed files with 375 additions and 307 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Action.hs
+10 -9
View File
@@ -13,6 +13,7 @@ module Dodge.Creature.Action (
youDropItem,
) where
import Linear
import NewInt
import Dodge.Creature.MoveType
import Dodge.Creature.Radius
@@ -49,13 +50,13 @@ performAimAt :: Creature -> World -> Int -> Point2 -> OutAction
performAimAt cr w tcid p = ([TurnToward tpos aimSp], Just $ AimAt tcid tpos)
where
cdir = _crDir cr
cpos = _crPos cr
cpos = cr ^. crPos . _xy
canSee' = canSee (_crID cr) tcid w
aimSp = case crMvType cr ^? mvAimSpeed of
Just f -> doFloatFloat f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos)
Nothing -> error "creature without aiming type"
tpos
| canSee' = w ^?! cWorld . lWorld . creatures . ix tcid . crPos
| canSee' = w ^?! cWorld . lWorld . creatures . ix tcid . crPos . _xy
| otherwise = p
performPathTo :: Creature -> World -> Point2 -> OutAction
@@ -73,7 +74,7 @@ performPathTo cr w p
)
_ -> ([], Nothing)
where
cpos = _crPos cr
cpos = cr ^. crPos . _xy
jit = _mvTurnJit $ crMvType cr
performTurnToA :: Creature -> Point2 -> OutAction
@@ -81,7 +82,7 @@ performTurnToA cr p
| angleVV cdirv dirv < 0.1 = ([], Nothing)
| otherwise = ([MvTurnToward p, RandomTurn jit], Just (TurnToPoint p))
where
cpos = _crPos cr
cpos = cr ^. crPos . _xy
cdirv = unitVectorAtAngle (_crDir cr)
dirv = p -.- cpos
jit = _mvTurnJit $ crMvType cr
@@ -121,15 +122,15 @@ performAction cr w ac = case ac of
DoActions acs ->
let (imps, newAcs) = unzip $ map (performAction cr w) acs
in (concat imps, Just . DoActions $ catMaybes newAcs)
StartSentinelPost -> ([AddGoal $ SentinelAt (_crPos cr) (_crDir cr)], Nothing)
StartSentinelPost -> ([AddGoal $ SentinelAt (cr ^. crPos . _xy) (_crDir cr)], Nothing)
PathTo p -> performPathTo cr w p
TurnToPoint p -> performTurnToA cr p
LeadTarget p -> case cr ^? crIntention . targetCr . _Just of
Just tcr -> ([TurnTo (_crPos tcr +.+ rotateV (_crDir tcr) p)], Nothing)
Just tcr -> ([TurnTo (tcr ^. crPos . _xy +.+ rotateV (_crDir tcr) p)], Nothing)
_ -> ([], Nothing)
UseTarget f -> performAction cr w $ doMCrAc f $ cr ^? crIntention . targetCr . _Just
UseSelf f -> performAction cr w $ doCrAc f cr
UseAheadPos f -> performAction cr w (doP2Ac f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
UseAheadPos f -> performAction cr w (doP2Ac f (cr ^. crPos . _xy +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
UseMvTargetPos f -> performAction cr w $ doMP2Ac f $ _mvToPoint $ _crIntention cr
ArbitraryAction f -> performAction cr w (doCrWdAc f cr w)
DoImpulsesAlongside sideImp mainAc -> case performAction cr w mainAc of
@@ -175,10 +176,10 @@ dropItem :: Creature -> Int -> World -> World
dropItem cr invid w' =
doanyitemdropeffect
. maybeshiftseldown
. copyItemToFloor (_crPos cr) itm -- . mayberemoveequip
. copyItemToFloor (cr ^. crPos . _xy) itm -- . mayberemoveequip
. rmInvItem (_crID cr) (NInt invid) -- it is important
-- to do this before copying the item to the floor!
. soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
. soundStart (CrSound (_crID cr)) (cr ^. crPos . _xy) whiteNoiseFadeOutS Nothing
$ w'
where
--doanyitemdropeffect = fromMaybe id $ do
src/Dodge/Creature/Action/Blink.hs
+7 -6
View File
@@ -5,6 +5,7 @@ module Dodge.Creature.Action.Blink (
unsafeBlinkAction,
) where
import Linear
import Dodge.Creature.Radius
import Dodge.Zoning.Wall
import Data.Maybe
@@ -25,13 +26,13 @@ blinkActionMousePos cr w =
w
& soundMultiFrom [TeleSound 0, TeleSound 1] p3 teleS Nothing
& blinkDistortions cpos p3
& cWorld . lWorld . creatures . ix cid . crPos .~ p3
& cWorld . lWorld . creatures . ix cid . crPos . _xy .~ p3
& blinkShockwave cid p3
& inverseShockwaveAt (cpos `v2z` 20) 40 2 2
where
cid = _crID cr
p1 = w ^. cWorld . lWorld . lAimPos
cpos = _crPos cr
cpos = cr ^. crPos . _xy
--p2 = bouncePoint (const True) 1 cpos p1 w
p2 = pushIntoMaybe $ collideCircWalls cpos p1 r (wlsNearSeg cpos p1 w)
r = crRad $ cr ^. crType
@@ -61,7 +62,7 @@ unsafeBlinkAction cr w
| success =
soundMultiFrom [TeleSound 0, TeleSound 1] mwp teleS Nothing
. blinkDistortions cpos mwp
. set (cWorld . lWorld . creatures . ix cid . crPos) mwp
. set (cWorld . lWorld . creatures . ix cid . crPos . _xy) mwp
. blinkShockwave cid mwp
$ inverseShockwaveAt (cpos `v2z` 20) 40 2 2 w
| otherwise =
@@ -74,7 +75,7 @@ unsafeBlinkAction cr w
return (isLHS mwp `uncurry` _wlLine wl)
cid = _crID cr
mwp = w ^. cWorld . lWorld . lAimPos
cpos = _crPos cr
cpos = cr ^. crPos . _xy
blinkShockwave ::
-- | Blinking creature ID.
@@ -93,14 +94,14 @@ blinkActionFail cr w =
w
& soundMultiFrom [TeleSound 0, TeleSound 1] p3 teleS Nothing
& cWorld . lWorld . distortions .:~ distortionBulge
& cWorld . lWorld . creatures . ix cid . crPos .~ p3
& cWorld . lWorld . creatures . ix cid . crPos . _xy .~ p3
& inverseShockwaveAt (cpos `v2z` 20) 40 2 2
where
distR = 120
distortionBulge = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9
cid = _crID cr
p1 = w ^. cWorld . lWorld . lAimPos
cpos = _crPos cr
cpos = cr ^. crPos . _xy
p2 = bouncePoint (const True) 1 cpos p1 w
r = 1.5 * crRad (cr ^. crType)
p3 = maybe p1 (mvPointTowardAtSpeed r cpos . fst) p2
src/Dodge/Creature/Boid.hs
+44 -40
View File
@@ -1,5 +1,6 @@
module Dodge.Creature.Boid where
import Linear
import Dodge.Creature.Radius
import Control.Lens
import Control.Monad.Reader
@@ -16,28 +17,28 @@ invertEncircleDistP d tcr cenp cr =
ypos
+.+ d *.* reflectIn (cenp -.- ypos) (squashNormalizeV (cpos -.- cenp))
where
cpos = _crPos cr
ypos = _crPos tcr
cpos = cr ^. crPos . _xy
ypos = tcr ^. crPos . _xy
encircleDistP :: Float -> Creature -> Point2 -> Creature -> Point2
encircleDistP d tcr cenp cr = ypos +.+ d *.* squashNormalizeV (cpos -.- cenp)
where
cpos = _crPos cr
ypos = _crPos tcr
cpos = cr ^. crPos . _xy
ypos = tcr ^. crPos . _xy
encircleP :: Creature -> Point2 -> Creature -> Point2
encircleP tcr cenp cr = ypos +.+ 50 *.* squashNormalizeV (cpos -.- cenp)
where
cpos = _crPos cr
ypos = _crPos tcr
cpos = cr ^. crPos . _xy
ypos = tcr ^. crPos . _xy
--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
cpos = _crPos cr
ypos = _crPos tcr
cpos = cr ^. crPos . _xy
ypos = tcr ^. crPos . _xy
f x = 150 * sigmoid (x -10)
forbidFlee ::
@@ -50,8 +51,8 @@ forbidFlee f tcr cenp cr
| ptargTest = tpos
| otherwise = ptarg
where
cpos = _crPos cr
tpos = _crPos tcr
cpos = cr ^. crPos . _xy
tpos = tcr ^. crPos . _xy
ptarg = f tcr cenp cr
ptargTest = isLHS cpos (cpos +.+ rotateV (negate (pi / 2)) (cpos -.- tpos)) ptarg
@@ -61,8 +62,8 @@ forbidFlee f tcr cenp cr
pincerP :: Creature -> Point2 -> Creature -> Point2
pincerP tcr cenp cr = tpos +.+ splitp -- +.+ 25 *.* (normalizeV $ tpos -.- cenp)
where
cpos = _crPos cr
tpos = _crPos tcr
cpos = cr ^. crPos . _xy
tpos = tcr ^. crPos . _xy
splitp
| isLHS cenp cpos tpos =
150 *.* orthCenpTpos
@@ -75,8 +76,8 @@ pincerP tcr cenp cr = tpos +.+ splitp -- +.+ 25 *.* (normalizeV $ tpos -.- cenp)
pincerP''' :: Creature -> Point2 -> Creature -> Point2
pincerP''' tcr cenp cr = interpWith (sigmoid $ 0.05 * dtcen) cenawayp cenclosep
where
cpos = _crPos cr
tpos = _crPos tcr
cpos = cr ^. crPos . _xy
tpos = tcr ^. crPos . _xy
dtcen = dist tpos cenp
f x = 150 * sigmoid (x -10)
cenawayp
@@ -97,8 +98,8 @@ pincerP' tcr cenp cr
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
cpos = cr ^. crPos . _xy
tpos = tcr ^. crPos . _xy
f x = 150 * sigmoid (x -10)
pincerP'' :: Creature -> Point2 -> Creature -> Point2
@@ -109,8 +110,8 @@ pincerP'' tcr cenp cr
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
cpos = cr ^. crPos . _xy
tpos = tcr ^. crPos . _xy
f x = 150 * sigmoid (x -10)
encircle :: Creature -> IM.IntMap Creature -> Creature -> Point2
@@ -118,17 +119,17 @@ encircle tcr crs cr
| length crs <= 1 = ypos
| otherwise = ypos +.+ f (max 0 (magV (ypos -.- cenp) - 80)) *.* squashNormalizeV (cpos -.- cenp)
where
cpos = _crPos cr
ypos = _crPos tcr
cpos = cr ^. crPos . _xy
ypos = tcr ^. crPos . _xy
f x = 150 * sigmoid (x -10)
cenp = centroid (map _crPos $ IM.elems crs)
cenp = centroid (map (^. crPos . _xy) $ IM.elems crs)
lineOrth :: Creature -> IM.IntMap Creature -> Creature -> Point2
lineOrth tcr crs cr = p
where
ypos = _crPos tcr
cpos = _crPos cr
ps = map _crPos $ IM.elems crs
ypos = tcr ^. crPos . _xy
cpos = cr ^. crPos . _xy
ps = map (^. crPos . _xy) $ IM.elems crs
cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
p
| dist cen ypos < 20 = ypos
@@ -137,10 +138,11 @@ lineOrth tcr crs cr = p
holdForm :: Creature -> IM.IntMap Creature -> Creature -> Point2
holdForm ycr crs cr = p
where
ypos = _crPos ycr
cpos = _crPos cr
ps = map _crPos $ IM.elems crs
cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
ypos = ycr ^. crPos . _xy
cpos = cr ^. crPos . _xy
ps = map (^. crPos . _xy) $ IM.elems crs
cen = centroid ps
--cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
p
| dist cen ypos < 20 = ypos
| otherwise = ypos +.+ cpos -.- cen
@@ -148,20 +150,22 @@ holdForm ycr crs cr = p
lineUp :: Creature -> IM.IntMap Creature -> Creature -> Point2
lineUp ycr crs cr = p
where
ypos = _crPos ycr
cpos = _crPos cr
ps = map _crPos $ IM.elems crs
cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
ypos = ycr ^. crPos . _xy
cpos = cr ^. crPos . _xy
ps = map (^. crPos . _xy) $ IM.elems crs
--cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
cen = centroid ps
p = (0.05 *.* ypos) +.+ (0.95 *.* errorClosestPointOnLine 500 cen ypos cpos)
-- not nice, a kind of encircle
spreadOut :: Creature -> IM.IntMap Creature -> Creature -> Point2
spreadOut ycr crs cr = p
where
ypos = _crPos ycr
cpos = _crPos cr
ps = map _crPos $ IM.elems crs
cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
ypos = ycr ^. crPos . _xy
cpos = cr ^. crPos . _xy
ps = map (^. crPos . _xy) $ IM.elems crs
cen = centroid ps
-- cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
p
| dist cen ypos < 30 = ypos
| otherwise = ypos +.+ (spreadFactor *.* cpos -.- cen)
@@ -307,8 +311,8 @@ meleeHeadingMove maxta minta tacutoff speed tp cr tcr
[MoveForward speed, TurnToward tp maxta, RandomTurn maxta]
| otherwise = [MoveForward speed, TurnToward tp minta, RandomTurn maxta]
where
cpos = _crPos cr
tpos = _crPos tcr
cpos = cr ^. crPos . _xy
tpos = tcr ^. crPos . _xy
combinedRad = crRad (cr ^. crType) + crRad (tcr ^. crType)
mvPointMeleeTarg :: Point2 -> Creature -> Creature -> [Impulse]
@@ -324,6 +328,6 @@ mvPointMeleeTarg p cr crT
[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
cpos = cr ^. crPos . _xy
tpos = crT ^. crPos . _xy
combinedRad = crRad (cr ^. crType) + crRad (crT ^. crType)
src/Dodge/Creature/ChooseTarget.hs
+3 -2
View File
@@ -3,16 +3,17 @@ module Dodge.Creature.ChooseTarget where
import Control.Lens
import Dodge.Base
import Dodge.Data.World
import Linear
targetYouLOS :: Creature -> World -> Maybe Creature
{-# INLINE targetYouLOS #-}
targetYouLOS cr w
| hasLOS (_crPos cr) (_crPos $ you w) w = Just $ you w
| hasLOS (cr ^. crPos . _xy) ( you w ^. crPos . _xy) w = Just $ you w
| otherwise = Nothing
targetYouCognizant :: Creature -> World -> Maybe Creature
targetYouCognizant cr w
| hasLOS (_crPos cr) (_crPos $ you w) w
| hasLOS (cr ^. crPos . _xy) (you w ^. crPos . _xy) w
&& isCog (cr ^? crPerception . cpAwareness . ix 0) =
Just $ you w
| otherwise = Nothing
src/Dodge/Creature/Damage.hs
+3 -2
View File
@@ -1,5 +1,6 @@
module Dodge.Creature.Damage (applyCreatureDamage) where
import Linear
import Dodge.Material.Damage
import Data.List
import Dodge.Creature.Mass
@@ -25,11 +26,11 @@ applyPiercingDamage cr dm w
= f . makeSpark NormalSpark p1 (argV (p1 - p)) $ w
| otherwise = f . damageHP cr (_dmAmount dm) $ w
where
f = cWorld . lWorld . creatures . ix (_crID cr) . crPos +~ _dmVector dm
f = cWorld . lWorld . creatures . ix (_crID cr) . crPos . _xy +~ _dmVector dm
/ V2 x x
x = crMass (_crType cr)
p = _dmPos dm
p1 = p + 2 *.* squashNormalizeV (p - _crPos cr)
p1 = p + 2 *.* squashNormalizeV (p - cr ^. crPos . _xy)
damageHP :: Creature -> Int -> World -> World
damageHP cr x =
src/Dodge/Creature/Impulse.hs
+6 -7
View File
@@ -1,9 +1,8 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Creature.Impulse (
impulsiveAIBefore,
) where
module Dodge.Creature.Impulse (impulsiveAIBefore) where
import Linear
import NewInt
import Dodge.Creature.MoveType
import Data.Foldable
@@ -58,7 +57,7 @@ followImpulse cr w imp = case imp of
, crMvAbsolute (w ^. cWorld . lWorld) (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crType . meleeCooldown .~ 20
)
RandomTurn a -> (randGen .~ snd (rr a), cr & crDir +~ fst (rr a))
MakeSound sid -> (soundStart (CrSound (_crID cr)) (_crPos cr) sid Nothing, cr)
MakeSound sid -> (soundStart (CrSound (_crID cr)) (cr ^. crPos . _xy) sid Nothing, cr)
DropItem -> undefined
ChangeStrategy strat -> crup $ cr & crActionPlan . apStrategy .~ strat
AddGoal gl -> crup $ cr & crActionPlan . apGoal .:~ gl
@@ -71,7 +70,7 @@ followImpulse cr w imp = case imp of
ImpulseUseTarget f -> case cr ^? crIntention . targetCr . _Just of
Just tcr -> followImpulse cr w (doCrImp f tcr)
_ -> crup cr
ImpulseUseAheadPos f -> followImpulse cr w (doP2Imp f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
ImpulseUseAheadPos f -> followImpulse cr w (doP2Imp f (cr ^. crPos . _xy +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
MvForward -> crup $ crMvForward speed (w ^. cWorld . lWorld) cr
MvTurnToward p ->
crup $
@@ -81,10 +80,10 @@ followImpulse cr w imp = case imp of
mvType = crMvType cr
speed = _mvSpeed mvType
turnRad = doFloatFloat $ _mvTurnRad mvType
cpos = _crPos cr
cpos = cr ^. crPos . _xy
cdir = _crDir cr
cid = _crID cr
posFromID cid' = w ^?! cWorld . lWorld . creatures . ix cid' . crPos
posFromID cid' = w ^?! cWorld . lWorld . creatures . ix cid' . crPos . _xy
rr a = randomR (- a, a) $ _randGen w
hitCr i =
cWorld . lWorld . creatures . ix i . crDamage
src/Dodge/Creature/Impulse/Flee.hs
+4 -3
View File
@@ -1,16 +1,17 @@
module Dodge.Creature.Impulse.Flee where
import Control.Lens
import Linear
import Dodge.Data.World
import FoldableHelp
import Geometry
retreatPointForFrom ::
Float -> World -> Creature -> Point2 -> Maybe Point2
retreatPointForFrom :: Float -> World -> Creature -> Point2 -> Maybe Point2
retreatPointForFrom d _ cr p =
safeMinimumOn (dist cpos) $
divideCircle 10 p d
where
cpos = _crPos cr
cpos = cr ^. crPos . _xy
-- = head $ sortBy (compare `on` (\p -> dist p ypos < 300)) $ retreatP'' : retreatPs
-- where
src/Dodge/Creature/Impulse/Movement.hs
+4 -3
View File
@@ -7,6 +7,7 @@ module Dodge.Creature.Impulse.Movement (
creatureTurnTo,
) where
import Linear
import Control.Lens
import Dodge.Base
import Dodge.Creature.Statistics
@@ -28,7 +29,7 @@ crMvBy p lw cr = crMvAbsolute lw (rotateV (_crDir cr) p) cr
crMvAbsolute :: LWorld -> Point2 -> Creature -> Creature
crMvAbsolute lw p' cr =
advanceStepCounter (magV p) cr
& crPos +~ p
& crPos . _xy +~ p
& crMvDir .~ argV p
where
p = strengthFactor (getCrMoveSpeed lw cr) *.* p'
@@ -55,7 +56,7 @@ creatureTurnTo p cr
| vToTarg == V2 0 0 = cr -- this should deal with the angleVV error
| otherwise = cr & crDir .~ dirToTarget
where
vToTarg = p -.- _crPos cr
vToTarg = p -.- cr ^. crPos . _xy
dirToTarget = argV vToTarg
-- the following is perhaps not ideal because it mixes normalizeAngle with
@@ -80,5 +81,5 @@ creatureTurnToward p turnSpeed cr
| isLeftOfA (normalizeAngle dirToTarget) (normalizeAngle $ _crDir cr) = cr & crDir +~ turnSpeed
| otherwise = cr & crDir -~ turnSpeed
where
vToTarg = p -.- _crPos cr
vToTarg = p -.- cr ^. crPos . _xy
dirToTarget = argV vToTarg
src/Dodge/Creature/Perception.hs
+5 -5
View File
@@ -95,7 +95,7 @@ chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
replicate numjits [RandomImpulse thejitter]
++ [[ChangeStrategy $ CloseToMelee 0]]
)
, AimAt 0 (w ^?! cWorld . lWorld . creatures . ix 0 . crPos)
, AimAt 0 (w ^?! cWorld . lWorld . creatures . ix 0 . crPos . _xy)
]
| otherwise = id
@@ -147,14 +147,14 @@ newExtraAwareness cr w cid
| not $ canSeeIndirect (_crID cr) cid w = Nothing
| otherwise = Just . Suspicious $ visionCheck cr tpos * awakeLevelPerception cr
where
tpos = w ^?! cWorld . lWorld . creatures . ix cid . crPos -- _crPos $ _creatures (_cWorld w) IM.! cid
cpos = _crPos cr
tpos = w ^?! cWorld . lWorld . creatures . ix cid . crPos . _xy -- _crPos $ _creatures (_cWorld w) IM.! cid
cpos = cr ^. crPos . _xy
visionCheck :: Creature -> Point2 -> Float
visionCheck cr tpos = doFloatFloat (_viFOV vi) ang * doFloatFloat (_viDist vi) d
where
vi = _cpVision $ _crPerception cr
cpos = _crPos cr
cpos = cr ^. crPos . _xy
dirvec = unitVectorAtAngle (_crDir cr)
ang = angleVV dirvec (tpos - (cpos - crRad (cr ^. crType) *^ dirvec))
d = dist tpos cpos
@@ -187,4 +187,4 @@ soundIsClose w cr (pos, vol) =
&& vol > doFloatFloat (_auDist . _cpAudition $ _crPerception cr) (dist pos cpos)
&& hasLOS cpos pos w
where
cpos = _crPos cr
cpos = cr ^. crPos . _xy
src/Dodge/Creature/Picture/Awareness.hs
+2 -1
View File
@@ -1,5 +1,6 @@
module Dodge.Creature.Picture.Awareness where
import Linear (_xy)
import Dodge.Creature.Radius
import qualified Data.Vector as V
import Dodge.Clock
@@ -31,7 +32,7 @@ creatureDisplayText w cr =
lw = w ^. cWorld . lWorld
campos = w ^. wCam . camViewFrom
theScale = 0.15 / (w ^. wCam . camZoom)
cpos = _crPos cr
cpos = cr ^. crPos . _xy
v = cpos -.- campos
(V2 x y) = campos +.+ v +.+ crRad (cr ^. crType) *.* normalizeV v
src/Dodge/Creature/ReaderUpdate.hs
+16 -15
View File
@@ -13,6 +13,7 @@ module Dodge.Creature.ReaderUpdate (
setViewPos,
) where
import Linear
import Dodge.Creature.Vocalization
import Dodge.Creature.Radius
import RandomHelp
@@ -47,16 +48,16 @@ tryMeleeAttack cr tcr
& crActionPlan . apStrategy .~ MeleeStrike
| otherwise = cr
where
cpos = _crPos cr
tpos = _crPos tcr
cpos = cr ^. crPos . _xy
tpos = tcr ^. crPos . _xy
setMvPos :: World -> Creature -> Creature
setMvPos w cr = cr & crIntention . mvToPoint .~ mpos
where
int = _crIntention cr
mtpos = do
tpos <- _crPos <$> _targetCr int
guard $ hasLOSIndirect (_crPos cr) tpos w
tpos <- (^. crPos . _xy) <$> _targetCr int
guard $ hasLOSIndirect (cr ^. crPos . _xy) tpos w
return tpos
mpos = mtpos <|> _mvToPoint int
@@ -70,8 +71,8 @@ attentionViewPoint w cr = do
attention <- cr ^? crPerception . cpAttention . getAttentiveTo
cid <- sortOn snd (IM.toList attention) ^? ix 0 . _1
tcr <- w ^? cWorld . lWorld . creatures . ix cid
guard $ visionCheck cr (_crPos tcr) > 0
return (_crPos tcr)
guard $ visionCheck cr (tcr ^. crPos . _xy) > 0
tcr ^? crPos . _xy
setTargetMv ::
-- | Function for determining target
@@ -82,7 +83,7 @@ setTargetMv ::
setTargetMv targFunc w cr =
maybe
cr
(\ctarg -> cr & crIntention . mvToPoint ?~ _crPos ctarg)
(\ctarg -> cr & crIntention . mvToPoint ?~ (ctarg ^. crPos . _xy))
(targFunc w cr)
-- ugly
@@ -90,14 +91,14 @@ flockACC :: World -> Creature -> Creature
flockACC w cr = case cr ^? crIntention . targetCr . _Just of
Nothing -> cr
Just tcr ->
let tpos = _crPos tcr
cpos = _crPos cr
let tpos = tcr ^. crPos . _xy
cpos = cr ^. crPos . _xy
isFarACC cr' =
_crGroup cr' == _crGroup cr
&& _crID cr' /= _crID cr
&& dist (_crPos cr') tpos > dist cpos tpos
&& dist (cr' ^. crPos . _xy) tpos > dist cpos tpos
macr =
safeMinimumOn (dist cpos . _crPos)
safeMinimumOn (dist cpos . (^. crPos . _xy))
. filter isFarACC
$ crsNearCirc cpos 50 w
in case macr of
@@ -106,7 +107,7 @@ flockACC w cr = case cr ^? crIntention . targetCr . _Just of
let r = crRad (acr ^. crType) + crRad (cr ^. crType) + 10
horDir = normalizeV (vNormal (cpos -.- tpos))
horShift =
if isLHS tpos cpos (_crPos acr)
if isLHS tpos cpos (acr ^. crPos . _xy)
then r *.* horDir
else negate r *.* horDir
in cr & crIntention . mvToPoint ?~ tpos +.+ horShift
@@ -128,7 +129,7 @@ chaseCritMv w cr = case _apStrategy (_crActionPlan cr) of
numjits = fst $ randomR (15, 25) (_randGen w)
_ -> case cr ^? crIntention . mvToPoint . _Just of
Just p
| dist (_crPos cr) p > crRad (cr ^. crType) -> cr & crActionPlan . apAction .~ [PathTo p]
| dist (cr ^. crPos . _xy) p > crRad (cr ^. crType) -> cr & crActionPlan . apAction .~ [PathTo p]
| otherwise ->
cr & crActionPlan . apAction .~ [bfsThenReturn 500 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]]
& crActionPlan . apStrategy .~ WatchAndWait
@@ -146,7 +147,7 @@ goToTarget w cr = case cr ^? crIntention . mvToPoint . _Just of
viewTarget :: World -> Creature -> Creature
viewTarget w cr = case cr ^? crIntention . viewPoint . _Just of
Just p
| hasLOSIndirect p (_crPos cr) w ->
| hasLOSIndirect p (cr ^. crPos . _xy) w ->
cr
& crActionPlan . apAction
.~ [TurnToPoint p]
@@ -210,7 +211,7 @@ searchIfDamaged cr
& crActionPlan . apStrategy
.~ StrategyActions
LookAround
[ TurnToPoint (_crPos cr -.- unitVectorAtAngle (_crDir cr))
[ TurnToPoint (cr ^. crPos . _xy -.- unitVectorAtAngle (_crDir cr))
`DoActionThen` 40 `WaitThen` bfsThenReturn 500
]
| otherwise = cr
src/Dodge/Creature/State.hs
+11 -10
View File
@@ -4,6 +4,7 @@ module Dodge.Creature.State (
invItemEffs,
) where
import Linear
import NewInt
import Control.Applicative
import Control.Monad
@@ -121,7 +122,7 @@ coolMachinePistol cr itm w
dosound s =
soundContinue
(CrWeaponSound (_crID cr) (fromIntegral $ _itID itm))
(_crPos cr)
(cr ^. crPos . _xy)
s
(Just 1)
d = pointerToItem itm . itParams
@@ -227,7 +228,7 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d
x = 1
isammolink AmmoMagSF{} = True
isammolink _ = False
pos = _crPos cr + xyV3 (rotate3 cdir p)
pos = cr ^. crPos . _xy + xyV3 (rotate3 cdir p)
cdir = _crDir cr
itm = itmtree ^. dtValue . _1
pointittarg = cWorld . lWorld . items . ix itid . itTargeting
@@ -251,7 +252,7 @@ shineTorch cr loc = fromMaybe id $ do
x = 10
isammolink AmmoMagSF{} = True
isammolink _ = False
pos = _crPos cr `v2z` 0 + rotate3 cdir (p + Q.rotate q (V3 5 0 1.5))
pos = _crPos cr + rotate3 cdir (p + Q.rotate q (V3 5 0 1.5))
cdir = _crDir cr
-- this probably needs to be set to null when dropped as well?
@@ -295,18 +296,18 @@ setRBCreatureTargeting cr w ituse
| otherwise = ituse & itTgID .~ fmap _crID newtarg & updatePos & itTgActive .~ False
where
newtarg =
safeMinimumOn (dist mwp . _crPos)
. filter (canseepos . _crPos)
safeMinimumOn (dist mwp . (^. crPos . _xy))
. filter (canseepos . (^. crPos . _xy))
$ crsNearCirc mwp 40 w
canseepos p = hasLOS (_crPos cr) p w
canseepos p = hasLOS ((^. crPos . _xy) cr) p w
mwp = w ^. cWorld . lWorld . lAimPos
updatePos t' = t' & itTgPos .~ posFromMaybeID (_itTgID t')
posFromMaybeID Nothing = Nothing
posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos
posFromMaybeID Nothing = Nothing
posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos . _xy
canSeeTarget = fromMaybe False $ do
cid <- ituse ^? itTgID . _Just
cpos <- w ^? cWorld . lWorld . creatures . ix cid . crPos
Just $ hasLOS cpos (_crPos cr) w
cpos <- w ^? cWorld . lWorld . creatures . ix cid . crPos . _xy
Just $ hasLOS cpos ( cr ^. crPos . _xy) w
--isFrictionless :: Creature -> Bool
--isFrictionless cr = case cr ^? crStance . carriage of
src/Dodge/Creature/State/WalkCycle.hs
+2 -1
View File
@@ -2,6 +2,7 @@
module Dodge.Creature.State.WalkCycle (updateWalkCycle) where
import Linear
import Control.Lens
import Dodge.Data.World
import Dodge.SoundLogic
@@ -15,7 +16,7 @@ updateWalkCycle cid w
w
& soundMultiFrom
[FootstepSound i | i <- [0 .. 10]]
(cr ^. crPos)
(cr ^. crPos . _xy)
(chooseFootSound ff)
Nothing
& over (cWorld . lWorld . creatures . ix cid . crStance . carriage) resetStride
src/Dodge/Creature/Test.hs
+8 -6
View File
@@ -24,6 +24,7 @@ module Dodge.Creature.Test (
crSafeDistFromTarg,
) where
import Linear
import NewInt
import qualified Data.IntMap.Strict as IM
import Dodge.Creature.Radius
@@ -49,7 +50,7 @@ import Geometry
-- return (x > 0)
crCanSeeCr :: Creature -> (World, Creature) -> Bool
crCanSeeCr tcr (w, cr) = hasLOS (_crPos cr) (_crPos tcr) w
crCanSeeCr tcr (w, cr) = hasLOS (cr ^. crPos . _xy) (tcr ^. crPos . _xy) w
--crCanSeeCrid :: Int -> (World, Creature) -> Bool
--crCanSeeCrid tcid (w, cr) = fromMaybe False $ do
@@ -71,7 +72,7 @@ crHasTargetLOS w cr = case cr ^? crIntention . targetCr . _Just of
crSafeDistFromTarg :: Float -> Creature -> Bool
crSafeDistFromTarg d cr = case cr ^? crIntention . targetCr . _Just of
Just tcr -> dist (_crPos cr) (_crPos tcr) > d
Just tcr -> dist (cr ^. crPos . _xy) (tcr ^. crPos . _xy) > d
Nothing -> True
crStratConMatches :: Strategy -> Creature -> Bool
@@ -81,7 +82,7 @@ crStratConMatches strat cr = strat == _apStrategy (_crActionPlan cr)
crAwayFromPost :: Creature -> Bool
crAwayFromPost cr = case find sentinelGoal . _apGoal $ _crActionPlan cr of
Just (SentinelAt p _) -> dist p (_crPos cr) > 15
Just (SentinelAt p _) -> dist p (cr ^. crPos . _xy) > 15
_ -> False
where
sentinelGoal (SentinelAt _ _) = True
@@ -108,8 +109,9 @@ crIsArmouredFrom m p cr = fromMaybe False $ do
ittype <- m ^? ix itid . itType
return $
EQUIP FRONTARMOUR == ittype
&& p /= _crOldPos cr
&& angleVV (unitVectorAtAngle (_crDir cr + frontarmdirection)) (p -.- _crOldPos cr) < pi / 2
&& p /= ( cr ^. crOldPos . _xy)
&& angleVV (unitVectorAtAngle (_crDir cr + frontarmdirection))
(p -.- (cr ^. crOldPos . _xy)) < pi / 2
where
-- even though angleVV can generate NaN, the comparison seems to deal with it
frontarmdirection
@@ -125,7 +127,7 @@ crIsArmouredFrom m p cr = fromMaybe False $ do
--crNearSeg d p1 p2 cr = circOnSeg p1 p2 (_crPos cr) (_crRad cr + d)
crNearPoint :: Float -> Point2 -> Creature -> Bool
crNearPoint d p cr = dist (_crPos cr) p < d + crRad (cr ^. crType)
crNearPoint d p cr = dist (cr ^. crPos . _xy) p < d + crRad (cr ^. crType)
isAnimate :: Creature -> Bool
{-# INLINE isAnimate #-}
src/Dodge/Creature/Update.hs
+8 -7
View File
@@ -1,5 +1,6 @@
module Dodge.Creature.Update (updateCreature) where
import Linear
import NewInt
import Color
import qualified Data.IntMap.Strict as IM
@@ -31,8 +32,8 @@ import ShapePicture.Data
updateCreature :: Creature -> World -> World
updateCreature cr
| null (cr ^? crHP . _HP) = id
| _crZ cr < negate 100 = (tocr . crHP .~ CrIsPitted) . destroyAllInvItems cr
| _crZ cr < 0 = (tocr . crZVel -~ 0.5) . (tocr . crZ +~ _crZVel cr)
| cr ^. crPos . _z < negate 100 = (tocr . crHP .~ CrIsPitted) . destroyAllInvItems cr
| cr ^. crPos . _z < 0 = (tocr . crZVel -~ 0.5) . (tocr . crPos . _z +~ _crZVel cr)
| otherwise = updateCreature' cr
where
tocr = cWorld . lWorld . creatures . ix (_crID cr)
@@ -131,16 +132,16 @@ dropAll cr w = foldl' (flip (dropItem cr)) w . reverse . IM.keys . _unNIntMap $
chasmTest :: Creature -> World -> World
chasmTest cr w
| _crZVel cr < 0 = w & tocr . crZVel -~ 0.5
& tocr . crZ +~ _crZVel cr
& tocr . crPos . _z +~ _crZVel cr
| Just (x, y) <- List.find g (foldMap loopPairs $ w ^. cWorld . chasms) = w
& soundContinue (CrChasm (_crID cr)) (_crPos cr) debrisS (Just 100)
& tocr . crPos -~ normalizeV (vNormal (x - y))
& soundContinue (CrChasm (_crID cr)) (cr ^. crPos . _xy) debrisS (Just 100)
& tocr . crPos . _xy -~ normalizeV (vNormal (x - y))
| any f (w ^. cWorld . chasms) = w & tocr . crZVel -~ 0.5
| otherwise = w
where
tocr = cWorld . lWorld . creatures . ix (_crID cr)
g = uncurry $ circOnSeg (_crPos cr) (crRad $ cr ^. crType)
f = circInPolygon (_crPos cr) (crRad $ cr ^. crType)
g = uncurry $ circOnSeg (cr ^. crPos . _xy) (crRad $ cr ^. crType)
f = circInPolygon (cr ^. crPos . _xy) (crRad $ cr ^. crType)
updatePulse :: Pulse -> Pulse
updatePulse PulseStatus{_pulseRate = pr, _pulseProgress = pp}
src/Dodge/Creature/YourControl.hs
+2 -1
View File
@@ -2,6 +2,7 @@
module Dodge.Creature.YourControl (yourControl) where
import Linear
import Control.Monad
import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as M
@@ -139,7 +140,7 @@ wasdAim inp w cr
| Aiming {} <- cr ^. crStance . posture = removeAimPosture cr
| otherwise = creatureTurnTowardDir (_crMvAim cr) 0.2 cr
where
mousedir = argV $ w ^. cWorld . lWorld . lAimPos - (cr ^. crPos)
mousedir = argV $ w ^. cWorld . lWorld . lAimPos - (cr ^. crPos . _xy)
setAimPosture :: IM.IntMap Item -> Creature -> Creature
setAimPosture m cr = fromMaybe cr $ do