From 8df6b310623880511941e9b229f995ed039fd549 Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 1 Oct 2024 20:13:08 +0100 Subject: [PATCH] Move towards being able to orient positions on attached items --- ghcidOutput | 100 +-------------------------------- src/Dodge/Data/Item/Effect.hs | 1 + src/Dodge/ItEffect.hs | 15 ++--- src/Dodge/Item/Grammar.hs | 50 ++++------------- src/Dodge/Item/Held/Utility.hs | 4 +- src/Dodge/Item/HeldOffset.hs | 75 +++++++++---------------- src/Dodge/Item/Orientation.hs | 1 + src/Dodge/LightSource/Torch.hs | 10 +++- src/Quaternion.hs | 4 ++ 9 files changed, 61 insertions(+), 199 deletions(-) diff --git a/ghcidOutput b/ghcidOutput index a0c074b35..308c26c1b 100644 --- a/ghcidOutput +++ b/ghcidOutput @@ -1,99 +1 @@ -/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:25:9: warning: [-Wname-shadowing] - This binding for ‘x’ shadows the existing binding - bound at /home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:23:12 - | -25 | noa x y = (x, ILink y orientAttachment) - | ^ -/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:25:11: warning: [-Wname-shadowing] - This binding for ‘y’ shadows the existing binding - bound at /home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:23:14 - | -25 | noa x y = (x, ILink y orientAttachment) - | ^ -/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:93:5-7: warning: [-Wunused-local-binds] - Defined but not used: ‘noa’ - | -93 | noa x y = (x, ILink y orientAttachment) - | ^^^ -/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:94:5-11: warning: [-Wunused-local-binds] - Defined but not used: ‘nolinks’ - | -94 | nolinks x = (itm, x, LTest (const Nothing) (const Nothing)) - | ^^^^^^^ -/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:95:5-11: warning: [-Wunused-local-binds] - Defined but not used: ‘isolate’ - | -95 | isolate = (itm, UncomposableIsolateSF, LTest (const Nothing) (const Nothing)) - | ^^^^^^^ -/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:98:1-17: warning: [-Wunused-top-binds] - Defined but not used: ‘ammoComposedItem'’ - | -98 | ammoComposedItem' itm = fromMaybe (error "in ammoComposedItem, wrong item") $ do - | ^^^^^^^^^^^^^^^^^ -/home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:26:1: warning: [-Wunused-top-binds] - Defined but not used: ‘heldItemRelativeOrient’ - | -26 | heldItemRelativeOrient itm cr (p,q) - | ^^^^^^^^^^^^^^^^^^^^^^ -/home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:44:5: warning: [-Wunused-local-binds] - Defined but not used: ‘handD’ - | -44 | handD = 15 - | ^^^^^ -/home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:44:13: warning: [-Wtype-defaults] - • Defaulting the following constraint to type ‘Integer’ - Num p0 arising from the literal ‘15’ - • In the expression: 15 - In an equation for ‘handD’: handD = 15 - In an equation for ‘heldItemRelativeOrient’: - heldItemRelativeOrient itm cr (p, q) - | _posture (_crStance cr) == Aiming = (p, q) - | isTwoHandFlat = (p, q) - | isOneHand = (p, q) - | otherwise = (p, q) - where - handD = 15 - handPos - = case cr ^? crStance . carriage of - Just (Walking x LeftForward) -> f x * 50 - _ -> 0 - isOneHand - = itm ^? itUseAimStance == Just OneHand - || isNothing (itm ^? itUseAimStance) - isTwoHandFlat = itm ^? itUseAimStance == Just TwoHandFlat - .... - | -44 | handD = 15 - | ^^ -/home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:45:5: warning: [-Wunused-local-binds] - Defined but not used: ‘handPos’ - | -45 | handPos = case cr ^? crStance . carriage of - | ^^^^^^^ -/home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:46:45: warning: [-Wtype-defaults] - • Defaulting the following constraints to type ‘Double’ - (Num a0) - arising from a use of ‘*’ - at /home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:46:45 - (Fractional a0) - arising from a use of ‘f’ - at /home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:46:41-43 - • In the expression: f x * 50 - In a case alternative: Just (Walking x LeftForward) -> f x * 50 - In the expression: - case cr ^? crStance . carriage of - Just (Walking x LeftForward) -> f x * 50 - _ -> 0 - | -46 | Just (Walking x LeftForward) -> f x * 50 - | ^ -/home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:53:5: warning: [-Wunused-local-binds] - Defined but not used: ‘f’ - | -53 | f i = 0.1 * fromIntegral (sLen - i) / fromIntegral sLen - | ^ -/home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:54:5: warning: [-Wunused-local-binds] - Defined but not used: ‘sLen’ - | -54 | sLen = _strideLength $ _crStance cr - | ^^^^ +All good (605 modules, at 20:13:06) diff --git a/src/Dodge/Data/Item/Effect.hs b/src/Dodge/Data/Item/Effect.hs index 553331b55..b449dd2d4 100644 --- a/src/Dodge/Data/Item/Effect.hs +++ b/src/Dodge/Data/Item/Effect.hs @@ -26,6 +26,7 @@ data ItInvEffect | CreateShieldWall | RemoveShieldWall | EffectWhileRoot ItInvEffect + | EffectWhileAttached ItInvEffect deriving (Eq, Ord, Show, Read) --Generic, Flat) data ItFloorEffect = NoFloorEffect diff --git a/src/Dodge/ItEffect.hs b/src/Dodge/ItEffect.hs index 4973e6a4c..e4a0049e6 100644 --- a/src/Dodge/ItEffect.hs +++ b/src/Dodge/ItEffect.hs @@ -17,6 +17,7 @@ doInvEffect iie = case iie of CreateShieldWall -> createShieldWall RemoveShieldWall -> removeShieldWall EffectWhileRoot f -> rootNotrootEff f NoInvEffect + EffectWhileAttached f -> effectWhileAttached f doFloorEffect :: ItFloorEffect -> Int -> World -> World doFloorEffect NoFloorEffect = const id @@ -26,6 +27,11 @@ rootNotrootEff f g it | it ^? itLocation . ilIsRoot == Just True = doInvEffect f it | otherwise = doInvEffect g it +effectWhileAttached :: ItInvEffect -> Item -> Creature -> World -> World +effectWhileAttached f it + | it ^? itLocation . ilIsAttached == Just True = doInvEffect f it + | otherwise = const id + --timeScrollEffect :: Item -> Creature -> World -> World --timeScrollEffect itm _ w = w & timeFlow .~ ScrollTimeFlow -- { _scrollSmoothing = 0 @@ -58,14 +64,5 @@ chargeIfEquipped itm cr ptrWpCharge = cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge maxcharge = itm ^?! itUse . leftConsumption . wpMaxCharge ---resetAttachmentEffect :: Item -> Creature -> World -> World ---resetAttachmentEffect itm cr w --- | _ieCounter iteff < 0 = w & pointToIt . itAttachment .~ NoItAttachment --- | otherwise = w & pointToIt . itEffect . ieCounter -~ 1 --- where --- iteff = _itEffect itm --- invid = _ipInvID $ _itLocation itm --- pointToIt = cWorld . creatures . ix (_crID cr) . crInv . ix invid - createHeldLight :: Item -> Creature -> World -> World createHeldLight itm cr = createTorchLightOffset cr itm 0 diff --git a/src/Dodge/Item/Grammar.hs b/src/Dodge/Item/Grammar.hs index c8fa06bd6..b5502227a 100644 --- a/src/Dodge/Item/Grammar.hs +++ b/src/Dodge/Item/Grammar.hs @@ -22,7 +22,7 @@ useBreakL' :: [(ItemStructuralFunction, ComposeLinkType)] -> [(ItemStructuralFun -> LinkTest ItemLink useBreakL' x y = useBreakListsLinkTest (map (uncurry noa) x) (map (uncurry noa) y) where - noa x y = (x, ILink y orientAttachment) + noa a b = (a, ILink b orientAttachment) useBreakListsLinkTest :: [(ItemStructuralFunction, a)] -> [(ItemStructuralFunction, a)] -> LinkTest a @@ -40,12 +40,10 @@ useBreakListsLinkTest llist rlist = LTest ltest rtest itemToBreakLists :: Item -> ([(ItemStructuralFunction, ComposeLinkType)] , [(ItemStructuralFunction, ComposeLinkType)]) itemToBreakLists itm = case itm ^. itType of + HELD TORCH -> (getAmmoLinks itm,[]) HELD {} -> - ( map - (\(i, a) -> (AmmoMagSF a,AmmoInLink i a)) - (IM.toList $ itm ^. itUse . heldAmmoTypes) - , - [(WeaponTargetingSF,WeaponTargetingLink), (WeaponScopeSF,WeaponScopeLink)] + ( getAmmoLinks itm + , [(WeaponTargetingSF,WeaponTargetingLink), (WeaponScopeSF,WeaponScopeLink)] ) AMMOMAG {} -> fromMaybe ([],[]) $ do atype <- itm ^? itUse . amagType @@ -59,8 +57,14 @@ itemToBreakLists itm = case itm ^. itType of TARGETING{} -> ([(AugmentedHUDSF,AugmentedHUDLink)],[]) _ -> ([],[]) +getAmmoLinks :: Item -> [(ItemStructuralFunction, ComposeLinkType)] +getAmmoLinks itm = map + (\(i, a) -> (AmmoMagSF a,AmmoInLink i a)) + (IM.toList $ itm ^. itUse . heldAmmoTypes) + itemToFunction :: Item -> ItemStructuralFunction itemToFunction itm = case itm ^. itType of + HELD TORCH -> WeaponScopeSF HELD {} -> WeaponPlatformSF AMMOMAG {} -> maybe UncomposableIsolateSF AmmoMagSF $ itm ^? itUse . amagType ATTACH REMOTESCREEN -> RemoteScreenSF @@ -78,39 +82,7 @@ simplePCI :: Item -> PartiallyComposedItem ItemLink simplePCI itm = (itm, itemToFunction itm, uncurry useBreakL' $ itemToBreakLists itm) basePartiallyComposedItem' :: Item -> PartiallyComposedItem ItemLink -basePartiallyComposedItem' itm = case itm ^. itType of --- AMMOMAG _ -> ammoComposedItem' itm --- TARGETING{} -> (itm, WeaponTargetingSF, useBreakListsLinkTest [noa AugmentedHUDSF AugmentedHUDLink] []) --- ATTACH REMOTESCREEN -> nolinks RemoteScreenSF --- ATTACH BULLETSYNTHESIZER -> (itm, AmmoModifierSF BulletAmmo, LTest (const Nothing) (const Nothing)) --- LEFT{} -> isolate --- EQUIP{} -> isolate --- CONSUMABLE{} -> isolate --- CRAFT{} -> isolate - _ -> simplePCI itm - where - - noa x y = (x, ILink y orientAttachment) - nolinks x = (itm, x, LTest (const Nothing) (const Nothing)) - isolate = (itm, UncomposableIsolateSF, LTest (const Nothing) (const Nothing)) - -ammoComposedItem' :: Item -> PartiallyComposedItem ItemLink -ammoComposedItem' itm = fromMaybe (error "in ammoComposedItem, wrong item") $ do - atype <- itm ^? itUse . amagType - return - ( itm - , AmmoMagSF atype - , useBreakListsLinkTest - [ noa (AmmoModifierSF atype) AmmoModLink - , noa (AmmoTargetingSF atype) AmmoTargetingLink - , noa (AmmoPayloadSF atype) AmmoPayloadLink - , noa (AmmoEffectSF atype) AmmoEffectLink - , noa RemoteScreenSF RemoteScreenLink - ] - [] - ) - where - noa x y = (x, ILink y orientAttachment) +basePartiallyComposedItem' itm = simplePCI itm type LDTComb a b = LabelDoubleTree b a -> LabelDoubleTree b a -> Maybe (LabelDoubleTree b a) diff --git a/src/Dodge/Item/Held/Utility.hs b/src/Dodge/Item/Held/Utility.hs index d8b8597c4..7ef3656b6 100644 --- a/src/Dodge/Item/Held/Utility.hs +++ b/src/Dodge/Item/Held/Utility.hs @@ -26,10 +26,10 @@ latchkey _ = defaultHeldItem torch :: Item torch = defaultHeldItem - & itEffect . ieInv .~ EffectWhileRoot CreateHeldLight + & itEffect . ieInv .~ EffectWhileAttached CreateHeldLight & itType .~ HELD TORCH - -- & itUse . heldAim . aimHandlePos .~ 5 & itUse . heldAim . aimMuzzles . ix 0 . mzPos . _x .~ 10 + & itUse . heldAmmoTypes .~ singleAmmo ElectricalAmmo {- | Sends out pulses that display walls. diff --git a/src/Dodge/Item/HeldOffset.hs b/src/Dodge/Item/HeldOffset.hs index 7e3a91fb8..86f574b1d 100644 --- a/src/Dodge/Item/HeldOffset.hs +++ b/src/Dodge/Item/HeldOffset.hs @@ -2,9 +2,10 @@ module Dodge.Item.HeldOffset ( turretItemOffset, twoFlatHRot, heldItemOffset, + heldItemRelativeOrient, ) where -import qualified Linear.Quaternion as Q +import qualified Quaternion as Q import Data.Maybe import Dodge.Creature.HandPos import Dodge.Data.Creature @@ -22,24 +23,33 @@ transToHandle itm = fromMaybe id $ do V2 x y <- itm ^? itUse . heldAim . aimHandlePos return (-.-.- V3 x y 0) +-- there is a lot of duplication going on here, and also need to check +-- rotations heldItemRelativeOrient :: Item -> Creature -> (Point3, Q.Quaternion Float) -> (Point3, Q.Quaternion Float) heldItemRelativeOrient itm cr (p,q) - | _posture (_crStance cr) == Aiming = (p,q) - | isTwoHandFlat = (p,q) --- (+.+.+ V3 (_crRad cr) 0 handD) --- . rotate3 (twoFlatHRot cr) --- . transToHandle itm - | isOneHand = (p,q) --- (+.+.+ V3 0 0 handD) --- . (+.+.+ V3 (_crRad cr * 0.7 + handPos) (_crRad cr * negate 0.7) 0) --- . (+.+.+ V3 (-2) 0 0) --- . transToHandle itm - | otherwise = (p,q) --- (+.+.+ V3 0 0 handD) --- . (+.+.+ V3 (_crRad cr) 0 0) --- . rotate3 (strideRot cr + 1.2) --- . (+.+.+ V3 (-8) 0 0) --- . transToHandle itm + | _posture (_crStance cr) == Aiming = + (p +.+.+ aimingWeaponZeroPos cr itm `v2z` shoulderHeight, Q.qID * q) + | isTwoHandFlat = + ( (+.+.+ V3 (_crRad cr) 0 handD) + . rotate3 (twoFlatHRot cr) + $ transToHandle itm p + , (Q.axisAngle (V3 0 0 1) (twoFlatHRot cr)) * q + ) + | isOneHand = + ( (+.+.+ V3 0 0 handD) + . (+.+.+ V3 (_crRad cr * 0.7 + handPos) (_crRad cr * negate 0.7) 0) + . (+.+.+ V3 (-2) 0 0) + $ transToHandle itm p + , Q.qID * q + ) + | otherwise = + ( (+.+.+ V3 0 0 handD) + . (+.+.+ V3 (_crRad cr) 0 0) + . rotate3 (strideRot cr + 1.2) + . (+.+.+ V3 (-8) 0 0) + $ transToHandle itm p + , (Q.axisAngle (V3 0 0 1) (strideRot cr + 1.2)) * q + ) where handD = 15 handPos = case cr ^? crStance . carriage of @@ -54,36 +64,7 @@ heldItemRelativeOrient itm cr (p,q) sLen = _strideLength $ _crStance cr heldItemOffset :: Item -> Creature -> Point3 -> Point3 -heldItemOffset itm cr - | _posture (_crStance cr) == Aiming = - (+.+.+ aimingWeaponZeroPos cr itm `v2z` shoulderHeight) - | isTwoHandFlat = - (+.+.+ V3 (_crRad cr) 0 handD) - . rotate3 (twoFlatHRot cr) - . transToHandle itm - | isOneHand = - (+.+.+ V3 0 0 handD) - . (+.+.+ V3 (_crRad cr * 0.7 + handPos) (_crRad cr * negate 0.7) 0) - . (+.+.+ V3 (-2) 0 0) - . transToHandle itm - | otherwise = - (+.+.+ V3 0 0 handD) - . (+.+.+ V3 (_crRad cr) 0 0) - . rotate3 (strideRot cr + 1.2) - . (+.+.+ V3 (-8) 0 0) - . transToHandle itm - where - handD = 15 - handPos = case cr ^? crStance . carriage of - Just (Walking x LeftForward) -> f x * 50 - _ -> 0 - isOneHand = - itm ^? itUseAimStance == Just OneHand - || isNothing (itm ^? itUseAimStance) - isTwoHandFlat = itm ^? itUseAimStance == Just TwoHandFlat - itUseAimStance = itUse . heldAim . aimStance - f i = 0.1 * fromIntegral (sLen - i) / fromIntegral sLen - sLen = _strideLength $ _crStance cr +heldItemOffset itm cr p = fst (heldItemRelativeOrient itm cr (p,Q.qID)) shoulderHeight :: Float shoulderHeight = 18 diff --git a/src/Dodge/Item/Orientation.hs b/src/Dodge/Item/Orientation.hs index 4c42e830f..5f875a727 100644 --- a/src/Dodge/Item/Orientation.hs +++ b/src/Dodge/Item/Orientation.hs @@ -16,6 +16,7 @@ orientByLink :: Item -> ComposeLinkType -> (Point3, Q.Quaternion Float) orientByLink itm lt = case (_itType itm,lt) of (HELD FLAMETHROWER, AmmoInLink{}) -> (V3 4 (-6) 0, Q.axisAngle (V3 1 0 0) 0) (HELD _,AmmoInLink{}) -> (V3 7 (-2) 0, Q.axisAngle (V3 1 0 0) 0) + (HELD _,WeaponScopeLink) -> (V3 5 0 5, Q.axisAngle (V3 1 0 0) 0) _ -> (0,Q.axisAngle (V3 1 0 0) 0) orientAttachment :: Item -> ComposeLinkType -> Item -> Maybe (Point3, Q.Quaternion Float) diff --git a/src/Dodge/LightSource/Torch.hs b/src/Dodge/LightSource/Torch.hs index 834c91148..f899605e6 100644 --- a/src/Dodge/LightSource/Torch.hs +++ b/src/Dodge/LightSource/Torch.hs @@ -1,5 +1,7 @@ module Dodge.LightSource.Torch where +import Color +import Dodge.WorldEvent.Flash import Dodge.Data.World import Dodge.Item.Draw -- heldItemOffset needs to be moved somewhere more sensible import Dodge.LightSource -- this needs to be split! @@ -7,12 +9,14 @@ import Geometry import LensHelp createTorchLightOffset :: Creature -> Item -> Point3 -> World -> World -createTorchLightOffset cr it off = - cWorld . lWorld . tempLightSources +createTorchLightOffset cr it off = muzFlareAt yellow pos (_crDir cr) . + (cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 250 0.7 - (p +.+.+ rotate3 (_crDir cr) (heldItemOffset it cr (off +.+.+ V3 8 0 1.5))) + pos + ) where + pos = (p +.+.+ rotate3 (_crDir cr) (heldItemOffset it cr (off +.+.+ V3 8 0 1.5))) p = addZ 0 $ _crPos cr diff --git a/src/Quaternion.hs b/src/Quaternion.hs index d8fa99e88..f69895052 100644 --- a/src/Quaternion.hs +++ b/src/Quaternion.hs @@ -10,6 +10,7 @@ WARNING: orphan instances concerning Aeson classes and Linear.Quaternion datatyp The warnings have been disabled. -} module Quaternion ( + qID, rotateToZ, vToQuat, module Linear.Quaternion, @@ -42,4 +43,7 @@ vToQuat a b where cprod = crossProd a b +qID :: Q.Quaternion Float +qID = Q.axisAngle (V3 1 0 0) 0 + --deriving instance (Flat a => Flat (Quaternion a))