Cleanup

src/Dodge/Placement/Instance/Door.hs

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

src/Dodge/TestString.hs

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

src/Dodge/WallCreatureCollisions.hs

@@ -1,21 +1,15 @@
 -- | Deals with moving creature wall collisions.
-module Dodge.WallCreatureCollisions (
+module Dodge.WallCreatureCollisions (colCrsWalls) where
-    colCrsWalls,
-    colCrWall,
-    pushCreatureOutFromWalls,
-    crOnWall,
-) 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))
@@ -40,9 +34,10 @@ colCrWall w c = cornpush . wallpush $ pushthrough c
     notff x = x ^. wlMaterial /= ForceField
 
 pushCr' :: [Wall] -> Creature -> Creature
-pushCr' wls cr 
+pushCr' wls cr
-    | dist ep sp > r 
+    | dist ep sp > r && dist ep ap > r =
-        && dist ep ap > r = ecr & crDamage <>~ [Crushing 1000 0]
+        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