Fix shockwave damage radius for walls

src/Dodge/Data/Projectile.hs

@@ -49,8 +49,7 @@ data GrenadeHitEffect
     | GStuckWall {_stuckWlID :: WallStructure}
     deriving (Show, Eq, Ord, Read) --Generic, Flat)
 
-data RocketSmoke
-    = ReducedRocketSmoke
+data RocketSmoke = ReducedRocketSmoke
     deriving (Show, Eq, Ord, Read) --Generic, Flat)
 
 makeLenses ''Projectile

src/Dodge/Debug.hs

@@ -2,12 +2,7 @@
 
 module Dodge.Debug (debugEvents, drawDebug) where
 
-import Geometry.Data
-import Dodge.WorldBool
-import Dodge.Zoning.Pathing
-import Dodge.Door.DoorLerp
-import Dodge.ShiftPoint
-import Dodge.Zoning.Base
+import AesonHelp
 import Control.Lens
 import Control.Monad
 import qualified Data.IntMap.Strict as IM
@@ -77,44 +72,8 @@ debugItem = \case
     Debug_put -> debugPutItems
 
 debugGet :: Universe -> [String]
-debugGet u = [fromMaybe "DebugGetFail" $ debugGet1 u
-    , fromMaybe "DebugGetFail" $ debugGet2 u
-    , fromMaybe "DebugGetFail" $ debugGet3 u
-    ]
+debugGet u = foldMap getPretty $ u ^. uvWorld . cWorld . lWorld . shockwaves
 
---debugGet1 :: Show a => Universe -> Maybe a
-debugGet1 :: Universe -> Maybe String
-debugGet1 u = do
-    dr <- u ^? uvWorld . cWorld . lWorld . doors . ix 2
-    let wlposs x = (dr ^. drFootPrint) & each . each %~ shiftPointBy (doDoorLerp dr x)
-        ps = wlposs (dr ^. drLerp)
-        is = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize)) ps
-    return $ show $ S.toList is
-
-debugGet2 :: Universe -> Maybe String
-debugGet2 u = do
-    let w = u ^. uvWorld
-    dr <- u ^? uvWorld . cWorld . lWorld . doors . ix 2
-    let clerp = dr ^. drLerp
-        speed = dr ^?! drUpdate . drLerpSpeed
-        toOpen = doWdBl (_drTrigger dr) w
-        newlerp
-            | toOpen && clerp < 1 = Just . min 1 $ clerp + speed
-            | clerp > 0 && not toOpen = Just . max 0 $ clerp - speed
-            | otherwise = Nothing
-    x <- newlerp
-    let wlposs y = (dr ^. drFootPrint) & each . each %~ shiftPointBy (doDoorLerp dr y)
-        ps = wlposs x
-        is = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize)) ps
-    return $ show is
-    
-debugGet3 :: Universe -> Maybe String
-debugGet3 u = do
-    dr <- u ^? uvWorld . cWorld . lWorld . doors . ix 2
-    let wlposs x = (dr ^. drFootPrint) & each . each %~ shiftPointBy (doDoorLerp dr x)
-        ps = wlposs (dr ^. drLerp)
-        is = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize)) ps
-    return $ show is
 
 debugPutItems :: Universe -> Maybe [DebugItem]
 debugPutItems u = Just $ f <$> [0..debugPutN]
@@ -134,23 +93,7 @@ doDebugPut i u
     | otherwise = u
 
 debugPutDraw :: IM.IntMap String -> Universe -> Picture
-debugPutDraw _ u = drawthedoor u <> drawthezones u
-
-drawthezones :: Universe -> Picture
-drawthezones u = fold $ do
-    is <- readMaybe =<< u ^? uvDebugPut . ix 0
-    let f :: [Int2] -> [Int2]
-        f = id
-    return $ foldMap (drawZoneCol yellow peZoneSize) $ f is
-
-drawthedoor :: Universe -> Picture
-drawthedoor u = fold $ do
-    dr <- u ^? uvWorld . cWorld . lWorld . doors . ix 2
-    let wlposs x = (dr ^. drFootPrint) & each . each %~ shiftPointBy (doDoorLerp dr x)
-        ps = wlposs (dr ^. drLerp)
-    return $ setLayer DebugLayer $ color blue $ foldMap g ps
-  where
-    g (x,y) = line [x,y]
+debugPutDraw _ _ = mempty
 
 doDebugGet :: Universe -> Maybe [DebugItem]
 doDebugGet u =

src/Dodge/DrWdWd.hs

@@ -1,108 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-
-module Dodge.DrWdWd (updateDoor) where
-
-import Dodge.LightSource
-import Data.Foldable
-import qualified Data.IntMap.Strict as IM
-import Data.Maybe
-import qualified Data.Set as S
-import Dodge.Block.Debris
-import Dodge.Data.World
-import Dodge.Door.DoorLerp
-import Dodge.ShiftPoint
-import Dodge.SoundLogic
-import Dodge.Wall.Delete
-import Dodge.Wall.Move
-import Dodge.WorldBool
-import Dodge.Zoning.Base
-import Dodge.Zoning.Pathing
-import Geometry.Data
-import LensHelp
-import Linear
-import Picture.Data
-import Shape.Data
-
-updateDoor :: Door -> World -> (S.Set Int2, World)
-updateDoor dr w
-    | dr ^. drHP < 1 = destroyDoor dr w
-    | DoorLerp x <- dr ^. drUpdate = doorLerp x dr w
-    | otherwise =
-        ( mempty
-        , foldl' (doDoorMount (doDoorLerp dr (dr ^. drLerp))) w (dr ^. drMounts)
-        )
-
-doDoorMount :: Point2A -> World -> MountedObject -> World
-doDoorMount pa w = \case
-    MountedLight p r c ->
-        w & cWorld . lWorld . lights
-            .:~ LSParam (p & _xy %~ shiftPointBy pa) r c
-    MountedSPic x ->
-        w & cWorld . lWorld . tempSPic
-            <>~ ( x & _1 . each . sfVs . each . _xy %~ shiftPointBy pa
-                    & _2 . each . vxPos . _xy %~ shiftPointBy pa
-                )
-
-doorLerp :: Float -> Door -> World -> (S.Set Int2, World)
-doorLerp speed dr w = fromMaybe (mempty,domounts (dr ^. drLerp) w) $ do
-    x <- newlerp
-    let ps = wlposs x
-        ps' = wlposs (dr ^. drLerp)
-        is = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize)) (ps <> ps')
-    -- it seems possible that this will miss some paths: we don't add zones for the
-    -- old footprint. Seems unlikely, but a possible cause of pathfinding bugs
-    return
-        ( is
-        , domounts x $ f x
-            & playSound x
-            & cWorld . lWorld . doors . ix drid . drLerp .~ x
-        )
-  where
-    domounts x w' = foldl' (doDoorMount (doDoorLerp dr x)) w' (dr ^. drMounts)
-    f = ifoldl' (flip . moveWallID) w . wlposs
-    wlposs x = (dr ^. drFootPrint) & each . each %~ shiftPointBy (doDoorLerp dr x)
-    clerp = dr ^. drLerp
-    newlerp
-        | toOpen && clerp < 1 = Just . min 1 $ clerp + speed
-        | clerp > 0 && not toOpen = Just . max 0 $ clerp - speed
-        | otherwise = Nothing
-    toOpen = doWdBl (_drTrigger dr) w
-    drid = _drID dr
-    playSound x
-        | _drPushedBy dr == PushesItself =
-            soundContinue (WallSound drid) (fst $ doDoorLerp dr x) slideDoorS (Just 1)
-        | otherwise = id
-
-destroyDoor :: Door -> World -> (S.Set Int2, World)
-destroyDoor dr w =
-    ( is
-    , w
-        & makeDoorDebris dr
-        & deleteWallIDs wlids
-        & cWorld . lWorld . doors %~ IM.delete (_drID dr)
-        --        & muchWlDustAt awl (0.5 * uncurry (+) (_drPos dr))
-        --        & flip (foldl' (flip $ muchWlDustAt awl)) (map (pos +.+) ps)
-        & stopPushing (_drPushes dr)
-        & (destroyMounts pa) (_drMounts dr)
-    )
-  where
-    pa = doDoorLerp dr (dr ^. drLerp)
-    is = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize)) ps
-    ps = (dr ^. drFootPrint) & each . each %~ shiftPointBy pa
-    wlids = IM.keysSet $ _drFootPrint dr
-
-destroyMounts :: Point2A -> [MountedObject] -> World -> World
-destroyMounts pa mos w = foldl' (flip $ destroyMount pa) w mos
-
-destroyMount :: Point2A -> MountedObject -> World -> World
-destroyMount pa = \case
-    MountedLight x _ _ -> destroyLSFlashAt $ x & _xy %~ shiftPointBy pa
-    MountedSPic{} -> id -- make debris?
-
-stopPushing :: Maybe Int -> World -> World
-stopPushing mdrid w = fromMaybe w $ do
-    drid <- mdrid
-    dr <- w ^? cWorld . lWorld . doors . ix drid
-    return $
-        w & cWorld . lWorld . doors . ix drid . drUpdate .~ DoorDoNothing
-            & stopPushing (_drPushes dr)

src/Dodge/Item/Weapon/LaserPath.hs

@@ -17,11 +17,7 @@ import Linear
 
 -- this needs to be tested with both reflections and refractions
 reflectLaserAlong ::
-    Float ->
-    Point2 ->
-    Point2 ->
-    World ->
-    (Maybe (Point2, Either Creature Wall), [Point2])
+    Float -> Point2 -> Point2 -> World -> (Maybe (Point2, Either Creature Wall), [Point2])
 {-# INLINE reflectLaserAlong #-}
 reflectLaserAlong phasev sp ep w = case thingHitFilt (const True) _wlUnshadowed sp ep w of
     Just (p, Right wl)
@@ -63,7 +59,8 @@ refract phasev x y wl p
     reflectExternal = 1 < abs (sin angleInc / phasev)
 
 -- note can hit multiple pulse balls
-reflectPulseLaserAlong :: Float -> Point2 -> Point2 -> World -> ([(Point2, Object)], [Point2])
+reflectPulseLaserAlong ::
+    Float -> Point2 -> Point2 -> World -> ([(Point2, Object)], [Point2])
 {-# INLINE reflectPulseLaserAlong #-}
 reflectPulseLaserAlong phasev sp ep w = f $ filter (isunshad . snd) $ crWlPbHit sp ep w
   where

src/Dodge/Placement/Instance/Wall.hs

@@ -22,7 +22,7 @@ import Dodge.Placement.Instance.Block
 import Geometry
 
 heightWallPS :: PlacementSpot -> Float -> [Point2] -> Placement
-heightWallPS spot h ps = psPtPl spot $ lowBlock Stone (materialColor Stone) h ps
+heightWallPS spot h = psPtPl spot . lowBlock Stone (materialColor Stone) h
 
 invisibleWall :: [Point2] -> Placement
 invisibleWall ps =
@@ -57,14 +57,14 @@ Places an breakable window between two points.
 Width 8, also extends out from each point by 8.
  -}
 windowLine :: Point2 -> Point2 -> Placement
-windowLine a b = sps0 $ PutLineBlock defaultWindow 8 a b
+windowLine a = sps0 . PutLineBlock defaultWindow 8 a
 
 {-
 Places an unbreakable window between two points.
 Width 7, also extends out from each point by 7.
  -}
 crystalLine :: Point2 -> Point2 -> Placement
-crystalLine a b = sps0 $ PutLineBlock defaultCrystalWall 7 a b
+crystalLine a = sps0 . PutLineBlock defaultCrystalWall 7 a
 
 --crystalLine a b = sps0 $ PutWall ps defaultCrystalWall
 --  where
@@ -109,8 +109,8 @@ replacePutID ::
     [PSType] ->
     Room ->
     Room
-replacePutID i psts r =
-    r & rmPmnts %~ flip (subZipWith (isPutID i) (\ps pt -> ps & plType .~ pt)) psts
+replacePutID i psts =
+    rmPmnts %~ flip (subZipWith (isPutID i) (\ps pt -> ps & plType .~ pt)) psts
 
 {- Partition a list by a predicate, apply a zip to those elements
 that satisfy the predicate, concatenate
@@ -146,17 +146,12 @@ isPutID i ps = Just i == ps ^? plType . putID
 --    aline = PutLineBlock baseBlockPane 9
 
 putBlockRect :: Float -> Float -> Float -> Float -> [Placement]
-putBlockRect a x b y =
-    [ blockLine (V2 a b) (V2 a y)
-    , blockLine (V2 a y) (V2 x y)
-    , blockLine (V2 x y) (V2 x b)
-    , blockLine (V2 x b) (V2 a b)
-    ]
+putBlockRect a x b y = uncurry blockLine <$> loopPairs (rectNSWE b y a x)
 
 putBlockV :: Float -> Float -> Float -> Float -> [Placement]
-putBlockV a x b y =
-    [ blockLine (V2 a b) (V2 a y)
-    , blockLine (V2 x b) (V2 a b)
+putBlockV a x b y = uncurry blockLine <$>
+    [ (V2 a b, V2 a y)
+    , (V2 x b, V2 a b)
     ]
 
 --putBlockC :: Float -> Float -> Float -> Float -> [Placement]
@@ -167,8 +162,8 @@ putBlockV a x b y =
 --    ]
 
 putBlockN :: Float -> Float -> Float -> Float -> [Placement]
-putBlockN a x b y =
-    [ blockLine (V2 a b) (V2 a y)
-    , blockLine (V2 x b) (V2 a b)
-    , blockLine (V2 x y) (V2 x b)
+putBlockN a x b y = uncurry blockLine <$>
+    [ (V2 a b, V2 a y)
+    , (V2 x b, V2 a b)
+    , (V2 x y, V2 x b)
     ]

src/Dodge/Projectile/Update.hs

@@ -13,7 +13,7 @@ import Dodge.Item.Location
 import Dodge.Movement.Turn
 import Dodge.Payload
 import Dodge.SoundLogic
-import Dodge.WorldEvent.Cloud
+--import Dodge.WorldEvent.Cloud
 import Dodge.WorldEvent.Sound
 import Geometry
 import qualified IntMapHelp as IM
@@ -126,7 +126,8 @@ tryThrust pj = fromMaybe id $ do
     return $ doThrust pj x . pjRemoteSetDirection y pj
 
 doThrust :: Projectile -> Maybe RocketSmoke -> World -> World
-doThrust pj smoke w =
+--doThrust pj smoke w =
+doThrust pj _ w =
     w
         & randGen .~ g
         & cWorld . lWorld . projectiles . ix i . pjVel . _xy %~ (\v -> accel + frict *^ v)
@@ -136,15 +137,15 @@ doThrust pj smoke w =
             (vel + rotateV (pi + sparkD) accel `v2z` 0)
             3
             10
-        & makeCloudAt
-            RocketSmoke
-            lifetime
-            (sp + r1 + 30 *^ signorm (sp - ep))
+--        & makeCloudAt
+--            RocketSmoke
+--            lifetime
+--            (sp + r1 + 30 *^ signorm (sp - ep))
   where
-    lifetime = fst . randomR lt $ _randGen w
-    lt
-        | smoke == Just ReducedRocketSmoke = (50, 200)
-        | otherwise = (300, 500)
+--    lifetime = fst . randomR lt $ _randGen w
+--    lt
+--        | smoke == Just ReducedRocketSmoke = (50, 200)
+--        | otherwise = (300, 500)
     accel = rotateV (pj ^. pjDir) (V2 3 0)
     i = _pjID pj
     sp = pj ^. pjPos
@@ -152,7 +153,7 @@ doThrust pj smoke w =
     ep = sp + vel
     (frict, g) = randomR (0.6, 0.9) $ _randGen w
     (sparkD, _) = randomR (-0.2, 0.2) $ _randGen w
-    r1 = addZ 0 $ randInCirc 10 & evalState $ _randGen w
+--    r1 = addZ 0 $ randInCirc 10 & evalState $ _randGen w
 
 doBarrelSpin :: Int -> Float -> Projectile -> World -> World
 doBarrelSpin cid i pj w =

src/Dodge/Room/Tutorial.hs

@@ -48,7 +48,7 @@ tutAnoTree = do
     foldMTRS
         [ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
         , corDoor
-        , tToBTree "cor" . return . cleatOnward <$> polyChasmC 6 120
+        , tToBTree "cor" . return . cleatOnward <$> southPillarsRoom 300 300 100
 --        , tToBTree "x" . return . cleatOnward <$> airlockSimple
 --        , tToBTree "lastun" . return . cleatOnward <$> tanksRoom [] []
         , return $ tToBTree "cor" $ return $ cleatOnward corridor

src/Dodge/Shockwave/Draw.hs

@@ -11,6 +11,6 @@ drawShockwave sw =
         $ thickCircle rad thickness
   where
     r = _swRad sw
-    thickness = tFraction ** 2 * r
+    thickness = min rad $ tFraction ** 2 * r
     rad = r - (3 / 4) * r * tFraction
     tFraction = fromIntegral (_swTimer sw) / fromIntegral (_swMaxTime sw)

src/Dodge/Shockwave/Update.hs

@@ -23,23 +23,10 @@ moveShockwave w sw
     tFraction = fromIntegral t / fromIntegral (_swMaxTime sw)
     rad = r - (3 / 4) * r * tFraction
     doDams 
-        | (p ^. _z >= 0) && (p ^. _z < 25) = damageInCircle (Explosive dam) (p ^. _xy) rad
+        | (p ^. _z >= 0) && (p ^. _z < 25)
+            && t > 5
+            = damageInCircle (Explosive dam) (p ^. _xy) rad
         | otherwise = id
---    doDams w' =
---        over (cWorld . lWorld . creatures) (IM.map damCr) $
---            foldl'
---                (flip $ damageWall (Explosive 1000 p))
---                w'
---                hitBlocks
---    hitBlocks = map snd . overlapCircWalls p rad $ wlsNearCirc p rad w
---    -- this is not expansive enough
---    damCr cr
---        | _crID cr `elem` is || dist (_crPos cr) p >= rad + crRad (cr ^. crType) = cr
---        | otherwise = cr & crDamage .:~ Explosive dam p
-
---where
---  cpos = _crPos cr
---  v = normalizeV (cpos -.- p)
 
 moveInverseShockwave ::
     World ->

src/Dodge/Update.hs

@@ -26,7 +26,7 @@ import Dodge.Data.Universe
 import Dodge.Debug
 import Dodge.DisplayInventory
 import Dodge.Distortion
-import Dodge.DrWdWd
+import Dodge.Door
 import Dodge.EnergyBall
 import Dodge.Flame
 import Dodge.Inventory

src/Dodge/WorldEvent/Explosion.hs

@@ -11,7 +11,7 @@ module Dodge.WorldEvent.Explosion (
 import Control.Monad
 import Data.List
 import Dodge.Data.World
-import Dodge.EnergyBall
+--import Dodge.EnergyBall
 import Dodge.SoundLogic
 import Dodge.WorldEvent.Shockwave
 import Dodge.WorldEvent.SpawnParticle
@@ -20,7 +20,7 @@ import LensHelp
 import Picture
 import RandomHelp
 import Linear.V3
-import Linear.Metric
+--import Linear.Metric
 
 makePoisonExplosionAt ::
     -- | Position
@@ -71,23 +71,25 @@ makeFlameExplosionAt p w =
 -- particle passes through for the first frame of its existence
 
 makeExplosionAt :: Point3 -> Point3 -> World -> World
-makeExplosionAt p vel w =
+--makeExplosionAt p vel w =
+makeExplosionAt p _ w =
     w
         & soundStart (Explosion (w ^. cWorld . lWorld . lClock)) (p ^. _xy) bangS Nothing
-        & addFlames
+--        & addFlames
         & cWorld . lWorld . worldEvents 
             .:~ MakeTempLight (LSParam p 150 (V3 1 0.5 0)) 20
-        & makeShockwaveAt [] p 50 50 1 white
+--        & makeShockwaveAt [] p 50 50 1 white
+        & makeShockwaveAt [] p 50 5000 1 white
   where
-    fVs = fmap (`v2z` 0) $ replicateM 100 (randInCirc 1) & evalState $ _randGen w
-    fPs' = fmap (`v2z` 0) $ replicateM 100 (randInCirc 5) & evalState $ _randGen w
-    fdamps = replicateM 100 (state $ randomR (0,1)) & evalState $ _randGen w
-    inversePushOut v = (15 - norm v) * 0.01 *.*.* v
-    fVs' = zipWith (+.+.+) fVs $ map inversePushOut fPs'
-    sizes = randomRs (2, 9) $ _randGen w
-    times = randomRs (15, 20) $ _randGen w
-    mF q v damp size time = makeFlamelet 
-        --(q - (2*v + 2* vel)) (v + damp *.*.* vel) size time
-        (q - (2*v )) (v + damp *.*.* vel) size time
-    newFs = zipWith4 (mF p) (zipWith (+) fPs' (fmap (3 *.*.*) fVs')) fdamps sizes times
-    addFlames w' = foldl' (flip ($)) w' newFs
+--    fVs = fmap (`v2z` 0) $ replicateM 100 (randInCirc 1) & evalState $ _randGen w
+--    fPs' = fmap (`v2z` 0) $ replicateM 100 (randInCirc 5) & evalState $ _randGen w
+--    fdamps = replicateM 100 (state $ randomR (0,1)) & evalState $ _randGen w
+--    inversePushOut v = (15 - norm v) * 0.01 *.*.* v
+--    fVs' = zipWith (+.+.+) fVs $ map inversePushOut fPs'
+--    sizes = randomRs (2, 9) $ _randGen w
+--    times = randomRs (15, 20) $ _randGen w
+--    mF q v damp size time = makeFlamelet 
+--        --(q - (2*v + 2* vel)) (v + damp *.*.* vel) size time
+--        (q - (2*v )) (v + damp *.*.* vel) size time
+--    newFs = zipWith4 (mF p) (zipWith (+) fPs' (fmap (3 *.*.*) fVs')) fdamps sizes times
+--    addFlames w' = foldl' (flip ($)) w' newFs

src/Dodge/WorldEvent/Shockwave.hs

@@ -8,7 +8,6 @@ import Geometry
 import LensHelp
 import Picture
 
--- currently very effective against walls
 makeShockwaveAt ::
     -- | IDs of invulnerable creatures.
     [Int] ->

src/Dodge/WorldEvent/ThingsHit.hs

@@ -17,6 +17,7 @@ module Dodge.WorldEvent.ThingsHit (
     isWalkable,
 ) where
 
+import Control.Applicative
 import Dodge.Wall.Pathing
 import Data.Monoid
 import qualified Data.Set as S
@@ -146,9 +147,17 @@ wlsHitUnsorted sp ep
 wlsHitRadial :: Point2 -> Float -> World -> [(Point2, Wall)]
 wlsHitRadial p r = mapMaybe f . wlsNearCirc p r
   where
-    f wl = uncurry (intersectSegSeg p (p - r *.* v)) (_wlLine wl) <&> (,wl)
+    --f wl = uncurry (intersectSegSeg p (p - r *.* v)) (_wlLine wl) <&> (,wl)
+    f wl = mhp <&> (,wl)
       where
-        v = normalizeV . vNormal . uncurry (-) $ _wlLine wl
+        (x,y) = wl ^. wlLine
+        t mp = do
+            p' <- mp
+            guard (distance p p' < r) 
+            mp
+        orthp = t $ orthogonalPointOnSeg x y p
+        mhp = orthp <|> t (return x) <|> t (return y)
+--        v = normalizeV . vNormal . uncurry (-) $ _wlLine wl
 
 crsHitRadial :: Point2 -> Float -> World -> [(Point2, Creature)]
 crsHitRadial p r = mapMaybe f . crsNearCirc p r
@@ -156,7 +165,7 @@ crsHitRadial p r = mapMaybe f . crsNearCirc p r
     f cr = do
         let cp = cr ^. crPos . _xy
         guard $ dist p cp < r + crRad (_crType cr)
-        return (cp + (1 + crRad (_crType cr)) *.* (cp - p), cr)
+        return (cp + (1 + crRad (_crType cr)) *^ (cp - p), cr)
 
 isFlyable :: Point2 -> Point2 -> World -> Bool
 {-# INLINE isFlyable #-}

src/Dodge/Zoning/Creature.hs

@@ -34,7 +34,8 @@ crIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet
 crIXsNearCirc p r = crsNearRect (p +.+ V2 r r) (p -.- V2 r r)
 
 crsNearCirc :: Point2 -> Float -> World -> [Creature]
-crsNearCirc p r w = mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid) . IS.toList $ crIXsNearCirc p r w
+crsNearCirc p r w = mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid) . IS.toList
+    $ crIXsNearCirc p r w
 
 crsNearRect :: Point2 -> Point2 -> World -> IS.IntSet
 crsNearRect = nearRect crZoneSize _crZoning

src/Geometry/Intersect.hs

@@ -295,7 +295,7 @@ closestPointOnLineParam ::
     Float
 {-# INLINE closestPointOnLineParam #-}
 closestPointOnLineParam !a !b !p =
-    (p -.- a) `dotV` (b -.- a) / (b -.- a) `dotV` (b -.- a)
+    (p - a) `dotV` (b - a) / (b - a) `dotV` (b - a)
 
 {- | Given a segment and external point, find the closest point on the segment.
  clamps to the end of the segment
@@ -312,7 +312,7 @@ closestPointOnSeg segP1 segP2 p
 orthogonalPointOnSeg :: Point2 -> Point2 -> Point2 -> Maybe Point2
 orthogonalPointOnSeg a b p
     | param < 0 || param > 1 = Nothing
-    | otherwise = Just $ a +.+ param *.* normalizeV (b -.- a)
+    | otherwise = Just $ a + param *^ normalizeV (b - a)
   where
     param = closestPointOnLineParam a b p