475 lines
19 KiB
Haskell
475 lines
19 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
module Dodge.HeldUse
|
|
(heldEffect
|
|
, mcUseHeld
|
|
)
|
|
where
|
|
|
|
import Dodge.Base.Coordinate
|
|
import Dodge.Base.Collide
|
|
import Dodge.Inventory.Lock
|
|
--import Dodge.WorldEvent.Cloud
|
|
import Dodge.LightSource
|
|
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 Dodge.Base.Coordinate
|
|
--import Dodge.Bullet
|
|
import Dodge.Creature.HandPos
|
|
import Dodge.Data.World
|
|
import Dodge.Gas
|
|
import Dodge.Item.Weapon.BatteryGuns
|
|
--import Dodge.Item.Weapon.Launcher
|
|
import Dodge.Item.Weapon.Radar
|
|
import Dodge.Item.Weapon.Shatter
|
|
import Dodge.Item.Weapon.TriggerType
|
|
import Dodge.Projectile.Create
|
|
import Dodge.SoundLogic
|
|
import Dodge.Tesla.Arc
|
|
--import Dodge.Wall.ForceField
|
|
--import Dodge.Wall.Move
|
|
import Dodge.WorldEvent.Flash
|
|
import Geometry
|
|
--import qualified IntMapHelp as IM
|
|
import LensHelp
|
|
import RandomHelp
|
|
--import Sound.Data
|
|
--import Data.Foldable
|
|
|
|
heldEffect :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
|
|
heldEffect = hammerCheck $ useTimeCheck heldEffectMuzzles
|
|
|
|
heldEffectMuzzles :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
|
|
heldEffectMuzzles t cr w = uncurry (applyCME (_ldtValue t) cr) cmew
|
|
& cWorld . lWorld . lTestString .~ map (show . _mzAmmoSlot) muzzles
|
|
& doWeaponRepetitions upitm cr
|
|
where
|
|
muzzles = t ^. ldtValue . itUse . heldAim . aimMuzzles
|
|
(upitm,loadedmuzzles) = mapAccumR loadMuzzle t muzzles
|
|
cmew = foldl' (useLoadedAmmo t cr) (CME 0 0 False,w) $ zip [0..] loadedmuzzles
|
|
|
|
|
|
-- need to be careful about inventory lock or item ids here
|
|
doWeaponRepetitions :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
|
|
doWeaponRepetitions itm cr = case itm ^? ldtValue . itUse . heldParams . weaponRepeat of
|
|
Just (x:xs) -> cWorld . lWorld . delayedEvents .++~ ((x:xs) <&> (,WdWdFromItCrixWdWd upitm (_crID cr) ItCrWdItemEffect))
|
|
_ -> id
|
|
where
|
|
upitm = itm & ldtValue . itUse . heldParams . weaponRepeat .~ []
|
|
& ldtValue . itUse . heldTriggerType .~ AutoTrigger
|
|
|
|
applyCME :: Item -> Creature -> CumulativeMuzzleEffect -> World -> World
|
|
applyCME itm cr cme
|
|
| _cmeSound cme = applyInvLock itm cr . applySoundCME itm cr . applySidePush spush cr . applyTorqueCME itm cr . applyRecoil itm cr
|
|
| otherwise = failsound
|
|
where
|
|
spush = fromMaybe 0 $ itm ^? itUse . heldParams . sidePush
|
|
failsound w = case w ^? input . mouseButtons . ix SDL.ButtonLeft of
|
|
Just 0 -> soundStart (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w
|
|
_ -> soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w
|
|
|
|
applyInvLock :: Item -> Creature -> World -> World
|
|
applyInvLock itm cr = case itm ^? itUse . heldParams . weaponInvLock of
|
|
Just i | i > 0 -> (cWorld . lWorld . delayedEvents .:~ (i, UnlockInv cid))
|
|
. lockInv cid
|
|
_ -> id
|
|
where
|
|
cid = _crID cr
|
|
|
|
applySoundCME :: Item -> Creature -> World -> World
|
|
applySoundCME itm cr = fromMaybe id $ do
|
|
(soundid,x) <- itm ^? itUse . heldParams . bulGunSound . _Just
|
|
if x > 0
|
|
then return $ soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) soundid (Just x)
|
|
else return $ soundMultiFrom [CrWeaponSound cid j | j <- [0..5]] (_crPos cr) soundid Nothing
|
|
where
|
|
cid = _crID cr
|
|
|
|
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
|
|
& cWorld . lWorld . creatures . ix cid . crDir +~ rot
|
|
& 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
|
|
|
|
-- (Muzzle,Int,Int) = (muzzle, amountloaded, id of mag taken from)
|
|
loadMuzzle :: LabelDoubleTree ComposeLinkType Item
|
|
-> Muzzle
|
|
-> (LabelDoubleTree ComposeLinkType Item,Maybe (Muzzle, Int,LabelDoubleTree ComposeLinkType Item))
|
|
loadMuzzle t@(LDT _ l _) mz = fromMaybe (t,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
|
|
guard $ usedammo > 0
|
|
return (t & ldtLeft . ix i . _2 . ldtValue . itUse . amagLoadStatus . iaLoaded -~ usedammo
|
|
, Just (mz, usedammo, mag)
|
|
)
|
|
|
|
makeMuzzleFlare :: Muzzle -> Item -> Creature -> World -> World
|
|
makeMuzzleFlare mz itm cr = case mz ^. mzFlareType of
|
|
DefaultFlareType -> id
|
|
PistolFlare -> basicMuzFlare pos dir
|
|
MiniGunFlare -> makeTlsTimeRadColPos 2 100 (V3 1 1 0.5) (pos `v2z` 20)
|
|
. muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
|
|
HeavySmokeFlare -> basicMuzFlare pos dir
|
|
LasGunFlare -> flareCircleAt (_lasColor $ _itParams itm) 0.8 (pos `v2z` 20)
|
|
. (cWorld . lWorld . tempLightSources .:~
|
|
tlsTimeRadColPos 1 100 (xyzV4 . _lasColor $ _itParams itm) (pos `v2z` 10))
|
|
TeslaGunFlare -> cWorld . lWorld . tempLightSources .:~
|
|
tlsTimeRadColPos 1 100 (V3 0 0 1) (pos `v2z` 10)
|
|
where
|
|
pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
|
|
dir = _crDir cr + _mzRot mz
|
|
|
|
basicMuzFlare :: Point2 -> Float -> World -> World
|
|
basicMuzFlare pos dir = makeTlsTimeRadColPos 2 100 (V3 1 1 0.5) (pos `v2z` 20)
|
|
. muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
|
|
. muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
|
|
. muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
|
|
|
|
---- need to add these to muzzle flare?
|
|
--makeMuzzleSmoke :: Muzzle -> Item -> Creature -> World -> World
|
|
--makeMuzzleSmoke mz itm cr w = case mz ^. mzFlareType of
|
|
-- DefaultFlareType -> w
|
|
-- PistolFlare -> foldl' (flip $ smokeCloudAt (greyN 0.5) 5 400 5 . (+.+.+ pos) . (* 8)) w ps
|
|
-- MiniGunFlare -> smokeCloudAt (greyN 0.5) 5 400 5 pos w
|
|
-- HeavySmokeFlare -> foldl' (flip $ smokeCloudAt black 20 400 5 . (+.+.+ pos) . (* 8)) w ps'
|
|
-- LasGunFlare -> w
|
|
-- TeslaGunFlare -> w
|
|
-- where
|
|
-- ps = replicateM 2 randOnUnitSphere & evalState $ _randGen w
|
|
-- ps' = replicateM 4 randOnUnitSphere & evalState $ _randGen w
|
|
-- pos = addZ 10 $ _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
|
|
---- , withSmoke 1 black 20 200 5
|
|
|
|
isAmmoIntLink :: Int -> ComposeLinkType -> Bool
|
|
isAmmoIntLink i (AmmoInLink j _) = i == j
|
|
isAmmoIntLink _ _ = False
|
|
|
|
useLoadedAmmo :: LabelDoubleTree ComposeLinkType Item
|
|
-> Creature
|
|
-> (CumulativeMuzzleEffect,World)
|
|
-> (Int,Maybe (Muzzle,Int,LabelDoubleTree ComposeLinkType Item))
|
|
-> (CumulativeMuzzleEffect,World)
|
|
useLoadedAmmo _ _ (cme,w) (_,Nothing) = (cme, w)
|
|
useLoadedAmmo itmtree cr (cme,w) (mzid,Just (mz,x,magtree)) = (,) (cme & cmeSound .~ True) $
|
|
removeAmmoFromMag x mid cr . makeMuzzleFlare mz itm cr $ case _mzEffect mz of
|
|
MuzzleShootBullet -> shootBullet itmtree cr (mz,x,magtree) w
|
|
MuzzleLaser -> shootLaser' itm cr mz w
|
|
MuzzleTesla -> shootTeslaArc itm cr mz w
|
|
MuzzleTractor -> shootTractorBeam itm cr w
|
|
MuzzleLauncher -> createProjectile magtree mz itmtree cr w
|
|
MuzzleNozzle {} -> useGasParams mid mz itm cr $ walkNozzle mzid mz itm cr w
|
|
MuzzleShatter -> shootShatter itm cr w
|
|
MuzzleForceField -> useForceFieldGun itm cr w
|
|
MuzzleDetector -> itemDetectorEffect itm cr w
|
|
where
|
|
mid = magtree ^? ldtValue . itLocation . ilInvID
|
|
itm = itmtree ^. ldtValue
|
|
|
|
itemDetectorEffect :: Item -> Creature -> World -> World
|
|
itemDetectorEffect itm cr w = fromMaybe w $ do
|
|
HELDDETECTOR dt <- itm ^? itType . ibtHeld
|
|
return $ detectorEffect dt itm cr w
|
|
|
|
walkNozzle :: Int -> Muzzle -> Item -> Creature -> World -> World
|
|
walkNozzle mzid mz itm cr w = fromMaybe w $ do
|
|
invid <- itm ^? itLocation . ilInvID
|
|
return $ w
|
|
& cWorld . lWorld . creatures . ix (_crID cr) . crInv
|
|
. ix invid . itUse . heldAim . aimMuzzles . ix mzid . mzEffect . nzCurrentWalkAngle .~ wa
|
|
& randGen .~ g
|
|
where
|
|
nz = _mzEffect mz
|
|
(walkamount, g) = randomR (- aspeed, aspeed) (_randGen w)
|
|
aspeed = _nzWalkSpeed nz
|
|
maxa = _nzMaxWalkAngle nz
|
|
wa = min maxa $ max (negate maxa) (_nzCurrentWalkAngle nz + walkamount)
|
|
|
|
|
|
shootTractorBeam :: Item -> Creature -> World -> World
|
|
shootTractorBeam itm cr w = w & cWorld . lWorld . tractorBeams .:~ tractorBeamAt spos outpos dir power
|
|
where
|
|
cpos = _crPos cr
|
|
spos = cpos +.+ (_crRad cr + 10) *.* unitVectorAtAngle dir
|
|
xpos = cpos +.+ 400 *.* unitVectorAtAngle dir
|
|
dir = _crDir cr
|
|
outpos = fst $ collidePointWallsFilter (const True) cpos xpos w
|
|
power = _attractionPower . _itParams $ itm
|
|
|
|
tractorBeamAt :: Point2 -> Point2 -> Float -> Point2 -> TractorBeam
|
|
tractorBeamAt pos outpos dir power =
|
|
TractorBeam
|
|
{ _tbPos = pos
|
|
, _tbStartPos = outpos
|
|
, _tbVel = d
|
|
, _tbTime = 10
|
|
}
|
|
where
|
|
d = unitVectorAtAngle dir * power
|
|
|
|
shootLaser' :: Item -> Creature -> Muzzle -> World -> World
|
|
shootLaser' itm cr mz w = w
|
|
& randGen .~ g
|
|
&
|
|
cWorld . lWorld . lasers
|
|
.:~ lasRayAt
|
|
(_lasColor $ _itParams itm)
|
|
(_lasDamage $ _itParams itm)
|
|
(_phaseV $ _itParams itm)
|
|
pos
|
|
dir
|
|
where
|
|
pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
|
|
(a,g) = randomR (-inacc,inacc) $ _randGen w
|
|
inacc = _mzInaccuracy mz
|
|
dir = _crDir cr + _mzRot mz + a
|
|
|
|
removeAmmoFromMag :: Int -> Maybe Int -> Creature -> World -> World
|
|
removeAmmoFromMag x mid cr = fromMaybe id $ do
|
|
magid <- mid
|
|
return $ cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix magid . itUse . amagLoadStatus . iaLoaded -~ x
|
|
|
|
getBulletType :: LabelDoubleTree ComposeLinkType Item
|
|
-> LabelDoubleTree ComposeLinkType Item
|
|
-> Muzzle
|
|
-> Creature
|
|
-> World
|
|
-> Maybe Bullet
|
|
getBulletType itmtree magtree mz cr w = magtree ^? ldtValue . itUse . amagParams . ampBullet
|
|
<&> buTrajectory .~ btraj
|
|
<&> buPayload .~ bpayload
|
|
<&> buEffect .~ beffect
|
|
where
|
|
-- consider modifying other parameters here too
|
|
btraj = fromMaybe BasicBulletTrajectory $ do
|
|
targetingtree <- lookup WeaponTargetingLink (itmtree ^. ldtRight) -- left or right for these
|
|
tp <- targetingtree ^? ldtValue . itUse . tgPos . _Just
|
|
attree <- lookup AmmoTargetingLink (magtree ^. ldtLeft)
|
|
bt <- attree ^? ldtValue . itUse . buMod . bmTrajectory
|
|
return $ getBulletTrajectory mz (itmtree ^. ldtValue) bt tp cr w
|
|
bpayload = fromMaybe BulSpark $ do
|
|
attree <- lookup AmmoPayloadLink (magtree ^. ldtLeft)
|
|
attree ^? ldtValue . itUse . buMod . bmPayload
|
|
beffect = fromMaybe DestroyBullet $ do
|
|
attree <- lookup AmmoEffectLink (magtree ^. ldtLeft)
|
|
attree ^? ldtValue . itUse . buMod . bmEffect
|
|
|
|
getBulletTrajectory :: Muzzle -> Item
|
|
-> BulletTrajectoryType -> Point2 -> Creature -> World -> BulletTrajectory
|
|
getBulletTrajectory mz itm bt tp cr w = case bt of
|
|
BasicBulletTrajectoryType -> BasicBulletTrajectory
|
|
FlechetteTrajectoryType -> FlechetteTrajectory tp
|
|
BezierTrajectoryType -> BezierTrajectory bulpos tp (mouseWorldPos (w ^. input) (w ^. wCam))
|
|
MagnetTrajectoryType -> MagnetTrajectory tp
|
|
where
|
|
bulpos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm + V2 0 offset)
|
|
offset = case itm ^? itUse . heldParams . randomOffset of
|
|
Just x | x /= 0 -> fst . randomR (-x,x) $ _randGen w
|
|
_ -> 0
|
|
|
|
|
|
shootBullet :: LabelDoubleTree ComposeLinkType Item
|
|
-> Creature
|
|
-> (Muzzle,Int,LabelDoubleTree ComposeLinkType Item )
|
|
-> World
|
|
-> World
|
|
shootBullet itmtree cr (mz,x,magtree) w = fromMaybe w $ do
|
|
-- should be able to pass the magazine in from elsewhere?
|
|
thebullet <- getBulletType itmtree magtree mz cr w
|
|
return $ flip (foldl' (&)) (replicate x (makeBullet thebullet (itmtree ^. ldtValue) cr mz)) w
|
|
-- & makeMuzzleFlare mz itm cr
|
|
-- & makeMuzzleSmoke mz itm cr
|
|
-- where
|
|
-- cid = _crID cr
|
|
|
|
-- the random generator is not updated here, not sure if that is a problem
|
|
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 *~ drag
|
|
)
|
|
where
|
|
bulpos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm + V2 0 offset)
|
|
(a,g'') = randomR (-inacc,inacc) $ _randGen w
|
|
inacc = _mzInaccuracy mz
|
|
(drag,g') = case _rifling (_heldParams $ _itUse itm) of
|
|
ConstFloat x -> (x,g'')
|
|
UniRandFloat x y -> randomR (x,y) g''
|
|
(muzvel,g) = case _muzVel $ _heldParams $ _itUse itm of
|
|
ConstFloat x -> (x,g')
|
|
UniRandFloat x y -> randomR (x,y) g'
|
|
dir = _crDir cr + _mzRot mz + a
|
|
offset = case itm ^? itUse . heldParams . randomOffset of
|
|
Just x | x /= 0 -> fst . randomR (-x,x) $ _randGen w
|
|
_ -> 0
|
|
|
|
mcUseHeld :: HeldItemType -> Item -> Machine -> World -> World
|
|
mcUseHeld hit = case hit of
|
|
LASGUN -> mcShootLaser
|
|
_ -> \_ _ -> id
|
|
|
|
--useHeld :: Huse -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
|
|
--useHeld hu = case hu of
|
|
-- HeldDoNothing -> const $ const id
|
|
-- HeldDetectorEffect dt -> detectorEffect dt . _ldtValue
|
|
-- HeldForceField -> useForceFieldGun . _ldtValue
|
|
|
|
useGasParams :: Maybe Int -> Muzzle -> Item -> Creature -> World -> World
|
|
useGasParams mmagid mz itm cr w =
|
|
createGas
|
|
gastype
|
|
pressure
|
|
pos
|
|
dir
|
|
cr
|
|
w & randGen .~ g'
|
|
where
|
|
(pressure,g) = doGenFloat (_nzPressure $ _mzEffect mz) (_randGen w)
|
|
gastype = fromMaybe (error "cannot find gas ammo") $ do
|
|
magid <- mmagid
|
|
fueltype <- cr ^? crInv . ix magid . itUse . amagParams . ampCreateGas
|
|
gc <- itm ^? itUse . heldParams . gasCreation
|
|
return $ gasCreate fueltype gc
|
|
pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
|
|
(a,g') = randomR (-inacc,inacc) g
|
|
inacc = _mzInaccuracy mz
|
|
dir = _crDir cr + _mzRot mz + a + _nzCurrentWalkAngle (_mzEffect mz)
|
|
|
|
gasCreate :: GasFuel -> GasCreate -> GasCreate
|
|
gasCreate = const id
|
|
|
|
doGenFloat :: RandomGen g => GenFloat -> g -> (Float, g)
|
|
doGenFloat (ConstFloat x) g = (x,g)
|
|
doGenFloat (UniRandFloat x y) g = randomR (x,y) g
|
|
|
|
--caneStickSoundChoice :: Item -> SoundID
|
|
--caneStickSoundChoice _ = tap3S
|
|
-- -- | (it ^?! itUse . heldConsumption . laSource . _InternalSource . iaLoaded) < 2 = tap3S
|
|
-- -- | otherwise = shotgunS
|
|
|
|
--bangStickSoundChoice :: Item -> SoundID
|
|
--bangStickSoundChoice = caneStickSoundChoice
|
|
|
|
-- do
|
|
-- wth <- state $ randomR (1, 5)
|
|
-- return (itUse . heldConsumption . laAmmoType . amBullet . buWidth .~ wth)
|
|
|
|
--coneRandItemParams :: State StdGen (Item -> Item)
|
|
--coneRandItemParams = do
|
|
-- muzv <- state $ randomR (0.5, 1)
|
|
-- rifl <- state $ randomR (0.3, 0.9)
|
|
-- return $ \it ->
|
|
-- it & itUse . heldParams . muzVel .~ muzv
|
|
-- & itUse . heldParams . rifling .~ rifl
|
|
|
|
mcShootLaser :: Item -> Machine -> World -> World
|
|
mcShootLaser it mc = cWorld . lWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
|
|
where
|
|
pos = _mcPos mc +.+ 20 *.* unitVectorAtAngle dir
|
|
dir = mc ^?! mcType . _McTurret . tuDir
|
|
phasev = _phaseV . _itParams $ it
|
|
dam = _lasDamage $ _itParams it
|
|
|
|
-- | assumes that the item is held
|
|
shootTeslaArc :: Item -> Creature -> Muzzle -> World -> World
|
|
shootTeslaArc itm cr mz w =
|
|
w'
|
|
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itParams .~ ip
|
|
where
|
|
-- use items item location instead
|
|
itRef = cr ^?! crManipulation . manObject . imRootItem -- unsafe!! TODO change
|
|
(w', ip) = makeTeslaArc (_itParams itm) pos dir w
|
|
pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
|
|
dir = _crDir cr + _mzRot mz
|
|
|
|
-- I believe because the targeting returns to nothing straight after you release
|
|
-- the rmb, it is possible for this to do nothing
|
|
-- TODO investigate more and fix
|
|
useForceFieldGun :: Item -> Creature -> World -> World
|
|
useForceFieldGun _ _ = id
|
|
--useForceFieldGun itm cr w = fromMaybe w $ do
|
|
-- a <- cr ^? crTargeting . ctPos . _Just
|
|
-- let mwp = mouseWorldPos (w ^. input) (w ^. wCam)
|
|
-- b = if dist a mwp < 100 then mwp else a +.+ 100 *.* normalizeV (mwp -.- a)
|
|
-- wlline = (a, b)
|
|
-- return $
|
|
-- w
|
|
-- & cWorld . lWorld . walls %~ IM.insertWith (\_ x -> x) i forceField{_wlID = i}
|
|
-- & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID (_itLocation itm)) . itParams . paramMID ?~ i
|
|
-- & moveWallIDUnsafe i wlline
|
|
-- where
|
|
-- i = fromMaybe (IM.newKey (_walls (_lWorld (_cWorld w)))) $ itm ^? itParams . paramMID . _Just
|
|
|
|
determineProjectileTracking :: LabelDoubleTree ComposeLinkType Item
|
|
-> LabelDoubleTree ComposeLinkType Item
|
|
-> ProjectileHoming
|
|
determineProjectileTracking magtree itmtree = case lookup RemoteScreenLink (magtree ^. ldtLeft) of
|
|
Just screen -> HomeUsingRemoteScreen (screen ^. ldtValue . itID)
|
|
Nothing -> fromMaybe NoHoming $ do
|
|
_ <- lookup AmmoTargetingLink (magtree ^. ldtLeft) -- should not have to give a direction
|
|
targetingtree <- lookup WeaponTargetingLink (itmtree ^. ldtRight) -- left or right for these
|
|
return $ HomeUsingTargeting (targetingtree ^. ldtValue . itID)
|
|
|
|
createProjectile
|
|
:: LabelDoubleTree ComposeLinkType Item
|
|
-> Muzzle
|
|
-> LabelDoubleTree ComposeLinkType Item
|
|
-> Creature -> World -> World
|
|
createProjectile magtree muz itmtree cr = fromMaybe failsound $ do
|
|
magid <- magtree ^? ldtValue . itLocation . ilInvID
|
|
ammoitem <- cr ^? crInv . ix magid
|
|
let homing = determineProjectileTracking magtree itmtree
|
|
j <- ammoitem ^? itLocation . ilInvID
|
|
aparams <- ammoitem ^? itUse . amagParams
|
|
return $ createShell homing aparams muz itm cr
|
|
. startthesound
|
|
. useammo j
|
|
where
|
|
itm = itmtree ^. ldtValue
|
|
useammo j = cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix j . itUse . amagLoadStatus . iaLoaded -~ 1
|
|
|
|
-- the sound should be moved to the projectile firing
|
|
startthesound = soundMultiFrom [CrWeaponSound (_crID cr) j | j <- [0..3]] (_crPos cr) tap4S Nothing
|
|
-- failsound = soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing
|
|
failsound w' = case w' ^? input . mouseButtons . ix SDL.ButtonLeft of
|
|
Just 0 -> soundStart (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w'
|
|
_ -> soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w'
|