1207 lines
41 KiB
Haskell
1207 lines
41 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.Item.Draw
|
|
import Dodge.Particle.Bullet.HitEffect
|
|
import Dodge.Particle.Bullet.Spawn
|
|
--import Dodge.Item.Weapon.Decoration
|
|
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.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
|
|
, _wpReloadTime = 40
|
|
, _wpReloadState = 0
|
|
, _itUseRate = 8
|
|
, _itUseTime = 0
|
|
, _itUse =
|
|
hammerCheck
|
|
. shootWithSound 0
|
|
. withRandomDir 0.1
|
|
. withMuzFlare
|
|
. withVelWthHiteff (30,0) 2
|
|
$ destroyOnImpact bulHitCr bulHitWall' bulHitFF'
|
|
, _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
|
|
}
|
|
defaultGun :: Item
|
|
defaultGun = pistol
|
|
defaultAutoGun :: Item
|
|
defaultAutoGun = autoGun
|
|
{ _itScrollUp = const id
|
|
, _itScrollDown = const id
|
|
, _itInvDisplay = basicWeaponDisplay
|
|
}
|
|
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 = defaultAutoGun
|
|
{ _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 ]
|
|
}
|
|
launcher :: Item
|
|
launcher = defaultGun
|
|
{ _itName = "ROCKO"
|
|
, _itIdentity = Launcher
|
|
, _wpMaxAmmo = 30
|
|
, _wpLoadedAmmo = 30
|
|
, _wpReloadTime = 80
|
|
, _wpReloadState = 0
|
|
, _itUseRate = 20
|
|
, _itUseTime = 0
|
|
, _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeExplosionAt
|
|
, _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)
|
|
, _itHammer = NoHammer
|
|
, _itEffect = NoItEffect
|
|
}
|
|
flameLauncher :: Item
|
|
flameLauncher = launcher
|
|
{ _itName = "FLROCKO"
|
|
, _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeFlameExplosionAt
|
|
}
|
|
|
|
poisonLauncher :: Item
|
|
poisonLauncher = launcher
|
|
{ _itName = "POISROCK"
|
|
, _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makePoisonExplosionAt
|
|
}
|
|
|
|
teslaLauncher :: Item
|
|
teslaLauncher = launcher
|
|
{ _itName = "TESLROCK"
|
|
, _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeTeslaExplosionAt
|
|
}
|
|
|
|
useTargetPos
|
|
:: (Point2 -> Creature -> World -> World)
|
|
-> Creature
|
|
-> World
|
|
-> World
|
|
useTargetPos f cr w = case cr ^? crInv . ix (_crInvSel cr) . itAttachment . _Just . itTargetPos of
|
|
Nothing -> w
|
|
Just p -> f p cr w
|
|
|
|
bezierGun :: Item
|
|
bezierGun = defaultAutoGun
|
|
{ _itName = "B-GUN"
|
|
, _itUse = useTargetPos $ \p ->
|
|
shootWithSound 0
|
|
. withMuzFlare
|
|
. withRecoil 40
|
|
. torqueBefore 0.05 -- I believe that this doesn't affect
|
|
$ shootBezier p -- <- the start point
|
|
, _itAttachment = Nothing
|
|
, _itScrollUp = removeItAttachment 0
|
|
, _itScrollDown = removeItAttachment 0
|
|
, _itHammer = HammerUp
|
|
, _itEffect = bezierTargetEffect
|
|
, _itZoom = defaultItZoom
|
|
, _itAimingRange = 0
|
|
}
|
|
|
|
shootBezier :: Point2 -> Creature -> World -> World
|
|
shootBezier targetp cr w = w & particles %~ (theBullet :)
|
|
where
|
|
theBullet = aCurveBulAt
|
|
(Just cid)
|
|
white
|
|
startp
|
|
(controlp +.+ randPos)
|
|
(targetp +.+ randPos')
|
|
(destroyOnImpact bulHitCr bulHitWall' bulHitFF')
|
|
5
|
|
controlp = mouseWorldPos w
|
|
cid = _crID cr
|
|
dir = _crDir cr
|
|
startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0)
|
|
(randPos,randPos') = flip evalState (_randGen w) $ do
|
|
a <- randInCirc 10
|
|
b <- randInCirc 20
|
|
return (a,b)
|
|
|
|
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
|
|
, _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
|
|
, _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
|
|
|
|
aRocketWithPayload
|
|
:: (Point2 -> World -> World) -- ^ Payload
|
|
-> Creature
|
|
-> World
|
|
-> World
|
|
aRocketWithPayload pl cr w = over projectiles (IM.insert i theShell) w
|
|
where
|
|
cid = _crID cr
|
|
i = newProjectileKey w
|
|
pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
|
|
dir = _crDir cr
|
|
theShell = makeShellAt pl i cid pos dir
|
|
|
|
makeShellAt
|
|
:: (Point2 -> World -> World)
|
|
-- ^ Payload
|
|
-> Int -- ^ Projectile id
|
|
-> Int -- ^ Creature id
|
|
-> Point2 -- ^ Start position
|
|
-> Float -- ^ Direction
|
|
-> Projectile
|
|
makeShellAt pl i cid pos dir = Shell
|
|
{ _pjPos = pos
|
|
, _pjStartPos = pos
|
|
, _pjVel = rotateV dir (1,0)
|
|
, _pjDraw = \_ -> blank
|
|
, _pjID = i
|
|
, _pjUpdate = \_ -> moveShell 50 i cid 0 (rotateV dir (3,0))
|
|
, _pjPayload = pl
|
|
}
|
|
|
|
moveShell
|
|
:: Int -- ^ Timer (frames)
|
|
-> Int -- ^ Projectile id
|
|
-> Int -- ^ Creature id
|
|
-> Float -- ^ Rotation
|
|
-> Point2 -- ^ Acceleration
|
|
-> World -> World
|
|
moveShell time i cid rot accel w
|
|
| time > 40 = if circOnSomeWall oldPos 4 w
|
|
then doExplode
|
|
else w
|
|
& projectiles . ix i . pjPos %~ (+.+ vel)
|
|
& projectiles . ix i . pjDraw .~ (\_ -> piclow)
|
|
& projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot (rotateV rot accel))
|
|
| isJust thingHit = doExplode
|
|
| time == 35 = w
|
|
& projectiles . ix i . pjPos %~ (+.+ vel)
|
|
& projectiles . ix i . pjDraw .~ (\_ -> pic)
|
|
& projectiles . ix i . pjUpdate .~ \_ -> moveShell (time-1) i cid spin accel
|
|
| time >= 20 = w
|
|
& projectiles . ix i . pjPos %~ (+.+ vel)
|
|
& projectiles . ix i . pjDraw .~ (\_ -> pic)
|
|
& projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel))
|
|
| time > -99 = w
|
|
& projectiles . ix i . pjPos %~ (+.+ vel)
|
|
& randGen .~ g
|
|
& projectiles . ix i . pjDraw .~ (\_ -> pic)
|
|
& projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel))
|
|
& projectiles . ix i . pjVel %~ (\v -> accel +.+ frict *.* v)
|
|
& soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250
|
|
& makeFlameletTimed (oldPos -.- vel) (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10
|
|
& smokeGen
|
|
| time > -200 = w
|
|
& projectiles . ix i . pjPos %~ (+.+ vel)
|
|
& projectiles . ix i . pjDraw .~ (\_ -> pic)
|
|
& projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel))
|
|
| otherwise = doExplode
|
|
where
|
|
doExplode = w
|
|
& projectileExplosion oldPos
|
|
& stopSoundFrom (ShellSound i)
|
|
& projectiles %~ IM.delete i
|
|
pj = _projectiles w IM.! i
|
|
oldPos = _pjPos pj
|
|
vel = _pjVel pj
|
|
projectileExplosion = _pjPayload pj
|
|
newPos = oldPos +.+ vel
|
|
(frict,g) = randomR (0.6,0.9) $ _randGen w
|
|
(sparkD,_) = randomR (-0.2,0.2) $ _randGen w
|
|
dir = argV vel
|
|
pic = onLayer PtLayer $ uncurry translate newPos $ rotate (argV accel) shellPic
|
|
piclow = onLayerL [levLayer CrLayer - 2]
|
|
$ uncurry translate newPos $ rotate (argV accel) shellPic
|
|
hitCr = fst <$> collideCircCrsPoint oldPos newPos 4 w
|
|
hitWl = fst <$> collideCircWalls' oldPos newPos 2 (wallsNearPoint newPos w)
|
|
thingHit = hitCr <|> hitWl
|
|
spin = case w ^? creatures . ix cid of
|
|
Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / 20
|
|
_ -> 0
|
|
r1 = randInCirc 10 & evalState $ _randGen w
|
|
smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos))
|
|
rot' = rot * 0.995
|
|
|
|
shellPic :: Picture
|
|
shellPic = color black $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
|
|
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
|
|
|
|
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 =
|
|
set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) (0,0)
|
|
$ set (pointToItem (_itemPositions w IM.! itid) . itZoom) defaultItZoom
|
|
$ set (pointToItem (_itemPositions w IM.! itid) . itUse) (hammerCheck throwRemoteBomb)
|
|
(w & 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) (const 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)
|
|
|