From 5a579951c8b94f1984ab3e0b9b6f06b38d705988 Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 23 Mar 2022 09:48:32 +0000 Subject: [PATCH] Improve tesla weapon path --- src/Dodge/Creature.hs | 7 +++ src/Dodge/Data.hs | 9 +-- src/Dodge/Debug/Terminal.hs | 2 + src/Dodge/Item/Weapon/BatteryGuns.hs | 82 ++++++++++++++++++++------ src/Dodge/Item/Weapon/SprayGuns.hs | 2 +- src/Dodge/LockAndKey.hs | 19 +++--- src/Dodge/Particle/Bullet/HitEffect.hs | 54 +++-------------- src/Dodge/Particle/TeslaArc.hs | 57 +++++++++++++----- src/Dodge/WorldEvent/HitEffect.hs | 8 --- src/MonadHelp.hs | 9 +++ 10 files changed, 146 insertions(+), 103 deletions(-) diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index def0ce0ac..431b3ba7c 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -164,6 +164,13 @@ startInvList :: [Item] startInvList = [ ] startInventory :: IM.IntMap Item startInventory = IM.fromList $ zip [0..] startInvList +inventoryA :: IM.IntMap Item +inventoryA = IM.fromList $ zip [0..] + [ makeTypeCraftNum 1 TRANSFORMER + , makeTypeCraftNum 2 CAN + , makeTypeCraftNum 2 PIPE + ] + testInventory :: IM.IntMap Item testInventory = IM.fromList $ zip [0..] [ makeTypeCraftNum 9 PIPE diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 06b13ce5d..181edf823 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -634,18 +634,13 @@ data ItemParams , _torqueAfter :: Float , _randomOffset :: Float } - | Sprayer - { _nozzleSpread :: Float - , _nozzleNum :: Int - } - | Sprayer' - { _sprayNozzles :: [Nozzle] - } + | Sprayer { _sprayNozzles :: [Nozzle] } | AngleWalk { _maxWalkAngle :: Float , _currentWalkAngle :: Float , _walkSpeed :: Float } + | Arcing { _currentArc :: Maybe [(Point2,Float,Maybe (Either Creature Wall))] } data Modification = ModIDTimerPoint3Bool { _mdID :: Int diff --git a/src/Dodge/Debug/Terminal.hs b/src/Dodge/Debug/Terminal.hs index ebff2c8bd..3ad937300 100644 --- a/src/Dodge/Debug/Terminal.hs +++ b/src/Dodge/Debug/Terminal.hs @@ -20,6 +20,8 @@ applyTerminalString :: String -> Universe -> Universe applyTerminalString "NOCLIP" = config . debug_noclip %~ not applyTerminalString "LOADME" = (uvWorld . creatures . ix 0 . crInv .~ stackedInventory) . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50) +applyTerminalString "LA" = (uvWorld . creatures . ix 0 . crInv .~ inventoryA) + . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50) applyTerminalString "GODON" = uvWorld . creatures . ix 0 . crUpdate .~ stateUpdateDamage clearDamage yourControl applyTerminalString "GODOFF" = uvWorld . creatures . ix 0 . crUpdate .~ stateUpdate yourControl diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index 726296aad..3b6e3409e 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -26,12 +26,15 @@ import Picture import Shape import ShapePicture import LensHelp +import Dodge.RandomHelp +import MonadHelp ---import Data.List ---import Data.Bifunctor +import Data.Maybe +import Data.List (sortOn) import System.Random --import Data.Tuple import qualified Data.IntMap.Strict as IM +import Control.Monad.State sparkGun :: Item sparkGun = teslaGun & itName .~ "SPARKGUN" @@ -45,7 +48,7 @@ teslaGun = defaultGun , _ammoLoaded = 200 , _reloadTime = 80 } - , _itUse = ruseInstant (const aTeslaArc) NoHammer + , _itUse = ruseInstant shootTeslaArc NoHammer [ ammoCheckI , withTempLight 1 100 (V3 0 0 1) , withSoundForI elecCrackleS 1 @@ -62,6 +65,7 @@ teslaGun = defaultGun } , _dimSPic = teslaGunPic } + , _itParams = Arcing {_currentArc = Nothing} } teslaGunPic :: Item -> SPic teslaGunPic _ = noPic $ colorSH blue $ @@ -79,7 +83,7 @@ lasGun = defaultAutoGun , _ammoLoaded = 200 , _reloadTime = 80 } - , _itUse = ruseInstant aLaser NoHammer + , _itUse = ruseInstant shootLaser NoHammer [ ammoCheckI , withTempLight 1 100 (V3 1 1 0) , withSoundForI tone440sawtoothquietS 2 @@ -189,21 +193,65 @@ tractorGunPic it = amFrac = fractionLoadedAmmo it col = brightX 2 1.5 $ mixColors amFrac (1-amFrac) green red -aTeslaArc :: Creature -> World -> World -aTeslaArc cr w = set randGen g w - & particles .:~ makeTeslaArcAt col pos dir +-- | assumes that the item is held +shootTeslaArc :: Item -> Creature -> World -> World +shootTeslaArc it cr w = w & randGen .~ g + & particles .:~ aTeslaArcAt' col newarc + & creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itParams . currentArc ?~ newarc where - pos = _crPos cr +.+ (_crRad cr +1) *.* unitVectorAtAngle dir + pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir dir = _crDir cr - (colid,g) = randomR (0::Int,3) $ _randGen w - col = chooseColor colid - chooseColor 0 = white - chooseColor 1 = azure - chooseColor 2 = blue - chooseColor _ = cyan + (col,g) = takeOne [white,azure,blue,cyan] & runState $ _randGen w + newarc = createArc (_currentArc (_itParams it)) w pos dir & evalState $ _randGen w -aLaser :: Item -> Creature -> World -> World -aLaser it cr = particles .:~ lasRayAt phasev pos dir +createArc :: RandomGen g + => Maybe [(Point2,Float,Maybe (Either Creature Wall))] + -> World + -> Point2 + -> Float + -> State g [(Point2,Float,Maybe (Either Creature Wall))] +createArc Nothing w p dir = createNewArc w p dir +createArc (Just thearc) w p dir = updateArc thearc w p dir + +createNewArc :: RandomGen g => World -> Point2 -> Float + -> State g [(Point2,Float,Maybe (Either Creature Wall))] +createNewArc w p dir = take 10 + <$> unfoldrMID (newArcStep w) (p,dir,Nothing) + +newArcStep :: RandomGen g => World -> (Point2,Float,Maybe (Either Creature Wall)) + -> State g (Maybe (Point2,Float,Maybe (Either Creature Wall))) +newArcStep _ (_,_,Just _) = return Nothing +newArcStep w (p,dir,_) = do + rot <- takeOne [pi/4,negate pi/4] + let csize = 10 + center = csize *.* rotateV rot (unitVectorAtAngle dir) +.+ p + newp <- (center +.+) <$> randInCirc csize + let mcr = listToMaybe + . sortOn (dist p . _crPos) + . filter (\cr -> dist p (_crPos cr) < csize) + . IM.elems + $ _creatures w + wlsnearpoint = wallsNearPoint p w + mwl = listToMaybe + . sortOn (dist p . fst) + . mapMaybe (\ q -> collidePointWallsWall p q wlsnearpoint) + . map (center +.+) + $ polyCirc 6 csize + f (q,wl) = (q,dir,Just $ Right wl) + g (cr) = (_crPos cr +.+ 10 *.* unitVectorAtAngle dir, dir,Just $ Left cr) + return . listToMaybe . sortOn (dist p . (^. _1)) + $ (newp,dir,Nothing) : catMaybes [fmap f mwl,fmap g mcr] + +updateArc :: RandomGen g + => [(Point2,Float,Maybe (Either Creature Wall))] + -> World + -> Point2 + -> Float + -> State g [(Point2,Float,Maybe (Either Creature Wall))] +updateArc _ w p dir = createNewArc w p dir + +shootLaser :: Item -> Creature -> World -> World +shootLaser it cr = particles .:~ lasRayAt phasev pos dir where pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir dir = _crDir cr @@ -221,7 +269,7 @@ mvLaser :: Float -- ^ Phase velocity, controls deflection through windows -> Particle -> (World, Maybe Particle) mvLaser phasev pos dir w pt - = ( damThingHitWith (\p1 p2 p3 -> Damage Lasering 19 p1 p2 p3 NoDamageEffect) pos xp thHit w + = ( damThingHitWith (\p1 p2 p3 -> Damage Lasering 11 p1 p2 p3 NoDamageEffect) pos xp thHit w , Just pt {_ptDraw = const pic ,_ptUpdate = ptSimpleTime 0 } ) where diff --git a/src/Dodge/Item/Weapon/SprayGuns.hs b/src/Dodge/Item/Weapon/SprayGuns.hs index 74b01401f..7107ddfed 100644 --- a/src/Dodge/Item/Weapon/SprayGuns.hs +++ b/src/Dodge/Item/Weapon/SprayGuns.hs @@ -145,7 +145,7 @@ flameThrower = defaultAutoGun -- , _itFloorPict = flamerPic -- , _itZoom = defaultItZoom , _itAttachment = NoItAttachment - , _itParams = Sprayer' + , _itParams = Sprayer { _sprayNozzles = [ Nozzle { _nzPressure = 4 diff --git a/src/Dodge/LockAndKey.hs b/src/Dodge/LockAndKey.hs index c91e99145..56732c547 100644 --- a/src/Dodge/LockAndKey.hs +++ b/src/Dodge/LockAndKey.hs @@ -20,16 +20,15 @@ bossKeyItems = lockRoomKeyItems :: RandomGen g => [ (Int -> State g (SubCompTree Room) , State g CombineType ) ] lockRoomKeyItems = --- [(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD] ) --- [(sensorRoomRunPast Electrical, takeOne [STATICMODULE,SPARKGUN] ) - --,(sensorRoomRunPast Flaming, takeOne [FLAMESPITTER, INCENDIARYMODULE] ) - [(sensorRoomRunPast Flaming, takeOne [INCENDIARYMODULE] ) --- ,(sensorRoomRunPast Lasering, return LASGUN ) --- ,(const slowDoorRoomRunPast, return MINIGUN) --- ,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD]) --- ,(const glassLessonRunPast, takeOne [LASGUN]) --- ,(const $ lasTunnelRunPast 400, return FLATSHIELD) --- ,(keyCardRoomRunPast 0, return (KEYCARD 0)) + [(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD] ) + ,(sensorRoomRunPast Electrical, takeOne [STATICMODULE,SPARKGUN] ) + ,(sensorRoomRunPast Flaming, takeOne [FLAMESPITTER, INCENDIARYMODULE] ) + ,(sensorRoomRunPast Lasering, return LASGUN ) + ,(const slowDoorRoomRunPast, return MINIGUN) + ,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD]) + ,(const glassLessonRunPast, takeOne [LASGUN]) + ,(const $ lasTunnelRunPast 400, return FLATSHIELD) + ,(keyCardRoomRunPast 0, return (KEYCARD 0)) ] itemRooms :: RandomGen g => [(CombineType, State g (SubCompTree Room))] diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs index f850c9664..40b3eddbc 100644 --- a/src/Dodge/Particle/Bullet/HitEffect.hs +++ b/src/Dodge/Particle/Bullet/HitEffect.hs @@ -1,5 +1,13 @@ {- | Effects of bullets upon impact with walls or creatures. -} -module Dodge.Particle.Bullet.HitEffect where +module Dodge.Particle.Bullet.HitEffect + ( bulHitCr + , bulHitWall + , hvBulHitCr + , hvBulHitWall + , bulletDestroySpawn + , bulBounceArmCr + , bulBounceWall + ) where import Dodge.Data import Dodge.Particle.Spark import Dodge.Wall.Damage @@ -7,7 +15,6 @@ import Dodge.WorldEvent import Dodge.Particle.Bullet.Spawn import Dodge.SoundLogic import Dodge.RandomHelp -import Dodge.WorldEvent.Shockwave import Dodge.Creature.Property import Dodge.Wall.Reflect import Geometry @@ -74,21 +81,6 @@ bulletHitSound p = soundMultiFrom [CrHitSound 0] p hit1S (Just 10) {- | Bounce off armoured creatures, otherwise do damage. -} bulBounceArmCr :: Particle -> Point2 -> Creature -> World -> World bulBounceArmCr = crArmourSplit basicHitCr bounceArmour -{- | Bullet pass through creatures. -} -bulPenCr' :: Particle -> Point2 -> Creature -> World -> World -bulPenCr' bt p cr w = w - & instantParticles .:~ piercer - & bulletHitSound ep - & creatures . ix cid . crState . crDamage .++~ - damageGamut 50 50 d1 sp p ep - where - (d1,_) = randomR (-0.7,0.7) $ _randGen w - cid = _crID cr - sp = head $ _ptTrail bt - ep = sp +.+ _ptVel bt - piercer = (aBulAt Nothing id (Just (_ptColor bt)) (Just cid) p (_ptVel bt) (_btDrag bt) - (_ptHitEff bt) (_ptWidth bt) - ) {_ptTimer = _ptTimer bt - 1} {- | Heavy bullet effects when hitting creature: piercing, blunt, twisting and pushback damage all applied. -} hvBulHitCr :: Particle -> Point2 -> Creature -> World -> World @@ -170,34 +162,6 @@ bulBounceWall bt p wl = damageWall (Damage Blunt 50 sp p ep NoDamageEffect) wl -- all projectiles in it are checked, so we cannot add to it as we accumulate over -- this list -{- | Create flamelet on wall. -} -bulIncWall - :: Particle - -> Point2 -- Impact point - -> Wall - -> World - -> World -bulIncWall bt p wl = damageWall (Damage Blunt 50 sp p ep NoDamageEffect) wl - . makeFlamelet pOut 20 reflectVel Nothing 3 20 - where - ep = sp +.+ _ptVel bt - sp = head $ _ptTrail bt - pOut = p +.+ squashNormalizeV (sp -.- p) - wallV = uncurry (-.-) (_wlLine wl) - reflectVel = squashNormalizeV $ reflectIn wallV (_ptVel bt) -{- | Create a shockwave on wall-} -bulConWall - :: Particle - -> Point2 -- ^ Impact point - -> Wall - -> World - -> World -bulConWall bt p wl = damageWall (Damage Blunt 10 sp p ep NoDamageEffect) wl . - makeShockwaveAt [] p 15 4 1 white - where - ep = sp +.+ _ptVel bt - sp = head $ _ptTrail bt - hvBulHitWall :: Particle -> Point2 -- ^ Impact point diff --git a/src/Dodge/Particle/TeslaArc.hs b/src/Dodge/Particle/TeslaArc.hs index 6c18fc033..0023d1f1e 100644 --- a/src/Dodge/Particle/TeslaArc.hs +++ b/src/Dodge/Particle/TeslaArc.hs @@ -1,7 +1,10 @@ +{-# LANGUAGE TupleSections #-} module Dodge.Particle.TeslaArc - ( makeTeslaArcAt + ( aTeslaArcAt + , aTeslaArcAt' ) where import Dodge.Data +import Dodge.Damage import Dodge.WorldEvent.Damage import Dodge.Base import Dodge.Zone @@ -19,8 +22,18 @@ import Control.Monad.State import Data.Function (on) import Data.List import Data.Maybe -makeTeslaArcAt :: Color -> Point2 -> Float -> Particle -makeTeslaArcAt col pos dir = LinearParticle + +aTeslaArcAt' :: Color -> [(Point2,Float,Maybe (Either Creature Wall))] -> Particle +aTeslaArcAt' col thearc = LinearParticle + { _ptPoints = map (^. _1) thearc + , _ptDraw = drawTeslaArc + , _ptUpdate = moveTeslaArc' thearc + , _ptTimer = 2 + , _ptColor = brightX 100 1.5 col + } + +aTeslaArcAt :: Color -> Point2 -> Float -> Particle +aTeslaArcAt col pos dir = LinearParticle { _ptPoints = [pos] , _ptDraw = drawTeslaArc , _ptUpdate = moveTeslaArc pos dir @@ -34,6 +47,20 @@ drawTeslaArc pt = setLayer 1 $ pictures ] where ps = _ptPoints pt +moveTeslaArc' :: [(Point2,Float,Maybe (Either Creature Wall))] + -> World + -> Particle + -> (World,Maybe Particle) +moveTeslaArc' thearc w pt + | _ptTimer pt == 2 = (foldr damthings w thearc, Just $ pt & ptTimer -~ 1) + | _ptTimer pt < 1 = (w, Nothing) + | otherwise = (w, Just $ pt & ptTimer -~ 1) + where + damthings (_,_,Nothing) = id + damthings (p,dir,Just crwl) = damageCrWall (thedamage p dir) crwl + thedamage p dir = Damage Electrical 5 (p -.- q) p (p +.+ q) NoDamageEffect + where + q = 5 *.* unitVectorAtAngle dir -- todo: fix electrical damage location moveTeslaArc :: Point2 -- ^ Emmission position @@ -43,8 +70,10 @@ moveTeslaArc -> (World, Maybe Particle) moveTeslaArc p d w pt | t == 2 = - (foldr damCrs w hitCrs & randGen .~ g & colSpark 8 nc q2 (argV sv) - & damThingHitWith (\p1 p2 p3 -> Damage Electrical 50 p1 p2 p3 NoDamageEffect) + ( foldr damCrs w hitCrs + & randGen .~ g + & colSpark 8 nc q2 (argV sv) + & damThingHitWith (\p1 p2 p3 -> Damage Electrical 50 p1 p2 p3 NoDamageEffect) q1 ((2 *.* q2) -.- q1) thHit , Just $ pt & ptTimer -~ 1 & ptPoints .~ ps' ) @@ -52,9 +81,9 @@ moveTeslaArc p d w pt | otherwise = (w , Just $ pt & ptTimer -~ 1) where t = _ptTimer pt - ps = take 25 $ p : map f (crsLightChain p d 0 w) + ps = take 5 $ p : map f (crsLightChain p d 0 w) f (E3x1 cr) = _crPos cr - f (E3x2 p1) = p1 + f (E3x2 (p1,_)) = p1 f (E3x3 p1) = p1 ps' = lightningMids d pers ps pers = evalState (sequence $ repeat $ randInCirc 5) $ _randGen w @@ -85,7 +114,7 @@ lightningMids d1 (p:pers) (p1: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 :: Point2 -> Float -> Float -> World -> [Either3 Creature (Point2,Wall) 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 @@ -103,29 +132,27 @@ crOrWallSensitive -> Float -- ^ Direction (radians) -> Float -- ^ Wall attraction parameter -> World - -> Either3 Creature Point2 Point2 + -> Either3 Creature (Point2,Wall) 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 + wlp = fmap E3x2 . listToMaybe - . sortBy (compare `on` dist p) + . sortBy (compare `on` dist p . fst) $ mapMaybe - ( fmap fst - . (\p1 -> reflectPointWalls p p1 $ wallsNearPoint p w) + ( (\p1 -> collidePointWallsWall 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,_)) = 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/WorldEvent/HitEffect.hs b/src/Dodge/WorldEvent/HitEffect.hs index a34f3bd25..10636c236 100644 --- a/src/Dodge/WorldEvent/HitEffect.hs +++ b/src/Dodge/WorldEvent/HitEffect.hs @@ -1,6 +1,5 @@ module Dodge.WorldEvent.HitEffect ( destroyOnImpact - , doFlameDam , noEff , penWalls ) where @@ -61,12 +60,5 @@ penWalls crEff wlEff pt hitThings w = case hitThings of -> 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 .:~ - Damage Flaming amount sp p ep NoDamageEffect - where - sp = _ptPos pt - ep = sp +.+ _ptVel pt - noEff :: a -> b -> c -> d -> d noEff _ _ _ = id diff --git a/src/MonadHelp.hs b/src/MonadHelp.hs index be1cb0910..fafd26374 100644 --- a/src/MonadHelp.hs +++ b/src/MonadHelp.hs @@ -25,3 +25,12 @@ iterateUntil t m = do iterateWhile :: Monad m => (a -> Bool) -> m a -> m a iterateWhile t = iterateUntil (not . t) + +unfoldrMID :: (Monad m) => (a -> m (Maybe a)) -> a -> m [a] +unfoldrMID f = go + where + go z = do + x <- f z + case x of + Nothing -> return [z] + Just y -> (z :) <$> go y