95 lines
3.4 KiB
Haskell
95 lines
3.4 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
module Dodge.Item.Weapon.LaserPath (
|
|
reflectLaserAlong,
|
|
reflectPulseLaserAlong,
|
|
) where
|
|
|
|
import Dodge.Data.Object
|
|
import Data.Bifunctor
|
|
import Data.Tuple
|
|
import Dodge.Base.Wall
|
|
import Dodge.Data.World
|
|
import Dodge.WorldEvent
|
|
import Geometry
|
|
|
|
-- 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)
|
|
| _wlReflect wl ->
|
|
second (p :) $
|
|
reflectLaserAlong
|
|
phasev
|
|
(p +.+ unitVectorAtAngle (reflDirWall sp p wl))
|
|
(p +.+ dist p ep *.* unitVectorAtAngle (reflDirWall sp p wl))
|
|
w
|
|
| wlIsSeeThrough wl ->
|
|
second (p :) $
|
|
reflectLaserAlong
|
|
phasev
|
|
(p +.+ normalizeV (refract phasev sp ep wl p))
|
|
(refract phasev sp ep wl p)
|
|
w
|
|
| otherwise -> (Just (p, Right wl), [p])
|
|
Just (p, obj) -> (Just (p, obj), [p])
|
|
Nothing -> (Nothing, [ep])
|
|
|
|
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) : _)
|
|
| _wlReflect wl ->
|
|
second (p :) $
|
|
reflectPulseLaserAlong
|
|
phasev
|
|
(p +.+ unitVectorAtAngle (reflDirWall sp p wl))
|
|
(p +.+ dist p ep *.* unitVectorAtAngle (reflDirWall sp p wl))
|
|
w
|
|
| wlIsSeeThrough wl ->
|
|
second (p :) $
|
|
reflectPulseLaserAlong
|
|
phasev
|
|
(p +.+ normalizeV (refract phasev sp ep wl p))
|
|
(refract phasev sp ep wl p)
|
|
w
|
|
| otherwise -> ([(p, OWall wl)], [p])
|
|
(x@(_,OPulseBall _) : ps ) -> first (x:) $ f ps
|
|
((p, obj):_) -> ([(p, obj)], [p])
|
|
[] -> ([], [ep])
|
|
isunshad (OWall wl) = _wlUnshadowed wl
|
|
isunshad _ = True
|