diff --git a/src/Dodge/Beam.hs b/src/Dodge/Beam.hs index 76743c998..ec90eb126 100644 --- a/src/Dodge/Beam.hs +++ b/src/Dodge/Beam.hs @@ -3,19 +3,10 @@ import Dodge.Data import Dodge.Flame import Dodge.Tesla.Arc import Dodge.Item.Location -import Dodge.WorldEvent.Damage -import Dodge.WorldEvent.HelperParticle -import Dodge.Item.Weapon.LaserPath import Geometry import LensHelp import Picture ---import RandomHelp ---import Dodge.Zone ---import Dodge.Base.Collide ---import Shape ---import Data.List (sortOn) ---import MonadHelp import Data.Maybe import qualified IntMapHelp as IM @@ -36,13 +27,13 @@ flameBeamCombine (p,(a,b,_),(x,y,_)) lasBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam)) -> World -> World lasBeamCombine (p,(a,b,_),(x,y,_)) - = instantParticles .:~ lasRayAt yellow 11 1 p (argV (normalizeV (b-.-a)+.+normalizeV (y-.-x))) + = lasers .:~ lasRayAt yellow 11 1 p (argV (normalizeV (b-.-a)+.+normalizeV (y-.-x))) splitBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam)) -> World -> World splitBeamCombine (p,(a,b,_),(x,y,_)) - = (instantParticles .:~ lasRayAt yellow 11 1 p (dir+0.5*pi)) - . (instantParticles .:~ lasRayAt yellow 11 1 p (dir-0.5*pi)) + = (lasers .:~ lasRayAt yellow 11 1 p (dir+0.5*pi)) + . (lasers .:~ lasRayAt yellow 11 1 p (dir-0.5*pi)) where dir = argV (normalizeV (b-.-a)+.+normalizeV (y-.-x)) @@ -58,35 +49,11 @@ teslaBeamCombine (p,(a,b,bm),(x,y,_)) w Nothing -> error "tried to get item use teslaBeamCombine that doesn't exist" Just itm -> itm -lasRayAt :: Color -> Int -> Float -> Point2 -> Float -> Particle -lasRayAt col dam phasev pos dir = LaserParticle - { _ptUpdate = mvLaser phasev pos dir - , _ptRange = 800 - , _ptDamage = dam - , _ptPhaseV = phasev - , _ptColor = col - , _ptPoints = [] +lasRayAt :: Color -> Int -> Float -> Point2 -> Float -> LaserStart +lasRayAt col dam phasev pos dir = LaserStart + { _lpDamage = dam + , _lpPhaseV = phasev + , _lpPos = pos + , _lpDir = dir + , _lpColor = col } -mvLaser :: Float -- ^ Phase velocity, controls deflection through windows - -> Point2 - -> Float - -> World - -> Particle - -> (World, Maybe Particle) -mvLaser phasev sp dir w pt = - ( damThingHitWith (\p1 p2 p3 -> Damage LASERING dam p1 p2 p3 NoDamageEffect) sp xp thHit w - , Just pt {_ptPoints = sp:ps ,_ptUpdate = ptSimpleTime 0 } - ) - where - dam = _ptDamage pt - xp = sp +.+ 800 *.* unitVectorAtAngle dir - (thHit, ps) = reflectLaserAlong phasev sp xp w - -drawLaser :: Particle -> Picture -drawLaser pt = - setLayer BloomNoZWrite $ pictures - [ setDepth 19.5 . color (brightX 10 1 col) $ thickLine 3 ps - ] - where - col = _ptColor pt - ps = _ptPoints pt diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 2356dca43..03af21e5d 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -77,7 +77,9 @@ module Dodge.Data , module Dodge.Data.Projectile , module Dodge.Data.Modification , module Dodge.Data.PressPlate + , module Dodge.Data.Laser ) where +import Dodge.Data.Laser import Dodge.Data.PressPlate import Dodge.Data.Modification import Dodge.Data.Projectile @@ -220,6 +222,8 @@ data World = World , _flares :: [Flare] , _newBeams :: WorldBeams , _beams :: WorldBeams + , _lasers :: [LaserStart] + , _lasersToDraw :: [Laser] , _walls :: IM.IntMap Wall , _wallDamages :: IM.IntMap [Damage] , _doors :: IM.IntMap Door @@ -370,15 +374,7 @@ data WorldBeams = WorldBeams {- Objects without ids. Update themselves, perhaps with side effects. -} data Particle - = LaserParticle - { _ptUpdate :: World -> Particle -> (World, Maybe Particle) - , _ptRange :: Float - , _ptDamage :: Int - , _ptColor :: Color - , _ptPhaseV :: Float - , _ptPoints :: [Point2] - } - | PtTeslaArc + = PtTeslaArc { _ptUpdate :: World -> Particle -> (World, Maybe Particle) , _ptPoints :: [Point2] , _ptTimer :: Int diff --git a/src/Dodge/Data/Laser.hs b/src/Dodge/Data/Laser.hs new file mode 100644 index 000000000..9549c4de8 --- /dev/null +++ b/src/Dodge/Data/Laser.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} +module Dodge.Data.Laser + where +import Color +import Geometry.Data +import Control.Lens +data LaserStart = LaserStart + { _lpDamage :: Int + , _lpPhaseV :: Float + , _lpPos :: Point2 + , _lpDir :: Float + , _lpColor :: Color + } + +data Laser = Laser + { _laColor :: Color + , _laPoints :: [Point2] + } +makeLenses ''Laser +makeLenses ''LaserStart diff --git a/src/Dodge/Data/PressPlate.hs b/src/Dodge/Data/PressPlate.hs index ae5e757c7..0d5670dc0 100644 --- a/src/Dodge/Data/PressPlate.hs +++ b/src/Dodge/Data/PressPlate.hs @@ -16,4 +16,5 @@ data PressPlate = PressPlate , _ppID :: Int , _ppText :: String } + deriving (Eq,Ord,Show,Read) makeLenses ''PressPlate diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 0a4aefb5c..31deb7d04 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -43,9 +43,11 @@ defaultWorld = World , _energyBalls = [] , _radarBlips = [] , _flares = [] - , _newBeams = WorldBeams [] [] [] [] - , _beams = WorldBeams [] [] [] [] - , _walls = IM.empty + , _newBeams = WorldBeams [] [] [] [] + , _beams = WorldBeams [] [] [] [] + , _lasers = [] + , _lasersToDraw = [] + , _walls = IM.empty , _wallDamages = IM.empty , _blocks = IM.empty , _machines = IM.empty diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index 8997e5b4e..6a01b3bfd 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -290,7 +290,7 @@ shootTeslaArc it cr w = w' dir = _crDir cr shootLaser :: Item -> Creature -> World -> World -shootLaser it cr = instantParticles .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir +shootLaser it cr = lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir where pos = _crPos cr dir = _crDir cr @@ -301,7 +301,7 @@ shootLaser it cr = instantParticles .:~ lasRayAt (_lasColor $ _itParams it) dam circleLaser :: Item -> Creature -> World -> World circleLaser it cr w | hasLOSIndirect cpos pos w = w - & instantParticles .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir + & lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir | otherwise = w where cpos = _crPos cr diff --git a/src/Dodge/Laser/Draw.hs b/src/Dodge/Laser/Draw.hs new file mode 100644 index 000000000..cb405a4a5 --- /dev/null +++ b/src/Dodge/Laser/Draw.hs @@ -0,0 +1,26 @@ +module Dodge.Laser.Draw + where +import Dodge.Data.Laser +import Picture + +--drawLaser :: Particle -> Picture +----drawLaser pt = setLayer BloomNoZWrite $ pictures +-- --[ setDepth 19 . color (brightX 0 0.5 col) $ thickLine 20 ps +--drawLaser pt = +-- setLayer BloomNoZWrite $ pictures +---- [ setDepth 19 . color (brightX 1 0.5 col) $ thickLine 20 ps +-- [ setDepth 19.5 . color (brightX 10 1 col) $ thickLine 3 ps +-- ] +-- where +-- col = _ptColor pt +-- ps = _ptPoints pt + + +drawLaser :: Laser -> Picture +drawLaser pt = + setLayer BloomNoZWrite $ pictures + [ setDepth 19.5 . color (brightX 10 1 col) $ thickLine 3 ps + ] + where + col = _laColor pt + ps = _laPoints pt diff --git a/src/Dodge/Laser/Update.hs b/src/Dodge/Laser/Update.hs new file mode 100644 index 000000000..679df5e2b --- /dev/null +++ b/src/Dodge/Laser/Update.hs @@ -0,0 +1,20 @@ +module Dodge.Laser.Update + where +import Dodge.Item.Weapon.LaserPath +import Dodge.WorldEvent.Damage +import Dodge.Data +import Geometry + +updateLaser :: World -> LaserStart -> (World, Laser) +updateLaser w pt = + ( damThingHitWith (\p1 p2 p3 -> Damage LASERING dam p1 p2 p3 NoDamageEffect) sp xp thHit w + , Laser {_laPoints = sp:ps , _laColor = _lpColor pt} + ) + where + phasev = _lpPhaseV pt + sp = _lpPos pt + dir = _lpDir pt + dam = _lpDamage pt + xp = sp +.+ 800 *.* unitVectorAtAngle dir + (thHit, ps) = reflectLaserAlong phasev sp xp w + diff --git a/src/Dodge/Particle/Draw.hs b/src/Dodge/Particle/Draw.hs index 229e088fc..35d0983ac 100644 --- a/src/Dodge/Particle/Draw.hs +++ b/src/Dodge/Particle/Draw.hs @@ -9,7 +9,6 @@ drawParticle pt = case pt of PtInvShockwave {} -> drawInverseShockwave pt PtTeslaArc {} -> drawTeslaArc pt PtTargetLaser {} -> drawTargetLaser pt - LaserParticle {} -> drawLaser pt ShockLine {} -> drawSonicWave pt drawShockwave :: Particle -> Picture @@ -52,18 +51,6 @@ drawTargetLaser pt = setLayer BloomNoZWrite $ pictures col = _ptColor pt (sp:ps) = _ptPoints pt -drawLaser :: Particle -> Picture ---drawLaser pt = setLayer BloomNoZWrite $ pictures - --[ setDepth 19 . color (brightX 0 0.5 col) $ thickLine 20 ps -drawLaser pt = - setLayer BloomNoZWrite $ pictures --- [ setDepth 19 . color (brightX 1 0.5 col) $ thickLine 20 ps - [ setDepth 19.5 . color (brightX 10 1 col) $ thickLine 3 ps - ] - where - col = _ptColor pt - ps = _ptPoints pt - drawSonicWave :: Particle -> Picture drawSonicWave pt = foldMap (color (_ptColor pt) . setLayer BloomNoZWrite . setDepth 20 . lineThick 20 diff --git a/src/Dodge/PressPlate.hs b/src/Dodge/PressPlate.hs index 2fe6264bf..859a8a18f 100644 --- a/src/Dodge/PressPlate.hs +++ b/src/Dodge/PressPlate.hs @@ -10,6 +10,7 @@ doPressPlateEvent ppe = case ppe of PressPlateId -> const id PPLevelReset -> ppLevelReset +ppLevelReset :: PressPlate -> World -> World ppLevelReset pp w | dist (_crPos $ you w) (_ppPos pp) < 20 = makeExplosionAt (_ppPos pp) w | otherwise = w diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 0387cd40f..1c30200f2 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -1,6 +1,7 @@ module Dodge.Render.ShapePicture ( worldSPic ) where +import Dodge.Laser.Draw import Dodge.Cloud.Draw import Dodge.Zoning import Dodge.Button.Draw @@ -126,6 +127,7 @@ cullPoint cfig w p extraPics :: Configuration -> World -> Picture extraPics cfig w = pictures (_decorations w) + <> concatMapPic drawLaser (_lasersToDraw w) <> concatMapPic drawParticle (_particles w) <> concatMapPic drawRadarSweep (_radarSweeps w) <> concatMapPic drawFlame (_flames w) diff --git a/src/Dodge/Room/Teleport.hs b/src/Dodge/Room/Teleport.hs index 3e39c9cb8..b273af1f4 100644 --- a/src/Dodge/Room/Teleport.hs +++ b/src/Dodge/Room/Teleport.hs @@ -2,14 +2,12 @@ module Dodge.Room.Teleport where import Dodge.Data -import Dodge.Base import Dodge.LevelGen.Data import Dodge.Room.Procedural import Dodge.Placement.Instance --import Dodge.LevelGen.Data import Geometry import Picture -import Dodge.WorldEvent.Explosion import Control.Lens import Control.Monad.State diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index a6d1bc522..80e3c6145 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -4,6 +4,7 @@ Module : Dodge.Update Description : Simulation update -} module Dodge.Update ( updateUniverse ) where +import Dodge.Laser.Update import Dodge.PressPlate import Dodge.ModificationEffect import Dodge.CrGroupUpdate @@ -94,6 +95,7 @@ functionalUpdate w = checkEndGame . over uvWorld updateRadarBlips . over uvWorld updateFlares . over uvWorld updateBeams + . over uvWorld updateLasers . over uvWorld (updateIMl _props _pjUpdate ) . over uvWorld (updateIMl' _projectiles updateProjectile) . over uvWorld updateLightSources @@ -118,6 +120,13 @@ functionalUpdate w = checkEndGame doWorldEvents :: World -> World doWorldEvents w = foldr doWorldEffect (w & worldEvents .~ []) (_worldEvents w) +updateLasers :: World -> World +updateLasers w = w' + & lasers .~ [] + & lasersToDraw .~ ls + where + (w',ls) = mapAccumR updateLaser w (_lasers w) + zoneClouds :: World -> World zoneClouds w = w & clZoning .~ mempty