diff --git a/src/Dodge/Wall/Damage.hs b/src/Dodge/Wall/Damage.hs index 751465836..f6defc5ff 100644 --- a/src/Dodge/Wall/Damage.hs +++ b/src/Dodge/Wall/Damage.hs @@ -11,11 +11,11 @@ import Dodge.Wall.Dust import Dodge.Particle.Spark import Geometry import Color +import LensHelp -import Control.Lens damageWall :: DamageType -> Wall -> World -> World damageWall dt wl = case _wlStructure wl of - MachinePart mcid -> machines . ix mcid . mcDamage %~ (dt :) + MachinePart mcid -> wallEff dt wl . (machines . ix mcid . mcDamage .:~ dt) BlockPart blid -> wallEff dt wl . (blocks . ix blid %~ damageBlockWith dt) CreaturePart crid f -> f dt wl crid _ -> wallEff dt wl diff --git a/src/Dodge/Wall/Dust.hs b/src/Dodge/Wall/Dust.hs index bdca915f1..e719eb8c8 100644 --- a/src/Dodge/Wall/Dust.hs +++ b/src/Dodge/Wall/Dust.hs @@ -5,7 +5,7 @@ import Geometry import Control.Lens wlDustAt :: Wall -> Point2 -> World -> World -wlDustAt wl p = smokeCloudAt dustcol 20 200 1 (addZ 20 p) +wlDustAt wl = smokeCloudAt dustcol 20 200 1 . addZ 20 where dustcol = _wlColor wl & _4 .~ 1 diff --git a/src/Dodge/Wall/Zone.hs b/src/Dodge/Wall/Zone.hs index 408acf5c8..a292f3a31 100644 --- a/src/Dodge/Wall/Zone.hs +++ b/src/Dodge/Wall/Zone.hs @@ -10,7 +10,7 @@ import Data.Foldable zoneOfWall :: Wall -> [(Int,Int)] zoneOfWall wl - | uncurry dist wlline <= 2*zoneSize = [zoneOfPoint $ uncurry pHalf wlline ] + | uncurry dist wlline <= 2*zoneSize = [zoneOfPoint $ uncurry pHalf wlline ] | otherwise = map zoneOfPoint $ uncurry (divideLine zoneSize) wlline where wlline = _wlLine wl diff --git a/src/Dodge/WorldEvent/Cloud.hs b/src/Dodge/WorldEvent/Cloud.hs index 87ff179bd..25e0fb9c3 100644 --- a/src/Dodge/WorldEvent/Cloud.hs +++ b/src/Dodge/WorldEvent/Cloud.hs @@ -11,8 +11,9 @@ import Dodge.Data import Dodge.Base import Geometry.Data import Picture +import LensHelp -import Control.Lens +--import Control.Lens import System.Random makeCloudAt @@ -23,18 +24,16 @@ makeCloudAt -> Point3 -- start position -> World -> World -makeCloudAt drawFunc rad t alt p = clouds %~ (theCloud :) - where - theCloud = Cloud - { _clPos = p - , _clVel = V3 0 0 0 - , _clPict = drawFunc - , _clRad = rad - , _clAlt = alt - , _clTimer = t - , _clType = SmokeCloud - , _clEffect = const id - } +makeCloudAt drawFunc rad t alt p = clouds .:~ Cloud + { _clPos = p + , _clVel = V3 0 0 0 + , _clPict = drawFunc + , _clRad = rad + , _clAlt = alt + , _clTimer = t + , _clType = SmokeCloud + , _clEffect = const id + } smokeCloudAt :: Color diff --git a/src/Dodge/WorldEvent/Explosion.hs b/src/Dodge/WorldEvent/Explosion.hs index f8814028c..032c1ed8c 100644 --- a/src/Dodge/WorldEvent/Explosion.hs +++ b/src/Dodge/WorldEvent/Explosion.hs @@ -34,9 +34,8 @@ makePoisonExplosionAt -> World makePoisonExplosionAt p w = soundMultiFrom [Explosion 0,Explosion 1] p bangS Nothing - $ foldr (makeGasCloud p) w vels - where - vels = replicateM 25 (randInCirc 2) & evalState $ _randGen w + $ foldr (makeGasCloud p) w + $ replicateM 25 (randInCirc 2) & evalState $ _randGen w -- just change the number after replicateM to get more or less clouds -- suggested change: use random positions, offset from p, rather than velocities -- so, p +.+ randomOffset @@ -93,4 +92,3 @@ makeExplosionAt p w newFs = zipWith5 mF fPs zs (fmap (3 *.*) fVs') sizes times addFlames w' = foldr ($) w' newFs pushAgainstWalls q = maybe q (uncurry (+.+)) $ reflectPointWalls p q $ wallsNearPoint q w - diff --git a/src/Dodge/WorldEvent/HelperParticle.hs b/src/Dodge/WorldEvent/HelperParticle.hs index ab99623bd..e922a59ae 100644 --- a/src/Dodge/WorldEvent/HelperParticle.hs +++ b/src/Dodge/WorldEvent/HelperParticle.hs @@ -1,8 +1,7 @@ {- Helper functions for particles. -} module Dodge.WorldEvent.HelperParticle ( ptSimpleTime - ) - where + ) where import Dodge.Data {- A simple timer update for particles. -} diff --git a/src/Dodge/WorldEvent/HitEffect.hs b/src/Dodge/WorldEvent/HitEffect.hs index df721cae7..020365773 100644 --- a/src/Dodge/WorldEvent/HitEffect.hs +++ b/src/Dodge/WorldEvent/HitEffect.hs @@ -43,7 +43,7 @@ killBulletUpdate :: World -> Particle -> (World,Maybe Particle) killBulletUpdate w pt | _ptTimer pt <= 0 = (w,Nothing) | otherwise = (w - ,Just $ pt & ptTimer -~ 1 + , Just $ pt & ptTimer -~ 1 & ptTrail %~ (\(x:xs) -> x:x:xs) ) @@ -55,11 +55,11 @@ penWalls -> World -> (World, Maybe Particle) penWalls crEff wlEff pt hitThings w = case hitThings of - [] -> ( w, mvPt pt) - ((p,Left cr):_) -> (crEff pt p cr w, destroyAt p pt) - ((p,Right wl):hs) | _wlFireThrough wl - -> first (wlEff pt p wl) $ penWalls crEff wlEff pt hs w - ((p,Right wl):_) -> (wlEff pt p wl w, destroyAt p pt) + [] -> ( w, mvPt pt) + ((p,Left cr):_) -> (crEff pt p cr w, destroyAt p pt) + ((p,Right wl):hs) | _wlFireThrough wl + -> first (wlEff pt p wl) $ penWalls crEff wlEff pt hs w + ((p,Right wl):_) -> (wlEff pt p wl w, destroyAt p pt) doFlameDam :: Int -> Particle -> Point2 -> Creature -> World -> World doFlameDam amount pt p cr = creatures . ix (_crID cr) . crState . crDamage .:~