Files
loop/src/Dodge/Item/Weapon.hs
T
2021-08-28 12:09:39 +01:00

1140 lines
35 KiB
Haskell

{- | Definitions of weapons.
In progress: move out effects into other modules. -}
module Dodge.Item.Weapon
where
import Dodge.Data
import Dodge.Base
import Dodge.Base.Zone
import Dodge.Picture.Layer
import Dodge.SoundLogic
import Dodge.SoundLogic.Synonyms
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.Default.Weapon
import Dodge.Item.Weapon.Booster
import Dodge.Item.Weapon.Grenade
import Dodge.Item.Attachment.Data
import Dodge.Item.Attachment
import Geometry
import Picture
import qualified IntMapHelp as IM
--import Data.List
--import Data.Char
import Data.Maybe
import Data.Function
--import qualified Data.ByteString as B
import qualified Data.Sequence as Seq
import Control.Lens
import Control.Applicative
import Control.Monad.State
--import Control.Monad
import qualified SDL
import System.Random
import qualified Data.Set as S
--import qualified Data.Map as M
pistol :: Item
pistol = defaultGun
{ _itName = "PISTOL"
, _itIdentity = Pistol
, _wpMaxAmmo = 15
, _wpLoadedAmmo = 15
, _wpReloadTime = 40
, _wpReloadState = 0
, _itUseRate = 8
, _itUseTime = 0
, _itUse = useAmmoParams
, _itUseModifiers =
[ ammoCheckI
, hammerCheckI
, useTimeCheckI
, withSoundI 0
, useAmmo 1
-- , withRandomDirI 0.1
, withMuzFlareI
]
, _itLeftClickUse = Nothing
, _wpSpread = 0.02
, _wpRange = 20
, _itHammer = HammerUp
, _itFloorPict = onLayer FlItLayer pistolPic
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itZoom = defaultItZoom
, _itEquipPict = pictureWeaponOnAim pistolPic
, _itAttachment = Nothing
, _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 = onLayer FlItLayer $ color chartreuse $ pictures
[polygon $ rectNESW 7 3 1 (-3)
,polygon $ rectNESW (-1) 3 (-7) (-3)
]
, _itAimingSpeed = 0.4
, _itAimingRange = 0
, _itEquipPict = pictureWeaponOnAim $ color chartreuse $ pictures
[polygon $ rectNESW 7 3 1 (-3)
,polygon $ rectNESW (-1) 3 (-7) (-3)
]
}
teslaGun :: Item
teslaGun = defaultGun
{ _itName = "TESLA"
, _itIdentity = TeslaGun
, _wpMaxAmmo = 200
, _wpLoadedAmmo = 200
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _itUse = const aTeslaArc
, _itUseModifiers =
[ ammoCheckI
, useTimeCheckI
, withSoundForI 25 1
, useAmmo 1
]
, _wpSpread = 0.001
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer teslaGunPic
, _itAimingSpeed = 0.4
, _itZoom = defaultItZoom
, _itAimingRange = 0
, _itEquipPict = pictureWeaponOnAim 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
, withSoundForI 24 1
, useAmmo 1
]
, _wpSpread = 0.001
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer lasGunPic
, _itAimingSpeed = 0.4
, _itAimingRange = 1
, _itEquipPict = pictureWeaponOnAim lasGunPic
, _itAttachment = Just $ 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 = 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 = onLayer FlItLayer $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ]
, _itAimingSpeed = 0.4
, _itAimingRange = 0.5
, _itEquipPict = pictureWeaponOnAim $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ]
}
removeItAttachment :: Int -> Int -> World -> World
removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachment .~ Nothing
where
cr = _creatures w IM.! i
itRef = _crInvSel cr
remoteLauncher :: Item
remoteLauncher = defaultGun
{ _itName = "ROCKO-REM"
, _itIdentity = RemoteLauncher
, _wpMaxAmmo = 1
, _wpLoadedAmmo = 1
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 10
, _itUseTime = 0
, _itUse = const fireRemoteLauncher
, _itUseModifiers =
[ ammoCheckI
, hammerCheckI
]
, _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 (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 (torqueBeforeForcedI 0.1) (torqueAfterI 0.2)
, withSoundI longGunSound
, withThinSmokeI
, withMuzFlareI
]
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer hvAutoGunPic
, _itAimingSpeed = 0.2
, _itAimingRange = 1
, _itEquipPict = pictureWeaponOnAim 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
, withSoundI 0
, useAmmo 1
, withRandomDirI 0.3
, withSidePushI 50
, withMuzFlareI
]
, _wpSpread = 0.5
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer ltAutoGunPic
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itZoom = defaultItZoom
, _itEquipPict = pictureWeaponOnAim 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 = 50
, _itUseRate = 1
, _itUseTime = 0
, _itUse = useAmmoParamsVelMod vm4
, _itUseModifiers =
[ ammoCheckI
, withWarmUpI 26
, useTimeCheckI
, withRecoilI 25
, withSoundForI 28 2
, torqueAfterI 0.05
--, withSidePushI 53
--, withRandomOffsetI 12
, trigDoAlso (useAmmoParamsVelMod vm1)
--, torqueBeforeForcedI 0.001
, withSidePushI 52
, withRandomOffsetI 11
, withOldDir od1
, trigDoAlso (useAmmoParamsVelMod vm2)
--, torqueBeforeForcedI 0.001
, withSidePushI 51
, withRandomOffsetI 10
, withOldDir od2
, trigDoAlso (useAmmoParamsVelMod vm3)
, useAmmo 4
--, torqueBeforeForcedI 0.001
, withSidePushI 50
, withRandomOffsetI 9
, withMuzFlareI
, withOldDir od3
]
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer miniGunPict
, _itAimingSpeed = 0.4
, _itAimingRange = 1
, _itEquipPict = pictureWeaponOnAim miniGunPict
, _wpAmmo = basicBullet
}
where
[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
, withSoundI shotgunSound
, useAmmo 1
, withRecoilI 100
, withMuzFlareI
, spreadNumI
]
, _wpSpread = spreadGunSpread
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer spreadGunPic
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itEquipPict = pictureWeaponOnAim spreadGunPic
, _wpAmmo = basicBullet
, _wpNumBarrels = 50
}
spreadGunPic :: Picture
spreadGunPic = color green $ pictures [ polygon $ map toV2[(-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 = useAmmoParams
, _itUseModifiers =
[ ammoCheckI
, hammerCheckI
, useTimeCheckI
, withSoundI shotgunSound
, useAmmo 1
, withRecoilI 200
, withMuzFlareI
, numI
]
, _wpSpread = spreadGunSpread
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer multGunPic
, _itAimingSpeed = 0.4
, _itAimingRange = 1
, _itZoom = defaultItZoom {_itAimZoomFac = 1.5}
, _itEquipPict = pictureWeaponOnAim 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 skwareFadeTwoSecSound
, _itUseRate = 100
, _itUseTime = 0
, _itUse = useAmmoParams
, _itUseModifiers =
[ ammoCheckI
, hammerCheckI
, useTimeCheckI
, withSoundI longGunSound
, useAmmo 1
, withThickSmokeI
, torqueAfterI 0.05
, withMuzFlareI
]
, _wpRange = 200
, _itFloorPict = onLayer FlItLayer longGunPic
, _itAimingSpeed = 0.2
, _itAimingRange = 1
, _itZoom = defaultItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5}
, _itEquipPict = pictureWeaponOnAim longGunPic
, _itScroll = zoomLongGun
, _itAttachment = Just $ 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 -> World -> World
zoomLongGun x cr
| x > 0 = startZoomInLongGun (_crInvSel cr)
| x < 0 = startZoomOutLongGun (_crInvSel cr)
| otherwise = id
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 = const aGasCloud
, _itUseModifiers =
[ useTimeCheckI
, withSoundI buzzSound
, useAmmo 1
]
, _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 = \_ -> randWalkAngle 0.2 0.01 aFlame
, _itUseModifiers =
[ ammoUseCheckI
, withSidePushI 5
, withSidePushAfterI 10
]
, _wpSpread = 0
, _wpRange = 8
, _itFloorPict = onLayer FlItLayer flamerPic
, _itAimingSpeed = 0.5
, _itAimingRange = 0
, _itZoom = defaultItZoom {_itAimZoomMax = 5, _itAimZoomMin = 1.5}
, _itEquipPict = pictureWeaponOnAim flamerPic
, _itAttachment = Nothing
}
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 = 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 = 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 pos dir :)
where
pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
+.+ sideOffset *.* vNormal (unitVectorAtAngle dir)
(sideOffset,g) = randomR (-5,5) $ _randGen w
dir = _crDir cr
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 . _Just . 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
. _Just . 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 . _Just . 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
. _Just . 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 _ -> soundOnce tapQuiet $ halfV updatedWorld
_ -> halfV updatedWorld
| otherwise = case hitWl of
Just _ -> soundOnce tapQuiet 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
. _Just . 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
. _Just . scopePos .~ (_pjPos pj -.- _crPos (_creatures w' IM.! cid))
& creatures . ix cid . crInv . ix invid . itZoom
.~ (defaultItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5})
_ -> w'
grenade :: Item
grenade = Throwable
{ _itName = "GRENADE " ++ show fuseTime
, _itIdentity = Grenade
, _itMaxStack = 8
, _itAmount = 1
, _itFloorPict = 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 {_itAimZoomMax = f fuseTime, _itAimZoomMin = f fuseTime}
, _itEquipPict = pictureWeaponOnAim $ grenadePic fuseTime
, _itID = Nothing
, _itUseRate = 25
, _itUseTime = 0
, _itAttachment = Just $ ItFuse fuseTime
, _itInvColor = white
, _itInvDisplay = basicWeaponDisplay
, _itEffect = wpRecock
, _itHammer = HammerUp
, _itScrollUp = decreaseFuse fuseTime
, _itScrollDown = increaseFuse fuseTime
, _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 = onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _twMaxRange = 150
, _twAccuracy = 30
, _itUse = const throwRemoteBomb
, _itUseModifiers =
[ hammerCheckI
]
, _itAttachment = Just $ ItScope (V2 0 0) 0 1 True
, _itEquipPict = pictureWeaponOnAim remoteBombUnarmedPic
}
fireRemoteLauncher :: Creature -> World -> World
fireRemoteLauncher cr w = setLocation
$ resetFire
$ resetName
$ soundOnce launcherSound
$ 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 )
)
& soundFromPos (ShellSound i) newPos smokeTrailSound 1 250
& 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 = makeSmokeCloudAt $ 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) $ \ _ _ -> blank
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 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 $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> blank
, _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 = 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 = const aSonarPulse
, _itUseModifiers =
[ ammoUseCheckI
]
, _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 $ map toV2 [(-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 $ map toV2 [(-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
, _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)