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

1171 lines
37 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.RandomHelp
import Dodge.WorldEvent
import Dodge.Default
--import Dodge.Default.Shell
import Dodge.Item.Draw
--import Dodge.Particle.Bullet.HitEffect
import Dodge.Item.Data
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.Shell
import Dodge.Item.Weapon.Bullet
import Dodge.Item.Weapon.AmmoParams
import Dodge.Item.Attachment.Data
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 Geometry.Vector3D
import Picture
import qualified IntMapHelp as IM
import Shape
import ShapePicture
--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 = defaultGun
{ _itName = "PISTOL"
, _itIdentity = Pistol
, _wpMaxAmmo = 15
, _wpLoadedAmmo = 15
, _wpReloadTime = 40
, _wpReloadState = 0
, _itUseRate = 8
, _itUseTime = 0
, _itUse = useAmmoParams
, _itUseModifiers =
[ ammoCheckI
, hammerCheckI
, useTimeCheckI
, withSoundStart tap3S
, useAmmo 1
, randSpreadDir
, withMuzFlareI
]
, _itLeftClickUse = Nothing
, _wpSpread = 0.02
, _wpRange = 20
, _itHammer = HammerUp
, _itFloorPict = (,) emptySH $ onLayer FlItLayer pistolPic
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itZoom = defaultItZoom
, _itEquipPict = pictureWeaponOnAim $ (,) emptySH pistolPic
, _itAttachment = NoItAttachment
, _itID = Nothing
, _itEffect = wpRecock
, _itInvDisplay = basicWeaponDisplay
, _itInvColor = white
, _itTargeting = Nothing
, _itWorldTrigger = Nothing
, _wpAmmo = basicBullet
}
pistolPic :: Picture
pistolPic = color green $ polygon $ rectNESW 5 5 (-5) (-5)
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
}
rezGun :: Item
rezGun = defaultGun
{ _itName = "REANIMATOR"
, _wpMaxAmmo = 50
, _wpLoadedAmmo = 50
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _itUse = const aTeslaArc
, _itUseModifiers =
[]
, _wpSpread = 0.001
, _wpRange = 20
, _itFloorPict = (,) emptySH $ onLayer FlItLayer $ color chartreuse $ pictures
[polygon $ rectNESW 7 3 1 (-3)
,polygon $ rectNESW (-1) 3 (-7) (-3)
]
, _itAimingSpeed = 0.4
, _itAimingRange = 0
, _itEquipPict = pictureWeaponOnAim $ (,) emptySH $ 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 = const aTeslaArc
, _itUseModifiers =
[ ammoCheckI
, useTimeCheckI
, withTempLight 1 100 (V3 0 0 1)
, withSoundForI elecCrackleS 1
, useAmmo 1
]
, _wpSpread = 0.001
, _wpRange = 20
, _itFloorPict = (,) emptySH $ onLayer FlItLayer teslaGunPic
, _itAimingSpeed = 0.4
, _itZoom = defaultItZoom
, _itAimingRange = 0
, _itEquipPict = pictureWeaponOnAim $ (,) emptySH teslaGunPic
}
teslaGunPic :: Picture
teslaGunPic = color blue $ pictures
[polygon $ rectNESW xb y xa (-y)
,polygon $ rectNESW (-xa) y (-xb) (-y)
]
where
xa = 1
xb = 9
y = 4
lasGun :: Item
lasGun = defaultAutoGun
{ _itName = "LASGUN ////"
, _itIdentity = LasGun
, _wpMaxAmmo = 200
, _wpLoadedAmmo = 200
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _itUse = const aLaser
, _itUseModifiers =
[ ammoCheckI
, useTimeCheckI
, withTempLight 1 100 (V3 1 1 0)
, withSoundForI tone440sawtoothS 1
, useAmmo 1
]
, _wpSpread = 0.001
, _wpRange = 20
, _itFloorPict = (,) emptySH $ onLayer FlItLayer lasGunPic
, _itAimingSpeed = 0.4
, _itAimingRange = 1
, _itEquipPict = pictureWeaponOnAim $ (,) emptySH lasGunPic
, _itAttachment = ItCharMode $ Seq.fromList "/VZ"
, _itScroll = scrollCharMode
, _itInvDisplay = basicWeaponDisplay
}
lasGunPic :: Picture
lasGunPic = color blue . polygon $ rectNESW 3 15 (-3) (-15)
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
-- }
tractorGun :: Item
tractorGun = defaultAutoGun
{ _itName = "TRACTORGUN"
, _itIdentity = TractorGun
, _wpMaxAmmo = 10000
, _wpLoadedAmmo = 10000
, _wpReloadTime = 40
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _itUse = \_ -> aTractorBeam 0
, _itUseModifiers =
[ ammoUseCheckI
]
, _wpSpread = 0.00001
, _wpRange = 20
, _itFloorPict = (,) emptySH $ onLayer FlItLayer $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ]
, _itAimingSpeed = 0.4
, _itAimingRange = 0.5
, _itEquipPict = pictureWeaponOnAim $ (,) emptySH $ 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 .~ NoItAttachment
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 = const fireRemoteLauncher
, _itUseModifiers =
[ ammoCheckI
, hammerCheckI
]
, _wpSpread = 0.02
, _wpRange = 20
, _itFloorPict = (,) emptySH $ onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
, _itAimingSpeed = 0.2
, _itAimingRange = 0.5
, _itEquipPict = pictureWeaponOnAim $ (,) emptySH $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
, _itAttachment = ItScope (V2 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 = useAmmoParams
, _itUseModifiers =
[ ammoCheckI
, rateIncABI 24 7 (torqueBeforeAtLeast 0.1 0.1) (torqueAfterI 0.2)
, withSoundStart bangEchoS
, withThinSmokeI
, withMuzFlareI
]
, _wpRange = 20
, _itFloorPict = (,) emptySH $ onLayer FlItLayer hvAutoGunPic
, _itAimingSpeed = 0.2
, _itAimingRange = 1
, _itEquipPict = pictureWeaponOnAim $ (,) emptySH hvAutoGunPic
, _wpAmmo = hvBullet
}
hvAutoGunPic :: Picture
hvAutoGunPic = color orange $ polygon $ rectNESW 5 12 (-5) (-12)
ltAutoGun :: Item
ltAutoGun = defaultAutoGun
{ _itName = "AUTO-LT"
, _itIdentity = LtAutoGun
, _wpMaxAmmo = 25
, _wpLoadedAmmo = 25
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 3
, _itUseTime = 0
, _itUse = useAmmoParams
, _itUseModifiers =
[ ammoCheckI
, useTimeCheckI
, withSoundStart tap1S
, useAmmo 1
, withRandomDirI 0.1
, torqueAfterI 0.2
, withSidePushI 50
, modClock 2 withMuzFlareI
]
, _wpSpread = 0.5
, _wpRange = 20
, _itFloorPict = (,) emptySH $ onLayer FlItLayer ltAutoGunPic
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itZoom = defaultItZoom
, _itEquipPict = pictureWeaponOnAim $ (,) emptySH ltAutoGunPic
, _itAimStance = OneHand
, _wpAmmo = ltBullet
}
ltAutoGunPic :: Picture
ltAutoGunPic = color green $ pictures
[polygon $ rectNSWE 5 (-5) (-5) 0
,circleSolid 5
]
miniGun :: Item
miniGun = defaultAutoGun
{ _itName = "MINI-G"
, _itIdentity = MiniGun
, _wpMaxAmmo = 1500
, _wpLoadedAmmo = 1500
, _wpReloadTime = 200
, _wpReloadState = 0
, _wpMaxWarmUp = 100
, _itUseRate = 0
, _itUseTime = 0
, _itUse = useAmmoParamsVelMod vm4
, _itUseModifiers =
[ ammoCheckI
, withWarmUpI crankSlowS
, useTimeCheckI
--, afterRecoil recoilAmount
, withSoundForI mini1S 2
--, withThinSmokeI
, torqueAfterI 0.05
, withSidePushI 53
, afterRecoil recoilAmount
, withRandomOffsetI 12
, trigDoAlso (useAmmoParamsVelMod vm1)
--, torqueBeforeForcedI 0.001
, withSidePushI 52
, afterRecoil recoilAmount
, withRandomOffsetI 11
, withOldDir od1
, trigDoAlso (useAmmoParamsVelMod vm2)
--, torqueBeforeForcedI 0.001
, withSidePushI 51
, afterRecoil recoilAmount
, withRandomOffsetI 10
, withOldDir od2
, trigDoAlso (useAmmoParamsVelMod vm3)
, useAmmo 4
--, torqueBeforeForcedI 0.001
, withSidePushI 50
, afterRecoil recoilAmount
, withRandomOffsetI 9
, withMuzFlareI
, withOldDir od3
, withSmoke 1 black 20 200 5
]
, _wpRange = 20
, _itFloorPict = (,) emptySH $ onLayer FlItLayer miniGunPict
, _itAimingSpeed = 0.4
, _itAimingRange = 1
, _itEquipPict = pictureWeaponOnAim $ (,) emptySH miniGunPict
, _wpAmmo = basicBullet
}
where
recoilAmount = 5
[vm1,vm2,vm3,vm4] =
[ 0.25
, 0.5
, 0.75
, 1
]
[od1,od2,od3] =
[ 0.25, 0.5, 0.9]
--[ 0.75, 0.5, 0.25]
--[ 0, 0, 0]
miniGunPict :: Picture
miniGunPict = pictures
[ translate 5 0 . color red $ polygon $ rectNESW 9 7 (-9) (-5)
, color red . polygon $ rectNESW 4 12 (-4) (-12)
]
spreadGun :: Item
spreadGun = defaultGun
{ _itName = "SPREAD"
, _itIdentity = SpreadGun
, _wpMaxAmmo = 5
, _wpLoadedAmmo = 5
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 20
, _itUseTime = 0
--, _itUse = \_ -> spreadNumVelWthHiteff spreadGunSpread 9 (V2 30 0) 2 basicBulletEffect
, _itUse = useAmmoParams
, _itUseModifiers =
[ ammoCheckI
, hammerCheckI
, useTimeCheckI
, withSoundStart shotgunS
, useAmmo 1
, withRecoilI 100
, withMuzFlareI
, spreadNumI
]
, _wpSpread = spreadGunSpread
, _wpRange = 20
, _itFloorPict = spreadGunPic
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itEquipPict = pictureWeaponOnAim $ spreadGunPic
, _wpAmmo = basicBullet
, _wpNumBarrels = 50
}
spreadGunPic :: SPic
spreadGunPic =
( colorSH green $ upperPrismPoly 5 $ map toV2[(-3,0),(3,6),(3,-6)]
, mempty
)
multGun :: Item
multGun = defaultGun
{ _itName = "MULTGUN"
, _itIdentity = MultGun
, _wpMaxAmmo = 2
, _wpLoadedAmmo = 2
, _wpReloadTime = 40
, _wpReloadState = 0
, _itUseRate = 20
, _itUseTime = 0
, _itUse = useAmmoParams
, _itUseModifiers =
[ ammoCheckI
, hammerCheckI
, useTimeCheckI
, withSoundStart shotgunS
, useAmmo 1
, withRecoilI 200
, withMuzFlareI
, numI
]
, _wpSpread = spreadGunSpread
, _wpRange = 20
, _itFloorPict = (,) emptySH $ onLayer FlItLayer multGunPic
, _itAimingSpeed = 0.4
, _itAimingRange = 1
, _itZoom = defaultItZoom
, _itAimZoom = defaultItZoom {_itZoomFac = 1.5}
, _itEquipPict = pictureWeaponOnAim $ (,) emptySH multGunPic
, _itAimStance = TwoHandTwist
, _wpAmmo = basicBullet
, _wpNumBarrels = 5
}
multGunPic :: Picture
multGunPic = color red $ pictures
[ polygon $ rectNESW 4 8 (-4) (-12)
, translate 8 0 $ 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 $ map toV2 [(-1.5,12),(-2,12),(-2,-12),(-1.5,-12)]
]
]
longGun :: Item
longGun = defaultGun
{ _itName = "LONGGUN"
, _itIdentity = LongGun
, _wpMaxAmmo = 1
, _wpLoadedAmmo = 1
, _wpReloadTime = 100
, _wpReloadState = 0
, _wpReloadType = PassiveReload skwareFadeTwoSecS
, _itUseRate = 100
, _itUseTime = 0
, _itUse = useAmmoParams
, _itUseModifiers =
[ ammoCheckI
, hammerCheckI
, useTimeCheckI
, withSoundStart bangEchoS
, useAmmo 1
, withThickSmokeI
, torqueAfterI 0.05
, withMuzFlareI
]
, _wpRange = 200
, _itFloorPict = (,) emptySH $ onLayer FlItLayer longGunPic
, _itAimingSpeed = 0.2
, _itAimingRange = 1
, _itZoom = defaultItZoom
, _itAimZoom = defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5}
, _itEquipPict = pictureWeaponOnAim $ (,) emptySH longGunPic
, _itScroll = zoomLongGun
, _itAttachment = ItScope (V2 0 0) 0 1 False
, _itEffect = itemLaserScopeEffect
, _wpAmmo = hvBullet
, _itAimStance = TwoHandTwist
}
longGunPic :: Picture
longGunPic = pictures [color orange $ polygon $ rectNESW 2 12 (-2) (-12) ]
zoomLongGun :: Float -> Creature -> Item -> Item
zoomLongGun x _
| x > 0 = startZoomInLongGun
| x < 0 = startZoomOutLongGun
| otherwise = id
startZoomInLongGun :: Item -> Item
startZoomInLongGun = itAttachment . scopeZoomChange %~ \x -> max 5 (x + 5)
startZoomOutLongGun :: Item -> Item
startZoomOutLongGun = itAttachment . 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 = const aGasCloud
, _itUseModifiers =
[ ammoCheckI
, useTimeCheckI
, withSoundForI foamSprayLoopS 5
, useAmmo 1
, spreadNumI
]
, _wpRange = 8
, _itFloorPict = (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
, _itAimingSpeed = 0.2
, _itAimingRange = 0
, _itZoom = defaultItZoom
, _itEquipPict = pictureWeaponOnAim $ (,) emptySH $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
, _wpSpread = 0.1
, _wpNumBarrels = 3
}
flamer :: Item
flamer = defaultAutoGun
{ _itName = "FLAMER"
, _itIdentity = Flamethrower
, _wpMaxAmmo = 250
, _wpLoadedAmmo = 250
, _wpReloadTime = 100
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _itUse = \_ -> randWalkAngle 0.2 0.01 aFlame
, _itUseModifiers =
[ ammoUseCheckI
, withSidePushI 5
--, withTempLight 1 100 (V3 1 0 0)
, withSidePushAfterI 20
]
, _wpSpread = 0
, _wpRange = 8
, _itFloorPict = (,) emptySH $ onLayer FlItLayer flamerPic
, _itAimingSpeed = 0.5
, _itAimingRange = 0
, _itZoom = defaultItZoom
, _itAimZoom = defaultItZoom {_itZoomMax = 5, _itZoomMin = 1.5}
, _itEquipPict = pictureWeaponOnAim $ (,) emptySH flamerPic
, _itAttachment = NoItAttachment
}
flamerPic :: Picture
flamerPic = color yellow $ pictures
[ translate (negate 5) (negate 7) $ circleSolid 5
, polygon $ rectNESW 2 9 (-2) (-9)
]
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
}
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 = (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-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
= teslaGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir)
$ set randGen g w
& particles %~ (makeTeslaArcAt col pos dir :)
where
pos = _crPos cr +.+ (_crRad cr +1) *.* unitVectorAtAngle dir
dir = _crDir cr
(colid,g) = randomR (0::Int,3) $ _randGen w
col = chooseColor colid
chooseColor 0 = white
chooseColor 1 = azure
chooseColor 2 = blue
chooseColor _ = cyan
remoteShellPic' :: Projectile -> Picture
remoteShellPic' pj
| t > 40 = onLayerL [levLayer CrLayer - 2]
$ uncurryV translate pos $ rotate dir $ remoteShellPic t
| otherwise = uncurryV translate pos $ rotate dir $ remoteShellPic t
where
t = _pjTimer pj
pos = _pjPos pj
dir = _pjDir pj
remoteShellPic
:: Int -- ^ Timer
-> Picture
remoteShellPic t
| rem (t+200) 20 < 9 = setDepth 20 $ polygon $ map toV2 [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
| otherwise = pictures
[ setDepth 20 $ polygon $ map toV2 [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
, setLayer 1 . setDepth 20.5 . 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 . scopePos) (V2 0 0)
$ set (pointToItem (_itemPositions w IM.! itid) . itUse) (const 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
. scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
_ -> w'
pos = fromMaybe (V2 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 . scopePos .~ V2 0 0)
. (itZoom .~ defaultItZoom)
. (itUse .~ const 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
. scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
_ -> w'
pos = fromMaybe (V2 0 0) $ w ^? projectiles . ix pjid . pjPos
moveRemoteBomb :: Int -> Int -> Int -> World -> World
moveRemoteBomb itid time pID w
| time < -4 = updatePicture
$ set (projectiles .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 (projectiles . ix pID . pjPos) finalPos
$ updatePicture
$ set (projectiles .ix pID.pjUpdate) (\_ -> moveRemoteBomb itid (time-1) pID)
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 $ uncurryV 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]
setRemoteScope :: Int -> Projectile -> World -> World
setRemoteScope itid pj w' = case w' ^? itemPositions . ix itid of
Just (InInv cid' invid )
-> w' & creatures . ix cid' . crInv . ix invid . itAttachment
. scopePos .~ (_pjPos pj -.- _crPos (_creatures w' IM.! cid'))
_ -> w'
setRemoteBombScope :: Int -> Projectile -> 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'
grenade :: Item
grenade = Throwable
{ _itName = "GRENADE " ++ show fuseTime
, _itIdentity = Grenade
, _itMaxStack = 8
, _itAmount = 1
, _itFloorPict = (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _twMaxRange = 150
, _twAccuracy = 30
, _itUse = \_ -> throwGrenade makeExplosionAt
, _itUseModifiers =
[ useTimeCheckI
]
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itZoom = defaultItZoom
, _itAimZoom = defaultItZoom {_itZoomMax = f fuseTime, _itZoomMin = f fuseTime}
, _itEquipPict = pictureWeaponOnAim $ grenadePic fuseTime
, _itID = Nothing
, _itUseRate = 25
, _itUseTime = 0
, _itAttachment = ItFuse fuseTime
, _itInvColor = white
, _itInvDisplay = basicWeaponDisplay
, _itEffect = wpRecock
, _itHammer = HammerUp
, _itScroll = changeFuse
, _itAimStance = OneHand
}
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 = (,) 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
}
fireRemoteLauncher :: Creature -> World -> World
fireRemoteLauncher cr w = setLocation
$ resetFire
$ resetName
$ soundStart (CrWeaponSound cid 0) pos tap4S Nothing
$ over projectiles addRemRocket w
where
i = IM.newKey $ _projectiles w
cid = _crID cr
dir = _crDir cr
pos = _crPos cr +.+ rotateV dir (V2 (_crRad cr + 1) 0)
addRemRocket = IM.insert i $ Shell
{ _pjPos = pos
, _pjStartPos = pos
, _pjVel = rotateV dir (V2 1 0)
, _pjDraw = remoteShellPic'
, _pjID = i
, _pjUpdate = \pj -> decTimMvVel pj . setRemoteScope itid pj . moveRemoteShell cid itid pj
, _pjAcc = V2 0 0
, _pjDir = dir
, _pjSpin = 0
, _pjPayload = makeExplosionAt
, _pjTimer = 50
}
j = _crInvSel cr
newitid = IM.newKey $ _itemPositions w
maybeitid = cr ^? crInv . ix j . itID . _Just
resetFire = set (creatures . ix cid . crInv . ix j . itUse)
$ \_ _ -> 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 -> Projectile -> World -> World
moveRemoteShell cid itid pj w
| time > 40 = if circOnSomeWall oldPos 4 w
then doExplosion w
else w
| time >= 20 = case thingHit of
Just _ -> doExplosion w
Nothing -> w & projectiles . ix i . pjDir .~ newdir
| time > -99 = case thingHit of
Just _ -> doExplosion $ stopSoundFrom (ShellSound i) w
Nothing -> w & set randGen g
& projectiles . ix i %~
( ( pjVel %~ ( (accel +.+) . (frict *.*) ) )
. ( pjDir .~ newdir )
)
& soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
& smokeGen
& makeFlameletTimed oldPos 20 (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10
| time > -200 = case thingHit of
Just _ -> doExplosion $ stopSoundFrom (ShellSound i) w
Nothing -> w
| otherwise = doExplosion $ stopSoundFrom (ShellSound i) w
where
time = _pjTimer pj
i = _pjID pj
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 = _pjDir pj
accel = rotateV newdir (V2 2 0)
(frict,g) = randomR (0.6,0.9) $ _randGen w
(sparkD,_) = randomR (-0.5,0.5) $ _randGen w
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 = shellTrailCloud $ addZ 20 $ oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)
doExplosion = explodeRemoteRocket itid i
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) (const 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 = const 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) $ \ _ _ -> 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 (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 $ (,) 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
spreadGunSpread,autogunSpread :: Float
spreadGunSpread = 0.5
autogunSpread = 0.07
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)
, _itAmount = 1
, _itMaxStack = 1
, _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)
, _itAmount = 1
, _itMaxStack = 1
, _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)