60 lines
2.3 KiB
Haskell
60 lines
2.3 KiB
Haskell
module Dodge.Item.Weapon.LaserPath
|
|
( reflectLaserAlong
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Wall.Reflect
|
|
--import Dodge.Creature.HandPos
|
|
import Dodge.WorldEvent
|
|
--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
|
|
import Data.List
|
|
import Data.Bifunctor
|
|
import Data.Tuple
|
|
|
|
-- not sure why we need to keep a list of seen walls, but seems to loop
|
|
-- infinitely when removed
|
|
-- this needs to be tested with both reflections and refractions
|
|
reflectLaserAlong :: Float -> [Wall] -> Point2 -> Point2 -> World
|
|
-> (Maybe (Point2,Either Creature Wall),[Point2])
|
|
reflectLaserAlong phasev seenWl sp ep w = case find (notseen seenWl)
|
|
$ thingsHitExceptCrLongLine Nothing sp ep w of
|
|
Just (p,Right wl)
|
|
| _wlReflect wl -> second (p:) $ reflectLaserAlong phasev (wl:seenWl) p
|
|
(p +.+ 800 *.* unitVectorAtAngle (reflDirWall sp p wl)) w
|
|
| _wlOpacity wl == SeeThrough -> second (p:) $ reflectLaserAlong phasev (wl:seenWl) p
|
|
(refract sp ep wl p) w
|
|
| otherwise -> (Just (p,Right wl), [p])
|
|
Just (p,obj) -> (Just (p,obj), [p])
|
|
Nothing -> (Nothing, [ep])
|
|
where
|
|
notseen ws (_,Right wl) = not $ any (\w' -> _wlID w' == _wlID wl) ws
|
|
notseen _ _ = True
|
|
refract 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)
|