Hlinting
This commit is contained in:
+139
-128
@@ -1,3 +1,7 @@
|
||||
{-
|
||||
Definitions of weapons.
|
||||
In progress: move out effects into other modules.
|
||||
-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
module Dodge.Item.Weapon
|
||||
( module Dodge.Item.Weapon
|
||||
@@ -12,14 +16,11 @@ import Dodge.WorldEvent
|
||||
import Dodge.Debug
|
||||
import Dodge.WallCreatureCollisions
|
||||
import Dodge.Default
|
||||
|
||||
import Dodge.Item.Draw
|
||||
|
||||
import Dodge.Item.Weapon.Bullet
|
||||
import Dodge.Item.Weapon.InventoryDisplay
|
||||
import Dodge.Item.Weapon.TriggerType
|
||||
import Dodge.Item.Weapon.Recock
|
||||
|
||||
import Geometry
|
||||
import Picture
|
||||
|
||||
@@ -33,15 +34,11 @@ 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
|
||||
@@ -371,7 +368,7 @@ maybeSetTarget f cid w = case join $ w ^? creatures . ix cid . crInv . ix itRef
|
||||
itRef = _crInvSel cr
|
||||
|
||||
shootBezier :: Point2 -> Int -> World -> World
|
||||
shootBezier targetp cid w = over particles' (theBullet :) w
|
||||
shootBezier targetp cid w = over particles (theBullet :) w
|
||||
where
|
||||
theBullet = aCurveBulAt
|
||||
(Just cid)
|
||||
@@ -678,24 +675,26 @@ aTeslaArc' cid w =
|
||||
teslaGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir)
|
||||
$ over projectiles (IM.insert i (makeTeslaArcAt i pos dir))
|
||||
$ set randGen g w
|
||||
where cr = (_creatures w IM.! cid)
|
||||
i = newProjectileKey w
|
||||
pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
|
||||
+.+ sideOffset *.* vNormal (unitVectorAtAngle dir)
|
||||
(sideOffset,g) = randomR (-5,5) $ _randGen w
|
||||
dir = _crDir cr
|
||||
where
|
||||
cr = (_creatures w IM.! cid)
|
||||
i = newProjectileKey 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)))
|
||||
aLaser cid w = over particles ((makeLaserAt phaseV pos dir (Just cid)) : )
|
||||
$ soundFrom LasSound 24 1 0
|
||||
$ laserGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir)
|
||||
w
|
||||
where cr = (_creatures w IM.! cid)
|
||||
i = newProjectileKey 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
|
||||
where
|
||||
cr = (_creatures w IM.! cid)
|
||||
i = newProjectileKey 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
|
||||
@@ -1043,13 +1042,20 @@ rateIncAB startRate fastRate shooteff1 shooteff2 cid w
|
||||
reloadCondition = _wpLoadedAmmo item == 0
|
||||
|
||||
|
||||
makeLaserAt :: Float -> Point2 -> Float -> Maybe Int -> Particle'
|
||||
makeLaserAt phaseV pos dir mcid = Particle'
|
||||
makeLaserAt :: Float -> Point2 -> Float -> Maybe Int -> Particle
|
||||
makeLaserAt phaseV pos dir mcid = Particle
|
||||
{ _ptDraw = const blank
|
||||
, _ptUpdate' = moveLaser phaseV pos dir mcid
|
||||
}
|
||||
|
||||
moveLaser :: Float -> Point2 -> Float -> Maybe Int -> World -> Particle' -> (World, Maybe Particle')
|
||||
moveLaser
|
||||
:: Float -- ^ Phase velocity, controls deflection in windows
|
||||
-> Point2
|
||||
-> Float
|
||||
-> Maybe Int
|
||||
-> World
|
||||
-> Particle
|
||||
-> (World, Maybe Particle)
|
||||
moveLaser phaseV pos dir mcid w pt
|
||||
= ( set randGen g
|
||||
-- $ over worldEvents ((.) flares)
|
||||
@@ -1058,61 +1064,62 @@ moveLaser phaseV pos dir mcid w pt
|
||||
,_ptUpdate' = ptTimer' 0
|
||||
}
|
||||
)
|
||||
where xp = pos +.+ 800 *.* unitVectorAtAngle dir
|
||||
(a,g) = randomR (-0.7,0.7) $ _randGen w
|
||||
reflectDir wall = a + (argV $ reflectIn
|
||||
(_wlLine wall !! 1 -.- _wlLine wall !! 0)
|
||||
(xp -.- pos)
|
||||
)
|
||||
(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 (pos -.- 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 [] pos xp
|
||||
hitEffect
|
||||
= case thHit of
|
||||
Just (p,E3x1 cr)
|
||||
-> over (creatures . ix (_crID cr) . crState . crDamage) ((:) $ Lasering 19 pos p xp)
|
||||
-- . over worldEvents ((.) $ flareAt yellow (flarePos p))
|
||||
Just (p,E3x2 wl) -> createSpark 8 colID (p +.+ safeNormalizeV (pos -.- p))
|
||||
(reflectDir wl) Nothing
|
||||
_ -> id
|
||||
pic = pictures [ fadeLine pos (head ps) 0.2 40 yellow
|
||||
, setLayer 1 $ color (withAlpha 0.9 white) $ vThickLine (pos:ps)
|
||||
, setLayer 1 $ color (withAlpha 0.5 yellow) $ vvThickLine (pos:ps)
|
||||
]
|
||||
where
|
||||
xp = pos +.+ 800 *.* unitVectorAtAngle dir
|
||||
(a,g) = randomR (-0.7,0.7) $ _randGen w
|
||||
reflectDir wall = a + (argV $ reflectIn
|
||||
(_wlLine wall !! 1 -.- _wlLine wall !! 0)
|
||||
(xp -.- pos)
|
||||
)
|
||||
(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 (pos -.- 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 [] pos xp
|
||||
hitEffect
|
||||
= case thHit of
|
||||
Just (p,E3x1 cr)
|
||||
-> over (creatures . ix (_crID cr) . crState . crDamage) ((:) $ Lasering 19 pos p xp)
|
||||
-- . over worldEvents ((.) $ flareAt yellow (flarePos p))
|
||||
Just (p,E3x2 wl) -> createSpark 8 colID (p +.+ safeNormalizeV (pos -.- p))
|
||||
(reflectDir wl) Nothing
|
||||
_ -> id
|
||||
pic = pictures [ fadeLine pos (head ps) 0.2 40 yellow
|
||||
, setLayer 1 $ color (withAlpha 0.9 white) $ vThickLine (pos:ps)
|
||||
, setLayer 1 $ color (withAlpha 0.5 yellow) $ vvThickLine (pos:ps)
|
||||
]
|
||||
|
||||
fadeLine :: Point2 -> Point2 -> Float -> Float -> Color -> Picture
|
||||
fadeLine sp ep alph width col = setLayer 1 $
|
||||
@@ -1693,18 +1700,21 @@ sonar = defaultGun
|
||||
}
|
||||
|
||||
aSonarPulse :: Int -> World -> World
|
||||
aSonarPulse cid w = over particles' ((:) $ sonarPulseAt (_crPos (_creatures w IM.! cid))) w
|
||||
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
|
||||
aRadarPulse cid w = over particles ((:) $ radarPulseAt (_crPos (_creatures w IM.! cid))) w
|
||||
|
||||
blipAt :: Point2 -> Color -> Int -> Particle'
|
||||
blipAt p col i = Particle'
|
||||
{-
|
||||
Radar blip at a point.
|
||||
-}
|
||||
blipAt :: Point2 -> Color -> Int -> Particle
|
||||
blipAt p col i = Particle
|
||||
{_ptDraw = const blank
|
||||
,_ptUpdate' = mvBlip p col i i
|
||||
}
|
||||
|
||||
mvBlip :: Point2 -> Color -> Int -> Int -> World -> Particle' -> (World, Maybe Particle')
|
||||
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)
|
||||
@@ -1715,67 +1725,68 @@ mvBlip p col maxt t w pt
|
||||
$ circleSolid 2)
|
||||
)
|
||||
|
||||
sonarPulseAt :: Point2 -> Particle'
|
||||
sonarPulseAt p = Particle'
|
||||
sonarPulseAt :: Point2 -> Particle
|
||||
sonarPulseAt p = Particle
|
||||
{ _ptDraw = const blank
|
||||
, _ptUpdate' = mvSonar 100 p
|
||||
}
|
||||
|
||||
mvSonar :: Int -> Point2 -> World -> Particle' -> (World, Maybe Particle')
|
||||
mvSonar :: Int -> Point2 -> World -> Particle -> (World, Maybe Particle)
|
||||
mvSonar 0 _ w _ = (w, Nothing)
|
||||
mvSonar x p w pt = (w, Just $ pt {_ptDraw = const pic
|
||||
,_ptUpdate' = mvSonar (x-1) p
|
||||
}
|
||||
)
|
||||
where pic = setDepth (-0.5) . setLayer 1 $ 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
|
||||
where
|
||||
pic = setDepth (-0.5) . setLayer 1 $ 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'
|
||||
radarPulseAt :: Point2 -> Particle
|
||||
radarPulseAt p = Particle
|
||||
{ _ptDraw = const blank
|
||||
, _ptUpdate' = mvRadar 50 p
|
||||
}
|
||||
|
||||
mvRadar :: Int -> Point2 -> World -> Particle' -> (World, Maybe Particle')
|
||||
mvRadar :: Int -> Point2 -> World -> Particle -> (World, Maybe Particle)
|
||||
mvRadar 0 _ w _ = (w, Nothing)
|
||||
mvRadar x p w pt = (putBlips w, Just $ pt {_ptDraw = const 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)
|
||||
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 = defaultEquipment
|
||||
{ _itIdentity = Generic
|
||||
@@ -1831,7 +1842,7 @@ itemLaserScopeEffect
|
||||
}
|
||||
where f cr invid w
|
||||
| invid == _crInvSel cr
|
||||
= w & particles' %~ (:) (makeLaserScope sp ep d reloadFrac)
|
||||
= w & particles %~ (:) (makeLaserScope sp ep d reloadFrac)
|
||||
& creatures . ix (_crID cr) . crInv . ix invid . itHammer %~ moveHammerUp
|
||||
& laserScopeTargetGlow col glowPoint
|
||||
-- this flare MAY be buggy... something to do with the creature glare
|
||||
@@ -1856,8 +1867,8 @@ itemLaserScopeEffect
|
||||
moveHammerUp !HammerDown = HammerReleased
|
||||
moveHammerUp !_ = HammerUp
|
||||
|
||||
makeLaserScope :: Point2 -> Point2 -> Float -> Float -> Particle'
|
||||
makeLaserScope p ep d relFrac = Particle'
|
||||
makeLaserScope :: Point2 -> Point2 -> Float -> Float -> Particle
|
||||
makeLaserScope p ep d relFrac = Particle
|
||||
{_ptDraw = const $ onLayer PtLayer $ pictures
|
||||
[color (withAlpha 0.5 $ mixColors relFrac (1-relFrac) red green)
|
||||
$ lineOfThickness 0.5 [p,ep]
|
||||
|
||||
+116
-95
@@ -20,12 +20,11 @@ import qualified Data.IntMap.Strict as IM
|
||||
|
||||
import Picture
|
||||
|
||||
-- bullet effects
|
||||
bulHitCr' :: Particle' -> Point2 -> Creature -> World -> World
|
||||
-- | bullet effects
|
||||
bulHitCr' :: Particle -> Point2 -> Creature -> World -> World
|
||||
bulHitCr' bt p cr w
|
||||
| crIsArmouredFrom p cr
|
||||
= createSpark 8 colID p1 (argV (p1 -.- p) + d1) Nothing
|
||||
. addDamageArmoured $ w
|
||||
= createSpark 8 colID p1 (argV (p1 -.- p) + d1) Nothing . addDamageArmoured $ w
|
||||
| otherwise
|
||||
= addDamage . hitSound . flashEff $ w
|
||||
where
|
||||
@@ -42,7 +41,10 @@ bulHitCr' bt p cr w
|
||||
(colID,_) = randomR (0,11) $ _randGen w
|
||||
p1 = p +.+ 2 *.* safeNormalizeV (p -.- _crPos cr)
|
||||
|
||||
bulBounceArmCr' :: Particle' -> Point2 -> Creature -> World -> World
|
||||
{-
|
||||
Bounce off armoured creatures, otherwise do damage.
|
||||
-}
|
||||
bulBounceArmCr' :: Particle -> Point2 -> Creature -> World -> World
|
||||
bulBounceArmCr' bt p cr w
|
||||
| crIsArmouredFrom p cr
|
||||
= addBouncer . addDamageArmoured $ w
|
||||
@@ -61,12 +63,15 @@ bulBounceArmCr' bt p cr w
|
||||
newDir = safeNormalizeV (p -.- _crPos cr)
|
||||
pOut = p +.+ 2 *.* newDir
|
||||
reflectVel = magV bulVel *.* newDir
|
||||
addBouncer = worldEvents %~ ((over particles' (bouncer :) ) . )
|
||||
addBouncer = worldEvents %~ ((over particles (bouncer :) ) . )
|
||||
bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel
|
||||
(_btHitEffect' bt) (_btWidth' bt)
|
||||
) {_btTimer' = _btTimer' bt - 1}
|
||||
|
||||
bulPenCr' :: Particle' -> Point2 -> Creature -> World -> World
|
||||
{-
|
||||
Bullet pass through creatures.
|
||||
-}
|
||||
bulPenCr' :: Particle -> Point2 -> Creature -> World -> World
|
||||
bulPenCr' bt p cr w
|
||||
= over (creatures . ix cid . crState . crDamage)
|
||||
(\dams -> [Piercing 50 sp p ep
|
||||
@@ -82,14 +87,16 @@ bulPenCr' bt p cr w
|
||||
cid = _crID cr
|
||||
sp = head $ _btTrail' bt
|
||||
ep = sp +.+ _btVel' bt
|
||||
addPiercer = (.) $ over particles' ((:) piercer)
|
||||
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)
|
||||
{- Heavy bullet effects when hitting creature:
|
||||
piercing, blunt, twisting and pushback damage all applied.
|
||||
-}
|
||||
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
|
||||
@@ -98,12 +105,13 @@ hvBulHitCr' bt p cr w
|
||||
)
|
||||
$ 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
|
||||
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' :: Particle -> Point2 -> Creature -> World -> World
|
||||
bulIncCr' bt p cr w
|
||||
= over (creatures . ix cid . crState . crDamage)
|
||||
(\dams -> [Piercing 60 sp p ep
|
||||
@@ -112,13 +120,17 @@ bulIncCr' bt p cr w
|
||||
$ 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 $ (.) (makeFlameletTimed p v Nothing 3 20)
|
||||
where
|
||||
cid = _crID cr
|
||||
sp = head $ _btTrail' bt
|
||||
ep = sp +.+ _btVel' bt
|
||||
v = evalState (randInCirc 1) $ _randGen w
|
||||
incFlamelets = over worldEvents $ (.) (makeFlameletTimed p v Nothing 3 20)
|
||||
|
||||
bulConCr' :: Particle' -> Point2 -> Creature -> World -> World
|
||||
{-
|
||||
Creates a shockwave when hitting a creature.
|
||||
-}
|
||||
bulConCr' :: Particle -> Point2 -> Creature -> World -> World
|
||||
bulConCr' bt p cr w
|
||||
= over (creatures . ix cid . crState . crDamage)
|
||||
(\dams -> [Piercing 60 sp p ep
|
||||
@@ -127,31 +139,39 @@ bulConCr' bt p cr w
|
||||
$ 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)
|
||||
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
|
||||
{-
|
||||
Hitting wall effects: create a spark, damage blocks.
|
||||
-}
|
||||
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 $ _projectiles 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
|
||||
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 $ _projectiles 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
|
||||
{-
|
||||
Bounce off walls, do damage to blocks.
|
||||
-}
|
||||
bulBounceWall' :: Particle -> Point2 -> Wall -> World -> World
|
||||
bulBounceWall' bt p wl w = damageBlocks wl $ over worldEvents addBouncer w
|
||||
where
|
||||
sp = head $ _btTrail' bt
|
||||
@@ -165,71 +185,72 @@ bulBounceWall' bt p wl w = damageBlocks wl $ over worldEvents addBouncer w
|
||||
) {_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
|
||||
addBouncer = (.) ( over particles (bouncer : ) )
|
||||
-- the hack is to get around the fact that the particles list gets reset after
|
||||
-- all projectiles 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 $ (.) (makeFlameletTimed pOut reflectVel Nothing 3 20)
|
||||
{- Create flamelet on wall.
|
||||
-}
|
||||
bulIncWall' :: Particle -> Point2 -> Wall -> World -> World
|
||||
bulIncWall' bt p wl w = damageBlocks wl $ incFlamelets 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 $ (.) (makeFlameletTimed pOut reflectVel Nothing 3 20)
|
||||
|
||||
bulConWall' :: Particle' -> Point2 -> Wall -> World -> World
|
||||
bulConWall' bt p wl w = damageBlocks wl
|
||||
$ mkwave
|
||||
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)
|
||||
{- Create a shockwave on wall-}
|
||||
bulConWall' :: Particle -> Point2 -> Wall -> World -> World
|
||||
bulConWall' bt p wl w = damageBlocks wl $ mkwave 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 $ _projectiles 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
|
||||
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
|
||||
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 $ _projectiles 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
|
||||
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' = destroyOnImpact bulHitCr' bulHitWall' bulHitFF'
|
||||
|
||||
bulletParticleSideEffect :: Particle' -> HitEffect
|
||||
bulletParticleSideEffect :: Particle -> HitEffect
|
||||
bulletParticleSideEffect pt = destroyOnImpact mkPt mkPt noEff
|
||||
where mkPt _ p _ = over particles' ((:) pt {_btTrail' = [p]})
|
||||
where
|
||||
mkPt _ p _ = over particles ((pt {_btTrail' = [p]}) :)
|
||||
|
||||
aGenBulAt' :: Maybe Int -> Color -> Point2 -> Point2 -> HitEffect -> Float -> Particle'
|
||||
aGenBulAt' :: Maybe Int -> Color -> Point2 -> Point2 -> HitEffect -> Float -> Particle
|
||||
aGenBulAt' maycid col pos vel hiteff width = Bul'
|
||||
{ _ptDraw = drawBul
|
||||
, _ptUpdate' = mvGenBullet'
|
||||
@@ -242,7 +263,7 @@ aGenBulAt' maycid col pos vel hiteff width = Bul'
|
||||
, _btHitEffect' = hiteff
|
||||
}
|
||||
|
||||
aCurveBulAt :: Maybe Int -> Color -> Point2 -> Point2 -> Point2 -> HitEffect -> Float -> Particle'
|
||||
aCurveBulAt :: Maybe Int -> Color -> Point2 -> Point2 -> Point2 -> HitEffect -> Float -> Particle
|
||||
aCurveBulAt maycid col pos control targ hiteff width = Bul'
|
||||
{ _ptDraw = drawBul
|
||||
, _ptUpdate' = \w -> mvGenBullet' w . setVel
|
||||
|
||||
@@ -192,7 +192,7 @@ withVelWthHiteff
|
||||
-> World
|
||||
-> World
|
||||
withVelWthHiteff vel width hiteff cid w
|
||||
= over particles' ((:) newbul) $ set randGen g w
|
||||
= over particles (newbul : ) $ set randGen g w
|
||||
where
|
||||
cr = _creatures w IM.! cid
|
||||
newbul = aGenBulAt' (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width
|
||||
@@ -281,7 +281,7 @@ spreadNumVelWthHiteff
|
||||
-> World
|
||||
-> World
|
||||
spreadNumVelWthHiteff spread num vel wth eff cid w
|
||||
= over particles' (newbuls ++) w
|
||||
= over particles (newbuls ++) w
|
||||
where
|
||||
cr = _creatures w IM.! cid
|
||||
newbuls = zipWith3 (\pos d colid -> aGenBulAt' (Just cid) (numColor colid)
|
||||
@@ -306,7 +306,7 @@ numVelWthHitEff
|
||||
-> World
|
||||
-> World
|
||||
numVelWthHitEff num vel wth eff cid w
|
||||
= over particles' (newbuls ++) w
|
||||
= over particles (newbuls ++) w
|
||||
where
|
||||
cr = _creatures w IM.! cid
|
||||
newbuls = zipWith (\pos colid -> aGenBulAt' (Just cid) (numColor colid)
|
||||
|
||||
Reference in New Issue
Block a user