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

1261 lines
43 KiB
Haskell

{- |
Definitions of weapons.
In progress: move out effects into other modules.
-}
{-# LANGUAGE BangPatterns #-}
module Dodge.Item.Weapon
( 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.Item.Weapon.Bullet
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.Grenade
import Dodge.Item.Attachment.Data
import Dodge.Item.Attachment
import Geometry
import Picture
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.IntMap.Strict as IM
import qualified Data.Map as M
import Foreign.ForeignPtr
pistol,lasGun,tractorGun,launcher,autoGun
,teslaGun
,spreadGun
,multGun
-- ,shatterGun
,longGun,flamer,blinkGun,forceFieldGun :: Item
pistol = Weapon
{ _itName = "PISTOL"
, _itIdentity = Pistol
, _wpMaxAmmo = 15
, _wpLoadedAmmo = 15
, _wpReloadTime = 40
, _wpReloadState = 0
, _itUseRate = 8
, _itUseTime = 0
, _wpFire =
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 = drawWeapon $ 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 = pistol
defaultAutoGun = autoGun
{ _itScrollUp = const id
, _itScrollDown = const id
, _itInvDisplay = basicWeaponDisplay
}
effectGun :: String -> (Int -> World -> World) -> Item
effectGun name eff = defaultGun
{ _itName = name ++ "Gun"
, _wpFire = eff
}
autoEffectGun :: String -> (Int -> World -> World) -> Item
autoEffectGun name eff = defaultAutoGun
{ _itName = name ++ "Gun"
, _wpFire = eff
}
autoGun = defaultGun
{ _itName = "AUTOGUN"
, _itIdentity = AutoGun
, _wpMaxAmmo = 30
, _wpLoadedAmmo = 30
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 6
, _itUseTime = 0
, _wpFire = 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)]]
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.4
, _itAimingRange = 1
, _itZoom = defaultItZoom {_itAimZoomFac = 1.5}
, _itEquipPict = drawWeapon $ color red $ polygon $ rectNESW 4 4 (-4) (-4)
, _itEffect = wpRecock
, _itAttachment = Just $ ItCharMode $ Seq.fromList "MS"
, _itScrollUp = incCharMode
, _itScrollDown = decCharMode
, _itInvDisplay = basicWeaponDisplay
}
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 = defaultGun
{ _itName = "REANIMATOR"
, _wpMaxAmmo = 50
, _wpLoadedAmmo = 50
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _wpFire = 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)
]
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.4
, _itAimingRange = 0
, _itEquipPict = drawWeapon $ color chartreuse $ pictures
[polygon $ rectNESW 7 3 1 (-3)
,polygon $ rectNESW (-1) 3 (-7) (-3)
]
}
teslaGun = defaultAutoGun
{ _itName = "TESLA"
, _itIdentity = TeslaGun
, _wpMaxAmmo = 200
, _wpLoadedAmmo = 200
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _wpFire = 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)
]
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.4
, _itZoom = defaultItZoom
, _itAimingRange = 0
, _itEquipPict = drawWeapon $ color blue $ pictures
[polygon $ rectNESW 7 3 1 (-3)
,polygon $ rectNESW (-1) 3 (-7) (-3)
]
}
lasGun = defaultAutoGun
{ _itName = "LASGUN ////"
, _itIdentity = LasGun
, _wpMaxAmmo = 200
, _wpLoadedAmmo = 200
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _wpFire = shoot aLaser
, _wpSpread = 0.001
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color blue $ polygon $ rectNESW 3 3 (-3) (-3)
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.4
, _itAimingRange = 1
, _itEquipPict = drawWeapon $ color blue $ polygon $ rectNESW 3 3 (-3) (-3)
, _itAttachment = Just $ ItCharMode $ Seq.fromList "/VZ"
, _itScrollUp = incCharMode
, _itScrollDown = decCharMode
, _itInvDisplay = basicWeaponDisplay
}
forceFieldGun = defaultGun
{ _itName = "FORCEFIELD"
, _itIdentity = ForceFieldGun
, _wpMaxAmmo = 100
, _wpLoadedAmmo = 100
, _wpReloadTime = 40
, _wpReloadState = 0
, _itUseRate = 10
, _itUseTime = 0
, _wpFire = undefined
, _wpSpread = 0.02
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ polygon [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)]
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.4
, _itAimingRange = 0.5
}
-- grapGun = defaultGun
-- { _itName = "grapGun"
-- , _itIdentity = GrapGun
-- , _wpMaxAmmo = 1
-- , _wpLoadedAmmo = 1
-- , _wpReloadTime = 40
-- , _wpReloadState = 0
-- , _itUseRate = 10
-- , _itUseTime = 0
-- , _wpFire = 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 = defaultAutoGun
{ _itName = "TRACTORGUN"
, _itIdentity = TractorGun
, _wpMaxAmmo = 10000
, _wpLoadedAmmo = 10000
, _wpReloadTime = 40
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _wpFire = shoot $ aTractorBeam 0
, _wpSpread = 0.00001
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ]
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.4
, _itAimingRange = 0.5
, _itEquipPict = drawWeapon $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ]
}
launcher = defaultGun
{ _itName = "ROCKO"
, _itIdentity = Launcher
, _wpMaxAmmo = 30
, _wpLoadedAmmo = 30
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 20
, _itUseTime = 0
, _wpFire = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeExplosionAt
, _wpSpread = 0.02
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.2
, _itAimingRange = 0.5
, _itEquipPict = drawWeapon $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
, _itHammer = NoHammer
, _itEffect = NoItEffect
}
flameLauncher = launcher
{ _itName = "FLROCKO"
, _wpFire = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeFlameExplosionAt
}
poisonLauncher = launcher
{ _itName = "POISROCK"
, _wpFire = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makePoisonExplosionAt
}
teslaLauncher = launcher
{ _itName = "TESLROCK"
, _wpFire = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeTeslaExplosionAt
}
bezierGun = defaultAutoGun
{ _itName = "B-GUN"
, _wpFire = hammerCheck $ maybeSetTarget $ \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 = bezierRecock
, _itZoom = defaultItZoom
, _itAimingRange = 0
}
maybeSetTarget :: (Point2 -> Int -> World -> World) -> Int -> World -> World
maybeSetTarget f cid w = case join $ w ^? creatures . ix cid . crInv . ix itRef . itAttachment of
Just (ItTargetPos targetp)
-> f targetp cid w
_ -> w & creatures . ix cid . crInv . ix itRef . itAttachment ?~ ItTargetPos mp
where
mp = mouseWorldPos w
cr = _creatures w IM.! cid
itRef = _crInvSel cr
shootBezier :: Point2 -> Int -> World -> World
shootBezier targetp cid w = over particles (theBullet :) w
where
theBullet = aCurveBulAt
(Just cid)
white
startp
(controlp +.+ randPos)
(targetp +.+ randPos')
(destroyOnImpact bulHitCr' bulHitWall' bulHitFF')
5
controlp = mouseWorldPos w
cr = _creatures w IM.! cid
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 = defaultGun
{ _itName = "ROCKO-REM"
, _itIdentity = RemoteLauncher
, _wpMaxAmmo = 1
, _wpLoadedAmmo = 1
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 10
, _itUseTime = 0
, _wpFire = hammerCheck fireRemoteLauncher
, _wpSpread = 0.02
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.2
, _itAimingRange = 0.5
, _itEquipPict = drawWeapon $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
, _itAttachment = Just $ ItScope (0,0) 0 1 True
}
hvAutoGun = defaultAutoGun
{ _itName = "AUTO-HV"
, _itIdentity = HvAutoGun
, _wpMaxAmmo = 100
, _wpLoadedAmmo = 100
, _wpReloadTime = 200
, _wpReloadState = 0
, _itUseRate = 25
, _itUseTime = 0
, _wpFire = rateIncAB 24 10 (torqueBeforeForced 0.1 mkHvBul) $ torqueAfter 0.2 mkHvBul
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color orange $ polygon $ rectNESW 5 5 (-5) (-5)
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.2
, _itAimingRange = 1
, _itEquipPict = drawWeapon $ color orange $ polygon $ rectNESW 5 5 (-5) (-5)
}
where
mkHvBul = withSound (fromIntegral longGunSound)
. withThinSmoke
. withMuzFlare
. withVelWthHiteff (80,0) 6
$ penWalls hvBulHitCr' hvBulHitWall' bulHitFF'
ltAutoGun = defaultAutoGun
{ _itName = "AUTO-LT"
, _itIdentity = LtAutoGun
, _wpMaxAmmo = 25
, _wpLoadedAmmo = 25
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 4
, _itUseTime = 0
, _wpFire = 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
]
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itZoom = defaultItZoom
, _itEquipPict = drawWeapon $ color green $ pictures [polygon $ rectNSWE 4 (-4) (-4) 0
,circleSolid 4
]
}
miniGun = defaultAutoGun
{ _itName = "MINI-G"
, _itIdentity = MiniGun
, _wpMaxAmmo = 150
, _wpLoadedAmmo = 150
, _wpReloadTime = 200
, _wpReloadState = 0
, _itUseRate = 2
, _itUseTime = 0
, _wpFire = 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)
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.4
, _itAimingRange = 1
, _itEquipPict = drawWeapon $ color red $ polygon $ rectNESW 9 5 (-9) (-5)
}
spreadGun = defaultGun
{ _itName = "SPREAD"
, _itIdentity = SpreadGun
, _wpMaxAmmo = 5
, _wpLoadedAmmo = 5
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 20
, _itUseTime = 0
, _wpFire = 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)] ]
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itEquipPict = drawWeapon $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)] ]
}
multGun = defaultGun
{ _itName = "MULTGUN"
, _itIdentity = MultGun
, _wpMaxAmmo = 2
, _wpLoadedAmmo = 2
, _wpReloadTime = 40
, _wpReloadState = 0
, _itUseRate = 20
, _itUseTime = 0
, _wpFire = shootWithSound (fromIntegral shotgunSound)
. withRecoil 200
. withMuzFlare
$ numVelWthHitEff 5 (50,0) 5 basicBulletEffect
, _wpSpread = spreadGunSpread
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer multGunPic
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.4
, _itAimingRange = 1
, _itZoom = defaultItZoom {_itAimZoomFac = 1.5}
, _itEquipPict = drawWeapon 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 = defaultGun
{ _itName = "LONGGUN"
, _itIdentity = LongGun
, _wpMaxAmmo = 1
, _wpLoadedAmmo = 1
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 100
, _itUseTime = 0
, _wpFire = 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) ]
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.2
, _itAimingRange = 1
, _itZoom = defaultItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5}
, _itEquipPict = drawWeapon $ 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 = defaultAutoGun
{ _itName = "POISON"
, _itIdentity = PoisonSprayer
, _wpMaxAmmo = 500
, _wpLoadedAmmo = 500
, _wpReloadTime = 100
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _wpFire = shoot aGasCloud
, _wpSpread = 0.3
, _wpRange = 8
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.2
, _itAimingRange = 0
, _itZoom = defaultItZoom
, _itEquipPict = drawWeapon $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
}
flamer = defaultAutoGun
{ _itName = "FLAMER"
, _itIdentity = Flamethrower
, _wpMaxAmmo = 250
, _wpLoadedAmmo = 250
, _wpReloadTime = 100
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _wpFire = shoot $ withSidePush 5 $ withSidePushAfter 10 $ randWalkAngle 0.5 0.05 aFlame
, _wpSpread = 0
, _wpRange = 8
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.5
, _itAimingRange = 0
, _itZoom = defaultItZoom {_itAimZoomMax = 5, _itAimZoomMin = 1.5}
, _itEquipPict = drawWeapon $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
, _itAttachment = Nothing
}
blinkGun = defaultGun
{ _itName = "BLINKER"
, _itIdentity = Blinker
, _wpMaxAmmo = 100
, _wpLoadedAmmo = 100
, _wpReloadTime = 20
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _wpFire = shoot aSelf
, _wpSpread = 0.05
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ polygon [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 1
, _itAimingRange = 0
}
aTeslaArc :: Int -> World -> World
aTeslaArc cid w = aTeslaArc' cid
$ soundFrom (CrWeaponSound cid) 25 1 0 w
aTeslaArc' :: Int -> World -> World
aTeslaArc' cid w
= teslaGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir)
$ over projectiles (IM.insert i (makeTeslaArcAt i pos dir))
$ set randGen g w
where
cr = _creatures w IM.! cid
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
-> Int -- ^ Creature id
-> World
-> World
aRocketWithPayload pl cid w = over projectiles (IM.insert i theShell) w
where
i = newProjectileKey w
cr = _creatures w IM.! cid
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)
, _pjPict = 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 . pjPict .~ 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 . pjPict .~ pic
& projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid spin accel
| time >= 20 = w
& projectiles . ix i . pjPos %~ (+.+ vel)
& projectiles . ix i . pjPict .~ 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 . pjPict .~ 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 . pjPict .~ 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
normalizeAnglePi angle
| normalizeAngle angle > pi = normalizeAngle angle - 2*pi
| otherwise = normalizeAngle angle
shellPic = color black $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
remoteShellPic :: Int -> Picture
remoteShellPic i
| rem (i+200) 20 < 9 = polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
| otherwise = pictures
[ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
, color col $ circleSolid 3
]
where
col | i > (-99) = green
| otherwise = red
shellExplosionAt = makeExplosionAt
aGasCloud :: Int -> World -> World
aGasCloud cid w = insertCloud $ set randGen g w
where
(a,g) = randomR (-0.1,0.1) (_randGen w)
cr = _creatures w IM.! cid
dir = _crDir cr + a
pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
pos2 = (0.5 *.* vel) +.+
_crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
vel = (_crPos cr -.- _crOldPos cr) +.+ 10 *.* unitVectorAtAngle dir
insertCloud = makeGasCloud pos vel -- . makeFlame pos2 vel (Just cid)
aFlame :: Int -> World -> World
aFlame cid w = insertFlame w
where
(t,_) = randomR (99,101) (_randGen w)
cr = _creatures w IM.! cid
dir = _crDir cr
pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir
insertFlame = makeFlame t pos vel (Just cid) -- . makeFlame pos2 vel (Just cid)
aSelf :: Int -> World -> World
aSelf = blinkAction
reflect :: Float -> Float -> Float
reflect a b = a + 2*(a-b)
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) . wpFire) (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) . twFire) (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.pjPict)
(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,remoteBomb :: 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
, _twFire = useTimeCheck $ throwGrenade makeExplosionAt
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itZoom = defaultItZoom {_itAimZoomMax = f fuseTime, _itAimZoomMin = f fuseTime}
, _itEquipPict = drawWeapon $ 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
, _twFire = throwGrenade makeFlameExplosionAt
}
where
fuseTime = 50
f x = 50 / fromIntegral x
teslaGrenade :: Item
teslaGrenade = grenade {
_itName = "TLSGREN " ++ show fuseTime
, _twFire = throwGrenade makeTeslaExplosionAt
}
where
fuseTime = 50
f x = 50 / fromIntegral x
defaultThrowable = grenade
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
, _twFire = hammerCheck throwRemoteBomb
, _itAttachment = Just $ ItScope (0,0) 0 1 True
, _itEquipPict = drawWeapon remoteBombUnarmedPic
}
fireRemoteLauncher :: Int -> World -> World
fireRemoteLauncher cid w = setLocation
$ resetFire
$ resetName
$ soundOnce (fromIntegral launcherSound)
$ over projectiles remRocket w
where
i = newKey $ _projectiles w
cr = _creatures w IM.! cid
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)
, _pjPict = blank
, _pjID = i
, _pjUpdate = moveRemoteShell 50 i cid itid dir
}
j = _crInvSel $ _creatures w IM.! cid
newitid = newKey $ _itemPositions w
maybeitid = w ^? creatures . ix cid . crInv . ix j . itID . _Just
resetFire = set (creatures . ix cid . crInv . ix j . wpFire)
$ 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 dir w
| time > 40 = if circOnSomeWall oldPos 4 w
then doExplosion w
else over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . pjPict) piclow
$ set (projectiles . ix i . pjUpdate)
(moveRemoteShell (time-1) i cid itid newdir)
$ setScope
w
| time >= 20 = case thingHit of
Just p -> doExplosion w
Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . pjPict) pic
$ set (projectiles . ix i . pjUpdate)
(moveRemoteShell (time-1) i cid itid newdir)
$ setScope
w
| time > -99 = case thingHit of
Just p -> doExplosion
$ stopSoundFrom (ShellSound i)
w
Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set randGen g
$ set (projectiles . ix i . pjPict) 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 p -> doExplosion
$ stopSoundFrom (ShellSound i)
w
Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . pjPict) 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 = onLayer PtLayer $ 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 cid
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
-> Int
-> World
-> World
explodeRemoteRocket itid pjid n w
= set (projectiles . ix pjid . pjUpdate) (retireRemoteRocket itid 30 pjid)
$ set (projectiles . ix pjid . pjPict) blank
$ set (itPoint . wpFire) (const id)
$ resetName
$ makeExplosionAt (_pjPos (_projectiles w IM.! pjid)) w
where
resetName = set (itPoint . itName) "REMOTELAUNCHER"
itPoint = pointToItem $ _itemPositions w IM.! itid
throwRemoteBomb :: Int -> World -> World
throwRemoteBomb n w = setLocation $ removePict $ resetFire
$ resetName $ over projectiles addG w
where
addG = IM.insert i $ Projectile
{ _pjPos = p
, _pjStartPos = p
, _pjVel = v
, _pjPict = blank
, _pjID = i
, _pjUpdate = moveRemoteBomb itid 50 i
}
i = newProjectileKey w
-- fireDist = zoom *.* (rotateV (_cameraRot w) (_mousePos w) +.+ _cameraCenter w -.- yourPos)
d = argV $ _mousePos w
--(l, _) = randomR (1 - grenadeAccL,1+grenadeAccL) (_randGen w)
--(a, g) = randomR (-grenadeAccA,grenadeAccA) (_randGen w)
v' = 0.02 / _cameraZoom w *.* rotateV (_cameraRot w) ( _mousePos w)
v | magV v' > 6 = 6 *.* normalizeV v'
| otherwise = v'
-- zoom = 1 / _cameraZoom w
j = _crInvSel $ _creatures w IM.! n
resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTE"
removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank
resetFire = set (creatures . ix n . crInv . ix j . twFire)
$ hammerCheck $ explodeRemoteBomb itid i
cr = _creatures w IM.! n
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 n . crInv . ix j . itID . _Just
setLocation :: World -> World
setLocation w' = case maybeitid of
Nothing -> w' & creatures . ix n . crInv . ix j . itID ?~ newitid
& itemPositions %~ IM.insert newitid (InInv n j)
_ -> w'
newitid = newKey $ _itemPositions w
itid = fromMaybe newitid maybeitid
explodeRemoteBomb :: Int -> Int -> Int -> World -> World
explodeRemoteBomb itid pjid n w
= set (projectiles . ix pjid . pjUpdate) (retireRemoteBomb itid 30 pjid)
$ set (projectiles . ix pjid . pjPict) blank
$ set (creatures . ix n . crInv . ix j . twFire) (const id)
$ resetName
$ resetPict
-- $ resetScope
$ makeExplosionAt (_pjPos (_projectiles w IM.! pjid)) w
-- - $ makeShrapnelBombAt (_pjPos (_projectiles w IM.! pjid)) w
where
resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTEBOMB"
resetPict = set (creatures . ix n . crInv . ix j . itEquipPict )
(drawWeapon remoteBombUnarmedPic)
-- resetScope = creatures . ix n . crInv . ix j . itScope . _Just . scopePos .~ (0,0)
j = _crInvSel $ _creatures w IM.! n
remoteBombPic :: Int -> Picture
remoteBombPic x = 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 = Craftable
{ _itIdentity = Generic
, _itName = "PIPE"
, _itMaxStack = 3
, _itAmount = 3
, _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \cr _ -> blank
, _itID = Nothing
, _itInvDisplay = _itName
, _itInvColor = green
}
magShield = defaultEquipment
{ _itIdentity = MagShield
, _itName = "MAGSHIELD"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \cr _ -> blank
, _itID = Nothing
}
flameShield = defaultEquipment
{ _itIdentity = FlameShield
, _itName = "FLAMESHIELD"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \cr _ -> onLayer CrLayer $ pictures [color cyan $ circle (_crRad cr+2)]
, _itID = Nothing
}
{- |
Slows you down, blocks forward projectiles. -}
frontArmour = defaultEquipment
{ _itIdentity = FrontArmour
, _itName = "FARMOUR"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ translate 0 (-5) $ pictures
[color (greyN 0.1) $ thickArc 0 (pi/2) 10 5
,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5
]
, _itEquipPict = \cr _ -> onLayer CrLayer $ pictures
[color (greyN 0.1) $ thickArc 0 (pi/2) 10 5
,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5
]
, _itEffect = NoItEffect
, _itID = Nothing
}
{- |
Increases speed, reduces friction, cannot only move forwards. -}
jetPack = defaultEquipment
{ _itIdentity = JetPack
, _itName = "JETPACK"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> onLayer CrLayer
$ pictures [color yellow $ polygon $ rectNSEW 5 (-5) (-3) (-11) ]
, _itEffect = NoItEffect
, _itID = Nothing
}
{- |
Sends out pulses that display walls. -}
radar = defaultGun
{ _itName = "RADAR"
, _itIdentity = Generic
, _wpMaxAmmo = 100
, _wpLoadedAmmo = 100
, _wpReloadTime = 200
, _wpReloadState = 0
, _itUseRate = 120
, _itUseTime = 0
, _wpFire = 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 = drawWeapon $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
}
{- |
Sends out pulses that display creatures. -}
sonar = defaultGun
{ _itName = "SONAR"
, _itIdentity = Generic
, _wpMaxAmmo = 100
, _wpLoadedAmmo = 100
, _wpReloadTime = 200
, _wpReloadState = 0
, _itUseRate = 120
, _itUseTime = 0
, _wpFire = 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 = drawWeapon $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
}
{- |
Automatically sends out pulses that display creatures. -}
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 = \cr _ -> blank
, _itEffect = autoSonarEffect
, _itID = Nothing
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1}
}
{- |
Automatically sends out pulses that display walls. -}
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 = \cr _ -> 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
, _wpFire = spawnCrNextTo cr
}
spawnCrNextTo
:: Creature -- ^ Creature to spawn
-> Int -- ^ ID of existing creature that will be spawned next to
-> World
-> World
spawnCrNextTo cr i w = w & creatures %~ IM.insert k newCr
where
k = newKey $ _creatures w
sCr = _creatures w IM.! i
newCr = cr
& crID .~ k
& crPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr)
& crOldPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr)