Commit AFTER playing around with poking/vector sizing a little
This commit is contained in:
@@ -27,7 +27,7 @@ crMvAbsolute p' cr =
|
||||
& crPos %~ (+.+ p)
|
||||
& crMvDir .~ argV p
|
||||
where
|
||||
p = strengthFactor (getCrStrength cr) *.* p'
|
||||
p = strengthFactor (getCrMoveSpeed cr) *.* p'
|
||||
|
||||
strengthFactor :: Int -> Float
|
||||
strengthFactor i
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
module Dodge.Creature.Statistics (
|
||||
getCrStrength,
|
||||
getCrMoveSpeed,
|
||||
getCrDexterity,
|
||||
) where
|
||||
|
||||
@@ -13,8 +13,8 @@ import LensHelp
|
||||
getCrDexterity :: Creature -> Int
|
||||
getCrDexterity cr = _dexterity (_crStatistics cr)
|
||||
|
||||
getCrStrength :: Creature -> Int
|
||||
getCrStrength cr = strFromHeldItem cr + strFromEquipment cr + _strength (_crStatistics cr)
|
||||
getCrMoveSpeed :: Creature -> Int
|
||||
getCrMoveSpeed cr = strFromHeldItem cr + strFromEquipment cr + _strength (_crStatistics cr)
|
||||
|
||||
strFromEquipment :: Creature -> Int
|
||||
strFromEquipment = sum . fmap equipmentStrValue . crCurrentEquipment
|
||||
|
||||
@@ -56,7 +56,6 @@ data Creature = Creature
|
||||
, _crInvLock :: Bool
|
||||
, _crInvEquipped :: IM.IntMap EquipPosition
|
||||
, _crEquipment :: M.Map EquipPosition Int
|
||||
-- , _crLeftInvSel :: LeftInvSel
|
||||
, _crInvHotkeys :: IM.IntMap Hotkey
|
||||
, _crHotkeys :: M.Map Hotkey Int
|
||||
, _crState :: CreatureState
|
||||
|
||||
+195
-173
@@ -1,72 +1,60 @@
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
module Dodge.HeldUse
|
||||
(heldEffect
|
||||
, mcUseHeld
|
||||
)
|
||||
where
|
||||
|
||||
module Dodge.HeldUse (
|
||||
heldEffect,
|
||||
mcUseHeld,
|
||||
) where
|
||||
|
||||
import Color
|
||||
import Dodge.Base.Coordinate
|
||||
import Data.Maybe
|
||||
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.Base.Coordinate
|
||||
import Dodge.Creature.HandPos
|
||||
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.MuzzleEffect
|
||||
import Dodge.Data.World
|
||||
import Dodge.Gas
|
||||
--import Dodge.Item.Weapon.BatteryGuns
|
||||
--import Dodge.Item.Weapon.Launcher
|
||||
import Dodge.Inventory.Lock
|
||||
import Dodge.Item.Weapon.Radar
|
||||
import Dodge.Item.Weapon.Shatter
|
||||
import Dodge.Item.Weapon.TriggerType
|
||||
import Dodge.LightSource
|
||||
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 ListHelp
|
||||
import RandomHelp
|
||||
--import Sound.Data
|
||||
--import Data.Foldable
|
||||
import qualified SDL
|
||||
|
||||
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
|
||||
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
|
||||
|
||||
(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))
|
||||
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
|
||||
upitm =
|
||||
itm & ldtValue . itUse . heldParams . weaponRepeat .~ []
|
||||
& ldtValue . itUse . heldTriggerType .~ AutoTrigger
|
||||
|
||||
applyCME :: Item -> Creature -> CumulativeMuzzleEffect -> World -> World
|
||||
applyCME itm cr cme
|
||||
applyCME itm cr cme
|
||||
| _cmeSound cme = applyInvLock itm cr . applySoundCME itm cr . applySidePush spush cr . applyTorqueCME itm cr . applyRecoil itm cr
|
||||
| otherwise = failsound
|
||||
where
|
||||
@@ -77,18 +65,20 @@ applyCME itm cr cme
|
||||
|
||||
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
|
||||
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
|
||||
(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
|
||||
else return $ soundMultiFrom [CrWeaponSound cid j | j <- [0 .. 5]] (_crPos cr) soundid Nothing
|
||||
where
|
||||
cid = _crID cr
|
||||
|
||||
@@ -101,40 +91,45 @@ applyRecoil itm cr = over (cWorld . lWorld . creatures . ix cid) pushback
|
||||
|
||||
applySidePush :: Float -> Creature -> World -> World
|
||||
applySidePush 0 _ w = w
|
||||
applySidePush maxSide cr w = w
|
||||
& cWorld . lWorld . creatures . ix cid %~ push
|
||||
& randGen .~ g
|
||||
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
|
||||
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
|
||||
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
|
||||
(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
|
||||
return
|
||||
( t & ldtLeft . ix i . _2 . ldtValue . itUse . amagLoadStatus . iaLoaded -~ usedammo
|
||||
, Just (mz, usedammo, mag)
|
||||
)
|
||||
|
||||
@@ -142,14 +137,18 @@ makeMuzzleFlare :: Muzzle -> LabelDoubleTree ComposeLinkType Item -> Creature ->
|
||||
makeMuzzleFlare mz itmtree 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
|
||||
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 (getLaserColor itmtree) 0.8 (pos `v2z` 20)
|
||||
. (cWorld . lWorld . tempLightSources .:~
|
||||
tlsTimeRadColPos 1 100 (xyzV4 $ getLaserColor itmtree) (pos `v2z` 10))
|
||||
TeslaGunFlare -> cWorld . lWorld . tempLightSources .:~
|
||||
tlsTimeRadColPos 1 100 (V3 0 0 1) (pos `v2z` 10)
|
||||
LasGunFlare ->
|
||||
flareCircleAt (getLaserColor itmtree) 0.8 (pos `v2z` 20)
|
||||
. ( cWorld . lWorld . tempLightSources
|
||||
.:~ tlsTimeRadColPos 1 100 (xyzV4 $ getLaserColor itmtree) (pos `v2z` 10)
|
||||
)
|
||||
TeslaGunFlare ->
|
||||
cWorld . lWorld . tempLightSources
|
||||
.:~ tlsTimeRadColPos 1 100 (V3 0 0 1) (pos `v2z` 10)
|
||||
where
|
||||
itm = itmtree ^. ldtValue
|
||||
pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
|
||||
@@ -165,47 +164,35 @@ getLaserColor :: LabelDoubleTree ComposeLinkType Item -> Color
|
||||
getLaserColor = const yellow
|
||||
|
||||
basicMuzFlare :: Point2 -> Float -> World -> World
|
||||
basicMuzFlare pos dir = makeTlsTimeRadColPos 2 100 (V3 1 1 0.5) (pos `v2z` 20)
|
||||
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
|
||||
. 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 itmtree cr $ case _mzEffect mz of
|
||||
MuzzleShootBullet -> shootBullet itmtree cr (mz,x,magtree) w
|
||||
MuzzleLaser -> shootLaser itmtree cr mz w
|
||||
MuzzleTesla -> shootTeslaArc itm cr mz w
|
||||
MuzzleTractor -> shootTractorBeam 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
|
||||
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 itmtree cr $ case _mzEffect mz of
|
||||
MuzzleShootBullet -> shootBullet itmtree cr (mz, x, magtree) w
|
||||
MuzzleLaser -> shootLaser itmtree cr mz w
|
||||
MuzzleTesla -> shootTeslaArc itm cr mz w
|
||||
MuzzleTractor -> shootTractorBeam 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
|
||||
@@ -218,17 +205,24 @@ itemDetectorEffect itm cr w = fromMaybe w $ do
|
||||
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
|
||||
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 :: Creature -> World -> World
|
||||
shootTractorBeam cr w = w & cWorld . lWorld . tractorBeams .:~ tractorBeamAt spos outpos dir power
|
||||
@@ -251,21 +245,22 @@ tractorBeamAt pos outpos dir power =
|
||||
where
|
||||
d = unitVectorAtAngle dir * power
|
||||
|
||||
shootLaser :: LabelDoubleTree ComposeLinkType Item -> Creature -> Muzzle -> World -> World
|
||||
shootLaser itmtree cr mz w = w
|
||||
& randGen .~ g
|
||||
& cWorld . lWorld . lasers
|
||||
.:~ LaserStart
|
||||
{ _lpType = getLaserDamage itmtree
|
||||
, _lpPhaseV = getLaserPhaseV itmtree
|
||||
, _lpPos = pos
|
||||
, _lpDir = dir
|
||||
, _lpColor = getLaserColor itmtree
|
||||
}
|
||||
shootLaser :: LabelDoubleTree ComposeLinkType Item -> Creature -> Muzzle -> World -> World
|
||||
shootLaser itmtree cr mz w =
|
||||
w
|
||||
& randGen .~ g
|
||||
& cWorld . lWorld . lasers
|
||||
.:~ LaserStart
|
||||
{ _lpType = getLaserDamage itmtree
|
||||
, _lpPhaseV = getLaserPhaseV itmtree
|
||||
, _lpPos = pos
|
||||
, _lpDir = dir
|
||||
, _lpColor = getLaserColor itmtree
|
||||
}
|
||||
where
|
||||
itm = itmtree ^. ldtValue
|
||||
pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
|
||||
(a,g) = randomR (-inacc,inacc) $ _randGen w
|
||||
(a, g) = randomR (- inacc, inacc) $ _randGen w
|
||||
inacc = _mzInaccuracy mz
|
||||
dir = _crDir cr + _mzRot mz + a
|
||||
|
||||
@@ -282,22 +277,24 @@ lasRayAt col dam phasev pos dir =
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
@@ -309,8 +306,14 @@ getBulletType itmtree magtree mz cr w = magtree ^? ldtValue . itUse . amagParams
|
||||
attree <- lookup AmmoEffectLink (magtree ^. ldtLeft)
|
||||
attree ^? ldtValue . itUse . buMod . bmEffect
|
||||
|
||||
getBulletTrajectory :: Muzzle -> Item
|
||||
-> BulletTrajectoryType -> Point2 -> Creature -> World -> BulletTrajectory
|
||||
getBulletTrajectory ::
|
||||
Muzzle ->
|
||||
Item ->
|
||||
BulletTrajectoryType ->
|
||||
Point2 ->
|
||||
Creature ->
|
||||
World ->
|
||||
BulletTrajectory
|
||||
getBulletTrajectory mz itm bt tp cr w = case bt of
|
||||
BasicBulletTrajectoryType -> BasicBulletTrajectory
|
||||
FlechetteTrajectoryType -> FlechetteTrajectory tp
|
||||
@@ -319,48 +322,45 @@ getBulletTrajectory mz itm bt tp cr w = case bt of
|
||||
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
|
||||
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?
|
||||
shootBullet ::
|
||||
LabelDoubleTree ComposeLinkType Item ->
|
||||
Creature ->
|
||||
(Muzzle, Int, LabelDoubleTree ComposeLinkType Item) ->
|
||||
World ->
|
||||
World
|
||||
shootBullet itmtree cr (mz, x, magtree) w = fromMaybe w $ do
|
||||
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
|
||||
)
|
||||
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
|
||||
(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'
|
||||
(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
|
||||
Just x | x /= 0 -> fst . randomR (- x, x) $ _randGen w
|
||||
_ -> 0
|
||||
|
||||
mcUseHeld :: HeldItemType -> Item -> Machine -> World -> World
|
||||
@@ -382,16 +382,18 @@ useGasParams mmagid mz itm cr w =
|
||||
pos
|
||||
dir
|
||||
cr
|
||||
w & randGen .~ g'
|
||||
w
|
||||
& randGen
|
||||
.~ g'
|
||||
where
|
||||
(pressure,g) = doGenFloat (_nzPressure $ _mzEffect mz) (_randGen w)
|
||||
(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
|
||||
(a, g') = randomR (- inacc, inacc) g
|
||||
inacc = _mzInaccuracy mz
|
||||
dir = _crDir cr + _mzRot mz + a + _nzCurrentWalkAngle (_mzEffect mz)
|
||||
|
||||
@@ -399,8 +401,8 @@ 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
|
||||
doGenFloat (ConstFloat x) g = (x, g)
|
||||
doGenFloat (UniRandFloat x y) g = randomR (x, y) g
|
||||
|
||||
--caneStickSoundChoice :: Item -> SoundID
|
||||
--caneStickSoundChoice _ = tap3S
|
||||
@@ -447,6 +449,7 @@ shootTeslaArc itm cr mz w =
|
||||
-- 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)
|
||||
@@ -460,31 +463,50 @@ useForceFieldGun _ _ = id
|
||||
-- where
|
||||
-- i = fromMaybe (IM.newKey (_walls (_lWorld (_cWorld w)))) $ itm ^? itParams . paramMID . _Just
|
||||
|
||||
determineProjectileTracking :: LabelDoubleTree ComposeLinkType Item
|
||||
-> LabelDoubleTree ComposeLinkType Item
|
||||
-> ProjectileHoming
|
||||
determineProjectileTracking ::
|
||||
LabelDoubleTree ComposeLinkType Item ->
|
||||
LabelDoubleTree ComposeLinkType Item ->
|
||||
ProjectileHoming
|
||||
determineProjectileTracking magtree itmtree = case lookup RemoteScreenLink (magtree ^. ldtLeft) of
|
||||
Just screen -> HomeUsingRemoteScreen (screen ^. ldtValue . itID)
|
||||
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 ::
|
||||
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
|
||||
aparams <- ammoitem ^? itUse . amagParams . ampPayload
|
||||
return $ createShell homing aparams muz cr
|
||||
. startthesound
|
||||
return $
|
||||
createShell homing aparams muz cr
|
||||
. startthesound
|
||||
where
|
||||
-- the sound should be moved to the projectile firing
|
||||
startthesound = soundMultiFrom [CrWeaponSound (_crID cr) j | j <- [0..3]] (_crPos cr) tap4S Nothing
|
||||
startthesound = soundMultiFrom [CrWeaponSound (_crID cr) j | j <- [0 .. 3]] (_crPos cr) tap4S 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'
|
||||
|
||||
---- 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
|
||||
|
||||
+1
-1
@@ -59,7 +59,7 @@ doDrawing' win pdata u = do
|
||||
shadV = _pictureShaders pdata
|
||||
nFls = w ^. cWorld . numberFloorVerxs
|
||||
-- bind as much data into vbos as feasible at this point
|
||||
-- count mutable vectors setup
|
||||
-- count mutable vectors setup (what is the 6 here?)
|
||||
layerCounts <- UMV.replicate (numLayers * 6) 0
|
||||
-- attempt to poke in parallel
|
||||
let wswp = wallSPics <> worldSPic cfig u
|
||||
|
||||
Reference in New Issue
Block a user