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

Move towards removal of ssaTri, which was buggy

Browse Source
This commit is contained in:
justin
2021-12-15 12:00:07 +00:00
parent c5a211afce
commit dccacd9d22
7 changed files with 57 additions and 70 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base.hs
+30 -40
View File
@@ -193,9 +193,9 @@ newCrKey :: World -> Int
newCrKey = IM.newKey . _creatures
{- | TODO: determine precisely what this does. -}
reflectPointCreature :: Point2 -> Point2 -> Creature -> Maybe (Point2, Point2, Int)
reflectPointCreature p1 p2 cr = case collidePointCirc p1 p2 (_crRad cr) (_crPos cr) of
reflectPointCreature p1 p2 cr = case intersectCircSegFirst (_crPos cr) (_crRad cr) p1 p2 of
Nothing -> Nothing
Just _ -> Just
Just a -> Just
( p1
, errorNormalizeV 35 (ssaTriPoint p2 (_crPos cr) p1 (_crRad cr) -.- _crPos cr)
+.+ (_crPos cr -.- _crOldPos cr)
@@ -214,7 +214,7 @@ reflectCircCreature
-> Point2 -- ^ End point
-> Creature
-> Maybe (Point2, Point2, Int)
reflectCircCreature rad p1 p2 cr = case collidePointCirc p1 p2 (rad + _crRad cr) (_crPos cr) of
reflectCircCreature rad p1 p2 cr = case intersectCircSegFirst (_crPos cr) (rad + _crRad cr) p1 p2 of
Nothing -> Nothing
Just _ -> Just
( p1
@@ -335,55 +335,45 @@ collidePointWallsNorm p1 p2 ws
where
f (a,_) = magV (p1 -.- a)
-- | Returns the first creature, if any, that a point intersects with.
collidePointCreatures :: Point2 -> Point2 -> World -> Maybe Int
collidePointCreatures p1 p2 w
collidePointCreatures :: Point2 -> Point2 -> IM.IntMap Creature -> Maybe Int
collidePointCreatures p1 p2 crs
= fmap fst
. safeMinimumOn snd
. IM.toList
. IM.mapMaybe (\x -> collidePointCirc' p1 p2 (_crRad x) (_crPos x))
$_creatures w
. IM.mapMaybe (\x -> fmap (dist p1) $ intersectCircSegFirst (_crPos x) (_crRad x) p1 p2)
$ crs
-- | As for 'collidePointCreatures', only increases the radius of creatures by a
--fixed amount, thus collides a moving circle with creaures.
collideCircCreatures :: Point2 -> Point2 -> Float -> World -> Maybe Int
collideCircCreatures p1 p2 rad w
= fmap fst
. safeMinimumOn snd
. IM.toList
. IM.mapMaybe (\x -> collidePointCirc' p1 p2 (rad + _crRad x) (_crPos x))
$ _creatures w
collideCircCreatures :: Point2 -> Point2 -> Float -> IM.IntMap Creature -> Maybe Int
collideCircCreatures p1 p2 rad = collidePointCreatures p1 p2 . fmap (crRad +~ rad)
-- | Returns the first creature id, if any, that a point intersects with, gives point
--in creature on line.
collidePointCrsPoint :: Point2 -> Point2 -> World -> Maybe (Point2,Int)
collidePointCrsPoint p1 p2 w
collidePointCrsPoint :: Point2 -> Point2 -> IM.IntMap Creature -> Maybe (Point2,Int)
collidePointCrsPoint p1 p2 crs
= fmap f
. safeMinimumOn (snd . snd)
. safeMinimumOn (dist p1 . snd)
. IM.toList
. IM.mapMaybe (\x -> collidePointCirc'' p1 p2 (_crRad x) (_crPos x))
$ _creatures w
. IM.mapMaybe (\x -> intersectCircSegFirst (_crPos x) (_crRad x) p1 p2)
$ crs
where
f (cID,(p,_)) = (p,cID)
f (cID,p) = (p,cID)
{- | Finds the first creature hit on a line.
Maybe evaluates the creature id and hit point. -}
collideCircCrsPoint :: Point2 -> Point2 -> Float -> World -> Maybe (Point2,Int)
collideCircCrsPoint p1 p2 rad w
= fmap f
. safeMinimumOn (snd . snd)
. IM.toList
. IM.mapMaybe (\x -> collidePointCirc'' p1 p2 (rad + _crRad x) (_crPos x))
$ _creatures w
where
f (cID,(p,_)) = (p,cID)
-- | Makes a creature not hittable.
collidePointCrsWithoutPoint :: Int -> Point2 -> Point2 -> World -> Maybe (Point2,Int)
collidePointCrsWithoutPoint cid p1 p2 w
= fmap f
. safeMinimumOn (snd . snd)
. IM.toList
. IM.mapMaybe (\x -> collidePointCirc'' p1 p2 (_crRad x) (_crPos x))
. IM.delete cid
$ _creatures w
where
f (cID,(p,_)) = (p,cID)
collideCircCrsPoint :: Point2 -> Point2 -> Float -> IM.IntMap Creature -> Maybe (Point2,Int)
collideCircCrsPoint p1 p2 rad = collidePointCrsPoint p1 p2 . fmap (crRad +~ rad)
---- | Makes a creature not hittable.
--collidePointCrsWithoutPoint :: Int -> Point2 -> Point2 -> World -> Maybe (Point2,Int)
--collidePointCrsWithoutPoint cid p1 p2 w
-- = fmap f
-- . safeMinimumOn (snd . snd)
-- . IM.toList
-- . IM.mapMaybe (\x -> collidePointCirc'' p1 p2 (_crRad x) (_crPos x))
-- . IM.delete cid
-- $ _creatures w
-- where
-- f (cID,(p,_)) = (p,cID)
{- | Test if a circle collides with any wall.
- Note no check on whether the wall is walkable. -}
circOnSomeWall :: Point2 -> Float -> World -> Bool
src/Dodge/Item/Weapon/Launcher.hs
+2 -2
View File
@@ -204,7 +204,7 @@ moveShell pj w
vel = _pjVel pj
projectileExplosion = _pjPayload pj
newPos = oldPos +.+ vel
hitCr = fst <$> collideCircCrsPoint oldPos newPos 4 w
hitCr = fst <$> collideCircCrsPoint oldPos newPos 4 (_creatures w)
hitWl = fst <$> collideCircWalls oldPos newPos 2 (wallsNearPoint newPos w)
thingHit = hitCr <|> hitWl
@@ -363,7 +363,7 @@ moveRemoteShell cid itid pj w
accel = rotateV newdir (V2 2 0)
(frict,g) = randomR (0.6,0.9) $ _randGen w
(sparkD,_) = randomR (-0.5,0.5) $ _randGen w
hitCr = fst <$> collideCircCrsPoint oldPos newPos 4 w
hitCr = fst <$> collideCircCrsPoint oldPos newPos 4 (_creatures w)
hitWl = fst <$> collideCircWalls oldPos newPos 2 (wallsNearPoint newPos w)
thingHit = hitCr <|> hitWl
r1 = _randGen w & evalState (randInCirc 10)
src/Dodge/Item/Weapon/UseEffect.hs
+5 -5
View File
@@ -1,11 +1,10 @@
{- |
Effects centered on creatures.
These are typically item effects, and typical occur when an item is explictly used. -}
module Dodge.Item.Weapon.UseEffect
where
module Dodge.Item.Weapon.UseEffect where
import Dodge.Data
import Dodge.Zone
import Dodge.Picture.Layer
--import Dodge.Zone
--import Dodge.Picture.Layer
import Picture
import Geometry
@@ -78,7 +77,8 @@ mvRadar
-> Point2 -- ^ Center of expanding circle
-> World -> Particle -> (World, Maybe Particle)
mvRadar 0 _ w _ = (w, Nothing)
mvRadar x p w pt = undefined
mvRadar _ _ w _ = (w, Nothing)
--mvRadar x p w pt = undefined
-- ( putBlips w
-- , Just $ pt {_ptDraw = const pic ,_ptUpdate = mvRadar (x-1) p }
-- )
src/Dodge/Placement/Instance/Turret.hs
+1 -1
View File
@@ -37,7 +37,7 @@ putLasTurret rotSpeed = sps0 $ PutMachine blue (reverse $ square wdth) defaultMa
lasTurret :: MachineType
lasTurret = Turret
{ _tuWeapon = lasGun
--{ _tuWeapon = autoRifle
-- { _tuWeapon = autoRifle
, _tuTurnSpeed = 0.1
, _tuFireTime = 0
, _tuMCrID = Nothing
src/Dodge/WorldEvent/ThingsHit.hs
+1 -6
View File
@@ -124,14 +124,9 @@ thingsHitLongLine sp ep w
where
crs = mapMaybe
(\cr -> (,Left cr) <$> listToMaybe (intersectCircSeg (_crPos cr) (_crRad cr) sp ep))
. IM.elems $ _creatures w
--crs = zip crPs (map Left hitCrs)
hitCrs = IM.elems
. IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
. IM.elems
$ _creatures w
-- $ creaturesAlongLine sp ep w
crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
--crPs = map _crPos hitCrs
wls = zip (map (fromJust . hitPoint) hitWls) (map Right hitWls)
--hitWls = wallsOnLine sp ep $ wallsAlongLine sp ep w
hitWls = wallsOnLine sp ep $ _walls w
src/Geometry.hs
+14 -14
View File
@@ -188,12 +188,12 @@ ssaTriPoint pa pb pc' bc
ac = ssaTri ab bc a
in pa +.+ (ac *.* errorNormalizeV 47 (pc' -.- pa))
-- | Safe version of 'ssaTriPoint'.
ssaTriPoint' :: Point2 -> Point2 -> Point2 -> Float -> Maybe Point2
ssaTriPoint' pa pb pc' bc
| dist pb (closestPointOnSeg pa pc' pb) >= bc
= Nothing
| otherwise
= Just $ ssaTriPoint pa pb pc' bc
--ssaTriPoint' :: Point2 -> Point2 -> Point2 -> Float -> Maybe Point2
--ssaTriPoint' pa pb pc' bc
-- | dist pb (closestPointOnSeg pa pc' pb) >= bc
-- = Nothing
-- | otherwise
-- = Just $ ssaTriPoint pa pb pc' bc
-- | Return Just a point if it is inside a circle, Nothing otherwise.
pointInCircle :: Point2 -> Float -> Point2 -> Maybe Point2
pointInCircle p r c
@@ -203,16 +203,16 @@ pointInCircle p r c
-- | Determines if a moving point intersects with a circle,
-- if so, returns a point on circle that intersects with the line passing
-- throught the circle : HOPEFULLY THE CORRECT OF THE TWO!
collidePointCirc :: Point2 -> Point2 -> Float -> Point2 -> Maybe Point2
collidePointCirc p1 p2 rad c = ssaTriPoint' p2 c p1 rad
--collidePointCirc :: Point2 -> Point2 -> Float -> Point2 -> Maybe Point2
--collidePointCirc p1 p2 rad c = ssaTriPoint' p2 c p1 rad
-- | As 'collidePointCirc', but changes the point to a measure of the distance.
collidePointCirc' :: Point2 -> Point2 -> Float -> Point2 -> Maybe Float
collidePointCirc' p1 p2 rad c = fmap (\x -> magV (x -.- p1))
(collidePointCirc p1 p2 rad c)
--collidePointCirc' :: Point2 -> Point2 -> Float -> Point2 -> Maybe Float
--collidePointCirc' p1 p2 rad c = fmap (\x -> magV (x -.- p1))
-- (collidePointCirc p1 p2 rad c)
-- | As 'collidePointCirc', but returns both the point and the measure of the distance.
collidePointCirc'' :: Point2 -> Point2 -> Float -> Point2 -> Maybe (Point2,Float)
collidePointCirc'' p1 p2 rad c = (,) <$> collidePointCirc p1 p2 rad c
<*> collidePointCirc' p1 p2 rad c
--collidePointCirc'' :: Point2 -> Point2 -> Float -> Point2 -> Maybe (Point2,Float)
--collidePointCirc'' p1 p2 rad c = (,) <$> collidePointCirc p1 p2 rad c
-- <*> collidePointCirc' p1 p2 rad c
-- | Finds the height of a triangle using herons formula.
-- The base is the line between the first two points.
heron :: Point2 -> Point2 -> Point2 -> Float
src/Geometry/Intersect.hs
+4 -2
View File
@@ -8,8 +8,7 @@ import Geometry.LHS
import Control.Applicative
import Data.List
import Data.Maybe (isNothing)
import Data.Maybe
-- | If two lines intersect, return 'Just' that point.
intersectLineLine' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
{-# INLINE intersectLineLine' #-}
@@ -267,3 +266,6 @@ intersectCircSeg c r a b
y = r ** 2 - x ** 2
z = sqrt y
v = z *.* normalizeV (b -.- a)
intersectCircSegFirst :: Point2 -> Float -> Point2 -> Point2 -> Maybe Point2
intersectCircSegFirst c r a = listToMaybe . intersectCircSeg c r a