Make projectile use 3d position/velocity records

src/Dodge/Data/Projectile.hs

@@ -15,15 +15,13 @@ import NewInt
 import Dodge.Data.Payload
 
 data Projectile = Shell
-    { _pjPos :: Point2
-    , _pjZ :: Float
-    , _pjVel :: Point2
+    { _pjPos :: Point3
+    , _pjVel :: Point3
     , _pjDir :: Float
     , _pjSpin :: Float
     , _pjID :: Int
     , _pjPayload :: Payload
     , _pjTimer :: Int
-    , _pjZVel :: Float
     , _pjBarrelSpin :: Maybe (Int, Float)
     , _pjType :: ProjectileType
     , _pjDetonatorID :: Maybe (NewInt ItmInt)

src/Dodge/Projectile/Create.hs

@@ -36,10 +36,8 @@ createShell (p,q) mdetonator mscreen stab pjtype payload muz cr w =
         & updatedetonator
         & cWorld . lWorld . projectiles . at i
             ?~ Shell
-                { _pjPos = pos
-                , _pjZ = 20
-                , _pjZVel = 5
-                , _pjVel = rotateV dir' (V2 speed 0) + crvelcomponent
+                { _pjPos = pos `v2z` 20
+                , _pjVel = (rotateV dir' (V2 speed 0) + crvelcomponent) `v2z` 5
                 , _pjID = i
                 , _pjDir = dir'
                 , _pjSpin = 0

src/Dodge/Projectile/Draw.hs

@@ -21,8 +21,9 @@ drawProjectile pj
 
 drawShell :: Maybe Color -> Projectile -> SPic
 drawShell mcol pj =
-    translateSPz (_pjZ pj)
-        . uncurryV translateSPxy (_pjPos pj)
+--    translateSPz (_pjZ pj)
+--        . uncurryV translateSPxy (_pjPos pj)
+    translateSP (pj ^. pjPos)
         $ rotateSP (_pjDir pj) $
             shellShape :!: thelight
   where

src/Dodge/Projectile/Update.hs

@@ -23,6 +23,7 @@ import LensHelp
 import NewInt
 import RandomHelp
 import Linear.Metric
+import Linear.V3
 
 updateProjectile :: Projectile -> World -> World
 updateProjectile pj w =
@@ -41,14 +42,14 @@ doGravityPU pj
 
 applyGravityPU :: Projectile -> World -> World
 applyGravityPU pj w
-    | _pjZ pj < 1 && abs (norm $ _pjVel pj `v2z` _pjZVel pj) < 1 = w 
+    | (pj ^. pjPos . _z) < 1 && norm (_pjVel pj) < 1 = w 
         & topj . pjVel .~ 0
     | otherwise =
-        w & topj . pjZ .~ newz
-            & topj . pjZVel -~ 0.5
+        w -- & topj . pjZ .~ newz
+            & topj . pjVel . _z -~ 0.5
   where
     topj = cWorld . lWorld . projectiles . ix (pj ^. pjID)
-    newz = pj ^. pjZ + pj ^. pjZVel
+--    newz = pj ^. pjZ + pj ^. pjZVel
 
 -- consider pushing any hit creature back
 shellExplosionCheck :: Projectile -> World -> World
@@ -68,16 +69,16 @@ shellHitWall p' n wl pj w
         w
             & cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
                 .~ Grenade (GStuckWall (wl ^. wlStructure))
-            & soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
+            & soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos . _xy)
     | Just x <- pj ^? pjType . gnHitEffect . bounceTolerance
-      , abs (dotV (pj ^. pjVel) (vNormal hitline)) < x =
+      , abs (dotV (pj ^. pjVel . _xy) (vNormal hitline)) < x =
         w
-            & cWorld . lWorld . projectiles . ix (_pjID pj) . pjVel
+            & cWorld . lWorld . projectiles . ix (_pjID pj) . pjVel . _xy
                 %~ reflectIn hitline
-            & cWorld . lWorld . projectiles . ix (_pjID pj) . pjPos
-                .~ p - normalizeV (pj ^. pjVel)
-            & soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos) click1S Nothing
-    | otherwise = w & cWorld . lWorld . projectiles . ix (_pjID pj) . pjPos .~ p
+            & cWorld . lWorld . projectiles . ix (_pjID pj) . pjPos . _xy
+                .~ p - normalizeV (pj ^. pjVel . _xy)
+            & soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos . _xy) click1S Nothing
+    | otherwise = w & cWorld . lWorld . projectiles . ix (_pjID pj) . pjPos .~ p'
             &  cWorld . lWorld . projectiles . ix (_pjID pj) . pjTimer .~ 0
   where
     p = xyV3 p'
@@ -94,28 +95,28 @@ shellHitCreature p' n cr pj w
                         (rotate3z (- cr ^. crDir) (p' - ((cr ^. crPos)`v2z`0)))
                         (pj ^. pjDir - cr ^. crDir)
                     )
-            & soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
-    | otherwise = w & cWorld . lWorld . projectiles . ix (_pjID pj) . pjPos .~ p
+            & soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos . _xy)
+    | otherwise = w & cWorld . lWorld . projectiles . ix (_pjID pj) . pjPos .~ p'
             &  cWorld . lWorld . projectiles . ix (_pjID pj) . pjTimer .~ 0
   where
     p = xyV3 p'
 
 shellHitFloor :: Point3 -> Point3 -> Projectile -> World -> World
 shellHitFloor p' n pj w 
-    | z < 1 && abs (norm $ _pjVel pj `v2z` zvel) < 1 = w 
+    | z < 1 && norm (_pjVel pj) < 1 = w 
     | otherwise = 
-        w & topj . pjZ .~ 0.1
-            & topj . pjZVel %~ bouncez
-            & topj . pjVel %~ decvel
+        w & topj . pjPos . _z .~ 0.1
+            & topj . pjVel . _z %~ bouncez
+            & topj . pjVel . _xy %~ decvel
             & topj . pjSpin %~ decspin
-            & soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos) click1S Nothing
+            & soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos . _xy) click1S Nothing
   where
     bouncez x
         | x < -1 = -0.5 * x
         | otherwise = 0
     topj = cWorld . lWorld . projectiles . ix (pj ^. pjID)
-    zvel = pj ^. pjZVel
-    z = pj ^. pjZ + zvel
+    zvel = pj ^. pjVel . _z
+    z = pj ^. pjPos . _z + zvel
     decvel v
         | magV v > 1 = rotateV (5 * pj ^. pjSpin) $ 0.8 * v
         | otherwise = 0
@@ -123,41 +124,41 @@ shellHitFloor p' n pj w
         | abs x < 0.01 = 0
         | otherwise = x * 0.9
 
----- note this doesn't take into account moving walls, which may break the
----- bouncing in some way
-tryShellBounce :: Point3 -> (Point3, Object ) -> Projectile -> World -> World
-tryShellBounce p' (n, OWall wl) pj w
-    | Just GStick <- pj ^? pjType . gnHitEffect =
-        w
-            & cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
-                .~ Grenade (GStuckWall (wl ^. wlStructure))
-            & soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
-    | Just x <- pj ^? pjType . gnHitEffect . bounceTolerance
-      , abs (dotV (pj ^. pjVel) (vNormal hitline)) < x =
-        w
-            & cWorld . lWorld . projectiles . ix (_pjID pj) . pjVel
-                %~ reflectIn hitline
-            & cWorld . lWorld . projectiles . ix (_pjID pj) . pjPos
-                .~ p - normalizeV (pj ^. pjVel)
-            & soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos) click1S Nothing
-  where
-    p = xyV3 p'
-    hitline = normalizeV $ uncurry (-) $ _wlLine wl
-tryShellBounce p' (n,OCreature cr) pj w
-    | Just GStick <- pj ^? pjType . gnHitEffect =
-        w
-            & cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
-                .~ Grenade
-                    ( GStuckCreature
-                        (cr ^. crID)
-                        (rotate3z (- cr ^. crDir) (p' - ((cr ^. crPos)`v2z`0)))
-                        (pj ^. pjDir - cr ^. crDir)
-                    )
-            & soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
-  where
-    p = xyV3 p'
-tryShellBounce _ _ pj w = w
-tryShellBounce _ _ pj w = explodeShell pj w
+------ note this doesn't take into account moving walls, which may break the
+------ bouncing in some way
+--tryShellBounce :: Point3 -> (Point3, Object ) -> Projectile -> World -> World
+--tryShellBounce p' (n, OWall wl) pj w
+--    | Just GStick <- pj ^? pjType . gnHitEffect =
+--        w
+--            & cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
+--                .~ Grenade (GStuckWall (wl ^. wlStructure))
+--            & soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos . _xy)
+--    | Just x <- pj ^? pjType . gnHitEffect . bounceTolerance
+--      , abs (dotV (pj ^. pjVel . _xy) (vNormal hitline)) < x =
+--        w
+--            & cWorld . lWorld . projectiles . ix (_pjID pj) . pjVel . _xy
+--                %~ reflectIn hitline
+--            & cWorld . lWorld . projectiles . ix (_pjID pj) . pjPos
+--                .~ p - normalizeV (pj ^. pjVel)
+--            & soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos) click1S Nothing
+--  where
+--    p = xyV3 p'
+--    hitline = normalizeV $ uncurry (-) $ _wlLine wl
+--tryShellBounce p' (n,OCreature cr) pj w
+--    | Just GStick <- pj ^? pjType . gnHitEffect =
+--        w
+--            & cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
+--                .~ Grenade
+--                    ( GStuckCreature
+--                        (cr ^. crID)
+--                        (rotate3z (- cr ^. crDir) (p' - ((cr ^. crPos)`v2z`0)))
+--                        (pj ^. pjDir - cr ^. crDir)
+--                    )
+--            & soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
+--  where
+--    p = xyV3 p'
+--tryShellBounce _ _ pj w = w
+--tryShellBounce _ _ pj w = explodeShell pj w
 
 destroyProjectile :: Maybe (NewInt ItmInt) -> Int -> World -> World
 destroyProjectile mitid pjid w =
@@ -185,7 +186,7 @@ doThrust :: Projectile -> Maybe RocketSmoke -> World -> World
 doThrust pj smoke w =
     w
         & randGen .~ g
-        & cWorld . lWorld . projectiles . ix i . pjVel %~ (\v -> accel +.+ frict *.* v)
+        & cWorld . lWorld . projectiles . ix i . pjVel . _xy %~ (\v -> accel +.+ frict *.* v)
         & soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
         & makeFlamelet (oldPos -.- vel) (vel +.+ rotateV (pi + sparkD) accel) 3 10
         & makeCloudAt
@@ -200,8 +201,8 @@ doThrust pj smoke w =
     --    trailfadetime = fst . randomR (100, 300) $ _randGen w
     accel = rotateV (pj ^. pjDir) (V2 3 0)
     i = _pjID pj
-    oldPos = _pjPos pj
-    vel = _pjVel pj
+    oldPos = pj ^. pjPos . _xy
+    vel = pj ^. pjVel . _xy
     newPos = oldPos +.+ vel
     (frict, g) = randomR (0.6, 0.9) $ _randGen w
     (sparkD, _) = randomR (-0.2, 0.2) $ _randGen w
@@ -214,12 +215,8 @@ doBarrelSpin cid i pj w =
     w & cWorld . lWorld . projectiles . ix pjid . pjSpin .~ newSpin
         & cWorld . lWorld . projectiles . ix pjid . pjBarrelSpin .~ Nothing
   where
-    --        & cWorld . lWorld . projectiles . ix pjid . pjUpdates %~ deleteBy f (StartSpinPU 0 0 0)
-
-    --    f _ StartSpinPU{} = True
-    --    f _ _ = False
     pjid = _pjID pj
-    dir = argV $ _pjVel pj
+    dir = argV $ pj ^. pjVel . _xy
     newSpin = case w ^? cWorld . lWorld . creatures . ix cid of
         Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / spinFactor
         _ -> 0
@@ -240,9 +237,9 @@ pjRemoteSetDirection ph pj w = case ph of
         | Just tp <- w ^? pointerToItemID itid . itTargeting . itTgPos . _Just ->
             w
                 & cWorld . lWorld . projectiles . ix (_pjID pj) . pjDir
-                    %~ turnTo 0.2 (_pjPos pj) tp
+                    %~ turnTo 0.2 (pj ^. pjPos . _xy) tp
                 & cWorld . lWorld . projectiles . ix (_pjID pj) . pjSpin
-                    .~ 0.5 * diffAngles (turnTo 0.2 (_pjPos pj) tp (_pjDir pj)) (_pjDir pj)
+                    .~ 0.5 * diffAngles (turnTo 0.2 (pj ^. pjPos . _xy) tp (_pjDir pj)) (_pjDir pj)
     _ -> w
   where
     lw = w ^. cWorld . lWorld
@@ -259,17 +256,17 @@ moveProjectile pj w
             cdir = cr ^. crDir
             vel = cpos - cr ^. crOldPos
          in w
-                & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjPos
+                & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjPos . _xy
                     .~ xyV3 ((cpos `v2z` 0) + rotate3z cdir poff)
                 & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjDir .~ d + cdir
-                & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjVel .~ vel
+                & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjVel . _xy .~ vel
     | Just GStuckCreature{} <- pj ^? pjType . gnHitEffect =
         w & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjType .~ Grenade GStick
-    | (p,Just (n,OWall wl)) <- collide3 (p `v2z` (_pjZ pj)) ((p + _pjVel pj)`v2z` (_pjZ pj + _pjZVel pj) ) w 
+    | (p,Just (n,OWall wl)) <- collide3 p (p + _pjVel pj) w 
         = shellHitWall p n wl pj w
-    | (p,Just (n,OFloor)) <- collide3 (p `v2z` (_pjZ pj)) ((p + _pjVel pj)`v2z` (_pjZ pj + _pjZVel pj) ) w 
+    | (p,Just (n,OFloor)) <- collide3 p (p + _pjVel pj) w 
         = shellHitFloor p n pj w
-    | (p,Just (n,OCreature cr)) <- collide3 (p `v2z` (_pjZ pj)) ((p + _pjVel pj)`v2z` (_pjZ pj + _pjZVel pj) ) w 
+    | (p,Just (n,OCreature cr)) <- collide3 p (p + _pjVel pj) w 
         = shellHitCreature p n cr pj w
     | otherwise =
         w
@@ -285,7 +282,7 @@ explodeShell pj w =
         & cWorld . lWorld . projectiles . ix pjid . pjType .~ RetiredProjectile
         & cWorld . lWorld . projectiles . ix pjid . pjVel .~ 0
         & cWorld . lWorld . projectiles . ix pjid . pjTimer .~ 30
-        & usePayload (_pjPayload pj) (_pjPos pj) (_pjVel pj)
+        & usePayload (_pjPayload pj) (pj ^. pjPos . _xy) (pj ^. pjVel . _xy)
         & stopSoundFrom (ShellSound pjid)
         & updatedetonator
   where

src/Dodge/Render/ShapePicture.hs

@@ -17,13 +17,14 @@ import NewInt
 import Picture
 import Shape
 import ShapePicture
+import Linear.V3
 
 worldSPic :: Configuration -> Universe -> SPic
 worldSPic cfig u =
     (mempty :!: extraPics cfig u)
         <> foldup propSPic (filtOn _prPos _props)
         <> foldMap' debrisSPic (filtOn' (xyV3 . _dbPos) _debris)
-        <> foldup drawProjectile (filtOn _pjPos _projectiles)
+        <> foldup drawProjectile (filtOn (^. pjPos . _xy) _projectiles)
         <> foldup drawPulseBall (filtOn _pbPos _pulseBalls)
         <> foldup (shiftDraw _blPos _blDir (drawBlock . _blDraw)) (filtOn _blPos _blocks)
         <> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _foregroundShapes)

src/Dodge/TestString.hs

@@ -29,7 +29,7 @@ import qualified Data.Map.Strict as M
 
 testStringInit :: Universe -> [String]
 testStringInit u =
-    map show (u ^.. uvWorld . cWorld . lWorld . projectiles . each . pjZVel)
+    map show (u ^.. uvWorld . cWorld . lWorld . projectiles . each . pjVel . _z)
 -- map shortShow (u ^.. uvWorld . cWorld . lWorld . debris . each . to g)
 --  where
 --    g db = (pz,z,norm v)

src/Dodge/Update/Camera.hs

@@ -6,6 +6,7 @@ module Dodge.Update.Camera (
     updateCamera,
 ) where
 
+import Linear.V3
 import Dodge.Creature.Radius
 import Bound
 import Control.Monad
@@ -96,7 +97,7 @@ moveZoomCamera cfig theinput cr w campos =
         i <- cr ^? crManipulation . manObject . imSelectedItem
         j <- cr ^? crInv . ix i . itUse . uaParams . apProjectiles . ix 0
         guard $ Just REMOTESCREEN == cr ^? crInv . ix i . itType . ibtAttach
-        w ^? cWorld . lWorld . projectiles . ix j . pjPos
+        w ^? cWorld . lWorld . projectiles . ix j . pjPos . _xy
     docamrot = rotateV (campos ^. camRot)
     offset = fromMaybe noscopeoffset $ do
         guard (SDL.ButtonRight `M.member` _mouseButtons theinput)