Partial refactor of bullet weapon effect chain
This commit is contained in:
+172
-29
@@ -1,10 +1,14 @@
|
||||
module Dodge.HeldUse where
|
||||
|
||||
import qualified SDL
|
||||
import Dodge.Base.You
|
||||
import Dodge.Data.MuzzleEffect
|
||||
import ListHelp
|
||||
import Dodge.Data.ComposedItem
|
||||
import Dodge.Data.DoubleTree
|
||||
import Color
|
||||
import Data.Maybe
|
||||
import Data.Traversable
|
||||
--import Data.Traversable
|
||||
import Dodge.Base.Coordinate
|
||||
import Dodge.Bullet
|
||||
import Dodge.Creature.HandPos
|
||||
@@ -26,7 +30,7 @@ import qualified IntMapHelp as IM
|
||||
import LensHelp
|
||||
import RandomHelp
|
||||
import Sound.Data
|
||||
import Data.Foldable
|
||||
--import Data.Foldable
|
||||
|
||||
heldEffect :: HeldMod -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
|
||||
heldEffect effecttype = case effecttype of
|
||||
@@ -215,18 +219,19 @@ heldEffect effecttype = case effecttype of
|
||||
, ammoCheckI
|
||||
, blCheck
|
||||
]
|
||||
PistolMod -> bulletGunEffect
|
||||
[ withSidePushI 50
|
||||
, withRecoil
|
||||
, withFlare
|
||||
, withTorqueAfter
|
||||
, duplicateLoadedBarrels
|
||||
, withSoundStart tap3S
|
||||
, useAmmoAmount 1
|
||||
, useTimeCheck
|
||||
, ammoCheckI
|
||||
, blCheck
|
||||
]
|
||||
PistolMod -> bulGunEffect
|
||||
-- bulletGunEffect
|
||||
-- [ withSidePushI 50
|
||||
-- , withRecoil
|
||||
-- , withFlare
|
||||
-- , withTorqueAfter
|
||||
-- , duplicateLoadedBarrels
|
||||
-- , withSoundStart tap3S
|
||||
-- , useAmmoAmount 1
|
||||
-- , useTimeCheck
|
||||
-- , ammoCheckI
|
||||
-- , blCheck
|
||||
-- ]
|
||||
AutoPistolMod -> bulletGunEffect
|
||||
[ withFlare
|
||||
, withSidePushI 50
|
||||
@@ -314,6 +319,11 @@ heldEffect effecttype = case effecttype of
|
||||
, blCheck
|
||||
]
|
||||
TractorMod -> foldl' (&) (aTractorBeam . _ldtValue) [ammoCheckI]
|
||||
FireRemoteShellMod -> undefined
|
||||
ExplodeRemoteShellMod -> undefined
|
||||
DoNothingMod -> const $ const id
|
||||
ForceFieldMod -> undefined
|
||||
DetectorMod _ -> undefined
|
||||
where
|
||||
f = do
|
||||
nzpres <- state $ randomR (3, 4)
|
||||
@@ -322,24 +332,157 @@ heldEffect effecttype = case effecttype of
|
||||
HammerUp -> it & itParams . lasCycle .~ 1
|
||||
_ -> it & itParams . lasCycle %~ (min (n * lasWideRate) . (+ 1))
|
||||
thegapDualBeam = _dbGap . _itParams
|
||||
directedTelPos _ cr w = (p, a)
|
||||
where
|
||||
p = fromMaybe (_crPos cr) $ cr ^? crTargeting . ctPos . _Just
|
||||
a = argV (mouseWorldPos (w ^. input) (w ^. wCam) -.- p)
|
||||
--directedTelPos _ cr w = (p, a)
|
||||
-- where
|
||||
-- p = fromMaybe (_crPos cr) $ cr ^? crTargeting . ctPos . _Just
|
||||
-- a = argV (mouseWorldPos (w ^. input) (w ^. wCam) -.- p)
|
||||
modcrpos x cr = fromMaybe cr $ do
|
||||
invid <- cr ^? crManipulation . manObject . inInventory . ispItem
|
||||
return $ cr & crDir %~ tweenAngles x (_crOldDir cr)
|
||||
& crPos %~ alongSegBy x (_crOldPos cr)
|
||||
& crInv . ix (invid + 1) . itUse . amagParams . ampBullet . buDelayFraction .~ x
|
||||
|
||||
gasEffect :: [(LabelDoubleTree ComposeLinkType Item
|
||||
-> Creature -> World -> World)
|
||||
-> LabelDoubleTree ComposeLinkType Item
|
||||
-> Creature
|
||||
-> World
|
||||
-> World]
|
||||
-> LabelDoubleTree ComposeLinkType Item
|
||||
-> Creature
|
||||
-> World
|
||||
-> World
|
||||
gasEffect = foldl' (&) (overNozzles useGasParams)
|
||||
|
||||
bulGunEffect :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
|
||||
bulGunEffect = hammerCheck $ useTimeCheck bulGunEffect'
|
||||
|
||||
bulGunEffect' :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
|
||||
bulGunEffect' t cr w = fromMaybe (error "error in bulGunEffect") $ do
|
||||
muzzles <- t ^? ldtValue . itUse . heldAim . aimMuzzles
|
||||
let (_,loadedmuzzles) = mapAccumR loadMuzzle t muzzles
|
||||
cmew = foldl' (useLoadedAmmo (_ldtValue t) cr) (CME 0 0 False,w) loadedmuzzles
|
||||
return $ uncurry (applyCME (_ldtValue t) cr) cmew
|
||||
|
||||
applyCME :: Item -> Creature -> CumulativeMuzzleEffect -> World -> World
|
||||
applyCME itm cr cme
|
||||
| _cmeSound cme = applySidePush spush cr . applyTorqueCME itm cr . applyRecoil itm cr
|
||||
| otherwise = id
|
||||
where
|
||||
spush = fromMaybe 0 $ itm ^? itUse . heldParams . sidePush
|
||||
|
||||
applyRecoil :: Item -> Creature -> World -> World
|
||||
applyRecoil itm cr = over (cWorld . lWorld . creatures . ix cid) pushback
|
||||
where
|
||||
cid = _crID cr
|
||||
recoilAmount = fromMaybe 0 $ itm ^? itUse . heldParams . recoil
|
||||
pushback = over crPos (+.+ rotateV (_crDir cr) (V2 ((- recoilAmount) / _crMass cr) 0))
|
||||
|
||||
applySidePush :: Float -> Creature -> World -> World
|
||||
applySidePush 0 _ w = w
|
||||
applySidePush maxSide cr w = w
|
||||
& cWorld . lWorld . creatures . ix cid %~ push
|
||||
& randGen .~ g
|
||||
where
|
||||
cid = _crID cr
|
||||
push = over crPos (+.+ rotateV (_crDir cr) (V2 0 (pushAmount / _crMass cr)))
|
||||
(pushAmount, g) = randomR (- maxSide, maxSide) $ _randGen w
|
||||
|
||||
applyTorqueCME :: Item -> Creature -> World -> World
|
||||
applyTorqueCME itm cr w
|
||||
| cid == 0 = w
|
||||
& wCam . camRot +~ rot
|
||||
& rotateScope
|
||||
& randGen .~ g
|
||||
| otherwise = w
|
||||
& cWorld . lWorld . creatures . ix cid . crDir +~ rot
|
||||
& randGen .~ g
|
||||
where
|
||||
cid = _crID cr
|
||||
(rot, g) = randomR (- torque, torque) $ _randGen w
|
||||
torque = fromMaybe 0 $ itm ^? itUse . heldParams . torqueAfter
|
||||
rotateScope = fromMaybe id $ do
|
||||
i <- yourScopeInvID w
|
||||
return $ cWorld . lWorld . creatures . ix cid . crInv . ix i . itUse . attachParams . scrollAttachParams . opticPos %~ rotateV rot
|
||||
|
||||
|
||||
-- (Muzzle,Int,Int) = (muzzle, amountloaded, id of mag taken from)
|
||||
loadMuzzle :: LabelDoubleTree ComposeLinkType Item
|
||||
-> Muzzle -> (LabelDoubleTree ComposeLinkType Item,(Muzzle, Int,Maybe Int))
|
||||
loadMuzzle t@(LDT _ l _) mz = fromMaybe (t,(mz, 0,Nothing)) $ do
|
||||
let as = _mzAmmoSlot mz
|
||||
amamount = 1
|
||||
(i,(_,mag)) <- findWithIx (isAmmoIntLink as . fst) l
|
||||
availableammo <- mag ^? ldtValue . itUse . amagLoadStatus . iaLoaded
|
||||
let usedammo = min amamount availableammo
|
||||
return (t & ldtLeft . ix i . _2 . ldtValue . itUse . amagLoadStatus . iaLoaded -~ usedammo
|
||||
, (mz, usedammo, mag ^? ldtValue . itLocation . ipInvID)
|
||||
)
|
||||
|
||||
makeMuzzleFlare :: (Muzzle,Int,Maybe Int) -> Item -> Creature -> World -> World
|
||||
makeMuzzleFlare _ _ _ = id
|
||||
|
||||
isAmmoIntLink :: Int -> ComposeLinkType -> Bool
|
||||
isAmmoIntLink i (AmmoInLink j _) = i == j
|
||||
isAmmoIntLink _ _ = False
|
||||
|
||||
useLoadedAmmo :: Item -> Creature -> (CumulativeMuzzleEffect,World) -> (Muzzle,Int,Maybe Int)
|
||||
-> (CumulativeMuzzleEffect,World)
|
||||
useLoadedAmmo _ cr (cme,w) (_,0,_) = (cme,failsound w)
|
||||
where
|
||||
failsound = case w ^? input . mouseButtons . ix SDL.ButtonLeft of
|
||||
Just 0 -> soundStart (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing
|
||||
_ -> soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing
|
||||
useLoadedAmmo itm cr (cme,w) (mz,x,mid) = fromMaybe (cme,w) $ do
|
||||
magid <- mid
|
||||
-- should be able to pass the magazine in from elsewhere?
|
||||
thebullet <- cr ^? crInv . ix magid . itUse . amagParams . ampBullet
|
||||
return $ (cme & cmeSound .~ True,
|
||||
w & cWorld . lWorld . creatures . ix cid . crInv . ix magid . itUse . amagLoadStatus . iaLoaded -~ x
|
||||
& flip (foldl' (&)) (replicate x (makeBullet thebullet itm cr mz))
|
||||
)
|
||||
where
|
||||
cid = _crID cr
|
||||
|
||||
makeBullet :: Bullet -> Item -> Creature -> Muzzle -> World -> World
|
||||
makeBullet thebullet itm cr mz w =
|
||||
w & randGen .~ g
|
||||
& cWorld . lWorld . instantBullets
|
||||
.:~ (thebullet
|
||||
& buPos .~ bulpos
|
||||
-- & buTrajectory .~ BasicBulletTrajectory
|
||||
& buVel %~ (rotateV dir . (muzvel *.*))
|
||||
& buDrag *~ _rifling (_heldParams $ _itUse itm)
|
||||
)
|
||||
where
|
||||
bulpos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
|
||||
(a,g) = randomR (-inacc,inacc) $ _randGen w
|
||||
inacc = _mzInaccuracy mz
|
||||
muzvel = _muzVel $ _heldParams $ _itUse itm
|
||||
dir = _crDir cr + _mzRot mz + a
|
||||
|
||||
bulletGunEffect :: [(LabelDoubleTree ComposeLinkType Item
|
||||
-> Creature -> World -> World)
|
||||
-> LabelDoubleTree ComposeLinkType Item
|
||||
-> Creature
|
||||
-> World
|
||||
-> World]
|
||||
-> LabelDoubleTree ComposeLinkType Item
|
||||
-> Creature
|
||||
-> World
|
||||
-> World
|
||||
bulletGunEffect = foldl' (&) shootBullet
|
||||
|
||||
useMod :: HeldMod ->
|
||||
[(LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World)
|
||||
-> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World]
|
||||
useMod hm = case hm of
|
||||
TractorMod -> undefined
|
||||
FireRemoteShellMod -> undefined
|
||||
ExplodeRemoteShellMod -> undefined
|
||||
DoNothingMod -> undefined
|
||||
ForceFieldMod -> undefined
|
||||
DetectorMod _ -> undefined
|
||||
-- HeldModNothing -> []
|
||||
PoisonSprayerMod ->
|
||||
[ useAmmoAmount 1
|
||||
@@ -646,17 +789,17 @@ useMod hm = case hm of
|
||||
f = do
|
||||
nzpres <- state $ randomR (3, 4)
|
||||
return $ sprayNozzles . ix 0 . nzPressure .~ nzpres
|
||||
increasecycleLasCircle it = it & itParams . lasCycle %~ (flip mod 2000 . (+ 1))
|
||||
--f it = [it & itParams . lasCycle +~ x | x <- [0,100 .. 1900] ]
|
||||
fLasCircle it = [it & itParams . lasCycle +~ x | x <- [0, 50 .. 1999]]
|
||||
--increasecycleLasCircle it = it & itParams . lasCycle %~ (flip mod 2000 . (+ 1))
|
||||
----f it = [it & itParams . lasCycle +~ x | x <- [0,100 .. 1900] ]
|
||||
--fLasCircle it = [it & itParams . lasCycle +~ x | x <- [0, 50 .. 1999]]
|
||||
increasecycleLasWide n it = case _heldHammer (_itUse it) of
|
||||
HammerUp -> it & itParams . lasCycle .~ 1
|
||||
_ -> it & itParams . lasCycle %~ (min (n * lasWideRate) . (+ 1))
|
||||
thegapDualBeam = _dbGap . _itParams
|
||||
directedTelPos _ cr w = (p, a)
|
||||
where
|
||||
p = fromMaybe (_crPos cr) $ cr ^? crTargeting . ctPos . _Just
|
||||
a = argV (mouseWorldPos (w ^. input) (w ^. wCam) -.- p)
|
||||
--directedTelPos _ cr w = (p, a)
|
||||
-- where
|
||||
-- p = fromMaybe (_crPos cr) $ cr ^? crTargeting . ctPos . _Just
|
||||
-- a = argV (mouseWorldPos (w ^. input) (w ^. wCam) -.- p)
|
||||
modcrpos x cr = fromMaybe cr $ do
|
||||
invid <- cr ^? crManipulation . manObject . inInventory . ispItem
|
||||
return $ cr & crDir %~ tweenAngles x (_crOldDir cr)
|
||||
@@ -694,13 +837,13 @@ usePjCreation :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> Wo
|
||||
usePjCreation itm cr = fromMaybe id $ do
|
||||
atype <- itm ^? ldtValue . itUse . heldAmmoTypes . ix 0
|
||||
leftitms <- itm ^? ldtLeft
|
||||
mag <- lookup (AmmoInLink atype) leftitms
|
||||
mag <- lookup (AmmoInLink 0 atype) leftitms
|
||||
apm <- mag ^? ldtValue
|
||||
muz <- itm ^? ldtValue . itUse . heldAim . aimMuzzles . ix 0
|
||||
return $ createProjectile apm muz (_ldtValue itm) cr
|
||||
|
||||
usePjCreationX :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
|
||||
usePjCreationX itm cr = undefined
|
||||
usePjCreationX = undefined
|
||||
--usePjCreationX ams itm cr = fromMaybe id $ do
|
||||
-- muzs <- itm ^? itUse . heldAim . aimMuzzles
|
||||
-- return $ foldr
|
||||
@@ -769,13 +912,13 @@ useGasParams nz itm cr =
|
||||
gastype = fromMaybe (error "cannot find gas ammo") $ do
|
||||
atype <- itm ^? ldtValue . itUse . heldAmmoTypes . ix 0
|
||||
leftitms <- itm ^? ldtLeft
|
||||
mag <- lookup (AmmoInLink atype) leftitms
|
||||
mag <- lookup (AmmoInLink 0 atype) leftitms
|
||||
mag ^? ldtValue . itUse . amagParams . ampCreateGas
|
||||
dir = _crDir cr
|
||||
pos = _crPos cr +.+ (_nzLength nz *.* unitVectorAtAngle (_crDir cr))
|
||||
|
||||
fireRemoteShell :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
|
||||
fireRemoteShell it cr w = undefined
|
||||
fireRemoteShell = undefined
|
||||
--fireRemoteShell :: [Item] -> Item -> Creature -> World -> World
|
||||
--fireRemoteShell ams it cr w =
|
||||
-- set
|
||||
|
||||
Reference in New Issue
Block a user