2768 lines
125 KiB
Haskell
2768 lines
125 KiB
Haskell
{-# LANGUAGE BangPatterns #-}
|
|
module Dodge.Weapons where
|
|
-- imports {{{
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Dodge.SoundLogic
|
|
import Dodge.CreatureActions
|
|
import Dodge.RandomHelp
|
|
import Dodge.WorldActions
|
|
import Dodge.Debug
|
|
import Dodge.WallCreatureCollisions
|
|
import Dodge.Prototypes
|
|
|
|
import Geometry
|
|
import Picture
|
|
|
|
import Data.List
|
|
import Data.Char
|
|
import Data.Maybe
|
|
import Data.Function
|
|
--import Data.Graph.Inductive.Graph
|
|
--import Data.Graph.Inductive.PatriciaTree
|
|
--import Codec.BMP
|
|
import qualified Data.ByteString as B
|
|
import Control.Lens
|
|
import Control.Applicative
|
|
import Control.Monad.State
|
|
import Control.Monad
|
|
import qualified SDL as SDL
|
|
--import qualified Graphics.UI.SDL.Mixer as Mix
|
|
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
|
|
import Control.Concurrent
|
|
-- }}}
|
|
|
|
pistol,lasGun,tractorGun,launcher,autoGun
|
|
,teslaGun
|
|
,spreadGun
|
|
,multGun
|
|
-- ,shatterGun
|
|
,longGun,flamer,blinkGun,forceFieldGun :: Item
|
|
|
|
pistol = Weapon
|
|
{ _itName = "PISTOL"
|
|
, _itIdentity = Pistol
|
|
, _wpMaxAmmo = 15
|
|
, _wpLoadedAmmo = 15
|
|
, _wpAmmoType = PistolBullet
|
|
, _wpReloadTime = 40
|
|
, _wpReloadState = 0
|
|
, _wpFireRate = 8
|
|
, _wpFireState = 0
|
|
, _wpFire = shootWithSound 0
|
|
$ withAccVelWthHiteff' 0.1 (30,0) 2
|
|
-- $ threeEff' bulIncCr' bulIncWall' bulHitFF'
|
|
$ threeEff' 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 = basicItZoom
|
|
, _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
|
|
basicWeaponDisplay :: Item -> String
|
|
basicWeaponDisplay it = _itName it ++ " " ++ aIfLoaded ++ "/" ++ availableAmmo
|
|
where
|
|
availableAmmo = show $ _wpMaxAmmo it
|
|
-- availableAmmo = if _unlimitedAmmo w
|
|
-- then show $ _wpMaxAmmo it
|
|
-- else show $ case _crAmmo (you w) M.!? _wpAmmoType it of
|
|
-- Nothing -> 0
|
|
-- Just x -> x
|
|
aIfLoaded = case (_wpReloadState it) of
|
|
0 -> show $ _wpLoadedAmmo it
|
|
x -> "R" ++ show x
|
|
effectGun :: String -> (Int -> World -> World) -> Item
|
|
effectGun name eff = defaultGun
|
|
{ _itName = name ++ "Gun"
|
|
, _wpFire = eff
|
|
}
|
|
autoEffectGun :: String -> (Int -> World -> World) -> Item
|
|
autoEffectGun name eff = autoGun
|
|
{ _itName = name ++ "Gun"
|
|
, _wpFire = eff
|
|
}
|
|
|
|
autoGun = defaultGun
|
|
{ _itName = "AUTOGUN AUTO"
|
|
, _itIdentity = AutoGun
|
|
, _wpMaxAmmo = 30
|
|
, _wpLoadedAmmo = 30
|
|
, _wpAmmoType = PistolBullet
|
|
, _wpReloadTime = 80
|
|
, _wpReloadState = 0
|
|
-- , _wpFireRate = 6
|
|
, _wpFireRate = 5
|
|
, _wpFireState = 0
|
|
, _wpFire = autoFireMode
|
|
, _wpSpread = autogunSpread
|
|
, _wpRange = 20
|
|
, _itHammer = NoHammer
|
|
, _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 = basicItZoom {_itAimZoomFac = 1.5}
|
|
, _itEquipPict = drawWeapon $ color red $ polygon $ rectNESW 4 4 (-4) (-4)
|
|
, _itEffect = NoItEffect
|
|
, _itAttachment = Just $ ItMode 0
|
|
, _itScrollUp = incMode
|
|
, _itScrollDown = incMode
|
|
}
|
|
autoFireMode = shootWithSound (fromIntegral autoGunSound)
|
|
$ withRecoil 40
|
|
$ torqueBefore 0.05
|
|
$ withAccVelWthHiteff' (autogunSpread/2) (50,0) 3
|
|
$ threeEff' bulHitCr' bulHitWall' bulHitFF'
|
|
singleFireMode = shootWithSound (fromIntegral autoGunSound)
|
|
$ withRecoil 40
|
|
$ torqueAfter 0.03
|
|
$ withAccVelWthHiteff' (autogunSpread/2) (50,0) 3
|
|
$ threeEff' bulHitCr' bulHitWall' bulHitFF'
|
|
|
|
incMode :: Int -> World -> World
|
|
incMode _ w
|
|
= case newMode of
|
|
0 -> w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode .~ 0
|
|
& creatures . ix 0 . crInv . ix itRef . itName .~ "AUTOGUN AUTO"
|
|
& creatures . ix 0 . crInv . ix itRef . itHammer .~ NoHammer
|
|
& creatures . ix 0 . crInv . ix itRef . itEffect .~ NoItEffect
|
|
& creatures . ix 0 . crInv . ix itRef . wpFire .~ autoFireMode
|
|
1 -> w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode .~ 1
|
|
& creatures . ix 0 . crInv . ix itRef . itName .~ "AUTOGUN SINGLE"
|
|
& creatures . ix 0 . crInv . ix itRef . itHammer .~ HammerUp
|
|
& creatures . ix 0 . crInv . ix itRef . itEffect .~ wpRecock
|
|
& creatures . ix 0 . crInv . ix itRef . wpFire .~ singleFireMode
|
|
where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel
|
|
oldMode = w ^? creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode
|
|
newMode = fromMaybe 1 $ fmap f oldMode
|
|
f x = mod (x+1) 2
|
|
decMode :: Int -> World -> World
|
|
decMode _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode %~ f
|
|
& creatures . ix 0 . crInv . ix itRef . itName .~ "AUTOGUN" ++ g newMode
|
|
where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel
|
|
oldMode = w ^? creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode
|
|
newMode = fromMaybe 1 $ fmap f oldMode
|
|
f x = mod (x-1) 2
|
|
g 1 = " SINGLE"
|
|
g 2 = " BURST"
|
|
g 0 = " AUTO"
|
|
|
|
rezGun = defaultGun
|
|
{ _itName = "REANIMATOR"
|
|
, _wpMaxAmmo = 50
|
|
, _wpLoadedAmmo = 50
|
|
, _wpAmmoType = Battery
|
|
, _wpReloadTime = 80
|
|
, _wpReloadState = 0
|
|
, _wpFireRate = 0
|
|
, _wpFireState = 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 = autoGun
|
|
{ _itName = "TESLAGUN"
|
|
, _itIdentity = TeslaGun
|
|
, _wpMaxAmmo = 200
|
|
, _wpLoadedAmmo = 200
|
|
, _wpAmmoType = Battery
|
|
, _wpReloadTime = 80
|
|
, _wpReloadState = 0
|
|
, _wpFireRate = 0
|
|
, _wpFireState = 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 = basicItZoom
|
|
, _itAimingRange = 0
|
|
, _itEquipPict = drawWeapon $ color blue $ pictures [polygon $ rectNESW 7 3 1 (-3)
|
|
,polygon $ rectNESW (-1) 3 (-7) (-3)
|
|
]
|
|
}
|
|
lasGun = autoGun
|
|
{ _itName = "LASGUN ////"
|
|
, _itIdentity = LasGun
|
|
, _wpMaxAmmo = 200
|
|
, _wpLoadedAmmo = 200
|
|
, _wpAmmoType = Battery
|
|
, _wpReloadTime = 80
|
|
, _wpReloadState = 0
|
|
, _wpFireRate = 0
|
|
, _wpFireState = 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 $ ItPhaseV 1
|
|
, _itScrollUp = incPhaseV
|
|
, _itScrollDown = decPhaseV
|
|
}
|
|
incPhaseV :: Int -> World -> World
|
|
incPhaseV _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV %~ f
|
|
& creatures . ix 0 . crInv . ix itRef . itName .~ "LASGUN" ++ g newPhaseV
|
|
where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel
|
|
oldPhaseV = w ^? creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV
|
|
newPhaseV = fromMaybe 1 $ fmap f oldPhaseV
|
|
f 0.2 = 0.5
|
|
f 0.5 = 1
|
|
f 1 = 2
|
|
f 2 = 5
|
|
f 5 = 5
|
|
g 0.2 = " //\\\\"
|
|
g 0.5 = " ///\\"
|
|
g 1 = " ////"
|
|
g 2 = " \\///"
|
|
g 5 = " \\\\//"
|
|
decPhaseV :: Int -> World -> World
|
|
decPhaseV _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV %~ f
|
|
& creatures . ix 0 . crInv . ix itRef . itName .~ "LASGUN" ++ g newPhaseV
|
|
where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel
|
|
oldPhaseV = w ^? creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV
|
|
newPhaseV = fromMaybe 1 $ fmap f oldPhaseV
|
|
f 0.2 = 0.2
|
|
f 0.5 = 0.2
|
|
f 1 = 0.5
|
|
f 2 = 1
|
|
f 5 = 2
|
|
g 0.2 = " //\\\\"
|
|
g 0.5 = " ///\\"
|
|
g 1 = " ////"
|
|
g 2 = " \\///"
|
|
g 5 = " \\\\//"
|
|
forceFieldGun = defaultGun
|
|
{ _itName = "FORCEFIELD"
|
|
, _itIdentity = ForceFieldGun
|
|
, _wpMaxAmmo = 100
|
|
, _wpLoadedAmmo = 100
|
|
, _wpAmmoType = Battery
|
|
, _wpReloadTime = 40
|
|
, _wpReloadState = 0
|
|
, _wpFireRate = 10
|
|
, _wpFireState = 0
|
|
, _wpFire = forceFieldFire
|
|
, _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
|
|
-- , _wpAmmoType = Battery
|
|
-- , _wpReloadTime = 40
|
|
-- , _wpReloadState = 0
|
|
-- , _wpFireRate = 10
|
|
-- , _wpFireState = 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 = autoGun
|
|
{ _itName = "TRACTORGUN"
|
|
, _itIdentity = TractorGun
|
|
, _wpMaxAmmo = 10000
|
|
, _wpLoadedAmmo = 10000
|
|
, _wpAmmoType = Battery
|
|
, _wpReloadTime = 40
|
|
, _wpReloadState = 0
|
|
, _wpFireRate = 0
|
|
, _wpFireState = 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 = "lAUNCHER"
|
|
, _itIdentity = Launcher
|
|
, _wpMaxAmmo = 30
|
|
, _wpLoadedAmmo = 30
|
|
, _wpAmmoType = Shell
|
|
, _wpReloadTime = 80
|
|
, _wpReloadState = 0
|
|
, _wpFireRate = 20
|
|
, _wpFireState = 0
|
|
, _wpFire = shoot $ aRocket
|
|
, _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
|
|
}
|
|
remoteLauncher = defaultGun
|
|
{ _itName = "REMOTELAUNCHER"
|
|
, _itIdentity = RemoteLauncher
|
|
, _wpMaxAmmo = 1
|
|
, _wpLoadedAmmo = 1
|
|
, _wpAmmoType = Shell
|
|
, _wpReloadTime = 80
|
|
, _wpReloadState = 0
|
|
, _wpFireRate = 10
|
|
, _wpFireState = 0
|
|
, _wpFire = 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 = autoGun
|
|
{ _itName = "HVMACHINEGUN"
|
|
, _itIdentity = HvAutoGun
|
|
, _wpMaxAmmo = 100
|
|
, _wpLoadedAmmo = 100
|
|
, _wpAmmoType = PistolBullet
|
|
, _wpReloadTime = 200
|
|
, _wpReloadState = 0
|
|
, _wpFireRate = 25
|
|
, _wpFireState = 0
|
|
, _wpFire = rateIncAB 24 12 (torqueBeforeForced 0.1 mkHvBul)
|
|
$torqueAfter 0.2 mkHvBul
|
|
, _wpSpread = autogunSpread
|
|
, _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
|
|
$ withAccVelWthHiteff' 0 (80,0) 6
|
|
$ threeEff'
|
|
hvBulHitCr' hvBulHitWall' bulHitFF'
|
|
|
|
ltAutoGun = autoGun
|
|
{ _itName = "AUTOPISTOL"
|
|
, _itIdentity = LtAutoGun
|
|
, _wpMaxAmmo = 25
|
|
, _wpLoadedAmmo = 25
|
|
, _wpAmmoType = PistolBullet
|
|
, _wpReloadTime = 80
|
|
, _wpReloadState = 0
|
|
, _wpFireRate = 4
|
|
, _wpFireState = 0
|
|
, _wpFire = shootWithSound 0 $ withAccVelWthHiteff' 0.3 (30,0) 2 bulletEffect'
|
|
, _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 = basicItZoom
|
|
, _itEquipPict = drawWeapon $ color green $ pictures [polygon $ rectNSWE 4 (-4) (-4) 0
|
|
,circleSolid 4
|
|
]
|
|
}
|
|
miniGun = autoGun
|
|
{ _itName = "MINIGUN"
|
|
, _itIdentity = MiniGun
|
|
, _wpMaxAmmo = 150
|
|
, _wpLoadedAmmo = 150
|
|
, _wpAmmoType = PistolBullet
|
|
, _wpReloadTime = 200
|
|
, _wpReloadState = 0
|
|
, _wpFireRate = 2
|
|
, _wpFireState = 0
|
|
, _wpFire = withWarmUp 50 $ torqueBefore 0.03 $ withSidePush 50 $ withRecoil 15
|
|
$ withOffsetAccVelWthHiteff' 9 0.1 (30,0) 2 bulletEffect'
|
|
, _wpSpread = autogunSpread
|
|
, _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 = "SPREADGUN"
|
|
, _itIdentity = SpreadGun
|
|
, _wpMaxAmmo = 5
|
|
, _wpLoadedAmmo = 5
|
|
, _wpAmmoType = PistolBullet
|
|
, _wpReloadTime = 80
|
|
, _wpReloadState = 0
|
|
, _wpFireRate = 20
|
|
, _wpFireState = 0
|
|
, _wpFire = shootWithSound (fromIntegral shotgunSound)
|
|
$ withRecoil 100
|
|
$ spreadNumVelWthHiteff' spreadGunSpread 9 (30,0) 2 bulletEffect'
|
|
, _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)]
|
|
]
|
|
}
|
|
-- shatterGun = defaultGun
|
|
-- { _itName = "shatterGun"
|
|
-- , _itIdentity = ShatterGun
|
|
-- , _wpMaxAmmo = 50
|
|
-- , _wpLoadedAmmo = 50
|
|
-- , _wpAmmoType = PistolBullet
|
|
-- , _wpReloadTime = 80
|
|
-- , _wpReloadState = 0
|
|
-- , _wpFireRate = 40
|
|
-- , _wpFireState = 0
|
|
-- , _wpFire = shatterGunFire
|
|
-- , _wpSpread = 3.14
|
|
-- , _wpRange = 20
|
|
-- , _wpIsAuto = False
|
|
-- , _itFloorPict = polygon [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)]
|
|
-- , _itAmount = 1
|
|
-- , _itMaxStack = 1
|
|
-- , _itAimingSpeed = 1
|
|
-- , _itAimingRange = 0.5
|
|
-- }
|
|
multGun = defaultGun
|
|
{ _itName = "MULTGUN"
|
|
, _itIdentity = MultGun
|
|
, _wpMaxAmmo = 2
|
|
, _wpLoadedAmmo = 2
|
|
, _wpAmmoType = PistolBullet
|
|
, _wpReloadTime = 40
|
|
, _wpReloadState = 0
|
|
, _wpFireRate = 20
|
|
, _wpFireState = 0
|
|
, _wpFire = shootWithSound (fromIntegral shotgunSound)
|
|
$ withRecoil 200
|
|
$ numVelWthHitEff' 5 (50,0) 4 bulletEffect'
|
|
, _wpSpread = spreadGunSpread
|
|
, _wpRange = 20
|
|
, _itFloorPict = onLayer FlItLayer $ multGunPic
|
|
, _itAmount = 1
|
|
, _itMaxStack = 1
|
|
, _itAimingSpeed = 0.4
|
|
, _itAimingRange = 1
|
|
, _itZoom = basicItZoom {_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 = "ELEPHANTGUN"
|
|
, _itIdentity = LongGun
|
|
, _wpMaxAmmo = 1
|
|
, _wpLoadedAmmo = 1
|
|
, _wpAmmoType = PistolBullet
|
|
, _wpReloadTime = 80
|
|
, _wpReloadState = 0
|
|
, _wpFireRate = 100
|
|
, _wpFireState = 0
|
|
, _wpFire = shootWithSound (fromIntegral longGunSound)
|
|
$ withThickSmoke
|
|
$ torqueAfter 0.05
|
|
$ withAccVelWthHiteff' 0 (60,0) 6
|
|
$ threeEff'
|
|
hvBulHitCr' hvBulHitWall' bulHitFF'
|
|
|
|
, _wpSpread = 0.0
|
|
, _wpRange = 200
|
|
, _itFloorPict = onLayer FlItLayer $ pictures [color orange $ polygon $ rectNESW 3 6 (-3) (-6) ]
|
|
, _itAmount = 1
|
|
, _itMaxStack = 1
|
|
, _itAimingSpeed = 0.2
|
|
, _itAimingRange = 1
|
|
, _itZoom = basicItZoom {_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)
|
|
-- (\x -> - 10)
|
|
|
|
|
|
poisonSprayer = autoGun
|
|
{ _itName = "POISONSPRAYER"
|
|
, _itIdentity = PoisonSprayer
|
|
, _wpMaxAmmo = 500
|
|
, _wpLoadedAmmo = 500
|
|
, _wpAmmoType = LiquidFuel
|
|
, _wpReloadTime = 100
|
|
, _wpReloadState = 0
|
|
, _wpFireRate = 0
|
|
, _wpFireState = 0
|
|
, _wpFire = shoot $ aGasCloud
|
|
, _wpSpread = flamerAngle
|
|
, _wpRange = 8
|
|
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
|
|
, _itAmount = 1
|
|
, _itMaxStack = 1
|
|
, _itAimingSpeed = 0.2
|
|
, _itAimingRange = 0
|
|
, _itZoom = basicItZoom
|
|
, _itEquipPict = drawWeapon $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
|
|
}
|
|
|
|
flamer = autoGun
|
|
{ _itName = "FLAMETHROWER"
|
|
, _itIdentity = Flamethrower
|
|
, _wpMaxAmmo = 250
|
|
, _wpLoadedAmmo = 250
|
|
, _wpAmmoType = LiquidFuel
|
|
, _wpReloadTime = 100
|
|
, _wpReloadState = 0
|
|
, _wpFireRate = 0
|
|
, _wpFireState = 0
|
|
, _wpFire = shoot $ aFlame 0
|
|
, _wpSpread = flamerAngle
|
|
, _wpRange = 8
|
|
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
|
|
, _itAmount = 1
|
|
, _itMaxStack = 1
|
|
, _itAimingSpeed = 0.5
|
|
-- , _itAimingSpeed = 1
|
|
-- , _itAimingSpeed = 0.2
|
|
, _itAimingRange = 0
|
|
, _itZoom = basicItZoom {_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
|
|
, _wpAmmoType = Battery
|
|
, _wpReloadTime = 20
|
|
, _wpReloadState = 0
|
|
, _wpFireRate = 0
|
|
, _wpFireState = 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
|
|
}
|
|
|
|
withWarmUp :: Int -> (Int -> World -> World) -> Int -> World -> World
|
|
withWarmUp t f cid w
|
|
| reloadCondition = fromMaybe w $ reloadWeapon cid w
|
|
| _wpReloadState item /= 0 = w
|
|
| fState == 0 = set (pointerToItem . wpFire) (withWarmUp 100 f)
|
|
$ set (pointerToItem . wpFireState) 2
|
|
w
|
|
| t > 1 = set (pointerToItem . wpFire) (withWarmUp (t-1) f)
|
|
$ set (pointerToItem . wpFireState) 2
|
|
$ soundFrom (CrWeaponSound cid) 26 1 0
|
|
w
|
|
| t > 0 = set (pointerToItem . wpFire) (withWarmUp (t-1) f)
|
|
$ set (pointerToItem . wpFireState) 2
|
|
w
|
|
-- | otherwise = set (pointerToItem . wpFire) (withWarmUp 0 f)
|
|
| otherwise = set (pointerToItem . wpFire) (withWarmUp 1 f)
|
|
$ over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1)
|
|
$ set (pointerToItem . wpFireState) 2
|
|
$ f cid
|
|
$ continueSoundFrom (CrWeaponSound cid) 28 2 0
|
|
w
|
|
where cr = _creatures w IM.! cid
|
|
itRef = _crInvSel cr
|
|
item = _crInv cr IM.! itRef
|
|
pointerToItem = creatures . ix cid . crInv . ix itRef
|
|
fState = _wpFireState item
|
|
fRate = _wpFireRate item
|
|
reloadCondition = _wpLoadedAmmo item == 0
|
|
-- rotC = case cid of 0 -> fst $ randomR (-0.03,0.03) (_randGen w)
|
|
-- _ -> 0
|
|
|
|
withSound :: Int -> (Int -> World -> World) -> Int -> World -> World
|
|
withSound soundid f cid = soundOnce soundid . f cid
|
|
|
|
withRecoil :: Float -> (Int -> World -> World) -> Int -> World -> World
|
|
withRecoil recoilAmount eff cid w = eff cid . over (creatures . ix cid) pushback $ w
|
|
where pushback cr = over crPos
|
|
-- where pushback cr = colCrWall w $ over crPos
|
|
(+.+ rotateV (_crDir cr) ((-recoilAmount) / _crMass cr ,0))
|
|
cr
|
|
withSidePush :: Float -> (Int -> World -> World) -> Int -> World -> World
|
|
withSidePush maxSide eff cid w = eff cid . over (creatures . ix cid) push $ w
|
|
where push cr = over crPos
|
|
(+.+ rotateV (_crDir cr) (0,(pushAmount) / _crMass cr))
|
|
cr
|
|
(pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w
|
|
|
|
|
|
|
|
shootWithSound :: Int -> (Int -> World -> World) -> Int -> World -> World
|
|
shootWithSound soundid f cid w
|
|
| fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1)
|
|
$ soundOnce soundid
|
|
$ set (pointerToItem . wpFireState) (_wpFireRate item)
|
|
$ f cid w
|
|
| reloadCondition = fromMaybe w $ reloadWeapon cid w
|
|
| otherwise = w
|
|
where cr = (_creatures w IM.! cid)
|
|
itRef = _crInvSel cr
|
|
item = _crInv cr IM.! itRef
|
|
pointerToItem = creatures . ix cid . crInv . ix itRef
|
|
fireCondition = _wpReloadState item == 0
|
|
&& _wpFireState item == 0
|
|
&& _wpLoadedAmmo item > 0
|
|
reloadCondition = _wpLoadedAmmo item == 0
|
|
|
|
shoot :: (Int -> World -> World) -> Int -> World -> World
|
|
shoot f cid w | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1)
|
|
$ set (pointerToItem . wpFireState) (_wpFireRate item)
|
|
$ f cid w
|
|
| reloadCondition = fromMaybe w $ reloadWeapon cid w
|
|
| otherwise = w
|
|
where cr = (_creatures w IM.! cid)
|
|
itRef = _crInvSel cr
|
|
item = _crInv cr IM.! itRef
|
|
pointerToItem = creatures . ix cid . crInv . ix itRef
|
|
fireCondition = _wpReloadState item == 0
|
|
&& _wpFireState item == 0
|
|
&& _wpLoadedAmmo item > 0
|
|
reloadCondition = _wpLoadedAmmo item == 0
|
|
|
|
aTeslaArc :: Int -> World -> World
|
|
aTeslaArc cid w = aTeslaArc' cid
|
|
$ soundFrom (CrWeaponSound cid) 25 1 0 w
|
|
|
|
aTeslaArc' :: Int -> World -> World
|
|
aTeslaArc' cid w = over particles (IM.insert i (makeTeslaArcAt i pos dir))
|
|
$ flareAt' cyan 0.03 0.1 (pos +.+ 5 *.* unitVectorAtAngle dir)
|
|
$ set randGen g w
|
|
where cr = (_creatures w IM.! cid)
|
|
i = newParticleKey w
|
|
pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
|
|
+.+ sideOffset *.* vNormal (unitVectorAtAngle dir)
|
|
(sideOffset,g) = randomR (-5,5) $ _randGen w
|
|
dir = _crDir cr
|
|
|
|
aLaser :: Int -> World -> World
|
|
aLaser cid w = over particles' ( (:) (makeLaserAt phaseV pos dir (Just cid)))
|
|
$ soundFrom LasSound 24 1 0
|
|
$ flareAt' yellow 0.02 0.05 (pos +.+ 5 *.* unitVectorAtAngle dir)
|
|
w
|
|
where cr = (_creatures w IM.! cid)
|
|
i = newParticleKey w
|
|
pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir)
|
|
dir = _crDir cr
|
|
phaseV = fromMaybe 1 $ cr ^? crInv . ix j . itAttachment . _Just . itPhaseV
|
|
j = _crInvSel cr
|
|
|
|
|
|
aTractorBeam :: Int -> Int -> World -> World
|
|
aTractorBeam col cid w
|
|
= set (creatures . ix cid . crInv . ix itRef . wpFire)
|
|
(shoot $ aTractorBeam ((col + 1) `mod` 10))
|
|
$ over particles (IM.insert i (tractorBeamAt col i pos dir)) w
|
|
where i = newParticleKey w
|
|
cr = (_creatures w IM.! cid)
|
|
pos = _crPos cr +.+ ((_crRad cr +10) *.* unitVectorAtAngle dir)
|
|
dir = _crDir cr
|
|
itRef = _crInvSel cr
|
|
|
|
aRocket :: Int -> World -> World
|
|
aRocket cid w
|
|
= soundOnce (fromIntegral launcherSound)
|
|
$ over particles (IM.insert i (makeShellAt i cid pos dir)) w
|
|
where i = newParticleKey w
|
|
cr = (_creatures w IM.! cid)
|
|
pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
|
|
dir = _crDir cr
|
|
|
|
makeShellAt :: Int -> Int -> Point2 -> Float -> Particle
|
|
makeShellAt i cid pos dir = Particle
|
|
{ _ptPos = pos
|
|
, _ptStartPos = pos
|
|
, _ptVel = rotateV dir (1,0)
|
|
, _ptPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic
|
|
, _ptID = i
|
|
, _ptUpdate = moveShell 50 i cid 0 (rotateV dir (2,0))
|
|
}
|
|
|
|
moveShell :: Int -> Int -> Int -> Float -> Point2 -> World -> World
|
|
moveShell time i cid rot accel w
|
|
| time > 40 = if circOnSomeWall oldPos 4 w
|
|
then shellExplosionAt oldPos $ over particles (IM.delete i) w
|
|
else over (particles . ix i . ptPos) (+.+ vel)
|
|
$ set (particles . ix i . ptPict) piclow
|
|
$ set (particles . ix i . ptUpdate)
|
|
(moveShell (time-1) i cid rot (rotateV rot accel))
|
|
w
|
|
| time == 35 = case thingHit of
|
|
Just p -> shellExplosionAt oldPos
|
|
$ over particles (IM.delete i) w
|
|
Nothing -> over (particles . ix i . ptPos) (+.+ vel)
|
|
$ set (particles . ix i . ptPict) pic
|
|
$ set (particles . ix i . ptUpdate)
|
|
(moveShell (time-1) i cid spin accel)
|
|
w
|
|
| time >= 20 = case thingHit of
|
|
Just p -> shellExplosionAt oldPos
|
|
$ over particles (IM.delete i) w
|
|
Nothing -> over (particles . ix i . ptPos) (+.+ vel)
|
|
$ set (particles . ix i . ptPict) pic
|
|
$ set (particles . ix i . ptUpdate)
|
|
(moveShell (time-1) i cid rot (rotateV rot accel))
|
|
w
|
|
| time > -99
|
|
= case thingHit of
|
|
Just p -> shellExplosionAt oldPos
|
|
$ stopSoundFrom (ShellSound i)
|
|
$ over particles (IM.delete i) w
|
|
Nothing -> over (particles . ix i . ptPos) (+.+ vel)
|
|
$ set randGen g
|
|
$ set (particles . ix i . ptPict) pic
|
|
$ set (particles . ix i . ptUpdate)
|
|
(moveShell (time-1) i cid rot (rotateV rot accel))
|
|
$ over (particles . ix i . ptVel) (\v -> accel +.+ frict *.* v)
|
|
$ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250
|
|
$ makeFlameletTimed oldPos
|
|
(0.5 *.* rotateV (pi+sparkD) accel) (levLayer UPtLayer) Nothing 3 20
|
|
$ makeFlameletTimed (0.5 *.* (newPos +.+ oldPos))
|
|
(0.5 *.* rotateV (pi+sparkD) accel) (levLayer UPtLayer) Nothing 3 20
|
|
$ smokeGen
|
|
w
|
|
| time > -200 = case thingHit of
|
|
Just p -> shellExplosionAt oldPos
|
|
$ stopSoundFrom (ShellSound i)
|
|
$ over particles (IM.delete i) w
|
|
Nothing -> over (particles . ix i . ptPos) (+.+ vel)
|
|
$ set (particles . ix i . ptPict) pic
|
|
$ set (particles . ix i . ptUpdate)
|
|
(moveShell (time-1) i cid rot (rotateV rot accel))
|
|
w
|
|
| otherwise = shellExplosionAt oldPos
|
|
$ stopSoundFrom (ShellSound i)
|
|
$ over particles (IM.delete i) w
|
|
where pt = _particles w IM.! i
|
|
oldPos = _ptPos pt
|
|
vel = _ptVel pt
|
|
newPos = oldPos +.+ vel
|
|
(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) shellPic
|
|
piclow = onLayerL [levLayer CrLayer - 2]
|
|
$ uncurry translate newPos $ rotate (argV accel) shellPic
|
|
hitCr = fmap fst $ collideCircCrsPoint oldPos newPos 4 w
|
|
hitWl = fmap fst $ collideCircWalls' oldPos newPos 2 $ wallsNearPoint newPos w
|
|
thingHit = hitCr <|> hitWl
|
|
spin = case w ^? creatures . ix cid of
|
|
Just cr -> min 0.1 $ max (-0.1)
|
|
$ (normalizeAnglePi (dir - _crDir cr)) / 20
|
|
_ -> 0
|
|
(v1:v2:v3:_) = fst $ runState ((sequence . repeat . randInCirc) 0.1) $ _randGen w
|
|
(r1:r2:r3:_) = map ((*.*) 100) (v2:v3:v1:[])
|
|
(t1:t2:t3:_) = randomRs ( 15,20) $ _randGen w
|
|
(s1:s2:s3:_) = map (\s -> fromIntegral s * 0.1 - 1) (t3:t2:t1:[])
|
|
-- ((r1:r2:r3:_),_) = runState ((sequence . repeat . randInCirc) 10) $ _randGen w
|
|
-- v1 = fst $ runState (randInCirc 0.5) $ _randGen w
|
|
smokeGen = makeSmokeAt'' v1 s1 t1 (newPos +.+ r1)
|
|
. makeSmokeAt'' v2 s2 t2 (newPos +.+ r2)
|
|
-- . makeSmokeAt'' v3 s3 t3 (newPos +.+ r3)
|
|
|
|
|
|
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
|
|
|
|
tractorBeamAt :: Int -> Int -> Point2 -> Float -> Particle
|
|
tractorBeamAt colID i pos dir = Particle
|
|
{ _ptPos = pos
|
|
, _ptStartPos = p'
|
|
, _ptVel = d
|
|
, _ptPict = blank
|
|
, _ptID = i
|
|
, _ptUpdate = updateTractor colID 10 i
|
|
}
|
|
where d = unitVectorAtAngle dir
|
|
p' = pos +.+ 400 *.* d
|
|
|
|
spreadNumVelWthHiteff' :: Float -> Int -> Point2 -> Float -> HitEffect' -> Int -> World -> World
|
|
spreadNumVelWthHiteff' spread num vel wth eff cid w
|
|
= over particles' (newbuls ++)
|
|
$ flip (foldr muzFlareAt) poss
|
|
w
|
|
where cr = _creatures w IM.! cid
|
|
newbuls = zipWith3 (\pos d colid -> aGenBulAt' (Just cid) (numColor colid)
|
|
pos (rotateV d vel) eff wth
|
|
) poss dirs colids
|
|
pos' = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
|
|
poss = map ((+.+) $ _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr))
|
|
$ evalState ((sequence . take num . repeat . randInCirc) 5) $ _randGen w
|
|
dirs = map ((+) (_crDir cr))
|
|
$ zipWith (+) [-spread,-spread+(2*spread/(fromIntegral num))..]
|
|
$ randomRs (0,spreadGunSpread/5) (_randGen w)
|
|
colids = take num $ randomRs (0,11) (_randGen w)
|
|
|
|
numVelWthHitEff' :: Int -> Point2 -> Float -> HitEffect' -> Int -> World -> World
|
|
numVelWthHitEff' num vel wth eff cid w
|
|
= over particles' (newbuls ++)
|
|
$ flip (foldr muzFlareAt) (take num poss)
|
|
w
|
|
where cr = _creatures w IM.! cid
|
|
newbuls = zipWith (\pos colid -> aGenBulAt' (Just cid) (numColor colid)
|
|
pos (rotateV d vel) eff wth)
|
|
poss colids
|
|
d = _crDir cr
|
|
poss = map (\o -> o +.+ pos) offsets
|
|
maxOffset = fromIntegral num * 2.5 - 2.5
|
|
offsets = map (\y -> rotateV d (0,y)) [-maxOffset,5-maxOffset..]
|
|
colids = take num $ randomRs (0,11) (_randGen w)
|
|
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle d
|
|
pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
|
|
|
|
aGasCloud :: Int -> World -> World
|
|
aGasCloud cid w
|
|
= -- soundFrom Flame fireSound 2 500
|
|
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) +.+ 4 *.* unitVectorAtAngle dir
|
|
insertCloud = makeGasCloud pos vel -- . makeFlame pos2 vel (Just cid)
|
|
|
|
makeGasCloud :: Point2 -> Point2 -> World -> World
|
|
makeGasCloud pos vel w = over clouds (IM.insert i theCloud)
|
|
$ set randGen g w
|
|
where i = newKey $ _clouds w
|
|
theCloud = Cloud { _clID = i
|
|
, _clPos = pos
|
|
, _clVel = vel
|
|
, _clPict = \_ -> onLayer CrLayer $ color (withAlpha 0.1 col)
|
|
$ circleSolid 20
|
|
, _clRad = 20
|
|
, _clTimer = 200
|
|
, _clEffect = cloudPoisonDamage
|
|
}
|
|
(col, g) = runState (takeOne [green,yellow]) $ _randGen w
|
|
|
|
cloudPoisonDamage :: Cloud -> World -> World
|
|
cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedCrs
|
|
where damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint (_clPos c) w
|
|
f cr = dist (_crPos cr) (_clPos c) < _crRad cr + _clRad c
|
|
doDam cr = cr & crState . crDamage %~ (:) (PoisonDam 1)
|
|
|
|
aFlame :: Float -> Int -> World -> World
|
|
aFlame a cid w
|
|
= shakeCr cid 2
|
|
$ soundFrom Flame fireSound 2 500
|
|
$ insertFlame $ resetAngle $ set randGen g $
|
|
w
|
|
where
|
|
(a2,g) = randomR (-0.1,0.1) (_randGen w)
|
|
angle = min flamerAngle $ max (-flamerAngle) (a + a2)
|
|
cr = (_creatures w IM.! cid)
|
|
dir = _crDir cr + angle
|
|
pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
|
|
pos2 = (0.5 *.* vel) +.+
|
|
_crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
|
|
w1 = set randGen g w
|
|
i = newParticleKey w1
|
|
-- vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir
|
|
vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir
|
|
insertFlame = makeFlame pos vel (Just cid) -- . makeFlame pos2 vel (Just cid)
|
|
resetAngle = set (creatures . ix cid . crInv . ix (_crInvSel cr) . wpFire)
|
|
(shoot $ aFlame angle)
|
|
|
|
makeFlame :: Point2 -> Point2 -> Maybe Int -> World -> World
|
|
makeFlame pos vel maycid = over particles' ((:) theFlame)
|
|
where theFlame =
|
|
Pt' { _ptPict' = blank
|
|
, _ptUpdate' = moveFlame vel
|
|
, _btVel' = vel
|
|
, _btColor' = red
|
|
, _btPos' = pos
|
|
, _btPassThrough' = maycid
|
|
, _btWidth' = 4
|
|
, _btTimer' = 100
|
|
, _btHitEffect' = threeEff' (doFlameDam 1) noEff noEff
|
|
}
|
|
|
|
moveFlame :: Point2 -> World -> Particle' -> (World, Maybe Particle')
|
|
moveFlame rotd w pt =
|
|
case _btTimer' pt of
|
|
time | time <= 0 -> (smokeGen w, Nothing)
|
|
| otherwise ->
|
|
case thingsHitExceptCr (_btPassThrough' pt) sp ep w of
|
|
-- ((p,(E3x1 cr)):_) -> (damcr cr p $ smokeGen damcrs, Nothing)
|
|
((p,(E3x1 cr)):_)
|
|
-> (soundFrom Flame fireSound 2 500
|
|
$ over worldEvents ((.) $ lowLightRadAt orange 0.05 8 50 ep)
|
|
damcrs
|
|
, mvPt')
|
|
(thing@(p,(E3x2 wl)):_) -> (hiteff thing damcrs, rfl wl p)
|
|
_ -> (soundFrom Flame fireSound 2 500
|
|
-- adding reflective glare is too intensive for this laptop
|
|
$ over worldEvents ((.) $ lowLightRadAt orange 0.05 8 50 ep)
|
|
damcrs
|
|
, mvPt)
|
|
where sp = _btPos' pt
|
|
vel = _btVel' pt
|
|
ep = sp +.+ vel
|
|
mvPt = Just $ pt {_btTimer' = time - 1, _btPos' = ep, _ptPict' = thepic ep
|
|
, _btPassThrough' = Nothing
|
|
,_btVel' = 0.98 *.* vel}
|
|
mvPt' = Just $ pt {_btTimer' = time - 1, _btPos' = ep, _ptPict' = thepic ep
|
|
, _btPassThrough' = Nothing
|
|
,_btVel' = 0.7 *.* vel}
|
|
damcrs = foldr ($) w $ map (\cr -> hiteff (ep,E3x1 cr)) $ filter closeCrs
|
|
$ IM.elems $ _creatures w
|
|
closeCrs cr = dist ep (_crPos cr)
|
|
< _crRad cr + 10 - min 9 (max 0 (fromIntegral time - 80))
|
|
+ 5 * angleCoeff (angleVV (ep -.- _crPos cr) rotd)
|
|
angleCoeff x = abs $ 1 - (abs $ (x * 2 - pi) / (pi))
|
|
damcr cr p = over (creatures . ix (_crID cr) . crState . crDamage)
|
|
((:) $ Flaming (div time 10) sp p ep)
|
|
hiteff = _btHitEffect' pt pt
|
|
thepic p' = pictures $ reverse [ pic p' , piu p' , pi2 p' , glow p' ]
|
|
pic p' = onLayerL [levLayer UPtLayer,6] $ uncurry translate (prot3 p')
|
|
$ rotate (pi * 0.5 + argV rotd)
|
|
$ scale scaleChange 1
|
|
-- $ color white
|
|
-- $ circleSolid 5
|
|
$ pictures $ reverse [color white $ circleSolid 4
|
|
,color (withAlpha 0.5 white) $ circleSolid 5
|
|
]
|
|
-- $ rotate (radToDeg (fromIntegral time * 10))
|
|
-- $ polygon [(-5,-2),(5,-2),(5,2),(-5,2)]
|
|
pi2 p' = onLayerL [levLayer UPtLayer,4] $ uncurry translate (prot p')
|
|
-- $ rotate ( (fromIntegral time * 5))
|
|
$ rotate (pi * 0.5 + argV rotd)
|
|
-- $ color (mixColors 0.5 0.5 orange white)
|
|
-- $ polygon [(-6,-6),(6,-6),(6,6),(-6,6)]
|
|
$ scale (scaleChange + 0.5) 1.5
|
|
$ pictures $ reverse [color orange $ circleSolid 4.5
|
|
,color (withAlpha 0.5 orange) $ circleSolid 5
|
|
]
|
|
-- $ color orange
|
|
-- $ circleSolid 5
|
|
prot p' = p' +.+ rotateV (fromIntegral time * 1) (0,1)
|
|
prot2 p' = p' +.+ rotateV (negate $ fromIntegral time * 1) (0,1)
|
|
prot3 p' = p' +.+ rotateV (2 + fromIntegral time * 0.1) (0,2)
|
|
piu p' = onLayerL [levLayer UPtLayer,2] $ uncurry translate (prot2 p')
|
|
$ rotate (pi*0.5 + argV rotd)
|
|
-- $ rotate ((fromIntegral time * (-10)))
|
|
$ scale (scaleChange + 1) 2
|
|
$ pictures $ reverse [color red $ circleSolid 4.5
|
|
,color (withAlpha 0.5 red) $ circleSolid 5
|
|
]
|
|
-- $ color (dark red)
|
|
-- $ circleSolid 5
|
|
-- $ polygon [(-8,-8),(8,-8),(8,8),(-8,8) ]
|
|
rfl wl p = Just $ pt {_btTimer' = time -1, _btPos' = pOut p
|
|
, _btVel' = reflV wl, _ptPict' = thepic $ pOut p
|
|
}
|
|
glow p' = onLayerL [levLayer UPtLayer,0] $ uncurry translate p'
|
|
$ color (withAlpha 0.02 orange)
|
|
$ circleSolid 50
|
|
pOut p = p +.+ safeNormalizeV (sp -.- p)
|
|
--reflV wall = (0.6 *.* reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0)
|
|
-- vel )
|
|
-- +.+
|
|
-- (0.4 *.* vel)
|
|
reflV wall = (0.3 *.* reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0)
|
|
vel )
|
|
+.+
|
|
(0.2 *.* vel)
|
|
scaleChange | time < 80 = 3
|
|
| otherwise = 3 - (fromIntegral time - 80) * 0.2
|
|
g = _randGen w
|
|
tms = randomRs (15,20) g
|
|
scs = randomRs (0.1,0.5) g
|
|
(rs,g1) = runState ((sequence . take 5 . repeat . randInCirc) 20) $ _randGen w
|
|
f sc tm r = makeColorSmokeAt (greyN 0.3) (0.5 *.* vel) sc tm (ep +.+ r)
|
|
smokeGen w = set randGen g1 $ foldr ($) w (zipWith3 f scs tms rs)
|
|
|
|
|
|
flamerAngle = 0.3
|
|
|
|
aSelf :: Int -> World -> World
|
|
aSelf = blinkAction
|
|
|
|
withAccVelWthHiteff' :: Float -> Point2 -> Float -> HitEffect' -> Int -> World -> World
|
|
withAccVelWthHiteff' acc vel width hiteff cid w
|
|
= over particles' ((:) newbul)
|
|
. over tempLightSources ((:) (tLightAt 4 pos))
|
|
. lowLightAt pos2
|
|
$ set randGen g
|
|
w
|
|
where cr = _creatures w IM.! cid
|
|
newbul = aGenBulAt' (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width
|
|
(colid, g) = randomR (0,11) $ _randGen w
|
|
(a, _) = randomR (-acc,acc) $ _randGen w
|
|
dir = _crDir cr + a
|
|
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
|
|
pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
|
|
|
|
withOffsetAccVelWthHiteff' :: Float -> Float -> Point2 -> Float -> HitEffect' -> Int -> World -> World
|
|
withOffsetAccVelWthHiteff' offsetAmount acc vel width hiteff cid w
|
|
= over particles' ((:) newbul )
|
|
$ muzFlareAt pos
|
|
$ set randGen g
|
|
w
|
|
where cr = _creatures w IM.! cid
|
|
newbul = aGenBulAt' (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width
|
|
(colid, g) = randomR (0,11) $ _randGen w
|
|
(a, _) = randomR (-acc,acc) $ _randGen w
|
|
dir = _crDir cr + a
|
|
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) +.+ offset
|
|
(offsetVal , _) = randomR (-offsetAmount,offsetAmount) $ _randGen w
|
|
offset = rotateV (_crDir cr) (0,offsetVal)
|
|
|
|
torqueBeforeForced :: Float -> (Int -> World -> World) -> Int -> World -> World
|
|
torqueBeforeForced torque feff cid w
|
|
| cid == 0 = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot')
|
|
$ over cameraRot (+rot') w
|
|
| otherwise = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot') w
|
|
where (rot, g) = randomR (-torque,torque) $ _randGen w
|
|
rot' | rot < 0 = rot - 0.1
|
|
| otherwise = rot + 0.1
|
|
|
|
torqueBefore :: Float -> (Int -> World -> World) -> Int -> World -> World
|
|
torqueBefore torque feff cid w
|
|
| cid == 0 = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot)
|
|
$ over cameraRot (+rot) w
|
|
| otherwise = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot) w
|
|
where (rot, g) = randomR (-torque,torque) $ _randGen w
|
|
|
|
torqueAfter :: Float -> (Int -> World -> World) -> Int -> World -> World
|
|
torqueAfter torque feff cid w
|
|
| cid == 0 = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff cid w
|
|
| otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) $ feff cid w
|
|
where (rot, g) = randomR (-torque,torque) $ _randGen w
|
|
rotateScope w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
|
. itAttachment . _Just . scopePos %~ rotateV rot
|
|
|
|
aGenBulAt' :: Maybe Int -> Color -> Point2 -> Point2 -> HitEffect' -> Float -> Particle'
|
|
aGenBulAt' maycid col pos vel hiteff width = Bul'
|
|
{ _ptPict' = blank
|
|
, _ptUpdate' = mvGenBullet'
|
|
, _btVel' = vel
|
|
, _btColor' = col
|
|
, _btTrail' = [pos]
|
|
, _btPassThrough' = maycid
|
|
, _btWidth' = width
|
|
, _btTimer' = 90
|
|
, _btHitEffect' = hiteff
|
|
}
|
|
|
|
-- bullet effects
|
|
bulHitCr' :: Particle' -> Point2 -> Creature -> World -> World
|
|
bulHitCr' bt p cr w =
|
|
let sp = head $ _btTrail' bt
|
|
ep = sp +.+ _btVel' bt
|
|
-- mvDams = [TorqueDam 1 d1 , PushDam 1 $ 2 *.* (ep -.- sp) ]
|
|
mvDams = [ PushDam 1 $ 2 *.* (ep -.- sp) ]
|
|
addDamage = over (creatures . ix cid . crState . crDamage)
|
|
(\dams -> (Piercing 100 sp p ep : mvDams) ++ dams)
|
|
addDamageArmoured = over (creatures . ix cid . crState . crDamage)
|
|
(\dams -> mvDams ++ dams)
|
|
hitSound = soundMultiFrom [CrHitSound 0] 15 10 0
|
|
flashEff = over worldEvents ((.) $ flareAt red p)
|
|
bulVel = ep -.- sp
|
|
ck cid = (+.+) (crKnockBack cid *.* bulVel)
|
|
crKnockBack cid = (/) 1 $ (+) 2 $ _crMass $ _creatures w IM.! cid
|
|
hasArmour cr = any (\it -> it ^? itIdentity == Just FrontArmour) $ _crInv cr
|
|
cid = _crID cr
|
|
sID = newParticleKey w
|
|
(d1,g) = randomR (-0.7,0.7) $ _randGen w
|
|
(colID,_) = randomR (0,11) $ _randGen w
|
|
hitEffect = addDamage . hitSound . flashEff $ w
|
|
in case hasArmour cr of --shit this is ugly, to refactor
|
|
True -> if hitBack
|
|
then hitEffect
|
|
else createSpark 8 colID p1
|
|
(argV (p -.- _crPos (_creatures w IM.! cid)) + d1)
|
|
Nothing
|
|
. addDamageArmoured
|
|
$ w
|
|
where cpos = _crPos $ _creatures w IM.! cid
|
|
relHitPos = p -.- cpos
|
|
hitBack = errorAngleVV 19 (unitVectorAtAngle (_crDir $ _creatures w IM.! cid))
|
|
relHitPos
|
|
> pi/2
|
|
p1 = p +.+ 2 *.* safeNormalizeV relHitPos
|
|
_ -> hitEffect
|
|
|
|
bulPenCr' :: Particle' -> Point2 -> Creature -> World -> World
|
|
bulPenCr' bt p cr w
|
|
= over (creatures . ix cid . crState . crDamage)
|
|
(\dams -> [Piercing 50 sp p ep
|
|
,Blunt 50 sp p ep
|
|
,TorqueDam 1 d1
|
|
,PushDam 1 $ 3 *.* (ep -.- sp)
|
|
] ++ dams
|
|
)
|
|
$ soundMultiFrom [CrHitSound 0] 15 10 0
|
|
$ over worldEvents addPiercer
|
|
w
|
|
where (d1,g) = randomR (-0.7,0.7) $ _randGen w
|
|
cid = _crID cr
|
|
sp = head $ _btTrail' bt
|
|
ep = sp +.+ _btVel' bt
|
|
addPiercer = (.) $ over particles' ((:) piercer)
|
|
piercer = (aGenBulAt' (Just cid) (_btColor' bt) p (_btVel' bt)
|
|
(_btHitEffect' bt) (_btWidth' bt)
|
|
) {_btTimer' = _btTimer' bt - 1}
|
|
|
|
hvBulHitCr' :: Particle' -> Point2 -> Creature -> World -> World
|
|
hvBulHitCr' bt p cr w
|
|
= over (creatures . ix cid . crState . crDamage)
|
|
(\dams -> [Piercing 200 sp p ep
|
|
,Blunt 100 sp p ep
|
|
,TorqueDam 1 d1
|
|
,PushDam 1 $ 3 *.* (ep -.- sp)
|
|
] ++ dams
|
|
)
|
|
$ soundMultiFrom [CrHitSound 0] 15 10 0
|
|
w
|
|
where (d1,g) = randomR (-0.7,0.7) $ _randGen w
|
|
cid = _crID cr
|
|
sp = head $ _btTrail' bt
|
|
ep = sp +.+ _btVel' bt
|
|
|
|
bulIncCr' :: Particle' -> Point2 -> Creature -> World -> World
|
|
bulIncCr' bt p cr w
|
|
= over (creatures . ix cid . crState . crDamage)
|
|
(\dams -> [Piercing 60 sp p ep
|
|
] ++ dams
|
|
)
|
|
$ soundMultiFrom [CrHitSound 0] 15 10 0
|
|
$ incFlamelets
|
|
w
|
|
where cid = _crID cr
|
|
sp = head $ _btTrail' bt
|
|
ep = sp +.+ _btVel' bt
|
|
v = evalState (randInCirc 1) $ _randGen w
|
|
incFlamelets = over worldEvents $ (.) (makeFlamelet p v (levLayer UPtLayer) Nothing 3)
|
|
|
|
bulConCr' :: Particle' -> Point2 -> Creature -> World -> World
|
|
bulConCr' bt p cr w
|
|
= over (creatures . ix cid . crState . crDamage)
|
|
(\dams -> [Piercing 60 sp p ep
|
|
] ++ dams
|
|
)
|
|
$ soundMultiFrom [CrHitSound 0] 15 10 0
|
|
$ mkwave
|
|
w
|
|
where cid = _crID cr
|
|
sp = head $ _btTrail' bt
|
|
ep = sp +.+ _btVel' bt
|
|
mkwave = over worldEvents $ (.) (makeShockwaveAt p 15 4 1 white)
|
|
|
|
|
|
|
|
bulHitWall' :: Particle' -> Point2 -> Wall -> World -> World
|
|
bulHitWall' bt p x w = damageBlocks x
|
|
$ createSpark 8 colID pOut (reflectDir x) Nothing
|
|
$ set randGen g
|
|
w
|
|
where sp = head $ _btTrail' bt
|
|
pOut = p +.+ safeNormalizeV (sp -.- p)
|
|
(colID,g) = randomR (0,11) $ _randGen w
|
|
(a, _) = randomR (-0.1,0.1) $ _randGen w
|
|
spid = newKey $ _particles w
|
|
reflectDir wall = a + (argV $ reflectIn
|
|
(_wlLine wall !! 1 -.- _wlLine wall !! 0)
|
|
(p -.- sp)
|
|
)
|
|
damageBlocks wall w
|
|
= case wall ^? blHP of
|
|
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
|
|
_ -> w
|
|
|
|
bulBounceWall' :: Particle' -> Point2 -> Wall -> World -> World
|
|
bulBounceWall' bt p wl w = damageBlocks wl
|
|
$ over worldEvents addBouncer
|
|
-- yay for hack -- should have used this before? or never?
|
|
w
|
|
where sp = head $ _btTrail' bt
|
|
pOut = p +.+ safeNormalizeV (sp -.- p)
|
|
damageBlocks wall w
|
|
= case wall ^? blHP of
|
|
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
|
|
_ -> w
|
|
bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel
|
|
(_btHitEffect' bt) (_btWidth' bt)
|
|
) {_btTimer' = _btTimer' bt - 1}
|
|
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0)
|
|
reflectVel = (reflectIn wallV (_btVel' bt))
|
|
addBouncer = (.) (over particles' ((:) bouncer))
|
|
-- the hack is to get around the fact that the particles' list gets reset after
|
|
-- all particles in it are checked, so we cannot add to it as we accumulate over
|
|
-- this list
|
|
|
|
bulIncWall' :: Particle' -> Point2 -> Wall -> World -> World
|
|
bulIncWall' bt p wl w = damageBlocks wl
|
|
$ incFlamelets
|
|
-- yay for hack -- should have used this before? or never?
|
|
w
|
|
where sp = head $ _btTrail' bt
|
|
pOut = p +.+ safeNormalizeV (sp -.- p)
|
|
damageBlocks wall w
|
|
= case wall ^? blHP of
|
|
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
|
|
_ -> w
|
|
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0)
|
|
reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt)
|
|
incFlamelets = over worldEvents $ (.) (makeFlamelet pOut reflectVel (levLayer UPtLayer) Nothing 3)
|
|
|
|
bulConWall' :: Particle' -> Point2 -> Wall -> World -> World
|
|
bulConWall' bt p wl w = damageBlocks wl
|
|
$ mkwave
|
|
-- yay for hack -- should have used this before? or never?
|
|
w
|
|
where sp = head $ _btTrail' bt
|
|
pOut = p +.+ safeNormalizeV (sp -.- p)
|
|
damageBlocks wall w
|
|
= case wall ^? blHP of
|
|
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
|
|
_ -> w
|
|
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0)
|
|
mkwave = over worldEvents $ (.) (makeShockwaveAt p 15 4 1 white)
|
|
|
|
hvBulHitWall' :: Particle' -> Point2 -> Wall -> World -> World
|
|
hvBulHitWall' bt p x w = damageBlocks x
|
|
$ set randGen g
|
|
$ foldr ($) w (sparks pOut sv)
|
|
where sp = head $ _btTrail' bt
|
|
pOut = p +.+ safeNormalizeV (sp -.- p)
|
|
(a, g) = randomR (-0.1,0.1) $ _randGen w
|
|
spid = newKey $ _particles w
|
|
reflectDir wall = a + (argV $ reflectIn
|
|
(_wlLine wall !! 1 -.- _wlLine wall !! 0)
|
|
(p -.- sp)
|
|
)
|
|
sv = unitVectorAtAngle $ reflectDir x
|
|
damageBlocks wall w
|
|
= case wall ^? blHP of
|
|
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 20)) w (_blIDs wall)
|
|
_ -> w
|
|
sID = newParticleKey w
|
|
cs = take 10 $ randomRs (0,11) $ _randGen w
|
|
ds = randomRs (-0.7,0.7) $ _randGen w
|
|
ts = randomRs (4,8) $ _randGen w
|
|
sparks pos vel = zipWith3 (\t c d -> createSpark t c pos (argV vel + d) Nothing) ts cs ds
|
|
bulHitFF' :: Particle' -> Point2 -> ForceField -> World -> World
|
|
bulHitFF' _ _ _ = id
|
|
|
|
bulletEffect' :: HitEffect'
|
|
bulletEffect' = threeEff' bulHitCr' bulHitWall' bulHitFF'
|
|
|
|
bulletParticleSideEffect :: Particle' -> HitEffect'
|
|
bulletParticleSideEffect pt = threeEff' mkPt mkPt noEff
|
|
where mkPt _ p _ = over particles' ((:) pt {_btTrail' = [p]})
|
|
|
|
reflect :: Float -> Float -> Float
|
|
reflect a b = a + 2*(a-b)
|
|
|
|
moveGrenade :: Int -> Float -> Int -> World -> World
|
|
moveGrenade 0 dir pID w = over particles (IM.delete pID)
|
|
$ makeExplosionAt (_ptPos (_particles w IM.! pID))
|
|
-- $ set (pointToItem (_itemPositions w IM.! wpID) . itEquipPict)
|
|
-- (drawWeapon $ grenadePic 50)
|
|
w
|
|
moveGrenade time dir pID w
|
|
= case hitWl of
|
|
Just _ -> soundOnce (fromIntegral tapQuiet) updatedWorld
|
|
_ -> updatedWorld
|
|
where
|
|
updatedWorld = updateV $ set (particles . ix pID . ptPos) finalPos
|
|
$ set (particles.ix pID.ptPict)
|
|
(onLayer PtLayer $ uncurry translate newPos
|
|
$ rotate dir $ grenadePic time)
|
|
$ set (particles.ix pID.ptUpdate) (moveGrenade (time-1) dir pID) w
|
|
pt = _particles w IM.! pID
|
|
oldPos = _ptPos pt
|
|
newPos = _ptVel pt +.+ oldPos
|
|
hitWl = collideCircWalls' oldPos newPos 4 $ wallsNearPoint newPos w
|
|
finalPos = fromMaybe newPos (fmap fst hitWl)
|
|
setV v = set (particles.ix pID.ptVel) v
|
|
updateV = fromMaybe id (fmap (setV.snd) hitWl)
|
|
|
|
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 ptid w
|
|
= set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos)
|
|
(0,0)
|
|
$ set (pointToItem (_itemPositions w IM.! itid) . wpFire)
|
|
fireRemoteLauncher
|
|
(w & particles %~ IM.delete ptid)
|
|
retireRemoteRocket itid t ptid w = setScope w & particles . ix ptid . ptUpdate .~ retireRemoteRocket itid (t-1) ptid
|
|
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 ^? particles . ix ptid . ptPos
|
|
|
|
retireRemoteBomb :: Int -> Int -> Int -> World -> World
|
|
retireRemoteBomb itid 0 ptid w
|
|
= set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos)
|
|
(0,0)
|
|
$ set (pointToItem (_itemPositions w IM.! itid) . itZoom)
|
|
basicItZoom
|
|
$ set (pointToItem (_itemPositions w IM.! itid) . twFire)
|
|
throwRemoteBomb
|
|
(w & particles %~ IM.delete ptid)
|
|
retireRemoteBomb itid t ptid w
|
|
= setScope w & particles . ix ptid . ptUpdate .~ retireRemoteBomb itid (t-1) ptid
|
|
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 ^? particles . ix ptid . ptPos
|
|
|
|
moveRemoteBomb :: Int -> Int -> Int -> World -> World
|
|
moveRemoteBomb itid time pID w
|
|
| time < -4 = setScope
|
|
$ updatePicture
|
|
$ set (particles.ix pID.ptUpdate) (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 (particles . ix pID . ptPos) finalPos
|
|
$ updatePicture
|
|
$ set (particles.ix pID.ptUpdate) (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
|
|
.~ (basicItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5})
|
|
_ -> w'
|
|
pt = _particles w IM.! pID
|
|
oldPos = _ptPos pt
|
|
newPos = _ptVel pt +.+ oldPos
|
|
-- this is hacky, should use a version of collidePointWalls' that collides
|
|
-- circles and walls
|
|
invShift x = x -.- 5 *.* normalizeV (_ptVel pt)
|
|
hitWl = collideCircWalls' oldPos newPos 4 $ wallsNearPoint newPos w
|
|
finalPos = fromMaybe newPos (fmap (invShift . fst) hitWl)
|
|
setV v = set (particles.ix pID.ptVel) v
|
|
updateV = fromMaybe id (fmap (setV.snd) hitWl)
|
|
halfV = over (particles . ix pID . ptVel) (\v -> 0.5 *.* v)
|
|
f x | x < -369 = -10
|
|
| otherwise = x - 1
|
|
updatePicture = set (particles . ix pID.ptPict)
|
|
(onLayer PtLayer $ uncurry translate newPos
|
|
$ remoteBombPic time)
|
|
. lowLightDirected red 0.1 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]
|
|
|
|
|
|
shootRateIncrease :: Int -> Int -> (Int -> World -> World) -> Int -> World -> World
|
|
shootRateIncrease startRate fastRate shootEffect cid w
|
|
| repeatFire = set (pointItem . wpFireRate) (max fastRate (currentRate - 1))
|
|
$ set (pointItem . wpFireState) currentRate
|
|
$ shootEffect cid
|
|
w
|
|
| firstFire = set (pointItem . wpFireRate) (startRate - 1)
|
|
$ set (pointItem . wpFireState) startRate
|
|
$ shootEffect cid
|
|
w
|
|
| reloadCondition = fromMaybe w $ reloadWeapon cid w
|
|
| otherwise = w
|
|
where cr = _creatures w IM.! cid
|
|
itRef = _crInvSel cr
|
|
item = _crInv cr IM.! itRef
|
|
pointItem = (creatures . ix cid . crInv . ix itRef)
|
|
currentRate = _wpFireRate item
|
|
repeatFire = _wpReloadState item == 0
|
|
&& _wpFireState item == 1
|
|
&& _wpLoadedAmmo item > 0
|
|
firstFire = _wpReloadState item == 0
|
|
&& _wpFireState item == 0
|
|
&& _wpLoadedAmmo item > 0
|
|
reloadCondition = _wpLoadedAmmo item == 0
|
|
|
|
rateIncAB :: Int -> Int -> (Int -> World -> World)
|
|
-> (Int -> World -> World)
|
|
-> Int -> World -> World
|
|
rateIncAB startRate fastRate shooteff1 shooteff2 cid w
|
|
| repeatFire = set (pointItem . wpFireRate) (max fastRate (currentRate - 1))
|
|
$ over (pointItem . wpLoadedAmmo) (\ammo -> ammo-1)
|
|
$ set (pointItem . wpFireState) currentRate
|
|
$ shooteff2 cid
|
|
w
|
|
| firstFire = set (pointItem . wpFireRate) (startRate - 1)
|
|
$ over (pointItem . wpLoadedAmmo) (\ammo -> ammo-1)
|
|
$ set (pointItem . wpFireState) startRate
|
|
$ shooteff1 cid
|
|
w
|
|
| reloadCondition = fromMaybe w $ reloadWeapon cid w
|
|
| otherwise = w
|
|
where cr = _creatures w IM.! cid
|
|
itRef = _crInvSel cr
|
|
item = _crInv cr IM.! itRef
|
|
pointItem = (creatures . ix cid . crInv . ix itRef)
|
|
currentRate = _wpFireRate item
|
|
repeatFire = _wpReloadState item == 0
|
|
&& _wpFireState item == 1
|
|
&& _wpLoadedAmmo item > 0
|
|
firstFire = _wpReloadState item == 0
|
|
&& _wpFireState item == 0
|
|
&& _wpLoadedAmmo item > 0
|
|
reloadCondition = _wpLoadedAmmo item == 0
|
|
|
|
|
|
withThinSmoke :: (Int -> World -> World) -> Int -> World -> World
|
|
withThinSmoke eff cid w = eff cid $ foldr ($) w smokeGen
|
|
where
|
|
cr = _creatures w IM.! cid
|
|
dir = _crDir cr
|
|
pos = _crPos cr +.+ ((_crRad cr +0.5) *.* unitVectorAtAngle dir)
|
|
(vs,_) = runState ((sequence . repeat . randInCirc) 0.4) $ _randGen w
|
|
(sps,_) = runState ((sequence . repeat . randInCirc) 8) $ _randGen w
|
|
ts = randomRs (250,1000) $ _randGen w
|
|
ss = take 3 $ randomRs (10,20) $ _randGen w
|
|
smokeGen = zipWith4 (\ v s t sp -> makeThinSmokeAt (greyN 0.1) v s t (pos +.+ sp))
|
|
vs ss ts sps
|
|
|
|
withThickSmoke :: (Int -> World -> World) -> Int -> World -> World
|
|
withThickSmoke eff cid w = eff cid $ foldr ($) w smokeGen
|
|
where
|
|
cr = _creatures w IM.! cid
|
|
dir = _crDir cr
|
|
pos = _crPos cr +.+ ((_crRad cr +0.5) *.* unitVectorAtAngle dir)
|
|
(vs,_) = runState ((sequence . repeat . randInCirc) 0.4) $ _randGen w
|
|
(sps,_) = runState ((sequence . repeat . randInCirc) 8) $ _randGen w
|
|
ts = randomRs (18,20) $ _randGen w
|
|
ss = take 20 $ randomRs (0.1,1) $ _randGen w
|
|
smokeGen = zipWith4 (\ v s t sp -> makeColorSmokeAt (greyN 0.1) v s t (pos +.+ sp))
|
|
vs ss ts sps
|
|
|
|
|
|
makeThinSmokeAt :: Color -> Point2 -> Float -> Int -> Point2 -> World -> World
|
|
makeThinSmokeAt col vel scal time p w = over particles (IM.insert n smP) w
|
|
where n = newParticleKey w
|
|
smP = Particle
|
|
{ _ptPos = p
|
|
, _ptStartPos = p
|
|
, _ptVel = vel
|
|
, _ptPict = onLayer PtLayer $ uncurry translate p $ color col $ circleSolid 1
|
|
, _ptID = n
|
|
, _ptUpdate = moveThinSmoke col scal time n
|
|
}
|
|
|
|
moveThinSmoke :: Color -> Float -> Int -> Int -> World -> World
|
|
moveThinSmoke col scal time i w
|
|
| time > 0
|
|
= set (particles . ix i . ptPict) pic
|
|
. set (particles . ix i . ptUpdate) (moveThinSmoke col scal (time-1) i)
|
|
. set (particles . ix i . ptPos) newPos
|
|
. setVel
|
|
$ w
|
|
| time > -10
|
|
= set (particles . ix i . ptPict) pi1
|
|
. set (particles . ix i . ptUpdate) (moveThinSmoke col scal (time-1) i)
|
|
. set (particles . ix i . ptPos) newPos
|
|
. setVel
|
|
$ w
|
|
| otherwise
|
|
= over particles (IM.delete i) w
|
|
where oldPos = _ptPos $ _particles w IM.! i
|
|
newPos = oldPos +.+ (_ptVel $ _particles w IM.! i)
|
|
setVel = over (particles . ix i . ptVel) $ (*.*) 0.99
|
|
pic = onLayer PtLayer $ uncurry translate newPos $ color (withAlpha 0.1 col) $ circleSolid scal
|
|
pi1 = onLayer PtLayer $ uncurry translate newPos
|
|
$ color (withAlpha (0.1 + fromIntegral time /100) col)
|
|
$ circleSolid $ scal
|
|
|
|
makeLaserAt :: Float -> Point2 -> Float -> Maybe Int -> Particle'
|
|
makeLaserAt phaseV pos dir mcid = Particle'
|
|
{ _ptPict' = blank
|
|
, _ptUpdate' = moveLaser phaseV pos dir mcid
|
|
}
|
|
|
|
moveLaser :: Float -> Point2 -> Float -> Maybe Int -> World -> Particle' -> (World, Maybe Particle')
|
|
moveLaser phaseV pos dir mcid w pt
|
|
= ( set randGen g $ over worldEvents ((.) flares) $ hitSpecific w
|
|
, Just pt {_ptPict' = onLayer PtLayer $ pic
|
|
,_ptUpdate' = ptTimer' 0
|
|
}
|
|
)
|
|
where sp = pos
|
|
xp = sp +.+ 800 *.* unitVectorAtAngle dir
|
|
--thHit = listToMaybe $ filter notSeeThrough $ thingsHitExceptCrLongLine mcid sp xp w
|
|
(a,g) = randomR (-0.7,0.7) $ _randGen w
|
|
reflectDir wall = a + (argV $ reflectIn
|
|
(_wlLine wall !! 1 -.- _wlLine wall !! 0)
|
|
(xp -.- sp)
|
|
)
|
|
notSeeThrough (p,E3x2 wl) = not $ _wlIsSeeThrough wl
|
|
notSeeThrough _ = True
|
|
(colID,_) = randomR (0,11) $ _randGen w
|
|
flares w = foldr (\p w' -> flareAt' yellow 0.01 0.02 p w') w flarePs
|
|
flarePs = zipWith (\x y -> x +.+ 5 *.* normalizeV (y -.- x)) ps $ tail ps
|
|
flarePos p = p +.+ ((a + 0.8) * 3) *.* (normalizeV (sp -.- p))
|
|
f :: [Wall] -> Point2 -> Point2 -> (Maybe (Point2,Either3 Creature Wall ForceField),[Point2])
|
|
f seenWs x y = case listToMaybe $ filter (h' seenWs)
|
|
$ thingsHitExceptCrLongLine Nothing x y w of
|
|
Just (p,E3x2 wl)
|
|
| _wlIsSeeThrough wl -> f' p $ f (wl:seenWs)
|
|
p
|
|
(h x y wl p)
|
|
| otherwise -> (Just (p,E3x2 wl), [p])
|
|
Just (p,obj) -> (Just (p,obj), [p])
|
|
Nothing -> (Nothing, [y])
|
|
f' p (x,ps') = (x,p:ps')
|
|
h x y wl p | isEntering = p +.+ rotateV angleRef normalDist
|
|
| otherwise = p +.+ rotateV angleRef' normalDist'
|
|
where wlNormal = vNormal $ (_wlLine wl !! 1) -.- (_wlLine wl !! 0)
|
|
normalDist = magV (p -.- y) *.* normalizeV wlNormal
|
|
angleInc = piRange $ argV wlNormal - argV (x -.- y)
|
|
angleRef | reflectExternal = angleInc
|
|
| otherwise = asin $ sin angleInc / phaseV
|
|
piRange a | a > pi = a - 2 * pi
|
|
| a > 0 - pi = a
|
|
| otherwise = a + 2 * pi
|
|
isEntering = isLeftOf (x -.- y) ((_wlLine wl !! 1) -.- (_wlLine wl !! 0))
|
|
wlNormal' = vNormal $ (_wlLine wl !! 0) -.- (_wlLine wl !! 1)
|
|
normalDist' = magV (p -.- y) *.* normalizeV wlNormal'
|
|
angleInc' = piRange $ argV wlNormal' - argV (x -.- y)
|
|
angleRef' | reflectInternal = angleInc'
|
|
| otherwise = asin $ phaseV * sin angleInc'
|
|
reflectInternal = 1 < abs (phaseV * sin angleInc')
|
|
reflectExternal = 1 < abs (sin angleInc / phaseV)
|
|
|
|
h' ws (_,E3x2 wl) = not $ any (\w -> _wlID w == _wlID wl) ws
|
|
h' _ _ = True
|
|
(thHit, ps) = f [] sp xp
|
|
hitSpecific
|
|
= case thHit of
|
|
Just (p,E3x1 cr)
|
|
-> over (creatures . ix (_crID cr) . crState . crDamage) ((:) $ Lasering 3 sp p xp)
|
|
. over worldEvents ((.) $ flareAt yellow (flarePos p))
|
|
Just (p,E3x2 wl) -> createSpark 8 colID (p +.+ safeNormalizeV (sp -.- p))
|
|
(reflectDir wl) Nothing
|
|
_ -> id
|
|
pic = case thHit of
|
|
Nothing ->
|
|
pictures [color (withAlpha 0.05 yellow) $ lineOfThickness (a*20+40) (sp:ps)
|
|
,color (withAlpha 0.3 yellow) $ vvThickLine (sp:ps)
|
|
,color (withAlpha 0.9 white) $ vThickLine (sp:ps)
|
|
,fadeLine lp op 0.9 3 white
|
|
,fadeLine lp op 0.3 3 yellow
|
|
,fadeLine lp op 0.05 (a*20+40) yellow
|
|
]
|
|
_ ->
|
|
pictures [color (withAlpha 0.05 yellow) $ lineOfThickness (a*20+40) (sp:ps)
|
|
,color (withAlpha 0.3 yellow) $ vvThickLine (sp:ps)
|
|
,color (withAlpha 0.9 white) $ vThickLine (sp:ps)
|
|
]
|
|
where lp = last ps
|
|
lp' = last $ init (sp:ps)
|
|
op = lp +.+ 50 *.* normalizeV (lp -.- lp')
|
|
|
|
fadeLine :: Point2 -> Point2 -> Float -> Float -> Color -> Picture
|
|
fadeLine sp ep alph width col =
|
|
pictures [color (withAlpha (0.8 * alph) col) $ lineOfThickness width [sp,p 0.25]
|
|
,color (withAlpha (0.6 * alph) col) $ lineOfThickness width [p 0.25,p 0.5]
|
|
,color (withAlpha (0.4 * alph) col) $ lineOfThickness width [p 0.5,p 0.75]
|
|
,color (withAlpha (0.2 * alph) col) $ lineOfThickness width [p 0.75,ep]
|
|
]
|
|
where p x = sp +.+ x *.* (ep -.- sp)
|
|
|
|
closestOfThree :: Point2 -> Maybe (Point2,a) -> Maybe (Point2,b) -> Maybe (Point2,c)
|
|
-> Maybe (Point2, Either3 a b c)
|
|
closestOfThree p x1 x2 x3 = listToMaybe $ sortBy g $ catMaybes [fmap f1 x1,fmap f2 x2,fmap f3 x3]
|
|
where f1 (r1,s1) = (r1, E3x1 s1)
|
|
f2 (r2,s2) = (r2, E3x2 s2)
|
|
f3 (r3,s3) = (r3, E3x3 s3)
|
|
g (x,_) (y,_) = compare (magV (x -.- p)) (magV (y -.- p))
|
|
|
|
grenadeLauncher :: Item
|
|
grenadeLauncher = pistol
|
|
|
|
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 = throwGrenade fuseTime
|
|
, _itAimingSpeed = 1
|
|
, _itAimingRange = 0
|
|
, _itZoom = basicItZoom {_itAimZoomMax = (f fuseTime), _itAimZoomMin = (f fuseTime)}
|
|
, _itEquipPict = drawWeapon $ grenadePic fuseTime
|
|
, _itID = Nothing
|
|
, _itAttachment = Just $ ItFuse fuseTime
|
|
, _itInvColor = white
|
|
, _itInvDisplay = _itName
|
|
, _itEffect = wpRecock
|
|
, _itHammer = HammerUp
|
|
, _itScrollUp = decreaseFuse fuseTime
|
|
, _itScrollDown = increaseFuse fuseTime
|
|
}
|
|
where fuseTime = 50
|
|
f x = 50 / fromIntegral x
|
|
increaseFuse :: Int -> Int -> World -> World
|
|
increaseFuse fuse i w = w & creatures . ix 0 . crInv . ix itRef . itScrollUp .~ decreaseFuse newTime
|
|
& creatures . ix 0 . crInv . ix itRef . itScrollDown .~ increaseFuse newTime
|
|
& creatures . ix 0 . crInv . ix itRef . twFire .~ throwGrenade newTime
|
|
& creatures . ix 0 . crInv . ix itRef . itName .~ "GRENADE " ++ show newTime
|
|
& creatures . ix 0 . crInv . ix itRef . itAttachment .~ Just (ItFuse newTime)
|
|
& creatures . ix 0 . crInv . ix itRef . itZoom
|
|
.~ (basicItZoom {_itAimZoomMax = zm, _itAimZoomMin = zm})
|
|
where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel
|
|
newTime = min (fuse + 5) 90
|
|
zm = 50 / fromIntegral newTime
|
|
|
|
decreaseFuse :: Int -> Int -> World -> World
|
|
decreaseFuse fuse i w = w & creatures . ix 0 . crInv . ix itRef . itScrollUp .~ decreaseFuse newTime
|
|
& creatures . ix 0 . crInv . ix itRef . itScrollDown .~ increaseFuse newTime
|
|
& creatures . ix 0 . crInv . ix itRef . twFire .~ throwGrenade newTime
|
|
& creatures . ix 0 . crInv . ix itRef . itName .~ "GRENADE " ++ show newTime
|
|
& creatures . ix 0 . crInv . ix itRef . itAttachment .~ Just (ItFuse newTime)
|
|
& creatures . ix 0 . crInv . ix itRef . itZoom
|
|
.~ (basicItZoom {_itAimZoomMax = zm, _itAimZoomMin = zm})
|
|
where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel
|
|
newTime = max (fuse - 5) 20
|
|
zm = 50 / fromIntegral newTime
|
|
|
|
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 = throwRemoteBomb
|
|
, _itAttachment = Just $ ItScope (0,0) 0 1 True
|
|
, _itEquipPict = drawWeapon $ remoteBombUnarmedPic
|
|
}
|
|
|
|
|
|
throwGrenade :: Int -> Int -> World -> World
|
|
--throwGrenade n w = rmInvItem n $ over particles addG $ set randGen g w
|
|
throwGrenade fuseTime n w = setWp $ removePict $ over particles addG $ set randGen g w
|
|
where addG = IM.insert i
|
|
$ Particle { _ptPos = p
|
|
, _ptStartPos = p
|
|
, _ptVel = v
|
|
, _ptPict = onLayer PtLayer $ uncurry translate p $ grenadePic 0
|
|
, _ptID = i
|
|
, _ptUpdate = moveGrenade fuseTime dir i
|
|
}
|
|
j = _crInvSel $ _creatures w IM.! n
|
|
removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank
|
|
i = newParticleKey w
|
|
(a, g) = randomR (-grenadeAccA,grenadeAccA::Float) (_randGen w)
|
|
(l, _) = randomR (1 - 2*grenadeAccL,1+grenadeAccL::Float) g
|
|
-- v = 0.02 * l / _cameraZoom w *.* rotateV (a+_cameraRot w) (limitRange $ _mousePos w)
|
|
v' = 1 / (fromIntegral fuseTime * _cameraZoom w) *.* rotateV (_cameraRot w) ( _mousePos w)
|
|
v | magV v' > 6 = 6 *.* normalizeV v'
|
|
| otherwise = v'
|
|
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'
|
|
dir = argV v
|
|
setWp :: World -> World
|
|
setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20
|
|
--maybewpid = w ^? creatures . ix n . crInv . ix j . itID . _Just
|
|
--setWpLocation :: World -> World
|
|
--setWpLocation w' = case maybewpid of
|
|
-- Nothing -> w' & creatures . ix n . crInv . ix j . itID .~ Just newitid
|
|
-- & itemPositions %~ IM.insert newitid (InInv n j)
|
|
-- _ -> w'
|
|
--newitid = newKey $ _itemPositions w
|
|
--wpid = fromMaybe newitid maybewpid
|
|
|
|
throwArmReset :: Int -> ItEffect
|
|
throwArmReset x =
|
|
ItInvEffect {_itInvEffect = f
|
|
,_itEffectCounter = x
|
|
}
|
|
where f cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust counterDown i
|
|
counterDown it | _itEffectCounter (_itEffect it) == 0
|
|
= it & itHammer .~ HammerUp
|
|
& itEquipPict .~ (drawWeapon $ grenadePic 50)
|
|
| otherwise = it & itEffect . itEffectCounter %~ (\x -> x - 1)
|
|
|
|
(grenadeAccL, grenadeAccA) = (0.1, 0.1)
|
|
|
|
grenadePic :: Int -> Picture
|
|
grenadePic x = pictures [ color (dark $ dark green) $ circleSolid 5
|
|
, color green $ arc
|
|
((179 * fromIntegral x / 50) - 180 )
|
|
(180 - (179 * fromIntegral x / 50) )
|
|
5
|
|
, translate (-2) 2 $ rotate (pi*0.5)
|
|
$ scale 0.05 0.05 $ color green $ text $ show $ 1 + quot x 20
|
|
]
|
|
|
|
fireRemoteLauncher :: Int -> World -> World
|
|
fireRemoteLauncher cid w = setLocation $ resetFire $ resetName
|
|
$ soundOnce (fromIntegral launcherSound)
|
|
$ over particles remRocket w
|
|
where
|
|
i = newKey $ _particles w
|
|
cr = _creatures w IM.! cid
|
|
dir = _crDir cr
|
|
pos = _crPos cr +.+ rotateV dir (_crRad cr + 1,0)
|
|
remRocket = IM.insert i $ Particle { _ptPos = pos
|
|
, _ptStartPos = pos
|
|
, _ptVel = rotateV dir (1,0)
|
|
, _ptPict = blank
|
|
, _ptID = i
|
|
, _ptUpdate = 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) $ 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 .~ Just 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 (particles . ix i . ptPos) (+.+ vel)
|
|
$ set (particles . ix i . ptPict) piclow
|
|
$ set (particles . ix i . ptUpdate)
|
|
(moveRemoteShell (time-1) i cid itid newdir)
|
|
$ setScope
|
|
w
|
|
| time >= 20 = case thingHit of
|
|
Just p -> doExplosion w
|
|
Nothing -> over (particles . ix i . ptPos) (+.+ vel)
|
|
$ set (particles . ix i . ptPict) pic
|
|
$ set (particles . ix i . ptUpdate)
|
|
(moveRemoteShell (time-1) i cid itid newdir)
|
|
$ setScope
|
|
w
|
|
| time > -99
|
|
= case thingHit of
|
|
Just p -> doExplosion
|
|
$ stopSoundFrom (ShellSound i)
|
|
w
|
|
Nothing -> over (particles . ix i . ptPos) (+.+ vel)
|
|
$ set randGen g
|
|
$ set (particles . ix i . ptPict) pic
|
|
$ set (particles . ix i . ptUpdate)
|
|
(moveRemoteShell (time-1) i cid itid newdir)
|
|
$ over (particles . ix i . ptVel) (\v -> accel +.+ frict *.* v)
|
|
$ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250
|
|
$ smokeGen
|
|
$ makeFlameletTimed oldPos
|
|
(0.5 *.* rotateV (pi+sparkD) accel) (levLayer UPtLayer) Nothing 3 20
|
|
$ makeFlameletTimed (0.5 *.* (newPos +.+ oldPos))
|
|
(0.5 *.* rotateV (pi+sparkD) accel) (levLayer UPtLayer) Nothing 3 20
|
|
$ setScope
|
|
w
|
|
| time > -200 = case thingHit of
|
|
Just p -> doExplosion
|
|
$ stopSoundFrom (ShellSound i)
|
|
w
|
|
Nothing -> over (particles . ix i . ptPos) (+.+ vel)
|
|
$ set (particles . ix i . ptPict) pic
|
|
$ set (particles . ix i . ptUpdate)
|
|
(moveRemoteShell (time-1) i cid itid newdir)
|
|
$ setScope
|
|
w
|
|
| otherwise = doExplosion
|
|
$ stopSoundFrom (ShellSound i)
|
|
w
|
|
where pt = _particles w IM.! i
|
|
oldPos = _ptPos pt
|
|
vel = _ptVel pt
|
|
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 = fmap fst $ collideCircCrsPoint oldPos newPos 4 w
|
|
hitWl = fmap fst $ collideCircWalls' oldPos newPos 2 $ wallsNearPoint newPos w
|
|
thingHit = hitCr <|> hitWl
|
|
|
|
(v1:v2:v3:_) = fst $ runState ((sequence . repeat . randInCirc) 0.1) $ _randGen w
|
|
(r1:r2:r3:_) = map ((*.*) 100) (v2:v3:v1:[])
|
|
(t1:t2:t3:_) = randomRs ( 15,20) $ _randGen w
|
|
(s1:s2:s3:_) = map (\s -> fromIntegral s * 0.1 - 1) (t3:t2:t1:[])
|
|
-- ((r1:r2:r3:_),_) = runState ((sequence . repeat . randInCirc) 10) $ _randGen w
|
|
-- v1 = fst $ runState (randInCirc 0.5) $ _randGen w
|
|
smokeGen = makeSmokeAt'' v2 s2 t2 (newPos +.+ r2)
|
|
. makeSmokeAt'' v1 s1 t1 (newPos +.+ r1)
|
|
|
|
-- . makeSmokeAt'' v3 s3 t3 (newPos +.+ r3)
|
|
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 -> Int -> Int -> World -> World
|
|
explodeRemoteRocket itid ptid n w
|
|
= set (particles . ix ptid . ptUpdate) (retireRemoteRocket itid 30 ptid)
|
|
$ set (particles . ix ptid . ptPict) blank
|
|
$ set (itPoint . wpFire) (flip const)
|
|
$ resetName
|
|
-- $ resetScope
|
|
$ makeExplosionAt (_ptPos (_particles w IM.! ptid)) w
|
|
-- $ makeShrapnelBombAt (_ptPos (_particles w IM.! ptid)) w
|
|
where resetName = set (itPoint . itName) "REMOTELAUNCHER"
|
|
-- resetScope = creatures . ix n . crInv . ix j . itScope . _Just . scopePos .~ (0,0)
|
|
itPoint = pointToItem $ _itemPositions w IM.! itid
|
|
|
|
throwRemoteBomb :: Int -> World -> World
|
|
throwRemoteBomb n w = setLocation $ removePict $ resetFire
|
|
-- $ resetName $ over particles addG $ set randGen g w
|
|
$ resetName $ over particles addG w
|
|
where addG = IM.insert i
|
|
$ Particle { _ptPos = p
|
|
, _ptStartPos = p
|
|
, _ptVel = v
|
|
, _ptPict = blank
|
|
, _ptID = i
|
|
, _ptUpdate = moveRemoteBomb itid 50 i
|
|
}
|
|
i = newParticleKey w
|
|
-- fireDist = zoom *.* (rotateV (_cameraRot w) (_mousePos w) +.+ _cameraPos 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'
|
|
-- 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) $ 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 .~ Just 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 ptid n w
|
|
= set (particles . ix ptid . ptUpdate) (retireRemoteBomb itid 30 ptid)
|
|
$ set (particles . ix ptid . ptPict) blank
|
|
$ set (creatures . ix n . crInv . ix j . twFire) (flip const)
|
|
$ resetName
|
|
$ resetPict
|
|
-- $ resetScope
|
|
$ makeExplosionAt (_ptPos (_particles w IM.! ptid)) w
|
|
-- $ makeShrapnelBombAt (_ptPos (_particles w IM.! ptid)) 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
|
|
, rotate (0 - degToRad (fromIntegral x * 10 + 45)) $ color red $ arc 0 90 5
|
|
, rotate (0 - degToRad (fromIntegral x * 10 + 45)) $ color (withAlpha 0.05 red)
|
|
$ arcSolid 0 90 50
|
|
, rotate (0 - degToRad (fromIntegral x * 10 + 20)) $ color (withAlpha 0.05 red)
|
|
$ arcSolid 0 40 40
|
|
, rotate (0 - degToRad (fromIntegral x * 10 + 10)) $ color (withAlpha 0.05 red)
|
|
$ arcSolid 0 20 20
|
|
]
|
|
remoteBombUnarmedPic :: Picture
|
|
remoteBombUnarmedPic = color (dark $ dark orange) $ circleSolid 5
|
|
|
|
drawWeapon :: Picture -> Creature -> Int -> Drawing
|
|
drawWeapon p cr posInInv
|
|
| _crInvSel cr == posInInv = onLayer PtLayer drawnWep
|
|
| otherwise = blank
|
|
where drawnWep = uncurry translate (_crRad cr,0) p
|
|
--drawWeapon :: Picture -> Creature -> Int -> Maybe (Picture, [Int])
|
|
--drawWeapon p cr posInInv
|
|
-- | _crInvSel cr == posInInv = Just (drawnWep, [levLayer PtLayer])
|
|
-- | otherwise = Nothing
|
|
-- where drawnWep = uncurry translate (_crRad cr,0) p
|
|
|
|
medkit :: Int -> Item
|
|
medkit i = basicConsumable
|
|
{ _itIdentity = Medkit25
|
|
, _itName = "MEDKIT" ++ show i
|
|
, _itMaxStack = 9
|
|
, _itAmount = 1
|
|
, _cnEffect = heal i
|
|
, _itFloorPict = onLayer FlItLayer $ color blue $ circleSolid 3
|
|
, _itEquipPict = drawWeapon $ color blue $ circleSolid 3
|
|
, _itID = Nothing
|
|
}
|
|
|
|
|
|
makeTeslaArcAt :: Int -> Point2 -> Float -> Particle
|
|
makeTeslaArcAt i pos dir = Particle
|
|
{ _ptPos = pos
|
|
, _ptStartPos = pos
|
|
, _ptVel = (0,0)
|
|
, _ptPict = onLayer PtLayer $ line [(0,0),(0,0)]
|
|
, _ptID = i
|
|
, _ptUpdate = moveTeslaArc pos dir i
|
|
}
|
|
|
|
moveTeslaArc :: Point2 -> Float -> Int -> World -> World
|
|
moveTeslaArc p d i w =
|
|
set (particles . ix i . ptPict) pic
|
|
$ set (particles . ix i . ptUpdate)
|
|
(ptTimer 2 i)
|
|
$ set randGen g
|
|
$ createSpark 8 nc q2 (argV sv + d1) Nothing
|
|
$ foldr damCrs w hitCrs
|
|
where pic = pictures
|
|
[ onLayer PtLayer $ color (f2 nc) $ line ps'
|
|
, onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 20 ps'
|
|
, onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 25 ps'
|
|
, onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 30 ps'
|
|
]
|
|
ps' = lightningMids d pers ps
|
|
ps = take 15 $ p : map f (crsLightChain p d 0 w)
|
|
f (E3x1 cr) = _crPos cr
|
|
f (E3x2 p1) = p1
|
|
f (E3x3 p1) = p1
|
|
pers = evalState (sequence $ repeat $ randInCirc 5) $ _randGen w
|
|
(nc,g) = randomR (0::Int,11) $ _randGen w
|
|
f1 (E3x1 cr) = Just $ _crID cr
|
|
f1 _ = Nothing
|
|
hitCrs = mapMaybe f1 $ take 14 $ crsLightChain p d 0 w
|
|
damCrs i = over (creatures . ix i . crHP) (\hp -> hp - 5)
|
|
f2 0 = cyan
|
|
f2 1 = azure
|
|
f2 _ = white
|
|
sID = newParticleKey w
|
|
q1 = last $ init ps'
|
|
q2 = last ps'
|
|
hitWall = collidePointWalls q1 ((2 *.* q2) -.- q1) $ wallsNearPoint q1 w
|
|
(d1,_) = randomR (-0.7,0.7) $ _randGen w
|
|
sv = fromMaybe (q2 -.- q1) $ fmap snd hitWall
|
|
|
|
lightningMid :: Float -> Point2 -> Point2 -> Point2
|
|
lightningMid d p1 p2 = (0.25 *.* (p1 +.+ p2)) +.+ 0.5 *.* p3
|
|
where p3 = errorClosestPointOnLine 1 p1 (p1 +.+ unitVectorAtAngle d) p2
|
|
|
|
lightningMids :: Float -> [Point2] -> [Point2] -> [Point2]
|
|
lightningMids d1 (p:pers) (p1:p3:ps)
|
|
= let p2 = p +.+ lightningMid d1 p1 p3
|
|
d2 = argV $ p3 -.- p2
|
|
in p1 : p2 : lightningMids d2 pers (p3:ps)
|
|
lightningMids _ _ ps = ps
|
|
|
|
crsLightChain' :: Point2 -> Float -> World -> [Either3 Creature Point2 Point2]
|
|
crsLightChain' p d w
|
|
= case crOrWall p d w of
|
|
E3x1 cr -> E3x1 cr : crsLightChain' (_crPos cr) (argV (_crPos cr -.- p)) w
|
|
E3x2 p1 -> [E3x2 p1]
|
|
E3x3 p1 -> E3x3 p1 : crsLightChain' p1 (dChange + argV (p1 -.- p)) (set randGen g w)
|
|
-- where (dChange, g) = (0, _randGen w)
|
|
where (dChange, g) = randomR (-0.05,0.05) $ _randGen w
|
|
|
|
crsLightChain :: Point2 -> Float -> Float -> World -> [Either3 Creature Point2 Point2]
|
|
crsLightChain p d wlAttract w
|
|
= case crOrWallSensitive p d wlAttract w of
|
|
E3x1 cr -> E3x1 cr : crsLightChain (_crPos cr) (argV (_crPos cr -.- p))
|
|
(min 1 (wlAttract + 0.3)) w
|
|
E3x2 p1 -> [E3x2 p1]
|
|
E3x3 p1 -> E3x3 p1 : crsLightChain p1 (dChange + argV (p1 -.- p)) (min 1 (wlAttract + 0.3)) (set randGen g w)
|
|
-- where (dChange, g) = (0, _randGen w)
|
|
where (dChange, g) = randomR (-0.05,0.05) $ _randGen w
|
|
|
|
crOrWallSensitive :: Point2 -> Float -> Float -> World -> Either3 Creature Point2 Point2
|
|
crOrWallSensitive p dir wlAttract w = fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0))
|
|
$ listToMaybe $ sortBy (compare `on` g)
|
|
$ catMaybes [cr,wlp]
|
|
where cr = fmap E3x1 $ nearestCrInFront p dir 100 w
|
|
wlp = fmap E3x2 $ listToMaybe
|
|
$ sortBy (compare `on` dist p)
|
|
$ mapMaybe
|
|
( fmap fst
|
|
. (\p1 -> collidePointWalls p p1 $ wallsNearPoint p w)
|
|
. (+.+) p
|
|
. (\d -> rotateV d (100,0))
|
|
. (+) dir
|
|
)
|
|
(fmap (*wlAttract) [-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8])
|
|
--[-pi/4,-pi/8,0,pi/8,pi/4]
|
|
g (E3x2 p1) = 100 + dist p p1 -- tweak makes it more likely to hit crs first
|
|
--g (E3x2 p1) = dist p p1 - 100 -- tweak makes it more likely to hit walls first
|
|
g (E3x1 cr1) = dist p $ _crPos cr1
|
|
(arcLen,_) = randomR (25,50) $ _randGen w
|
|
-- BUG: can hit crs through walls
|
|
|
|
crOrWall :: Point2 -> Float -> World -> Either3 Creature Point2 Point2
|
|
crOrWall p dir w = fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0))
|
|
$ listToMaybe $ sortBy (compare `on` g)
|
|
$ catMaybes [cr,wlp]
|
|
where cr = fmap E3x1 $ nearestCrInFront p dir 100 w
|
|
wlp = fmap E3x2 $ listToMaybe
|
|
$ sortBy (compare `on` dist p)
|
|
$ mapMaybe
|
|
( fmap fst
|
|
. (\p1 -> collidePointWalls p p1 $ wallsNearPoint p w)
|
|
. (+.+) p
|
|
. (\d -> rotateV d (100,0))
|
|
. (+) dir
|
|
)
|
|
[-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8]
|
|
--[-pi/4,-pi/8,0,pi/8,pi/4]
|
|
g (E3x2 p1) = 100 + dist p p1 -- tweak makes it more likely to hit crs first
|
|
--g (E3x2 p1) = dist p p1 - 100 -- tweak makes it more likely to hit walls first
|
|
g (E3x1 cr1) = dist p $ _crPos cr1
|
|
(arcLen,_) = randomR (25,50) $ _randGen w
|
|
|
|
-- grapFire :: Int -> World -> World
|
|
-- grapFire n w | fireCondition = set (creatures . ix n . crInv . ix itRef . wpFireState)
|
|
-- (_wpFireRate (_crInv cr IM.! itRef))
|
|
-- $ over (creatures . ix n . crInv . ix itRef . wpLoadedAmmo)
|
|
-- (\x -> x - 1)
|
|
-- $ set randGen g
|
|
-- $ over particles (IM.insert i (makeGrapFrom i n pos dir)) w
|
|
-- | reloadCondition = let remAmmo = _crAmmo cr M.! _wpAmmoType item
|
|
-- (newA,newTotalA) = moveInt (_wpMaxAmmo item) remAmmo
|
|
-- in set (pointerToItem . wpReloadState) rTime
|
|
-- $ set (pointerToItem . wpLoadedAmmo) newA
|
|
-- $ over (creatures . ix n . crAmmo )
|
|
-- (M.insert (_wpAmmoType item) newTotalA) w
|
|
-- | emptyCondition = soundOnce 1 w
|
|
-- | otherwise = w
|
|
-- where i = newParticleKey w
|
|
-- cr = (_creatures w IM.! n)
|
|
-- pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
|
|
-- dir = _crDir cr -- + a
|
|
-- (a,g) = randomR (-0.2,0.2::Float) (_randGen w)
|
|
-- itRef = _crInvSel cr
|
|
-- item = _crInv cr IM.! itRef
|
|
-- pointerToItem = creatures . ix n . crInv . ix itRef
|
|
-- rTime = _wpReloadTime (_crInv cr IM.! itRef)
|
|
-- fireCondition = _wpReloadState (_crInv cr IM.! itRef) == 0
|
|
-- && _wpFireState (_crInv cr IM.! itRef) == 0
|
|
-- && _wpLoadedAmmo (_crInv cr IM.! itRef) > 0
|
|
-- reloadCondition = _wpReloadState (_crInv cr IM.! itRef) == 0
|
|
-- && _wpLoadedAmmo (_crInv cr IM.! itRef) == 0
|
|
-- && someJust (_crAmmo cr M.!? PistolBullet)
|
|
-- emptyCondition = _wpLoadedAmmo (_crInv cr IM.! itRef) == 0
|
|
--
|
|
-- makeGrapFrom :: Int -> Int -> Point -> Float -> Particle
|
|
-- makeGrapFrom i ci pos dir = Particle
|
|
-- { _ptPos = pos
|
|
-- , _ptStartPos = pos
|
|
-- , _ptVel = rotateV dir (10,0)
|
|
-- , _ptPict = Line [(0,0)]
|
|
-- , _ptID = i
|
|
-- , _ptUpdate = moveGrap 50 [pos] ci i
|
|
-- }
|
|
--
|
|
-- moveGrap :: Int -> [Point] -> Int -> Int -> World -> World
|
|
-- moveGrap x ls ci i w --
|
|
-- | x < 0 || lineCollide = windGrap' (zipWith (-.-) ls ls5) ci i w
|
|
-- | otherwise = case tHit of
|
|
-- Just (Left (p,crID)) -> set (particles . ix i . ptUpdate) (windGrap'' i crID ci
|
|
-- (_crPos (_creatures w IM.! crID))
|
|
-- sCrP)
|
|
-- w
|
|
-- Just (Right (p,sv)) -> set (particles . ix i . ptUpdate)
|
|
-- (windGrap sCrP (zipWith (-.-) ls ls5 ++[p]) ci i)
|
|
-- w
|
|
-- _ -> set (particles . ix i . ptUpdate) (moveGrap (x-1) ls1 ci i)
|
|
-- $ set (particles . ix i. ptPos) pNewPos
|
|
-- $ set (particles . ix i. ptPict) pic
|
|
-- w
|
|
-- where sCr = _creatures w IM.! ci
|
|
-- sCrP = _crPos sCr
|
|
-- pic = thickLine ls1
|
|
-- pOldPos = _ptPos (_particles w IM.! i)
|
|
-- vel = _ptVel (_particles w IM.! i)
|
|
-- ls1 = zipWith (+.+) ls2 $ zipWith f [1,1-step..] ls ++ [pNewPos]
|
|
-- step = 1/ (51 - fromIntegral x)
|
|
-- f y p = p +.+ (y) *.* crMv
|
|
-- pNewPos = pOldPos +.+ vel
|
|
-- crMv = sCrP -.- _crOldPos sCr
|
|
-- ls3 = (:) (0,0) $ drop x $ take 48 $ cycle $
|
|
-- [lineWidth *.* vNormal vel
|
|
-- ,(0,0)
|
|
-- ,(-lineWidth) *.* vNormal vel
|
|
-- ,(-lineWidth) *.* vNormal vel
|
|
-- ,(0,0)
|
|
-- ,lineWidth *.* vNormal vel
|
|
-- ]
|
|
-- lineWidth = 1
|
|
-- lineWidth2 = 0.5
|
|
-- ls2 = ls3 ++ repeat (0,0)
|
|
-- ls5 = (:) (0,0) $ drop (x+z) $ take (48+z) $ cycle $
|
|
-- [lineWidth *.* vNormal vel
|
|
-- ,(0,0)
|
|
-- ,(-lineWidth) *.* vNormal vel
|
|
-- ,(-lineWidth) *.* vNormal vel
|
|
-- ,(0,0)
|
|
-- ,lineWidth *.* vNormal vel
|
|
-- ]
|
|
-- where z = 2
|
|
-- ls6 = (:) (0,0) $ drop (x+z) $ take (48+z) $ cycle $
|
|
-- [lineWidth2 *.* vNormal vel
|
|
-- ,(0,0)
|
|
-- ,(-lineWidth2) *.* vNormal vel
|
|
-- ,(-lineWidth2) *.* vNormal vel
|
|
-- ,(0,0)
|
|
-- ,lineWidth2 *.* vNormal vel
|
|
-- ]
|
|
-- where z = 2
|
|
-- hitCr = collidePointCrsPoint pOldPos pNewPos w
|
|
-- hitWl = collidePointWalls pOldPos pNewPos $ wallsNearPoint pNewPos w
|
|
-- tHit = thingHit' pOldPos hitCr hitWl
|
|
-- lineCollide = foldr (||) False $ zipWith
|
|
-- (\a b -> isJust $ collidePointWalls a b
|
|
-- $ wallsNearPoint b w)
|
|
-- ls (tail ls)
|
|
|
|
thingHit' :: Point2 -> Maybe (Point2,a) -> Maybe (Point2,c) -> Maybe (Either (Point2,a) (Point2,c))
|
|
thingHit' p Nothing Nothing = Nothing
|
|
thingHit' p (Just x) Nothing = Just (Left x)
|
|
thingHit' p Nothing (Just x) = Just (Right x)
|
|
thingHit' p (Just x@(p1,_)) (Just y@(p2,_))
|
|
| magV (p -.- p1) > magV (p -.- p2) = Just (Right y)
|
|
| otherwise = Just (Left x)
|
|
|
|
-- windGrap :: Point -> [Point] -> Int -> Int -> World -> World
|
|
-- windGrap cp (x:y:xs) ci i w
|
|
-- | dist (_crPos cr) cp < 5
|
|
-- = set (particles . ix i . ptUpdate) (windGrap cNewPos (y:xs) ci i)
|
|
-- $ set (particles . ix i . ptPict) (thickLine (y:xs))
|
|
-- $ set (creatures . ix ci . crPos) cNewPos
|
|
-- w
|
|
-- | otherwise = windGrap' (x:y:xs) ci i w
|
|
-- where cr = _creatures w IM.! ci
|
|
-- cNewPos = y -.- d
|
|
-- d = _crRad cr *.* errorNormalizeV 31 (y -.- x)
|
|
-- windGrap _ _ _ i w
|
|
-- = over particles (IM.delete i) w
|
|
--
|
|
-- windGrap' :: [Point] -> Int -> Int -> World -> World
|
|
-- windGrap' (x:[]) _ i w
|
|
-- = over particles (IM.delete i) w
|
|
-- windGrap' (x:xs) ci i w
|
|
-- = set (particles . ix i . ptUpdate) (windGrap' ys ci i)
|
|
-- $ set (particles . ix i . ptPict) (thickLine ys)
|
|
-- w
|
|
-- where ys = init $ zipWith f [1,1-step..] (x:xs)
|
|
-- crMv = sCrP -.- _crOldPos sCr
|
|
-- sCr = _creatures w IM.! ci
|
|
-- sCrP = _crPos sCr
|
|
-- f y p = p +.+ (y) *.* crMv
|
|
-- step = 1/ (fromIntegral (length xs) + 1)
|
|
--
|
|
-- windGrap'' :: Int -> Int -> Int -> Point -> Point -> World -> World
|
|
-- windGrap'' pti ci1 ci2 p1 p2 w
|
|
-- | dist cp1 cp2 < r1 + r2 + 1
|
|
-- = over particles (IM.delete pti) w
|
|
-- | dist cp1 p1 > 5 || dist cp2 p2 > 5
|
|
-- = over particles (IM.delete pti) w
|
|
-- | otherwise
|
|
-- = set (creatures . ix ci1 . crPos) cpn1
|
|
-- $ set (creatures . ix ci2 . crPos) cpn2
|
|
-- $ set (particles . ix pti . ptPict) (thickLine [ cp1, cp2])
|
|
-- $ set (particles . ix pti . ptUpdate) (windGrap'' pti ci1 ci2 cpn1 cpn2)
|
|
-- w
|
|
-- where cr1 = _creatures w IM.! ci1
|
|
-- cr2 = _creatures w IM.! ci2
|
|
-- cp1 = _crPos cr1
|
|
-- cp2 = _crPos cr2
|
|
-- r1 = _crRad cr1
|
|
-- r2 = _crRad cr2
|
|
-- m1 = _crMass cr1
|
|
-- m2 = _crMass cr2
|
|
-- v = errorNormalizeV 32 $ cp2 -.- cp1
|
|
-- v1 = 10 * m2 / (m1 + m2) *.* v
|
|
-- v2 = (-10 * m1 / (m1 + m2)) *.* v
|
|
-- cpn1 = cp1 +.+ v1
|
|
-- cpn2 = cp2 +.+ v2
|
|
|
|
spreadGunSpread,autogunSpread :: Float
|
|
spreadGunSpread = 0.5
|
|
autogunSpread = 0.07
|
|
|
|
medkit25,pipe,magShield :: Item
|
|
medkit25 = basicConsumable
|
|
{ _itIdentity = Medkit25
|
|
, _itName = "MEDKIT25"
|
|
, _itMaxStack = 3
|
|
, _itAmount = 2
|
|
, _cnEffect = heal25
|
|
, _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
|
|
, _itEquipPict = \cr _ -> blank
|
|
}
|
|
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 = basicEquipment
|
|
{ _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 = basicEquipment
|
|
{ _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
|
|
}
|
|
frontArmour = basicEquipment
|
|
{ _itIdentity = FrontArmour
|
|
, _itName = "FRONTARMOUR"
|
|
, _itMaxStack = 1
|
|
, _itAmount = 1
|
|
, _itFloorPict = onLayer FlItLayer $ translate 0 (-5) $ pictures [color (greyN 0.1) $ thickArc 0 90 10 5
|
|
,color (greyN 0.1) $ thickArc 270 360 10 5
|
|
]
|
|
, _itEquipPict = (\cr _ -> onLayer CrLayer
|
|
$ pictures [color (greyN 0.1) $ thickArc 0 90 (_crRad cr) 5
|
|
,color (greyN 0.1) $ thickArc 270 360 (_crRad cr) 5
|
|
]
|
|
)
|
|
, _itEffect = NoItEffect
|
|
, _itID = Nothing
|
|
}
|
|
jetPack = basicEquipment
|
|
{ _itIdentity = JetPack
|
|
, _itName = "JETPACK"
|
|
, _itMaxStack = 1
|
|
, _itAmount = 1
|
|
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
|
|
, _itEquipPict = (\cr _ -> onLayer CrLayer
|
|
$ pictures [color yellow $ polygon $ rectNSEW 5 (-5) (-3) (-11)
|
|
]
|
|
)
|
|
, _itEffect = NoItEffect
|
|
, _itID = Nothing
|
|
}
|
|
|
|
latchkey :: Int -> Item
|
|
latchkey n = basicEquipment
|
|
{ _itIdentity = Generic
|
|
, _itName = "KEY "++show n
|
|
, _itMaxStack = 1
|
|
, _itAmount = 1
|
|
, _itFloorPict = onLayer FlItLayer $ latchkeyPic
|
|
, _itEquipPict = \cr _ -> onLayer PtLayer $ translate (-5) (-5) $ rotate (pi/2.5) latchkeyPic
|
|
, _itEffect = NoItEffect
|
|
, _itHammer = HammerUp
|
|
, _itID = Nothing
|
|
, _itAimingSpeed = 1
|
|
, _itAimingRange = 0
|
|
, _itZoom = basicItZoom
|
|
, _itInvColor = yellow
|
|
, _itInvDisplay = _itName
|
|
}
|
|
latchkeyPic = color yellow $
|
|
pictures [translate (-4) 0 $ thickCircle 4 2
|
|
,lineOfThickness 2 [(0,0),(8,0),(8,-4)]
|
|
,lineOfThickness 2 [(4,0),(4,-4)]
|
|
]
|
|
|
|
|
|
-- }}}
|
|
|
|
heal25 :: Int -> World -> Maybe World
|
|
heal25 n w | _crHP (_creatures w IM.! n) >= 200 = Nothing
|
|
| otherwise = Just $ soundOnce healSound
|
|
$ over (creatures . ix n . crHP) ((\x-> min x 100). (+ 25) ) w
|
|
heal :: Int -> Int -> World -> Maybe World
|
|
heal hp n w | _crHP (_creatures w IM.! n) >= 1000 = Nothing
|
|
| otherwise = Just $ soundOnce healSound
|
|
$ over (creatures . ix n . crHP) ((\x-> min x 1000). (+ hp) ) w
|
|
|
|
forceFieldFire :: Int -> World -> World
|
|
forceFieldFire cid w = w
|
|
|
|
--shatterGunFire :: Int -> World -> World
|
|
--shatterGunFire n w | fireCondition = -- soundOnce 0
|
|
-- set (creatures . ix n . crInv . ix itRef . wpFireState)
|
|
-- (_wpFireRate (_crInv cr IM.! itRef))
|
|
-- $ over (creatures . ix n . crInv . ix itRef . wpLoadedAmmo)
|
|
-- (\x -> x - 1)
|
|
-- $ over particles (IM.insert i $ makeTremorAt i pos dir) w
|
|
-- | reloadCondition = let remAmmo = _crAmmo cr M.! _wpAmmoType item
|
|
-- (newA,newTotalA) = moveInt (_wpMaxAmmo item) remAmmo
|
|
-- in set (pointerToItem . wpReloadState) rTime
|
|
-- $ set (pointerToItem . wpLoadedAmmo) newA
|
|
-- $ over (creatures . ix n . crAmmo )
|
|
-- (M.insert (_wpAmmoType item) newTotalA) w
|
|
-- | emptyCondition = soundOnce 1 w
|
|
-- | otherwise = w
|
|
-- where i = newParticleKey w
|
|
-- cr = (_creatures w IM.! n)
|
|
-- pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
|
|
-- dir = _crDir cr
|
|
-- --(colID, _) = randomR (0,11) (_randGen w)
|
|
-- itRef = _crInvSel cr
|
|
-- item = _crInv cr IM.! itRef
|
|
-- pointerToItem = creatures . ix n . crInv . ix itRef
|
|
-- rTime = _wpReloadTime (_crInv cr IM.! itRef)
|
|
-- fireCondition = _wpReloadState (_crInv cr IM.! itRef) == 0
|
|
-- && _wpFireState (_crInv cr IM.! itRef) == 0
|
|
-- && _wpLoadedAmmo (_crInv cr IM.! itRef) > 0
|
|
-- reloadCondition = _wpReloadState (_crInv cr IM.! itRef) == 0
|
|
-- && _wpLoadedAmmo (_crInv cr IM.! itRef) == 0
|
|
-- && someJust (_crAmmo cr M.!? PistolBullet)
|
|
-- emptyCondition = _wpLoadedAmmo (_crInv cr IM.! itRef) == 0
|
|
|
|
|
|
--for reloading, we take from the total ammo
|
|
moveInt :: Int -> Int -> (Int,Int)
|
|
moveInt toReload totalAmmo = (x, totalAmmo-x)
|
|
where x = min toReload totalAmmo
|
|
|
|
updateTractor :: Int -> Int -> Int -> World -> World
|
|
updateTractor colID time i w
|
|
| time > 0 = set (particles . ix i . ptUpdate) (updateTractor colID (time-1) i)
|
|
$ set (particles . ix i . ptPict) pic
|
|
$ over creatures (IM.map tractCr)
|
|
$ over floorItems (IM.map tractFlIt)
|
|
w
|
|
| otherwise = over particles (IM.delete i) w
|
|
where tractCr cr | circOnLine p1 p2 cP 10
|
|
= over crPos (\p ->
|
|
p -.- m *.* ((0.3/ x) *.* q +.+ (f y *.* p4))
|
|
) cr
|
|
| otherwise = cr
|
|
where x = abs y + 1
|
|
y = errorClosestPointOnLineParam 1 p1 p3 cP
|
|
cP = _crPos cr
|
|
m | dist cP p1 < 350 = 1
|
|
| otherwise = (400 - dist cP p1) / 50
|
|
tractFlIt it | circOnLine p1 p2 iP 10
|
|
= over flItPos (\p -> p -.- m *.*
|
|
( (0.3/ x) *.* q +.+ (f y *.* p4))
|
|
) it
|
|
| otherwise = it
|
|
where x = abs y + 1
|
|
y = errorClosestPointOnLineParam 2 p1 p3 iP
|
|
iP = _flItPos it
|
|
m | dist iP p1 < 350 = 1
|
|
| otherwise = (410 - dist iP p1) / 60
|
|
pt = _particles w IM.! i
|
|
q = _ptVel pt
|
|
p1 = _ptPos pt
|
|
p' = _ptStartPos pt
|
|
p2 = fromMaybe p' $ fmap fst $ collidePointWalls p1 p' $ wallsNearPoint p' w
|
|
p4 = vNormal p5
|
|
p5 = errorNormalizeV 12 $ p2 -.- p1
|
|
p3 = p1 +.+ p4
|
|
g x | x > 5 = (10 - x) / 5
|
|
| x > 1 = 1
|
|
| x > -1 = x
|
|
| x > -5 = -1
|
|
| otherwise = (x - 10) / 5
|
|
d = errorNormalizeV 13 $ p' -.- p1
|
|
f x = g x / 50
|
|
cID = fromIntegral colID / 10
|
|
col = mixColors 0.5 0.5 white blue
|
|
px z = (fromIntegral time + 5) *.* z
|
|
pz z = fromIntegral time * 10 *.* z
|
|
pic = onLayer PtLayer $ color (withAlpha 0.05 col)
|
|
$ polygon [ p1 +.+ px p4
|
|
, p1 -.- 10 *.* p5
|
|
, p1 -.- px p4
|
|
, (p' -.- pz p5) -.- px p4
|
|
, (p' -.- pz p5) +.+ px p4]
|
|
|
|
thickLine :: [Point2] -> Picture
|
|
thickLine = lineOfThickness 2
|
|
|
|
vThickLine :: [Point2] -> Picture
|
|
vThickLine = lineOfThickness 3
|
|
|
|
vvThickLine :: [Point2] -> Picture
|
|
vvThickLine = lineOfThickness 6
|
|
|
|
thinLine :: [Point2] -> Picture
|
|
thinLine = lineOfThickness 1
|
|
|
|
someJust (Just x) | x > 0 = True
|
|
| otherwise = False
|
|
|
|
shakeCr :: Int -> Float -> World -> World
|
|
shakeCr cID amount w =
|
|
let vec = vNormal $ unitVectorAtAngle $ _crDir $ _creatures w IM.! cID
|
|
(x,g) = randomR (-amount,amount) $ _randGen w
|
|
in set randGen g . over (creatures . ix cID . crPos) (+.+ (x *.* vec)) $ w
|
|
|
|
|
|
radar = defaultGun
|
|
{ _itName = "RADAR"
|
|
, _itIdentity = Generic
|
|
, _wpMaxAmmo = 100
|
|
, _wpLoadedAmmo = 100
|
|
, _wpAmmoType = PistolBullet
|
|
, _wpReloadTime = 200
|
|
, _wpReloadState = 0
|
|
, _wpFireRate = 120
|
|
, _wpFireState = 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 = basicItZoom {_itAimZoomMax = 1, _itZoomMax = 1}
|
|
, _itEquipPict = drawWeapon $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
|
|
}
|
|
|
|
sonar = defaultGun
|
|
{ _itName = "SONAR"
|
|
, _itIdentity = Generic
|
|
, _wpMaxAmmo = 100
|
|
, _wpLoadedAmmo = 100
|
|
, _wpAmmoType = PistolBullet
|
|
, _wpReloadTime = 200
|
|
, _wpReloadState = 0
|
|
, _wpFireRate = 120
|
|
, _wpFireState = 0
|
|
, _wpFire = shoot $ aSonarPulse
|
|
, _wpSpread = autogunSpread
|
|
, _wpRange = 20
|
|
, _itHammer = HammerUp
|
|
, _itFloorPict = onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
|
|
, _itAmount = 1
|
|
, _itMaxStack = 1
|
|
, _itAimingRange = 1
|
|
, _itZoom = basicItZoom {_itAimZoomMax = 1, _itZoomMax = 1}
|
|
, _itEquipPict = drawWeapon $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
|
|
}
|
|
|
|
aSonarPulse :: Int -> World -> World
|
|
aSonarPulse cid w = over particles' ((:) $ sonarPulseAt (_crPos (_creatures w IM.! cid))) w
|
|
|
|
aRadarPulse :: Int -> World -> World
|
|
aRadarPulse cid w = over particles' ((:) $ radarPulseAt (_crPos (_creatures w IM.! cid))) w
|
|
|
|
blipAt :: Point2 -> Color -> Int -> Particle'
|
|
blipAt p col i = Particle'
|
|
{_ptPict' = blank
|
|
,_ptUpdate' = mvBlip p col i i
|
|
}
|
|
|
|
mvBlip :: Point2 -> Color -> Int -> Int -> World -> Particle' -> (World, Maybe Particle')
|
|
mvBlip p col maxt 0 w pt = (w, Nothing)
|
|
mvBlip p col maxt t w pt
|
|
= (w, Just $ pt & ptUpdate' .~ mvBlip p col maxt (t-1)
|
|
& ptPict' .~ (onLayerL [levLayer ShadowLayer, 2]
|
|
$ uncurry translate p
|
|
$ color (withAlpha (fromIntegral t / fromIntegral maxt) col)
|
|
$ circleSolid 2)
|
|
)
|
|
|
|
sonarPulseAt :: Point2 -> Particle'
|
|
sonarPulseAt p = Particle'
|
|
{ _ptPict' = blank
|
|
, _ptUpdate' = mvSonar 100 p
|
|
}
|
|
|
|
mvSonar :: Int -> Point2 -> World -> Particle' -> (World, Maybe Particle')
|
|
mvSonar 0 _ w _ = (w, Nothing)
|
|
mvSonar x p w pt = (w, Just $ pt {_ptPict' = pic
|
|
,_ptUpdate' = mvSonar (x-1) p
|
|
}
|
|
)
|
|
where pic = onLayerL [levLayer ShadowLayer, 2] $ pictures
|
|
-- $ sweepPics ++
|
|
crBlips -- ++ wallBlips
|
|
crBlips = mapMaybe crBlip $ IM.elems $ _creatures w
|
|
crBlip cr | dist cpos p < r + crad && dist cpos p > r - (crad + 100)
|
|
= Just $ colHelper (0.5 * (1 - (r - dist cpos p) /100))
|
|
$ uncurry translate cpos $ circleSolid crad
|
|
| otherwise = Nothing
|
|
where crad = _crRad cr
|
|
cpos = _crPos cr
|
|
r = fromIntegral (500 - x*5)
|
|
sweepPics = [colHelper 0.05 $ uncurry translate p $ thickCircle r 5
|
|
-- ,colHelper 0.3 $ uncurry translate p $ thickCircle (r-5) 5
|
|
-- ,colHelper 0.1 $ uncurry translate p $ thickCircle (r-10) 5
|
|
]
|
|
globalAlpha | x > 10 = 1
|
|
| otherwise = fromIntegral x / 10
|
|
colHelper y = color (withAlpha (y * globalAlpha) green)
|
|
-- wallBlips
|
|
|
|
|
|
radarPulseAt :: Point2 -> Particle'
|
|
radarPulseAt p = Particle'
|
|
{ _ptPict' = blank
|
|
, _ptUpdate' = mvRadar 50 p
|
|
}
|
|
|
|
mvRadar :: Int -> Point2 -> World -> Particle' -> (World, Maybe Particle')
|
|
mvRadar 0 _ w _ = (w, Nothing)
|
|
mvRadar x p w pt = (putBlips w, Just $ pt {_ptPict' = pic
|
|
,_ptUpdate' = mvRadar (x-1) p
|
|
}
|
|
)
|
|
where pic = onLayerL [levLayer ShadowLayer, 1] $ pictures
|
|
$ sweepPics
|
|
putBlips = over worldEvents ((.) $ over particles' ((++) blips))
|
|
blips = map (\p -> blipAt p (withAlpha (0.5*globalAlpha) red) 50)
|
|
$ circPoints
|
|
circPoints = mapMaybe (\wl -> collidePointCircCorrect (_wlLine wl !! 0) (_wlLine wl !! 1) r p)
|
|
$ (map (over wlLine reverse) $ IM.elems $ wallsAlongCirc p r w)
|
|
++ (IM.elems $ wallsAlongCirc p r w)
|
|
r = fromIntegral (800 - x*16)
|
|
sweepPics = [--colHelper 0.1 $ uncurry translate p $ thickCircle r 15
|
|
--,colHelper 0.06 $ uncurry translate p $ thickCircle (r-5) 5
|
|
--,colHelper 0.03 $ uncurry translate p $ thickCircle (r-10) 5
|
|
]
|
|
globalAlpha | x > 10 = 1
|
|
| otherwise = fromIntegral x / 10
|
|
colHelper y = color (withAlpha (y * globalAlpha) red)
|
|
|
|
autoSonar = basicEquipment
|
|
{ _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 = basicItZoom {_itAimZoomMax = 1, _itZoomMax = 1}
|
|
}
|
|
autoRadar = basicEquipment
|
|
{ _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 = basicItZoom {_itAimZoomMax = 1, _itZoomMax = 1}
|
|
}
|
|
|
|
autoRadarEffect :: ItEffect
|
|
autoRadarEffect = ItInvEffect {_itInvEffect = f 50
|
|
,_itEffectCounter = 0
|
|
}
|
|
where f 0 cr i w = aRadarPulse (_crID cr)
|
|
w & creatures . ix (_crID cr) . crInv . ix i
|
|
. itEffect . itInvEffect .~ f 100
|
|
f t cr i w = w & creatures . ix (_crID cr) . crInv . ix i
|
|
. itEffect . itInvEffect .~ f (t-1)
|
|
|
|
autoSonarEffect :: ItEffect
|
|
autoSonarEffect = ItInvEffect {_itInvEffect = f 50
|
|
,_itEffectCounter = 0
|
|
}
|
|
where f 0 cr i w = aSonarPulse (_crID cr)
|
|
w & creatures . ix (_crID cr) . crInv . ix i
|
|
. itEffect . itInvEffect .~ f 40
|
|
f t cr i w = w & creatures . ix (_crID cr) . crInv . ix i
|
|
. itEffect . itInvEffect .~ f (t-1)
|
|
|
|
itemLaserScopeEffect :: ItEffect
|
|
itemLaserScopeEffect
|
|
= ItInvEffect {_itInvEffect = f
|
|
,_itEffectCounter = 0
|
|
}
|
|
where f cr invid w
|
|
| invid == _crInvSel cr
|
|
= w & particles' %~ (:) (makeLaserScope sp ep d reloadFrac)
|
|
& creatures . ix (_crID cr) . crInv . ix invid . itHammer %~ moveHammerUp
|
|
& flareWidth 2 1 15 32 col 0.05 0.1 (ep -.- 4 *.* unitVectorAtAngle d)
|
|
-- this flare MAY be buggy... something to do with the creature glare
|
|
| otherwise = w
|
|
where
|
|
p = _crPos cr
|
|
d = _crDir cr
|
|
r = _crRad cr
|
|
sp = (p +.+ (r + 3) *.* unitVectorAtAngle d)
|
|
xp = sp +.+ 3000 *.* unitVectorAtAngle d
|
|
ep = case listToMaybe $ thingsHitLongLine sp xp w of
|
|
Just (p,_) -> p
|
|
Nothing -> xp
|
|
it = (cr ^. crInv) IM.! invid
|
|
reloadFrac
|
|
| _wpLoadedAmmo it == 0 = 1
|
|
| otherwise = fromIntegral (_wpReloadState it) / fromIntegral (_wpReloadTime it)
|
|
col = mixColors reloadFrac (1-reloadFrac) red green
|
|
moveHammerUp !HammerDown = HammerReleased
|
|
moveHammerUp !_ = HammerUp
|
|
|
|
makeLaserScope :: Point2 -> Point2 -> Float -> Float -> Particle'
|
|
makeLaserScope p ep d relFrac = Particle'
|
|
{_ptPict' = onLayer PtLayer $ pictures
|
|
[color (withAlpha 0.5 $ mixColors relFrac (1-relFrac) red green)
|
|
$ lineOfThickness 0.5 [p,ep]
|
|
,color (withAlpha 0.2 $ mixColors relFrac (1-relFrac) red green)
|
|
$ lineOfThickness 1.5 [p,ep]
|
|
,color (withAlpha 0.1 $ mixColors relFrac (1-relFrac) red green)
|
|
$ lineOfThickness 2 [p,ep]
|
|
]
|
|
,_ptUpdate' = \w pt -> (w, Just $ pt & ptUpdate' .~ \w' _ -> (w',Nothing))
|
|
}
|