Files
loop/src/Dodge/Item/Weapon.hs
T

1031 lines
35 KiB
Haskell

{- | Definitions of weapons.
In progress: move out effects into other modules. -}
module Dodge.Item.Weapon
where
import Dodge.Data
import Dodge.Base
import Dodge.Picture.Layer
import Dodge.SoundLogic
import Dodge.Creature.Action
import Dodge.RandomHelp
import Dodge.WorldEvent
import Dodge.Default
--import Dodge.Default.Shell
import Dodge.Item.Draw
import Dodge.Particle.Bullet.HitEffect
import Dodge.Item.Weapon.InventoryDisplay
import Dodge.Item.Weapon.TriggerType
import Dodge.Item.Weapon.ExtraEffect
import Dodge.Item.Weapon.UseEffect
import Dodge.Item.Weapon.Laser
import Dodge.Default.Weapon
import Dodge.Item.Weapon.Booster
import Dodge.Item.Weapon.Grenade
import Dodge.Item.Attachment.Data
import Dodge.Item.Attachment
import Geometry
import Picture
import qualified IntMapHelp as IM
--import Data.List
--import Data.Char
import Data.Maybe
import Data.Function
--import qualified Data.ByteString as B
import qualified Data.Sequence as Seq
import Control.Lens
import Control.Applicative
import Control.Monad.State
--import Control.Monad
import qualified SDL
import System.Random
import qualified Data.Set as S
--import qualified Data.Map as M
pistol :: Item
pistol = Weapon
{ _itName = "PISTOL"
, _itIdentity = Pistol
, _wpMaxAmmo = 15
, _wpLoadedAmmo = 15
, _wpAmmo = GenericAmmo
, _wpReloadTime = 40
, _wpReloadState = 0
, _itUseRate = 8
, _itUseTime = 0
, _itUse = \_ ->
hammerCheck
. shootWithSound 0
. withRandomDir 0.1
. withMuzFlare
. withVelWthHiteff (30,0) 2
$ destroyOnImpact bulHitCr bulHitWall' bulHitFF'
, _itLeftClickUse = Nothing
, _wpSpread = 0.02
, _wpRange = 20
, _itHammer = HammerUp
, _itFloorPict = onLayer FlItLayer $ color green $ polygon $ rectNESW 3 3 (-3) (-3)
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itZoom = defaultItZoom
, _itEquipPict = pictureWeaponOnAim $ color green $ polygon $ rectNESW 3 3 (-3) (-3)
, _itScrollUp = const id
, _itScrollDown = const id
, _itAttachment = Nothing
, _itID = Nothing
, _itEffect = wpRecock
, _itInvDisplay = basicWeaponDisplay
, _itInvColor = white
, _itTargeting = Nothing
, _itWorldTrigger = Nothing
}
effectGun :: String -> (Creature -> World -> World) -> Item
effectGun name eff = defaultGun
{ _itName = name ++ "Gun"
, _itUse = \_ -> eff
}
autoEffectGun :: String -> (Creature -> World -> World) -> Item
autoEffectGun name eff = defaultAutoGun
{ _itName = name ++ "Gun"
, _itUse = \_ -> eff
}
autoGun :: Item
autoGun = defaultGun
{ _itName = "AUTOGUN"
, _itIdentity = AutoGun
, _wpMaxAmmo = 30
, _wpLoadedAmmo = 30
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 6
, _itUseTime = 0
, _itUse = \_ -> charFiringStrat
[('M',autoFireMode)
,('S',singleFireMode)
]
, _wpSpread = autogunSpread
, _wpRange = 20
, _itHammer = HammerUp
, _itFloorPict = onLayer FlItLayer $ color red $ pictures [polygon [(-4,-4),(-4,4),(4,4),(4,-4)]]
, _itAimingSpeed = 0.4
, _itAimingRange = 1
, _itZoom = defaultItZoom {_itAimZoomFac = 1.5}
, _itEquipPict = pictureWeaponOnAim $ color red $ polygon $ rectNESW 4 4 (-4) (-4)
, _itEffect = wpRecock
, _itAttachment = Just $ ItCharMode $ Seq.fromList "MS"
, _itScrollUp = incCharMode
, _itScrollDown = decCharMode
, _itInvDisplay = basicWeaponDisplay
}
autoFireMode, singleFireMode, autoGunNonTwistEff :: Creature -> World -> World
autoFireMode = shootWithSound (fromIntegral autoGunSound)
. torqueBefore 0.05
$ autoGunNonTwistEff
singleFireMode = hammerCheck $ shootWithSound (fromIntegral autoGunSound) autoGunNonTwistEff
autoGunNonTwistEff = withRecoil 40
. withRandomDir (autogunSpread/2)
. withMuzFlare
. withVelWthHiteff (50,0) 3
$ destroyOnImpact bulHitCr bulHitWall' bulHitFF'
rezGun :: Item
rezGun = defaultGun
{ _itName = "REANIMATOR"
, _wpMaxAmmo = 50
, _wpLoadedAmmo = 50
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _itUse = \_ -> shoot aTeslaArc
, _wpSpread = 0.001
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color chartreuse $ pictures
[polygon $ rectNESW 7 3 1 (-3)
,polygon $ rectNESW (-1) 3 (-7) (-3)
]
, _itAimingSpeed = 0.4
, _itAimingRange = 0
, _itEquipPict = pictureWeaponOnAim $ color chartreuse $ pictures
[polygon $ rectNESW 7 3 1 (-3)
,polygon $ rectNESW (-1) 3 (-7) (-3)
]
}
teslaGun :: Item
teslaGun = defaultGun
{ _itName = "TESLA"
, _itIdentity = TeslaGun
, _wpMaxAmmo = 200
, _wpLoadedAmmo = 200
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _itUse = \_ -> shoot aTeslaArc
, _wpSpread = 0.001
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color blue $ pictures
[polygon $ rectNESW 7 3 1 (-3)
,polygon $ rectNESW (-1) 3 (-7) (-3)
]
, _itAimingSpeed = 0.4
, _itZoom = defaultItZoom
, _itAimingRange = 0
, _itEquipPict = pictureWeaponOnAim $ color blue $ pictures
[polygon $ rectNESW 7 3 1 (-3)
,polygon $ rectNESW (-1) 3 (-7) (-3)
]
}
lasGun :: Item
lasGun = defaultAutoGun
{ _itName = "LASGUN ////"
, _itIdentity = LasGun
, _wpMaxAmmo = 200
, _wpLoadedAmmo = 200
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _itUse = \_ -> shoot aLaser
, _wpSpread = 0.001
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color blue $ polygon $ rectNESW 3 3 (-3) (-3)
, _itAimingSpeed = 0.4
, _itAimingRange = 1
, _itEquipPict = pictureWeaponOnAim $ color blue $ polygon $ rectNESW 3 3 (-3) (-3)
, _itAttachment = Just $ ItCharMode $ Seq.fromList "/VZ"
, _itScrollUp = incCharMode
, _itScrollDown = decCharMode
, _itInvDisplay = basicWeaponDisplay
}
forceFieldGun :: Item
forceFieldGun = defaultGun
{ _itName = "FORCEFIELD"
, _itIdentity = ForceFieldGun
, _wpMaxAmmo = 100
, _wpLoadedAmmo = 100
, _wpReloadTime = 40
, _wpReloadState = 0
, _itUseRate = 10
, _itUseTime = 0
, _itUse = undefined
, _wpSpread = 0.02
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ polygon [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)]
, _itAimingSpeed = 0.4
, _itAimingRange = 0.5
}
-- grapGun = defaultGun
-- { _itName = "grapGun"
-- , _itIdentity = GrapGun
-- , _wpMaxAmmo = 1
-- , _wpLoadedAmmo = 1
-- , _wpReloadTime = 40
-- , _wpReloadState = 0
-- , _itUseRate = 10
-- , _itUseTime = 0
-- , _itUse = grapFire
-- , _wpSpread = 0.002
-- , _wpRange = 20
-- , _wpIsAuto = False
-- , _itFloorPict = onLayer FlItLayer $ polygon [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)]
-- , _itAmount = 1
-- , _itMaxStack = 1
-- , _itAimingSpeed = 1
-- , _itAimingRange = 0.5
-- }
tractorGun :: Item
tractorGun = defaultAutoGun
{ _itName = "TRACTORGUN"
, _itIdentity = TractorGun
, _wpMaxAmmo = 10000
, _wpLoadedAmmo = 10000
, _wpReloadTime = 40
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _itUse = \_ -> shoot $ aTractorBeam 0
, _wpSpread = 0.00001
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ]
, _itAimingSpeed = 0.4
, _itAimingRange = 0.5
, _itEquipPict = pictureWeaponOnAim $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ]
}
removeItAttachment :: Int -> Int -> World -> World
removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachment .~ Nothing
where
cr = _creatures w IM.! i
itRef = _crInvSel cr
remoteLauncher :: Item
remoteLauncher = defaultGun
{ _itName = "ROCKO-REM"
, _itIdentity = RemoteLauncher
, _wpMaxAmmo = 1
, _wpLoadedAmmo = 1
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 10
, _itUseTime = 0
, _itUse = \_ -> hammerCheck fireRemoteLauncher
, _wpSpread = 0.02
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
, _itAimingSpeed = 0.2
, _itAimingRange = 0.5
, _itEquipPict = pictureWeaponOnAim $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
, _itAttachment = Just $ ItScope (0,0) 0 1 True
}
hvAutoGun :: Item
hvAutoGun = defaultAutoGun
{ _itName = "AUTO-HV"
, _itIdentity = HvAutoGun
, _wpMaxAmmo = 100
, _wpLoadedAmmo = 100
, _wpReloadTime = 200
, _wpReloadState = 0
, _itUseRate = 25
, _itUseTime = 0
, _itUse = \_ -> rateIncAB 24 10 (torqueBeforeForced 0.1 mkHvBul) $ torqueAfter 0.2 mkHvBul
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color orange $ polygon $ rectNESW 5 5 (-5) (-5)
, _itAimingSpeed = 0.2
, _itAimingRange = 1
, _itEquipPict = pictureWeaponOnAim $ color orange $ polygon $ rectNESW 5 5 (-5) (-5)
}
where
mkHvBul = withSound (fromIntegral longGunSound)
. withThinSmoke
. withMuzFlare
. withVelWthHiteff (80,0) 6
$ penWalls hvBulHitCr' hvBulHitWall' bulHitFF'
ltAutoGun :: Item
ltAutoGun = defaultAutoGun
{ _itName = "AUTO-LT"
, _itIdentity = LtAutoGun
, _wpMaxAmmo = 25
, _wpLoadedAmmo = 25
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 4
, _itUseTime = 0
, _itUse = \_ -> shootWithSound 0 . withRandomDir 0.3 . withSidePush 50
. withMuzFlare $ withVelWthHiteff (30,0) 2 basicBulletEffect
, _wpSpread = 0.5
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color green $ pictures [polygon $ rectNSWE 4 (-4) (-4) 0
,circleSolid 4
]
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itZoom = defaultItZoom
, _itEquipPict = pictureWeaponOnAim $ color green $ pictures [polygon $ rectNSWE 4 (-4) (-4) 0
,circleSolid 4
]
}
miniGun :: Item
miniGun = defaultAutoGun
{ _itName = "MINI-G"
, _itIdentity = MiniGun
, _wpMaxAmmo = 150
, _wpLoadedAmmo = 150
, _wpReloadTime = 200
, _wpReloadState = 0
, _itUseRate = 2
, _itUseTime = 0
, _itUse = \_ -> withWarmUp 50 . torqueBefore 0.03 . withSidePush 50 . withRecoil 15
. withRandomDir 0.1
. withRandomOffset 9
. withMuzFlare
. withVelWthHiteff (30,0) 2
$ destroyOnImpact bulBounceArmCr' bulHitWall' bulHitFF'
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color red $ polygon $ rectNESW 9 5 (-9) (-5)
, _itAimingSpeed = 0.4
, _itAimingRange = 1
, _itEquipPict = pictureWeaponOnAim $ color red $ polygon $ rectNESW 9 5 (-9) (-5)
}
spreadGun :: Item
spreadGun = defaultGun
{ _itName = "SPREAD"
, _itIdentity = SpreadGun
, _wpMaxAmmo = 5
, _wpLoadedAmmo = 5
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 20
, _itUseTime = 0
, _itUse = \_ -> shootWithSound (fromIntegral shotgunSound)
. withRecoil 100
. withMuzFlare
$ spreadNumVelWthHiteff spreadGunSpread 9 (30,0) 2 basicBulletEffect
, _wpSpread = spreadGunSpread
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)] ]
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itEquipPict = pictureWeaponOnAim $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)] ]
}
multGun :: Item
multGun = defaultGun
{ _itName = "MULTGUN"
, _itIdentity = MultGun
, _wpMaxAmmo = 2
, _wpLoadedAmmo = 2
, _wpReloadTime = 40
, _wpReloadState = 0
, _itUseRate = 20
, _itUseTime = 0
, _itUse = \_ -> shootWithSound (fromIntegral shotgunSound)
. withRecoil 200
. withMuzFlare
$ numVelWthHitEff 5 (50,0) 5 basicBulletEffect
, _wpSpread = spreadGunSpread
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer multGunPic
, _itAimingSpeed = 0.4
, _itAimingRange = 1
, _itZoom = defaultItZoom {_itAimZoomFac = 1.5}
, _itEquipPict = pictureWeaponOnAim multGunPic
}
where
multGunPic = color red $ pictures
[ polygon $ rectNSEW 12 8 2 (-2)
, polygon $ rectNSEW 7 3 2 (-2)
, polygon $ rectNSEW 2 (-2) 2 (-2)
, polygon $ rectNSEW (-3) (-7) 2 (-2)
, polygon $ rectNSEW (-8) (-12) 2 (-2)
, polygon [(-1.5,12),(-2,12),(-2,-12),(-1.5,-12)]
]
longGun :: Item
longGun = defaultGun
{ _itName = "LONGGUN"
, _itIdentity = LongGun
, _wpMaxAmmo = 1
, _wpLoadedAmmo = 1
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 100
, _itUseTime = 0
, _itUse = \_ -> shootWithSound (fromIntegral longGunSound)
. withThickSmoke
. torqueAfter 0.05
. withMuzFlare
. withVelWthHiteff (60,0) 6
$ penWalls hvBulHitCr' hvBulHitWall' bulHitFF'
, _wpRange = 200
, _itFloorPict = onLayer FlItLayer $ pictures [color orange $ polygon $ rectNESW 3 6 (-3) (-6) ]
, _itAimingSpeed = 0.2
, _itAimingRange = 1
, _itZoom = defaultItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5}
, _itEquipPict = pictureWeaponOnAim $ pictures [color orange $ polygon $ rectNESW 3 6 (-3) (-6) ]
, _itScrollUp = startZoomInLongGun
, _itScrollDown = startZoomOutLongGun
, _itAttachment = Just $ ItScope (0,0) 0 1 False
, _itEffect = itemLaserScopeEffect
}
startZoomInLongGun :: Int -> World -> World
startZoomInLongGun _ w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment . _Just . scopeZoomChange %~ \x -> max 5 (x + 5)
startZoomOutLongGun :: Int -> World -> World
startZoomOutLongGun _ w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment . _Just . scopeZoomChange %~ \x -> min (-5) (x-5)
poisonSprayer :: Item
poisonSprayer = defaultAutoGun
{ _itName = "POISON"
, _itIdentity = PoisonSprayer
, _wpMaxAmmo = 500
, _wpLoadedAmmo = 500
, _wpReloadTime = 100
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _itUse = \_ -> shoot aGasCloud
, _wpSpread = 0.3
, _wpRange = 8
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
, _itAimingSpeed = 0.2
, _itAimingRange = 0
, _itZoom = defaultItZoom
, _itEquipPict = pictureWeaponOnAim $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
}
flamer :: Item
flamer = defaultAutoGun
{ _itName = "FLAMER"
, _itIdentity = Flamethrower
, _wpMaxAmmo = 250
, _wpLoadedAmmo = 250
, _wpReloadTime = 100
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _itUse = \_ -> shoot $ withSidePush 5 $ withSidePushAfter 10 $ randWalkAngle 0.2 0.01 aFlame
, _wpSpread = 0
, _wpRange = 8
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
, _itAimingSpeed = 0.5
, _itAimingRange = 0
, _itZoom = defaultItZoom {_itAimZoomMax = 5, _itAimZoomMin = 1.5}
, _itEquipPict = pictureWeaponOnAim $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
, _itAttachment = Nothing
}
blinkGun :: Item
blinkGun = defaultGun
{ _itName = "BLINKER"
, _itIdentity = Blinker
, _wpMaxAmmo = 100
, _wpLoadedAmmo = 100
, _wpReloadTime = 20
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _itUse = \_ -> hammerCheck $ shoot aSelf
, _itLeftClickUse = Just $ hammerCheckL $ shootL aSelfL
, _wpSpread = 0.05
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ polygon [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
, _itAimingSpeed = 1
, _itAimingRange = 0
}
boosterGun :: Item
boosterGun = defaultGun
{ _itName = "BOOSTER"
, _itIdentity = Blinker
, _wpMaxAmmo = 100
, _wpLoadedAmmo = 100
, _wpReloadTime = 20
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _itUse = \_ -> boostSelf 10
, _itLeftClickUse = Just $ boostSelfL 10
, _wpSpread = 0.05
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ polygon [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itEffect = resetAttachmentID
}
aTeslaArc :: Creature -> World -> World
aTeslaArc cr w = aTeslaArc' cr $ soundFrom (CrWeaponSound cid) 25 1 0 w
where
cid = _crID cr
aTeslaArc' :: Creature -> World -> World
aTeslaArc' cr w
= teslaGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir)
$ over projectiles (IM.insert i (makeTeslaArcAt i pos dir))
$ set randGen g w
where
i = newProjectileKey w
pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
+.+ sideOffset *.* vNormal (unitVectorAtAngle dir)
(sideOffset,g) = randomR (-5,5) $ _randGen w
dir = _crDir cr
remoteShellPic
:: Int -- ^ Timer
-> Picture
remoteShellPic t
| rem (t+200) 20 < 9 = polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
| otherwise = pictures
[ onLayer UPtLayer $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
, setLayer 1 $ onLayer HPtLayer $ color col $ circleSolid 3
]
where
col | t > (-99) = green
| otherwise = red
shellExplosionAt :: Point2 -> World -> World
shellExplosionAt = makeExplosionAt
aGasCloud :: Creature -> World -> World
aGasCloud cr w = insertCloud $ set randGen g w
where
(a,g) = randomR (-0.1,0.1) (_randGen w)
dir = _crDir cr + a
pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
vel = (_crPos cr -.- _crOldPos cr) +.+ 10 *.* unitVectorAtAngle dir
insertCloud = makeGasCloud pos vel
aFlame :: Creature -> World -> World
aFlame cr w = w & particles %~ (aFlameParticle t pos vel (Just cid) :)
where
(t,_) = randomR (99,101) (_randGen w)
cid = _crID cr
dir = _crDir cr
pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir
aSelf :: Creature -> World -> World
aSelf = blinkAction
aSelfL :: Creature -> Int -> World -> World
aSelfL cr _ = blinkAction cr
reflect :: Float -> Float -> Float
reflect a b = a + 2*(a-b)
pointToItem :: Applicative f =>
ItemPos -> (Item -> f Item) -> World -> f World
pointToItem (InInv cid invid) = creatures . ix cid . crInv . ix invid
pointToItem (OnFloor flid) = floorItems . ix flid . flIt
retireRemoteRocket :: Int -> Int -> Int -> World -> World
retireRemoteRocket itid 0 pjid w =
set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) (0,0)
$ set (pointToItem (_itemPositions w IM.! itid) . itUse) (\_ -> hammerCheck fireRemoteLauncher)
(w & projectiles %~ IM.delete pjid)
retireRemoteRocket itid t pjid w = setScope w
& projectiles . ix pjid . pjUpdate .~ (\_ -> retireRemoteRocket itid (t-1) pjid)
where
setScope w' = case _itemPositions w' IM.! itid of
InInv cid invid -> w'
& creatures . ix cid . crInv . ix invid . itAttachment
. _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
_ -> w'
pos = fromMaybe (0,0) $ w ^? projectiles . ix pjid . pjPos
retireRemoteBomb :: Int -> Int -> Int -> World -> World
retireRemoteBomb itid 0 pjid w = w
& pointToItem (_itemPositions w IM.! itid) %~
( (itAttachment . _Just . scopePos .~ (0,0))
. (itZoom .~ defaultItZoom)
. (itUse .~ (\_ -> hammerCheck throwRemoteBomb))
)
& projectiles %~ IM.delete pjid
retireRemoteBomb itid t pjid w = setScope w
& projectiles . ix pjid . pjUpdate .~ (\_ -> retireRemoteBomb itid (t-1) pjid)
where
setScope w' = case _itemPositions w' IM.! itid of
InInv cid invid -> w'
& creatures . ix cid . crInv . ix invid . itAttachment
. _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
_ -> w'
pos = fromMaybe (0,0) $ w ^? projectiles . ix pjid . pjPos
moveRemoteBomb :: Int -> Int -> Int -> World -> World
moveRemoteBomb itid time pID w
| time < -4 = setScope
$ updatePicture
$ set (projectiles .ix pID.pjUpdate) (\_ -> moveRemoteBomb itid (f time) pID)
w
| time < 2
= case hitWl of
Just _ -> soundOnce (fromIntegral tapQuiet) $ halfV updatedWorld
_ -> halfV updatedWorld
| otherwise
= case hitWl of
Just _ -> soundOnce (fromIntegral tapQuiet) updatedWorld
_ -> updatedWorld
where
updatedWorld
= updateV $ set (projectiles . ix pID . pjPos) finalPos
$ updatePicture
$ set (projectiles .ix pID.pjUpdate) (\_ -> moveRemoteBomb itid (time-1) pID)
$ setScope
w
setScope w' = case _itemPositions w' IM.! itid of
InInv cid invid
-> w' & creatures . ix cid . crInv . ix invid . itAttachment
. _Just . scopePos .~ (newPos -.- _crPos (_creatures w' IM.! cid))
& creatures . ix cid . crInv . ix invid . itZoom
.~ (defaultItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5})
_ -> w'
pj = _projectiles w IM.! pID
oldPos = _pjPos pj
newPos = _pjVel pj +.+ oldPos
-- this is hacky, should use a version of collidePointWalls' that collides
-- circles and walls
invShift x = x -.- 5 *.* normalizeV (_pjVel pj)
hitWl = collideCircWalls' oldPos newPos 4 $ wallsNearPoint newPos w
finalPos = maybe newPos (invShift . fst) hitWl
setV v = set (projectiles . ix pID . pjVel) v
updateV = maybe id (setV . snd) hitWl
halfV = projectiles . ix pID . pjVel %~ (0.5 *.*)
f x | x < -369 = -10
| otherwise = x - 1
updatePicture =
set (projectiles . ix pID . pjDraw)
(\_ -> onLayer PtLayer $ uncurry translate newPos $ remoteBombPic time)
. lowLightDirected
(withAlpha 0.1 red)
newPos
(50 *.* unitVectorAtAngle (negate $ degToRad (10 * fromIntegral time)))
[-0.2,-0.15,-0.1,-0.05,0,0.05,0.1,0.15,0.2]
grenade :: Item
grenade = Throwable
{ _itName = "GRENADE " ++ show fuseTime
, _itIdentity = Grenade
, _itMaxStack = 8
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
, _twMaxRange = 150
, _twAccuracy = 30
, _itUse = \_ -> useTimeCheck $ throwGrenade makeExplosionAt
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itZoom = defaultItZoom {_itAimZoomMax = f fuseTime, _itAimZoomMin = f fuseTime}
, _itEquipPict = pictureWeaponOnAim $ grenadePic fuseTime
, _itID = Nothing
, _itUseRate = 50
, _itUseTime = 0
, _itAttachment = Just $ ItFuse fuseTime
, _itInvColor = white
, _itInvDisplay = basicWeaponDisplay
, _itEffect = wpRecock
, _itHammer = HammerUp
, _itScrollUp = decreaseFuse fuseTime
, _itScrollDown = increaseFuse fuseTime
}
where
fuseTime = 50
f x = 50 / fromIntegral x
flameGrenade :: Item
flameGrenade = grenade {
_itName = "FLMGREN " ++ show fuseTime
, _itUse = \_ -> throwGrenade makeFlameExplosionAt
}
where
fuseTime = 50 :: Int
--f x = 50 / fromIntegral x
teslaGrenade :: Item
teslaGrenade = grenade {
_itName = "TLSGREN " ++ show fuseTime
, _itUse = \_ -> throwGrenade makeTeslaExplosionAt
}
where
fuseTime = 50 :: Int
--f x = 50 / fromIntegral x
defaultThrowable :: Item
defaultThrowable = grenade
remoteBomb :: Item
remoteBomb = defaultThrowable
{ _itName = "REMOTEBOMB"
, _itIdentity = RemoteBomb
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
, _twMaxRange = 150
, _twAccuracy = 30
, _itUse = \_ -> hammerCheck throwRemoteBomb
, _itAttachment = Just $ ItScope (0,0) 0 1 True
, _itEquipPict = pictureWeaponOnAim remoteBombUnarmedPic
}
fireRemoteLauncher :: Creature -> World -> World
fireRemoteLauncher cr w = setLocation
$ resetFire
$ resetName
$ soundOnce (fromIntegral launcherSound)
$ over projectiles remRocket w
where
i = IM.newKey $ _projectiles w
cid = _crID cr
dir = _crDir cr
pos = _crPos cr +.+ rotateV dir (_crRad cr + 1,0)
remRocket = IM.insert i $ Projectile
{ _pjPos = pos
, _pjStartPos = pos
, _pjVel = rotateV dir (1,0)
, _pjDraw = \_ -> blank
, _pjID = i
, _pjUpdate = \_ -> moveRemoteShell 50 i cid itid dir
}
j = _crInvSel cr
newitid = IM.newKey $ _itemPositions w
maybeitid = cr ^? crInv . ix j . itID . _Just
resetFire = set (creatures . ix cid . crInv . ix j . itUse)
$ \_ -> hammerCheck $ \_ -> explodeRemoteRocket itid i
resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEROCKET"
setLocation :: World -> World
setLocation w' = case maybeitid of
Nothing -> w' & creatures . ix cid . crInv . ix j . itID ?~ newitid
& itemPositions %~ IM.insert newitid (InInv cid j)
_ -> w'
itid = fromMaybe newitid maybeitid
moveRemoteShell :: Int -> Int -> Int -> Int -> Float -> World -> World
moveRemoteShell time i cid itid _ w
| time > 40 = if circOnSomeWall oldPos 4 w
then doExplosion w
else over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . pjDraw) (\_ -> piclow)
$ set (projectiles . ix i . pjUpdate)
(\_ -> moveRemoteShell (time-1) i cid itid newdir)
$ setScope
w
| time >= 20 = case thingHit of
Just _ -> doExplosion w
Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . pjDraw) (\_ -> pic)
$ set (projectiles . ix i . pjUpdate)
(\_ -> moveRemoteShell (time-1) i cid itid newdir)
$ setScope
w
| time > -99 = case thingHit of
Just _ -> doExplosion
$ stopSoundFrom (ShellSound i)
w
Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set randGen g
$ set (projectiles . ix i . pjDraw) (\_ -> pic)
$ set (projectiles . ix i . pjUpdate) (\_ -> moveRemoteShell (time-1) i cid itid newdir)
$ over (projectiles . ix i . pjVel) (\v -> accel +.+ frict *.* v)
$ soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250
$ smokeGen
$ makeFlameletTimed oldPos (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10
$ setScope
w
| time > -200 = case thingHit of
Just _ -> doExplosion
$ stopSoundFrom (ShellSound i)
w
Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . pjDraw) (\_ -> pic)
$ set (projectiles . ix i . pjUpdate) (\_ -> moveRemoteShell (time-1) i cid itid newdir)
$ setScope
w
| otherwise = doExplosion
$ stopSoundFrom (ShellSound i)
w
where
pj = _projectiles w IM.! i
oldPos = _pjPos pj
vel = _pjVel pj
newPos = oldPos +.+ vel
newdir
| SDL.ButtonRight `S.member` _mouseButtons w
&& w ^? creatures . ix cid . crInvSel == w ^? itemPositions . ix itid . itInvId
= _cameraRot w + argV (_mousePos w)
| otherwise = dir
accel = rotateV newdir (2,0)
(frict,g) = randomR (0.6,0.9) $ _randGen w
(sparkD,_) = randomR (-0.5,0.5) $ _randGen w
dir = argV vel
pic = uncurry translate newPos
$ rotate (argV accel) $ remoteShellPic time
piclow = onLayerL [levLayer CrLayer - 2]
$ uncurry translate newPos $ rotate (argV accel)
$ remoteShellPic time
hitCr = fst <$> collideCircCrsPoint oldPos newPos 4 w
hitWl = fst <$> collideCircWalls' oldPos newPos 2 (wallsNearPoint newPos w)
thingHit = hitCr <|> hitWl
r1 = _randGen w & evalState (randInCirc 10)
smokeGen = makeSmokeCloudAt $ oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)
doExplosion = explodeRemoteRocket itid i
setScope w' = case _itemPositions w' IM.! itid of
InInv cid' invid
-> w' & creatures . ix cid' . crInv . ix invid . itAttachment
. _Just . scopePos .~ (newPos -.- _crPos (_creatures w' IM.! cid'))
_ -> w'
explodeRemoteRocket
:: Int -- ^ Item id
-> Int -- ^ Projectile id
-> World
-> World
explodeRemoteRocket itid pjid w
= set (projectiles . ix pjid . pjUpdate) (\_ -> retireRemoteRocket itid 30 pjid)
$ set (projectiles . ix pjid . pjDraw) (\_ -> blank)
$ set (itPoint . itUse) (\_ _ -> id)
$ resetName
$ makeExplosionAt (_pjPos (_projectiles w IM.! pjid)) w
where
resetName = set (itPoint . itName) "REMOTELAUNCHER"
itPoint = pointToItem $ _itemPositions w IM.! itid
throwRemoteBomb :: Creature -> World -> World
throwRemoteBomb cr w = setLocation
$ removePict
$ resetFire
$ resetName
$ over projectiles addG w
where
cid = _crID cr
addG = IM.insert i $ Projectile
{ _pjPos = p
, _pjStartPos = p
, _pjVel = v
, _pjDraw = \_ -> blank
, _pjID = i
, _pjUpdate = \_ -> moveRemoteBomb itid 50 i
}
i = newProjectileKey w
v' = 0.02 / _cameraZoom w *.* rotateV (_cameraRot w) ( _mousePos w)
v | magV v' > 6 = 6 *.* normalizeV v'
| otherwise = v'
j = _crInvSel cr
resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTE"
removePict = set (creatures . ix cid . crInv . ix j . itEquipPict) $ \ _ _ -> blank
resetFire = set (creatures . ix cid . crInv . ix j . itUse)
$ \_ -> hammerCheck $ explodeRemoteBomb itid i
p' = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr,0)
p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr-4,0)
| otherwise = p'
maybeitid = w ^? creatures . ix cid . crInv . ix j . itID . _Just
setLocation :: World -> World
setLocation w' = case maybeitid of
Nothing -> w' & creatures . ix cid . crInv . ix j . itID ?~ newitid
& itemPositions %~ IM.insert newitid (InInv cid j)
_ -> w'
newitid = IM.newKey $ _itemPositions w
itid = fromMaybe newitid maybeitid
explodeRemoteBomb :: Int -> Int -> Creature -> World -> World
explodeRemoteBomb itid pjid cr w
= set (projectiles . ix pjid . pjUpdate) (\_ -> retireRemoteBomb itid 30 pjid)
$ set (projectiles . ix pjid . pjDraw) (\_ -> blank)
$ set (creatures . ix cid . crInv . ix j . itUse) (\_ -> const id)
$ resetName
$ resetPict
-- $ resetScope
$ makeExplosionAt (_pjPos (_projectiles w IM.! pjid)) w
-- - $ makeShrapnelBombAt (_pjPos (_projectiles w IM.! pjid)) w
where
cid = _crID cr
resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEBOMB"
resetPict = set (creatures . ix cid . crInv . ix j . itEquipPict )
(pictureWeaponOnAim remoteBombUnarmedPic)
-- resetScope = creatures . ix cid . crInv . ix j . itScope . _Just . scopePos .~ (0,0)
j = _crInvSel $ _creatures w IM.! cid
remoteBombPic
:: Int -- ^ time
-> Picture
remoteBombPic _ = pictures
[ color (dark $ dark orange) $ circleSolid 5
]
remoteBombUnarmedPic :: Picture
remoteBombUnarmedPic = color (dark $ dark orange) $ circleSolid 5
spreadGunSpread,autogunSpread :: Float
spreadGunSpread = 0.5
autogunSpread = 0.07
pipe :: Item
pipe = Craftable
{ _itIdentity = Generic
, _itName = "PIPE"
, _itMaxStack = 3
, _itAmount = 3
, _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> blank
, _itID = Nothing
, _itInvDisplay = _itName
, _itInvColor = green
}
{- |
Sends out pulses that display walls. -}
radar :: Item
radar = defaultGun
{ _itName = "RADAR"
, _itIdentity = Generic
, _wpMaxAmmo = 100
, _wpLoadedAmmo = 100
, _wpReloadTime = 200
, _wpReloadState = 0
, _itUseRate = 120
, _itUseTime = 0
, _itUse = \_ -> shoot aRadarPulse
, _wpSpread = autogunSpread
, _wpRange = 20
, _itHammer = HammerUp
, _itFloorPict = onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
, _itAmount = 1
, _itMaxStack = 1
, _itAimingRange = 1
, _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1}
, _itEquipPict = pictureWeaponOnAim $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
}
{- |
Sends out pulses that display creatures. -}
sonar :: Item
sonar = defaultGun
{ _itName = "SONAR"
, _itIdentity = Generic
, _wpMaxAmmo = 100
, _wpLoadedAmmo = 100
, _wpReloadTime = 200
, _wpReloadState = 0
, _itUseRate = 120
, _itUseTime = 0
, _itUse = \_ -> shoot aSonarPulse
, _wpRange = 20
, _itHammer = HammerUp
, _itFloorPict = onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
, _itAmount = 1
, _itMaxStack = 1
, _itAimingRange = 1
, _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1}
, _itEquipPict = pictureWeaponOnAim $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
}
{- |
Automatically sends out pulses that display creatures. -}
autoSonar :: Item
autoSonar = defaultEquipment
{ _itIdentity = Generic
, _itName = "AUTOSONAR"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> blank
, _itEffect = autoSonarEffect
, _itID = Nothing
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1}
}
{- |
Automatically sends out pulses that display walls. -}
autoRadar :: Item
autoRadar = defaultEquipment
{ _itIdentity = Generic
, _itName = "AUTORADAR"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> blank
, _itEffect = autoRadarEffect
, _itID = Nothing
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1}
}
{- |
Creates a creature next to the creature using the item. -}
spawnGun :: Creature -> Item
spawnGun cr = defaultGun
{ _itName = "SPAWNER"
, _wpMaxAmmo = 1
, _wpLoadedAmmo = 1
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 100
, _itUse = \_ -> spawnCrNextTo cr
}
spawnCrNextTo
:: Creature -- ^ Creature to spawn
-> Creature -- ^ existing creature that will be spawned next to
-> World
-> World
spawnCrNextTo cr sCr w = w & creatures %~ IM.insert k newCr
where
k = IM.newKey $ _creatures w
newCr = cr
& crID .~ k
& crPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr)
& crOldPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr)