Improve tesla weapon path

2022-03-23 09:48:32 +00:00
parent 7f174b7d18
commit 5a579951c8
10 changed files with 146 additions and 103 deletions
@@ -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
@@ -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
@@ -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
@@ -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
@@ -145,7 +145,7 @@ flameThrower = defaultAutoGun
 --    , _itFloorPict = flamerPic
 --    , _itZoom       = defaultItZoom
    , _itAttachment = NoItAttachment
-    , _itParams = Sprayer' 
+    , _itParams = Sprayer
        { _sprayNozzles = 
            [ Nozzle 
                { _nzPressure = 4
@@ -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))]
@@ -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
@@ -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
-
@@ -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
@@ -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