Cleanup

src/Dodge/Base/Collide.hs

@@ -37,7 +37,6 @@ module Dodge.Base.Collide (
     collide3,
 ) where
 
-import Linear
 import Control.Lens
 import Control.Monad
 import qualified Data.IntSet as IS
@@ -50,24 +49,28 @@ import Dodge.Data.World
 import Dodge.Zoning
 import FoldableHelp
 import Geometry
+import Linear
 
 collidePoint :: Point2 -> Point2 -> [Wall] -> (Point2, Maybe Wall)
 {-# INLINE collidePoint #-}
 collidePoint sp ep = foldl' f (ep, Nothing)
   where
-    f (p, mwl) wl 
+    f (p, mwl) wl =
-        = maybe (p, mwl) (,Just wl) . uncurry (intersectSegSeg sp p) . _wlLine $ wl
+        maybe (p, mwl) (,Just wl) . uncurry (intersectSegSeg sp p) . _wlLine $ wl
 
 overlapSegCrs :: Point2 -> Point2 -> [Creature] -> [(Point2, Creature)]
 {-# INLINE overlapSegCrs #-}
-overlapSegCrs sp ep =
+overlapSegCrs sp ep = mapMaybe f
-    mapMaybe
+  where
-        (\cr -> (,cr) <$> fst (intersectCircSeg (cr ^. crPos . _xy) (crRad $ cr ^. crType) sp ep))
+    f cr =
+        (,cr)
+            <$> fst (intersectCircSeg (cr ^. crPos . _xy) (crRad $ cr ^. crType) sp ep)
 
 doBounce :: Float -> Point2 -> Point2 -> (Point2, Maybe Wall) -> Maybe (Point2, Point2)
 {-# INLINE doBounce #-}
-doBounce x sp ep (p, mwl) =
+doBounce x sp ep (p, mwl) = fmap f mwl
-    mwl <&> \wl ->
+  where
+    f wl =
         ( p +.+ normalizeV (vNormal (uncurry (-.-) (_wlLine wl)))
         , reflVelWallDamp x wl (ep -.- sp)
         )
@@ -82,7 +85,13 @@ doBounce x sp ep (p, mwl) =
 --{-# INLINE bounceBall #-}
 --bounceBall x sp ep r = doBounce x sp ep . collideCircWalls sp ep r
 
-bouncePoint :: (Wall -> Bool) -> Float -> Point2 -> Point2 -> World -> Maybe (Point2, Point2)
+bouncePoint ::
+    (Wall -> Bool) ->
+    Float ->
+    Point2 ->
+    Point2 ->
+    World ->
+    Maybe (Point2, Point2)
 {-# INLINE bouncePoint #-}
 bouncePoint t x sp ep = doBounce x sp ep . collidePointWallsFilter t sp ep
 
@@ -153,18 +162,20 @@ collide3Wall sp wl (ep, mo) = maybe (ep, mo) (,Just (n, OWall wl)) $ intersectSe
 collide3Creature :: Point3 -> Creature -> (Point3, MPO) -> (Point3, MPO)
 collide3Creature sp cr (ep, m) = fromMaybe (ep, m) $ do
     h <- crHeight cr
-    (p,n) <- fst $ intersectCylSeg
+    (p, n) <-
-        (cr ^. crPos)
+        fst $
-        (crRad $ cr ^. crType)
+            intersectCylSeg
-        h
+                (cr ^. crPos)
-        sp
+                (crRad $ cr ^. crType)
-        ep
+                h
-    return (p, Just (n,OCreature cr))
+                sp
+                ep
+    return (p, Just (n, OCreature cr))
 
 crHeight :: Creature -> Maybe Float
 crHeight cr = case cr ^. crHP of
-    HP {} -> Just 25
+    HP{} -> Just 25
-    CrIsCorpse {} -> Just 5
+    CrIsCorpse{} -> Just 5
     CrIsGibs -> Nothing
     CrIsPitted -> Nothing
 

src/Dodge/Projectile/Update.hs

@@ -3,10 +3,6 @@
 module Dodge.Projectile.Update (updateProjectile) where
 
 import Linear
-import Dodge.Render.List
-import Dodge.Render.Label
-import ShortShow
-import Picture.Base
 import Control.Monad
 import Data.List (delete)
 import Data.Maybe
@@ -123,42 +119,6 @@ shellHitFloor p pj w
         | abs x < 0.01 = 0
         | otherwise = x * 0.9
 
------- note this doesn't take into account moving walls, which may break the
------- bouncing in some way
---tryShellBounce :: Point3 -> (Point3, Object ) -> Projectile -> World -> World
---tryShellBounce p' (n, OWall wl) pj w
---    | Just GStick <- pj ^? pjType . gnHitEffect =
---        w
---            & cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
---                .~ Grenade (GStuckWall (wl ^. wlStructure))
---            & soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos . _xy)
---    | Just x <- pj ^? pjType . gnHitEffect . bounceTolerance
---      , abs (dotV (pj ^. pjVel . _xy) (vNormal hitline)) < x =
---        w
---            & cWorld . lWorld . projectiles . ix (_pjID pj) . pjVel . _xy
---                %~ reflectIn hitline
---            & cWorld . lWorld . projectiles . ix (_pjID pj) . pjPos
---                .~ p - normalizeV (pj ^. pjVel)
---            & soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos) click1S Nothing
---  where
---    p = xyV3 p'
---    hitline = normalizeV $ uncurry (-) $ _wlLine wl
---tryShellBounce p' (n,OCreature cr) pj w
---    | Just GStick <- pj ^? pjType . gnHitEffect =
---        w
---            & cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
---                .~ Grenade
---                    ( GStuckCreature
---                        (cr ^. crID)
---                        (rotate3z (- cr ^. crDir) (p' - ((cr ^. crPos)`v2z`0)))
---                        (pj ^. pjDir - cr ^. crDir)
---                    )
---            & soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
---  where
---    p = xyV3 p'
---tryShellBounce _ _ pj w = w
---tryShellBounce _ _ pj w = explodeShell pj w
-
 destroyProjectile :: Maybe (NewInt ItmInt) -> Int -> World -> World
 destroyProjectile mitid pjid w =
     w & cWorld . lWorld . projectiles %~ IM.delete pjid
@@ -260,18 +220,7 @@ moveStuckGrenade cid poff d pj w
         w & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjType .~ Grenade GStick
 
 moveProjectile :: Projectile -> World -> World
-moveProjectile pj w = moveProjectile' pj w
+moveProjectile pj w
-    & cWorld . lWorld . flares <>~
-    (setLayer DebugLayer
-    $ color red $ line [p, (p +v)]
-    )
-  where
-    p = pj^. pjPos . _xy
-    v = pj^. pjVel . _xy
-
-
-moveProjectile' :: Projectile -> World -> World
-moveProjectile' pj w
     | Just GStuckWall{} <- pj ^? pjType . gnHitEffect = w
     | Just (GStuckCreature crid poff d) <- pj ^? pjType . gnHitEffect =
         moveStuckGrenade crid poff d pj w
@@ -281,7 +230,6 @@ moveProjectile' pj w
         shellHitFloor p pj w
     | (p, Just (_, OCreature cr)) <- collide3 sp (sp + 2 *^ _pjVel pj) w =
         shellHitCreature p cr pj w
-            & cWorld . lWorld . flares <>~ test p cr w sp (_pjVel pj)
     | (_, Just (_, OChasmWall)) <- collide3 sp (sp + 2 *^_pjVel pj) w =
         -- no stick or bounce for now
         w & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjTimer .~ 0
@@ -293,31 +241,6 @@ moveProjectile' pj w
   where
     sp = _pjPos pj
 
-test :: Point3 -> Creature -> World -> Point3 -> Point3 -> Picture
-test p cr w sp v = 
-    (setLayer FixedCoordLayer
-    $ uncurryV translate (worldPosToScreen (w ^. wCam) (p ^. _xy))
-        $ drawList [text (shortShow p),text $ shortShow sp, text $ shortShow $ sp + 2*v, text $ shortShow v]
-         <> color white (crossPic 5)
-    ) <> 
-    (setLayer DebugLayer
-    $ uncurryV translate (p ^. _xy)
-        $ ( scale 0.1 0.1
-        $ stackPicturesAt
-        [ text $ shortShow p
-        , text $ shortShow sp
-        , text $ shortShow (sp + v)
-        ]
-    ) <> color green (crossPic 5)
-    ) <> 
-    setLayer DebugLayer
-    (uncurryV translate (cr ^. crPos . _xy)
-    $ circle 10
-    ) <> 
-    (setLayer DebugLayer
-    $ color red $ line [sp^. _xy, (sp +v)^._xy]
-    )
-
 explodeShell :: Projectile -> World -> World
 explodeShell pj w =
     w