Add check to cylinder segment collision, break rocket projectiles

src/Dodge/HeldUse.hs

@@ -732,7 +732,8 @@ useLoadedAmmo loc cr mz m w =
         MuzzleRLauncher -> createProjectileR loc magtree mz cr w
         MuzzleGLauncher ->
             createProjectile
-                (itmtree ^. dtValue . _3)
+                pq
+--                (itmtree ^. dtValue . _3)
                 (Grenade (getGrenadeHitEffect itmtree))
                 magtree
                 (getPJStabiliser itmtree)
@@ -754,11 +755,21 @@ useLoadedAmmo loc cr mz m w =
         MuzzleStopper -> useStopWatch itm cr w
         MuzzleScroller -> useTimeScrollGun itm cr w
   where
+    pq = muzzlePos loc cr mz
     itmtree = loc ^. locDT
     mitid = magtree ^. dtValue . _1 . itID
     itm = itmtree ^. dtValue . _1
     (x, magtree) = fromJust m
 
+muzzlePos :: LocationDT OItem -> Creature -> Muzzle -> Point3Q
+muzzlePos m cr muz = (p1,q1) `Q.comp` pq `Q.comp` (p3,q3)
+  where
+    pq = locOrient m cr
+    p1 = cr ^. crPos
+    q1 = Q.qz $ cr ^. crDir
+    p3 = addZ 0 $ muz ^. mzPos
+    q3 = Q.qz $ muz ^. mzRot
+
 getAttachedSFLink :: ItemSF -> DTree OItem -> Maybe (NewInt ItmInt)
 getAttachedSFLink sf = (^? dtRight . folding (find f) . dtValue . _1 . itID)
   where

src/Dodge/Item/HeldOffset.hs

@@ -61,10 +61,9 @@ locOrient loc cr =
 
 handHandleOrient :: LocationDT CItem -> Creature -> Point3Q
 handHandleOrient loc cr =
-    handOrient cr (itemAimStance (loc' ^. locDT))
-        `Q.comp` handleOrient loc'
+    handOrient cr (itemAimStance (l ^. locDT)) `Q.comp` handleOrient l
   where
-    loc' = locToTop loc
+    l = locToTop loc
 
 shoulderHeight :: Float
 shoulderHeight = 18

src/Dodge/Projectile/Create.hs

@@ -36,10 +36,13 @@ createShell (p,q) mdetonator mscreen stab pjtype payload muz cr w =
         & updatedetonator
         & cWorld . lWorld . projectiles . at i
             ?~ Shell
-                { _pjPos = pos
-                , _pjVel = (rotateV dir' (V2 speed 0) + crvelcomponent) `v2z` 0
+--                { _pjPos = pos
+                { _pjPos = p
+--                , _pjVel = (rotateV dir' (V2 speed 0) + crvelcomponent) `v2z` 0
+                , _pjVel = (rotateV ddd (V2 speed 0) + crvelcomponent) `v2z` 0
                 , _pjID = i
-                , _pjDir = dir'
+--                , _pjDir = dir'
+                , _pjDir = ddd
                 , _pjSpin = 0
                 , _pjPayload = payload
                 , _pjTimer = lifespan
@@ -49,6 +52,7 @@ createShell (p,q) mdetonator mscreen stab pjtype payload muz cr w =
                 , _pjScreenID = mscreen
                 }
   where
+    ddd = Q.qToAng q 
     crvelcomponent = case stab of
         Just StabOrthReduce -> projV (cr ^. crPos . _xy - cr ^. crOldPos . _xy) (unitVectorAtAngle dir)
         _ -> (cr ^. crPos - cr ^. crOldPos) ^. _xy

src/Dodge/Projectile/Draw.hs

@@ -33,7 +33,7 @@ drawShell mcol pj =
             mcol
 
 shellShape :: Shape
-shellShape = colorSH black $ upperPrismPoly Small Typical 4 $ map toV2 [(-6, 4), (-6, -4), (6, -4), (8, 0), (6, 4)]
+shellShape = colorSH (greyN 0.5) $ upperPrismPoly Small Typical 4 $ map toV2 [(-6, 4), (-6, -4), (6, -4), (8, 0), (6, 4)]
 
 drawRemoteShell :: Projectile -> SPic
 drawRemoteShell pj

src/Dodge/Projectile/Update.hs

@@ -2,6 +2,11 @@
 --{-# OPTIONS_GHC -Wno-unused-imports #-}
 module Dodge.Projectile.Update (updateProjectile) where
 
+import Linear
+import Dodge.Render.List
+import Dodge.Render.Label
+import ShortShow
+import Picture.Base
 import Control.Monad
 import Data.List (delete)
 import Data.Maybe
@@ -18,8 +23,6 @@ import Dodge.WorldEvent.Sound
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
-import Linear.Metric
-import Linear.V3
 import NewInt
 import RandomHelp
 
@@ -257,16 +260,28 @@ moveStuckGrenade cid poff d pj w
         w & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjType .~ Grenade GStick
 
 moveProjectile :: Projectile -> World -> World
-moveProjectile pj w
+moveProjectile pj w = moveProjectile' pj w
+    & cWorld . lWorld . flares <>~
+    (setLayer DebugLayer
+    $ color red $ line [p, (p +v)]
+    )
+  where
+    p = pj^. pjPos . _xy
+    v = pj^. pjVel . _xy
+
+
+moveProjectile' :: Projectile -> World -> World
+moveProjectile' pj w
     | Just GStuckWall{} <- pj ^? pjType . gnHitEffect = w
     | Just (GStuckCreature crid poff d) <- pj ^? pjType . gnHitEffect =
         moveStuckGrenade crid poff d pj w
-    | (p, Just (n, OWall wl)) <- collide3 sp (sp + _pjVel pj) w =
+    | (p, Just (n, OWall wl)) <- collide3 sp (sp + 2 *^ _pjVel pj) w =
         shellHitWall p n wl pj w
-    | (p, Just (_, OFloor)) <- collide3 sp (sp + _pjVel pj) w =
+    | (p, Just (_, OFloor)) <- collide3 sp (sp + 2*^ _pjVel pj) w =
         shellHitFloor p pj w
     | (p, Just (_, OCreature cr)) <- collide3 sp (sp + _pjVel pj) w =
         shellHitCreature p cr pj w
+            & cWorld . lWorld . flares <>~ test p cr w sp (_pjVel pj)
     | (_, Just (_, OChasmWall)) <- collide3 sp (sp + _pjVel pj) w =
         -- no stick or bounce for now
         w & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjTimer .~ 0
@@ -278,6 +293,30 @@ moveProjectile pj w
   where
     sp = _pjPos pj
 
+test p cr w sp v = 
+    (setLayer FixedCoordLayer
+    $ uncurryV translate (worldPosToScreen (w ^. wCam) (p ^. _xy))
+        $ drawList [text (shortShow p),text $shortShow sp, text $ shortShow $ sp + 2*v, text $ shortShow v]
+         <> color white (crossPic 5)
+    ) <> 
+    (setLayer DebugLayer
+    $ uncurryV translate (p ^. _xy)
+        $ ( scale 0.1 0.1
+        $ stackPicturesAt
+        [ text $ shortShow p
+        , text $ shortShow sp
+        , text $ shortShow (sp + v)
+        ]
+    ) <> color green (crossPic 5)
+    ) <> 
+    setLayer DebugLayer
+    (uncurryV translate (cr ^. crPos . _xy)
+    $ circle 10
+    ) <> 
+    (setLayer DebugLayer
+    $ color red $ line [sp^. _xy, (sp +v)^._xy]
+    )
+
 explodeShell :: Projectile -> World -> World
 explodeShell pj w =
     w