This commit is contained in:
2022-07-24 13:53:35 +01:00
parent ac069d08f6
commit 2c1bc67a51
16 changed files with 185 additions and 199 deletions
+1 -1
View File
@@ -159,7 +159,7 @@ data HeldItemType
-- | LASGUNWIDEPULSE -- | LASGUNWIDEPULSE
| LASWIDE {_xNum :: Int} | LASWIDE {_xNum :: Int}
-- | LASGUNFOCUS Int -- | LASGUNFOCUS Int
| SONICGUN -- | SONICGUN
| TRACTORGUN | TRACTORGUN
| LAUNCHER | LAUNCHER
| LAUNCHERX {_xNum :: Int} | LAUNCHERX {_xNum :: Int}
+2 -2
View File
@@ -250,8 +250,8 @@ testInventory = IM.fromList $ zip [0..]
] ]
stackedInventory :: IM.IntMap Item stackedInventory :: IM.IntMap Item
stackedInventory = IM.fromList $ zip [0..] stackedInventory = IM.fromList $ zip [0..]
[sonicGun [--sonicGun
,burstRifle burstRifle
, pipe , pipe
,rewindGun ,rewindGun
,tractorGun ,tractorGun
+16 -16
View File
@@ -218,8 +218,8 @@ data World = World
, _projectiles :: IM.IntMap Proj , _projectiles :: IM.IntMap Proj
, _instantBullets :: [Bullet] , _instantBullets :: [Bullet]
, _bullets :: [Bullet] , _bullets :: [Bullet]
, _instantParticles :: [Particle] -- , _instantParticles :: [Particle]
, _particles :: [Particle] -- , _particles :: [Particle]
, _radarSweeps :: [RadarSweep] , _radarSweeps :: [RadarSweep]
, _energyBalls :: [EnergyBall] , _energyBalls :: [EnergyBall]
, _posEvents :: [PosEvent] , _posEvents :: [PosEvent]
@@ -292,7 +292,7 @@ data World = World
, _lSelect :: Point2 , _lSelect :: Point2
, _rSelect :: Point2 , _rSelect :: Point2
} }
--deriving (Eq,Ord,Show,Read) -- deriving (Eq,Ord,Show,Read)
data WorldHammer data WorldHammer
= SubInvHam = SubInvHam
| DoubleMouseHam | DoubleMouseHam
@@ -385,18 +385,18 @@ data WorldBeams = WorldBeams
{- Objects without ids. {- Objects without ids.
Update themselves, perhaps with side effects. -} Update themselves, perhaps with side effects. -}
data Particle --data Particle = DPart
= ShockLine -- = ShockLine
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle) -- { _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptPointDirs :: [[(Point2,Float)]] -- , _ptPointDirs :: [[(Point2,Float)]]
, _ptTimer :: Int -- , _ptTimer :: Int
, _ptColor :: Color -- , _ptColor :: Color
, _ptCenter :: Point2 -- , _ptCenter :: Point2
} -- }
type HitEffect = Particle --type HitEffect = Particle
-> Stream (Of (Point2, Either Creature Wall)) Identity () -- -> Stream (Of (Point2, Either Creature Wall)) Identity ()
-> World -- -> World
-> (World,Maybe Particle) -- -> (World,Maybe Particle)
type HitEffect' = Flame type HitEffect' = Flame
-> Stream (Of (Point2, Either Creature Wall)) Identity () -> Stream (Of (Point2, Either Creature Wall)) Identity ()
-> World -> World
@@ -593,7 +593,7 @@ data InPlacement = InPlacement
} }
makeLenses ''World makeLenses ''World
makeLenses ''FloorItem makeLenses ''FloorItem
makeLenses ''Particle --makeLenses ''Particle
makeLenses ''Door makeLenses ''Door
makeLenses ''Terminal makeLenses ''Terminal
makeLenses ''Machine makeLenses ''Machine
-1
View File
@@ -15,7 +15,6 @@ data HeldUse = HeldDoNothing
| HeldCircleLaser | HeldCircleLaser
| HeldDualLaser | HeldDualLaser
| HeldTractor | HeldTractor
| HeldSonicWave
| HeldForceField | HeldForceField
| HeldShatter | HeldShatter
deriving (Eq,Ord,Show,Read) deriving (Eq,Ord,Show,Read)
+1
View File
@@ -32,4 +32,5 @@ data Proj
, _prjUpdates :: [ProjectileUpdate] , _prjUpdates :: [ProjectileUpdate]
, _prjMITID :: Maybe Int , _prjMITID :: Maybe Int
} }
deriving (Eq,Ord,Show,Read)
makeLenses ''Proj makeLenses ''Proj
+2 -2
View File
@@ -34,8 +34,8 @@ defaultWorld = World
, _projectiles = IM.empty , _projectiles = IM.empty
, _instantBullets = [] , _instantBullets = []
, _bullets = [] , _bullets = []
, _instantParticles = [] -- , _instantParticles = []
, _particles = [] -- , _particles = []
, _flames = [] , _flames = []
, _radarSweeps = [] , _radarSweeps = []
, _sparks = [] , _sparks = []
+1 -2
View File
@@ -9,7 +9,6 @@ import Dodge.WorldEvent.Flash
import Dodge.Item.Location import Dodge.Item.Location
import Dodge.Item.Weapon.Radar import Dodge.Item.Weapon.Radar
import Dodge.Item.Weapon.BatteryGuns import Dodge.Item.Weapon.BatteryGuns
import Dodge.Item.Weapon.SonicGuns
import Dodge.Item.Weapon.Utility import Dodge.Item.Weapon.Utility
import Dodge.Item.Weapon.Shatter import Dodge.Item.Weapon.Shatter
import Dodge.Item.Weapon.Launcher import Dodge.Item.Weapon.Launcher
@@ -340,7 +339,7 @@ useHeld hu = case hu of
HeldCircleLaser -> circleLaser HeldCircleLaser -> circleLaser
HeldDualLaser -> shootDualLaser HeldDualLaser -> shootDualLaser
HeldTractor -> aTractorBeam HeldTractor -> aTractorBeam
HeldSonicWave -> aSonicWave -- HeldSonicWave -> aSonicWave
HeldForceField -> useForceFieldGun HeldForceField -> useForceFieldGun
HeldShatter -> shootShatter HeldShatter -> shootShatter
HeldExplodeRemoteShell itid pjid -> const $ const $ explodeRemoteRocket itid pjid HeldExplodeRemoteShell itid pjid -> const $ const $ explodeRemoteRocket itid pjid
+1 -1
View File
@@ -105,7 +105,7 @@ itemFromHeldType ht = case ht of
-- LASGUNWIDEPULSE -> lasWidePulse -- LASGUNWIDEPULSE -> lasWidePulse
LASWIDE i -> lasWide i LASWIDE i -> lasWide i
--LASGUNFOCUS i -> lasFocus i --LASGUNFOCUS i -> lasFocus i
SONICGUN -> sonicGun -- SONICGUN -> sonicGun
TRACTORGUN -> tractorGun TRACTORGUN -> tractorGun
LAUNCHER -> launcher LAUNCHER -> launcher
LAUNCHERX i -> launcherX i LAUNCHERX i -> launcherX i
+1 -1
View File
@@ -91,7 +91,7 @@ heldItemSPic ht it = case ht of
LASCIRCLE -> lasGunPic it LASCIRCLE -> lasGunPic it
DUALBEAM -> dualBeamPic it DUALBEAM -> dualBeamPic it
LASWIDE _ -> lasGunPic it LASWIDE _ -> lasGunPic it
SONICGUN -> noPic baseSonicShape --SONICGUN -> noPic baseSonicShape
TRACTORGUN -> tractorGunPic it TRACTORGUN -> tractorGunPic it
LAUNCHER -> launcherPic it LAUNCHER -> launcherPic it
LAUNCHERX _ -> launcherPic it LAUNCHERX _ -> launcherPic it
-2
View File
@@ -1,7 +1,6 @@
{- | Rexport all weapons -} {- | Rexport all weapons -}
module Dodge.Item.Weapon module Dodge.Item.Weapon
( module Dodge.Item.Weapon.BulletGuns ( module Dodge.Item.Weapon.BulletGuns
, module Dodge.Item.Weapon.SonicGuns
, module Dodge.Item.Weapon.Shatter , module Dodge.Item.Weapon.Shatter
, module Dodge.Item.Weapon.TriggerType , module Dodge.Item.Weapon.TriggerType
, module Dodge.Item.Weapon.ExtraEffect , module Dodge.Item.Weapon.ExtraEffect
@@ -19,7 +18,6 @@ import Dodge.Item.Weapon.Utility
import Dodge.Item.Weapon.BulletGuns import Dodge.Item.Weapon.BulletGuns
import Dodge.Item.Weapon.Drone import Dodge.Item.Weapon.Drone
import Dodge.Item.Weapon.TriggerType import Dodge.Item.Weapon.TriggerType
import Dodge.Item.Weapon.SonicGuns
import Dodge.Item.Weapon.Shatter import Dodge.Item.Weapon.Shatter
import Dodge.Item.Weapon.ExtraEffect import Dodge.Item.Weapon.ExtraEffect
import Dodge.Item.Weapon.Remote import Dodge.Item.Weapon.Remote
+132 -132
View File
@@ -1,133 +1,133 @@
module Dodge.Item.Weapon.SonicGuns where module Dodge.Item.Weapon.SonicGuns where
import Dodge.Data --import Dodge.Data
import Dodge.Reloading.Action --import Dodge.Reloading.Action
import Dodge.Creature.HandPos --import Dodge.Creature.HandPos
import Dodge.Default.Weapon --import Dodge.Default.Weapon
--import Dodge.Item.Attachment ----import Dodge.Item.Attachment
--import Dodge.WorldEvent.HelperParticle ----import Dodge.WorldEvent.HelperParticle
--import Dodge.Base ----import Dodge.Base
--import Dodge.Zone ----import Dodge.Zone
import Geometry --import Geometry
import Picture --import Picture
import LensHelp --import LensHelp
--
--import Data.Maybe ----import Data.Maybe
--import Data.List ----import Data.List
--import Data.Bifunctor ----import Data.Bifunctor
--import System.Random ----import System.Random
--import Data.Tuple ----import Data.Tuple
--import qualified IntMapHelp as IM ----import qualified IntMapHelp as IM
--
sonicGun :: Item ----sonicGun :: Item
sonicGun = defaultAutoGun ----sonicGun = defaultAutoGun
{ _itConsumption = defaultLoadable ---- { _itConsumption = defaultLoadable
& laMax .~ 10 ---- & laMax .~ 10
& laCycle .~ [loadEject 10, loadInsert 10 , loadPrime 60] ---- & laCycle .~ [loadEject 10, loadInsert 10 , loadPrime 60]
, _itParams = NoParams ---- , _itParams = NoParams
, _itTweaks = NoTweaks ---- , _itTweaks = NoTweaks
} ---- }
& itDimension . dimRad .~ 10 ---- & itDimension . dimRad .~ 10
& itDimension . dimCenter .~ V3 15 0 0 ---- & itDimension . dimCenter .~ V3 15 0 0
& itUse . useDelay . rateMax .~ 8 ---- & itUse . useDelay . rateMax .~ 8
& itUse . rUse .~ HeldSonicWave --aSonicWave ---- & itUse . rUse .~ HeldSonicWave --aSonicWave
& itUse . useMods .~ AmmoHammerTimeUseOneMod ---- & itUse . useMods .~ AmmoHammerTimeUseOneMod
& itUse . useAim . aimWeight .~ 6 ---- & itUse . useAim . aimWeight .~ 6
& itUse . useAim . aimRange .~ 1 ---- & itUse . useAim . aimRange .~ 1
& itUse . useAim . aimStance .~ TwoHandTwist ---- & itUse . useAim . aimStance .~ TwoHandTwist
& itUse . useAim . aimMuzPos .~ 25 ---- & itUse . useAim . aimMuzPos .~ 25
& itType . iyBase .~ HELD SONICGUN ---- & itType . iyBase .~ HELD SONICGUN
--
aSonicWave :: Item -> Creature -> World -> World ----aSonicWave :: Item -> Creature -> World -> World
aSonicWave it cr = instantParticles .:~ sonicWave pos dir cpos ----aSonicWave it cr = instantParticles .:~ sonicWave pos dir cpos
where ---- where
pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir ---- pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
cpos = _crPos cr ---- cpos = _crPos cr
dir = _crDir cr ---- dir = _crDir cr
--
sonicWave :: Point2 -> Float -> Point2 -> Particle ----sonicWave :: Point2 -> Float -> Point2 -> Particle
sonicWave pos dir cpos = ShockLine ----sonicWave pos dir cpos = ShockLine
{ _ptUpdate = mvSonicWave ---- { _ptUpdate = mvSonicWave
, _ptPointDirs = [[makePointDir $ pos +.+ clockOrth,makePointDir $ pos -.- clockOrth]] ---- , _ptPointDirs = [[makePointDir $ pos +.+ clockOrth,makePointDir $ pos -.- clockOrth]]
, _ptTimer = 1000 ---- , _ptTimer = 1000
, _ptColor = white ---- , _ptColor = white
, _ptCenter = cpos ---- , _ptCenter = cpos
} ---- }
where ---- where
clockOrth = 10 *.* unitVectorAtAngle (dir + pi*0.5) ---- clockOrth = 10 *.* unitVectorAtAngle (dir + pi*0.5)
makePointDir p = (p, argV $ p -.- cpos) ---- makePointDir p = (p, argV $ p -.- cpos)
--
drawSonicWave :: Particle -> Picture ----drawSonicWave :: Particle -> Picture
drawSonicWave pt = foldMap (color (_ptColor pt) . setLayer BloomNoZWrite . setDepth 20 ----drawSonicWave pt = foldMap (color (_ptColor pt) . setLayer BloomNoZWrite . setDepth 20
. lineThick 20 ---- . lineThick 20
. map fst) ---- . map fst)
$ _ptPointDirs pt ---- $ _ptPointDirs pt
----
mvSonicWave :: World -> Particle -> (World, Maybe Particle) ----mvSonicWave :: World -> Particle -> (World, Maybe Particle)
mvSonicWave w pt ----mvSonicWave w pt
| _ptTimer pt <= 0 = (w,Nothing) ---- | _ptTimer pt <= 0 = (w,Nothing)
| otherwise = (w, Just $ pt & ptTimer -~ 1) ---- | otherwise = (w, Just $ pt & ptTimer -~ 1)
-- | otherwise = (w, Just pt') ------ | otherwise = (w, Just pt')
-- where ------ where
-- mvPointDir (p,a) = case wallsHit p ep w of ------ mvPointDir (p,a) = case wallsHit p ep w of
-- [] -> Just ((ep, a), (True,True)) ------ [] -> Just ((ep, a), (True,True))
-- (hp,wl):_ -> reflectShockLine wl p hp ep ------ (hp,wl):_ -> reflectShockLine wl p hp ep
-- where ------ where
-- ep = p +.+ 5 *.* unitVectorAtAngle a ------ ep = p +.+ 5 *.* unitVectorAtAngle a
-- dividePointDir (x:y:xs) = f x y ++ dividePointDir (y:xs) ------ dividePointDir (x:y:xs) = f x y ++ dividePointDir (y:xs)
-- dividePointDir xs = xs ------ dividePointDir xs = xs
-- f (p,a) (q,b) ------ f (p,a) (q,b)
-- | dist p q > 10 = [(p,a),(0.5 *.* (p +.+ q),mixAngles 0.5 a b)] ------ | dist p q > 10 = [(p,a),(0.5 *.* (p +.+ q),mixAngles 0.5 a b)]
-- | otherwise = [(p,a)] ------ | otherwise = [(p,a)]
-- combineClose ((p,a):(q,b):pairs) ------ combineClose ((p,a):(q,b):pairs)
-- | dist p q < 5 = combineClose (( 0.5 *.* (p+.+q), mixa) : pairs) ------ | dist p q < 5 = combineClose (( 0.5 *.* (p+.+q), mixa) : pairs)
-- | otherwise = (p,a) : combineClose ((q,b):pairs) ------ | otherwise = (p,a) : combineClose ((q,b):pairs)
-- where ------ where
-- mixa = mixAngles 0.5 a b ------ mixa = mixAngles 0.5 a b
-- combineClose pairs = pairs ------ combineClose pairs = pairs
-- pt' = pt & ptTimer -~ 10 ------ pt' = pt & ptTimer -~ 10
-- -- & ptPointDirs %~ (map dividePointDir . filter (not . null) . dosplit . map mvPointDir) ------ -- & ptPointDirs %~ (map dividePointDir . filter (not . null) . dosplit . map mvPointDir)
-- & ptPointDirs %~ (map (dividePointDir . combineClose) . filter (not . null) ------ & ptPointDirs %~ (map (dividePointDir . combineClose) . filter (not . null)
-- . concatMap (dosplit . map mvPointDir)) ------ . concatMap (dosplit . map mvPointDir))
-- -- & ptPointDirs %~ (filter (not . null) . concatMap (dosplit . map mvPointDir)) ------ -- & ptPointDirs %~ (filter (not . null) . concatMap (dosplit . map mvPointDir))
-- dosplit :: [Maybe ((Point2,Float),(Bool,Bool))] -> [[(Point2,Float)]] ------ dosplit :: [Maybe ((Point2,Float),(Bool,Bool))] -> [[(Point2,Float)]]
-- dosplit (x:xs) = case x of ------ dosplit (x:xs) = case x of
-- Nothing -> [] : dosplit xs ------ Nothing -> [] : dosplit xs
-- Just (pair,(True,True)) -> overHead (pair:) $ dosplit xs ------ Just (pair,(True,True)) -> overHead (pair:) $ dosplit xs
-- Just (pair,(False,True)) -> [] : overHead (pair:) (dosplit xs) ------ Just (pair,(False,True)) -> [] : overHead (pair:) (dosplit xs)
-- Just (pair,(True,False)) -> [pair] : dosplit xs ------ Just (pair,(True,False)) -> [pair] : dosplit xs
-- Just (_,(False,False)) -> [] : dosplit xs ------ Just (_,(False,False)) -> [] : dosplit xs
-- dosplit [] = [[]] ------ dosplit [] = [[]]
--
overHead :: (a -> a) -> [a] -> [a] ----overHead :: (a -> a) -> [a] -> [a]
overHead f (x:xs) = f x: xs ----overHead f (x:xs) = f x: xs
overHead _ [] = [] ----overHead _ [] = []
----
----
reflectShockLine :: Wall -> Point2 -> Point2 -> Point2 -> Maybe ((Point2,Float),(Bool,Bool)) ----reflectShockLine :: Wall -> Point2 -> Point2 -> Point2 -> Maybe ((Point2,Float),(Bool,Bool))
reflectShockLine wl sp hitp ep ----reflectShockLine wl sp hitp ep
| angleVV wlV v < pi/3 = Just (pair, (False,True)) ---- | angleVV wlV v < pi/3 = Just (pair, (False,True))
| angleVV wlV v < 2 *pi/3 = Nothing ---- | angleVV wlV v < 2 *pi/3 = Nothing
| otherwise = Just (pair, (True,False)) ---- | otherwise = Just (pair, (True,False))
where ---- where
reflv = reflectIn wlV (ep -.- hitp) ---- reflv = reflectIn wlV (ep -.- hitp)
np = hitp +.+ reflv ---- np = hitp +.+ reflv
pair = (np, argV reflv) ---- pair = (np, argV reflv)
wlV = uncurry (-.-) $ _wlLine wl ---- wlV = uncurry (-.-) $ _wlLine wl
v = hitp -.- sp ---- v = hitp -.- sp
----
reflectShockLine' :: Wall -> Point2 -> Point2 -> Point2 -> Maybe ((Point2,Float),(Bool,Bool)) ----reflectShockLine' :: Wall -> Point2 -> Point2 -> Point2 -> Maybe ((Point2,Float),(Bool,Bool))
reflectShockLine' wl sp hitp ep ----reflectShockLine' wl sp hitp ep
| angleVV wlV v < pi/3 = Just ((np +.+ wlVN,argV wlV), (False,True)) ---- | angleVV wlV v < pi/3 = Just ((np +.+ wlVN,argV wlV), (False,True))
| angleVV wlV v < 2 *pi/3 = Nothing ---- | angleVV wlV v < 2 *pi/3 = Nothing
| otherwise = Just ((np -.- wlVN,argV $ V2 0 0 -.- wlV), (True,False)) ---- | otherwise = Just ((np -.- wlVN,argV $ V2 0 0 -.- wlV), (True,False))
where ---- where
np = hitp +.+ normalizeV (sp -.- hitp) ---- np = hitp +.+ normalizeV (sp -.- hitp)
wlV = uncurry (-.-) $ _wlLine wl ---- wlV = uncurry (-.-) $ _wlLine wl
wlVN = dist hitp ep *.* normalizeV wlV ---- wlVN = dist hitp ep *.* normalizeV wlV
v = hitp -.- sp ---- v = hitp -.- sp
----
dividePoly :: Float -> [Point2] -> [Point2] ----dividePoly :: Float -> [Point2] -> [Point2]
dividePoly x (a:b:bs) = init (divideLine x a b) ++ dividePoly x (b:bs) ----dividePoly x (a:b:bs) = init (divideLine x a b) ++ dividePoly x (b:bs)
dividePoly _ [a] = [a] ----dividePoly _ [a] = [a]
dividePoly _ _ = [] ----dividePoly _ _ = []
--
+8 -8
View File
@@ -2,9 +2,9 @@ module Dodge.Particle.Draw where
import Dodge.Data import Dodge.Data
import Picture import Picture
drawParticle :: Particle -> Picture --drawParticle :: Particle -> Picture
drawParticle pt = case pt of --drawParticle pt = case pt of
ShockLine {} -> drawSonicWave pt -- ShockLine {} -> drawSonicWave pt
-- --
--drawShockwave :: Particle -> Picture --drawShockwave :: Particle -> Picture
--drawShockwave pt = setDepth 20 --drawShockwave pt = setDepth 20
@@ -46,9 +46,9 @@ drawTargetLaser pt = setLayer BloomNoZWrite $ pictures
col = _laColor pt col = _laColor pt
(sp:ps) = _laPoints pt (sp:ps) = _laPoints pt
drawSonicWave :: Particle -> Picture --drawSonicWave :: Particle -> Picture
drawSonicWave pt = foldMap (color (_ptColor pt) . setLayer BloomNoZWrite . setDepth 20 --drawSonicWave pt = foldMap (color (_ptColor pt) . setLayer BloomNoZWrite . setDepth 20
. lineThick 20 -- . lineThick 20
. map fst) -- . map fst)
$ _ptPointDirs pt -- $ _ptPointDirs pt
+1 -2
View File
@@ -19,7 +19,6 @@ import Dodge.Item.Draw.SPic
import Dodge.EnergyBall.Draw import Dodge.EnergyBall.Draw
import Dodge.Creature.Picture.Awareness import Dodge.Creature.Picture.Awareness
import Dodge.Creature.Picture import Dodge.Creature.Picture
import Dodge.Particle.Draw
import Dodge.Flame.Draw import Dodge.Flame.Draw
import Dodge.Bullet.Draw import Dodge.Bullet.Draw
import Dodge.Spark.Draw import Dodge.Spark.Draw
@@ -137,7 +136,7 @@ extraPics cfig w = pictures (_decorations w)
<> concatMapPic drawShockwave (_shockwaves w) <> concatMapPic drawShockwave (_shockwaves w)
<> concatMapPic drawLaser (_lasersToDraw w) <> concatMapPic drawLaser (_lasersToDraw w)
<> concatMapPic drawTeslaArc (_teslaArcs w) <> concatMapPic drawTeslaArc (_teslaArcs w)
<> concatMapPic drawParticle (_particles w) -- <> concatMapPic drawParticle (_particles w)
<> concatMapPic drawRadarSweep (_radarSweeps w) <> concatMapPic drawRadarSweep (_radarSweeps w)
<> concatMapPic drawFlame (_flames w) <> concatMapPic drawFlame (_flames w)
<> concatMapPic drawEnergyBall (_energyBalls w) <> concatMapPic drawEnergyBall (_energyBalls w)
+12 -12
View File
@@ -62,8 +62,8 @@ updateUniverse u = case _menuLayers u of
| i < 1 -> u & over uvWorld doWorldEvents | i < 1 -> u & over uvWorld doWorldEvents
| otherwise -> u & menuLayers %~ ( (WaitScreen s (i-1) :) . tail ) | otherwise -> u & menuLayers %~ ( (WaitScreen s (i-1) :) . tail )
(OptionScreen {_scOptionFlag = GameOverOptions} : _) -> u & uvWorld %~ (OptionScreen {_scOptionFlag = GameOverOptions} : _) -> u & uvWorld %~
( updateParticles ( --updateParticles
. (radarBlips .~ []) (radarBlips .~ [])
-- . updateIMl _props _pjUpdate -- . updateIMl _props _pjUpdate
. updateLightSources . updateLightSources
. updateClouds ) . updateClouds )
@@ -96,7 +96,7 @@ functionalUpdate w = checkEndGame
. over uvWorld updateFlames . over uvWorld updateFlames
. over uvWorld updateShockwaves . over uvWorld updateShockwaves
. over uvWorld updateEnergyBalls . over uvWorld updateEnergyBalls
. over uvWorld updateParticles -- . over uvWorld updateParticles
. over uvWorld updateBullets . over uvWorld updateBullets
. over uvWorld updateRadarBlips . over uvWorld updateRadarBlips
. over uvWorld updateFlares . over uvWorld updateFlares
@@ -285,10 +285,10 @@ updatePosEvents w = w' & posEvents .~ catMaybes newposEvents
{- Apply internal particle updates, delete 'Nothing's. -} {- Apply internal particle updates, delete 'Nothing's. -}
updateParticles :: World -> World --updateParticles :: World -> World
updateParticles w = updateInstantParticles $ set particles (catMaybes ps) w' --updateParticles w = updateInstantParticles $ set particles (catMaybes ps) w'
where -- where
(w',ps) = mapAccumR (\a b -> _ptUpdate b a b) w $ _particles w -- (w',ps) = mapAccumR (\a b -> _ptUpdate b a b) w $ _particles w
updateBeams :: World -> World updateBeams :: World -> World
updateBeams w = w updateBeams w = w
& newBeams .~ WorldBeams [] [] [] [] & newBeams .~ WorldBeams [] [] [] []
@@ -365,11 +365,11 @@ updateInstantBullets w = case _instantBullets w of
ps -> let (w',ps') = mapAccumR updateBullet (w {_instantBullets=[]}) ps ps -> let (w',ps') = mapAccumR updateBullet (w {_instantBullets=[]}) ps
in updateInstantBullets $ w' & bullets .++~ catMaybes ps' in updateInstantBullets $ w' & bullets .++~ catMaybes ps'
updateInstantParticles :: World -> World --updateInstantParticles :: World -> World
updateInstantParticles w = case _instantParticles w of --updateInstantParticles w = case _instantParticles w of
[] -> w -- [] -> w
ps -> let (w',ps') = mapAccumR (\a b -> _ptUpdate b a b) (w {_instantParticles=[]}) ps -- ps -> let (w',ps') = mapAccumR (\a b -> _ptUpdate b a b) (w {_instantParticles=[]}) ps
in updateInstantParticles $ w' & particles .++~ catMaybes ps' -- in updateInstantParticles $ w' & particles .++~ catMaybes ps'
updateMIM :: ASetter' World (IM.IntMap a) -> (a -> a -> Maybe a) -> World -> World updateMIM :: ASetter' World (IM.IntMap a) -> (a -> a -> Maybe a) -> World -> World
updateMIM f up = f %~ IM.mapMaybe (dbArg up) updateMIM f up = f %~ IM.mapMaybe (dbArg up)
-10
View File
@@ -1,10 +0,0 @@
{- Helper functions for particles. -}
module Dodge.WorldEvent.HelperParticle
( ptSimpleTime
) where
import Dodge.Data
{- A simple timer update for particles. -}
ptSimpleTime :: Int -> World -> Particle -> (World, Maybe Particle)
ptSimpleTime 0 w _ = (w, Nothing)
ptSimpleTime n w pt = (w, Just $ pt {_ptUpdate = ptSimpleTime (n-1)})
+7 -7
View File
@@ -3,7 +3,7 @@ module Dodge.WorldEvent.SpawnParticle
( makeGasCloud ( makeGasCloud
, makeStaticBall , makeStaticBall
, concBall , concBall
, randParticleAt -- , randParticleAt
) where ) where
import Dodge.Data import Dodge.Data
import RandomHelp import RandomHelp
@@ -11,12 +11,12 @@ import Picture
import Geometry import Geometry
import LensHelp import LensHelp
randParticleAt :: (Point2 -> State StdGen Particle) -> Point2 -> World -> World --randParticleAt :: (Point2 -> State StdGen Particle) -> Point2 -> World -> World
randParticleAt f p w = w --randParticleAt f p w = w
& instantParticles .:~ thepart -- & instantParticles .:~ thepart
& randGen .~ g -- & randGen .~ g
where -- where
(thepart,g) = runState (f p) (_randGen w) -- (thepart,g) = runState (f p) (_randGen w)
randEnergyBallAt :: (Point2 -> State StdGen EnergyBall) -> Point2 -> World -> World randEnergyBallAt :: (Point2 -> State StdGen EnergyBall) -> Point2 -> World -> World
randEnergyBallAt f p w = w randEnergyBallAt f p w = w
& energyBalls .:~ thepart & energyBalls .:~ thepart