From 15b98e38acdaa3da7cb8820cb0ac98d903261697 Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 26 Jun 2022 10:52:46 +0100 Subject: [PATCH] Move wall collisions around --- src/Dodge/Base.hs | 2 + src/Dodge/Base/Collide.hs | 64 ++++++--------------- src/Dodge/{Wall/Reflect.hs => Base/Wall.hs} | 15 ++++- src/Dodge/Item/Weapon/LaserPath.hs | 8 +-- src/Dodge/Wall/DamageEffect.hs | 2 +- 5 files changed, 33 insertions(+), 58 deletions(-) rename src/Dodge/{Wall/Reflect.hs => Base/Wall.hs} (63%) diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index 5b19c2617..c84b4af9a 100644 --- a/src/Dodge/Base.hs +++ b/src/Dodge/Base.hs @@ -13,9 +13,11 @@ module Dodge.Base , module Dodge.Base.Coordinate , module Dodge.Base.Collide , module Dodge.Base.CardinalPoint + , module Dodge.Base.Wall ) where import Dodge.Data import Dodge.Base.WinScale +import Dodge.Base.Wall import Dodge.Base.Arithmetic import Dodge.Base.NewID import Dodge.Base.Coordinate diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs index 4aafd17a6..66ffb371d 100644 --- a/src/Dodge/Base/Collide.hs +++ b/src/Dodge/Base/Collide.hs @@ -16,7 +16,7 @@ module Dodge.Base.Collide , bounceBall , bouncePoint , ssfold - , collidePointUpToIndirectMinDist +-- , collidePointUpToIndirectMinDist , wlIsOpaque , wlIsSeeThrough , wallsOnCirc @@ -50,11 +50,10 @@ module Dodge.Base.Collide ) where import Dodge.Data import Dodge.Zone -import Dodge.Wall.Reflect +import Dodge.Base.Wall import Geometry import FoldableHelp ---import Data.List import Data.Maybe import Data.Function (on) import qualified Data.IntMap.Strict as IM @@ -64,36 +63,28 @@ import qualified FoldlHelp as L import Data.Monoid import Streaming import qualified Streaming.Prelude as S ---import qualified Data.Map.Lazy as M -- note the use of Lazy, the idea being interoperation with Streaming --- + collidePoint :: Point2 -> Point2 -> Stream (Of Wall) Identity () -> (Point2, Maybe Wall) {-# INLINE collidePoint #-} -collidePoint sp ep = runIdentity - . S.fold_ findPoint (ep, Nothing) id +collidePoint sp ep = runIdentity . S.fold_ findPoint (ep, Nothing) id where findPoint (p,mwl) wl = maybe (p,mwl) (,Just wl) . uncurry (intersectSegSeg sp p) . _wlLine $ wl +doBounce :: Float -> Point2 -> Point2 -> (Point2, Maybe Wall) -> Maybe (Point2, Point2) +doBounce x sp ep (p, mwl) = mwl <&> \wl -> + ( p +.+ normalizeV (vNormal (uncurry (-.-) (_wlLine wl))) + , reflVelWallDamp x wl (ep -.- sp) + ) + bounceBall :: Float -> Point2 -> Point2 -> Float -> Stream (Of Wall) Identity () -> Maybe (Point2,Point2) -bounceBall x sp ep r w = do - wl <- mwl - return (p +.+ normalizeV (vNormal (uncurry (-.-) (_wlLine wl))) - , reflVelWallDamp x wl (ep -.- sp) - ) - where - (p, mwl) = collideCircWallsStream sp ep r w +bounceBall x sp ep r = doBounce x sp ep . collideCircWallsStream sp ep r bouncePoint :: (Wall -> Bool) -> Float -> Point2 -> Point2 -> World -> Maybe (Point2,Point2) -bouncePoint t x sp ep w = do - wl <- mwl - return (p +.+ normalizeV (vNormal (uncurry (-.-) (_wlLine wl))) - , reflVelWallDamp x wl (ep -.- sp) - ) - where - (p, mwl) = collidePointWallsFilterStream t sp ep w +bouncePoint t x sp ep = doBounce x sp ep . collidePointWallsFilterStream t sp ep -- this COULD be written in terms of collidePointWallsFilterStream, TODO test -- whether this is actually faster @@ -107,49 +98,28 @@ collidePointWallsFilterStream t sp ep = collidePoint sp ep . S.filter t . wallsAlongLine sp ep ---visibleWallWalls' :: Point2 -> Point2 -> World -> M.Map Float Wall ---visibleWallWalls' sp ep = L.purely S.fold L.map . visibleWallWalls sp ep - --orderStreamOn :: Ord b => (a -> b) -> Stream (Of a) Identity () -> Identity (Of (M.Map b a) ()) orderStreamOn :: Ord a => (b -> a) -> Stream (Of b) Identity () -> Stream (Of b) Identity () orderStreamOn f = S.each . runIdentity . L.purely S.fold_ L.map . S.map g where g x = (f x,x) +overlapSegWalls :: Point2 -> Point2 -> Stream (Of Wall) Identity () + -> Stream (Of (Point2,Wall)) Identity () +overlapSegWalls sp ep = S.mapMaybe $ \wl -> uncurry (intersectSegSeg sp ep) (_wlLine wl) <&> (,wl) + visibleWalls :: Point2 -> Point2 -> World -> Stream (Of (Point2,Wall)) Identity () visibleWalls sp ep = S.take 1 <=< -- hlint, was using join and fmap ( S.span (not . wlIsOpaque . snd) . orderStreamOn (dist sp . fst) - . S.mapMaybe f + . overlapSegWalls sp ep . wallsAlongLine sp ep ) - where - f wl = uncurry (intersectSegSeg sp ep) (_wlLine wl) <&> (,wl) allVisibleWalls :: World -> Stream (Of (Point2,Wall)) Identity () allVisibleWalls w = concats $ S.subst (flip (visibleWalls vPos) w . (+.+ vPos)) $ S.each (nRays 20) where vPos = _cameraViewFrom w -wlIsOpaque :: Wall -> Bool -wlIsOpaque wl = case _wlOpacity wl of - Opaque -> True - _ -> False - -wlIsSeeThrough :: Wall -> Bool -wlIsSeeThrough wl = case _wlOpacity wl of - SeeThrough -> True - _ -> False - ---collidePointUpToIndirect --- :: Point2 -- ^start point --- -> Point2 -- ^end point --- -> IM.IntMap Wall --- -> Point2 ---{-# INLINE collidePointUpToIndirect #-} ---collidePointUpToIndirect p1 p2 = foldr f p2 . IM.filter wlIsOpaque --- where --- f wl x = fromMaybe x . uncurry (intersectSegSeg p1 x) $ _wlLine wl - collidePointUpToIndirectMinDist :: Point2 -- ^start point -> Point2 -- ^end point diff --git a/src/Dodge/Wall/Reflect.hs b/src/Dodge/Base/Wall.hs similarity index 63% rename from src/Dodge/Wall/Reflect.hs rename to src/Dodge/Base/Wall.hs index f9ea2d9ae..c48d9bdd6 100644 --- a/src/Dodge/Wall/Reflect.hs +++ b/src/Dodge/Base/Wall.hs @@ -1,7 +1,16 @@ -module Dodge.Wall.Reflect - where -import Geometry +module Dodge.Base.Wall where import Dodge.Data +import Geometry + +wlIsOpaque :: Wall -> Bool +wlIsOpaque wl = case _wlOpacity wl of + Opaque -> True + _ -> False + +wlIsSeeThrough :: Wall -> Bool +wlIsSeeThrough wl = case _wlOpacity wl of + SeeThrough -> True + _ -> False reflDirWall :: Point2 -> Point2 -> Wall -> Float reflDirWall sp ep wl = argV (reflectIn (uncurry (-.-) (_wlLine wl)) (ep -.- sp)) diff --git a/src/Dodge/Item/Weapon/LaserPath.hs b/src/Dodge/Item/Weapon/LaserPath.hs index 56b04cd10..3f79569f7 100644 --- a/src/Dodge/Item/Weapon/LaserPath.hs +++ b/src/Dodge/Item/Weapon/LaserPath.hs @@ -2,15 +2,9 @@ module Dodge.Item.Weapon.LaserPath ( reflectLaserAlong ) where import Dodge.Data -import Dodge.Wall.Reflect +import Dodge.Base.Wall --import Dodge.Creature.HandPos import Dodge.WorldEvent -import Dodge.Base.Collide ---import Dodge.Default ---import Dodge.Item.Weapon.InventoryDisplay ---import Dodge.Item.Weapon.TriggerType ---import Dodge.Item.Attachment ---import Dodge.Base import Geometry --import Data.Maybe diff --git a/src/Dodge/Wall/DamageEffect.hs b/src/Dodge/Wall/DamageEffect.hs index ce8affd2b..9bd6d91a4 100644 --- a/src/Dodge/Wall/DamageEffect.hs +++ b/src/Dodge/Wall/DamageEffect.hs @@ -2,7 +2,7 @@ module Dodge.Wall.DamageEffect where import Dodge.Data import Dodge.Particle.Spark import Dodge.Particle.Bullet.Spawn -import Dodge.Wall.Reflect +import Dodge.Base.Wall import Dodge.Wall.Dust import Dodge.Block import Geometry