Add new bullet trajectories

2022-02-28 13:19:07 +00:00
parent 1e5f24c8a1
commit 419fcd0ff0
18 changed files with 285 additions and 101 deletions
@@ -9,10 +9,12 @@ module Dodge.Item.Weapon.AmmoParams
 import Dodge.Data
 import Dodge.Particle.Bullet.Spawn
 import Dodge.Creature.HandPos
+import Dodge.Item.Weapon.Targeting
+import Dodge.Item.Weapon.Bezier
 import Geometry
 import LensHelp

--import Data.Maybe
+import Data.Maybe
 --import Control.Lens

 useAmmoParamsRate :: Int 
@@ -35,13 +37,17 @@ defaultAimParams = AimParams
    }

 useAmmoParams :: Item -> Creature -> World -> World
-useAmmoParams it cr = withVelWthHiteff 
-    (muzvel *.* _amBulVel b) 
-    (_rifling $ _itParams it) 
-    (_amBulWth b) 
-    muzlength
-    (_amBulEff b) 
-    cr
+useAmmoParams it cr = case _amBulTraj b of
+    BasicBulletTrajectory -> withVelWthHiteff 
+        (muzvel *.* _amBulVel b) 
+        (_rifling $ _itParams it) 
+        (_amBulWth b) 
+        muzlength
+        (_amBulEff b) 
+        cr
+    BezierTrajectory -> useTargetPos (\p -> shootBezier $ fromJust p) cr
+    FlechetteTrajectory -> undefined
+    MagnetTrajectory    -> undefined
  where
    muzlength = aimingMuzzlePos cr it
    muzvel = _muzVel $ _itParams it
@@ -5,10 +5,11 @@ module Dodge.Item.Weapon.BatteryGuns
    , lasRayAt
    ) where
 import Dodge.Data
+import Dodge.Item.Weapon.LaserPath
 import Dodge.Creature.HandPos
 import Dodge.Particle.TeslaArc
 import Dodge.SoundLogic.LoadSound
-import Dodge.WorldEvent
+--import Dodge.WorldEvent
 import Dodge.WorldEvent.Damage
 --import Dodge.Default
 --import Dodge.Item.Weapon.InventoryDisplay
@@ -25,10 +26,10 @@ import Shape
 import ShapePicture
 import LensHelp

-import Data.List
-import Data.Bifunctor
+--import Data.List
+--import Data.Bifunctor
 import System.Random
-import Data.Tuple
+--import Data.Tuple
 import qualified Data.IntMap.Strict as IM
 teslaGun :: Item
 teslaGun = defaultGun 
@@ -178,45 +179,13 @@ mvLaser phasev pos dir w pt
      )
  where
    xp = pos +.+ 800 *.* unitVectorAtAngle dir
-    (thHit, ps) = f [] pos xp
-    f :: [Wall] -> Point2 -> Point2 -> (Maybe (Point2,Either Creature Wall),[Point2])
-    f seenWs x y = case find (notseen seenWs) $ thingsHitExceptCrLongLine Nothing x y w of
-    --f seenWs x y = case find (notseen seenWs) $ thingsHitExceptCr Nothing x y w of
-        Just (p,Right wl) 
-            | _wlOpacity wl == SeeThrough -> second (p:) $ f (wl:seenWs) p (refract x y wl p)
-            | otherwise -> (Just (p,Right wl), [p])
-        Just (p,obj) -> (Just (p,obj), [p])
-        Nothing -> (Nothing, [y])
-    refract x y wl p 
-        | isEntering = p +.+ rotateV angleRef  (normalDist wlNormal)
-        | otherwise  = p +.+ rotateV angleRef' (normalDist wlNormal')
-      where 
-        wlNormal = vNormal $ uncurry (-.-) $ swap (_wlLine wl)
-        wlNormal' = vNormal $ uncurry (-.-) (_wlLine wl)
-        normalDist wlnormal  = magV (p -.- y) *.* normalizeV wlnormal
-        angleInc = piRange $ argV wlNormal - argV (x -.- y)
-        angleRef 
-            | reflectExternal = angleInc
-            | otherwise = asin $ sin angleInc / phasev
-        piRange a' 
-            | a' > pi = a' - 2 * pi
-            | a' > negate pi = a'
-            | otherwise  = a' + 2 * pi
-        isEntering = not $ isLeftOf (x -.- y) (uncurry (-.-) (_wlLine wl))
-        angleInc' = piRange $ argV wlNormal' - argV (x -.- y)
-        angleRef' 
-            | reflectInternal = angleInc'
-            | otherwise = asin $ phasev * sin angleInc'
-        reflectInternal = 1 < abs (phasev * sin angleInc')
-        reflectExternal = 1 < abs (sin angleInc / phasev)
-            
-    notseen ws (_,Right wl) = not $ any (\w' -> _wlID w' == _wlID wl) ws
-    notseen _ _ = True
+    (thHit, ps) = reflectLaserAlong phasev [] pos xp w
    pic = setLayer 1 $ pictures
        [ setDepth 19   . color (brightX 0 0.5 yellow) $ thickLine 20 (pos:ps)
        , setDepth 19.5 . color (brightX 10 1 yellow)  $ thickLine 3  (pos:ps)
        ]

+
 aTractorBeam :: Item -> Creature -> World -> World
 aTractorBeam _ cr w = w & props . at i ?~ tractorBeamAt i spos outpos dir
  where 
@@ -1,5 +1,6 @@
 module Dodge.Item.Weapon.Bezier
    ( bezierGun
+    , shootBezier
    ) where
 import Dodge.Data
 import Dodge.Base
@@ -17,6 +17,7 @@ basicBullet = BulletAmmo
    , _amBulEff = destroyOnImpact bulHitCr bulHitWall
    , _amBulWth = 2
    , _amBulVel = V2 50 0
+    , _amBulTraj = BasicBulletTrajectory
    }
 incBullet :: AmmoType
 incBullet = BulletAmmo
@@ -24,6 +25,7 @@ incBullet = BulletAmmo
    , _amBulEff = destroyOnImpact bulIncCr bulIncWall
    , _amBulWth = 2
    , _amBulVel = V2 50 0
+    , _amBulTraj = BasicBulletTrajectory
    }
 conBullet :: AmmoType
 conBullet = BulletAmmo
@@ -31,6 +33,7 @@ conBullet = BulletAmmo
    , _amBulEff = destroyOnImpact bulConCr bulConWall
    , _amBulWth = 2
    , _amBulVel = V2 50 0
+    , _amBulTraj = BasicBulletTrajectory
    }
 bounceBullet :: AmmoType
 bounceBullet = BulletAmmo
@@ -38,6 +41,7 @@ bounceBullet = BulletAmmo
    , _amBulEff = destroyOnImpact bulHitCr bulBounceWall
    , _amBulWth = 2
    , _amBulVel = V2 50 0
+    , _amBulTraj = BasicBulletTrajectory
    }
 ltBullet :: AmmoType
 ltBullet = BulletAmmo
@@ -45,6 +49,7 @@ ltBullet = BulletAmmo
    , _amBulEff = destroyOnImpact bulHitCr bulHitWall
    , _amBulWth = 2
    , _amBulVel = V2 40 0
+    , _amBulTraj = BasicBulletTrajectory
    }
 hvBullet :: AmmoType
 hvBullet = BulletAmmo
@@ -52,4 +57,5 @@ hvBullet = BulletAmmo
    , _amBulEff = penWalls hvBulHitCr hvBulHitWall
    , _amBulWth = 6
    , _amBulVel = V2 80 0
+    , _amBulTraj = BasicBulletTrajectory
    }
@@ -44,7 +44,7 @@ bangCane :: Item
 bangCane = defaultGun
    { _itName = "BANGCANE"
    , _itType = BANGCANE
-    ,_itParams = BulletShooter
+    , _itParams = BulletShooter
        { _muzVel = 0.8
        , _rifling = 0.9
        , _bore = 2
@@ -3,17 +3,20 @@
 Extra weapon effects, supplementing explicit use effects.
 -}
 module Dodge.Item.Weapon.ExtraEffect
-    (-- wpRecock
-     itemLaserScopeEffect
+    ( itemLaserScopeEffect
    , autoSonarEffect
    , autoRadarEffect
    , targetRBPress
+    , targetRBCreature
+    , targetCursor
+    , targetLaser
 --    , rbSetTarget
    ) where
 import Dodge.Data
 import Dodge.Base
 import Dodge.Item.Weapon.Decoration
 import Dodge.Item.Weapon.UseEffect
+import Dodge.Item.Weapon.LaserPath
 --import Dodge.Item.Attachment.Data
 import Dodge.WorldEvent.ThingsHit
 import Dodge.Picture.Layer
@@ -82,16 +85,35 @@ autoSonarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
    f t _ cr i w = w 
        & creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f (t-1)

-targetRBPress :: Targeting
-targetRBPress = TargetingOnHeld
+defaultTargeting :: Targeting
+defaultTargeting = TargetingOnHeld
    { _tgPos = Nothing
-    , _tgHeldUpdate = targetRBPressUpdate
-    , _tgDraw = targetRBPressDraw
+    , _tgUpdate = \_ _ _ -> id
+    , _tgDraw = \_ _ _ _ -> mempty
+    , _tgID = Nothing
+    , _tgActive = False
+    , _tgPoints = []
    }
-targetRBPressDraw :: Int -> Item -> Creature -> World -> Picture
-targetRBPressDraw _ it _ w = fromMaybe mempty $ do
+targetLaser :: Targeting
+targetLaser = defaultTargeting
+    & tgUpdate  .~ targetLaserUpdate
+    & tgDraw        .~ targetLaserDraw
+targetRBPress :: Targeting
+targetRBPress = defaultTargeting
+    & tgUpdate  .~ targetRBPressUpdate
+    & tgDraw    .~ targetSimpleDraw
+targetRBCreature :: Targeting
+targetRBCreature = defaultTargeting
+    & tgUpdate  .~ targetRBCreatureUpdate
+    & tgDraw    .~ targetRBCreatureDraw
+targetCursor :: Targeting
+targetCursor = defaultTargeting
+    & tgUpdate  .~ targetCursorUpdate
+    & tgDraw    .~ targetSimpleDraw
+targetSimpleDraw :: Int -> Item -> Creature -> World -> Picture
+targetSimpleDraw _ it _ w = fromMaybe mempty $ do
    mwp <- it ^? itTargeting . tgPos . _Just
-    return $ setLayer 1 $ color red $ onLayer InvLayer $ uncurryV translate mwp 
+    return $ setLayer 5 $ color red $ onLayer InvLayer $ uncurryV translate mwp 
        $ rotate (_cameraRot w)
        $ pictures
            [line [V2   x  x, V2 (-x) (-x)]
@@ -100,8 +122,67 @@ targetRBPressDraw _ it _ w = fromMaybe mempty $ do
  where
    x = 5 / _cameraZoom w

+targetRBCreatureDraw :: Int -> Item -> Creature -> World -> Picture
+targetRBCreatureDraw _ it _ w = fromMaybe mempty $ do
+    mwp <- it ^? itTargeting . tgPos . _Just
+    return $ setLayer 5 $ color thecolor $ onLayer InvLayer $ uncurryV translate mwp 
+        $ rotate (_cameraRot w)
+        $ pictures
+            [line [V2   x  x, V2 (-x) (-x)]
+            ,line [V2 (-x) x, V2   x  (-x)]
+            ]
+  where
+    x = 5 / _cameraZoom w
+    thecolor | _tgActive $ _itTargeting it = red
+        | otherwise = blue
+
+targetCursorUpdate :: Item -> Creature -> World -> Targeting -> Targeting
+targetCursorUpdate _ _ w t
+    | SDL.ButtonRight `S.member` _mouseButtons w = t
+        & tgPos . _Just .~ mouseWorldPos w
+        & tgActive .~ True
+    | otherwise = t & tgPos %~ const Nothing
+        & tgActive .~ False
+
 targetRBPressUpdate :: Item -> Creature -> World -> Targeting -> Targeting
 targetRBPressUpdate _ _ w t
    | SDL.ButtonRight `S.member` _mouseButtons w = t
        & tgPos %~ maybe (Just $ mouseWorldPos w) Just
+        & tgActive .~ True
    | otherwise = t & tgPos %~ const Nothing
+        & tgActive .~ False
+
+targetRBCreatureUpdate :: Item -> Creature -> World -> Targeting -> Targeting
+targetRBCreatureUpdate _ _ w t
+    | SDL.ButtonRight `S.member` _mouseButtons w = t & updatePos
+        & tgActive .~ True
+    | otherwise = t & tgID .~ fmap _crID (creatureNearPoint mwp w)
+        & updatePos
+        & tgActive .~ False
+  where
+    mwp = mouseWorldPos w
+    updatePos t' = t' & tgPos .~ posFromMaybeID (_tgID t')
+    posFromMaybeID Nothing = Nothing
+    posFromMaybeID (Just i) = w ^? creatures . ix i . crPos
+
+targetLaserDraw :: Int -> Item -> Creature -> World -> Picture
+targetLaserDraw _ it _ _ = fromMaybe mempty $ do
+    ps <- it ^? itTargeting . tgPoints
+    return $ setLayer 1 $ pictures
+        [ setDepth 19   . color (brightX 0 0.5 red) $ thickLine 5 ps
+        , setDepth 19.5 . color (brightX 5 1 red)  $ thickLine 1  ps
+        ]
+
+targetLaserUpdate :: Item -> Creature -> World -> Targeting -> Targeting
+targetLaserUpdate _ cr w t
+    | SDL.ButtonRight `S.member` _mouseButtons w = t
+        & tgPos .~ fmap fst mp
+        & tgPoints .~ ps ++ [sp]
+        & tgActive .~ True
+    | otherwise = t & tgPos %~ const Nothing
+        & tgPoints .~ []
+        & tgActive .~ False
+  where
+    (mp, ps) = reflectLaserAlong 0.2 [] sp ep w
+    sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
+    ep = sp +.+ 1000 *.* normalizeV (mouseWorldPos w -.- sp)
@@ -0,0 +1,54 @@
+module Dodge.Item.Weapon.LaserPath 
+    ( reflectLaserAlong
+    ) where
+import Dodge.Data
+--import Dodge.Creature.HandPos
+import Dodge.WorldEvent
+--import Dodge.Default
+--import Dodge.Item.Weapon.InventoryDisplay
+--import Dodge.Item.Weapon.TriggerType
+--import Dodge.Item.Attachment
+--import Dodge.Base
+import Geometry
+
+--import Data.Maybe
+import Data.List
+import Data.Bifunctor
+import Data.Tuple
+
+-- not sure why we need to keep a list of seen walls, but seems to loop
+-- infinitely when removed
+reflectLaserAlong :: Float -> [Wall] -> Point2 -> Point2 -> World 
+    -> (Maybe (Point2,Either Creature Wall),[Point2])
+reflectLaserAlong phasev seenWl sp ep w = case find (notseen seenWl) 
+        $ thingsHitExceptCrLongLine Nothing sp ep w of
+    Just (p,Right wl) 
+        | _wlOpacity wl == SeeThrough -> second (p:) $ reflectLaserAlong phasev (wl:seenWl) p (refract sp ep wl p) w
+        | otherwise -> (Just (p,Right wl), [p])
+    Just (p,obj) -> (Just (p,obj), [p])
+    Nothing -> (Nothing, [ep])
+  where
+    notseen ws (_,Right wl) = not $ any (\w' -> _wlID w' == _wlID wl) ws
+    notseen _ _ = True
+    refract x y wl p 
+        | isEntering = p +.+ rotateV angleRef  (normalDist wlNormal)
+        | otherwise  = p +.+ rotateV angleRef' (normalDist wlNormal')
+      where 
+        wlNormal = vNormal $ uncurry (-.-) $ swap (_wlLine wl)
+        wlNormal' = vNormal $ uncurry (-.-) (_wlLine wl)
+        normalDist wlnormal  = magV (p -.- y) *.* normalizeV wlnormal
+        angleInc = piRange $ argV wlNormal - argV (x -.- y)
+        angleRef 
+            | reflectExternal = angleInc
+            | otherwise = asin $ sin angleInc / phasev
+        piRange a' 
+            | a' > pi = a' - 2 * pi
+            | a' > negate pi = a'
+            | otherwise  = a' + 2 * pi
+        isEntering = not $ isLeftOf (x -.- y) (uncurry (-.-) (_wlLine wl))
+        angleInc' = piRange $ argV wlNormal' - argV (x -.- y)
+        angleRef' 
+            | reflectInternal = angleInc'
+            | otherwise = asin $ phasev * sin angleInc'
+        reflectInternal = 1 < abs (phasev * sin angleInc')
+        reflectExternal = 1 < abs (sin angleInc / phasev)