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/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)