justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Simplify laser reflection/refraction

Browse Source
This commit is contained in:
justin
2025-10-27 19:41:52 +00:00
parent 7c40db7153
commit 20042fcf8d
3 changed files with 27 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Item/Weapon/LaserPath.hs
+22 -33
View File
@@ -1,17 +1,19 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Item.Weapon.LaserPath (
reflectLaserAlong,
reflectPulseLaserAlong,
) where
import Control.Lens
import Dodge.Data.Object
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 ::
@@ -24,28 +26,22 @@ reflectLaserAlong ::
reflectLaserAlong phasev sp ep w = case thingHitFilt (const True) _wlUnshadowed sp ep w of
Just (p, Right wl)
| Metal <- wl ^. wlMaterial ->
second (p :) $
reflectLaserAlong
phasev
(p +.+ unitVectorAtAngle (reflDirWall sp p wl))
(p +.+ dist p ep *.* unitVectorAtAngle (reflDirWall sp p wl))
w
f
p
(p + angle (reflWall sp p wl))
(p + distance p ep *^ angle (reflWall sp p wl))
| 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])
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')
| isEntering = p + rotateV angleRef (normalDist wlNormal)
| otherwise = p + rotateV angleRef' (normalDist wlNormal')
where
wlNormal = vNormal $ uncurry (-.-) $ swap (_wlLine wl)
wlNormal' = vNormal $ uncurry (-.-) (_wlLine wl)
@@ -67,29 +63,22 @@ 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
f = \case
((p, OWall wl) : _)
| Metal <- wl ^. wlMaterial ->
second (p :) $
reflectPulseLaserAlong
phasev
(p +.+ unitVectorAtAngle (reflDirWall sp p wl))
(p +.+ dist p ep *.* unitVectorAtAngle (reflDirWall sp p wl))
w
g
p
(p + angle (reflWall sp p wl))
(p + distance p ep *.* angle (reflWall sp p wl))
| 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])
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