Initial implementation of bezier bullet

This commit is contained in:
2021-03-15 13:11:01 +01:00
parent 5ce9b4487b
commit a5e0dc65da
6 changed files with 43 additions and 349 deletions
+5
View File
@@ -35,6 +35,11 @@ midPadL :: Int -> a -> [a] -> [a] -> [a]
midPadL i x xs ys = take j (xs ++ repeat x) ++ ys
where j = i - length ys
takeUntil :: (a -> Bool) -> [a] -> [a]
takeUntil f ps = case span f ps of
(xs,[]) -> xs
(xs,(y:_)) -> xs ++ [y]
you :: World -> Creature
you w = _creatures w IM.! _yourID w
+4 -7
View File
@@ -1425,14 +1425,11 @@ bezierControl targetp cid w = resetGun $ shootWithSound 0 (mkBezierBul startp co
resetGun = set (creatures . ix cid . crInv . ix j . wpFire) $ bezierTarget
mkBezierBul :: Point2 -> Point2 -> Point2 -> Int -> World -> World
mkBezierBul startp controlp targetp cid w = over particles' (bbul 30 :) w
mkBezierBul startp controlp targetp cid w = over particles' (bbul :) w
where
bbul i = Particle'
{_ptPict' = onLayerL [levLayer PtLayer ] $ bezierQuad white white 5 5 startp controlp targetp
,_ptUpdate' = \w p -> case i of 0 -> (w, Nothing)
n -> (w, Just $ bbul (i-1))
}
bbul = aCurveBulAt (Just cid) white startp controlp targetp
(threeEff' bulHitCr' bulHitWall' bulHitFF') 5
fireRemoteLauncher :: Int -> World -> World
fireRemoteLauncher cid w = setLocation $ resetFire $ resetName
$ soundOnce (fromIntegral launcherSound)
+17 -1
View File
@@ -231,6 +231,22 @@ aGenBulAt' maycid col pos vel hiteff width = Bul'
, _btTrail' = [pos]
, _btPassThrough' = maycid
, _btWidth' = width
, _btTimer' = 90
, _btTimer' = 100
, _btHitEffect' = hiteff
}
aCurveBulAt :: Maybe Int -> Color -> Point2 -> Point2 -> Point2 -> HitEffect' -> Float -> Particle'
aCurveBulAt maycid col pos control targ hiteff width = Bul'
{ _ptPict' = blank
, _ptUpdate' = mvBulletTrajectory f
, _btVel' = (0,0)
, _btColor' = col
, _btTrail' = [pos]
, _btPassThrough' = maycid
, _btWidth' = width
, _btTimer' = 100
, _btHitEffect' = hiteff
}
where f i = g $ (100 - fromIntegral i) / 10
g x = map (bf . (+ x)) [0,0.01..0.09]
bf = bQuadToF (pos,control,targ)
+7 -86
View File
@@ -1,4 +1,10 @@
module Dodge.WorldActions where
module Dodge.WorldActions
( module Dodge.WorldActions
, module Dodge.WorldActions.Bullet
)
where
import Dodge.WorldActions.Bullet
import Dodge.Data
import Dodge.Base
@@ -425,93 +431,8 @@ threeEff' crEff wlEff ffEff pt thing w = case thing of
(p,E3x2 wl) -> wlEff pt p wl w
(p,E3x3 ff) -> ffEff pt p ff w
mvGenBullet' :: World -> Particle' -> (World, Maybe Particle')
mvGenBullet' w bt
| t <= 0 = (w, Nothing)
| t < 4 = (w, Just $ set btPassThrough' Nothing
$ set btTrail' (p:p:ps)
$ set ptPict' (bulLine col wth (p:p:ps))
$ set btTimer' (t-1) bt
)
| otherwise = case thingsHitExceptCr mcr p (p +.+ vel) w of
[] -> (w, Just $ set btPassThrough' Nothing
$ set btTrail' (p +.+ vel :p:ps)
$ set ptPict' (bulLine col wth (p +.+ vel:p:ps))
$ set btTimer' (t-1) bt
)
((hitp,thing):_)
-> ( hiteff bt (hitp,thing) w
, Just $ set btPassThrough' Nothing
$ set btTrail' (hitp:p:ps)
$ set ptPict' (bulLine col wth (hitp:p:ps))
$ set btTimer' 3 bt
)
where mcr = _btPassThrough' bt
col = _btColor' bt
(p:ps) = _btTrail' bt
vel = _btVel' bt
hiteff = _btHitEffect' bt
wth = _btWidth' bt
t = _btTimer' bt
bulLine c w = setLayer 1 . bulLinea c w
bulLinea :: Color -> Float -> [Point2] -> Picture
bulLinea _ _ [] = blank
bulLinea _ _ (x:[]) = blank
bulLinea col width (a:b:[]) -- (a:b:[])
= onLayer HPtLayer $ pictures $ reverse
[polygonCol $ zip (wedgeGeom width b a) $ [white,withAlpha 0 white,withAlpha 0 white]
,polygonCol $ zip (lineGeom (width+1.5) a b) $ [col,col,withAlpha 0 col,withAlpha 0 col]
]
bulLinea col width (a:b:c:[]) -- (a:b:[])
= onLayer HPtLayer $ pictures $ reverse
[polygonCol $ zip (wedgeGeom width b a) $ repeat white
,polygonCol $ zip (wedgeGeom width b c) $ [white,white,withAlpha 0 white]
,polygonCol $ zip (lineGeom (width+1.5) a c) $ [col,col,withAlpha 0 col,withAlpha 0 col]
]
bulLinea col width (a:b:_:c:[]) -- (a:b:[])
= onLayer HPtLayer $ pictures $ reverse
[polygonCol $ zip (wedgeGeom width b a) $ repeat white
,polygonCol $ zip (wedgeGeom width b c) $ [white,white,withAlpha 0 white]
,polygonCol $ zip (lineGeom (width+1.5) a c) $ [col,col,withAlpha 0 col,withAlpha 0 col]
]
bulLinea col width (a:b:_:_:c:_) -- (a:b:[])
= onLayer HPtLayer $ pictures $ reverse
[polygonCol $ zip (wedgeGeom width b a) $ repeat white
,polygonCol $ zip (wedgeGeom width b c) $ [white,white,withAlpha 0 white]
,polygonCol $ zip (lineGeom (width+1.5) a c) $ [col,col,withAlpha 0 col,withAlpha 0 col]
]
-- [color (withAlpha 0.5 col) $ lineOfThickness (width+1.5) [a,b]
-- ,color white $ wedgeOfThickness width a b
--bulLine col width (a:b:c:_)
-- = onLayer HPtLayer $ pictures
-- [color (withAlpha 0.5 col) $ lineOfThickness (width+1.5) [a,c]
-- ,color white $ wedgeOfThickness width a c
thingsHitExceptCr :: Maybe Int -> Point2 -> Point2 -> World
-> [(Point2, (Either3 Creature Wall ForceField))]
thingsHitExceptCr Nothing sp ep = thingsHit sp ep
thingsHitExceptCr (Just cid) sp ep = filter crNotCid . thingsHit sp ep
where crNotCid (_,(E3x1 cr)) = _crID cr /= cid
crNotCid _ = True
thingsHit :: Point2 -> Point2 -> World -> [(Point2, (Either3 Creature Wall ForceField))]
thingsHit sp ep w = sortBy (compare `on` dist sp . fst) (crs ++ walls ++ ffs)
where hitCrs = IM.elems $ IM.filter (\cr -> circOnLine sp ep (_crPos cr) (_crRad cr))
$ creaturesAlongLine sp ep w
crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
crs = zip crPs (map E3x1 hitCrs)
-- hitWls = wallsOnLine sp ep (f y $ f x $ _wallsZone w)
hitWls = wallsOnLine sp ep (IM.unions [f b $ f a $ _wallsZone w | a<-[x-1,x,x+1]
, b<-[y-1,y,y+1]])
(x,y) = zoneOfPoint (0.5 *.* (sp +.+ ep))
f i m = case IM.lookup i m of Just val -> val
_ -> IM.empty
walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
hitPoint w = intersectSegSeg' sp ep (_wlLine w !! 0) (_wlLine w !! 1)
hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
thingsHitExceptCrLongLine :: Maybe Int -> Point2 -> Point2 -> World
-> [(Point2, (Either3 Creature Wall ForceField))]