justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Add code for determining item orientation

Browse Source
This commit is contained in:
justin
2025-06-28 21:21:50 +01:00
parent 4f0dc64e72
commit 6af2a8cc36
7 changed files with 197 additions and 138 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/ComposedItem.hs
+4
View File
@@ -8,6 +8,8 @@ module Dodge.Data.ComposedItem where
import Dodge.Data.AmmoType
import Control.Lens
import Dodge.Data.Item
import Linear
import qualified Linear.Quaternion as Q
data ItemLink
= AmmoInLink Int AmmoType
@@ -64,4 +66,6 @@ data ItemStructuralFunction
type CItem = (Item, ItemStructuralFunction)
type OItem = (Item, ItemStructuralFunction, (V3 Float,Q.Quaternion Float))
makeLenses ''ItemLink
src/Dodge/DoubleTree.hs
+15
View File
@@ -15,6 +15,21 @@ singleLDT x = LDT x [] []
ldtToDT :: LDTree b a -> DoubleTree a
ldtToDT (LDT x l r) = DT x (map (ldtToDT . snd) l) (map (ldtToDT . snd) r)
ldtStartPropagate :: (a -> c) -> (c -> b -> a -> c) -> LDTree b a -> LDTree b c
ldtStartPropagate g f (LDT x l r) = LDT z
(fmap (\(j,t) -> (j,ldtPropagate' z j f t)) l)
(fmap (\(j,t) -> (j,ldtPropagate' z j f t)) r)
where
z = g x
ldtPropagate' :: c -> b -> (c -> b -> a -> c) -> LDTree b a -> LDTree b c
ldtPropagate' x i f (LDT y l r) = LDT z
(fmap (\(j,t) -> (j,ldtPropagate' z j f t)) l)
(fmap (\(j,t) -> (j,ldtPropagate' z j f t)) r)
where
z = f x i y
-- propagate two functions down the links of an LDT tree
-- which function is chosen depends on whether it is a left or right branch
ldtPropagate ::
src/Dodge/HeldUse.hs
+6 -2
View File
@@ -10,6 +10,7 @@ module Dodge.HeldUse (
heldEffectMuzzles,
) where
import qualified Quaternion as Q
import Color
import Control.Applicative
import Control.Monad
@@ -782,6 +783,7 @@ useLoadedAmmo itmtree cr (_, w) (Just (mz, x, magtree)) = (,) True $
MuzzleRLauncher -> createProjectileR itmtree magtree mz cr w
MuzzleGLauncher ->
createProjectile
(0, Q.qID)
(Grenade (getGrenadeHitEffect itmtree))
magtree
(getPJStabiliser itmtree)
@@ -1288,6 +1290,7 @@ createProjectileR ::
World
createProjectileR itmtree magtree =
createProjectile
(0, Q.qID)
( Rocket
(determineProjectileTracking magtree itmtree)
smoke
@@ -1315,6 +1318,7 @@ getGrenadeHitEffect t = case lookup GrenadeHitEffectLink (t ^. ldtRight) of
_ -> GBounce 2
createProjectile ::
(Point3, Q.Quaternion Float) ->
ProjectileType ->
LDTree ItemLink Item ->
Maybe PJStabiliser ->
@@ -1322,7 +1326,7 @@ createProjectile ::
Creature ->
World ->
World
createProjectile pjtype magtree stab muz cr = fromMaybe failsound $ do
createProjectile x pjtype magtree stab muz cr = fromMaybe failsound $ do
magid <- magtree ^? ldtValue . itLocation . ilInvID
ammoitem <- cr ^? crInv . ix magid
let rdetonate =
@@ -1336,7 +1340,7 @@ createProjectile pjtype magtree stab muz cr = fromMaybe failsound $ do
-- <|> ammoitem ^? itConsumables . magParams . ampPayload
<|> magAmmoParams ammoitem ^? _Just . ampPayload
return $
createShell rdetonate rscreen stab pjtype aparams muz cr
createShell x rdetonate rscreen stab pjtype aparams muz cr
. startthesound
where
-- the sound should be moved to the projectile firing
src/Dodge/Item/HeldOffset.hs
+11
View File
@@ -5,8 +5,13 @@ module Dodge.Item.HeldOffset (
heldItemOffset,
heldItemRelativeOrient,
heldItemOrient2D,
itemRelativeOrient,
) where
import Dodge.Item.Orientation
import Dodge.DoubleTree
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
import Dodge.Creature.Radius
import Dodge.Data.AimStance
import Dodge.Item.AimStance
@@ -135,3 +140,9 @@ heldHandlePos = \case
KEYCARD {} -> V2 3 0
BLINKER -> V2 3 0
BLINKERUNSAFE -> V2 3 0
itemRelativeOrient :: LocationLDT ItemLink Item -> Creature
-> (Point3, Q.Quaternion Float) -> (Point3, Q.Quaternion Float)
itemRelativeOrient loc cr
= heldItemRelativeOrient (locToTop loc ^. locLDT . ldtValue) cr
. orientLocation (V3 0 0 0,Q.qID) loc
src/Dodge/Item/Orientation.hs
+26 -7
View File
@@ -3,6 +3,7 @@
module Dodge.Item.Orientation (
orientAttachment,
orientLocation,
propagateOrientation,
) where
import Dodge.Data.ComposedItem
@@ -37,9 +38,10 @@ orientAttachment par lnk ch = case (_itType par, lnk, _itType ch) of
(t1, q1) = orientByLink par lnk
(t2, q2) = orientChild ch
orientLocation' :: (Point3,Q.Quaternion Float)
-> LocationLDT ItemLink Item
-> (Point3, Q.Quaternion Float)
orientLocation' ::
(Point3, Q.Quaternion Float) ->
LocationLDT ItemLink Item ->
(Point3, Q.Quaternion Float)
orientLocation' x = \case
(LocLDT TopLDT _) -> x
(LocLDT c t) -> (p + Q.rotate q p1, q * q1)
@@ -47,10 +49,27 @@ orientLocation' x = \case
(p, q) = orientLocation' x (LocLDT (_cldtUp c) (singleLDT (_cldtParent c)))
(p1, q1) = orientAttachment (_cldtParent c) (_cldtLink c) (_ldtValue t)
orientLocation ::
(Point3, Q.Quaternion Float) ->
LocationLDT ItemLink Item
-> (Point3, Q.Quaternion Float) -> (Point3, Q.Quaternion Float)
orientLocation ::
(Point3, Q.Quaternion Float) ->
LocationLDT ItemLink Item ->
(Point3, Q.Quaternion Float) ->
(Point3, Q.Quaternion Float)
orientLocation x loc (p1, q1) = (p + Q.rotate q p1, q * q1)
where
(p, q) = orientLocation' x loc
propagateOrientation :: LDTree ItemLink CItem
-> LDTree ItemLink OItem
propagateOrientation = ldtStartPropagate g f
where
g (x,y) = (x,y,(V3 0 0 0,Q.qID))
f (x,_,(p,q)) i (y,y1) = let (p1,q1) = orientAttachment x i y
in (y,y1,(p + Q.rotate q p1, q * q1))
--propagateOrientation' :: LDTree ItemLink Item
-- -> LDTree ItemLink (Item, (Point3, Q.Quaternion Float))
--propagateOrientation' = ldtStartPropagate g f
-- where
-- g x = (x,(V3 0 0 0,Q.qID))
-- f (x,(p,q)) i y = let (p1,q1) = orientAttachment x i y
-- in (y,(p + Q.rotate q p1, q * q1))
src/Dodge/Projectile/Create.hs
+4 -2
View File
@@ -6,6 +6,7 @@ module Dodge.Projectile.Create (
--import Dodge.Data.ComposedItem
--import Dodge.Data.DoubleTree
import qualified Quaternion as Q
import Dodge.Data.Muzzle
import Data.Maybe
import Dodge.Data.World
@@ -21,6 +22,7 @@ data PJStabiliser
-- assumes the mscreen is in your inventory
createShell ::
(Point3, Q.Quaternion Float) ->
Maybe (NewInt ItmInt) ->
Maybe (NewInt ItmInt) ->
Maybe PJStabiliser ->
@@ -30,7 +32,7 @@ createShell ::
Creature ->
World ->
World
createShell mdetonator mscreen stab pjtype payload muz cr w =
createShell (p,q) mdetonator mscreen stab pjtype payload muz cr w =
w
& updatescreen
& updatedetonator
@@ -91,4 +93,4 @@ createShell mdetonator mscreen stab pjtype payload muz cr w =
.:~ i
i = IM.newKey $ w ^. cWorld . lWorld . projectiles
dir = _crDir cr + _mzRot muz
pos = _crPos cr +.+ rotateV dir (_mzPos muz)
pos = _crPos cr + xyV3 p + rotateV dir (_mzPos muz)