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