From 7ef1da9be509512a9b76f80e20d63ce6d5efcd18 Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 1 Nov 2021 23:07:58 +0000 Subject: [PATCH] Work on sensor machines, remove some datatypes associated with placements --- src/Dodge/Item/Weapon/BatteryGuns.hs | 12 +- src/Dodge/LevelGen.hs | 7 +- src/Dodge/LevelGen/AutoDoor.hs | 26 ----- src/Dodge/LevelGen/Data.hs | 3 +- src/Dodge/LevelGen/TriggerDoor.hs | 15 +-- src/Dodge/Machine/Sensor.hs | 35 +++--- src/Dodge/Particle/Bullet/HitEffect.hs | 1 + src/Dodge/Particle/Spark.hs | 41 +++++++ src/Dodge/Particle/TeslaArc.hs | 132 ++++++++++++++++++++++ src/Dodge/Placements.hs | 23 ++++ src/Dodge/Room/Airlock.hs | 10 +- src/Dodge/Room/Door.hs | 7 +- src/Dodge/Wall/Damage.hs | 2 +- src/Dodge/WorldEvent/Damage.hs | 22 ++++ src/Dodge/WorldEvent/SpawnParticle.hs | 146 +------------------------ src/Dodge/WorldEvent/ThingsHit.hs | 3 + 16 files changed, 265 insertions(+), 220 deletions(-) delete mode 100644 src/Dodge/LevelGen/AutoDoor.hs create mode 100644 src/Dodge/Particle/Spark.hs create mode 100644 src/Dodge/Particle/TeslaArc.hs create mode 100644 src/Dodge/Placements.hs create mode 100644 src/Dodge/WorldEvent/Damage.hs diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index 9687dba9d..38522cbf6 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -5,11 +5,11 @@ module Dodge.Item.Weapon.BatteryGuns ) where import Dodge.Data +import Dodge.Particle.TeslaArc import Dodge.SoundLogic.LoadSound -import Dodge.Creature.State.Data import Dodge.Data.DamageType import Dodge.WorldEvent -import Dodge.Wall.Damage +import Dodge.WorldEvent.Damage import Dodge.Default import Dodge.Item.Draw import Dodge.Item.Data @@ -173,7 +173,7 @@ makeLaserAt phaseV pos dir = Particle { _ptDraw = const blank , _ptUpdate = moveLaser phaseV pos dir } -moveLaser +moveLaser :: Float -- ^ Phase velocity, controls deflection through windows -> Point2 -> Float @@ -221,11 +221,7 @@ moveLaser phaseV pos dir w pt h' ws (_,Right wl) = not $ any (\w' -> _wlID w' == _wlID wl) ws h' _ _ = True (thHit, ps) = f [] pos xp - hitEffect = case thHit of - Just (p,Left cr) - -> creatures . ix (_crID cr) . crState . crDamage %~ (Lasering 19 pos p xp :) - Just (p,Right wl) -> damageWall (Lasering 19 pos p xp) wl - _ -> id + hitEffect = damThingHitWith (Lasering 19) pos xp thHit pic = setLayer 1 $ pictures [ setDepth 19 . color (brightX 0 0.5 yellow) $ lineOfThickness 20 (pos:ps) , setDepth 19.5 . color (brightX 10 1 yellow) $ lineOfThickness 3 (pos:ps) diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index bac38862f..95c6ee553 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -12,7 +12,6 @@ import Dodge.Data import Dodge.LevelGen.Block import Dodge.LevelGen.Pathing import Dodge.LevelGen.StaticWalls -import Dodge.LevelGen.AutoDoor import Dodge.LevelGen.TriggerDoor import Dodge.LevelGen.Switch import Dodge.LevelGen.Data @@ -59,10 +58,8 @@ placeSpotID ps w = case _psType ps of where mapBoth fn (x,y) = (fn x, fn y) PutSingleDoor col f a b speed - -> putSingleDoor False col f (doShift a) (doShift b) speed w - PutDoubleDoor col f a b speed - -> (,) 0 $ insertDoubleDoor False col f (doShift a) (doShift b) speed w - PutAutoDoor a b -> (,) 0 $ addAutoDoor (doShift a) (doShift b) w + -> placeSingleDoor False col f (doShift a) (doShift b) speed w + --PutAutoDoor a b -> (,) 0 $ placeAutoDoor (doShift a) (doShift b) w PutBlock (hp:hps) col ps' -> placeBlock (map doShift ps') hp col Opaque hps w PutBlock{} -> error "messed up block placement somehow" PutBtDoor c bp f a b speed -> addButtonDoor c (doShift bp) (f + rot) diff --git a/src/Dodge/LevelGen/AutoDoor.hs b/src/Dodge/LevelGen/AutoDoor.hs deleted file mode 100644 index 308a01d7a..000000000 --- a/src/Dodge/LevelGen/AutoDoor.hs +++ /dev/null @@ -1,26 +0,0 @@ ---{-# LANGUAGE BangPatterns #-} -{- | -Creation of doors that open when creatures approach them. - -} -module Dodge.LevelGen.AutoDoor - where -import Dodge.Data -import Dodge.Base -import Dodge.Creature.Property ---import Dodge.LevelGen.MoveDoor -import Dodge.LevelGen.TriggerDoor ---import Geometry -import Picture -import Geometry.Data ---import qualified DoubleStack as DS -import qualified IntMapHelp as IM - - -addAutoDoor - :: Point2 -- ^ Left point - -> Point2 -- ^ Right point (though the two points should be symmetric) - -> World - -> World -addAutoDoor a b = insertDoubleDoor True (dim yellow) cond a b 3 - where - cond = any (crNearSeg 40 a b) . IM.filter isAnimate . _creatures diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index 3d3071c19..2b7858c91 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -17,11 +17,10 @@ data PSType = PutCrit {_unPutCrit :: Creature} | PutProp Prop | PutFlIt Item | PutPressPlate PressPlate - | PutAutoDoor Point2 Point2 + -- | PutAutoDoor Point2 Point2 | PutBlock [Int] Color [Point2] | PutLineBlock Wall Float Float Point2 Point2 | PutWall { _pwPoly :: [Point2] , _pwWall :: Wall } - | PutDoubleDoor Color (World -> Bool) Point2 Point2 Float | PutSingleDoor Color (World -> Bool) Point2 Point2 Float | PutDoor Color (World -> Bool) [(Point2,Point2)] | PutBtDoor Color Point2 Float Point2 Point2 Float diff --git a/src/Dodge/LevelGen/TriggerDoor.hs b/src/Dodge/LevelGen/TriggerDoor.hs index 7004bcdb7..98693b4c0 100644 --- a/src/Dodge/LevelGen/TriggerDoor.hs +++ b/src/Dodge/LevelGen/TriggerDoor.hs @@ -1,9 +1,8 @@ --{-# LANGUAGE BangPatterns #-} module Dodge.LevelGen.TriggerDoor ( putDoor - , putSingleDoor + , placeSingleDoor , addButtonDoor - , insertDoubleDoor ) where import Dodge.Data import Dodge.Base @@ -34,7 +33,7 @@ addButtonDoor c btp btr a b speed w $ set pathPoints (foldr insertPoint IM.empty (labNodes newGraph)) $ set pathGraph newGraph $ set pathGraphP newGraphPairs - $ snd (putSingleDoor False c cond a b speed w) + $ snd (placeSingleDoor False c cond a b speed w) where bid = IM.newKey $ _buttons w cond w' = BtNoLabel == _btState (_buttons w' IM.! bid) @@ -123,15 +122,9 @@ doorMechanism drid speed wlidOpCps dr w & walls . ix wlid %~ moveDoorToward speed p & (\w'' -> foldr (changeZonedWall (moveDoorToward speed p) wlid) w'' (zoneps zp)) -insertDoubleDoor :: Bool -> Color -> (World -> Bool) -> Point2 -> Point2 -> Float -> World - -> World -insertDoubleDoor isPathable col cond a b speed - = snd . putSingleDoor isPathable col cond a (0.5 *.* (a +.+ b)) speed - . snd . putSingleDoor isPathable col cond b (0.5 *.* (a +.+ b)) speed - -putSingleDoor :: Bool -> Color -> (World -> Bool) -> Point2 -> Point2 -> Float -> World +placeSingleDoor :: Bool -> Color -> (World -> Bool) -> Point2 -> Point2 -> Float -> World -> (Int, World) -putSingleDoor isPathable col cond a b speed w = (drid, addWalls w +placeSingleDoor isPathable col cond a b speed w = (drid, addWalls w & doors %~ addDoor) where drid = IM.newKey $ _doors w diff --git a/src/Dodge/Machine/Sensor.hs b/src/Dodge/Machine/Sensor.hs index 380059c7e..57267751c 100644 --- a/src/Dodge/Machine/Sensor.hs +++ b/src/Dodge/Machine/Sensor.hs @@ -11,12 +11,15 @@ import ShapePicture import Shape import Control.Lens +import Data.Either -lightSensor :: Point2 -> Float -> Placement -lightSensor p r = Placement (PS p r $ PutLS theLS) +damageSensor + :: (DamageType -> Either Int Int) -- Left gets sensed, Right does damage + -> Point2 -> Float -> Placement +damageSensor damF p r = Placement (PS p r $ PutLS theLS) $ \lsid -> jsps p r $ PutMachine blue (reverse $ square wdth) defaultMachine - { _mcDraw = lightSensorSPic - , _mcUpdate = lightSensorUpdate + { _mcDraw = sensorSPic + , _mcUpdate = sensorUpdate damF , _mcLSs = [lsid] } where @@ -25,26 +28,30 @@ lightSensor p r = Placement (PS p r $ PutLS theLS) , _lsIntensity = 0.1 } -lightSensorUpdate :: Machine -> World -> World -lightSensorUpdate mc w = w & machines . ix mcid %~ upmc +lightSensor :: Point2 -> Float -> Placement +lightSensor = damageSensor senseLasering + +senseLasering :: DamageType -> Either Int Int +senseLasering Lasering {_dmAmount = x} = Left x +senseLasering _ = Right 0 + +sensorUpdate :: (DamageType -> Either Int Int) -> Machine -> World -> World +sensorUpdate damF mc w = w & machines . ix mcid %~ upmc & lightSources . ix lsid %~ upls where upmc = ( mcSensor %~ \x' -> min 750 (max 0 (x' - 5 + newSense)) ) + . ( mcHP -~ sum dam ) . (mcDamage .~ []) x = _mcSensor mc mcid = _mcID mc lsid = head (_mcLSs mc) - newSense = sum . map _dmAmount $ filter isLasering $ _mcDamage mc + (senseData,dam) = partitionEithers $ map damF $ _mcDamage mc + newSense = sum senseData ni = fromIntegral x / 500 upls = lsIntensity .~ V3 ni ni ni -isLasering Lasering {} = True -isLasering _ = False -isElectrical Electrical {} = True -isElectrical _ = False - -lightSensorSPic :: Machine -> SPic -lightSensorSPic mc = ( colorSH blue $ upperPrismPoly 25 (square wdth) +sensorSPic :: Machine -> SPic +sensorSPic _ = ( colorSH blue $ upperPrismPoly 25 (square wdth) , mempty ) wdth :: Float diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs index a9f9792c1..c66d56d03 100644 --- a/src/Dodge/Particle/Bullet/HitEffect.hs +++ b/src/Dodge/Particle/Bullet/HitEffect.hs @@ -4,6 +4,7 @@ Effects of bullets upon impact with walls or creatures. module Dodge.Particle.Bullet.HitEffect where import Dodge.Data +import Dodge.Particle.Spark import Dodge.Data.DamageType import Dodge.Data.SoundOrigin import Dodge.Wall.Damage diff --git a/src/Dodge/Particle/Spark.hs b/src/Dodge/Particle/Spark.hs new file mode 100644 index 000000000..a41c935bc --- /dev/null +++ b/src/Dodge/Particle/Spark.hs @@ -0,0 +1,41 @@ +module Dodge.Particle.Spark + ( colSpark + , colSpark' + ) + where +import Dodge.Data +import Dodge.Data.DamageType +import Dodge.Particle.Bullet.Draw +import Dodge.Particle.Bullet.Update +import Dodge.WorldEvent.HitEffect +import Dodge.Creature.State.Data +import Color +import Geometry + +import System.Random +import Control.Lens + +colSpark :: Int -> Color -> Point2 -> Float -> World -> World +colSpark = colSpark' 0.7 +colSpark' :: Float -> Int -> Color -> Point2 -> Float -> World -> World +colSpark' randDir time col pos baseDir w = w + & worldEvents %~ ( over particles (spark :) . ) + & randGen .~ g + where + (a,g) = randomR (-randDir,randDir) $ _randGen w + dir = a + baseDir + spark = BulletPt + { _ptDraw = drawBul + , _ptUpdate = mvGenBullet + , _btVel' = rotateV dir (V2 5 0) + , _btColor' = col + , _btTrail' = [pos] + , _btPassThrough' = Nothing + , _btWidth' = 1 + , _btTimer' = time + , _btHitEffect' = destroyOnImpact sparkEff noEff + } + sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : ) + where + sp = head (_btTrail' bt) + ep = sp +.+ _btVel' bt diff --git a/src/Dodge/Particle/TeslaArc.hs b/src/Dodge/Particle/TeslaArc.hs new file mode 100644 index 000000000..ad9875870 --- /dev/null +++ b/src/Dodge/Particle/TeslaArc.hs @@ -0,0 +1,132 @@ +module Dodge.Particle.TeslaArc + ( makeTeslaArcAt + ) where +import Dodge.Data +import Dodge.Data.DamageType +import Dodge.Creature.State.Data +import Dodge.WorldEvent.Damage +import Dodge.Base +import Dodge.Zone +import Dodge.Base.Collide +import Dodge.Picture +import Dodge.Particle.Spark +import Dodge.WorldEvent.ThingsHit +import Dodge.RandomHelp +import Picture +import Geometry +import qualified IntMapHelp as IM + +import Control.Lens +import System.Random +import Control.Monad.State +import Data.Function (on) +import Data.List +import Data.Maybe +makeTeslaArcAt :: Color -> Point2 -> Float -> Particle +makeTeslaArcAt col pos dir = LinearParticle + { _ptPoints = [pos] + , _ptDraw = drawTeslaArc + , _ptUpdate = moveTeslaArc pos dir + , _ptTimer = 2 + , _ptColor = brightX 100 1.5 col + } +drawTeslaArc :: Particle -> Picture +drawTeslaArc pt = setLayer 1 $ pictures + [ setDepth 20.5 $ color (brightX 2 1 $ _ptColor pt) $ lineOfThickness 3 ps + , setDepth 20 $ color (V4 0 0 0 0.5) $ lineOfThickness 10 ps + ] + where + ps = _ptPoints pt +-- todo: fix electrical damage location +moveTeslaArc + :: Point2 -- ^ Emmission position + -> Float -- ^ Emmission direction + -> World + -> Particle + -> (World, Maybe Particle) +moveTeslaArc p d w pt + | t == 2 = + (foldr damCrs w hitCrs & randGen .~ g & colSpark 8 nc q2 (argV sv) + & damThingHitWith (Electrical 50) q1 ((2 *.* q2) -.- q1) thHit + , Just $ pt & ptTimer -~ 1 & ptPoints .~ ps' + ) + | t < 1 = (w , Nothing) + | otherwise = (w , Just $ pt & ptTimer -~ 1) + where + t = _ptTimer pt + ps = take 25 $ p : map f (crsLightChain p d 0 w) + f (E3x1 cr) = _crPos cr + f (E3x2 p1) = p1 + f (E3x3 p1) = p1 + ps' = lightningMids d pers ps + pers = evalState (sequence $ repeat $ randInCirc 5) $ _randGen w + nc = brightX 100 1.5 $ numColor colid + (colid,g) = randomR (0::Int,5) $ _randGen w + f1 (E3x1 cr) = Just $ _crID cr + f1 _ = Nothing + hitCrs = mapMaybe f1 $ take 14 $ crsLightChain p d 0 w + damCrs cid = over (creatures . ix cid . crState . crDamage) (Electrical 5 cpos cpos cpos :) + where + cpos = _crPos (_creatures w IM.! cid) + q1 = last $ init ps' + q2 = last ps' + hitWall = reflectPointWalls q1 ((2 *.* q2) -.- q1) $ wallsNearPoint q1 w + thHit = thingHit q1 ((2 *.* q2) -.- q1) w + sv = maybe (q2 -.- q1) snd hitWall +{- Finds a point somewhere roughly inbetween two points. -} +lightningMid :: Float -> Point2 -> Point2 -> Point2 +lightningMid d p1 p2 = (0.25 *.* (p1 +.+ p2)) +.+ 0.5 *.* p3 + where p3 = errorClosestPointOnLine 1 p1 (p1 +.+ unitVectorAtAngle d) p2 +{- Finds extra middle points between successive points in a list of points. -} +lightningMids :: Float -> [Point2] -> [Point2] -> [Point2] +lightningMids d1 (p:pers) (p1:p3:ps) + = let p2 = p +.+ lightningMid d1 p1 p3 + d2 = argV $ p3 -.- p2 + in p1 : p2 : lightningMids d2 pers (p3:ps) +lightningMids _ _ ps = ps +{- Finds a list of hit things from a given point. +'E3x1' objects are creatures, 'E3x2' objects are points on walls, 'E3x3' objects are points in space. -} +crsLightChain :: Point2 -> Float -> Float -> World -> [Either3 Creature Point2 Point2] +crsLightChain p d wlAttract w = case crOrWallSensitive p d wlAttract w of + E3x1 cr -> E3x1 cr : crsLightChain (_crPos cr) (argV (_crPos cr -.- p)) + (min 1 (wlAttract + 0.3)) w + E3x2 p1 -> [E3x2 p1] + E3x3 p1 -> E3x3 p1 : crsLightChain p1 (dChange + argV (p1 -.- p)) (min 1 (wlAttract + 0.3)) (set randGen g w) + where + (dChange, g) = randomR (-0.5,0.5) $ _randGen w +{- +Finds whether a creature or wall is in front of a given point and direction. +Evaluates to a creature as an 'E3x1' or a wall as an 'E3x2'. +Has a parameter to tweak how attracted the test is to walls. + -} +crOrWallSensitive + :: Point2 -- ^ Start point + -> Float -- ^ Direction (radians) + -> Float -- ^ Wall attraction parameter + -> World + -> Either3 Creature Point2 Point2 +crOrWallSensitive p dir wlAttract w = fromMaybe (E3x3 $ p +.+ rotateV dir (V2 arcLen 0)) + . listToMaybe + . sortBy (compare `on` g) + $ catMaybes [cr,wlp] + where + cr = E3x1 <$> nearestCrInFront p dir 100 w + wlp = fmap E3x2 + . listToMaybe + . sortBy (compare `on` dist p) + $ mapMaybe + ( fmap fst + . (\p1 -> reflectPointWalls p p1 $ wallsNearPoint p w) + . (+.+) p + . (\d -> rotateV d (V2 100 0)) + . (+ dir) + . (* wlAttract) + ) + [-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8] + g (E3x2 p1) = 100 + dist p p1 -- tweak makes it more likely to hit crs first + --g (E3x2 p1) = dist p p1 - 100 -- tweak makes it more likely to hit walls first + g (E3x1 cr1) = dist p $ _crPos cr1 + g _ = 0 + (arcLen,_) = randomR (25,50) $ _randGen w +-- BUG: can hit crs through walls + diff --git a/src/Dodge/Placements.hs b/src/Dodge/Placements.hs new file mode 100644 index 000000000..83b215c38 --- /dev/null +++ b/src/Dodge/Placements.hs @@ -0,0 +1,23 @@ +module Dodge.Placements + ( putDoubleDoorThen + , putAutoDoor + ) + where +import Dodge.Data +import Dodge.Base +import Color +import Geometry +import Dodge.LevelGen.Data +import Dodge.Creature.Property + +import qualified Data.IntMap.Strict as IM +putDoubleDoorThen :: Color -> (World -> Bool) -> Point2 -> Point2 -> Float -> Maybe Placement -> Placement +putDoubleDoorThen col cond a b speed mayp = ps0j (PutSingleDoor col cond a half speed) + $ Placement (PS (V2 0 0) 0 (PutSingleDoor col cond b half speed)) $ const mayp + where + half = 0.5 *.* (a +.+ b) + +putAutoDoor :: Point2 -> Point2 -> Placement +putAutoDoor a b = putDoubleDoorThen (dim yellow) cond a b 3 Nothing + where + cond = any (crNearSeg 40 a b) . IM.filter isAnimate . _creatures diff --git a/src/Dodge/Room/Airlock.hs b/src/Dodge/Room/Airlock.hs index d6c4e2396..dfc3b125a 100644 --- a/src/Dodge/Room/Airlock.hs +++ b/src/Dodge/Room/Airlock.hs @@ -7,6 +7,7 @@ import Dodge.Room.Placement import Dodge.Room.Foreground import Dodge.Default.Room import Dodge.Data +import Dodge.Placements import Dodge.LevelGen.Data import Dodge.LevelGen.Switch import Dodge.RandomHelp @@ -18,7 +19,8 @@ import System.Random import Control.Monad.State {- | A passage with a switch that opens forward access while closing backwards access. -} airlock :: RandomGen g => State g Room -airlock = takeOne [airlock0,airlock90,airlockCrystal] +--airlock = takeOne [airlock0,airlock90,airlockCrystal] +airlock = takeOne [airlock0] {- | Straight airlock -} airlock0 :: Room airlock0 = defaultRoom @@ -27,8 +29,10 @@ airlock0 = defaultRoom , _rmPath = [(V2 20 95,V2 20 45) ,(V2 20 45,V2 20 5) ] , _rmPS = [Placement (PS (V2 (-35) 50) (negate $ pi/2) $ PutButton $ makeSwitch col red id id) - $ \btid -> jspsJ (V2 0 20) 0 (PutDoubleDoor col (not . cond' btid) (V2 1 0) (V2 39 0) 2) - $ sPS (V2 0 80) 0 $ PutDoubleDoor col (cond' btid) (V2 1 0) (V2 39 0) 2 + $ \btid -> Just $ putDoubleDoorThen col (not . cond' btid) (V2 (-1) 20) (V2 41 20) 2 + $ Just $ putDoubleDoorThen col (cond' btid) (V2 (-1) 80) (V2 41 80) 2 Nothing + -- $ \btid -> jspsJ (V2 0 0) 0 (PutDoubleDoor col (not . cond' btid) (V2 1 20) (V2 39 20) 2) + -- $ sPS (V2 0 0) 0 $ PutDoubleDoor col (cond' btid) (V2 1 80) (V2 39 80) 2 ,mountedLightI 70 (V2 (-2) 30) (V2 (-2) 70) ,sps0 $ PutForeground $ thinHighBar 75 (V2 40 50) (V2 (-1) 50) ] diff --git a/src/Dodge/Room/Door.hs b/src/Dodge/Room/Door.hs index ce073baac..b7eec9302 100644 --- a/src/Dodge/Room/Door.hs +++ b/src/Dodge/Room/Door.hs @@ -5,11 +5,8 @@ module Dodge.Room.Door where import Geometry import Dodge.Room.Data -import Dodge.LevelGen.Data import Dodge.Default.Room - ---import Control.Monad.State ---import System.Random +import Dodge.Placements door :: Room door = defaultRoom @@ -17,7 +14,7 @@ door = defaultRoom , _rmLinks = lnks , _rmPath = [(V2 20 35,V2 20 5)] -- door extends into side walls (for shadows as rendered 12/03) - , _rmPS = [sPS (V2 0 20) 0 $ PutAutoDoor (V2 0 0) (V2 40 0)] + , _rmPS = [putAutoDoor (V2 0 20) (V2 40 20)] , _rmBound = [] } where lnks = [(V2 20 35,0) diff --git a/src/Dodge/Wall/Damage.hs b/src/Dodge/Wall/Damage.hs index df5658ad6..00d2a9d0c 100644 --- a/src/Dodge/Wall/Damage.hs +++ b/src/Dodge/Wall/Damage.hs @@ -7,9 +7,9 @@ module Dodge.Wall.Damage ) where import Dodge.Data import Dodge.Data.DamageType -import Dodge.WorldEvent.SpawnParticle import Dodge.WorldEvent.Cloud import Dodge.Wall.Reflect +import Dodge.Particle.Spark import Geometry import Geometry.Vector3D import Color diff --git a/src/Dodge/WorldEvent/Damage.hs b/src/Dodge/WorldEvent/Damage.hs new file mode 100644 index 000000000..3fe76e157 --- /dev/null +++ b/src/Dodge/WorldEvent/Damage.hs @@ -0,0 +1,22 @@ +module Dodge.WorldEvent.Damage + ( damThingHitWith + ) where +import Dodge.Data +import Dodge.Data.DamageType +import Dodge.Creature.State.Data +import Geometry +import Dodge.Wall.Damage + +import Control.Lens + +damThingHitWith + :: (Point2 -> Point2 -> Point2 -> DamageType) + -> Point2 + -> Point2 + -> Maybe (Point2, Either Creature Wall) + -> World + -> World +damThingHitWith partDT sp ep mayEiCrWl = case mayEiCrWl of + Just (hitp,Left cr ) -> creatures . ix (_crID cr) . crState . crDamage %~ (partDT sp hitp ep :) + Just (hitp,Right wl) -> damageWall (partDT sp hitp ep) wl + Nothing -> id diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 1d96beda8..8f9a03ea4 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -5,25 +5,17 @@ module Dodge.WorldEvent.SpawnParticle ( makeGasCloud , aFlameParticle , makeFlameletTimed - , makeTeslaArcAt - , colSpark - , colSpark' ) where import Dodge.Data import Dodge.Data.DamageType import Dodge.Data.SoundOrigin import Dodge.Creature.State.Data +--import Dodge.WorldEvent.Damage import Dodge.Base -import Dodge.Zone -import Dodge.Base.Collide -import Dodge.Picture ---import Dodge.Picture.Layer import Dodge.WorldEvent.HitEffect import Dodge.WorldEvent.ThingsHit import Dodge.WorldEvent.Cloud import Dodge.WorldEvent.Flash -import Dodge.Particle.Bullet.Draw -import Dodge.Particle.Bullet.Update import Dodge.SoundLogic import Dodge.SoundLogic.LoadSound import Dodge.RandomHelp @@ -37,9 +29,6 @@ import qualified IntMapHelp as IM import Control.Lens import System.Random import Control.Monad.State -import Data.Function (on) -import Data.List -import Data.Maybe import Data.Tuple aFlameParticle :: Int -- ^ Timer @@ -252,136 +241,3 @@ cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedC damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint (stripZ $ _clPos c) w f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10 doDam cr = cr & crState . crDamage %~ (PoisonDam 1 :) -makeTeslaArcAt :: Color -> Point2 -> Float -> Particle -makeTeslaArcAt col pos dir = LinearParticle - { _ptPoints = [pos] - , _ptDraw = drawTeslaArc - , _ptUpdate = moveTeslaArc pos dir - , _ptTimer = 2 - , _ptColor = brightX 100 1.5 col - } -drawTeslaArc :: Particle -> Picture -drawTeslaArc pt = setLayer 1 $ pictures - [ setDepth 20.5 $ color (brightX 2 1 $ _ptColor pt) $ lineOfThickness 3 ps - , setDepth 20 $ color (V4 0 0 0 0.5) $ lineOfThickness 10 ps - ] - where - ps = _ptPoints pt --- todo: fix electrical damage location -moveTeslaArc - :: Point2 -- ^ Emmission position - -> Float -- ^ Emmission direction - -> World - -> Particle - -> (World, Maybe Particle) -moveTeslaArc p d w pt - | t == 2 = - (foldr damCrs w hitCrs & randGen .~ g - & colSpark 8 nc q2 (argV sv) - , Just $ pt - & ptTimer -~ 1 - & ptPoints .~ ps' - ) - | t < 1 = (w , Nothing) - | otherwise = (w , Just $ pt & ptTimer -~ 1) - where - t = _ptTimer pt - ps = take 25 $ p : map f (crsLightChain p d 0 w) - f (E3x1 cr) = _crPos cr - f (E3x2 p1) = p1 - f (E3x3 p1) = p1 - ps' = lightningMids d pers ps - pers = evalState (sequence $ repeat $ randInCirc 5) $ _randGen w - nc = brightX 100 1.5 $ numColor colid - (colid,g) = randomR (0::Int,5) $ _randGen w - f1 (E3x1 cr) = Just $ _crID cr - f1 _ = Nothing - hitCrs = mapMaybe f1 $ take 14 $ crsLightChain p d 0 w - damCrs cid = over (creatures . ix cid . crState . crDamage) (Electrical 5 cpos cpos cpos :) - where - cpos = _crPos (_creatures w IM.! cid) - q1 = last $ init ps' - q2 = last ps' - hitWall = reflectPointWalls q1 ((2 *.* q2) -.- q1) $ wallsNearPoint q1 w - sv = maybe (q2 -.- q1) snd hitWall -{- Finds a point somewhere roughly inbetween two points. -} -lightningMid :: Float -> Point2 -> Point2 -> Point2 -lightningMid d p1 p2 = (0.25 *.* (p1 +.+ p2)) +.+ 0.5 *.* p3 - where p3 = errorClosestPointOnLine 1 p1 (p1 +.+ unitVectorAtAngle d) p2 -{- Finds extra middle points between successive points in a list of points. -} -lightningMids :: Float -> [Point2] -> [Point2] -> [Point2] -lightningMids d1 (p:pers) (p1:p3:ps) - = let p2 = p +.+ lightningMid d1 p1 p3 - d2 = argV $ p3 -.- p2 - in p1 : p2 : lightningMids d2 pers (p3:ps) -lightningMids _ _ ps = ps -{- Finds a list of hit things from a given point. -'E3x1' objects are creatures, 'E3x2' objects are points on walls, 'E3x3' objects are points in space. -} -crsLightChain :: Point2 -> Float -> Float -> World -> [Either3 Creature Point2 Point2] -crsLightChain p d wlAttract w = case crOrWallSensitive p d wlAttract w of - E3x1 cr -> E3x1 cr : crsLightChain (_crPos cr) (argV (_crPos cr -.- p)) - (min 1 (wlAttract + 0.3)) w - E3x2 p1 -> [E3x2 p1] - E3x3 p1 -> E3x3 p1 : crsLightChain p1 (dChange + argV (p1 -.- p)) (min 1 (wlAttract + 0.3)) (set randGen g w) - where - (dChange, g) = randomR (-0.5,0.5) $ _randGen w -{- -Finds whether a creature or wall is in front of a given point and direction. -Evaluates to a creature as an 'E3x1' or a wall as an 'E3x2'. -Has a parameter to tweak how attracted the test is to walls. - -} -crOrWallSensitive - :: Point2 -- ^ Start point - -> Float -- ^ Direction (radians) - -> Float -- ^ Wall attraction parameter - -> World - -> Either3 Creature Point2 Point2 -crOrWallSensitive p dir wlAttract w = fromMaybe (E3x3 $ p +.+ rotateV dir (V2 arcLen 0)) - . listToMaybe - . sortBy (compare `on` g) - $ catMaybes [cr,wlp] - where - cr = E3x1 <$> nearestCrInFront p dir 100 w - wlp = fmap E3x2 - . listToMaybe - . sortBy (compare `on` dist p) - $ mapMaybe - ( fmap fst - . (\p1 -> reflectPointWalls p p1 $ wallsNearPoint p w) - . (+.+) p - . (\d -> rotateV d (V2 100 0)) - . (+ dir) - . (* wlAttract) - ) - [-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8] - g (E3x2 p1) = 100 + dist p p1 -- tweak makes it more likely to hit crs first - --g (E3x2 p1) = dist p p1 - 100 -- tweak makes it more likely to hit walls first - g (E3x1 cr1) = dist p $ _crPos cr1 - g _ = 0 - (arcLen,_) = randomR (25,50) $ _randGen w --- BUG: can hit crs through walls - -colSpark :: Int -> Color -> Point2 -> Float -> World -> World -colSpark = colSpark' 0.7 -colSpark' :: Float -> Int -> Color -> Point2 -> Float -> World -> World -colSpark' randDir time col pos baseDir w = w - & worldEvents %~ ( over particles (spark :) . ) - & randGen .~ g - where - (a,g) = randomR (-randDir,randDir) $ _randGen w - dir = a + baseDir - spark = BulletPt - { _ptDraw = drawBul - , _ptUpdate = mvGenBullet - , _btVel' = rotateV dir (V2 5 0) - , _btColor' = col - , _btTrail' = [pos] - , _btPassThrough' = Nothing - , _btWidth' = 1 - , _btTimer' = time - , _btHitEffect' = destroyOnImpact sparkEff noEff - } - sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : ) - where - sp = head (_btTrail' bt) - ep = sp +.+ _btVel' bt diff --git a/src/Dodge/WorldEvent/ThingsHit.hs b/src/Dodge/WorldEvent/ThingsHit.hs index c3cf6eb4f..386b49182 100644 --- a/src/Dodge/WorldEvent/ThingsHit.hs +++ b/src/Dodge/WorldEvent/ThingsHit.hs @@ -3,6 +3,7 @@ Find which objects lie upon a line. -} module Dodge.WorldEvent.ThingsHit ( thingsHit + , thingHit , thingsHitLongLine , thingsHitExceptCr , thingsHitExceptCrLongLine @@ -40,6 +41,8 @@ thingsHit sp ep w _ -> IM.empty wls = zip (map (fromJust . hitPoint) hitWls) (map Right hitWls) hitPoint w' = uncurry (intersectSegSeg sp ep) (_wlLine w') +thingHit :: Point2 -> Point2 -> World -> Maybe (Point2, Either Creature Wall) +thingHit sp ep = listToMaybe . thingsHit sp ep {- List objects that appear on a line. Can filter out a creature. -} thingsHitExceptCr