Files
loop/src/Dodge/Item/Weapon/LaserPath.hs
T

82 lines
2.9 KiB
Haskell

{-# LANGUAGE LambdaCase #-}
module Dodge.Item.Weapon.LaserPath (
reflectLaserAlong,
reflectPulseLaserAlong,
) where
import Data.Bifunctor
import Data.Tuple
import Dodge.Base.Wall
import Dodge.Data.Object
import Dodge.Data.World
import Dodge.WorldEvent
import Geometry
import LensHelp
import Linear
-- this needs to be tested with both reflections and refractions
reflectLaserAlong ::
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)
| Metal <- wl ^. wlMaterial ->
f
p
(p + angle (reflWall sp p wl))
(p + distance p ep *^ angle (reflWall sp p wl))
| wlIsSeeThrough wl ->
f p (p + signorm (refract phasev sp ep wl p)) (refract phasev sp ep wl p)
Just (p, obj) -> (Just (p, obj), [p])
Nothing -> (Nothing, [ep])
where
f p a b = reflectLaserAlong phasev a b w & _2 .:~ p
refract :: Float -> Point2 -> Point2 -> Wall -> Point2 -> Point2
{-# INLINE refract #-}
refract phasev x y wl p
| isEntering = p + rotateV angleRef (normalDist wlNormal)
| otherwise = p + rotateV angleRef' (normalDist wlNormal')
where
wlNormal = vNormal $ uncurry (-.-) $ swap (_wlLine wl)
wlNormal' = vNormal $ uncurry (-.-) (_wlLine wl)
normalDist wlnormal = magV (p -.- y) *.* normalizeV wlnormal
angleInc = piRange $ argV wlNormal - argV (x -.- y)
angleRef
| reflectExternal = angleInc
| otherwise = asin $ sin angleInc / phasev
piRange a'
| a' > pi = a' - 2 * pi
| a' > negate pi = a'
| otherwise = a' + 2 * pi
isEntering = not $ isLeftOf (x -.- y) (uncurry (-.-) (_wlLine wl))
angleInc' = piRange $ argV wlNormal' - argV (x -.- y)
angleRef'
| reflectInternal = angleInc'
| otherwise = asin $ phasev * sin angleInc'
reflectInternal = 1 < abs (phasev * sin angleInc')
reflectExternal = 1 < abs (sin angleInc / phasev)
-- note can hit multiple pulse balls
reflectPulseLaserAlong ::
Float -> Point2 -> Point2 -> World -> ([(Point2, Object)], [Point2])
{-# INLINE reflectPulseLaserAlong #-}
reflectPulseLaserAlong phasev sp ep w = f $ filter (isunshad . snd) $ crWlPbHit sp ep w
where
f = \case
((p, OWall wl) : _)
| Metal <- wl ^. wlMaterial ->
g
p
(p + angle (reflWall sp p wl))
(p + distance p ep *.* angle (reflWall sp p wl))
| wlIsSeeThrough wl ->
g p (p + signorm (refract phasev sp ep wl p)) (refract phasev sp ep wl p)
(x@(_, OPulseBall _) : ps) -> first (x :) $ f ps
((p, obj) : _) -> ([(p, obj)], [p])
[] -> ([], [ep])
isunshad (OWall wl) = _wlUnshadowed wl
isunshad _ = True
g p a b = reflectPulseLaserAlong phasev a b w & _2 .:~ p