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