397 lines
13 KiB
Haskell
397 lines
13 KiB
Haskell
{- | Definitions of weapons.
|
|
In progress: move out effects into other modules. -}
|
|
module Dodge.Item.Weapon
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Data.SoundOrigin
|
|
import Dodge.Base
|
|
import Dodge.Zone
|
|
import Dodge.Picture.Layer
|
|
import Dodge.SoundLogic
|
|
import Dodge.SoundLogic.LoadSound
|
|
import Dodge.Creature.Action
|
|
import Dodge.WorldEvent
|
|
import Dodge.Default
|
|
import Dodge.Item.Draw
|
|
import Dodge.Item.Data
|
|
import Dodge.Item.Weapon.BulletGuns
|
|
import Dodge.Item.Weapon.TriggerType
|
|
import Dodge.Item.Weapon.ExtraEffect
|
|
import Dodge.Item.Weapon.UseEffect
|
|
import Dodge.Item.Weapon.Remote
|
|
import Dodge.Item.Attachment.Data
|
|
import Dodge.Default.Weapon
|
|
import Dodge.Item.Weapon.Grenade
|
|
import Geometry
|
|
import Picture
|
|
import qualified IntMapHelp as IM
|
|
import Shape
|
|
import ShapePicture
|
|
|
|
import Data.Maybe
|
|
import Data.Function
|
|
import Control.Lens
|
|
|
|
effectGun :: String -> (Creature -> World -> World) -> Item
|
|
effectGun name eff = defaultGun
|
|
{ _itName = name ++ "Gun"
|
|
, _itUse = const eff
|
|
}
|
|
autoEffectGun :: String -> (Creature -> World -> World) -> Item
|
|
autoEffectGun name eff = defaultAutoGun
|
|
{ _itName = name ++ "Gun"
|
|
, _itUse = const eff
|
|
}
|
|
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 = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-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
|
|
-- }
|
|
|
|
removeItAttachment :: Int -> Int -> World -> World
|
|
removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachment .~ NoItAttachment
|
|
where
|
|
cr = _creatures w IM.! i
|
|
itRef = _crInvSel cr
|
|
|
|
blinkGun :: Item
|
|
blinkGun = defaultGun
|
|
{ _itName = "BLINKER"
|
|
, _itIdentity = Blinker
|
|
, _wpMaxAmmo = 100
|
|
, _wpLoadedAmmo = 100
|
|
, _wpReloadTime = 20
|
|
, _wpReloadState = 0
|
|
, _itUseRate = 0
|
|
, _itUseTime = 0
|
|
, _itUse = const aSelf
|
|
, _itUseModifiers =
|
|
[ ammoCheckI
|
|
, hammerCheckI
|
|
]
|
|
, _itLeftClickUse = Just $ hammerCheckL $ shootL aSelfL
|
|
, _wpSpread = 0.05
|
|
, _wpRange = 20
|
|
, _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2[(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
|
|
, _itAimingSpeed = 1
|
|
, _itAimingRange = 0
|
|
}
|
|
|
|
|
|
shellExplosionAt :: Point2 -> World -> World
|
|
shellExplosionAt = makeExplosionAt
|
|
|
|
|
|
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)
|
|
|
|
retireRemoteBomb :: Int -> Int -> Int -> World -> World
|
|
retireRemoteBomb itid 0 pjid w = w
|
|
& pointToItem (_itemPositions w IM.! itid) %~
|
|
( (itAttachment . scopePos .~ V2 0 0)
|
|
. (itZoom .~ defaultItZoom)
|
|
. (itUse .~ const throwRemoteBomb)
|
|
)
|
|
& props %~ IM.delete pjid
|
|
retireRemoteBomb itid t pjid w = setScope w
|
|
& props . 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
|
|
. scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
|
|
_ -> w'
|
|
pos = fromMaybe (V2 0 0) $ w ^? props . ix pjid . pjPos
|
|
|
|
moveRemoteBomb :: Int -> Int -> Int -> World -> World
|
|
moveRemoteBomb itid time pID w
|
|
| time < -4 = updatePicture
|
|
$ set (props .ix pID.pjUpdate) (\_ -> moveRemoteBomb itid (f time) pID)
|
|
w
|
|
| time < 2 = case hitWl of
|
|
Just (p,_) -> soundStart (Tap 0) p tapQuietS Nothing $ halfV updatedWorld
|
|
_ -> halfV updatedWorld
|
|
| otherwise = case hitWl of
|
|
Just (p,_) -> soundStart (Tap 0) p tapQuietS Nothing updatedWorld
|
|
_ -> updatedWorld
|
|
where
|
|
updatedWorld
|
|
= updateV $ set (props . ix pID . pjPos) finalPos
|
|
$ updatePicture
|
|
$ set (props .ix pID.pjUpdate) (\_ -> moveRemoteBomb itid (time-1) pID)
|
|
w
|
|
pj = _props 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 (props . ix pID . pjVel) v
|
|
updateV = maybe id (setV . snd) hitWl
|
|
halfV = props . ix pID . pjVel %~ (0.5 *.*)
|
|
f x | x < -369 = -10
|
|
| otherwise = x - 1
|
|
updatePicture =
|
|
set (props . ix pID . prDraw)
|
|
(\_ -> (,) mempty $ onLayer PtLayer $ uncurryV translate newPos $ remoteBombPic time)
|
|
|
|
|
|
setRemoteBombScope :: Int -> Prop -> World -> World
|
|
setRemoteBombScope itid pj w' = case _itemPositions w' IM.! itid of
|
|
InInv cid invid
|
|
-> w' & creatures . ix cid . crInv . ix invid . itAttachment
|
|
. scopePos .~ (_pjPos pj -.- _crPos (_creatures w' IM.! cid))
|
|
& creatures . ix cid . crInv . ix invid . itAimZoom
|
|
.~ (defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5})
|
|
_ -> w'
|
|
|
|
defaultThrowable :: Item
|
|
defaultThrowable = grenade
|
|
remoteBomb :: Item
|
|
remoteBomb = defaultThrowable
|
|
{ _itName = "REMOTEBOMB"
|
|
, _itIdentity = RemoteBomb
|
|
, _itMaxStack = 1
|
|
, _itAmount = 1
|
|
, _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2
|
|
[(-3,-3),(-3,3),(3,3),(3,-3)]
|
|
, _twMaxRange = 150
|
|
, _twAccuracy = 30
|
|
, _itUse = const throwRemoteBomb
|
|
, _itUseModifiers =
|
|
[ hammerCheckI
|
|
]
|
|
, _itAttachment = ItScope (V2 0 0) 0 1 True
|
|
, _itEquipPict = pictureWeaponOnAim $ \_ -> (,) emptySH remoteBombUnarmedPic
|
|
}
|
|
|
|
|
|
throwRemoteBomb :: Creature -> World -> World
|
|
throwRemoteBomb cr w = setLocation
|
|
$ removePict
|
|
$ resetFire
|
|
$ resetName
|
|
$ over props addG w
|
|
where
|
|
cid = _crID cr
|
|
addG = IM.insert i $ Projectile
|
|
{ _pjPos = p
|
|
, _pjStartPos = p
|
|
, _pjVel = v
|
|
, _prDraw = const mempty
|
|
, _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) $ \ _ _ -> emptyBlank
|
|
resetFire = set (creatures . ix cid . crInv . ix j . itUse)
|
|
$ \_ -> explodeRemoteBomb itid i
|
|
p' = _crPos cr +.+ rotateV (_crDir cr) (V2 (_crRad cr) 0)
|
|
p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (V2 (_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 (props . ix pjid . pjUpdate) (\_ -> retireRemoteBomb itid 30 pjid)
|
|
-- $ set (props . ix pjid . pjDraw) (\_ -> blank)
|
|
$ set (creatures . ix cid . crInv . ix j . itUse) (\_ -> const id)
|
|
$ resetName
|
|
$ resetPict
|
|
-- $ resetScope
|
|
$ makeExplosionAt (_pjPos (_props w IM.! pjid)) w
|
|
-- - $ makeShrapnelBombAt (_pjPos (_props 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 $ \_ -> (,) emptySH 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
|
|
|
|
pipe :: Item
|
|
pipe = Craftable
|
|
{ _itIdentity = Generic
|
|
, _itName = "PIPE"
|
|
, _itMaxStack = 3
|
|
, _itAmount = 3
|
|
, _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
|
|
, _itEquipPict = \_ _ -> emptyBlank
|
|
, _itID = Nothing
|
|
, _itInvDisplay = _itName
|
|
, _itInvColor = green
|
|
, _itAimStance = LeaveHolstered
|
|
}
|
|
{- |
|
|
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 = const aRadarPulse
|
|
, _itUseModifiers =
|
|
[ ammoUseCheckI
|
|
]
|
|
, _wpSpread = autogunSpread
|
|
, _wpRange = 20
|
|
, _itHammer = HammerUp
|
|
, _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
|
|
, _itAimingRange = 1
|
|
, _itZoom = defaultItZoom { _itZoomMax = 1}
|
|
, _itAimZoom = defaultItZoom { _itZoomMax = 1}
|
|
, _itEquipPict = pictureWeaponOnAim $ \_ -> (,) emptySH $ 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 = const aSonarPulse
|
|
, _itUseModifiers =
|
|
[ ammoUseCheckI
|
|
]
|
|
, _wpRange = 20
|
|
, _itHammer = HammerUp
|
|
, _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
|
|
, _itAimingRange = 1
|
|
, _itZoom = defaultItZoom {_itZoomMax = 1}
|
|
, _itAimZoom = defaultItZoom {_itZoomMax = 1}
|
|
, _itEquipPict = pictureWeaponOnAim $ \_ -> (,) emptySH $ 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 = \_ -> (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
|
|
, _itEquipPict = \_ _ -> (,) emptySH blank
|
|
, _itEffect = autoSonarEffect
|
|
, _itID = Nothing
|
|
, _itAimingSpeed = 1
|
|
, _itAimingRange = 0
|
|
, _itZoom = defaultItZoom {_itZoomMax = 1}
|
|
, _itAimZoom = defaultItZoom {_itZoomMax = 1}
|
|
}
|
|
{- |
|
|
Automatically sends out pulses that display walls. -}
|
|
autoRadar :: Item
|
|
autoRadar = defaultEquipment
|
|
{ _itIdentity = Generic
|
|
, _itName = "AUTORADAR"
|
|
, _itMaxStack = 1
|
|
, _itAmount = 1
|
|
, _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
|
|
, _itEquipPict = \_ _ -> (,) emptySH blank
|
|
, _itEffect = autoRadarEffect
|
|
, _itID = Nothing
|
|
, _itAimingSpeed = 1
|
|
, _itAimingRange = 0
|
|
, _itZoom = defaultItZoom {_itZoomMax = 1}
|
|
, _itAimZoom = defaultItZoom {_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
|
|
, _itUseModifiers =
|
|
[ ammoCheckI
|
|
, hammerCheckI
|
|
]
|
|
}
|
|
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)
|
|
|