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

Rename (indexed) particles to projectiles

Browse Source
This commit is contained in:
jgk
2021-03-23 14:03:00 +01:00
parent 941fef134d
commit 885fa4a67e
11 changed files with 245 additions and 251 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base.hs
+1 -1
View File
@@ -484,7 +484,7 @@ newKey m = case IM.lookupMax m of
Nothing -> 0
newParticleKey :: World -> Int
newParticleKey w = case IM.lookupMax (_particles w) of
newParticleKey w = case IM.lookupMax (_projectiles w) of
Just (n,_) -> n+1
Nothing -> 0
newCrKey :: World -> Int
src/Dodge/Data.hs
+51 -71
View File
@@ -35,57 +35,53 @@ import qualified Data.DList as DL
--}}}
-- datatypes {{{
data World = World
{ _keys :: !(S.Set Keycode)
, _mouseButtons :: !(S.Set MouseButton)
, _cameraPos :: !Point2
, _cameraAimTime :: Int
, _cameraRot :: !Float
, _cameraZoom :: !Float
, _cameraCenter :: !Point2
, _creatures :: IM.IntMap Creature
, _creaturesZone :: IM.IntMap (IM.IntMap (IM.IntMap Creature))
, _itemPositions :: IM.IntMap ItemPos
, _clouds :: IM.IntMap Cloud
, _cloudsZone :: IM.IntMap (IM.IntMap (IM.IntMap Cloud))
, _particles :: IM.IntMap Particle
, _particles' :: ![Particle']
, _smoke :: [Smoke]
, _walls :: !(IM.IntMap Wall)
, _wallsZone :: (IM.IntMap (IM.IntMap (IM.IntMap Wall)))
, _forceFields :: IM.IntMap ForceField
, _floorItems :: IM.IntMap FloorItem
, _randGen :: StdGen
, _mousePos :: !(Float,Float)
, _testString :: String
, _yourID :: !Int
, _worldEvents :: !(World -> World)
, _pressPlates :: IM.IntMap PressPlate
, _buttons :: IM.IntMap Button
, _soundQueue :: [Int]
, _sounds :: M.Map SoundOrigin Sound
, _decorations :: IM.IntMap Drawing
, _corpses :: IM.IntMap (IM.IntMap [Corpse])
, _lbClickMousePos :: (Float,Float)
, _lbRotation :: Float
, _pathGraph :: ~(Gr Point2 Float)
, _pathGraph' :: ~[(Point2,Point2)]
, _pathPoints :: ~(IM.IntMap (IM.IntMap [(Int,Point2)]))
, _pathInc :: ~(M.Map Point2 [Point2])
, _storedLevel :: Maybe World
, _menuState :: MenuState
, _worldState :: M.Map WorldState Bool
, _windowX :: Float
, _windowY :: Float
, _mapDisplay :: (Bool, Float)
, _lightSources :: !(IM.IntMap LightSource)
{ _keys :: !(S.Set Keycode)
, _mouseButtons :: !(S.Set MouseButton)
, _cameraPos :: !Point2
, _cameraAimTime :: Int
, _cameraRot :: !Float
, _cameraZoom :: !Float
, _cameraCenter :: !Point2
, _creatures :: IM.IntMap Creature
, _creaturesZone :: IM.IntMap (IM.IntMap (IM.IntMap Creature))
, _itemPositions :: IM.IntMap ItemPos
, _clouds :: IM.IntMap Cloud
, _cloudsZone :: IM.IntMap (IM.IntMap (IM.IntMap Cloud))
, _projectiles :: IM.IntMap Projectile
, _particles' :: ![Particle']
, _smoke :: [Smoke]
, _walls :: !(IM.IntMap Wall)
, _wallsZone :: (IM.IntMap (IM.IntMap (IM.IntMap Wall)))
, _forceFields :: IM.IntMap ForceField
, _floorItems :: IM.IntMap FloorItem
, _randGen :: StdGen
, _mousePos :: !(Float,Float)
, _testString :: String
, _yourID :: !Int
, _worldEvents :: !(World -> World)
, _pressPlates :: IM.IntMap PressPlate
, _buttons :: IM.IntMap Button
, _soundQueue :: [Int]
, _sounds :: M.Map SoundOrigin Sound
, _decorations :: IM.IntMap Drawing
, _corpses :: IM.IntMap (IM.IntMap [Corpse])
, _lbClickMousePos :: (Float,Float)
, _lbRotation :: Float
, _pathGraph :: ~(Gr Point2 Float)
, _pathGraph' :: ~[(Point2,Point2)]
, _pathPoints :: ~(IM.IntMap (IM.IntMap [(Int,Point2)]))
, _pathInc :: ~(M.Map Point2 [Point2])
, _storedLevel :: Maybe World
, _menuState :: MenuState
, _worldState :: M.Map WorldState Bool
, _windowX :: Float
, _windowY :: Float
, _mapDisplay :: (Bool, Float)
, _lightSources :: !(IM.IntMap LightSource)
, _tempLightSources :: ![TempLightSource]
, _closeActiveObjects :: [Either FloorItem Button]
, _remap :: Keycode -> Keycode
, _remap :: Keycode -> Keycode
} --deriving (Show)
type Drawing = Picture
@@ -435,9 +431,10 @@ data ItemIdentity
deriving (Eq,Show,Ord,Enum)
data Particle' =
Particle' { _ptPict' :: Drawing
, _ptUpdate' :: World -> Particle' -> (World, Maybe Particle')
}
Particle'
{ _ptPict' :: Drawing
, _ptUpdate' :: World -> Particle' -> (World, Maybe Particle')
}
| Bul' { _ptPict' :: Drawing
, _ptUpdate' :: World -> Particle' -> (World, Maybe Particle')
, _btVel' :: Point2
@@ -478,31 +475,14 @@ type HitEffect = Particle' -> [(Point2, (Either3 Creature Wall ForceField))] ->
-> (World,Maybe Particle')
data Particle =
Particle { _ptPos :: Point2
data Projectile =
Projectile { _ptPos :: Point2
, _ptStartPos :: Point2
, _ptVel :: Point2
, _ptPict :: Drawing
, _ptID :: Int
, _ptUpdate :: World -> World
}
| Bullet { _ptPos :: Point2
, _ptVel :: Point2
, _ptPict :: Drawing
, _ptID :: Int
, _ptUpdate :: World -> World
, _btTrail :: [Point2]
, _btPassThrough :: Maybe Int
, _btColor :: Color
, _btWidth :: Float
}
| Bullet'
{ _ptPos :: Point2
, _ptVel :: Point2
, _ptPict :: Drawing
, _ptID :: Int
, _ptUpdate :: World -> World
}
data DamageType = Piercing {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
| Blunt {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
@@ -656,7 +636,7 @@ makeLenses ''ItEffect
makeLenses ''ItAttachment
makeLenses ''ItZoom
makeLenses ''FloorItem
makeLenses ''Particle
makeLenses ''Projectile
makeLenses ''Particle'
makeLenses ''Wall
makeLenses ''Smoke
src/Dodge/Debug.hs
+8 -8
View File
@@ -14,8 +14,8 @@ import qualified Data.IntMap.Strict as IM
drawCircleAtFor :: Point2 -> Int -> World -> World
drawCircleAtFor p t w =
let n = newParticleKey w
in over particles ( IM.insert n
Particle { _ptPos = p
in over projectiles ( IM.insert n
Projectile { _ptPos = p
, _ptStartPos = p
, _ptVel = (0,0)
, _ptPict = onLayer PtLayer $ uncurry translate p $ color white $ circleSolid 20
@@ -25,8 +25,8 @@ drawCircleAtFor p t w =
drawCircleAtForCol :: Point2 -> Int -> Color -> World -> World
drawCircleAtForCol p t col w =
let n = newParticleKey w
in over particles ( IM.insert n
Particle { _ptPos = p
in over projectiles ( IM.insert n
Projectile { _ptPos = p
, _ptStartPos = p
, _ptVel = (0,0)
, _ptPict = onLayer PtLayer $ uncurry translate p $ color col $ circleSolid 20
@@ -36,8 +36,8 @@ drawCircleAtForCol p t col w =
drawLineForCol :: [Point2] -> Int -> Color -> World -> World
drawLineForCol ps t col w =
let n = newParticleKey w
in over particles ( IM.insert n
Particle { _ptPos = head ps
in over projectiles ( IM.insert n
Projectile { _ptPos = head ps
, _ptStartPos = head ps
, _ptVel = (0,0)
, _ptPict = onLayer PtLayer $ color col $ lineOfThickness 5 ps
@@ -46,5 +46,5 @@ drawLineForCol ps t col w =
} ) w
ptTimer :: Int -> Int -> World -> World
ptTimer 0 i = over particles (IM.delete i)
ptTimer time i = set (particles . ix i . ptUpdate) $ ptTimer (time - 1) i
ptTimer 0 i = over projectiles (IM.delete i)
ptTimer time i = set (projectiles . ix i . ptUpdate) $ ptTimer (time - 1) i
src/Dodge/Initialisation.hs
+1 -1
View File
@@ -29,7 +29,7 @@ initialWorld = basicWorld
, _cameraRot = 0
, _cameraZoom = 1
, _creatures = IM.fromList [(0,startCr)]
, _particles = IM.empty
, _projectiles = IM.empty
, _walls = IM.empty
, _forceFields = IM.empty
, _floorItems = IM.empty
src/Dodge/Item/Weapon.hs
+102 -102
View File
@@ -534,7 +534,7 @@ multGun = defaultGun
, _wpFire = shootWithSound (fromIntegral shotgunSound)
. withRecoil 200
. withMuzFlare
$ numVelWthHitEff 5 (50,0) 4 bulletEffect'
$ numVelWthHitEff 5 (50,0) 5 bulletEffect'
, _wpSpread = spreadGunSpread
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ multGunPic
@@ -664,7 +664,7 @@ aTeslaArc cid w = aTeslaArc' cid
aTeslaArc' :: Int -> World -> World
aTeslaArc' cid w =
flareAt' cyan 0.03 0.1 (pos +.+ 5 *.* unitVectorAtAngle dir)
$ over particles (IM.insert i (makeTeslaArcAt i pos dir))
$ over projectiles (IM.insert i (makeTeslaArcAt i pos dir))
$ set randGen g w
where cr = (_creatures w IM.! cid)
i = newParticleKey w
@@ -690,7 +690,7 @@ aTractorBeam :: Int -> Int -> World -> World
aTractorBeam col cid w
= set (creatures . ix cid . crInv . ix itRef . wpFire)
(shoot $ aTractorBeam ((col + 1) `mod` 10))
$ over particles (IM.insert i (tractorBeamAt col i pos dir)) w
$ over projectiles (IM.insert i (tractorBeamAt col i pos dir)) w
where i = newParticleKey w
cr = (_creatures w IM.! cid)
pos = _crPos cr +.+ ((_crRad cr +10) *.* unitVectorAtAngle dir)
@@ -700,14 +700,14 @@ aTractorBeam col cid w
aRocket :: Int -> World -> World
aRocket cid w
= soundOnce (fromIntegral launcherSound)
$ over particles (IM.insert i (makeShellAt i cid pos dir)) w
$ over projectiles (IM.insert i (makeShellAt i cid pos dir)) w
where i = newParticleKey w
cr = (_creatures w IM.! cid)
pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
dir = _crDir cr
makeShellAt :: Int -> Int -> Point2 -> Float -> Particle
makeShellAt i cid pos dir = Particle
makeShellAt :: Int -> Int -> Point2 -> Float -> Projectile
makeShellAt i cid pos dir = Projectile
{ _ptPos = pos
, _ptStartPos = pos
, _ptVel = rotateV dir (1,0)
@@ -719,39 +719,39 @@ makeShellAt i cid pos dir = Particle
moveShell :: Int -> Int -> Int -> Float -> Point2 -> World -> World
moveShell time i cid rot accel w
| time > 40 = if circOnSomeWall oldPos 4 w
then shellExplosionAt oldPos $ over particles (IM.delete i) w
else over (particles . ix i . ptPos) (+.+ vel)
$ set (particles . ix i . ptPict) piclow
$ set (particles . ix i . ptUpdate)
then shellExplosionAt oldPos $ over projectiles (IM.delete i) w
else over (projectiles . ix i . ptPos) (+.+ vel)
$ set (projectiles . ix i . ptPict) piclow
$ set (projectiles . ix i . ptUpdate)
(moveShell (time-1) i cid rot (rotateV rot accel))
w
| time == 35 = case thingHit of
Just p -> shellExplosionAt oldPos
$ over particles (IM.delete i) w
Nothing -> over (particles . ix i . ptPos) (+.+ vel)
$ set (particles . ix i . ptPict) pic
$ set (particles . ix i . ptUpdate)
$ over projectiles (IM.delete i) w
Nothing -> over (projectiles . ix i . ptPos) (+.+ vel)
$ set (projectiles . ix i . ptPict) pic
$ set (projectiles . ix i . ptUpdate)
(moveShell (time-1) i cid spin accel)
w
| time >= 20 = case thingHit of
Just p -> shellExplosionAt oldPos
$ over particles (IM.delete i) w
Nothing -> over (particles . ix i . ptPos) (+.+ vel)
$ set (particles . ix i . ptPict) pic
$ set (particles . ix i . ptUpdate)
$ over projectiles (IM.delete i) w
Nothing -> over (projectiles . ix i . ptPos) (+.+ vel)
$ set (projectiles . ix i . ptPict) pic
$ set (projectiles . ix i . ptUpdate)
(moveShell (time-1) i cid rot (rotateV rot accel))
w
| time > -99
= case thingHit of
Just p -> shellExplosionAt oldPos
$ stopSoundFrom (ShellSound i)
$ over particles (IM.delete i) w
Nothing -> over (particles . ix i . ptPos) (+.+ vel)
$ over projectiles (IM.delete i) w
Nothing -> over (projectiles . ix i . ptPos) (+.+ vel)
$ set randGen g
$ set (particles . ix i . ptPict) pic
$ set (particles . ix i . ptUpdate)
$ set (projectiles . ix i . ptPict) pic
$ set (projectiles . ix i . ptUpdate)
(moveShell (time-1) i cid rot (rotateV rot accel))
$ over (particles . ix i . ptVel) (\v -> accel +.+ frict *.* v)
$ over (projectiles . ix i . ptVel) (\v -> accel +.+ frict *.* v)
$ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250
$ makeFlameletTimed oldPos
(0.5 *.* rotateV (pi+sparkD) accel) (levLayer UPtLayer) Nothing 3 20
@@ -762,16 +762,16 @@ moveShell time i cid rot accel w
| time > -200 = case thingHit of
Just p -> shellExplosionAt oldPos
$ stopSoundFrom (ShellSound i)
$ over particles (IM.delete i) w
Nothing -> over (particles . ix i . ptPos) (+.+ vel)
$ set (particles . ix i . ptPict) pic
$ set (particles . ix i . ptUpdate)
$ over projectiles (IM.delete i) w
Nothing -> over (projectiles . ix i . ptPos) (+.+ vel)
$ set (projectiles . ix i . ptPict) pic
$ set (projectiles . ix i . ptUpdate)
(moveShell (time-1) i cid rot (rotateV rot accel))
w
| otherwise = shellExplosionAt oldPos
$ stopSoundFrom (ShellSound i)
$ over particles (IM.delete i) w
where pt = _particles w IM.! i
$ over projectiles (IM.delete i) w
where pt = _projectiles w IM.! i
oldPos = _ptPos pt
vel = _ptVel pt
newPos = oldPos +.+ vel
@@ -813,8 +813,8 @@ remoteShellPic i | rem (i+200) 20 < 9 = polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,
shellExplosionAt = makeExplosionAt
tractorBeamAt :: Int -> Int -> Point2 -> Float -> Particle
tractorBeamAt colID i pos dir = Particle
tractorBeamAt :: Int -> Int -> Point2 -> Float -> Projectile
tractorBeamAt colID i pos dir = Projectile
{ _ptPos = pos
, _ptStartPos = p'
, _ptVel = d
@@ -1003,8 +1003,8 @@ reflect :: Float -> Float -> Float
reflect a b = a + 2*(a-b)
moveGrenade :: Int -> Float -> Int -> World -> World
moveGrenade 0 dir pID w = over particles (IM.delete pID)
$ makeExplosionAt (_ptPos (_particles w IM.! pID))
moveGrenade 0 dir pID w = over projectiles (IM.delete pID)
$ makeExplosionAt (_ptPos (_projectiles w IM.! pID))
-- $ set (pointToItem (_itemPositions w IM.! wpID) . itEquipPict)
-- (drawWeapon $ grenadePic 50)
w
@@ -1013,17 +1013,17 @@ moveGrenade time dir pID w
Just _ -> soundOnce (fromIntegral tapQuiet) updatedWorld
_ -> updatedWorld
where
updatedWorld = updateV $ set (particles . ix pID . ptPos) finalPos
$ set (particles.ix pID.ptPict)
updatedWorld = updateV $ set (projectiles . ix pID . ptPos) finalPos
$ set (projectiles .ix pID.ptPict)
(onLayer PtLayer $ uncurry translate newPos
$ rotate dir $ grenadePic time)
$ set (particles.ix pID.ptUpdate) (moveGrenade (time-1) dir pID) w
pt = _particles w IM.! pID
$ set (projectiles .ix pID.ptUpdate) (moveGrenade (time-1) dir pID) w
pt = _projectiles w IM.! pID
oldPos = _ptPos pt
newPos = _ptVel pt +.+ oldPos
hitWl = collideCircWalls' oldPos newPos 4 $ wallsNearPoint newPos w
finalPos = fromMaybe newPos (fmap fst hitWl)
setV v = set (particles.ix pID.ptVel) v
setV v = set (projectiles .ix pID.ptVel) v
updateV = fromMaybe id (fmap (setV.snd) hitWl)
pointToItem (InInv cid invid) = creatures . ix cid . crInv . ix invid
@@ -1035,15 +1035,15 @@ retireRemoteRocket itid 0 ptid w
(0,0)
$ set (pointToItem (_itemPositions w IM.! itid) . wpFire)
fireRemoteLauncher
(w & particles %~ IM.delete ptid)
retireRemoteRocket itid t ptid w = setScope w & particles . ix ptid . ptUpdate .~ retireRemoteRocket itid (t-1) ptid
(w & projectiles %~ IM.delete ptid)
retireRemoteRocket itid t ptid w = setScope w & projectiles . ix ptid . ptUpdate .~ retireRemoteRocket itid (t-1) ptid
where
setScope w' = case _itemPositions w' IM.! itid of
InInv cid invid
-> w' & creatures . ix cid . crInv . ix invid . itAttachment
. _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
_ -> w'
pos = fromMaybe (0,0) $ w ^? particles . ix ptid . ptPos
pos = fromMaybe (0,0) $ w ^? projectiles . ix ptid . ptPos
retireRemoteBomb :: Int -> Int -> Int -> World -> World
retireRemoteBomb itid 0 ptid w
@@ -1053,22 +1053,22 @@ retireRemoteBomb itid 0 ptid w
basicItZoom
$ set (pointToItem (_itemPositions w IM.! itid) . twFire)
throwRemoteBomb
(w & particles %~ IM.delete ptid)
(w & projectiles %~ IM.delete ptid)
retireRemoteBomb itid t ptid w
= setScope w & particles . ix ptid . ptUpdate .~ retireRemoteBomb itid (t-1) ptid
= setScope w & projectiles . ix ptid . ptUpdate .~ retireRemoteBomb itid (t-1) ptid
where
setScope w' = case _itemPositions w' IM.! itid of
InInv cid invid
-> w' & creatures . ix cid . crInv . ix invid . itAttachment
. _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
_ -> w'
pos = fromMaybe (0,0) $ w ^? particles . ix ptid . ptPos
pos = fromMaybe (0,0) $ w ^? projectiles . ix ptid . ptPos
moveRemoteBomb :: Int -> Int -> Int -> World -> World
moveRemoteBomb itid time pID w
| time < -4 = setScope
$ updatePicture
$ set (particles.ix pID.ptUpdate) (moveRemoteBomb itid (f time) pID)
$ set (projectiles .ix pID.ptUpdate) (moveRemoteBomb itid (f time) pID)
w
| time < 2
= case hitWl of
@@ -1080,9 +1080,9 @@ moveRemoteBomb itid time pID w
_ -> updatedWorld
where
updatedWorld
= updateV $ set (particles . ix pID . ptPos) finalPos
= updateV $ set (projectiles . ix pID . ptPos) finalPos
$ updatePicture
$ set (particles.ix pID.ptUpdate) (moveRemoteBomb itid (time-1) pID)
$ set (projectiles .ix pID.ptUpdate) (moveRemoteBomb itid (time-1) pID)
$ setScope
w
setScope w' = case _itemPositions w' IM.! itid of
@@ -1092,7 +1092,7 @@ moveRemoteBomb itid time pID w
& creatures . ix cid . crInv . ix invid . itZoom
.~ (basicItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5})
_ -> w'
pt = _particles w IM.! pID
pt = _projectiles w IM.! pID
oldPos = _ptPos pt
newPos = _ptVel pt +.+ oldPos
-- this is hacky, should use a version of collidePointWalls' that collides
@@ -1100,12 +1100,12 @@ moveRemoteBomb itid time pID w
invShift x = x -.- 5 *.* normalizeV (_ptVel pt)
hitWl = collideCircWalls' oldPos newPos 4 $ wallsNearPoint newPos w
finalPos = fromMaybe newPos (fmap (invShift . fst) hitWl)
setV v = set (particles.ix pID.ptVel) v
setV v = set (projectiles .ix pID.ptVel) v
updateV = fromMaybe id (fmap (setV.snd) hitWl)
halfV = over (particles . ix pID . ptVel) (\v -> 0.5 *.* v)
halfV = over (projectiles . ix pID . ptVel) (\v -> 0.5 *.* v)
f x | x < -369 = -10
| otherwise = x - 1
updatePicture = set (particles . ix pID.ptPict)
updatePicture = set (projectiles . ix pID.ptPict)
(onLayer PtLayer $ uncurry translate newPos
$ remoteBombPic time)
. lowLightDirected red 0.1 newPos
@@ -1196,9 +1196,9 @@ withThickSmoke eff cid w = eff cid $ foldr ($) w smokeGen
makeThinSmokeAt :: Color -> Point2 -> Float -> Int -> Point2 -> World -> World
makeThinSmokeAt col vel scal time p w = over particles (IM.insert n smP) w
makeThinSmokeAt col vel scal time p w = over projectiles (IM.insert n smP) w
where n = newParticleKey w
smP = Particle
smP = Projectile
{ _ptPos = p
, _ptStartPos = p
, _ptVel = vel
@@ -1210,22 +1210,22 @@ makeThinSmokeAt col vel scal time p w = over particles (IM.insert n smP) w
moveThinSmoke :: Color -> Float -> Int -> Int -> World -> World
moveThinSmoke col scal time i w
| time > 0
= set (particles . ix i . ptPict) pic
. set (particles . ix i . ptUpdate) (moveThinSmoke col scal (time-1) i)
. set (particles . ix i . ptPos) newPos
= set (projectiles . ix i . ptPict) pic
. set (projectiles . ix i . ptUpdate) (moveThinSmoke col scal (time-1) i)
. set (projectiles . ix i . ptPos) newPos
. setVel
$ w
| time > -10
= set (particles . ix i . ptPict) pi1
. set (particles . ix i . ptUpdate) (moveThinSmoke col scal (time-1) i)
. set (particles . ix i . ptPos) newPos
= set (projectiles . ix i . ptPict) pi1
. set (projectiles . ix i . ptUpdate) (moveThinSmoke col scal (time-1) i)
. set (projectiles . ix i . ptPos) newPos
. setVel
$ w
| otherwise
= over particles (IM.delete i) w
where oldPos = _ptPos $ _particles w IM.! i
newPos = oldPos +.+ (_ptVel $ _particles w IM.! i)
setVel = over (particles . ix i . ptVel) $ (*.*) 0.99
= over projectiles (IM.delete i) w
where oldPos = _ptPos $ _projectiles w IM.! i
newPos = oldPos +.+ (_ptVel $ _projectiles w IM.! i)
setVel = over (projectiles . ix i . ptVel) $ (*.*) 0.99
pic = onLayer PtLayer $ uncurry translate newPos $ color (withAlpha 0.1 col) $ circleSolid scal
pi1 = onLayer PtLayer $ uncurry translate newPos
$ color (withAlpha (0.1 + fromIntegral time /100) col)
@@ -1389,9 +1389,9 @@ remoteBomb = defaultThrowable
throwGrenade :: Int -> Int -> World -> World
throwGrenade fuseTime n w = setWp $ removePict $ over particles addG $ set randGen g w
throwGrenade fuseTime n w = setWp $ removePict $ over projectiles addG $ set randGen g w
where addG = IM.insert i
$ Particle { _ptPos = p
$ Projectile { _ptPos = p
, _ptStartPos = p
, _ptVel = v
, _ptPict = onLayer PtLayer $ uncurry translate p $ grenadePic 0
@@ -1441,13 +1441,13 @@ grenadePic x = pictures [ color (dark $ dark green) $ circleSolid 5
fireRemoteLauncher :: Int -> World -> World
fireRemoteLauncher cid w = setLocation $ resetFire $ resetName
$ soundOnce (fromIntegral launcherSound)
$ over particles remRocket w
$ over projectiles remRocket w
where
i = newKey $ _particles w
i = newKey $ _projectiles w
cr = _creatures w IM.! cid
dir = _crDir cr
pos = _crPos cr +.+ rotateV dir (_crRad cr + 1,0)
remRocket = IM.insert i $ Particle { _ptPos = pos
remRocket = IM.insert i $ Projectile { _ptPos = pos
, _ptStartPos = pos
, _ptVel = rotateV dir (1,0)
, _ptPict = blank
@@ -1470,17 +1470,17 @@ moveRemoteShell :: Int -> Int -> Int -> Int -> Float -> World -> World
moveRemoteShell time i cid itid dir w
| time > 40 = if circOnSomeWall oldPos 4 w
then doExplosion w
else over (particles . ix i . ptPos) (+.+ vel)
$ set (particles . ix i . ptPict) piclow
$ set (particles . ix i . ptUpdate)
else over (projectiles . ix i . ptPos) (+.+ vel)
$ set (projectiles . ix i . ptPict) piclow
$ set (projectiles . ix i . ptUpdate)
(moveRemoteShell (time-1) i cid itid newdir)
$ setScope
w
| time >= 20 = case thingHit of
Just p -> doExplosion w
Nothing -> over (particles . ix i . ptPos) (+.+ vel)
$ set (particles . ix i . ptPict) pic
$ set (particles . ix i . ptUpdate)
Nothing -> over (projectiles . ix i . ptPos) (+.+ vel)
$ set (projectiles . ix i . ptPict) pic
$ set (projectiles . ix i . ptUpdate)
(moveRemoteShell (time-1) i cid itid newdir)
$ setScope
w
@@ -1489,12 +1489,12 @@ moveRemoteShell time i cid itid dir w
Just p -> doExplosion
$ stopSoundFrom (ShellSound i)
w
Nothing -> over (particles . ix i . ptPos) (+.+ vel)
Nothing -> over (projectiles . ix i . ptPos) (+.+ vel)
$ set randGen g
$ set (particles . ix i . ptPict) pic
$ set (particles . ix i . ptUpdate)
$ set (projectiles . ix i . ptPict) pic
$ set (projectiles . ix i . ptUpdate)
(moveRemoteShell (time-1) i cid itid newdir)
$ over (particles . ix i . ptVel) (\v -> accel +.+ frict *.* v)
$ over (projectiles . ix i . ptVel) (\v -> accel +.+ frict *.* v)
$ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250
$ smokeGen
$ makeFlameletTimed oldPos
@@ -1507,16 +1507,16 @@ moveRemoteShell time i cid itid dir w
Just p -> doExplosion
$ stopSoundFrom (ShellSound i)
w
Nothing -> over (particles . ix i . ptPos) (+.+ vel)
$ set (particles . ix i . ptPict) pic
$ set (particles . ix i . ptUpdate)
Nothing -> over (projectiles . ix i . ptPos) (+.+ vel)
$ set (projectiles . ix i . ptPict) pic
$ set (projectiles . ix i . ptUpdate)
(moveRemoteShell (time-1) i cid itid newdir)
$ setScope
w
| otherwise = doExplosion
$ stopSoundFrom (ShellSound i)
w
where pt = _particles w IM.! i
where pt = _projectiles w IM.! i
oldPos = _ptPos pt
vel = _ptVel pt
newPos = oldPos +.+ vel
@@ -1557,23 +1557,23 @@ moveRemoteShell time i cid itid dir w
explodeRemoteRocket :: Int -> Int -> Int -> World -> World
explodeRemoteRocket itid ptid n w
= set (particles . ix ptid . ptUpdate) (retireRemoteRocket itid 30 ptid)
$ set (particles . ix ptid . ptPict) blank
= set (projectiles . ix ptid . ptUpdate) (retireRemoteRocket itid 30 ptid)
$ set (projectiles . ix ptid . ptPict) blank
$ set (itPoint . wpFire) (flip const)
$ resetName
-- $ resetScope
$ makeExplosionAt (_ptPos (_particles w IM.! ptid)) w
-- $ makeShrapnelBombAt (_ptPos (_particles w IM.! ptid)) w
$ makeExplosionAt (_ptPos (_projectiles w IM.! ptid)) w
-- $ makeShrapnelBombAt (_ptPos (_projectiles w IM.! ptid)) w
where resetName = set (itPoint . itName) "REMOTELAUNCHER"
-- resetScope = creatures . ix n . crInv . ix j . itScope . _Just . scopePos .~ (0,0)
itPoint = pointToItem $ _itemPositions w IM.! itid
throwRemoteBomb :: Int -> World -> World
throwRemoteBomb n w = setLocation $ removePict $ resetFire
-- $ resetName $ over particles addG $ set randGen g w
$ resetName $ over particles addG w
-- $ resetName $ over projectiles addG $ set randGen g w
$ resetName $ over projectiles addG w
where addG = IM.insert i
$ Particle { _ptPos = p
$ Projectile { _ptPos = p
, _ptStartPos = p
, _ptVel = v
, _ptPict = blank
@@ -1608,14 +1608,14 @@ throwRemoteBomb n w = setLocation $ removePict $ resetFire
explodeRemoteBomb :: Int -> Int -> Int -> World -> World
explodeRemoteBomb itid ptid n w
= set (particles . ix ptid . ptUpdate) (retireRemoteBomb itid 30 ptid)
$ set (particles . ix ptid . ptPict) blank
= set (projectiles . ix ptid . ptUpdate) (retireRemoteBomb itid 30 ptid)
$ set (projectiles . ix ptid . ptPict) blank
$ set (creatures . ix n . crInv . ix j . twFire) (flip const)
$ resetName
$ resetPict
-- $ resetScope
$ makeExplosionAt (_ptPos (_particles w IM.! ptid)) w
-- $ makeShrapnelBombAt (_ptPos (_particles w IM.! ptid)) w
$ makeExplosionAt (_ptPos (_projectiles w IM.! ptid)) w
-- $ makeShrapnelBombAt (_ptPos (_projectiles w IM.! ptid)) w
where resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTEBOMB"
resetPict = set (creatures . ix n . crInv . ix j . itEquipPict )
(drawWeapon $ remoteBombUnarmedPic)
@@ -1635,8 +1635,8 @@ remoteBombUnarmedPic :: Picture
remoteBombUnarmedPic = color (dark $ dark orange) $ circleSolid 5
makeTeslaArcAt :: Int -> Point2 -> Float -> Particle
makeTeslaArcAt i pos dir = Particle
makeTeslaArcAt :: Int -> Point2 -> Float -> Projectile
makeTeslaArcAt i pos dir = Projectile
{ _ptPos = pos
, _ptStartPos = pos
, _ptVel = (0,0)
@@ -1647,8 +1647,8 @@ makeTeslaArcAt i pos dir = Particle
moveTeslaArc :: Point2 -> Float -> Int -> World -> World
moveTeslaArc p d i w =
set (particles . ix i . ptPict) pic
$ set (particles . ix i . ptUpdate)
set (projectiles . ix i . ptPict) pic
$ set (projectiles . ix i . ptUpdate)
(ptTimer 2 i)
$ set randGen g
$ createSpark 8 nc q2 (argV sv + d1) Nothing
@@ -1854,7 +1854,7 @@ forceFieldFire cid w = w
-- (_wpFireRate (_crInv cr IM.! itRef))
-- $ over (creatures . ix n . crInv . ix itRef . wpLoadedAmmo)
-- (\x -> x - 1)
-- $ over particles (IM.insert i $ makeTremorAt i pos dir) w
-- $ over projectiles (IM.insert i $ makeTremorAt i pos dir) w
-- | reloadCondition = let remAmmo = _crAmmo cr M.! _wpAmmoType item
-- (newA,newTotalA) = moveInt (_wpMaxAmmo item) remAmmo
-- in set (pointerToItem . wpReloadState) rTime
@@ -1888,12 +1888,12 @@ moveInt toReload totalAmmo = (x, totalAmmo-x)
updateTractor :: Int -> Int -> Int -> World -> World
updateTractor colID time i w
| time > 0 = set (particles . ix i . ptUpdate) (updateTractor colID (time-1) i)
$ set (particles . ix i . ptPict) pic
| time > 0 = set (projectiles . ix i . ptUpdate) (updateTractor colID (time-1) i)
$ set (projectiles . ix i . ptPict) pic
$ over creatures (IM.map tractCr)
$ over floorItems (IM.map tractFlIt)
w
| otherwise = over particles (IM.delete i) w
| otherwise = over projectiles (IM.delete i) w
where tractCr cr | circOnLine p1 p2 cP 10
= over crPos (\p ->
p -.- m *.* ((0.3/ x) *.* q +.+ (f y *.* p4))
@@ -1914,7 +1914,7 @@ updateTractor colID time i w
iP = _flItPos it
m | dist iP p1 < 350 = 1
| otherwise = (410 - dist iP p1) / 60
pt = _particles w IM.! i
pt = _projectiles w IM.! i
q = _ptVel pt
p1 = _ptPos pt
p' = _ptStartPos pt
src/Dodge/Item/Weapon/Bullet.hs
+3 -4
View File
@@ -132,7 +132,7 @@ bulHitWall' bt p x w = damageBlocks x
pOut = p +.+ safeNormalizeV (sp -.- p)
(colID,g) = randomR (0,11) $ _randGen w
(a, _) = randomR (-0.1,0.1) $ _randGen w
spid = newKey $ _particles w
spid = newKey $ _projectiles w
reflectDir wall = a + (argV $ reflectIn
(_wlLine wall !! 1 -.- _wlLine wall !! 0)
(p -.- sp)
@@ -160,7 +160,7 @@ bulBounceWall' bt p wl w = damageBlocks wl
reflectVel = (reflectIn wallV (_btVel' bt))
addBouncer = (.) (over particles' ((:) bouncer))
-- the hack is to get around the fact that the particles' list gets reset after
-- all particles in it are checked, so we cannot add to it as we accumulate over
-- all projectiles in it are checked, so we cannot add to it as we accumulate over
-- this list
bulIncWall' :: Particle' -> Point2 -> Wall -> World -> World
@@ -181,7 +181,6 @@ bulIncWall' bt p wl w = damageBlocks wl
bulConWall' :: Particle' -> Point2 -> Wall -> World -> World
bulConWall' bt p wl w = damageBlocks wl
$ mkwave
-- yay for hack -- should have used this before? or never?
w
where sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p)
@@ -199,7 +198,7 @@ hvBulHitWall' bt p x w = damageBlocks x
where sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p)
(a, g) = randomR (-0.1,0.1) $ _randGen w
spid = newKey $ _particles w
spid = newKey $ _projectiles w
reflectDir wall = a + (argV $ reflectIn
(_wlLine wall !! 1 -.- _wlLine wall !! 0)
(p -.- sp)
src/Dodge/Prototypes.hs
+2 -2
View File
@@ -159,7 +159,7 @@ basicButton = Button
, _btText = "Button"
, _btState = BtOff
}
basicPT = Particle
basicPT = Projectile
{ _ptPos = (0,0)
, _ptStartPos = (0,0)
, _ptVel = (0,0)
@@ -190,7 +190,7 @@ basicWorld = World
, _clouds = IM.empty
, _cloudsZone = IM.empty
, _itemPositions = IM.empty
, _particles = IM.empty
, _projectiles = IM.empty
, _particles' = []
, _walls = IM.empty
, _wallsZone = IM.empty
src/Dodge/Rendering.hs
+1 -1
View File
@@ -37,7 +37,7 @@ fixedCoordPictures w = pictures
worldPictures :: World -> Picture
worldPictures w
= pictures $ concat [ IM.elems $ _decorations w
, map _ptPict . IM.elems $ _particles w
, map _ptPict . IM.elems $ _projectiles w
, map drawItem . IM.elems $ _floorItems w
, map crDraw . IM.elems $ _creatures w
, map clDraw . IM.elems $ _clouds w
src/Dodge/Update.hs
+2 -2
View File
@@ -69,7 +69,7 @@ updateSoundQueue = set soundQueue []
updateLightSources w = set tempLightSources (catMaybes tlss) w'
where (w',tlss) = mapAccumR (\a b -> _tlsUpdate b a b) w $ _tempLightSources w
updateParticles w = IM.foldr' _ptUpdate w $ _particles w
updateParticles w = IM.foldr' _ptUpdate w $ _projectiles w
updateSmoke :: World -> World
updateSmoke w = w & smoke %~ mapMaybe (\s -> _smUpdate s s)
@@ -113,7 +113,7 @@ setTestStringIO = fmap (\ w -> set testString (show $ s w) w)
-- fmap (set testString $ show $ last $ show $ pairsToIncidence' $ _pathGraph' w') w
-- update logic: creature old position set, creatures perform actions including movement,
-- creatures collided with each other, camera updated, particles updated, creatures
-- creatures collided with each other, camera updated, projectiles updated, creatures
-- collided with walls
src/Dodge/WorldEvent.hs
+19 -59
View File
@@ -4,9 +4,11 @@ module Dodge.WorldEvent
, module Dodge.WorldEvent.Flash
, module Dodge.WorldEvent.ThingsHit
, module Dodge.WorldEvent.HelperParticle
, module Dodge.WorldEvent.Projectile
)
where
import Dodge.WorldEvent.Projectile
import Dodge.WorldEvent.Bullet
import Dodge.WorldEvent.Flash
import Dodge.WorldEvent.ThingsHit
@@ -25,7 +27,6 @@ import Control.Monad.State
import System.Random
import Data.Bifunctor
import Data.Maybe
import Data.Function
import Data.List
@@ -35,10 +36,10 @@ makeExplosionAt :: Point2 -> World -> World
makeExplosionAt p w = soundOnce grenadeBang
$ over tempLightSources ((:) $ tLightFade 20 150 intensityF p)
$ fs
$ over particles (IM.insert n exp)
$ over projectiles (IM.insert n exp)
w
where n = newParticleKey w
exp = Particle
exp = Projectile
{ _ptPos = p
, _ptStartPos = p
, _ptVel = (0,0)
@@ -66,11 +67,11 @@ makeExplosionAt p w = soundOnce grenadeBang
| otherwise = 1
explosionWaveDamage :: Int -> Point2 -> Int -> World -> World
explosionWaveDamage 0 p ptid = over particles (IM.delete ptid)
explosionWaveDamage 0 p ptid = over projectiles (IM.delete ptid)
explosionWaveDamage time p ptid
= set (particles . ix ptid . ptUpdate) (explosionWaveDamage (time-1) p ptid)
= set (projectiles . ix ptid . ptUpdate) (explosionWaveDamage (time-1) p ptid)
. shockWaveDamage p rad 20
. set (particles . ix ptid . ptPict) shockwavePic
. set (projectiles . ix ptid . ptPict) shockwavePic
. explosionFlashAt p
where shockwavePic = onLayer PtLayer $ uncurry translate p $ color (withAlpha 0.9 white)
$ thickCircle rad (thickness*2)
@@ -244,48 +245,7 @@ createBarrelSpark time colid pos dir maycid w = over worldEvents
noEff _ _ _ = id
type HitCreatureEffect = Particle' -> Point2 -> Creature -> World -> World
type HitWallEffect = Particle' -> Point2 -> Wall -> World -> World
type HitForceFieldEffect = Particle' -> Point2 -> ForceField -> World -> World
destroyOnImpact :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle')
destroyOnImpact crEff wlEff ffEff pt hitThings w = case hitThings of
[] -> ( w, mvPt)
((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p)
((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p)
((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p)
where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl)
& ptPict' .~ bulLine col wth (hitp: trl)
& btTimer' .~ 3
mvPt = Just $ pt & btTrail' .~ (newP : trl)
& ptPict' .~ bulLine col wth (newP : trl)
& btTimer' %~ (\t -> t - 1)
& btPassThrough' .~ Nothing
trl = _btTrail' pt
col = _btColor' pt
wth = _btWidth' pt
newP = head trl +.+ _btVel' pt
penWalls :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle')
penWalls crEff wlEff ffEff pt hitThings w = case hitThings of
[] -> ( w, mvPt)
((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p)
((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p)
((p,E3x2 wl):hs) | isJust (wl ^? blHP)
-> first (wlEff pt p wl) $ penWalls crEff wlEff ffEff pt hs w
((p,E3x2 wl):_) | otherwise -> (wlEff pt p wl w, destroyAt p)
where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl)
& ptPict' .~ bulLine col wth (hitp: trl)
& btTimer' .~ 3
mvPt = Just $ pt & btTrail' .~ (newP : trl)
& ptPict' .~ bulLine col wth (newP : trl)
& btTimer' %~ (\t -> t - 1)
& btPassThrough' .~ Nothing
trl = _btTrail' pt
col = _btColor' pt
wth = _btWidth' pt
newP = head trl +.+ _btVel' pt
makeFlameletTimed :: Point2 -> Point2 -> Int -> Maybe Int -> Float -> Int -> World -> World
makeFlameletTimed pos vel levelInt maycid size time w
@@ -404,9 +364,9 @@ moveSmoke'' scal time p vel w pt
]
makeColorSmokeAt :: Color -> Point2 -> Float -> Int -> Point2 -> World -> World
makeColorSmokeAt col vel scal time p w = over particles (IM.insert n smP) w
makeColorSmokeAt col vel scal time p w = over projectiles (IM.insert n smP) w
where n = newParticleKey w
smP = Particle
smP = Projectile
{ _ptPos = p
, _ptStartPos = p
, _ptVel = vel
@@ -418,22 +378,22 @@ makeColorSmokeAt col vel scal time p w = over particles (IM.insert n smP) w
moveColorSmoke :: Color -> Float -> Int -> Int -> World -> World
moveColorSmoke col scal time i w
| time > 0
= set (particles . ix i . ptPict) pic
. set (particles . ix i . ptUpdate) (moveColorSmoke col scal (time-1) i)
. set (particles . ix i . ptPos) newPos
= set (projectiles . ix i . ptPict) pic
. set (projectiles . ix i . ptUpdate) (moveColorSmoke col scal (time-1) i)
. set (projectiles . ix i . ptPos) newPos
. setVel
$ w
| time > -50
= set (particles . ix i . ptPict) pi1
. set (particles . ix i . ptUpdate) (moveColorSmoke col scal (time-1) i)
. set (particles . ix i . ptPos) newPos
= set (projectiles . ix i . ptPict) pi1
. set (projectiles . ix i . ptUpdate) (moveColorSmoke col scal (time-1) i)
. set (projectiles . ix i . ptPos) newPos
. setVel
$ w
| otherwise
= over particles (IM.delete i) w
where oldPos = _ptPos $ _particles w IM.! i
newPos = oldPos +.+ (_ptVel $ _particles w IM.! i)
setVel = over (particles . ix i . ptVel) $ (*.*) 0.99
= over projectiles (IM.delete i) w
where oldPos = _ptPos $ _projectiles w IM.! i
newPos = oldPos +.+ (_ptVel $ _projectiles w IM.! i)
setVel = over (projectiles . ix i . ptVel) $ (*.*) 0.99
pic = onLayer PtLayer $ uncurry translate newPos $ color col $ circleSolid $ (21 - fromIntegral time) * scal
pi1 = onLayer PtLayer $ uncurry translate newPos
$ color (withAlpha (1 + fromIntegral time /50) col)
src/Dodge/WorldEvent/Projectile.hs
+55
View File
@@ -0,0 +1,55 @@
module Dodge.WorldEvent.Projectile
where
import Dodge.Data
import Control.Lens
import Data.Bifunctor
import Data.Maybe
import Picture
import Geometry
type HitCreatureEffect = Particle' -> Point2 -> Creature -> World -> World
type HitWallEffect = Particle' -> Point2 -> Wall -> World -> World
type HitForceFieldEffect = Particle' -> Point2 -> ForceField -> World -> World
destroyOnImpact :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle')
destroyOnImpact crEff wlEff ffEff pt hitThings w = case hitThings of
[] -> ( w, mvPt)
((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p)
((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p)
((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p)
where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl)
& ptPict' .~ drawBul wth (hitp: trl)
& btTimer' .~ 3
mvPt = Just $ pt & btTrail' .~ (newP : trl)
& ptPict' .~ drawBul wth (newP : trl)
& btTimer' %~ (\t -> t - 1)
& btPassThrough' .~ Nothing
trl = _btTrail' pt
wth = _btWidth' pt
newP = head trl +.+ _btVel' pt
penWalls :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle')
penWalls crEff wlEff ffEff pt hitThings w = case hitThings of
[] -> ( w, mvPt)
((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p)
((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p)
((p,E3x2 wl):hs) | isJust (wl ^? blHP)
-> first (wlEff pt p wl) $ penWalls crEff wlEff ffEff pt hs w
((p,E3x2 wl):_) | otherwise -> (wlEff pt p wl w, destroyAt p)
where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl)
& ptPict' .~ drawBul wth (hitp: trl)
& btTimer' .~ 3
mvPt = Just $ pt & btTrail' .~ (newP : trl)
& ptPict' .~ drawBul wth (newP : trl)
& btTimer' %~ (\t -> t - 1)
& btPassThrough' .~ Nothing
trl = _btTrail' pt
wth = _btWidth' pt
newP = head trl +.+ _btVel' pt
drawBul :: Float -> [Point2] -> Picture
drawBul width (a:b:_) = setLayer 1 . color white $ thickLine [a,b] width
drawBul _ _ = blank