justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Linting, refactor random angle walk for flamer

Browse Source
This commit is contained in:
justin
2021-04-30 13:21:37 +02:00
parent 619756dd73
commit c8e84c775f
14 changed files with 460 additions and 377 deletions
Download Patch File Download Diff File Expand all files Collapse all files
shader/fullscreen.frag
+5
View File
@@ -6,6 +6,11 @@ uniform sampler2D screenTexture;
void main() void main()
{ {
// vec4 col = vec4(0,0,0,0);
// for (int i = 0; i < 9; i++)
// {
// col +=
// }
fColor = texture(screenTexture, vTexPos); fColor = texture(screenTexture, vTexPos);
// fColor = vec4(1,1,1,0); // fColor = vec4(1,1,1,0);
} }
src/Dodge/Creature.hs
+1 -1
View File
@@ -266,7 +266,7 @@ startInventory = IM.fromList (zip [0..20]
( (
[lasGun [lasGun
,autoGun ,autoGun
,bezierGun ,flamer
--,blinkGun --,blinkGun
--,spawnGun lamp --,spawnGun lamp
--,poisonSprayer --,poisonSprayer
src/Dodge/Default.hs
+3 -7
View File
@@ -6,8 +6,7 @@ Description : Instances of data structures
This module contains prototypical data structures. This module contains prototypical data structures.
-} -}
module Dodge.Default where module Dodge.Default where
import Dodge.Item.Weapon.ExtraEffect
import Dodge.Item.Weapon.Recock
import Dodge.Data import Dodge.Data
import Dodge.Data.Menu import Dodge.Data.Menu
import Dodge.SoundLogic import Dodge.SoundLogic
@@ -24,10 +23,8 @@ import qualified Data.Map as M
import qualified Data.Set as S import qualified Data.Set as S
import Data.Graph.Inductive.Graph hiding ((&)) import Data.Graph.Inductive.Graph hiding ((&))
import Data.List import Data.List
{- {-
Indestructible wall. Indestructible wall. -}
-}
defaultWall = Wall defaultWall = Wall
{ _wlLine = [(0,0),(50,0)] { _wlLine = [(0,0),(50,0)]
, _wlID = 0 , _wlID = 0
@@ -37,8 +34,7 @@ defaultWall = Wall
} }
{- {-
Door that opens on approach. Door that opens on approach.
Pathable. Pathable. -}
-}
defaultAutoDoor = Door defaultAutoDoor = Door
{ _wlLine = [(0,0),(50,0)] { _wlLine = [(0,0),(50,0)]
, _wlID = 0 , _wlID = 0
src/Dodge/Event.hs
+9 -7
View File
@@ -67,7 +67,7 @@ handleMouseWheelEvent mwev w = case _menuLayers w of
| otherwise -> Just w | otherwise -> Just w
_ -> Just w _ -> Just w
{- {- |
Resets the world window size, and resizes the fbo that gets the light map drawn into it. Resets the world window size, and resizes the fbo that gets the light map drawn into it.
-} -}
handleResizeEvent :: WindowSizeChangedEventData -> World -> Maybe World handleResizeEvent :: WindowSizeChangedEventData -> World -> Maybe World
@@ -122,14 +122,16 @@ wheelDownEvent w = case _carteDisplay w of
upInvPos :: World -> World upInvPos :: World -> World
upInvPos w = stopSoundFrom (CrReloadSound 0) $ set (creatures . ix (_yourID w) . crInvSel) x w upInvPos w = stopSoundFrom (CrReloadSound 0) $ set (creatures . ix (_yourID w) . crInvSel) x w
where is = IM.keys $ _crInv $ _creatures w IM.! _yourID w where
isis = is ++ is is = IM.keys $ _crInv $ _creatures w IM.! _yourID w
x = before (_crInvSel (you w)) isis isis = is ++ is
x = before (_crInvSel (you w)) isis
downInvPos :: World -> World downInvPos :: World -> World
downInvPos w = stopSoundFrom (CrReloadSound 0) $ set (creatures . ix (_yourID w) . crInvSel) x w downInvPos w = stopSoundFrom (CrReloadSound 0) $ set (creatures . ix (_yourID w) . crInvSel) x w
where is = IM.keys $ _crInv $ _creatures w IM.! _yourID w where
isis = is ++ is is = IM.keys $ _crInv $ _creatures w IM.! _yourID w
x = after (_crInvSel (you w)) isis isis = is ++ is
x = after (_crInvSel (you w)) isis
-- these are incomplete: should put in error case here! -- these are incomplete: should put in error case here!
before y (x:z:ys) | y == z = x before y (x:z:ys) | y == z = x
src/Dodge/Item/Weapon.hs
+36 -201
View File
@@ -1,4 +1,4 @@
{- {- |
Definitions of weapons. Definitions of weapons.
In progress: move out effects into other modules. In progress: move out effects into other modules.
-} -}
@@ -16,9 +16,11 @@ import Dodge.WorldEvent
import Dodge.Default import Dodge.Default
import Dodge.Item.Draw import Dodge.Item.Draw
import Dodge.Item.Weapon.Bullet import Dodge.Item.Weapon.Bullet
import Dodge.Item.Weapon.Decoration
import Dodge.Item.Weapon.InventoryDisplay import Dodge.Item.Weapon.InventoryDisplay
import Dodge.Item.Weapon.TriggerType import Dodge.Item.Weapon.TriggerType
import Dodge.Item.Weapon.Recock import Dodge.Item.Weapon.ExtraEffect
import Dodge.Item.Weapon.UseEffect
import Dodge.Item.Attachment.Data import Dodge.Item.Attachment.Data
import Dodge.Item.Attachment import Dodge.Item.Attachment
import Geometry import Geometry
@@ -410,7 +412,7 @@ ltAutoGun = defaultAutoGun
, _wpFireRate = 4 , _wpFireRate = 4
, _wpFireState = 0 , _wpFireState = 0
, _wpFire = shootWithSound 0 . withRandomDir 0.3 . withSidePush 50 , _wpFire = shootWithSound 0 . withRandomDir 0.3 . withSidePush 50
. withMuzFlare $ withVelWthHiteff (30,0) 2 bulletEffect' . withMuzFlare $ withVelWthHiteff (30,0) 2 basicBulletEffect
, _wpSpread = 0.5 , _wpSpread = 0.5
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color green $ pictures [polygon $ rectNSWE 4 (-4) (-4) 0 , _itFloorPict = onLayer FlItLayer $ color green $ pictures [polygon $ rectNSWE 4 (-4) (-4) 0
@@ -461,7 +463,7 @@ spreadGun = defaultGun
, _wpFire = shootWithSound (fromIntegral shotgunSound) , _wpFire = shootWithSound (fromIntegral shotgunSound)
. withRecoil 100 . withRecoil 100
. withMuzFlare . withMuzFlare
$ spreadNumVelWthHiteff spreadGunSpread 9 (30,0) 2 bulletEffect' $ spreadNumVelWthHiteff spreadGunSpread 9 (30,0) 2 basicBulletEffect
, _wpSpread = spreadGunSpread , _wpSpread = spreadGunSpread
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)] , _itFloorPict = onLayer FlItLayer $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)]
@@ -504,7 +506,7 @@ multGun = defaultGun
, _wpFire = shootWithSound (fromIntegral shotgunSound) , _wpFire = shootWithSound (fromIntegral shotgunSound)
. withRecoil 200 . withRecoil 200
. withMuzFlare . withMuzFlare
$ numVelWthHitEff 5 (50,0) 5 bulletEffect' $ numVelWthHitEff 5 (50,0) 5 basicBulletEffect
, _wpSpread = spreadGunSpread , _wpSpread = spreadGunSpread
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ multGunPic , _itFloorPict = onLayer FlItLayer $ multGunPic
@@ -571,7 +573,7 @@ poisonSprayer = defaultAutoGun
, _wpFireRate = 0 , _wpFireRate = 0
, _wpFireState = 0 , _wpFireState = 0
, _wpFire = shoot $ aGasCloud , _wpFire = shoot $ aGasCloud
, _wpSpread = flamerAngle , _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)
, _itAmount = 1 , _itAmount = 1
@@ -591,8 +593,8 @@ flamer = defaultAutoGun
, _wpReloadState = 0 , _wpReloadState = 0
, _wpFireRate = 0 , _wpFireRate = 0
, _wpFireState = 0 , _wpFireState = 0
, _wpFire = shoot $ aFlame 0 , _wpFire = shoot $ withSidePushAfter 10 $ randWalkAngle 0.5 0.05 aFlame
, _wpSpread = flamerAngle , _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)
, _itAmount = 1 , _itAmount = 1
@@ -804,30 +806,16 @@ aGasCloud cid 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 :: Float -> Int -> World -> World aFlame cid w = insertFlame w
aFlame a cid w where
= shakeCr cid 2 (t,_) = randomR (99,101) (_randGen w)
$ insertFlame $ resetAngle $ set randGen g $ cr = (_creatures w IM.! cid)
w dir = _crDir cr
where pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
(a2,g) = randomR (-0.1,0.1) (_randGen w) vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir
(t,_) = randomR (99,101) (_randGen w) insertFlame = makeFlame t pos vel (Just cid) -- . makeFlame pos2 vel (Just cid)
angle = min flamerAngle $ max (-flamerAngle) (a + a2)
cr = (_creatures w IM.! cid)
dir = _crDir cr + angle
pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
w1 = set randGen g w
vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir
insertFlame = makeFlame t pos vel (Just cid) -- . makeFlame pos2 vel (Just cid)
resetAngle = set (creatures . ix cid . crInv . ix (_crInvSel cr) . wpFire)
(shoot $ aFlame angle)
flamerAngle = 0.3
aSelf :: Int -> World -> World aSelf :: Int -> World -> World
aSelf = blinkAction aSelf = blinkAction
@@ -1610,14 +1598,8 @@ thinLine = lineOfThickness 1
someJust (Just x) | x > 0 = True someJust (Just x) | x > 0 = True
| otherwise = False | otherwise = False
{- |
shakeCr :: Int -> Float -> World -> World Sends out pulses that display walls. -}
shakeCr cID amount w =
let vec = vNormal $ unitVectorAtAngle $ _crDir $ _creatures w IM.! cID
(x,g) = randomR (-amount,amount) $ _randGen w
in set randGen g . over (creatures . ix cID . crPos) (+.+ (x *.* vec)) $ w
radar = defaultGun radar = defaultGun
{ _itName = "RADAR" { _itName = "RADAR"
, _itIdentity = Generic , _itIdentity = Generic
@@ -1627,7 +1609,7 @@ radar = defaultGun
, _wpReloadState = 0 , _wpReloadState = 0
, _wpFireRate = 120 , _wpFireRate = 120
, _wpFireState = 0 , _wpFireState = 0
, _wpFire = shoot $ aRadarPulse , _wpFire = shoot aRadarPulse
, _wpSpread = autogunSpread , _wpSpread = autogunSpread
, _wpRange = 20 , _wpRange = 20
, _itHammer = HammerUp , _itHammer = HammerUp
@@ -1638,7 +1620,8 @@ radar = defaultGun
, _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1} , _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1}
, _itEquipPict = drawWeapon $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) , _itEquipPict = drawWeapon $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
} }
{- |
Sends out pulses that display creatures. -}
sonar = defaultGun sonar = defaultGun
{ _itName = "SONAR" { _itName = "SONAR"
, _itIdentity = Generic , _itIdentity = Generic
@@ -1648,7 +1631,7 @@ sonar = defaultGun
, _wpReloadState = 0 , _wpReloadState = 0
, _wpFireRate = 120 , _wpFireRate = 120
, _wpFireState = 0 , _wpFireState = 0
, _wpFire = shoot $ aSonarPulse , _wpFire = shoot aSonarPulse
, _wpSpread = autogunSpread , _wpSpread = autogunSpread
, _wpRange = 20 , _wpRange = 20
, _itHammer = HammerUp , _itHammer = HammerUp
@@ -1659,96 +1642,8 @@ sonar = defaultGun
, _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1} , _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1}
, _itEquipPict = drawWeapon $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) , _itEquipPict = drawWeapon $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
} }
{- |
aSonarPulse :: Int -> World -> World Automatically sends out pulses that display creatures. -}
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
{-
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 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)
& ptDraw .~ (const . setDepth (-0.5)
. setLayer 1
$ uncurry translate p
$ color (withAlpha (fromIntegral t / fromIntegral maxt) col)
$ circleSolid 2)
)
sonarPulseAt :: Point2 -> Particle
sonarPulseAt p = Particle
{ _ptDraw = const blank
, _ptUpdate' = mvSonar 100 p
}
mvSonar :: Int -> Point2 -> World -> Particle -> (World, Maybe Particle)
mvSonar 0 _ w _ = (w, Nothing)
mvSonar x p w pt = (w, Just $ pt {_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
radarPulseAt :: Point2 -> Particle
radarPulseAt p = Particle
{ _ptDraw = const blank
, _ptUpdate' = mvRadar 50 p
}
mvRadar :: Int -> Point2 -> World -> Particle -> (World, Maybe Particle)
mvRadar 0 _ w _ = (w, Nothing)
mvRadar x p w pt = (putBlips w, Just $ pt {_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)
autoSonar = defaultEquipment autoSonar = defaultEquipment
{ _itIdentity = Generic { _itIdentity = Generic
, _itName = "AUTOSONAR" , _itName = "AUTOSONAR"
@@ -1762,6 +1657,8 @@ autoSonar = defaultEquipment
, _itAimingRange = 0 , _itAimingRange = 0
, _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1} , _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1}
} }
{- |
Automatically sends out pulses that display walls. -}
autoRadar = defaultEquipment autoRadar = defaultEquipment
{ _itIdentity = Generic { _itIdentity = Generic
, _itName = "AUTORADAR" , _itName = "AUTORADAR"
@@ -1775,74 +1672,8 @@ autoRadar = defaultEquipment
, _itAimingRange = 0 , _itAimingRange = 0
, _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1} , _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1}
} }
{- |
autoRadarEffect :: ItEffect Creates a creature next to the creature using the item. -}
autoRadarEffect = ItInvEffect {_itInvEffect = f 50
,_itEffectCounter = 0
}
where f 0 cr i w = aRadarPulse (_crID cr)
w & creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f 100
f t cr i w = w & creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f (t-1)
autoSonarEffect :: ItEffect
autoSonarEffect = ItInvEffect {_itInvEffect = f 50
,_itEffectCounter = 0
}
where f 0 cr i w = aSonarPulse (_crID cr)
w & creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f 140
f t cr i w = w & creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f (t-1)
itemLaserScopeEffect :: ItEffect
itemLaserScopeEffect
= ItInvEffect {_itInvEffect = f
,_itEffectCounter = 0
}
where f cr invid w
| invid == _crInvSel cr
= w & particles %~ (:) (makeLaserScope sp ep d reloadFrac)
& creatures . ix (_crID cr) . crInv . ix invid . itHammer %~ moveHammerUp
& laserScopeTargetGlow col glowPoint
-- this flare MAY be buggy... something to do with the creature glare
| otherwise = w
where
p = _crPos cr
d = _crDir cr
r = _crRad cr
sp = (p +.+ (r + 3) *.* unitVectorAtAngle d)
xp = sp +.+ 3000 *.* unitVectorAtAngle d
ep = case listToMaybe $ thingsHitLongLine sp xp w of
Just (p,_) -> p
Nothing -> xp
glowPoint = case listToMaybe $ thingsHitLongLine sp xp w of
Just (p,E3x2 wl) -> p +.+ 2 *.* wallNormal wl
_ -> (ep -.- 2 *.* unitVectorAtAngle d)
it = (cr ^. crInv) IM.! invid
reloadFrac
| _wpLoadedAmmo it == 0 = 1
| otherwise = fromIntegral (_wpReloadState it) / fromIntegral (_wpReloadTime it)
col = mixColors reloadFrac (1-reloadFrac) red green
moveHammerUp !HammerDown = HammerReleased
moveHammerUp !_ = HammerUp
makeLaserScope :: Point2 -> Point2 -> Float -> Float -> Particle
makeLaserScope p ep d relFrac = Particle
{_ptDraw = const $ onLayer PtLayer $ pictures
[color (withAlpha 0.5 $ mixColors relFrac (1-relFrac) red green)
$ lineOfThickness 0.5 [p,ep]
,color (withAlpha 0.2 $ mixColors relFrac (1-relFrac) red green)
$ lineOfThickness 1.5 [p,ep]
,color (withAlpha 0.1 $ mixColors relFrac (1-relFrac) red green)
$ lineOfThickness 2 [p,ep]
]
,_ptUpdate' = \w pt -> (w, Just $ pt & ptUpdate' .~ \w' _ -> (w',Nothing))
}
spawnGun :: Creature -> Item spawnGun :: Creature -> Item
spawnGun cr = defaultGun spawnGun cr = defaultGun
{ _itName = "SPAWNER" { _itName = "SPAWNER"
@@ -1854,7 +1685,11 @@ spawnGun cr = defaultGun
, _wpFire = spawnCrNextTo cr , _wpFire = spawnCrNextTo cr
} }
spawnCrNextTo :: Creature -> Int -> World -> World spawnCrNextTo
:: Creature -- ^ Creature to spawn
-> Int -- ^ ID of existing creature that will be spawned next to
-> World
-> World
spawnCrNextTo cr i w = w & creatures %~ IM.insert k newCr spawnCrNextTo cr i w = w & creatures %~ IM.insert k newCr
where where
k = newKey $ _creatures w k = newKey $ _creatures w
src/Dodge/Item/Weapon/Bullet.hs
+119 -104
View File
@@ -1,3 +1,6 @@
{- |
Effects of bullets upon impact with walls or creatures, and possibly force fields.
-}
module Dodge.Item.Weapon.Bullet module Dodge.Item.Weapon.Bullet
where where
import Dodge.Data import Dodge.Data
@@ -6,21 +9,16 @@ import Dodge.WorldEvent
import Dodge.SoundLogic import Dodge.SoundLogic
import Dodge.RandomHelp import Dodge.RandomHelp
import Dodge.WorldEvent.Shockwave import Dodge.WorldEvent.Shockwave
import Dodge.Creature.Property import Dodge.Creature.Property
import Geometry import Geometry
import System.Random
import Control.Lens
import Control.Monad.State
import qualified Data.IntMap.Strict as IM
import Picture import Picture
-- | bullet effects import System.Random
import Control.Lens
import Control.Monad.State
import qualified Data.IntMap.Strict as IM
-- | Basic bullet hit creature effect.
bulHitCr' :: Particle -> Point2 -> Creature -> World -> World bulHitCr' :: Particle -> Point2 -> Creature -> World -> World
bulHitCr' bt p cr w bulHitCr' bt p cr w
| crIsArmouredFrom p cr | crIsArmouredFrom p cr
@@ -35,13 +33,13 @@ bulHitCr' bt p cr w
addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ ) addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++) addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
hitSound = soundMultiFrom [CrHitSound 0] 15 10 0 hitSound = soundMultiFrom [CrHitSound 0] 15 10 0
flashEff = over worldEvents ((.) $ bloodFlashAt p) flashEff = over worldEvents (bloodFlashAt p . )
cid = _crID cr cid = _crID cr
(d1,g) = randomR (-0.7,0.7) $ _randGen w (d1,g) = randomR (-0.7,0.7) $ _randGen w
(colID,_) = randomR (0,11) $ _randGen w (colID,_) = randomR (0,11) $ _randGen w
p1 = p +.+ 2 *.* safeNormalizeV (p -.- _crPos cr) p1 = p +.+ 2 *.* safeNormalizeV (p -.- _crPos cr)
{- {- |
Bounce off armoured creatures, otherwise do damage. Bounce off armoured creatures, otherwise do damage.
-} -}
bulBounceArmCr' :: Particle -> Point2 -> Creature -> World -> World bulBounceArmCr' :: Particle -> Point2 -> Creature -> World -> World
@@ -63,112 +61,104 @@ bulBounceArmCr' bt p cr w
newDir = safeNormalizeV (p -.- _crPos cr) newDir = safeNormalizeV (p -.- _crPos cr)
pOut = p +.+ 2 *.* newDir pOut = p +.+ 2 *.* newDir
reflectVel = magV bulVel *.* newDir reflectVel = magV bulVel *.* newDir
addBouncer = worldEvents %~ ((over particles (bouncer :) ) . ) addBouncer = worldEvents %~ ( over particles (bouncer :) . )
bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel
(_btHitEffect' bt) (_btWidth' bt) (_btHitEffect' bt) (_btWidth' bt)
) {_btTimer' = _btTimer' bt - 1} ) {_btTimer' = _btTimer' bt - 1}
{- {- |
Bullet pass through creatures. Bullet pass through creatures.
-} -}
bulPenCr' :: Particle -> Point2 -> Creature -> World -> World bulPenCr' :: Particle -> Point2 -> Creature -> World -> World
bulPenCr' bt p cr w bulPenCr' bt p cr w
= over (creatures . ix cid . crState . crDamage) = over (creatures . ix cid . crState . crDamage)
(\dams -> [Piercing 50 sp p ep ([Piercing 50 sp p ep
,Blunt 50 sp p ep ,Blunt 50 sp p ep
,TorqueDam 1 d1 ,TorqueDam 1 d1
,PushDam 1 $ 3 *.* (ep -.- sp) ,PushDam 1 $ 3 *.* (ep -.- sp)
] ++ dams ]
) ++
$ soundMultiFrom [CrHitSound 0] 15 10 0 )
$ over worldEvents addPiercer $ soundMultiFrom [CrHitSound 0] 15 10 0
w $ over worldEvents (addPiercer . )
where (d1,g) = randomR (-0.7,0.7) $ _randGen w w
cid = _crID cr
sp = head $ _btTrail' bt
ep = sp +.+ _btVel' bt
addPiercer = (.) $ over particles (piercer :)
piercer = (aGenBulAt' (Just cid) (_btColor' bt) p (_btVel' bt)
(_btHitEffect' bt) (_btWidth' bt)
) {_btTimer' = _btTimer' bt - 1}
{- 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
,PushDam 1 $ 3 *.* (ep -.- sp)
] ++ dams
)
$ soundMultiFrom [CrHitSound 0] 15 10 0
w
where where
(d1,g) = randomR (-0.7,0.7) $ _randGen w (d1,g) = randomR (-0.7,0.7) $ _randGen w
cid = _crID cr cid = _crID cr
sp = head $ _btTrail' bt sp = head $ _btTrail' bt
ep = sp +.+ _btVel' bt ep = sp +.+ _btVel' bt
addPiercer = over particles (piercer :)
piercer = (aGenBulAt' (Just cid) (_btColor' bt) p (_btVel' bt)
(_btHitEffect' bt) (_btWidth' bt)
) {_btTimer' = _btTimer' bt - 1}
{- |
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)
([Piercing 200 sp p ep
,Blunt 100 sp p ep
,TorqueDam 1 d1
,PushDam 1 $ 3 *.* (ep -.- sp)
]
++
)
$ 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
{- |
Create a flamelet when hitting a creature. -}
bulIncCr' :: Particle -> Point2 -> Creature -> World -> World bulIncCr' :: Particle -> Point2 -> Creature -> World -> World
bulIncCr' bt p cr w bulIncCr' bt p cr w
= over (creatures . ix cid . crState . crDamage) = over (creatures . ix cid . crState . crDamage)
(\dams -> [Piercing 60 sp p ep ( Piercing 60 sp p ep : )
] ++ dams $ soundMultiFrom [CrHitSound 0] 15 10 0
) $ incFlamelets
$ soundMultiFrom [CrHitSound 0] 15 10 0 w
$ incFlamelets
w
where where
cid = _crID cr cid = _crID cr
sp = head $ _btTrail' bt sp = head $ _btTrail' bt
ep = sp +.+ _btVel' bt ep = sp +.+ _btVel' bt
v = evalState (randInCirc 1) $ _randGen w v = evalState (randInCirc 1) $ _randGen w
incFlamelets = over worldEvents $ (.) (makeFlameletTimed p v Nothing 3 20) incFlamelets = over worldEvents $ (.) (makeFlameletTimed p v Nothing 3 20)
{- |
{- Creates a shockwave when hitting a creature. -}
Creates a shockwave when hitting a creature.
-}
bulConCr' :: Particle -> Point2 -> Creature -> World -> World bulConCr' :: Particle -> Point2 -> Creature -> World -> World
bulConCr' bt p cr w bulConCr' bt p cr w
= over (creatures . ix cid . crState . crDamage) = over (creatures . ix cid . crState . crDamage)
(\dams -> [Piercing 60 sp p ep ( Piercing 60 sp p ep : )
] ++ dams $ soundMultiFrom [CrHitSound 0] 15 10 0
) $ mkwave
$ soundMultiFrom [CrHitSound 0] 15 10 0 w
$ mkwave
w
where where
cid = _crID cr cid = _crID cr
sp = head $ _btTrail' bt sp = head $ _btTrail' bt
ep = sp +.+ _btVel' bt ep = sp +.+ _btVel' bt
mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white) mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white)
{- |
{- Hitting wall effects: create a spark, damage blocks. -}
Hitting wall effects: create a spark, damage blocks.
-}
bulHitWall' :: Particle -> Point2 -> Wall -> World -> World bulHitWall' :: Particle -> Point2 -> Wall -> World -> World
bulHitWall' bt p x w = damageBlocks x bulHitWall' bt p x w = damageBlocks x
$ createSpark 8 colID pOut (reflectDir x) Nothing $ createSpark 8 colID pOut (reflectDir x) Nothing
$ set randGen g $ set randGen g
w w
where where
sp = head $ _btTrail' bt sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p) pOut = p +.+ safeNormalizeV (sp -.- p)
(colID,g) = randomR (0,11) $ _randGen w (colID,g) = randomR (0,11) $ _randGen w
(a, _) = randomR (-0.1,0.1) $ _randGen w (a, _) = randomR (-0.1,0.1) $ _randGen w
spid = newKey $ _projectiles w spid = newKey $ _projectiles w
reflectDir wall = a + (argV $ reflectIn reflectDir wall = a +
(_wlLine wall !! 1 -.- _wlLine wall !! 0) argV (reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0) (p -.- sp) )
(p -.- sp) damageBlocks wall w = case wall ^? blHP of
)
damageBlocks wall w
= case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall) Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
_ -> w _ -> w
{- |
{-
Bounce off walls, do damage to blocks. Bounce off walls, do damage to blocks.
-} -}
bulBounceWall' :: Particle -> Point2 -> Wall -> World -> World bulBounceWall' :: Particle -> Point2 -> Wall -> World -> World
@@ -183,16 +173,21 @@ bulBounceWall' bt p wl w = damageBlocks wl $ over worldEvents addBouncer w
bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel
(_btHitEffect' bt) (_btWidth' bt) (_btHitEffect' bt) (_btWidth' bt)
) {_btTimer' = _btTimer' bt - 1} ) {_btTimer' = _btTimer' bt - 1}
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0) wallV = _wlLine wl !! 1 -.- _wlLine wl !! 0
reflectVel = (reflectIn wallV (_btVel' bt)) reflectVel = (reflectIn wallV (_btVel' bt))
addBouncer = (.) ( over particles (bouncer : ) ) addBouncer = (.) ( over particles (bouncer : ) )
-- the hack is to get around the fact that the particles list gets reset after -- 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 -- all projectiles in it are checked, so we cannot add to it as we accumulate over
-- this list -- this list
{- Create flamelet on wall. {- | Create flamelet on wall.
-} -}
bulIncWall' :: Particle -> Point2 -> Wall -> World -> World bulIncWall'
:: Particle
-> Point2 -- Impact point
-> Wall
-> World
-> World
bulIncWall' bt p wl w = damageBlocks wl $ incFlamelets w bulIncWall' bt p wl w = damageBlocks wl $ incFlamelets w
where where
sp = head $ _btTrail' bt sp = head $ _btTrail' bt
@@ -201,12 +196,17 @@ bulIncWall' bt p wl w = damageBlocks wl $ incFlamelets w
= case wall ^? blHP of = case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall) Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
_ -> w _ -> w
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0) wallV = _wlLine wl !! 1 -.- _wlLine wl !! 0
reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt) reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt)
incFlamelets = over worldEvents $ (.) (makeFlameletTimed pOut reflectVel Nothing 3 20) incFlamelets = over worldEvents $ (.) (makeFlameletTimed pOut reflectVel Nothing 3 20)
{- Create a shockwave on wall-} {- | Create a shockwave on wall-}
bulConWall' :: Particle -> Point2 -> Wall -> World -> World bulConWall'
:: Particle
-> Point2 -- Impact point
-> Wall
-> World
-> World
bulConWall' bt p wl w = damageBlocks wl $ mkwave w bulConWall' bt p wl w = damageBlocks wl $ mkwave w
where where
sp = head $ _btTrail' bt sp = head $ _btTrail' bt
@@ -215,25 +215,27 @@ bulConWall' bt p wl w = damageBlocks wl $ mkwave w
= case wall ^? blHP of = case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall) Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
_ -> w _ -> w
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0) wallV = _wlLine wl !! 1 -.- _wlLine wl !! 0
mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white) mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white)
hvBulHitWall' :: Particle -> Point2 -> Wall -> World -> World hvBulHitWall'
:: Particle
-> Point2 -- Impact point
-> Wall
-> World
-> World
hvBulHitWall' bt p x w = damageBlocks x $ set randGen g $ foldr ($) w (sparks pOut sv) hvBulHitWall' bt p x w = damageBlocks x $ set randGen g $ foldr ($) w (sparks pOut sv)
where where
sp = head $ _btTrail' bt sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p) pOut = p +.+ safeNormalizeV (sp -.- p)
(a, g) = randomR (-0.1,0.1) $ _randGen w (a, g) = randomR (-0.1,0.1) $ _randGen w
spid = newKey $ _projectiles w spid = newKey $ _projectiles w
reflectDir wall = a + (argV $ reflectIn reflectDir wall = a +
(_wlLine wall !! 1 -.- _wlLine wall !! 0) argV (reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0) (p -.- sp) )
(p -.- sp)
)
sv = unitVectorAtAngle $ reflectDir x sv = unitVectorAtAngle $ reflectDir x
damageBlocks wall w damageBlocks wall w = case wall ^? blHP of
= case wall ^? blHP of Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 20)) w (_blIDs wall)
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 20)) w (_blIDs wall) _ -> w
_ -> w
cs = take 10 $ randomRs (0,11) $ _randGen w cs = take 10 $ randomRs (0,11) $ _randGen w
ds = randomRs (-0.7,0.7) $ _randGen w ds = randomRs (-0.7,0.7) $ _randGen w
ts = randomRs (4,8) $ _randGen w ts = randomRs (4,8) $ _randGen w
@@ -242,15 +244,20 @@ hvBulHitWall' bt p x w = damageBlocks x $ set randGen g $ foldr ($) w (sparks p
bulHitFF' :: Particle -> Point2 -> ForceField -> World -> World bulHitFF' :: Particle -> Point2 -> ForceField -> World -> World
bulHitFF' _ _ _ = id bulHitFF' _ _ _ = id
bulletEffect' :: HitEffect {-
bulletEffect' = destroyOnImpact bulHitCr' bulHitWall' bulHitFF' Typical effect: destroy on impact, damage creatures and blocks, create spark on walls.
-}
basicBulletEffect :: HitEffect
basicBulletEffect = destroyOnImpact bulHitCr' bulHitWall' bulHitFF'
bulletParticleSideEffect :: Particle -> HitEffect aGenBulAt'
bulletParticleSideEffect pt = destroyOnImpact mkPt mkPt noEff :: Maybe Int -- ^ Pass-through creature id
where -> Color
mkPt _ p _ = over particles ((pt {_btTrail' = [p]}) :) -> Point2 -- ^ Start position
-> Point2 -- ^ Velocity
aGenBulAt' :: Maybe Int -> Color -> Point2 -> Point2 -> HitEffect -> Float -> Particle -> HitEffect
-> Float -- ^ Bullet width
-> Particle
aGenBulAt' maycid col pos vel hiteff width = Bul' aGenBulAt' maycid col pos vel hiteff width = Bul'
{ _ptDraw = drawBul { _ptDraw = drawBul
, _ptUpdate' = mvGenBullet' , _ptUpdate' = mvGenBullet'
@@ -263,7 +270,15 @@ aGenBulAt' maycid col pos vel hiteff width = Bul'
, _btHitEffect' = hiteff , _btHitEffect' = hiteff
} }
aCurveBulAt :: Maybe Int -> Color -> Point2 -> Point2 -> Point2 -> HitEffect -> Float -> Particle aCurveBulAt
:: Maybe Int -- ^ Pass-through creature id
-> Color
-> Point2 -- ^ Start position
-> Point2 -- ^ Control position
-> Point2 -- ^ Target position
-> HitEffect
-> Float -- ^ Bullet width
-> Particle
aCurveBulAt maycid col pos control targ hiteff width = Bul' aCurveBulAt maycid col pos control targ hiteff width = Bul'
{ _ptDraw = drawBul { _ptDraw = drawBul
, _ptUpdate' = \w -> mvGenBullet' w . setVel , _ptUpdate' = \w -> mvGenBullet' w . setVel
src/Dodge/Item/Weapon/Decoration.hs
+29
View File
@@ -0,0 +1,29 @@
{- |
Particles and pictures that decorate weapons, such as laser scopes etc.
-}
module Dodge.Item.Weapon.Decoration
where
import Dodge.Data
import Dodge.Base
import Geometry.Data
import Picture
import Control.Lens
makeLaserScope
:: Point2 -- ^ Start point
-> Point2 -- ^ End point
-> Float -- ^ Fraction of red/green
-> Particle
makeLaserScope p ep relFrac = Particle
{_ptDraw = const $ onLayer PtLayer $ pictures
[color (withAlpha 0.5 $ mixColors relFrac (1-relFrac) red green)
$ lineOfThickness 0.5 [p,ep]
,color (withAlpha 0.2 $ mixColors relFrac (1-relFrac) red green)
$ lineOfThickness 1.5 [p,ep]
,color (withAlpha 0.1 $ mixColors relFrac (1-relFrac) red green)
$ lineOfThickness 2 [p,ep]
]
,_ptUpdate' = \w pt -> (w, Just $ pt & ptUpdate' .~ \w' _ -> (w',Nothing))
}
src/Dodge/Item/Weapon/ExtraEffect.hs
+96
View File
@@ -0,0 +1,96 @@
{-# LANGUAGE BangPatterns #-}
{- |
Extra weapon effects, supplementing explicit use effects.
-}
module Dodge.Item.Weapon.ExtraEffect
where
import Dodge.Data
import Dodge.Base
import Dodge.Item.Weapon.Decoration
import Dodge.Item.Weapon.UseEffect
import Dodge.WorldEvent.Flash
import Dodge.WorldEvent.ThingsHit
import Picture
import Geometry.Vector
import Data.Maybe
import Control.Lens
import qualified Data.IntMap.Strict as IM
{- |
Controls resetting a weapon, allows for non-continuous fire needing a button release. -}
wpRecock :: ItEffect
wpRecock = ItInvEffect
{_itInvEffect = f
,_itEffectCounter = 0
}
where
f cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust fOnIt i
moveHammerUp HammerDown = HammerReleased
moveHammerUp HammerReleased = HammerUp
moveHammerUp HammerUp = HammerUp
fOnIt it = it & itHammer %~ moveHammerUp
{- |
Special recock for the bezier gun.
Not sure of its purpose at this time... -}
bezierRecock :: ItEffect
bezierRecock = ItInvEffect
{_itInvEffect = f
,_itEffectCounter = 0
}
where
f cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust fOnIt i
fOnIt it = case _itHammer it of
HammerDown -> it & itHammer .~ HammerUp
_ -> it & itAttachment .~ Nothing
{- |
Creates a laser scope and recocks the weapon.
-}
itemLaserScopeEffect :: ItEffect
itemLaserScopeEffect
= ItInvEffect {_itInvEffect = f ,_itEffectCounter = 0 }
where
moveHammerUp !HammerDown = HammerReleased
moveHammerUp !_ = HammerUp
f cr invid w
| invid == _crInvSel cr = w
& particles %~ (:) (makeLaserScope sp ep reloadFrac)
& creatures . ix (_crID cr) . crInv . ix invid . itHammer %~ moveHammerUp
& laserScopeTargetGlow col glowPoint
| otherwise = w
where
p = _crPos cr
d = _crDir cr
r = _crRad cr
sp = p +.+ (r + 3) *.* unitVectorAtAngle d
xp = sp +.+ 3000 *.* unitVectorAtAngle d
ep = case listToMaybe $ thingsHitLongLine sp xp w of
Just (p,_) -> p
Nothing -> xp
glowPoint = case listToMaybe $ thingsHitLongLine sp xp w of
Just (p,E3x2 wl) -> p +.+ 2 *.* wallNormal wl
_ -> ep -.- 2 *.* unitVectorAtAngle d
it = (cr ^. crInv) IM.! invid
reloadFrac
| _wpLoadedAmmo it == 0 = 1
| otherwise = fromIntegral (_wpReloadState it) / fromIntegral (_wpReloadTime it)
col = mixColors reloadFrac (1-reloadFrac) red green
{- |
Automatically send out radar pulses that detect walls. -}
autoRadarEffect :: ItEffect
autoRadarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
where
f 0 cr i w = aRadarPulse (_crID cr) w
& creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f 100
f t cr i w = w
& creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f (t-1)
{- |
Automatically send out sonar pulses that detect creatures. -}
autoSonarEffect :: ItEffect
autoSonarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
where f 0 cr i w = aSonarPulse (_crID cr)
w & creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f 140
f t cr i w = w & creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f (t-1)
src/Dodge/Item/Weapon/InventoryDisplay.hs
+4 -12
View File
@@ -13,23 +13,15 @@ import Control.Monad
-- not sure if this is in the right place... -- not sure if this is in the right place...
{- |
Displays the item name, ammo if loaded, and any selected '_itCharMode'.
-}
basicWeaponDisplay :: Item -> String basicWeaponDisplay :: Item -> String
basicWeaponDisplay it = case it ^? itAttachment . _Just . itCharMode of basicWeaponDisplay it = case it ^? itAttachment . _Just . itCharMode of
Just (c :<| _) -> midPadL 10 ' ' (_itName it) (' ' : aIfLoaded) ++ [' ',c] Just (c :<| _) -> midPadL 10 ' ' (_itName it) (' ' : aIfLoaded) ++ [' ',c]
_ -> midPadL 10 ' ' (_itName it) (' ' : aIfLoaded) _ -> midPadL 10 ' ' (_itName it) (' ' : aIfLoaded)
where where
availableAmmo = show $ _wpMaxAmmo it availableAmmo = show $ _wpMaxAmmo it
aIfLoaded = case (_wpReloadState it) of aIfLoaded = case _wpReloadState it of
0 -> show $ _wpLoadedAmmo it 0 -> show $ _wpLoadedAmmo it
x -> "R" ++ show x x -> "R" ++ show x
displayLasGun :: Item -> String
displayLasGun it@(Weapon {_itAttachment = mayPhase})
= midPadL 10 ' ' "LASER" (' ':aIfLoaded) ++ (' ':phaseS)
where aIfLoaded = case (_wpReloadState it) of
0 -> show $ _wpLoadedAmmo it
x -> "R" ++ show x
phaseS = case mayPhase of
Just (ItPhaseV 0.2) -> "V"
Just (ItPhaseV 1) -> "/"
Just (ItPhaseV 5) -> "Z"
src/Dodge/Item/Weapon/Recock.hs
-36
View File
@@ -1,36 +0,0 @@
{-# LANGUAGE BangPatterns #-}
{- |
Controls for continuous and non-continuous fire.
-}
module Dodge.Item.Weapon.Recock
where
import Dodge.Data
import Control.Lens
import qualified Data.IntMap.Strict as IM
{- |
Controls resetting a weapon, allows for non-continuous fire needing a button release. -}
wpRecock :: ItEffect
wpRecock = ItInvEffect
{_itInvEffect = f
,_itEffectCounter = 0
}
where
f cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust fOnIt i
moveHammerUp HammerDown = HammerReleased
moveHammerUp HammerReleased = HammerUp
moveHammerUp HammerUp = HammerUp
fOnIt it = it & itHammer %~ moveHammerUp
{- |
Special recock for the bezier gun.
Not sure of its purpose at this time... -}
bezierRecock :: ItEffect
bezierRecock = ItInvEffect
{_itInvEffect = f
,_itEffectCounter = 0
}
where
f cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust fOnIt i
fOnIt it = case _itHammer it of
HammerDown -> it & itHammer .~ HammerUp
_ -> it & itAttachment .~ Nothing
src/Dodge/Item/Weapon/TriggerType.hs
+42 -8
View File
@@ -99,7 +99,9 @@ withRecoil
withRecoil recoilAmount eff cid = eff cid . over (creatures . ix cid) pushback withRecoil recoilAmount eff cid = eff cid . over (creatures . ix cid) pushback
where where
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.
Applied before the underlying effect. -}
withSidePush withSidePush
:: Float -- ^ Maximal possible side push amount :: Float -- ^ Maximal possible side push amount
-> (Int -> World -> World) -> (Int -> World -> World)
@@ -111,6 +113,19 @@ withSidePush maxSide eff cid w = eff cid . over (creatures . ix cid) push $ w
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
{- | {- |
Pushes a creature sideways by a random amount.
Applied after the underlying effect. -}
withSidePushAfter
:: Float -- ^ Maximal possible side push amount
-> (Int -> World -> World)
-- ^ Underlying world effect, takes creature id as input
-> Int -- ^ Creature id
-> World -> World
withSidePushAfter maxSide eff cid w = over (creatures . ix cid) push . eff cid $ w
where
push cr = over crPos (+.+ rotateV (_crDir cr) (0,pushAmount / _crMass cr)) cr
(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
@@ -134,7 +149,8 @@ shootWithSound soundid f cid w
&& _wpFireState item == 0 && _wpFireState item == 0
&& _wpLoadedAmmo item > 0 && _wpLoadedAmmo item > 0
reloadCondition = _wpLoadedAmmo item == 0 reloadCondition = _wpLoadedAmmo item == 0
{- | 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 :: (Int -> World -> World) -- ^ Underlying effect
-> Int -- ^ Creature id -> Int -- ^ Creature id
@@ -146,8 +162,8 @@ hammerCheck f cid w = case (_crInv cr IM.! _crInvSel cr) ^? itHammer of
where where
cr = _creatures w IM.! cid cr = _creatures w IM.! cid
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) :: (Int -> World -> World)
-- ^ Underlying effect, takes creature id as input -- ^ Underlying effect, takes creature id as input
@@ -175,8 +191,7 @@ withMuzFlare
-> Int -- ^ Creature id -> Int -- ^ Creature id
-> World -> World
-> World -> World
withMuzFlare f cid w = tempLightForAt 3 pos withMuzFlare f cid w = tempLightForAt 3 pos . muzzleFlashAt pos2 $ f cid w
. muzzleFlashAt pos2 $ f cid w
where where
cr = _creatures w IM.! cid cr = _creatures w IM.! cid
dir = _crDir cr dir = _crDir cr
@@ -184,8 +199,7 @@ withMuzFlare f cid w = tempLightForAt 3 pos
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) -> (Int -> World -> World)
@@ -336,3 +350,23 @@ numVelWthHitEff num vel wth eff cid w = over particles (newbuls ++) w
offsets = map (\y -> rotateV d (0,y)) [-maxOffset,5-maxOffset..] offsets = map (\y -> rotateV d (0,y)) [-maxOffset,5-maxOffset..]
colids = take num $ randomRs (0,11) (_randGen w) colids = take num $ randomRs (0,11) (_randGen w)
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle d pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle d
{- |
Uses '_wpSpread' as a parameter for the current offset angle. -}
randWalkAngle
:: Float -- ^ Max offset angle
-> Float -- ^ Walk speed
-> (Int -> World -> World) -- ^ Underlying effect
-> Int -- ^ Creature id
-> World
-> World
randWalkAngle ma aspeed f cid w = w
& creatures . ix cid . crDir -~ a
& f cid
& creatures . ix cid . crDir +~ a
& creatures . ix cid . crInv . ix i . wpSpread .~ newa
where
a = _wpSpread $ _crInv (_creatures w IM.! cid) IM.! i
(walka, g) = randomR (-aspeed,aspeed) (_randGen w)
newa = min ma $ max (negate ma) (a + walka)
i = _crInvSel $ _creatures w IM.! cid
src/Dodge/Item/Weapon/UseEffect.hs
+110
View File
@@ -0,0 +1,110 @@
{- |
Effects centered on creatures.
These are typically item effects, and typical occur when an item is explictly used. -}
module Dodge.Item.Weapon.UseEffect
where
import Dodge.Data
import Dodge.Base
import Dodge.Item.Weapon.Decoration
import Dodge.WorldEvent.Flash
import Dodge.WorldEvent.ThingsHit
import Picture
import Geometry
import Data.Maybe
import Control.Lens
import qualified Data.IntMap.Strict as IM
{- |
Creates an outwardly increasing circle that draws creatures, even those behind walls. -}
aSonarPulse :: Int -> World -> World
aSonarPulse cid w = over particles ((:) $ sonarPulseAt (_crPos (_creatures w IM.! cid))) w
{- |
Creates an outwardly increasing circle that displays walls, even those behind other walls. -}
aRadarPulse :: Int -> World -> World
aRadarPulse cid w = over particles ((:) $ radarPulseAt (_crPos (_creatures w IM.! cid))) w
{- |
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 -- ^ Max possible timer value
-> Int -- ^ Current timer value
-> 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)
& ptDraw .~ (const . setDepth (-0.5)
. setLayer 1
$ uncurry translate p
$ color (withAlpha (fromIntegral t / fromIntegral maxt) col)
$ circleSolid 2)
)
{- |
An outwardly increasing circle that draws creatures, even those behind walls. -}
sonarPulseAt :: Point2 -> Particle
sonarPulseAt p = Particle { _ptDraw = const blank , _ptUpdate' = mvSonar 100 p }
mvSonar
:: Int -- ^ Timer
-> Point2 -- ^ Center of expanding circle
-> 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 crBlips
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 ]
globalAlpha | x > 10 = 1
| otherwise = fromIntegral x / 10
colHelper y = color (withAlpha (y * globalAlpha) green)
{- |
An outwardly increasing circle that displays walls, even those behind other walls. -}
radarPulseAt :: Point2 -> Particle
radarPulseAt p = Particle
{ _ptDraw = const blank
, _ptUpdate' = mvRadar 50 p
}
mvRadar
:: Int -- ^ Timer
-> Point2 -- ^ Center of expanding circle
-> 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)
src/Picture/Preload.hs
+1 -1
View File
@@ -120,7 +120,7 @@ setupFramebuffer = do
textureBinding Texture2D $= Just fboTO textureBinding Texture2D $= Just fboTO
texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 800 600) 0 (PixelData RGBA UnsignedByte nullPtr) texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 800 600) 0 (PixelData RGBA UnsignedByte nullPtr)
texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 8 6) 0 (PixelData RGBA UnsignedByte nullPtr) texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 8 6) 0 (PixelData RGBA UnsignedByte nullPtr)
textureFilter Texture2D $= ((Linear',Just Linear') , Nearest) textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
generateMipmap' Texture2D generateMipmap' Texture2D
framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0 framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
src/Picture/Render.hs
+5
View File
@@ -140,7 +140,12 @@ createLightMap pdata resDiv wallPoints lightPoints
bindFramebuffer Framebuffer $= defaultFramebufferObject bindFramebuffer Framebuffer $= defaultFramebufferObject
colorMask $= Color4 Disabled Disabled Disabled Enabled colorMask $= Color4 Disabled Disabled Disabled Enabled
bindShaderBuffers [_fullscreenShader pdata] [4] bindShaderBuffers [_fullscreenShader pdata] [4]
-- by upscaling the shadowmap texture and using Linear' magnification
-- interpolation, we get a poor mans blur
textureBinding Texture2D $= Just (_fboTexture pdata) textureBinding Texture2D $= Just (_fboTexture pdata)
textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
-- not sure about the perforamnce implications ^^^
generateMipmap' Texture2D
drawShader (_fullscreenShader pdata) 4 drawShader (_fullscreenShader pdata) 4
colorMask $= Color4 Enabled Enabled Enabled Enabled colorMask $= Color4 Enabled Enabled Enabled Enabled
blend $= Enabled blend $= Enabled