Commit before attempting to unify hammers for used items

This commit is contained in:
2022-07-07 07:24:42 +01:00
parent 0eb2fdc37e
commit 9159281f85
12 changed files with 85 additions and 56 deletions
+27 -26
View File
@@ -22,35 +22,36 @@ reflectLaserAlong phasev sp ep w = case thingHitFilt (const True) _wlDraw sp ep
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))
(p +.+ dist p ep *.* unitVectorAtAngle (reflDirWall sp p wl))
w
| wlIsSeeThrough wl -> second (p:) $ reflectLaserAlong phasev
(p +.+ normalizeV (refract sp ep wl p))
(refract sp ep wl p)
(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])
where
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)
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)