diff --git a/src/Dodge/Cloud.hs b/src/Dodge/Cloud.hs deleted file mode 100644 index db8615028..000000000 --- a/src/Dodge/Cloud.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Dodge.Cloud (clAlt) where - -import Dodge.Data.Cloud - -clAlt :: Cloud -> Float -clAlt cl = case _clType cl of - Smoke -> 90 - RocketSmoke -> 30 - CryoReleaseCloud -> 50 - GasCloud -> 20 - ---clRad :: Cloud -> Float ---clRad cl = case _clType cl of --- SmokeCloud -> 15 --- FlamerSmokeCloud -> 6 --- RocketCloud -> 15 --- StoneDust -> 15 --- CryoReleaseCloud -> 10 --- GasCloud -> 15 --- BloodCloud -> 10 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index be01bcf3a..295fd5b20 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -14,7 +14,7 @@ import Data.Maybe import Data.Monoid import Dodge.Base import Dodge.Bullet -import Dodge.Cloud +--import Dodge.Cloud import Dodge.CrGroupUpdate import Dodge.Creature.Mass import Dodge.Creature.Radius @@ -802,17 +802,15 @@ updateCloud w c & clTimer -~ 1 ) where - newVel@(V3 _ _ nvz) = (0.95 *^ springVels) + V3 0 0 (0.01 * vertVel) - newVel2 = stripZ newVel - vertVel = min 5 $ clAlt c - opz + newVel = 0.95 *^ (springVels & _z +~ 0.02) springVels = foldl' (clClSpringVel c) (_clVel c) (clsNearPoint oldPos2 w) - oldPos@(V3 _ _ opz) = _clPos c + oldPos = _clPos c oldPos2 = stripZ oldPos - newPos@(V3 _ _ npz) = oldPos +.+.+ newVel + newPos@(V3 _ _ npz) = oldPos + newVel newPos2 = stripZ newPos hitWl = bouncePoint (const True) 1 oldPos2 newPos2 w finalPos = addZ (max 1 $ min 90 npz) $ maybe newPos2 fst hitWl - finalVel = addZ nvz $ maybe newVel2 snd hitWl + finalVel = newVel & _xy %~ maybe id (const . snd) hitWl updateDust :: World -> Dust -> Maybe Dust updateDust w c @@ -835,12 +833,12 @@ updateDust w c clClSpringVel :: Cloud -> Point3 -> Cloud -> Point3 clClSpringVel a v b - | dist3 pa pb < radDist = v +.+.+ 0.1 *.*.* normalizeV3 (pa -.-.- pb) + | dist3 pa pb < radDist = v + 0.1 *^ normalize (pa - pb) | otherwise = v where pa = _clPos a pb = _clPos b - radDist = 10 + radDist = 8 --radDist = (_clRad a + _clRad b) / 2 diff --git a/src/Dodge/Wall/Damage.hs b/src/Dodge/Wall/Damage.hs index 3535364b8..5ed6da064 100644 --- a/src/Dodge/Wall/Damage.hs +++ b/src/Dodge/Wall/Damage.hs @@ -3,9 +3,7 @@ {- | Controls a walls response to external damage. - Indestructible walls may still produce sparks, dust etc -} -module Dodge.Wall.Damage ( - damageWall, -) where +module Dodge.Wall.Damage (damageWall) where import Control.Monad import Data.Foldable diff --git a/src/Dodge/Zoning/Base.hs b/src/Dodge/Zoning/Base.hs index 8ff2769f0..4ea904b01 100644 --- a/src/Dodge/Zoning/Base.hs +++ b/src/Dodge/Zoning/Base.hs @@ -44,6 +44,7 @@ makeIntInterval x y -- [V2 x y | x <- makeIntInterval x1 x2, y <- makeIntInterval y1 y2] zoneOfPoint :: Float -> Point2 -> Int2 +{-# INLINE zoneOfPoint #-} zoneOfPoint = fmap . divTo zoneOfSeg :: Float -> Point2 -> Point2 -> [Int2] diff --git a/src/Dodge/Zoning/Cloud.hs b/src/Dodge/Zoning/Cloud.hs index 22651ff24..64e257ea4 100644 --- a/src/Dodge/Zoning/Cloud.hs +++ b/src/Dodge/Zoning/Cloud.hs @@ -1,22 +1,28 @@ -module Dodge.Zoning.Cloud where +module Dodge.Zoning.Cloud ( + clsNearPoint, + zoneCloud, + zoneDust, + dssNearPoint, +) where import Dodge.Data.World import Dodge.Zoning.Base +import Dodge.Zoning.Common import Geometry import qualified IntMapHelp as IM -import Dodge.Zoning.Common clsNearPoint :: Point2 -> World -> [Cloud] +{-# INLINE clsNearPoint #-} clsNearPoint = nearPoint clZoneSize _clZoning -clsNearSeg :: Point2 -> Point2 -> World -> [Cloud] -clsNearSeg = nearSeg clZoneSize _clZoning - -clsNearRect :: Point2 -> Point2 -> World -> [Cloud] -clsNearRect = nearRect clZoneSize _clZoning - -clsNearCirc :: Point2 -> Float -> World -> [Cloud] -clsNearCirc p r = clsNearRect (p +.+ V2 r r) (p -.- V2 r r) +--clsNearSeg :: Point2 -> Point2 -> World -> [Cloud] +--clsNearSeg = nearSeg clZoneSize _clZoning +-- +--clsNearRect :: Point2 -> Point2 -> World -> [Cloud] +--clsNearRect = nearRect clZoneSize _clZoning +-- +--clsNearCirc :: Point2 -> Float -> World -> [Cloud] +--clsNearCirc p r = clsNearRect (p +.+ V2 r r) (p -.- V2 r r) clZoneSize :: Float clZoneSize = 20 @@ -30,14 +36,14 @@ zoneCloud cl = zoneMonoid (zoneOfCl cl) [cl] dssNearPoint :: Point2 -> World -> [Dust] dssNearPoint = nearPoint dsZoneSize _dsZoning -dssNearSeg :: Point2 -> Point2 -> World -> [Dust] -dssNearSeg = nearSeg dsZoneSize _dsZoning - -dssNearRect :: Point2 -> Point2 -> World -> [Dust] -dssNearRect = nearRect dsZoneSize _dsZoning - -dssNearCirc :: Point2 -> Float -> World -> [Dust] -dssNearCirc p r = dssNearRect (p +.+ V2 r r) (p -.- V2 r r) +--dssNearSeg :: Point2 -> Point2 -> World -> [Dust] +--dssNearSeg = nearSeg dsZoneSize _dsZoning +-- +--dssNearRect :: Point2 -> Point2 -> World -> [Dust] +--dssNearRect = nearRect dsZoneSize _dsZoning +-- +--dssNearCirc :: Point2 -> Float -> World -> [Dust] +--dssNearCirc p r = dssNearRect (p +.+ V2 r r) (p -.- V2 r r) dsZoneSize :: Float dsZoneSize = 20