Modularise triggers for weapons

This commit is contained in:
jgk
2021-03-12 02:54:15 +01:00
parent 22275beb89
commit 6f1f817ed3
3 changed files with 193 additions and 176 deletions
+5 -175
View File
@@ -1,5 +1,8 @@
{-# LANGUAGE BangPatterns #-}
module Dodge.Item.Weapon where
module Dodge.Item.Weapon
( module Dodge.Item.Weapon
)
where
-- imports {{{
import Dodge.Data
import Dodge.Base
@@ -15,6 +18,7 @@ import Dodge.Item.Draw
import Dodge.Item.Weapon.Bullet
import Dodge.Item.Weapon.InventoryDisplay
import Dodge.Item.Weapon.TriggerType
import Geometry
import Picture
@@ -607,86 +611,6 @@ blinkGun = defaultGun
, _itAimingRange = 0
}
withWarmUp :: Int -> (Int -> World -> World) -> Int -> World -> World
withWarmUp t f cid w
| reloadCondition = fromMaybe w $ reloadWeapon cid w
| _wpReloadState item /= 0 = w
| fState == 0 = set (pointerToItem . wpFire) (withWarmUp 100 f)
$ set (pointerToItem . wpFireState) 2
w
| t > 1 = set (pointerToItem . wpFire) (withWarmUp (t-1) f)
$ set (pointerToItem . wpFireState) 2
$ soundFrom (CrWeaponSound cid) 26 1 0
w
| t > 0 = set (pointerToItem . wpFire) (withWarmUp (t-1) f)
$ set (pointerToItem . wpFireState) 2
w
-- | otherwise = set (pointerToItem . wpFire) (withWarmUp 0 f)
| otherwise = set (pointerToItem . wpFire) (withWarmUp 1 f)
$ over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1)
$ set (pointerToItem . wpFireState) 2
$ f cid
$ continueSoundFrom (CrWeaponSound cid) 28 2 0
w
where cr = _creatures w IM.! cid
itRef = _crInvSel cr
item = _crInv cr IM.! itRef
pointerToItem = creatures . ix cid . crInv . ix itRef
fState = _wpFireState item
fRate = _wpFireRate item
reloadCondition = _wpLoadedAmmo item == 0
-- rotC = case cid of 0 -> fst $ randomR (-0.03,0.03) (_randGen w)
-- _ -> 0
withSound :: Int -> (Int -> World -> World) -> Int -> World -> World
withSound soundid f cid = soundOnce soundid . f cid
withRecoil :: Float -> (Int -> World -> World) -> Int -> World -> World
withRecoil recoilAmount eff cid w = eff cid . over (creatures . ix cid) pushback $ w
where pushback cr = over crPos
-- where pushback cr = colCrWall w $ over crPos
(+.+ rotateV (_crDir cr) ((-recoilAmount) / _crMass cr ,0))
cr
withSidePush :: Float -> (Int -> World -> World) -> Int -> World -> World
withSidePush maxSide eff cid w = eff cid . over (creatures . ix cid) push $ w
where push cr = over crPos
(+.+ rotateV (_crDir cr) (0,(pushAmount) / _crMass cr))
cr
(pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w
shootWithSound :: Int -> (Int -> World -> World) -> Int -> World -> World
shootWithSound soundid f cid w
| fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1)
$ soundOnce soundid
$ set (pointerToItem . wpFireState) (_wpFireRate item)
$ f cid w
| reloadCondition = fromMaybe w $ reloadWeapon cid w
| otherwise = w
where cr = (_creatures w IM.! cid)
itRef = _crInvSel cr
item = _crInv cr IM.! itRef
pointerToItem = creatures . ix cid . crInv . ix itRef
fireCondition = _wpReloadState item == 0
&& _wpFireState item == 0
&& _wpLoadedAmmo item > 0
reloadCondition = _wpLoadedAmmo item == 0
shoot :: (Int -> World -> World) -> Int -> World -> World
shoot f cid w | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1)
$ set (pointerToItem . wpFireState) (_wpFireRate item)
$ f cid w
| reloadCondition = fromMaybe w $ reloadWeapon cid w
| otherwise = w
where cr = (_creatures w IM.! cid)
itRef = _crInvSel cr
item = _crInv cr IM.! itRef
pointerToItem = creatures . ix cid . crInv . ix itRef
fireCondition = _wpReloadState item == 0
&& _wpFireState item == 0
&& _wpLoadedAmmo item > 0
reloadCondition = _wpLoadedAmmo item == 0
aTeslaArc :: Int -> World -> World
aTeslaArc cid w = aTeslaArc' cid
@@ -856,39 +780,6 @@ tractorBeamAt colID i pos dir = Particle
where d = unitVectorAtAngle dir
p' = pos +.+ 400 *.* d
spreadNumVelWthHiteff' :: Float -> Int -> Point2 -> Float -> HitEffect' -> Int -> World -> World
spreadNumVelWthHiteff' spread num vel wth eff cid w
= over particles' (newbuls ++)
$ flip (foldr muzFlareAt) poss
w
where cr = _creatures w IM.! cid
newbuls = zipWith3 (\pos d colid -> aGenBulAt' (Just cid) (numColor colid)
pos (rotateV d vel) eff wth
) poss dirs colids
pos' = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
poss = map ((+.+) $ _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr))
$ evalState ((sequence . take num . repeat . randInCirc) 5) $ _randGen w
dirs = map ((+) (_crDir cr))
$ zipWith (+) [-spread,-spread+(2*spread/(fromIntegral num))..]
$ randomRs (0,spreadGunSpread/5) (_randGen w)
colids = take num $ randomRs (0,11) (_randGen w)
numVelWthHitEff' :: Int -> Point2 -> Float -> HitEffect' -> Int -> World -> World
numVelWthHitEff' num vel wth eff cid w
= over particles' (newbuls ++)
$ flip (foldr muzFlareAt) (take num poss)
w
where cr = _creatures w IM.! cid
newbuls = zipWith (\pos colid -> aGenBulAt' (Just cid) (numColor colid)
pos (rotateV d vel) eff wth)
poss colids
d = _crDir cr
poss = map (\o -> o +.+ pos) 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
pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
aGasCloud :: Int -> World -> World
aGasCloud cid w
@@ -1060,59 +951,6 @@ flamerAngle = 0.3
aSelf :: Int -> World -> World
aSelf = blinkAction
withAccVelWthHiteff' :: Float -> Point2 -> Float -> HitEffect' -> Int -> World -> World
withAccVelWthHiteff' acc vel width hiteff cid w
= over particles' ((:) newbul)
. over tempLightSources ((:) (tLightAt 4 pos))
. lowLightAt pos2
$ set randGen g
w
where cr = _creatures w IM.! cid
newbul = aGenBulAt' (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width
(colid, g) = randomR (0,11) $ _randGen w
(a, _) = randomR (-acc,acc) $ _randGen w
dir = _crDir cr + a
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
withOffsetAccVelWthHiteff' :: Float -> Float -> Point2 -> Float -> HitEffect' -> Int -> World -> World
withOffsetAccVelWthHiteff' offsetAmount acc vel width hiteff cid w
= over particles' ((:) newbul )
$ muzFlareAt pos
$ set randGen g
w
where cr = _creatures w IM.! cid
newbul = aGenBulAt' (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width
(colid, g) = randomR (0,11) $ _randGen w
(a, _) = randomR (-acc,acc) $ _randGen w
dir = _crDir cr + a
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) +.+ offset
(offsetVal , _) = randomR (-offsetAmount,offsetAmount) $ _randGen w
offset = rotateV (_crDir cr) (0,offsetVal)
torqueBeforeForced :: Float -> (Int -> World -> World) -> Int -> World -> World
torqueBeforeForced torque feff cid w
| cid == 0 = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot')
$ over cameraRot (+rot') w
| otherwise = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot') w
where (rot, g) = randomR (-torque,torque) $ _randGen w
rot' | rot < 0 = rot - 0.1
| otherwise = rot + 0.1
torqueBefore :: Float -> (Int -> World -> World) -> Int -> World -> World
torqueBefore torque feff cid w
| cid == 0 = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot)
$ over cameraRot (+rot) w
| otherwise = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot) w
where (rot, g) = randomR (-torque,torque) $ _randGen w
torqueAfter :: Float -> (Int -> World -> World) -> Int -> World -> World
torqueAfter torque feff cid w
| cid == 0 = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff cid w
| otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) $ feff cid w
where (rot, g) = randomR (-torque,torque) $ _randGen w
rotateScope w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment . _Just . scopePos %~ rotateV rot
@@ -1879,14 +1717,6 @@ crOrWall p dir w = fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0))
g (E3x1 cr1) = dist p $ _crPos cr1
(arcLen,_) = randomR (25,50) $ _randGen w
thingHit' :: Point2 -> Maybe (Point2,a) -> Maybe (Point2,c) -> Maybe (Either (Point2,a) (Point2,c))
thingHit' p Nothing Nothing = Nothing
thingHit' p (Just x) Nothing = Just (Left x)
thingHit' p Nothing (Just x) = Just (Right x)
thingHit' p (Just x@(p1,_)) (Just y@(p2,_))
| magV (p -.- p1) > magV (p -.- p2) = Just (Right y)
| otherwise = Just (Left x)
spreadGunSpread,autogunSpread :: Float
spreadGunSpread = 0.5
autogunSpread = 0.07
+187
View File
@@ -0,0 +1,187 @@
module Dodge.Item.Weapon.TriggerType
where
import Dodge.Data
import Dodge.SoundLogic
import Dodge.CreatureActions (reloadWeapon)
import Dodge.WorldActions (muzFlareAt,lowLightAt,tLightAt)
import Dodge.RandomHelp
import Dodge.Item.Weapon.Bullet
import Geometry
import System.Random
import Control.Lens
import Control.Monad.State
import Data.Maybe
import qualified Data.IntMap.Strict as IM
withWarmUp :: Int -> (Int -> World -> World) -> Int -> World -> World
withWarmUp t f cid w
| reloadCondition = fromMaybe w $ reloadWeapon cid w
| _wpReloadState item /= 0 = w
| fState == 0 = set (pointerToItem . wpFire) (withWarmUp 100 f)
$ set (pointerToItem . wpFireState) 2
w
| t > 1 = set (pointerToItem . wpFire) (withWarmUp (t-1) f)
$ set (pointerToItem . wpFireState) 2
$ soundFrom (CrWeaponSound cid) 26 1 0
w
| t > 0 = set (pointerToItem . wpFire) (withWarmUp (t-1) f)
$ set (pointerToItem . wpFireState) 2
w
-- | otherwise = set (pointerToItem . wpFire) (withWarmUp 0 f)
| otherwise = set (pointerToItem . wpFire) (withWarmUp 1 f)
$ over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1)
$ set (pointerToItem . wpFireState) 2
$ f cid
$ continueSoundFrom (CrWeaponSound cid) 28 2 0
w
where cr = _creatures w IM.! cid
itRef = _crInvSel cr
item = _crInv cr IM.! itRef
pointerToItem = creatures . ix cid . crInv . ix itRef
fState = _wpFireState item
fRate = _wpFireRate item
reloadCondition = _wpLoadedAmmo item == 0
withSound :: Int -> (Int -> World -> World) -> Int -> World -> World
withSound soundid f cid = soundOnce soundid . f cid
withRecoil :: Float -> (Int -> World -> World) -> Int -> World -> World
withRecoil recoilAmount eff cid w = eff cid . over (creatures . ix cid) pushback $ w
where pushback cr = over crPos
-- where pushback cr = colCrWall w $ over crPos
(+.+ rotateV (_crDir cr) ((-recoilAmount) / _crMass cr ,0))
cr
withSidePush :: Float -> (Int -> World -> World) -> Int -> World -> World
withSidePush maxSide eff cid w = eff cid . over (creatures . ix cid) push $ w
where push cr = over crPos
(+.+ rotateV (_crDir cr) (0,(pushAmount) / _crMass cr))
cr
(pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w
shootWithSound :: Int -> (Int -> World -> World) -> Int -> World -> World
shootWithSound soundid f cid w
| fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1)
$ soundOnce soundid
$ set (pointerToItem . wpFireState) (_wpFireRate item)
$ f cid w
| reloadCondition = fromMaybe w $ reloadWeapon cid w
| otherwise = w
where cr = (_creatures w IM.! cid)
itRef = _crInvSel cr
item = _crInv cr IM.! itRef
pointerToItem = creatures . ix cid . crInv . ix itRef
fireCondition = _wpReloadState item == 0
&& _wpFireState item == 0
&& _wpLoadedAmmo item > 0
reloadCondition = _wpLoadedAmmo item == 0
shoot :: (Int -> World -> World) -> Int -> World -> World
shoot f cid w | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1)
$ set (pointerToItem . wpFireState) (_wpFireRate item)
$ f cid w
| reloadCondition = fromMaybe w $ reloadWeapon cid w
| otherwise = w
where cr = (_creatures w IM.! cid)
itRef = _crInvSel cr
item = _crInv cr IM.! itRef
pointerToItem = creatures . ix cid . crInv . ix itRef
fireCondition = _wpReloadState item == 0
&& _wpFireState item == 0
&& _wpLoadedAmmo item > 0
reloadCondition = _wpLoadedAmmo item == 0
withAccVelWthHiteff' :: Float -> Point2 -> Float -> HitEffect' -> Int -> World -> World
withAccVelWthHiteff' acc vel width hiteff cid w
= over particles' ((:) newbul)
. over tempLightSources ((:) (tLightAt 4 pos))
. lowLightAt pos2
$ set randGen g
w
where cr = _creatures w IM.! cid
newbul = aGenBulAt' (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width
(colid, g) = randomR (0,11) $ _randGen w
(a, _) = randomR (-acc,acc) $ _randGen w
dir = _crDir cr + a
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
withOffsetAccVelWthHiteff' :: Float -> Float -> Point2 -> Float -> HitEffect' -> Int -> World -> World
withOffsetAccVelWthHiteff' offsetAmount acc vel width hiteff cid w
= over particles' ((:) newbul )
$ muzFlareAt pos
$ set randGen g
w
where cr = _creatures w IM.! cid
newbul = aGenBulAt' (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width
(colid, g) = randomR (0,11) $ _randGen w
(a, _) = randomR (-acc,acc) $ _randGen w
dir = _crDir cr + a
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) +.+ offset
(offsetVal , _) = randomR (-offsetAmount,offsetAmount) $ _randGen w
offset = rotateV (_crDir cr) (0,offsetVal)
torqueBeforeForced :: Float -> (Int -> World -> World) -> Int -> World -> World
torqueBeforeForced torque feff cid w
| cid == 0 = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot')
$ over cameraRot (+rot') w
| otherwise = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot') w
where (rot, g) = randomR (-torque,torque) $ _randGen w
rot' | rot < 0 = rot - 0.1
| otherwise = rot + 0.1
torqueBefore :: Float -> (Int -> World -> World) -> Int -> World -> World
torqueBefore torque feff cid w
| cid == 0 = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot)
$ over cameraRot (+rot) w
| otherwise = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot) w
where (rot, g) = randomR (-torque,torque) $ _randGen w
torqueAfter :: Float -> (Int -> World -> World) -> Int -> World -> World
torqueAfter torque feff cid w
| cid == 0 = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff cid w
| otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) $ feff cid w
where (rot, g) = randomR (-torque,torque) $ _randGen w
rotateScope w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment . _Just . scopePos %~ rotateV rot
spreadNumVelWthHiteff' :: Float -> Int -> Point2 -> Float -> HitEffect' -> Int -> World -> World
spreadNumVelWthHiteff' spread num vel wth eff cid w
= over particles' (newbuls ++)
$ flip (foldr muzFlareAt) poss
w
where cr = _creatures w IM.! cid
newbuls = zipWith3 (\pos d colid -> aGenBulAt' (Just cid) (numColor colid)
pos (rotateV d vel) eff wth
) poss dirs colids
pos' = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
poss = map ((+.+) $ _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr))
$ evalState ((sequence . take num . repeat . randInCirc) 5) $ _randGen w
dirs = map ((+) (_crDir cr))
$ zipWith (+) [-spread,-spread+(2*spread/(fromIntegral num))..]
$ randomRs (0,spread/5) (_randGen w)
-- $ randomRs (0,spreadGunSpread/5) (_randGen w)
colids = take num $ randomRs (0,11) (_randGen w)
numVelWthHitEff' :: Int -> Point2 -> Float -> HitEffect' -> Int -> World -> World
numVelWthHitEff' num vel wth eff cid w
= over particles' (newbuls ++)
$ flip (foldr muzFlareAt) (take num poss)
w
where cr = _creatures w IM.! cid
newbuls = zipWith (\pos colid -> aGenBulAt' (Just cid) (numColor colid)
pos (rotateV d vel) eff wth)
poss colids
d = _crDir cr
poss = map (\o -> o +.+ pos) 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
pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
+1 -1
View File
@@ -206,7 +206,7 @@ door = Room
, _rmLinks = lnks
, _rmPath = [((20,35),(20,5))]
-- door extends into side walls (for shadows as rendered 12/03)
, _rmPS = [PS (0,20) 0 $ PutAutoDoor (-10,0) (50,0)]
, _rmPS = [PS (0,20) 0 $ PutAutoDoor (-20,0) (60,0)]
, _rmBound = []
}
where lnks = [((20,35),0)