Cleanup
This commit is contained in:
@@ -63,7 +63,7 @@ divideDoorPane mid wl soff dr ppairs g = case ppairs of
|
||||
thedoor = dr & drPushedBy .~ maybe PushesItself PushedBy mid
|
||||
|
||||
putAutoDoor :: Point2 -> Point2 -> Placement
|
||||
putAutoDoor a b = Placement (PS 0 0) (PutCoord a) Nothing Nothing $ \_ apl ->
|
||||
putAutoDoor a b = pt0 (PutCoord a) $ \apl ->
|
||||
Just $
|
||||
Placement (PS 0 0) (PutCoord b) Nothing Nothing $ \w bpl ->
|
||||
let x = w ^?! gwWorld . coordinates . ix (apl ^?! plMID . _Just)
|
||||
|
||||
@@ -33,12 +33,8 @@ import Data.Monoid
|
||||
import RandomHelp
|
||||
|
||||
testStringInit :: Universe -> [String]
|
||||
testStringInit _ = mempty
|
||||
--testStringInit u = [show $ u ^? uvWorld . input . mouseContext . mcoRotateDist]
|
||||
testStringInit u = --fmap show (u ^.. uvWorld . cWorld . lWorld . creatures . each . crHP . _HP)
|
||||
fmap show (u ^.. uvWorld . cWorld . lWorld . creatures . each . crPos . _xy)
|
||||
<> fmap show (u ^.. uvWorld . cWorld . lWorld . creatures . each . crOldPos . _xy)
|
||||
<> fmap show (u ^.. uvWorld . cWorld . lWorld . creatures . each . crWallTouch)
|
||||
<> fmap show (u ^.. uvWorld . cWorld . lWorld . debris . each . dbPos)
|
||||
-- (fmap show $ u ^.. uvWorld . cWorld . lWorld . machines . each . mcType . _McDamSensor . sensAmount)
|
||||
-- <> (fmap show $ u ^.. uvWorld . cWorld . lWorld . machines . each . mcMaterial)
|
||||
--testStringInit u = map show (u ^.. uvWorld . cWorld . lWorld . machines . traverse . mcDir)
|
||||
|
||||
@@ -1,21 +1,15 @@
|
||||
-- | Deals with moving creature wall collisions.
|
||||
module Dodge.WallCreatureCollisions (
|
||||
colCrsWalls,
|
||||
colCrWall,
|
||||
pushCreatureOutFromWalls,
|
||||
crOnWall,
|
||||
) where
|
||||
module Dodge.WallCreatureCollisions (colCrsWalls) where
|
||||
|
||||
import qualified Data.IntSet as IS
|
||||
import Data.Foldable
|
||||
import Linear
|
||||
import Dodge.Creature.Radius
|
||||
import Control.Lens
|
||||
import Data.Monoid
|
||||
import Data.Foldable
|
||||
import qualified Data.IntSet as IS
|
||||
import Dodge.Base
|
||||
import Dodge.Creature.Radius
|
||||
import Dodge.Data.Universe
|
||||
import Dodge.Zoning.Wall
|
||||
import Geometry
|
||||
import Linear
|
||||
|
||||
colCrsWalls :: Universe -> Universe
|
||||
colCrsWalls uv = uv & uvWorld . cWorld . lWorld . creatures %~ fmap (noclipCheck (_uvConfig uv) (_uvWorld uv))
|
||||
@@ -41,8 +35,9 @@ colCrWall w c = cornpush . wallpush $ pushthrough c
|
||||
|
||||
pushCr' :: [Wall] -> Creature -> Creature
|
||||
pushCr' wls cr
|
||||
| dist ep sp > r
|
||||
&& dist ep ap > r = ecr & crDamage <>~ [Crushing 1000 0]
|
||||
| dist ep sp > r && dist ep ap > r =
|
||||
ecr
|
||||
& crDamage <>~ [Crushing 1000 0]
|
||||
& crPos . _xy .~ ap
|
||||
| otherwise = ecr
|
||||
where
|
||||
@@ -59,45 +54,6 @@ pushCr' wls cr
|
||||
wallBuffer :: Float
|
||||
wallBuffer = 0
|
||||
|
||||
pushCreatureOutFromWalls :: [(Point2, Point2)] -> Creature -> Creature
|
||||
pushCreatureOutFromWalls ls cr = cr & crPos . _xy
|
||||
%~ pushOutFromWalls (crRad (cr ^. crType)) ls
|
||||
|
||||
-- the following tests whether or not a point is on a wall, and if so pushes it
|
||||
-- out from the wall
|
||||
-- this is then repeated if the point ends up on a new wall
|
||||
pushOutFromWalls :: Float -> [(Point2, Point2)] -> Point2 -> Point2
|
||||
pushOutFromWalls rad wls p1 = case (getFirst . foldMap (First . pushOutFromWall rad p1)) wls of
|
||||
Nothing -> p1
|
||||
Just p2 -> pushOutFromWalls rad (tail wls) p2
|
||||
|
||||
--wallPushList :: Float -> [Wall] -> Point2 -> [(Point2, Wall)]
|
||||
--wallPushList rad wls p1 = mapMaybe f wls
|
||||
-- where
|
||||
-- f :: Wall -> Maybe (Point2,Wall)
|
||||
-- f wl = case pushOutFromWall rad p1 (wl ^. wlLine) of
|
||||
-- Nothing -> Nothing
|
||||
-- Just p -> Just (p,wl)
|
||||
|
||||
-- possible improvement: choose between the closer of p2 and "p3" to p1
|
||||
|
||||
--pushOutFromWalls' :: Float -> [(Point2,Point2)] -> Point2 -> Point2
|
||||
--pushOutFromWalls' rad wls p1 = case (getFirst . foldMap (First . pushOutFromWall' rad p1)) wls of
|
||||
-- Nothing -> p1
|
||||
-- Just p2 -> fromMaybe p2 $ (getLast . foldMap (Last . pushOutFromWall' rad p2)) wls
|
||||
-- -- possible improvement: choose between the closer of p2 and "p3" to p1
|
||||
|
||||
-- note the inclusion of endpoints in circOnSeg
|
||||
crOnWall :: Creature -> World -> Bool
|
||||
crOnWall cr =
|
||||
any (uncurry (circOnSeg p r) . _wlLine)
|
||||
. filter notff
|
||||
. wlsNearCirc p r
|
||||
where
|
||||
notff x = x ^. wlMaterial /= ForceField
|
||||
p = cr ^. crPos . _xy
|
||||
r = crRad (cr ^. crType)
|
||||
|
||||
-- assumes that the wall is orientated
|
||||
-- assumes wall points are different
|
||||
pushOutFromWall :: Float -> Point2 -> (Point2, Point2) -> Maybe Point2
|
||||
@@ -112,7 +68,6 @@ pushOutFromWall rad cp2 (wp1, wp2)
|
||||
isOnWall = circOnSegNoEndpoints wp1 wp2 cp2 rad
|
||||
|
||||
pushOutFromCorners :: Float -> [(Point2, Point2)] -> Point2 -> Point2
|
||||
--pushOutFromCorners r ls p = foldr (squashIntersectCirclePoint r . fst) p ls
|
||||
pushOutFromCorners r = flip $ foldr (squashIntersectCirclePoint r . fst)
|
||||
|
||||
squashIntersectCirclePoint :: Float -> Point2 -> Point2 -> Point2
|
||||
|
||||
Reference in New Issue
Block a user