refactor: pass creature to weapon use function, as opposed to just id

This commit is contained in:
2021-05-23 22:07:46 +02:00
parent 3ae454acf4
commit cda035b1d1
11 changed files with 235 additions and 219 deletions
+6 -5
View File
@@ -30,11 +30,11 @@ import System.Random
--import qualified Data.Map as M --import qualified Data.Map as M
startReloadingWeapon startReloadingWeapon
:: Int -- ^ Creature id :: Creature
-> World -> World
-> Maybe World -> Maybe World
startReloadingWeapon cid w = startReloadingWeapon cr w =
let cr = _creatures w IM.! cid let cid = _crID cr
it = _crInv cr IM.! _crInvSel cr it = _crInv cr IM.! _crInvSel cr
itRef = creatures . ix cid . crInv . ix (_crInvSel cr) itRef = creatures . ix cid . crInv . ix (_crInvSel cr)
in case it of in case it of
@@ -54,15 +54,16 @@ crAutoReload cr = case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of
maxA = cr ^? crInv . ix (_crInvSel cr) . wpMaxAmmo maxA = cr ^? crInv . ix (_crInvSel cr) . wpMaxAmmo
{- | Teleport a creature to the mouse position -} {- | Teleport a creature to the mouse position -}
blinkAction blinkAction
:: Int -- ^ Creature id :: Creature
-> World -> World
-> World -> World
blinkAction n w blinkAction cr w
= soundOnce teleSound = soundOnce teleSound
. set (creatures . ix n . crPos) p3 . set (creatures . ix n . crPos) p3
. blinkShockwave n p3 . blinkShockwave n p3
$ inverseShockwaveAt cp 40 2 2 2 w $ inverseShockwaveAt cp 40 2 2 2 w
where where
n = _crID cr
p1 = _cameraCenter w +.+ (1 / _cameraZoom w) *.* rotateV (_cameraRot w) (_mousePos w) p1 = _cameraCenter w +.+ (1 / _cameraZoom w) *.* rotateV (_cameraRot w) (_mousePos w)
cp = _crPos $ _creatures w IM.! n cp = _crPos $ _creatures w IM.! n
p2 = reflectPointWalls cp p1 $ wallsAlongLine cp p1 w p2 = reflectPointWalls cp p1 $ wallsAlongLine cp p1 w
+10 -9
View File
@@ -8,29 +8,30 @@ import Control.Lens
--import Data.Maybe (maybe) --import Data.Maybe (maybe)
useItem :: Int -> World -> World useItem :: Int -> World -> World
useItem n w = itemEffect n it w useItem n w = itemEffect c it w
where where
c = _creatures w IM.! n c = _creatures w IM.! n
it = _crInv c IM.! _crInvSel c it = _crInv c IM.! _crInvSel c
-- TODO this needs sorting out and possibly removing
crUseItem :: Creature -> World -> World crUseItem :: Creature -> World -> World
--crUseItem cr = itemEffect (_crID cr) (_crInv cr IM.! _crInvSel cr) --crUseItem cr = itemEffect (_crID cr) (_crInv cr IM.! _crInvSel cr)
crUseItem cr = tryUseItem (_crID cr) crUseItem cr = tryUseItem cr
tryUseItem tryUseItem
:: Int -- ^ Creature id :: Creature
-> World -> World
-> World -> World
tryUseItem cid w = case w ^? creatures . ix cid of tryUseItem cr' w = case w ^? creatures . ix (_crID cr') of
Just cr -> itemEffect cid (_crInv cr IM.! _crInvSel cr) w Just cr -> itemEffect cr (_crInv cr IM.! _crInvSel cr) w
Nothing -> w Nothing -> w
itemEffect itemEffect
:: Int -- ^ Creature id (I am almost certain) :: Creature
-> Item -> Item
-> World -> World
-> World -> World
itemEffect n Consumable{_cnEffect=eff } w = maybe w (rmSelectedInvItem n) (eff n w) itemEffect cr Consumable{_cnEffect=eff } w = maybe w (rmSelectedInvItem (_crID cr)) (eff (_crID cr) w)
itemEffect n Weapon{_wpFire=eff} w = eff n w itemEffect cr Weapon{_itUse=eff} w = eff cr w
itemEffect n Throwable{_twFire = eff} w = eff n w itemEffect cr Throwable{_itUse = eff} w = eff cr w
itemEffect _ _ w = w itemEffect _ _ w = w
+2 -2
View File
@@ -197,7 +197,7 @@ data Item
, _wpReloadState :: Int , _wpReloadState :: Int
, _itUseRate :: Int , _itUseRate :: Int
, _itUseTime :: Int , _itUseTime :: Int
, _wpFire :: Int -> World -> World , _itUse :: Creature -> World -> World
, _wpSpread :: Float , _wpSpread :: Float
, _wpRange :: Float , _wpRange :: Float
, _itHammer :: HammerPosition , _itHammer :: HammerPosition
@@ -265,7 +265,7 @@ data Item
, _itFloorPict :: Picture , _itFloorPict :: Picture
, _twMaxRange :: Float , _twMaxRange :: Float
, _twAccuracy :: Float , _twAccuracy :: Float
, _twFire :: Int -> World -> World , _itUse :: Creature -> World -> World
, _itUseRate :: Int , _itUseRate :: Int
, _itUseTime :: Int , _itUseTime :: Int
, _itAimingSpeed :: Float , _itAimingSpeed :: Float
+1 -1
View File
@@ -50,7 +50,7 @@ handlePressedKeyInGame scode w
| scode == pauseKey (_keyConfig w) = Just $ pauseGame $ escapeMap w | scode == pauseKey (_keyConfig w) = Just $ pauseGame $ escapeMap w
| scode == dropItemKey (_keyConfig w) = Just $ youDropItem w | scode == dropItemKey (_keyConfig w) = Just $ youDropItem w
| scode == toggleMapKey (_keyConfig w) = Just $ toggleMap w | scode == toggleMapKey (_keyConfig w) = Just $ toggleMap w
| scode == reloadKey (_keyConfig w) = Just $ fromMaybe w $ startReloadingWeapon (_yourID w) w | scode == reloadKey (_keyConfig w) = Just $ fromMaybe w $ startReloadingWeapon (you w) w
| scode == testEventKey (_keyConfig w) = Just $ testEvent w | scode == testEventKey (_keyConfig w) = Just $ testEvent w
| scode == spaceActionKey (_keyConfig w) = Just $ spaceAction w | scode == spaceActionKey (_keyConfig w) = Just $ spaceAction w
| scode == rotateCameraPlusKey (_keyConfig w) = Just $ w & cameraRot +~ 0.01 | scode == rotateCameraPlusKey (_keyConfig w) = Just $ w & cameraRot +~ 0.01
+6 -4
View File
@@ -32,14 +32,16 @@ decCharMode
decCharMode i = creatures . ix 0 . crInv . ix i . itAttachment . _Just %~ decCharMode' decCharMode i = creatures . ix 0 . crInv . ix i . itAttachment . _Just %~ decCharMode'
charFiringStrat charFiringStrat
:: [(Char, Int -> World -> World)] -- ^ Different firing effects for different characters :: [(Char, Creature -> World -> World)] -- ^ Different firing effects for different characters
-> Int -- ^ Creature id -> Creature -- ^ Creature id
-> World -> World
-> World -> World
charFiringStrat strats cid w = case w ^? creatures . ix cid . crInv charFiringStrat strats cr w = case w ^? creatures . ix cid . crInv
. ix (_crInvSel $ _creatures w IM.! cid) . itAttachment . _Just . itCharMode of . ix (_crInvSel $ _creatures w IM.! cid) . itAttachment . _Just . itCharMode of
Just (c :<| _) -> fromJust (Prelude.lookup c strats) cid w Just (c :<| _) -> fromJust (Prelude.lookup c strats) cr w
_ -> w _ -> w
where
cid = _crID cr
increaseFuse increaseFuse
:: Int -- ^ Old fuse time :: Int -- ^ Old fuse time
+81 -79
View File
@@ -70,7 +70,7 @@ pistol = Weapon
, _wpReloadState = 0 , _wpReloadState = 0
, _itUseRate = 8 , _itUseRate = 8
, _itUseTime = 0 , _itUseTime = 0
, _wpFire = , _itUse =
hammerCheck hammerCheck
. shootWithSound 0 . shootWithSound 0
. withRandomDir 0.1 . withRandomDir 0.1
@@ -102,15 +102,15 @@ defaultAutoGun = autoGun
, _itScrollDown = const id , _itScrollDown = const id
, _itInvDisplay = basicWeaponDisplay , _itInvDisplay = basicWeaponDisplay
} }
effectGun :: String -> (Int -> World -> World) -> Item effectGun :: String -> (Creature -> World -> World) -> Item
effectGun name eff = defaultGun effectGun name eff = defaultGun
{ _itName = name ++ "Gun" { _itName = name ++ "Gun"
, _wpFire = eff , _itUse = eff
} }
autoEffectGun :: String -> (Int -> World -> World) -> Item autoEffectGun :: String -> (Creature -> World -> World) -> Item
autoEffectGun name eff = defaultAutoGun autoEffectGun name eff = defaultAutoGun
{ _itName = name ++ "Gun" { _itName = name ++ "Gun"
, _wpFire = eff , _itUse = eff
} }
autoGun :: Item autoGun :: Item
autoGun = defaultGun autoGun = defaultGun
@@ -122,7 +122,7 @@ autoGun = defaultGun
, _wpReloadState = 0 , _wpReloadState = 0
, _itUseRate = 6 , _itUseRate = 6
, _itUseTime = 0 , _itUseTime = 0
, _wpFire = charFiringStrat , _itUse = charFiringStrat
[('M',autoFireMode) [('M',autoFireMode)
,('S',singleFireMode) ,('S',singleFireMode)
] ]
@@ -142,7 +142,7 @@ autoGun = defaultGun
, _itScrollDown = decCharMode , _itScrollDown = decCharMode
, _itInvDisplay = basicWeaponDisplay , _itInvDisplay = basicWeaponDisplay
} }
autoFireMode, singleFireMode, autoGunNonTwistEff :: Int -> World -> World autoFireMode, singleFireMode, autoGunNonTwistEff :: Creature -> World -> World
autoFireMode = shootWithSound (fromIntegral autoGunSound) autoFireMode = shootWithSound (fromIntegral autoGunSound)
. torqueBefore 0.05 . torqueBefore 0.05
$ autoGunNonTwistEff $ autoGunNonTwistEff
@@ -161,7 +161,7 @@ rezGun = defaultGun
, _wpReloadState = 0 , _wpReloadState = 0
, _itUseRate = 0 , _itUseRate = 0
, _itUseTime = 0 , _itUseTime = 0
, _wpFire = shoot aTeslaArc , _itUse = shoot aTeslaArc
, _wpSpread = 0.001 , _wpSpread = 0.001
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color chartreuse $ pictures , _itFloorPict = onLayer FlItLayer $ color chartreuse $ pictures
@@ -186,7 +186,7 @@ teslaGun = defaultAutoGun
, _wpReloadState = 0 , _wpReloadState = 0
, _itUseRate = 0 , _itUseRate = 0
, _itUseTime = 0 , _itUseTime = 0
, _wpFire = shoot aTeslaArc , _itUse = shoot aTeslaArc
, _wpSpread = 0.001 , _wpSpread = 0.001
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color blue $ pictures , _itFloorPict = onLayer FlItLayer $ color blue $ pictures
@@ -212,7 +212,7 @@ lasGun = defaultAutoGun
, _wpReloadState = 0 , _wpReloadState = 0
, _itUseRate = 0 , _itUseRate = 0
, _itUseTime = 0 , _itUseTime = 0
, _wpFire = shoot aLaser , _itUse = shoot aLaser
, _wpSpread = 0.001 , _wpSpread = 0.001
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color blue $ polygon $ rectNESW 3 3 (-3) (-3) , _itFloorPict = onLayer FlItLayer $ color blue $ polygon $ rectNESW 3 3 (-3) (-3)
@@ -235,7 +235,7 @@ forceFieldGun = defaultGun
, _wpReloadState = 0 , _wpReloadState = 0
, _itUseRate = 10 , _itUseRate = 10
, _itUseTime = 0 , _itUseTime = 0
, _wpFire = undefined , _itUse = undefined
, _wpSpread = 0.02 , _wpSpread = 0.02
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ polygon [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)] , _itFloorPict = onLayer FlItLayer $ polygon [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)]
@@ -253,7 +253,7 @@ forceFieldGun = defaultGun
-- , _wpReloadState = 0 -- , _wpReloadState = 0
-- , _itUseRate = 10 -- , _itUseRate = 10
-- , _itUseTime = 0 -- , _itUseTime = 0
-- , _wpFire = grapFire -- , _itUse = grapFire
-- , _wpSpread = 0.002 -- , _wpSpread = 0.002
-- , _wpRange = 20 -- , _wpRange = 20
-- , _wpIsAuto = False -- , _wpIsAuto = False
@@ -272,7 +272,7 @@ tractorGun = defaultAutoGun
, _wpReloadState = 0 , _wpReloadState = 0
, _itUseRate = 0 , _itUseRate = 0
, _itUseTime = 0 , _itUseTime = 0
, _wpFire = shoot $ aTractorBeam 0 , _itUse = shoot $ aTractorBeam 0
, _wpSpread = 0.00001 , _wpSpread = 0.00001
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ] , _itFloorPict = onLayer FlItLayer $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ]
@@ -291,7 +291,7 @@ launcher = defaultGun
, _wpReloadState = 0 , _wpReloadState = 0
, _itUseRate = 20 , _itUseRate = 20
, _itUseTime = 0 , _itUseTime = 0
, _wpFire = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeExplosionAt , _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeExplosionAt
, _wpSpread = 0.02 , _wpSpread = 0.02
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5) , _itFloorPict = onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
@@ -305,34 +305,34 @@ launcher = defaultGun
} }
flameLauncher = launcher flameLauncher = launcher
{ _itName = "FLROCKO" { _itName = "FLROCKO"
, _wpFire = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeFlameExplosionAt , _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeFlameExplosionAt
} }
poisonLauncher = launcher poisonLauncher = launcher
{ _itName = "POISROCK" { _itName = "POISROCK"
, _wpFire = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makePoisonExplosionAt , _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makePoisonExplosionAt
} }
teslaLauncher = launcher teslaLauncher = launcher
{ _itName = "TESLROCK" { _itName = "TESLROCK"
, _wpFire = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeTeslaExplosionAt , _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeTeslaExplosionAt
} }
useTargetPos useTargetPos
:: (Point2 -> Int -> World -> World) :: (Point2 -> Creature -> World -> World)
-> Int -> Creature
-> World -> World
-> World -> World
useTargetPos f cid w = case cr ^? crInv . ix (_crInvSel cr) . itAttachment . _Just . itTargetPos of useTargetPos f cr w = case cr ^? crInv . ix (_crInvSel cr) . itAttachment . _Just . itTargetPos of
Nothing -> w Nothing -> w
Just p -> f p cid w Just p -> f p cr w
where where
cr = _creatures w IM.! cid cid = _crID cr
bezierGun :: Item bezierGun :: Item
bezierGun = defaultAutoGun bezierGun = defaultAutoGun
{ _itName = "B-GUN" { _itName = "B-GUN"
, _wpFire = useTargetPos $ \p -> , _itUse = useTargetPos $ \p ->
shootWithSound 0 shootWithSound 0
. withMuzFlare . withMuzFlare
. withRecoil 40 . withRecoil 40
@@ -347,8 +347,8 @@ bezierGun = defaultAutoGun
, _itAimingRange = 0 , _itAimingRange = 0
} }
shootBezier :: Point2 -> Int -> World -> World shootBezier :: Point2 -> Creature -> World -> World
shootBezier targetp cid w = w & particles %~ (theBullet :) shootBezier targetp cr w = w & particles %~ (theBullet :)
where where
theBullet = aCurveBulAt theBullet = aCurveBulAt
(Just cid) (Just cid)
@@ -359,7 +359,7 @@ shootBezier targetp cid w = w & particles %~ (theBullet :)
(destroyOnImpact bulHitCr bulHitWall' bulHitFF') (destroyOnImpact bulHitCr bulHitWall' bulHitFF')
5 5
controlp = mouseWorldPos w controlp = mouseWorldPos w
cr = _creatures w IM.! cid cid = _crID cr
dir = _crDir cr dir = _crDir cr
startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0) startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0)
(randPos,randPos') = flip evalState (_randGen w) $ do (randPos,randPos') = flip evalState (_randGen w) $ do
@@ -382,7 +382,7 @@ remoteLauncher = defaultGun
, _wpReloadState = 0 , _wpReloadState = 0
, _itUseRate = 10 , _itUseRate = 10
, _itUseTime = 0 , _itUseTime = 0
, _wpFire = hammerCheck fireRemoteLauncher , _itUse = hammerCheck fireRemoteLauncher
, _wpSpread = 0.02 , _wpSpread = 0.02
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5) , _itFloorPict = onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
@@ -402,7 +402,7 @@ hvAutoGun = defaultAutoGun
, _wpReloadState = 0 , _wpReloadState = 0
, _itUseRate = 25 , _itUseRate = 25
, _itUseTime = 0 , _itUseTime = 0
, _wpFire = rateIncAB 24 10 (torqueBeforeForced 0.1 mkHvBul) $ torqueAfter 0.2 mkHvBul , _itUse = rateIncAB 24 10 (torqueBeforeForced 0.1 mkHvBul) $ torqueAfter 0.2 mkHvBul
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color orange $ polygon $ rectNESW 5 5 (-5) (-5) , _itFloorPict = onLayer FlItLayer $ color orange $ polygon $ rectNESW 5 5 (-5) (-5)
, _itAmount = 1 , _itAmount = 1
@@ -427,7 +427,7 @@ ltAutoGun = defaultAutoGun
, _wpReloadState = 0 , _wpReloadState = 0
, _itUseRate = 4 , _itUseRate = 4
, _itUseTime = 0 , _itUseTime = 0
, _wpFire = shootWithSound 0 . withRandomDir 0.3 . withSidePush 50 , _itUse = shootWithSound 0 . withRandomDir 0.3 . withSidePush 50
. withMuzFlare $ withVelWthHiteff (30,0) 2 basicBulletEffect . withMuzFlare $ withVelWthHiteff (30,0) 2 basicBulletEffect
, _wpSpread = 0.5 , _wpSpread = 0.5
, _wpRange = 20 , _wpRange = 20
@@ -452,7 +452,7 @@ miniGun = defaultAutoGun
, _wpReloadState = 0 , _wpReloadState = 0
, _itUseRate = 2 , _itUseRate = 2
, _itUseTime = 0 , _itUseTime = 0
, _wpFire = withWarmUp 50 . torqueBefore 0.03 . withSidePush 50 . withRecoil 15 , _itUse = withWarmUp 50 . torqueBefore 0.03 . withSidePush 50 . withRecoil 15
. withRandomDir 0.1 . withRandomDir 0.1
. withRandomOffset 9 . withRandomOffset 9
. withMuzFlare . withMuzFlare
@@ -475,7 +475,7 @@ spreadGun = defaultGun
, _wpReloadState = 0 , _wpReloadState = 0
, _itUseRate = 20 , _itUseRate = 20
, _itUseTime = 0 , _itUseTime = 0
, _wpFire = shootWithSound (fromIntegral shotgunSound) , _itUse = shootWithSound (fromIntegral shotgunSound)
. withRecoil 100 . withRecoil 100
. withMuzFlare . withMuzFlare
$ spreadNumVelWthHiteff spreadGunSpread 9 (30,0) 2 basicBulletEffect $ spreadNumVelWthHiteff spreadGunSpread 9 (30,0) 2 basicBulletEffect
@@ -497,7 +497,7 @@ multGun = defaultGun
, _wpReloadState = 0 , _wpReloadState = 0
, _itUseRate = 20 , _itUseRate = 20
, _itUseTime = 0 , _itUseTime = 0
, _wpFire = shootWithSound (fromIntegral shotgunSound) , _itUse = shootWithSound (fromIntegral shotgunSound)
. withRecoil 200 . withRecoil 200
. withMuzFlare . withMuzFlare
$ numVelWthHitEff 5 (50,0) 5 basicBulletEffect $ numVelWthHitEff 5 (50,0) 5 basicBulletEffect
@@ -529,7 +529,7 @@ longGun = defaultGun
, _wpReloadState = 0 , _wpReloadState = 0
, _itUseRate = 100 , _itUseRate = 100
, _itUseTime = 0 , _itUseTime = 0
, _wpFire = shootWithSound (fromIntegral longGunSound) , _itUse = shootWithSound (fromIntegral longGunSound)
. withThickSmoke . withThickSmoke
. torqueAfter 0.05 . torqueAfter 0.05
. withMuzFlare . withMuzFlare
@@ -566,7 +566,7 @@ poisonSprayer = defaultAutoGun
, _wpReloadState = 0 , _wpReloadState = 0
, _itUseRate = 0 , _itUseRate = 0
, _itUseTime = 0 , _itUseTime = 0
, _wpFire = shoot aGasCloud , _itUse = shoot aGasCloud
, _wpSpread = 0.3 , _wpSpread = 0.3
, _wpRange = 8 , _wpRange = 8
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4) , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
@@ -587,7 +587,7 @@ flamer = defaultAutoGun
, _wpReloadState = 0 , _wpReloadState = 0
, _itUseRate = 0 , _itUseRate = 0
, _itUseTime = 0 , _itUseTime = 0
, _wpFire = shoot $ withSidePush 5 $ withSidePushAfter 10 $ randWalkAngle 0.5 0.05 aFlame , _itUse = shoot $ withSidePush 5 $ withSidePushAfter 10 $ randWalkAngle 0.5 0.05 aFlame
, _wpSpread = 0 , _wpSpread = 0
, _wpRange = 8 , _wpRange = 8
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4) , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
@@ -608,7 +608,7 @@ blinkGun = defaultGun
, _wpReloadState = 0 , _wpReloadState = 0
, _itUseRate = 0 , _itUseRate = 0
, _itUseTime = 0 , _itUseTime = 0
, _wpFire = shoot aSelf , _itUse = shoot aSelf
, _wpSpread = 0.05 , _wpSpread = 0.05
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ polygon [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)] , _itFloorPict = onLayer FlItLayer $ polygon [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
@@ -619,17 +619,18 @@ blinkGun = defaultGun
} }
aTeslaArc :: Int -> World -> World aTeslaArc :: Creature -> World -> World
aTeslaArc cid w = aTeslaArc' cid aTeslaArc cr w = aTeslaArc' cr $ soundFrom (CrWeaponSound cid) 25 1 0 w
$ soundFrom (CrWeaponSound cid) 25 1 0 w where
cid = _crID cr
aTeslaArc' :: Int -> World -> World aTeslaArc' :: Creature -> World -> World
aTeslaArc' cid w aTeslaArc' cr w
= teslaGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir) = teslaGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir)
$ over projectiles (IM.insert i (makeTeslaArcAt i pos dir)) $ over projectiles (IM.insert i (makeTeslaArcAt i pos dir))
$ set randGen g w $ set randGen g w
where where
cr = _creatures w IM.! cid cid = _crID cr
i = newProjectileKey w i = newProjectileKey w
pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
+.+ sideOffset *.* vNormal (unitVectorAtAngle dir) +.+ sideOffset *.* vNormal (unitVectorAtAngle dir)
@@ -638,13 +639,13 @@ aTeslaArc' cid w
aRocketWithPayload aRocketWithPayload
:: (Point2 -> World -> World) -- ^ Payload :: (Point2 -> World -> World) -- ^ Payload
-> Int -- ^ Creature id -> Creature
-> World -> World
-> World -> World
aRocketWithPayload pl cid w = over projectiles (IM.insert i theShell) w aRocketWithPayload pl cr w = over projectiles (IM.insert i theShell) w
where where
cid = _crID cr
i = newProjectileKey w i = newProjectileKey w
cr = _creatures w IM.! cid
pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
dir = _crDir cr dir = _crDir cr
theShell = makeShellAt pl i cid pos dir theShell = makeShellAt pl i cid pos dir
@@ -746,11 +747,11 @@ remoteShellPic i
shellExplosionAt :: Point2 -> World -> World shellExplosionAt :: Point2 -> World -> World
shellExplosionAt = makeExplosionAt shellExplosionAt = makeExplosionAt
aGasCloud :: Int -> World -> World aGasCloud :: Creature -> World -> World
aGasCloud cid w = insertCloud $ set randGen g w aGasCloud cr w = insertCloud $ set randGen g w
where where
(a,g) = randomR (-0.1,0.1) (_randGen w) (a,g) = randomR (-0.1,0.1) (_randGen w)
cr = _creatures w IM.! cid cid = _crID cr
dir = _crDir cr + a dir = _crDir cr + a
pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr)) pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
--pos2 = (0.5 *.* vel) +.+ --pos2 = (0.5 *.* vel) +.+
@@ -758,17 +759,17 @@ aGasCloud cid w = insertCloud $ set randGen g w
vel = (_crPos cr -.- _crOldPos cr) +.+ 10 *.* unitVectorAtAngle dir vel = (_crPos cr -.- _crOldPos cr) +.+ 10 *.* unitVectorAtAngle dir
insertCloud = makeGasCloud pos vel -- . makeFlame pos2 vel (Just cid) insertCloud = makeGasCloud pos vel -- . makeFlame pos2 vel (Just cid)
aFlame :: Int -> World -> World aFlame :: Creature -> World -> World
aFlame cid w = insertFlame w aFlame cr w = insertFlame w
where where
(t,_) = randomR (99,101) (_randGen w) (t,_) = randomR (99,101) (_randGen w)
cr = _creatures w IM.! cid cid = _crID cr
dir = _crDir cr dir = _crDir cr
pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr)) pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir
insertFlame = makeFlame t pos vel (Just cid) -- . makeFlame pos2 vel (Just cid) insertFlame = makeFlame t pos vel (Just cid) -- . makeFlame pos2 vel (Just cid)
aSelf :: Int -> World -> World aSelf :: Creature -> World -> World
aSelf = blinkAction aSelf = blinkAction
reflect :: Float -> Float -> Float reflect :: Float -> Float -> Float
@@ -783,7 +784,7 @@ pointToItem (OnFloor flid) = floorItems . ix flid . flIt
retireRemoteRocket :: Int -> Int -> Int -> World -> World retireRemoteRocket :: Int -> Int -> Int -> World -> World
retireRemoteRocket itid 0 pjid w = retireRemoteRocket itid 0 pjid w =
set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) (0,0) set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) (0,0)
$ set (pointToItem (_itemPositions w IM.! itid) . wpFire) (hammerCheck fireRemoteLauncher) $ set (pointToItem (_itemPositions w IM.! itid) . itUse) (hammerCheck fireRemoteLauncher)
(w & projectiles %~ IM.delete pjid) (w & projectiles %~ IM.delete pjid)
retireRemoteRocket itid t pjid w = setScope w retireRemoteRocket itid t pjid w = setScope w
& projectiles . ix pjid . pjUpdate .~ retireRemoteRocket itid (t-1) pjid & projectiles . ix pjid . pjUpdate .~ retireRemoteRocket itid (t-1) pjid
@@ -799,7 +800,7 @@ retireRemoteBomb :: Int -> Int -> Int -> World -> World
retireRemoteBomb itid 0 pjid w = retireRemoteBomb itid 0 pjid w =
set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) (0,0) set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) (0,0)
$ set (pointToItem (_itemPositions w IM.! itid) . itZoom) defaultItZoom $ set (pointToItem (_itemPositions w IM.! itid) . itZoom) defaultItZoom
$ set (pointToItem (_itemPositions w IM.! itid) . twFire) (hammerCheck throwRemoteBomb) $ set (pointToItem (_itemPositions w IM.! itid) . itUse) (hammerCheck throwRemoteBomb)
(w & projectiles %~ IM.delete pjid) (w & projectiles %~ IM.delete pjid)
retireRemoteBomb itid t pjid w = setScope w retireRemoteBomb itid t pjid w = setScope w
& projectiles . ix pjid . pjUpdate .~ retireRemoteBomb itid (t-1) pjid & projectiles . ix pjid . pjUpdate .~ retireRemoteBomb itid (t-1) pjid
@@ -870,7 +871,7 @@ grenade = Throwable
, _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
, _twMaxRange = 150 , _twMaxRange = 150
, _twAccuracy = 30 , _twAccuracy = 30
, _twFire = useTimeCheck $ throwGrenade makeExplosionAt , _itUse = useTimeCheck $ throwGrenade makeExplosionAt
, _itAimingSpeed = 1 , _itAimingSpeed = 1
, _itAimingRange = 0 , _itAimingRange = 0
, _itZoom = defaultItZoom {_itAimZoomMax = f fuseTime, _itAimZoomMin = f fuseTime} , _itZoom = defaultItZoom {_itAimZoomMax = f fuseTime, _itAimZoomMin = f fuseTime}
@@ -893,7 +894,7 @@ grenade = Throwable
flameGrenade :: Item flameGrenade :: Item
flameGrenade = grenade { flameGrenade = grenade {
_itName = "FLMGREN " ++ show fuseTime _itName = "FLMGREN " ++ show fuseTime
, _twFire = throwGrenade makeFlameExplosionAt , _itUse = throwGrenade makeFlameExplosionAt
} }
where where
fuseTime = 50 :: Int fuseTime = 50 :: Int
@@ -902,7 +903,7 @@ flameGrenade = grenade {
teslaGrenade :: Item teslaGrenade :: Item
teslaGrenade = grenade { teslaGrenade = grenade {
_itName = "TLSGREN " ++ show fuseTime _itName = "TLSGREN " ++ show fuseTime
, _twFire = throwGrenade makeTeslaExplosionAt , _itUse = throwGrenade makeTeslaExplosionAt
} }
where where
fuseTime = 50 :: Int fuseTime = 50 :: Int
@@ -917,22 +918,22 @@ remoteBomb = defaultThrowable
, _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
, _twMaxRange = 150 , _twMaxRange = 150
, _twAccuracy = 30 , _twAccuracy = 30
, _twFire = hammerCheck throwRemoteBomb , _itUse = hammerCheck throwRemoteBomb
, _itAttachment = Just $ ItScope (0,0) 0 1 True , _itAttachment = Just $ ItScope (0,0) 0 1 True
, _itEquipPict = pictureWeaponOnAim remoteBombUnarmedPic , _itEquipPict = pictureWeaponOnAim remoteBombUnarmedPic
} }
fireRemoteLauncher :: Int -> World -> World fireRemoteLauncher :: Creature -> World -> World
fireRemoteLauncher cid w = setLocation fireRemoteLauncher cr w = setLocation
$ resetFire $ resetFire
$ resetName $ resetName
$ soundOnce (fromIntegral launcherSound) $ soundOnce (fromIntegral launcherSound)
$ over projectiles remRocket w $ over projectiles remRocket w
where where
i = IM.newKey $ _projectiles w i = IM.newKey $ _projectiles w
cr = _creatures w IM.! cid cid = _crID cr
dir = _crDir cr dir = _crDir cr
pos = _crPos cr +.+ rotateV dir (_crRad cr + 1,0) pos = _crPos cr +.+ rotateV dir (_crRad cr + 1,0)
remRocket = IM.insert i $ Projectile remRocket = IM.insert i $ Projectile
@@ -946,8 +947,8 @@ fireRemoteLauncher cid w = setLocation
j = _crInvSel $ _creatures w IM.! cid j = _crInvSel $ _creatures w IM.! cid
newitid = IM.newKey $ _itemPositions w newitid = IM.newKey $ _itemPositions w
maybeitid = w ^? creatures . ix cid . crInv . ix j . itID . _Just maybeitid = w ^? creatures . ix cid . crInv . ix j . itID . _Just
resetFire = set (creatures . ix cid . crInv . ix j . wpFire) resetFire = set (creatures . ix cid . crInv . ix j . itUse)
$ hammerCheck $ explodeRemoteRocket itid i $ hammerCheck $ \cr -> explodeRemoteRocket itid i
resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEROCKET" resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEROCKET"
setLocation :: World -> World setLocation :: World -> World
setLocation w' = case maybeitid of setLocation w' = case maybeitid of
@@ -1025,7 +1026,7 @@ moveRemoteShell time i cid itid _ w
r1 = _randGen w & evalState (randInCirc 10) r1 = _randGen w & evalState (randInCirc 10)
smokeGen = makeSmokeCloudAt $ oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos) smokeGen = makeSmokeCloudAt $ oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)
doExplosion = explodeRemoteRocket itid i cid doExplosion = explodeRemoteRocket itid i
setScope w' = case _itemPositions w' IM.! itid of setScope w' = case _itemPositions w' IM.! itid of
InInv cid' invid InInv cid' invid
-> w' & creatures . ix cid' . crInv . ix invid . itAttachment -> w' & creatures . ix cid' . crInv . ix invid . itAttachment
@@ -1035,23 +1036,23 @@ moveRemoteShell time i cid itid _ w
explodeRemoteRocket explodeRemoteRocket
:: Int -- ^ Item id :: Int -- ^ Item id
-> Int -- ^ Projectile id -> Int -- ^ Projectile id
-> Int -- ^ (Probably) firing creature id
-> World -> World
-> World -> World
explodeRemoteRocket itid pjid _ w explodeRemoteRocket itid pjid w
= set (projectiles . ix pjid . pjUpdate) (retireRemoteRocket itid 30 pjid) = set (projectiles . ix pjid . pjUpdate) (retireRemoteRocket itid 30 pjid)
$ set (projectiles . ix pjid . pjPict) blank $ set (projectiles . ix pjid . pjPict) blank
$ set (itPoint . wpFire) (const id) $ set (itPoint . itUse) (const id)
$ resetName $ resetName
$ makeExplosionAt (_pjPos (_projectiles w IM.! pjid)) w $ makeExplosionAt (_pjPos (_projectiles w IM.! pjid)) w
where where
resetName = set (itPoint . itName) "REMOTELAUNCHER" resetName = set (itPoint . itName) "REMOTELAUNCHER"
itPoint = pointToItem $ _itemPositions w IM.! itid itPoint = pointToItem $ _itemPositions w IM.! itid
throwRemoteBomb :: Int -> World -> World throwRemoteBomb :: Creature -> World -> World
throwRemoteBomb n w = setLocation $ removePict $ resetFire throwRemoteBomb cr w = setLocation $ removePict $ resetFire
$ resetName $ over projectiles addG w $ resetName $ over projectiles addG w
where where
n = _crID cr -- to change to cid
addG = IM.insert i $ Projectile addG = IM.insert i $ Projectile
{ _pjPos = p { _pjPos = p
, _pjStartPos = p , _pjStartPos = p
@@ -1072,7 +1073,7 @@ throwRemoteBomb n w = setLocation $ removePict $ resetFire
j = _crInvSel $ _creatures w IM.! n j = _crInvSel $ _creatures w IM.! n
resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTE" resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTE"
removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank
resetFire = set (creatures . ix n . crInv . ix j . twFire) resetFire = set (creatures . ix n . crInv . ix j . itUse)
$ hammerCheck $ explodeRemoteBomb itid i $ hammerCheck $ explodeRemoteBomb itid i
cr = _creatures w IM.! n cr = _creatures w IM.! n
p' = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr,0) p' = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr,0)
@@ -1087,17 +1088,18 @@ throwRemoteBomb n w = setLocation $ removePict $ resetFire
newitid = IM.newKey $ _itemPositions w newitid = IM.newKey $ _itemPositions w
itid = fromMaybe newitid maybeitid itid = fromMaybe newitid maybeitid
explodeRemoteBomb :: Int -> Int -> Int -> World -> World explodeRemoteBomb :: Int -> Int -> Creature -> World -> World
explodeRemoteBomb itid pjid n w explodeRemoteBomb itid pjid cr w
= set (projectiles . ix pjid . pjUpdate) (retireRemoteBomb itid 30 pjid) = set (projectiles . ix pjid . pjUpdate) (retireRemoteBomb itid 30 pjid)
$ set (projectiles . ix pjid . pjPict) blank $ set (projectiles . ix pjid . pjPict) blank
$ set (creatures . ix n . crInv . ix j . twFire) (const id) $ set (creatures . ix n . crInv . ix j . itUse) (const id)
$ resetName $ resetName
$ resetPict $ resetPict
-- $ resetScope -- $ resetScope
$ makeExplosionAt (_pjPos (_projectiles w IM.! pjid)) w $ makeExplosionAt (_pjPos (_projectiles w IM.! pjid)) w
-- - $ makeShrapnelBombAt (_pjPos (_projectiles w IM.! pjid)) w -- - $ makeShrapnelBombAt (_pjPos (_projectiles w IM.! pjid)) w
where where
n = _crID cr
resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTEBOMB" resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTEBOMB"
resetPict = set (creatures . ix n . crInv . ix j . itEquipPict ) resetPict = set (creatures . ix n . crInv . ix j . itEquipPict )
(pictureWeaponOnAim remoteBombUnarmedPic) (pictureWeaponOnAim remoteBombUnarmedPic)
@@ -1140,7 +1142,7 @@ radar = defaultGun
, _wpReloadState = 0 , _wpReloadState = 0
, _itUseRate = 120 , _itUseRate = 120
, _itUseTime = 0 , _itUseTime = 0
, _wpFire = shoot aRadarPulse , _itUse = shoot aRadarPulse
, _wpSpread = autogunSpread , _wpSpread = autogunSpread
, _wpRange = 20 , _wpRange = 20
, _itHammer = HammerUp , _itHammer = HammerUp
@@ -1163,7 +1165,7 @@ sonar = defaultGun
, _wpReloadState = 0 , _wpReloadState = 0
, _itUseRate = 120 , _itUseRate = 120
, _itUseTime = 0 , _itUseTime = 0
, _wpFire = shoot aSonarPulse , _itUse = shoot aSonarPulse
, _wpRange = 20 , _wpRange = 20
, _itHammer = HammerUp , _itHammer = HammerUp
, _itFloorPict = onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) , _itFloorPict = onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
@@ -1215,17 +1217,17 @@ spawnGun cr = defaultGun
, _wpReloadTime = 80 , _wpReloadTime = 80
, _wpReloadState = 0 , _wpReloadState = 0
, _itUseRate = 100 , _itUseRate = 100
, _wpFire = spawnCrNextTo cr , _itUse = spawnCrNextTo cr
} }
spawnCrNextTo spawnCrNextTo
:: Creature -- ^ Creature to spawn :: Creature -- ^ Creature to spawn
-> Int -- ^ ID of existing creature that will be spawned next to -> Creature -- ^ existing creature that will be spawned next to
-> World -> World
-> World -> World
spawnCrNextTo cr i w = w & creatures %~ IM.insert k newCr spawnCrNextTo cr sCr w = w & creatures %~ IM.insert k newCr
where where
k = IM.newKey $ _creatures w k = IM.newKey $ _creatures w
sCr = _creatures w IM.! i i = _crID cr
newCr = cr newCr = cr
& crID .~ k & crID .~ k
& crPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr) & crPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr)
+2 -2
View File
@@ -84,7 +84,7 @@ autoRadarEffect :: ItEffect
autoRadarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 } autoRadarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
where where
f :: Int -> Creature -> Int -> World -> World f :: Int -> Creature -> Int -> World -> World
f 0 cr i w = aRadarPulse (_crID cr) w f 0 cr i w = aRadarPulse cr w
& creatures . ix (_crID cr) . crInv . ix i & creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f 100 . itEffect . itInvEffect .~ f 100
f t cr i w = w f t cr i w = w
@@ -96,7 +96,7 @@ autoSonarEffect :: ItEffect
autoSonarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 } autoSonarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
where where
f :: Int -> Creature -> Int -> World -> World f :: Int -> Creature -> Int -> World -> World
f 0 cr i w = aSonarPulse (_crID cr) f 0 cr i w = aSonarPulse cr
w & creatures . ix (_crID cr) . crInv . ix i w & creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f 140 . itEffect . itInvEffect .~ f 140
f t cr i w = w & creatures . ix (_crID cr) . crInv . ix i f t cr i w = w & creatures . ix (_crID cr) . crInv . ix i
+3 -3
View File
@@ -57,11 +57,12 @@ grenadePic x = pictures
throwGrenade throwGrenade
:: (Point2 -> World -> World) -- ^ Payload :: (Point2 -> World -> World) -- ^ Payload
-> Int -- ^ Creature id -> Creature
-> World -> World
-> World -> World
throwGrenade explosion n w = setWp $ removePict $ over projectiles addG w throwGrenade explosion cr w = setWp $ removePict $ over projectiles addG w
where where
n = _crID cr
addG = IM.insert i $ Shell addG = IM.insert i $ Shell
{ _pjPos = p { _pjPos = p
, _pjStartPos = p , _pjStartPos = p
@@ -71,7 +72,6 @@ throwGrenade explosion n w = setWp $ removePict $ over projectiles addG w
, _pjUpdate = moveGrenade fuseTime dir i , _pjUpdate = moveGrenade fuseTime dir i
, _pjPayload = explosion , _pjPayload = explosion
} }
cr = _creatures w IM.! n
j = _crInvSel cr j = _crInvSel cr
removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank
i = newProjectileKey w i = newProjectileKey w
+3 -3
View File
@@ -23,13 +23,13 @@ import Data.Maybe (fromMaybe)
import qualified Data.Sequence as Seq import qualified Data.Sequence as Seq
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
aLaser :: Int -> World -> World aLaser :: Creature -> World -> World
aLaser cid w = over particles (makeLaserAt phaseV pos dir (Just cid) : ) aLaser cr w = over particles (makeLaserAt phaseV pos dir (Just cid) : )
$ soundFrom LasSound 24 1 0 $ soundFrom LasSound 24 1 0
$ laserGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir) $ laserGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir)
w w
where where
cr = _creatures w IM.! cid cid = _crID cr
pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir) pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir)
dir = _crDir cr dir = _crDir cr
phaseV = charToPhaseV phaseV = charToPhaseV
+111 -103
View File
@@ -19,25 +19,23 @@ import Data.Maybe
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
withThinSmoke withThinSmoke
:: (Int -> World -> World) -- ^ Underlying effect :: (Creature -> World -> World) -- ^ Underlying effect
-> Int -- ^ Creature id -> Creature
-> World -> World
-> World -> World
withThinSmoke eff cid w = eff cid $ foldr (makeThinSmokeAt . (+.+ pos)) w ps withThinSmoke eff cr w = eff cr $ foldr (makeThinSmokeAt . (+.+ pos)) w ps
where where
cr = _creatures w IM.! cid
dir = _crDir cr dir = _crDir cr
pos = _crPos cr +.+ (_crRad cr +0.5) *.* unitVectorAtAngle dir pos = _crPos cr +.+ (_crRad cr +0.5) *.* unitVectorAtAngle dir
ps = (replicateM 5 . randInCirc) 8 & evalState $ _randGen w ps = (replicateM 5 . randInCirc) 8 & evalState $ _randGen w
withThickSmoke withThickSmoke
:: (Int -> World -> World) -- ^ Underlying effect :: (Creature -> World -> World) -- ^ Underlying effect
-> Int -- ^ Creature id -> Creature
-> World -> World
-> World -> World
withThickSmoke eff cid w = eff cid $ foldr (makeThickSmokeAt . (+.+ pos)) w ps withThickSmoke eff cr w = eff cr $ foldr (makeThickSmokeAt . (+.+ pos)) w ps
where where
cr = _creatures w IM.! cid
dir = _crDir cr dir = _crDir cr
pos = _crPos cr +.+ (_crRad cr + 15) *.* unitVectorAtAngle dir pos = _crPos cr +.+ (_crRad cr + 15) *.* unitVectorAtAngle dir
ps = (replicateM 20 . randInCirc) 8 & evalState $ _randGen w ps = (replicateM 20 . randInCirc) 8 & evalState $ _randGen w
@@ -48,26 +46,26 @@ Applies ammo check and use cooldown check. -}
rateIncAB rateIncAB
:: Int -- ^ Start rate :: Int -- ^ Start rate
-> Int -- ^ End rate -> Int -- ^ End rate
-> (Int -> World -> World) -- ^ Effect on first fire -> (Creature -> World -> World) -- ^ Effect on first fire
-> (Int -> World -> World) -- ^ Effect on continued fire -> (Creature -> World -> World) -- ^ Effect on continued fire
-> Int -- ^ Creature id -> Creature -- ^ Creature id
-> World -> World
-> World -> World
rateIncAB startRate fastRate shooteff1 shooteff2 cid w rateIncAB startRate fastRate shooteff1 shooteff2 cr w
| repeatFire = set (pointItem . itUseRate) (max fastRate (currentRate - 1)) | repeatFire = set (pointItem . itUseRate) (max fastRate (currentRate - 1))
$ over (pointItem . wpLoadedAmmo) (\ammo -> ammo-1) $ over (pointItem . wpLoadedAmmo) (\ammo -> ammo-1)
$ set (pointItem . itUseTime) currentRate $ set (pointItem . itUseTime) currentRate
$ shooteff2 cid $ shooteff2 cr
w w
| firstFire = set (pointItem . itUseRate) (startRate - 1) | firstFire = set (pointItem . itUseRate) (startRate - 1)
$ over (pointItem . wpLoadedAmmo) (\ammo -> ammo-1) $ over (pointItem . wpLoadedAmmo) (\ammo -> ammo-1)
$ set (pointItem . itUseTime) startRate $ set (pointItem . itUseTime) startRate
$ shooteff1 cid $ shooteff1 cr
w w
| reloadCondition = fromMaybe w $ startReloadingWeapon cid w | reloadCondition = fromMaybe w $ startReloadingWeapon cr w
| otherwise = w | otherwise = w
where where
cr = _creatures w IM.! cid cid = _crID cr
itRef = _crInvSel cr itRef = _crInvSel cr
item = _crInv cr IM.! itRef item = _crInv cr IM.! itRef
pointItem = creatures . ix cid . crInv . ix itRef pointItem = creatures . ix cid . crInv . ix itRef
@@ -84,32 +82,32 @@ Shoot a weapon rapidly after a warm up.
Applies ammo check as well. -} Applies ammo check as well. -}
withWarmUp withWarmUp
:: Int -- ^ Warm up time (in frames) :: Int -- ^ Warm up time (in frames)
-> (Int -> World -> World) -> (Creature -> World -> World)
-- ^ Shoot effect -- ^ Shoot effect
-> Int -- ^ Creature id -> Creature
-> World -> World
-> World -> World
withWarmUp t f cid w withWarmUp t f cr w
| reloadCondition = fromMaybe w $ startReloadingWeapon cid w | reloadCondition = fromMaybe w $ startReloadingWeapon cr w
| _wpReloadState item /= 0 = w | _wpReloadState item /= 0 = w
| fState == 0 = set (pointerToItem . wpFire) (withWarmUp 100 f) | fState == 0 = set (pointerToItem . itUse) (withWarmUp 100 f)
$ set (pointerToItem . itUseTime) 2 $ set (pointerToItem . itUseTime) 2
w w
| t > 2 = set (pointerToItem . wpFire) (withWarmUp (t-1) f) | t > 2 = set (pointerToItem . itUse) (withWarmUp (t-1) f)
$ set (pointerToItem . itUseTime) 2 $ set (pointerToItem . itUseTime) 2
$ soundFrom (CrWeaponSound cid) 26 2 0 $ soundFrom (CrWeaponSound cid) 26 2 0
w w
| t > 0 = set (pointerToItem . wpFire) (withWarmUp (t-1) f) | t > 0 = set (pointerToItem . itUse) (withWarmUp (t-1) f)
$ set (pointerToItem . itUseTime) 2 $ set (pointerToItem . itUseTime) 2
w w
| otherwise = set (pointerToItem . wpFire) (withWarmUp 1 f) | otherwise = set (pointerToItem . itUse) (withWarmUp 1 f)
$ over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) $ over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1)
$ set (pointerToItem . itUseTime) 2 $ set (pointerToItem . itUseTime) 2
$ f cid $ f cr
$ soundFrom (CrWeaponSound cid) 28 2 0 $ soundFrom (CrWeaponSound cid) 28 2 0
w w
where where
cr = _creatures w IM.! cid cid = _crID cr
itRef = _crInvSel cr itRef = _crInvSel cr
item = _crInv cr IM.! itRef item = _crInv cr IM.! itRef
pointerToItem = creatures . ix cid . crInv . ix itRef pointerToItem = creatures . ix cid . crInv . ix itRef
@@ -120,33 +118,36 @@ Adds a sound to a creature based world effect.
The sound is emitted from the creature's position. -} The sound is emitted from the creature's position. -}
withSound withSound
:: Int -- ^ Sound id :: Int -- ^ Sound id
-> (Int -> World -> World) -- ^ Underlying effect -> (Creature -> World -> World) -- ^ Underlying effect
-> Int -- ^ Creature id -> Creature
-> World -> World -> World -> World
withSound soundid f cid w = (soundOncePos soundid p . f cid) w withSound soundid f cr w = (soundOncePos soundid p . f cr) w
where where
cid = _crID cr
p = _crPos (_creatures w IM.! cid) p = _crPos (_creatures w IM.! cid)
withRecoil withRecoil
:: Float -- ^ Recoil amount :: Float -- ^ Recoil amount
-> (Int -> World -> World) -> (Creature -> World -> World)
-- ^ Underlying world effect, takes creature id as input -- ^ Underlying world effect, takes creature id as input
-> Int -- ^ Creature id -> Creature
-> World -> World -> World -> World
withRecoil recoilAmount eff cid = eff cid . over (creatures . ix cid) pushback withRecoil recoilAmount eff cr = eff cr . over (creatures . ix cid) pushback
where where
cid = _crID cr
pushback cr = over crPos (+.+ rotateV (_crDir cr) ((-recoilAmount) / _crMass cr ,0)) cr pushback cr = over crPos (+.+ rotateV (_crDir cr) ((-recoilAmount) / _crMass cr ,0)) cr
{- | {- |
Pushes a creature sideways by a random amount. Pushes a creature sideways by a random amount.
Applied before the underlying effect. -} Applied before the underlying effect. -}
withSidePush withSidePush
:: Float -- ^ Maximal possible side push amount :: Float -- ^ Maximal possible side push amount
-> (Int -> World -> World) -> (Creature -> World -> World)
-- ^ Underlying world effect, takes creature id as input -- ^ Underlying world effect, takes creature id as input
-> Int -- ^ Creature id -> Creature
-> World -> World -> World -> World
withSidePush maxSide eff cid w = eff cid . over (creatures . ix cid) push $ w withSidePush maxSide eff cr w = eff cr . over (creatures . ix cid) push $ w
where where
cid = _crID cr
push cr = over crPos (+.+ rotateV (_crDir cr) (0,pushAmount / _crMass cr)) cr push cr = over crPos (+.+ rotateV (_crDir cr) (0,pushAmount / _crMass cr)) cr
(pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w (pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w
{- | {- |
@@ -154,31 +155,32 @@ Pushes a creature sideways by a random amount.
Applied after the underlying effect. -} Applied after the underlying effect. -}
withSidePushAfter withSidePushAfter
:: Float -- ^ Maximal possible side push amount :: Float -- ^ Maximal possible side push amount
-> (Int -> World -> World) -> (Creature -> World -> World)
-- ^ Underlying world effect, takes creature id as input -- ^ Underlying world effect, takes creature id as input
-> Int -- ^ Creature id -> Creature -- ^ Creature id
-> World -> World -> World -> World
withSidePushAfter maxSide eff cid w = over (creatures . ix cid) push . eff cid $ w withSidePushAfter maxSide eff cr w = over (creatures . ix cid) push . eff cr $ w
where where
cid = _crID cr
push cr = over crPos (+.+ rotateV (_crDir cr) (0,pushAmount / _crMass cr)) cr push cr = over crPos (+.+ rotateV (_crDir cr) (0,pushAmount / _crMass cr)) cr
(pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w (pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w
{- | {- |
Applies a world effect and sound effect after an ammo check. -} Applies a world effect and sound effect after an ammo check. -}
shootWithSound shootWithSound
:: Int -- ^ Sound identifier :: Int -- ^ Sound identifier
-> (Int -> World -> World) -> (Creature -> World -> World)
-- ^ Shoot effect, takes creature id as input -- ^ Shoot effect, takes creature id as input
-> Int -- ^ Creature id -> Creature
-> World -> World -> World -> World
shootWithSound soundid f cid w shootWithSound soundid f cr w
| fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1)
$ soundOncePos soundid (_crPos cr) $ soundOncePos soundid (_crPos cr)
$ set (pointerToItem . itUseTime) (_itUseRate item) $ set (pointerToItem . itUseTime) (_itUseRate item)
$ f cid w $ f cr w
| reloadCondition = fromMaybe w $ startReloadingWeapon cid w | reloadCondition = fromMaybe w $ startReloadingWeapon cr w
| otherwise = w | otherwise = w
where where
cr = _creatures w IM.! cid cid = _crID cr
itRef = _crInvSel cr itRef = _crInvSel cr
item = _crInv cr IM.! itRef item = _crInv cr IM.! itRef
pointerToItem = creatures . ix cid . crInv . ix itRef pointerToItem = creatures . ix cid . crInv . ix itRef
@@ -189,47 +191,47 @@ shootWithSound soundid f cid w
{- | {- |
Applies a world effect after an item use cooldown check. -} Applies a world effect after an item use cooldown check. -}
useTimeCheck useTimeCheck
:: (Int -> World -> World) -- ^ Underlying effect :: (Creature -> World -> World) -- ^ Underlying effect
-> Int -- ^ Creature id -> Creature
-> World -> World
-> World -> World
useTimeCheck f cid w = case theItem ^? itUseTime of useTimeCheck f cr w = case theItem ^? itUseTime of
Just 0 -> f cid $ setUseTime w Just 0 -> f cr $ setUseTime w
_ -> w _ -> w
where where
cr = _creatures w IM.! cid cid = _crID cr
setUseTime = creatures . ix cid . crInv . ix (_crInvSel cr) . itUseTime +~ useRate setUseTime = creatures . ix cid . crInv . ix (_crInvSel cr) . itUseTime +~ useRate
theItem = _crInv cr IM.! _crInvSel cr theItem = _crInv cr IM.! _crInvSel cr
useRate = fromMaybe 0 $ theItem ^? itUseRate useRate = fromMaybe 0 $ theItem ^? itUseRate
{- | {- |
Applies a world effect after a hammer position check. -} Applies a world effect after a hammer position check. -}
hammerCheck hammerCheck
:: (Int -> World -> World) -- ^ Underlying effect :: (Creature -> World -> World) -- ^ Underlying effect
-> Int -- ^ Creature id -> Creature
-> World -> World
-> World -> World
hammerCheck f cid w = case (_crInv cr IM.! _crInvSel cr) ^? itHammer of hammerCheck f cr w = case (_crInv cr IM.! _crInvSel cr) ^? itHammer of
Just HammerUp -> f cid $ setHammerDown w Just HammerUp -> f cr $ setHammerDown w
_ -> setHammerDown w _ -> setHammerDown w
where where
cr = _creatures w IM.! cid cid = _crID cr
setHammerDown = creatures . ix cid . crInv . ix (_crInvSel cr) . itHammer .~ HammerDown setHammerDown = creatures . ix cid . crInv . ix (_crInvSel cr) . itHammer .~ HammerDown
{- | {- |
Applies a world effect after an ammo check. -} Applies a world effect after an ammo check. -}
shoot shoot
:: (Int -> World -> World) :: (Creature -> World -> World)
-- ^ Underlying effect, takes creature id as input -- ^ Underlying effect
-> Int -- ^ Creature id -> Creature
-> World -> World
-> World -> World
shoot f cid w shoot f cr w
| fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1)
$ set (pointerToItem . itUseTime) (_itUseRate item) $ set (pointerToItem . itUseTime) (_itUseRate item)
$ f cid w $ f cr w
| reloadCondition = fromMaybe w $ startReloadingWeapon cid w | reloadCondition = fromMaybe w $ startReloadingWeapon cr w
| otherwise = w | otherwise = w
where where
cr = _creatures w IM.! cid cid = _crID cr
itRef = _crInvSel cr itRef = _crInvSel cr
item = _crInv cr IM.! itRef item = _crInv cr IM.! itRef
pointerToItem = creatures . ix cid . crInv . ix itRef pointerToItem = creatures . ix cid . crInv . ix itRef
@@ -239,43 +241,45 @@ shoot f cid w
reloadCondition = _wpLoadedAmmo item == 0 reloadCondition = _wpLoadedAmmo item == 0
withMuzFlare withMuzFlare
:: (Int -> World -> World) -- ^ Underlying effect :: (Creature -> World -> World) -- ^ Underlying effect
-> Int -- ^ Creature id -> Creature
-> World -> World
-> World -> World
withMuzFlare f cid w = tempLightForAt 3 pos . muzzleFlashAt pos2 $ f cid w withMuzFlare f cr w = tempLightForAt 3 pos . muzzleFlashAt pos2 $ f cr w
where where
cr = _creatures w IM.! cid cid = _crID cr
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr) pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
{- | {- |
Rotates the creature randomly, applies the effect, rotates the creature back. -} Rotates the creature randomly, applies the effect, rotates the creature back. -}
withRandomDir withRandomDir
:: Float -- ^ Max possible rotation :: Float -- ^ Max possible rotation
-> (Int -> World -> World) -> (Creature -> World -> World)
-- ^ Underlying effect -- ^ Underlying effect
-> Int -- ^ Creature id -> Creature
-> World -> World
-> World -> World
withRandomDir acc f cid w = over (creatures . ix cid . crDir) (\d -> d - a) withRandomDir acc f cr w = over (creatures . ix cid . crDir) (\d -> d - a)
. f cid . f cr
. over (creatures . ix cid . crDir) (+ a) . over (creatures . ix cid . crDir) (+ a)
$ set randGen g $ set randGen g
w w
where (a, g) = randomR (-acc,acc) $ _randGen w where
cid = _crID cr
(a, g) = randomR (-acc,acc) $ _randGen w
{- | {- |
Creates a bullet with a given velocity, width, and 'HitEffect' -} Creates a bullet with a given velocity, width, and 'HitEffect' -}
withVelWthHiteff withVelWthHiteff
:: Point2 -- ^ Velocity, x direction is forward with respect to the creature :: Point2 -- ^ Velocity, x direction is forward with respect to the creature
-> Float -- ^ Bullet width -> Float -- ^ Bullet width
-> HitEffect -- ^ Bullet effect when hitting creature, wall etc -> HitEffect -- ^ Bullet effect when hitting creature, wall etc
-> Int -- ^ Creature id -> Creature -- ^ Creature id
-> World -> World
-> World -> World
withVelWthHiteff vel width hiteff cid w withVelWthHiteff vel width hiteff cr w
= over particles (newbul : ) $ set randGen g w = over particles (newbul : ) $ set randGen g w
where where
cr = _creatures w IM.! cid cid = _crID cr
newbul = aGenBulAt (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width newbul = aGenBulAt (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width
(colid, g) = randomR (0,11) $ _randGen w (colid, g) = randomR (0,11) $ _randGen w
dir = _crDir cr dir = _crDir cr
@@ -284,37 +288,38 @@ withVelWthHiteff vel width hiteff cid w
Translate the creature sideways a random amount, apply the effect, translate back. -} Translate the creature sideways a random amount, apply the effect, translate back. -}
withRandomOffset withRandomOffset
:: Float -- ^ Max possible translate :: Float -- ^ Max possible translate
-> (Int -> World -> World) -> (Creature -> World -> World)
-- ^ Underlying effect -- ^ Underlying effect
-> Int -- ^ Creature id -> Creature -- ^ Creature id
-> World -> World
-> World -> World
withRandomOffset offsetAmount f cid w withRandomOffset offsetAmount f cr w
= over (creatures . ix cid . crPos) (-.- offV) = over (creatures . ix cid . crPos) (-.- offV)
. f cid . f cr
. over (creatures . ix cid . crPos) (+.+ offV) . over (creatures . ix cid . crPos) (+.+ offV)
$ set randGen g $ set randGen g
w w
where where
(offsetVal , g) = randomR (-offsetAmount,offsetAmount) $ _randGen w (offsetVal , g) = randomR (-offsetAmount,offsetAmount) $ _randGen w
cr = _creatures w IM.! cid cid = _crID cr
offV = rotateV (_crDir cr) (0,offsetVal) offV = rotateV (_crDir cr) (0,offsetVal)
-- | Rotates a creature with minimum rotation at least 0.1. -- | Rotates a creature with minimum rotation at least 0.1.
-- Rotates the player creature before applying the effect, other creatures after. -- Rotates the player creature before applying the effect, other creatures after.
torqueBeforeForced torqueBeforeForced
:: Float -- ^ Max possible rotation (less the 0.1 forced rotation) :: Float -- ^ Max possible rotation (less the 0.1 forced rotation)
-> (Int -> World -> World) -> (Creature -> World -> World)
-- ^ Underlying effect -- ^ Underlying effect
-> Int -- ^ Creature id -> Creature
-> World -> World
-> World -> World
torqueBeforeForced torque feff cid w torqueBeforeForced torque feff cr w
| cid == 0 = feff cid $ w | cid == 0 = feff cr $ w
& randGen .~ g & randGen .~ g
& creatures . ix cid . crDir +~ rot' & creatures . ix cid . crDir +~ rot'
& cameraRot +~ rot' & cameraRot +~ rot'
| otherwise = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot') w | otherwise = feff cr $ set randGen g $ over (creatures . ix cid . crDir) (+rot') w
where where
cid = _crID cr
(rot, g) = randomR (-torque,torque) $ _randGen w (rot, g) = randomR (-torque,torque) $ _randGen w
rot' | rot < 0 = rot - 0.1 rot' | rot < 0 = rot - 0.1
| otherwise = rot + 0.1 | otherwise = rot + 0.1
@@ -322,29 +327,31 @@ torqueBeforeForced torque feff cid w
-- Note this currently (29/4/2021) rotates other creatures /after/ applying the effect. -- Note this currently (29/4/2021) rotates other creatures /after/ applying the effect.
torqueBefore torqueBefore
:: Float -- ^ Max possible rotation :: Float -- ^ Max possible rotation
-> (Int -> World -> World) -- ^ Underlying effect -> (Creature -> World -> World) -- ^ Underlying effect
-> Int -- ^ Creature id -> Creature -- ^ Creature id
-> World -> World
-> World -> World
torqueBefore torque feff cid w torqueBefore torque feff cr w
| cid == 0 = feff cid $ w | cid == 0 = feff cr $ w
& randGen .~ g & randGen .~ g
& creatures . ix cid . crDir +~ rot & creatures . ix cid . crDir +~ rot
& cameraRot +~ rot & cameraRot +~ rot
| otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) $ feff cid w | otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) $ feff cr w
where where
cid = _crID cr
(rot, g) = randomR (-torque,torque) $ _randGen w (rot, g) = randomR (-torque,torque) $ _randGen w
-- | Rotate a randomly creature after applying an effect. -- | Rotate a randomly creature after applying an effect.
torqueAfter torqueAfter
:: Float -- ^ Max possible rotation :: Float -- ^ Max possible rotation
-> (Int -> World -> World) -- ^ Underlying effect -> (Creature -> World -> World) -- ^ Underlying effect
-> Int -- ^ Creature id -> Creature -- ^ Creature id
-> World -> World
-> World -> World
torqueAfter torque feff cid w torqueAfter torque feff cr w
| cid == 0 = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff cid w | cid == 0 = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff cr w
| otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) $ feff cid w | otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) $ feff cr w
where where
cid = _crID cr
(rot, g) = randomR (-torque,torque) $ _randGen w (rot, g) = randomR (-torque,torque) $ _randGen w
rotateScope = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) rotateScope = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment . _Just . scopePos %~ rotateV rot . itAttachment . _Just . scopePos %~ rotateV rot
@@ -356,12 +363,12 @@ spreadNumVelWthHiteff
-> Point2 -- ^ Velocity, x is direction of creature -> Point2 -- ^ Velocity, x is direction of creature
-> Float -- ^ Bullet width -> Float -- ^ Bullet width
-> HitEffect -- ^ Effect when hitting creature, wall etc -> HitEffect -- ^ Effect when hitting creature, wall etc
-> Int -- ^ Creature id -> Creature -- ^ Creature id
-> World -> World
-> World -> World
spreadNumVelWthHiteff spread num vel wth eff cid w = over particles (newbuls ++) w spreadNumVelWthHiteff spread num vel wth eff cr w = over particles (newbuls ++) w
where where
cr = _creatures w IM.! cid cid = _crID cr
newbuls = zipWith3 newbuls = zipWith3
(\pos d colid -> aGenBulAt (Just cid) (numColor colid) pos (rotateV d vel) eff wth) (\pos d colid -> aGenBulAt (Just cid) (numColor colid) pos (rotateV d vel) eff wth)
poss dirs colids poss dirs colids
@@ -378,12 +385,12 @@ numVelWthHitEff
-> Point2 -- ^ Velocity, x axis is direction of creature -> Point2 -- ^ Velocity, x axis is direction of creature
-> Float -- ^ Bullet width -> Float -- ^ Bullet width
-> HitEffect -- ^ Effect when hitting creature, wall etc -> HitEffect -- ^ Effect when hitting creature, wall etc
-> Int -- ^ Creature id -> Creature -- ^ Creature id
-> World -> World
-> World -> World
numVelWthHitEff num vel wth eff cid w = over particles (newbuls ++) w numVelWthHitEff num vel wth eff cr w = over particles (newbuls ++) w
where where
cr = _creatures w IM.! cid cid = _crID cr
newbuls = zipWith newbuls = zipWith
(\p colid -> aGenBulAt (Just cid) (numColor colid) p (rotateV d vel) eff wth) (\p colid -> aGenBulAt (Just cid) (numColor colid) p (rotateV d vel) eff wth)
poss poss
@@ -400,16 +407,17 @@ Uses '_wpSpread' as a parameter for the current offset angle. -}
randWalkAngle randWalkAngle
:: Float -- ^ Max offset angle :: Float -- ^ Max offset angle
-> Float -- ^ Walk speed -> Float -- ^ Walk speed
-> (Int -> World -> World) -- ^ Underlying effect -> (Creature -> World -> World) -- ^ Underlying effect
-> Int -- ^ Creature id -> Creature -- ^ Creature id
-> World -> World
-> World -> World
randWalkAngle ma aspeed f cid w = w randWalkAngle ma aspeed f cr w = w
& creatures . ix cid . crDir -~ a & creatures . ix cid . crDir -~ a
& f cid & f cr
& creatures . ix cid . crDir +~ a & creatures . ix cid . crDir +~ a
& creatures . ix cid . crInv . ix i . wpSpread .~ newa & creatures . ix cid . crInv . ix i . wpSpread .~ newa
where where
cid = _crID cr
a = _wpSpread $ _crInv (_creatures w IM.! cid) IM.! i a = _wpSpread $ _crInv (_creatures w IM.! cid) IM.! i
(walka, _) = randomR (-aspeed,aspeed) (_randGen w) (walka, _) = randomR (-aspeed,aspeed) (_randGen w)
newa = min ma $ max (negate ma) (a + walka) newa = min ma $ max (negate ma) (a + walka)
+10 -8
View File
@@ -18,13 +18,15 @@ import Control.Lens
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
{- | {- |
Creates an outwardly increasing circle that draws creatures, even those behind walls. -} Creates an outwardly increasing circle that draws creatures, even those behind walls. -}
aSonarPulse :: Int -> World -> World aSonarPulse :: Creature -> World -> World
aSonarPulse cid w = over particles ((:) $ sonarPulseAt (_crPos (_creatures w IM.! cid))) w aSonarPulse cr w = over particles ((:) $ sonarPulseAt (_crPos cr)) w
{- | {- |
Creates an outwardly increasing circle that displays walls, even those behind other walls. -} Creates an outwardly increasing circle that displays walls, even those behind other walls. -}
aRadarPulse :: Int -> World -> World aRadarPulse :: Creature -> World -> World
aRadarPulse cid w = over particles ((:) $ radarPulseAt (_crPos (_creatures w IM.! cid))) w aRadarPulse cr w = over particles ((:) $ radarPulseAt (_crPos (_creatures w IM.! cid))) w
where
cid = _crID cr
{- | {- |
Radar blip at a point. Radar blip at a point.
@@ -113,16 +115,16 @@ mvRadar x p w pt =
aTractorBeam aTractorBeam
:: Int -- ^ Color id :: Int -- ^ Color id
-> Int -- ^ Creature id -> Creature -- ^ Creature id
-> World -> World
-> World -> World
aTractorBeam col cid w aTractorBeam col cr w
= set (creatures . ix cid . crInv . ix itRef . wpFire) = set (creatures . ix cid . crInv . ix itRef . itUse)
(shoot $ aTractorBeam ((col + 1) `mod` 10)) (shoot $ aTractorBeam ((col + 1) `mod` 10))
$ over projectiles (IM.insert i (tractorBeamAt col i pos dir)) w $ over projectiles (IM.insert i (tractorBeamAt col i pos dir)) w
where where
i = newProjectileKey w i = newProjectileKey w
cr = _creatures w IM.! cid cid = _crID cr
pos = _crPos cr +.+ ((_crRad cr + 10) *.* unitVectorAtAngle dir) pos = _crPos cr +.+ ((_crRad cr + 10) *.* unitVectorAtAngle dir)
dir = _crDir cr dir = _crDir cr
itRef = _crInvSel cr itRef = _crInvSel cr