Add basic booster

This commit is contained in:
2021-05-24 13:59:51 +02:00
parent cda035b1d1
commit 968273bf25
20 changed files with 276 additions and 324 deletions
+49
View File
@@ -0,0 +1,49 @@
module Dodge.Item.Weapon.Booster
where
import Dodge.Data
import Dodge.Base
import Geometry
import IntMapHelp
import Data.Maybe
import Control.Lens
{- | Move a creature towards the mouse position, with shockwave -}
boostPoint
:: Float -- ^ boost amount
-> Creature
-> World
-> Either Point2 Point2
boostPoint x cr w = case mayp2 of
Nothing -> Right p1
Just p2 -> Left $ mvPointTowardAtSpeed r cpos $ fst p2
where
cpos = _crPos cr
r = 1.5 * _crRad cr
p1 = cpos +.+ x *.* normalizeV (mouseWorldPos w -.- cpos)
mayp2 = reflectPointWalls cpos p1 $ wallsAlongLine cpos p1 w
boostSelf
:: Maybe Int -- ^ shockwave projectile id
-> Float -- ^ boost amount
-> Creature
-> World
-> World
boostSelf mpid x cr w = case boostPoint x cr w of
Left p -> wWithShock
& creatures . ix cid %~ ( (crPos .~ p) . (crInv . ix (_crInvSel cr) . wpLoadedAmmo .~ 1))
Right p -> wWithShock & creatures . ix cid . crPos .~ p
where
cid = _crID cr
cpos = _crPos cr
r = _crRad cr
pid = fromMaybe (newKey $ _projectiles w) mpid
wWithShock = addBoostShockwave pid cpos (vNormal $ r *.* unitVectorAtAngle (_crDir cr)) w
addBoostShockwave
:: Int
-> Point2
-> Point2
-> World
-> World
addBoostShockwave _ _ _ w = w
+11 -14
View File
@@ -21,15 +21,14 @@ import Data.Tuple
import Data.List (find)
import Data.Maybe (fromMaybe)
import qualified Data.Sequence as Seq
import qualified Data.IntMap.Strict as IM
--import qualified Data.IntMap.Strict as IM
aLaser :: Creature -> World -> World
aLaser cr w = over particles (makeLaserAt phaseV pos dir (Just cid) : )
aLaser cr w = over particles (makeLaserAt phaseV pos dir : )
$ soundFrom LasSound 24 1 0
$ laserGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir)
w
where
cid = _crID cr
pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir)
dir = _crDir cr
phaseV = charToPhaseV
@@ -42,21 +41,20 @@ charToPhaseV '/' = 1
charToPhaseV 'Z' = 5
charToPhaseV _ = error "Trying to set an undefined phaseV"
makeLaserAt :: Float -> Point2 -> Float -> Maybe Int -> Particle
makeLaserAt phaseV pos dir mcid = Particle
makeLaserAt :: Float -> Point2 -> Float -> Particle
makeLaserAt phaseV pos dir = Particle
{ _ptDraw = const blank
, _ptUpdate' = moveLaser phaseV pos dir mcid
, _ptUpdate' = moveLaser phaseV pos dir
}
moveLaser
:: Float -- ^ Phase velocity, controls deflection in windows
:: Float -- ^ Phase velocity, controls deflection through windows
-> Point2
-> Float
-> Maybe Int
-> World
-> Particle
-> (World, Maybe Particle)
moveLaser phaseV pos dir _ w pt
moveLaser phaseV pos dir w pt
= ( set randGen g $ hitEffect w
, Just pt {_ptDraw = const $ onLayer PtLayer pic ,_ptUpdate' = ptTimer' 0 }
)
@@ -68,15 +66,14 @@ moveLaser phaseV pos dir _ w pt
f :: [Wall] -> Point2 -> Point2 -> (Maybe (Point2,Either3 Creature Wall ForceField),[Point2])
f seenWs x y = case find (h' seenWs) $ thingsHitExceptCrLongLine Nothing x y w of
Just (p,E3x2 wl)
| _wlIsSeeThrough wl -> f' p $ f (wl:seenWs)
p
(h x y wl p)
| _wlIsSeeThrough wl -> f' p $ f (wl:seenWs) p (h x y wl p)
| otherwise -> (Just (p,E3x2 wl), [p])
Just (p,obj) -> (Just (p,obj), [p])
Nothing -> (Nothing, [y])
f' p (x,ps') = (x,p:ps')
h x y wl p | isEntering = p +.+ rotateV angleRef normalDist
| otherwise = p +.+ rotateV angleRef' normalDist'
h x y wl p
| isEntering = p +.+ rotateV angleRef normalDist
| otherwise = p +.+ rotateV angleRef' normalDist'
where
wlNormal = vNormal $ uncurry (-.-) $ swap (_wlLine wl)
normalDist = magV (p -.- y) *.* normalizeV wlNormal
+51 -88
View File
@@ -52,16 +52,16 @@ rateIncAB
-> World
-> World
rateIncAB startRate fastRate shooteff1 shooteff2 cr w
| repeatFire = set (pointItem . itUseRate) (max fastRate (currentRate - 1))
$ over (pointItem . wpLoadedAmmo) (\ammo -> ammo-1)
$ set (pointItem . itUseTime) currentRate
$ shooteff2 cr
w
| firstFire = set (pointItem . itUseRate) (startRate - 1)
$ over (pointItem . wpLoadedAmmo) (\ammo -> ammo-1)
$ set (pointItem . itUseTime) startRate
$ shooteff1 cr
w
| repeatFire = w
& pointItem %~ ( (itUseRate .~ max fastRate (currentRate - 1))
. (wpLoadedAmmo -~ 1)
. (itUseTime .~ currentRate) )
& shooteff2 cr
| firstFire = w
& pointItem %~ ( (itUseRate .~ startRate - 1)
. (wpLoadedAmmo -~ 1)
. (itUseTime .~ startRate) )
& shooteff1 cr
| reloadCondition = fromMaybe w $ startReloadingWeapon cr w
| otherwise = w
where
@@ -90,22 +90,17 @@ withWarmUp
withWarmUp t f cr w
| reloadCondition = fromMaybe w $ startReloadingWeapon cr w
| _wpReloadState item /= 0 = w
| fState == 0 = set (pointerToItem . itUse) (withWarmUp 100 f)
$ set (pointerToItem . itUseTime) 2
w
| t > 2 = set (pointerToItem . itUse) (withWarmUp (t-1) f)
$ set (pointerToItem . itUseTime) 2
$ soundFrom (CrWeaponSound cid) 26 2 0
w
| t > 0 = set (pointerToItem . itUse) (withWarmUp (t-1) f)
$ set (pointerToItem . itUseTime) 2
w
| otherwise = set (pointerToItem . itUse) (withWarmUp 1 f)
$ over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1)
$ set (pointerToItem . itUseTime) 2
$ f cr
$ soundFrom (CrWeaponSound cid) 28 2 0
w
| fState == 0 = w
& pointerToItem %~ ( (itUse .~ withWarmUp 100 f) . (itUseTime .~ 2) )
| t > 2 = w
& pointerToItem %~ ( (itUse .~ withWarmUp (t-1) f) . (itUseTime .~ 2) )
& soundFrom (CrWeaponSound cid) 26 2 0
| t > 0 = w
& pointerToItem %~ ( (itUse .~ withWarmUp (t-1) f) . (itUseTime .~ 2) )
| otherwise = w
& pointerToItem %~ ( (itUse .~ withWarmUp 1 f) . (wpLoadedAmmo -~ 1) . (itUseTime .~ 2) )
& f cr
& soundFrom (CrWeaponSound cid) 28 2 0
where
cid = _crID cr
itRef = _crInvSel cr
@@ -113,18 +108,14 @@ withWarmUp t f cr w
pointerToItem = creatures . ix cid . crInv . ix itRef
fState = _itUseTime item
reloadCondition = _wpLoadedAmmo item == 0
{- |
Adds a sound to a creature based world effect.
{- | Adds a sound to a creature based world effect.
The sound is emitted from the creature's position. -}
withSound
:: Int -- ^ Sound id
-> (Creature -> World -> World) -- ^ Underlying effect
-> Creature
-> World -> World
withSound soundid f cr w = (soundOncePos soundid p . f cr) w
where
cid = _crID cr
p = _crPos (_creatures w IM.! cid)
withSound soundid f cr = soundOncePos soundid (_crPos cr) . f cr
withRecoil
:: Float -- ^ Recoil amount
@@ -135,9 +126,8 @@ withRecoil
withRecoil recoilAmount eff cr = eff cr . over (creatures . ix cid) pushback
where
cid = _crID cr
pushback cr = over crPos (+.+ rotateV (_crDir cr) ((-recoilAmount) / _crMass cr ,0)) cr
{- |
Pushes a creature sideways by a random amount.
pushback = over crPos (+.+ rotateV (_crDir cr) ((-recoilAmount) / _crMass cr ,0))
{- | Pushes a creature sideways by a random amount.
Applied before the underlying effect. -}
withSidePush
:: Float -- ^ Maximal possible side push amount
@@ -148,10 +138,9 @@ withSidePush
withSidePush maxSide eff cr w = eff cr . over (creatures . ix cid) push $ w
where
cid = _crID cr
push cr = over crPos (+.+ rotateV (_crDir cr) (0,pushAmount / _crMass cr)) cr
push = over crPos (+.+ rotateV (_crDir cr) (0,pushAmount / _crMass cr))
(pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w
{- |
Pushes a creature sideways by a random amount.
{- | Pushes a creature sideways by a random amount.
Applied after the underlying effect. -}
withSidePushAfter
:: Float -- ^ Maximal possible side push amount
@@ -162,7 +151,7 @@ withSidePushAfter
withSidePushAfter maxSide eff cr w = over (creatures . ix cid) push . eff cr $ w
where
cid = _crID cr
push cr = over crPos (+.+ rotateV (_crDir cr) (0,pushAmount / _crMass cr)) cr
push = over crPos (+.+ rotateV (_crDir cr) (0,pushAmount / _crMass cr))
(pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w
{- |
Applies a world effect and sound effect after an ammo check. -}
@@ -171,7 +160,8 @@ shootWithSound
-> (Creature -> World -> World)
-- ^ Shoot effect, takes creature id as input
-> Creature
-> World -> World
-> World
-> World
shootWithSound soundid f cr w
| fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1)
$ soundOncePos soundid (_crPos cr)
@@ -225,9 +215,8 @@ shoot
-> World
-> World
shoot f cr w
| fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1)
$ set (pointerToItem . itUseTime) (_itUseRate item)
$ f cr w
| fireCondition = f cr w & pointerToItem %~
( (wpLoadedAmmo -~ 1) . (itUseTime .~ _itUseRate item) )
| reloadCondition = fromMaybe w $ startReloadingWeapon cr w
| otherwise = w
where
@@ -247,11 +236,9 @@ withMuzFlare
-> World
withMuzFlare f cr w = tempLightForAt 3 pos . muzzleFlashAt pos2 $ f cr w
where
cid = _crID cr
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
{- |
Rotates the creature randomly, applies the effect, rotates the creature back. -}
{- | Applies the effect to a randomly rotated creature. -}
withRandomDir
:: Float -- ^ Max possible rotation
-> (Creature -> World -> World)
@@ -259,16 +246,10 @@ withRandomDir
-> Creature
-> World
-> World
withRandomDir acc f cr w = over (creatures . ix cid . crDir) (\d -> d - a)
. f cr
. over (creatures . ix cid . crDir) (+ a)
$ set randGen g
w
withRandomDir acc f cr w = f (cr & crDir +~ a) $ set randGen g w
where
cid = _crID cr
(a, g) = randomR (-acc,acc) $ _randGen w
{- |
Creates a bullet with a given velocity, width, and 'HitEffect' -}
{- | Creates a bullet with a given velocity, width, and 'HitEffect' -}
withVelWthHiteff
:: Point2 -- ^ Velocity, x direction is forward with respect to the creature
-> Float -- ^ Bullet width
@@ -276,32 +257,23 @@ withVelWthHiteff
-> Creature -- ^ Creature id
-> World
-> World
withVelWthHiteff vel width hiteff cr w
= over particles (newbul : ) $ set randGen g w
withVelWthHiteff vel width hiteff cr = over particles (newbul : )
where
cid = _crID cr
newbul = aGenBulAt (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width
(colid, g) = randomR (0,11) $ _randGen w
newbul = aGenBulAt (Just cid) pos (rotateV dir vel) hiteff width
dir = _crDir cr
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
{- |
Translate the creature sideways a random amount, apply the effect, translate back. -}
{- | Apply the effect to a translated creature. -}
withRandomOffset
:: Float -- ^ Max possible translate
-> (Creature -> World -> World)
-- ^ Underlying effect
-> Creature -- ^ Creature id
-> Creature
-> World
-> World
withRandomOffset offsetAmount f cr w
= over (creatures . ix cid . crPos) (-.- offV)
. f cr
. over (creatures . ix cid . crPos) (+.+ offV)
$ set randGen g
w
withRandomOffset offsetAmount f cr w = f (cr & crPos %~ (+.+ offV)) $ set randGen g w
where
(offsetVal , g) = randomR (-offsetAmount,offsetAmount) $ _randGen w
cid = _crID cr
offV = rotateV (_crDir cr) (0,offsetVal)
-- | Rotates a creature with minimum rotation at least 0.1.
-- Rotates the player creature before applying the effect, other creatures after.
@@ -313,7 +285,7 @@ torqueBeforeForced
-> World
-> World
torqueBeforeForced torque feff cr w
| cid == 0 = feff cr $ w
| cid == 0 = feff (cr & crDir +~ rot') $ w
& randGen .~ g
& creatures . ix cid . crDir +~ rot'
& cameraRot +~ rot'
@@ -332,7 +304,7 @@ torqueBefore
-> World
-> World
torqueBefore torque feff cr w
| cid == 0 = feff cr $ w
| cid == 0 = feff (cr & crDir +~ rot) $ w
& randGen .~ g
& creatures . ix cid . crDir +~ rot
& cameraRot +~ rot
@@ -369,15 +341,14 @@ spreadNumVelWthHiteff
spreadNumVelWthHiteff spread num vel wth eff cr w = over particles (newbuls ++) w
where
cid = _crID cr
newbuls = zipWith3
(\pos d colid -> aGenBulAt (Just cid) (numColor colid) pos (rotateV d vel) eff wth)
poss dirs colids
newbuls = zipWith
(\pos d -> aGenBulAt (Just cid) pos (rotateV d vel) eff wth)
poss dirs
poss = map ((+.+) $ _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr))
$ (replicateM num . randInCirc) 5 & evalState $ _randGen w
dirs = map (_crDir cr +) $ zipWith (+)
[-spread,-spread+(2*spread/fromIntegral num)..]
(randomRs (0,spread/5) (_randGen w))
colids = take num $ randomRs (0,11) (_randGen w)
{- | Create a number of bullets side by side with a given velocity,
given width and given 'HitEffect'. -}
numVelWthHitEff
@@ -385,25 +356,19 @@ numVelWthHitEff
-> Point2 -- ^ Velocity, x axis is direction of creature
-> Float -- ^ Bullet width
-> HitEffect -- ^ Effect when hitting creature, wall etc
-> Creature -- ^ Creature id
-> Creature
-> World
-> World
numVelWthHitEff num vel wth eff cr w = over particles (newbuls ++) w
numVelWthHitEff num vel wth eff cr = over particles (newbuls ++)
where
cid = _crID cr
newbuls = zipWith
(\p colid -> aGenBulAt (Just cid) (numColor colid) p (rotateV d vel) eff wth)
poss
colids
newbuls = map (\p -> aGenBulAt (Just cid) p (rotateV d vel) eff wth) poss
d = _crDir cr
poss = map (+.+ pos) offsets
poss = map (+.+ pos) $ take num offsets
maxOffset = fromIntegral num * 2.5 - 2.5
offsets = map (\y -> rotateV d (0,y)) [-maxOffset,5-maxOffset..]
colids = take num $ randomRs (0,11) (_randGen w)
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle d
{- |
Uses '_wpSpread' as a parameter for the current offset angle. -}
{- | Uses '_wpSpread' as a parameter for the current offset angle. -}
randWalkAngle
:: Float -- ^ Max offset angle
-> Float -- ^ Walk speed
@@ -412,9 +377,7 @@ randWalkAngle
-> World
-> World
randWalkAngle ma aspeed f cr w = w
& creatures . ix cid . crDir -~ a
& f cr
& creatures . ix cid . crDir +~ a
& f (cr & crDir +~ a)
& creatures . ix cid . crInv . ix i . wpSpread .~ newa
where
cid = _crID cr
+16 -24
View File
@@ -16,21 +16,13 @@ import Geometry
import Data.Maybe
import Control.Lens
import qualified Data.IntMap.Strict as IM
{- |
Creates an outwardly increasing circle that draws creatures, even those behind walls. -}
{- | Creates an outwardly increasing circle that draws creatures, even those behind walls. -}
aSonarPulse :: Creature -> World -> World
aSonarPulse cr w = over particles ((:) $ sonarPulseAt (_crPos cr)) w
{- |
Creates an outwardly increasing circle that displays walls, even those behind other walls. -}
aSonarPulse cr = over particles (sonarPulseAt (_crPos cr) :)
{- | Creates an outwardly increasing circle that displays walls, even those behind other walls. -}
aRadarPulse :: Creature -> World -> World
aRadarPulse cr w = over particles ((:) $ radarPulseAt (_crPos (_creatures w IM.! cid))) w
where
cid = _crID cr
{- |
Radar blip at a point.
-}
aRadarPulse cr = over particles (radarPulseAt (_crPos cr) :)
{- | Radar blip at a point. -}
blipAt :: Point2 -> Color -> Int -> Particle
blipAt p col i = Particle
{_ptDraw = const blank
@@ -42,17 +34,17 @@ mvBlip :: Point2 -> Color
-> Int -- ^ Current timer value
-> World -> Particle -> (World, Maybe Particle)
mvBlip _ _ _ 0 w _ = (w, Nothing)
mvBlip p col maxt t w pt
= (w, Just $ pt & ptUpdate' .~ mvBlip p col maxt (t-1)
& ptDraw .~ (const . setDepth (-0.5)
. setLayer 1
$ uncurry translate p
$ color (withAlpha (fromIntegral t / fromIntegral maxt) col)
$ circleSolid 2)
)
{- |
An outwardly increasing circle that draws creatures, even those behind walls. -}
mvBlip p col maxt t w pt =
(w
, Just $ pt & ptUpdate' .~ mvBlip p col maxt (t-1)
& ptDraw .~ ( const
. setDepth (-0.5)
. setLayer 1
. uncurry translate p
. color (withAlpha (fromIntegral t / fromIntegral maxt) col)
$ circleSolid 2 )
)
{- | An outwardly increasing circle that draws creatures, even those behind walls. -}
sonarPulseAt :: Point2 -> Particle
sonarPulseAt p = Particle { _ptDraw = const blank , _ptUpdate' = mvSonar 100 p }