Work on sensor machines, remove some datatypes associated with placements
This commit is contained in:
@@ -4,6 +4,7 @@ Effects of bullets upon impact with walls or creatures.
|
||||
module Dodge.Particle.Bullet.HitEffect
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.Particle.Spark
|
||||
import Dodge.Data.DamageType
|
||||
import Dodge.Data.SoundOrigin
|
||||
import Dodge.Wall.Damage
|
||||
|
||||
@@ -0,0 +1,41 @@
|
||||
module Dodge.Particle.Spark
|
||||
( colSpark
|
||||
, colSpark'
|
||||
)
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.Data.DamageType
|
||||
import Dodge.Particle.Bullet.Draw
|
||||
import Dodge.Particle.Bullet.Update
|
||||
import Dodge.WorldEvent.HitEffect
|
||||
import Dodge.Creature.State.Data
|
||||
import Color
|
||||
import Geometry
|
||||
|
||||
import System.Random
|
||||
import Control.Lens
|
||||
|
||||
colSpark :: Int -> Color -> Point2 -> Float -> World -> World
|
||||
colSpark = colSpark' 0.7
|
||||
colSpark' :: Float -> Int -> Color -> Point2 -> Float -> World -> World
|
||||
colSpark' randDir time col pos baseDir w = w
|
||||
& worldEvents %~ ( over particles (spark :) . )
|
||||
& randGen .~ g
|
||||
where
|
||||
(a,g) = randomR (-randDir,randDir) $ _randGen w
|
||||
dir = a + baseDir
|
||||
spark = BulletPt
|
||||
{ _ptDraw = drawBul
|
||||
, _ptUpdate = mvGenBullet
|
||||
, _btVel' = rotateV dir (V2 5 0)
|
||||
, _btColor' = col
|
||||
, _btTrail' = [pos]
|
||||
, _btPassThrough' = Nothing
|
||||
, _btWidth' = 1
|
||||
, _btTimer' = time
|
||||
, _btHitEffect' = destroyOnImpact sparkEff noEff
|
||||
}
|
||||
sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : )
|
||||
where
|
||||
sp = head (_btTrail' bt)
|
||||
ep = sp +.+ _btVel' bt
|
||||
@@ -0,0 +1,132 @@
|
||||
module Dodge.Particle.TeslaArc
|
||||
( makeTeslaArcAt
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Dodge.Data.DamageType
|
||||
import Dodge.Creature.State.Data
|
||||
import Dodge.WorldEvent.Damage
|
||||
import Dodge.Base
|
||||
import Dodge.Zone
|
||||
import Dodge.Base.Collide
|
||||
import Dodge.Picture
|
||||
import Dodge.Particle.Spark
|
||||
import Dodge.WorldEvent.ThingsHit
|
||||
import Dodge.RandomHelp
|
||||
import Picture
|
||||
import Geometry
|
||||
import qualified IntMapHelp as IM
|
||||
|
||||
import Control.Lens
|
||||
import System.Random
|
||||
import Control.Monad.State
|
||||
import Data.Function (on)
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
makeTeslaArcAt :: Color -> Point2 -> Float -> Particle
|
||||
makeTeslaArcAt col pos dir = LinearParticle
|
||||
{ _ptPoints = [pos]
|
||||
, _ptDraw = drawTeslaArc
|
||||
, _ptUpdate = moveTeslaArc pos dir
|
||||
, _ptTimer = 2
|
||||
, _ptColor = brightX 100 1.5 col
|
||||
}
|
||||
drawTeslaArc :: Particle -> Picture
|
||||
drawTeslaArc pt = setLayer 1 $ pictures
|
||||
[ setDepth 20.5 $ color (brightX 2 1 $ _ptColor pt) $ lineOfThickness 3 ps
|
||||
, setDepth 20 $ color (V4 0 0 0 0.5) $ lineOfThickness 10 ps
|
||||
]
|
||||
where
|
||||
ps = _ptPoints pt
|
||||
-- todo: fix electrical damage location
|
||||
moveTeslaArc
|
||||
:: Point2 -- ^ Emmission position
|
||||
-> Float -- ^ Emmission direction
|
||||
-> World
|
||||
-> Particle
|
||||
-> (World, Maybe Particle)
|
||||
moveTeslaArc p d w pt
|
||||
| t == 2 =
|
||||
(foldr damCrs w hitCrs & randGen .~ g & colSpark 8 nc q2 (argV sv)
|
||||
& damThingHitWith (Electrical 50) q1 ((2 *.* q2) -.- q1) thHit
|
||||
, Just $ pt & ptTimer -~ 1 & ptPoints .~ ps'
|
||||
)
|
||||
| t < 1 = (w , Nothing)
|
||||
| otherwise = (w , Just $ pt & ptTimer -~ 1)
|
||||
where
|
||||
t = _ptTimer pt
|
||||
ps = take 25 $ p : map f (crsLightChain p d 0 w)
|
||||
f (E3x1 cr) = _crPos cr
|
||||
f (E3x2 p1) = p1
|
||||
f (E3x3 p1) = p1
|
||||
ps' = lightningMids d pers ps
|
||||
pers = evalState (sequence $ repeat $ randInCirc 5) $ _randGen w
|
||||
nc = brightX 100 1.5 $ numColor colid
|
||||
(colid,g) = randomR (0::Int,5) $ _randGen w
|
||||
f1 (E3x1 cr) = Just $ _crID cr
|
||||
f1 _ = Nothing
|
||||
hitCrs = mapMaybe f1 $ take 14 $ crsLightChain p d 0 w
|
||||
damCrs cid = over (creatures . ix cid . crState . crDamage) (Electrical 5 cpos cpos cpos :)
|
||||
where
|
||||
cpos = _crPos (_creatures w IM.! cid)
|
||||
q1 = last $ init ps'
|
||||
q2 = last ps'
|
||||
hitWall = reflectPointWalls q1 ((2 *.* q2) -.- q1) $ wallsNearPoint q1 w
|
||||
thHit = thingHit q1 ((2 *.* q2) -.- q1) w
|
||||
sv = maybe (q2 -.- q1) snd hitWall
|
||||
{- Finds a point somewhere roughly inbetween two points. -}
|
||||
lightningMid :: Float -> Point2 -> Point2 -> Point2
|
||||
lightningMid d p1 p2 = (0.25 *.* (p1 +.+ p2)) +.+ 0.5 *.* p3
|
||||
where p3 = errorClosestPointOnLine 1 p1 (p1 +.+ unitVectorAtAngle d) p2
|
||||
{- Finds extra middle points between successive points in a list of points. -}
|
||||
lightningMids :: Float -> [Point2] -> [Point2] -> [Point2]
|
||||
lightningMids d1 (p:pers) (p1:p3:ps)
|
||||
= let p2 = p +.+ lightningMid d1 p1 p3
|
||||
d2 = argV $ p3 -.- p2
|
||||
in p1 : p2 : lightningMids d2 pers (p3:ps)
|
||||
lightningMids _ _ ps = ps
|
||||
{- Finds a list of hit things from a given point.
|
||||
'E3x1' objects are creatures, 'E3x2' objects are points on walls, 'E3x3' objects are points in space. -}
|
||||
crsLightChain :: Point2 -> Float -> Float -> World -> [Either3 Creature Point2 Point2]
|
||||
crsLightChain p d wlAttract w = case crOrWallSensitive p d wlAttract w of
|
||||
E3x1 cr -> E3x1 cr : crsLightChain (_crPos cr) (argV (_crPos cr -.- p))
|
||||
(min 1 (wlAttract + 0.3)) w
|
||||
E3x2 p1 -> [E3x2 p1]
|
||||
E3x3 p1 -> E3x3 p1 : crsLightChain p1 (dChange + argV (p1 -.- p)) (min 1 (wlAttract + 0.3)) (set randGen g w)
|
||||
where
|
||||
(dChange, g) = randomR (-0.5,0.5) $ _randGen w
|
||||
{-
|
||||
Finds whether a creature or wall is in front of a given point and direction.
|
||||
Evaluates to a creature as an 'E3x1' or a wall as an 'E3x2'.
|
||||
Has a parameter to tweak how attracted the test is to walls.
|
||||
-}
|
||||
crOrWallSensitive
|
||||
:: Point2 -- ^ Start point
|
||||
-> Float -- ^ Direction (radians)
|
||||
-> Float -- ^ Wall attraction parameter
|
||||
-> World
|
||||
-> Either3 Creature Point2 Point2
|
||||
crOrWallSensitive p dir wlAttract w = fromMaybe (E3x3 $ p +.+ rotateV dir (V2 arcLen 0))
|
||||
. listToMaybe
|
||||
. sortBy (compare `on` g)
|
||||
$ catMaybes [cr,wlp]
|
||||
where
|
||||
cr = E3x1 <$> nearestCrInFront p dir 100 w
|
||||
wlp = fmap E3x2
|
||||
. listToMaybe
|
||||
. sortBy (compare `on` dist p)
|
||||
$ mapMaybe
|
||||
( fmap fst
|
||||
. (\p1 -> reflectPointWalls p p1 $ wallsNearPoint p w)
|
||||
. (+.+) p
|
||||
. (\d -> rotateV d (V2 100 0))
|
||||
. (+ dir)
|
||||
. (* wlAttract)
|
||||
)
|
||||
[-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8]
|
||||
g (E3x2 p1) = 100 + dist p p1 -- tweak makes it more likely to hit crs first
|
||||
--g (E3x2 p1) = dist p p1 - 100 -- tweak makes it more likely to hit walls first
|
||||
g (E3x1 cr1) = dist p $ _crPos cr1
|
||||
g _ = 0
|
||||
(arcLen,_) = randomR (25,50) $ _randGen w
|
||||
-- BUG: can hit crs through walls
|
||||
|
||||
Reference in New Issue
Block a user