diff --git a/ghcidOutput b/ghcidOutput index 1075d70b5..858c74d87 100644 --- a/ghcidOutput +++ b/ghcidOutput @@ -1,15 +1 @@ -/home/justin/Haskell/loop/src/Dodge/ItEffect.hs:67:17-19: warning: [-Wunused-matches] - Defined but not used: ‘itm’ - | -67 | createHeldLight itm cr = id - | ^^^ -/home/justin/Haskell/loop/src/Dodge/ItEffect.hs:67:21-22: warning: [-Wunused-matches] - Defined but not used: ‘cr’ - | -67 | createHeldLight itm cr = id - | ^^ -/home/justin/Haskell/loop/src/Dodge/Creature/State.hs:202:14-16: warning: [-Wunused-matches] - Defined but not used: ‘itm’ - | -202 | testtorch cr itm (p,q) = --createTorchLightOffset cr itm pos' . - | ^^^ +All good (602 modules, at 23:49:54) diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 2e4eb95a6..c29743d20 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -280,6 +280,7 @@ testInventory = stackedInventory :: [Item] stackedInventory = [ torch + , torch , remoteScreen , megaShellMag , targetingScope TARGETLASER diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index aafbb7257..f59ee0996 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -4,7 +4,6 @@ module Dodge.Creature.State ( ) where import Dodge.LightSource -import Dodge.WorldEvent.Flash import qualified Data.Map.Strict as M import Data.Maybe import Data.Monoid @@ -174,7 +173,7 @@ updateRootItem cr = fromMaybe id $ do updateRootItem' :: LabelDoubleTree ItemLink Item -> Creature -> World -> World updateRootItem' itmtree cr = - ldtPropagateFold + ldtPropagateFoldTree chainLinkOrientation chainLinkOrientation (updateItemWithOrientation cr) @@ -193,21 +192,31 @@ chainLinkOrientation mo par (ILink lt f) child = (p + Q.rotate q p1, q * q1) (p, q) = mo (p1, q1) = f par lt child -updateItemWithOrientation :: Creature -> (Point3, Q.Quaternion Float) -> Item -> World -> World -updateItemWithOrientation cr m itm = case _itType itm of - HELD TORCH -> testtorch cr itm m +updateItemWithOrientation :: Creature -> (Point3, Q.Quaternion Float) + -> LabelDoubleTree ItemLink Item + -> World -> World +updateItemWithOrientation cr m itmtree = case _itType itm of + HELD TORCH -> shineTorch cr itmtree m _ -> id - -testtorch :: Creature -> Item -> (Point3, Q.Quaternion Float) -> World -> World -testtorch cr itm (p,q) = --createTorchLightOffset cr itm pos' . - muzFlareAt yellow pos'' d - .( cWorld . lWorld . tempLightSources .:~ - tlsTimeRadColPos 1 250 0.7 pos'' - ) where - --pos = (_crPos cr `v2z` 0 + rotate3 cdir p) + itm = itmtree ^. ldtValue + + + +shineTorch :: Creature -> LabelDoubleTree ItemLink Item -> (Point3, Q.Quaternion Float) -> World -> World +shineTorch cr itmtree (p,q) = fromMaybe id $ do + (_,mag) <- find (isammolink . _iatType . fst) (itmtree ^. ldtLeft) + i <- mag ^? ldtValue . itUse . amagLoadStatus . iaLoaded + guard $ i >= x + invid <- mag ^? ldtValue . itLocation . ilInvID + return $ + (cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 250 0.7 pos'') + . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . amagLoadStatus . iaLoaded -~ x) + where + x = 10 + isammolink AmmoInLink{} = True + isammolink _ = False pos = (_crPos cr `v2z` 0 + rotate3 cdir p) - --pos'' = pos pos'' = pos + rotate3 d (V3 8 0 1.5) cdir = _crDir cr a = argV (Q.qToV2 q) diff --git a/src/Dodge/Data/Item/Effect.hs b/src/Dodge/Data/Item/Effect.hs index b449dd2d4..007c7cac3 100644 --- a/src/Dodge/Data/Item/Effect.hs +++ b/src/Dodge/Data/Item/Effect.hs @@ -22,21 +22,16 @@ data ItInvEffect | ChargeIfInInventory | SetCharge Int | EffectRootNotroot ItInvEffect ItInvEffect - | CreateHeldLight | CreateShieldWall | RemoveShieldWall | EffectWhileRoot ItInvEffect | EffectWhileAttached ItInvEffect deriving (Eq, Ord, Show, Read) --Generic, Flat) -data ItFloorEffect = NoFloorEffect - deriving (Eq, Ord, Show, Read) --Generic, Flat) - data ItDropEffect = NoDropEffect deriving (Eq, Ord, Show, Read) --Generic, Flat) makeLenses ''ItEffect deriveJSON defaultOptions ''ItInvEffect -deriveJSON defaultOptions ''ItFloorEffect deriveJSON defaultOptions ''ItDropEffect deriveJSON defaultOptions ''ItEffect diff --git a/src/Dodge/Default/Item.hs b/src/Dodge/Default/Item.hs index 725a485c2..4f0540082 100644 --- a/src/Dodge/Default/Item.hs +++ b/src/Dodge/Default/Item.hs @@ -1,13 +1,11 @@ module Dodge.Default.Item ( module Dodge.Default.Item, module Dodge.Default.Item.Use, - module Dodge.Default.Item.Effect, ) where import qualified Data.IntMap.Strict as IM import Control.Lens import Dodge.Data.Item -import Dodge.Default.Item.Effect import Dodge.Default.Item.Use import Geometry.Data @@ -48,3 +46,10 @@ defaultBulletWeapon = defaultHeldItem defaultConsumable :: Item defaultConsumable = defaultHeldItem & itUse .~ UseConsume CDoNothing +defaultItEffect :: ItEffect +defaultItEffect = + ItEffect + { _ieInv = NoInvEffect + , _ieOnInsert = NoInvEffect + , _ieOnDrop = NoInvEffect + } diff --git a/src/Dodge/Default/Item/Effect.hs b/src/Dodge/Default/Item/Effect.hs deleted file mode 100644 index 6d25a84d1..000000000 --- a/src/Dodge/Default/Item/Effect.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Dodge.Default.Item.Effect - where -import Dodge.Data.Item.Effect - -defaultItEffect :: ItEffect -defaultItEffect = - ItEffect - { _ieInv = NoInvEffect - , _ieOnInsert = NoInvEffect - , _ieOnDrop = NoInvEffect - } diff --git a/src/Dodge/Default/Item/Use/AimParams.hs b/src/Dodge/Default/Item/Use/AimParams.hs index e6f955aed..742309906 100644 --- a/src/Dodge/Default/Item/Use/AimParams.hs +++ b/src/Dodge/Default/Item/Use/AimParams.hs @@ -1,4 +1,7 @@ -module Dodge.Default.Item.Use.AimParams where +module Dodge.Default.Item.Use.AimParams ( + defaultAimParams, + defaultItZoom, +) where import Dodge.Data.Item.Use import Linear diff --git a/src/Dodge/DoubleTree.hs b/src/Dodge/DoubleTree.hs index c7db6d7e0..7dc11f86e 100644 --- a/src/Dodge/DoubleTree.hs +++ b/src/Dodge/DoubleTree.hs @@ -38,6 +38,22 @@ ldtPropagateFold lf rf up x (LDT v l r) = . alaf Endo foldMap (\(s,y) -> ldtPropagateFold lf rf up (lf x v s (_ldtValue y)) y) l . up x v +-- Propgates a value (of type c) down the branches of the LDT. +-- The value is updated according a "left" or "right" function (lf or rf), +-- that acts on the parent value, the link, and the child value. +-- For each node-tree, the updated value is used to update a final value (of type d). +ldtPropagateFoldTree :: (c -> a -> b -> a -> c) + -> (c -> a -> b -> a -> c) + -> (c -> LabelDoubleTree b a -> d -> d) + -> c + -> LabelDoubleTree b a + -> d + -> d +ldtPropagateFoldTree lf rf up x t@(LDT v l r) = + alaf Endo foldMap (\(s,y) -> ldtPropagateFoldTree lf rf up (rf x v s (_ldtValue y)) y) r + . alaf Endo foldMap (\(s,y) -> ldtPropagateFoldTree lf rf up (lf x v s (_ldtValue y)) y) l + . up x t + ildtPropagate :: (Int -> c -> b -> c) -> (Int -> c -> b -> c) -> c -> LabelDoubleTree b a -> LabelDoubleTree c a diff --git a/src/Dodge/ItEffect.hs b/src/Dodge/ItEffect.hs index 7bdf1754b..7d3e41ab7 100644 --- a/src/Dodge/ItEffect.hs +++ b/src/Dodge/ItEffect.hs @@ -1,4 +1,6 @@ -module Dodge.ItEffect where +module Dodge.ItEffect + ( doInvEffect + ) where import qualified IntMapHelp as IM import Control.Lens @@ -12,15 +14,11 @@ doInvEffect iie = case iie of ChargeIfInInventory -> chargeIfInInventory SetCharge i -> setItemCharge i EffectRootNotroot f g -> rootNotrootEff f g - CreateHeldLight -> createHeldLight CreateShieldWall -> createShieldWall RemoveShieldWall -> removeShieldWall EffectWhileRoot f -> rootNotrootEff f NoInvEffect EffectWhileAttached f -> effectWhileAttached f -doFloorEffect :: ItFloorEffect -> Int -> World -> World -doFloorEffect NoFloorEffect = const id - rootNotrootEff :: ItInvEffect -> ItInvEffect -> Item -> Creature -> World -> World rootNotrootEff f g it | it ^? itLocation . ilIsRoot == Just True = doInvEffect f it @@ -62,7 +60,3 @@ chargeIfEquipped itm cr invid = _ilInvID $ _itLocation itm ptrWpCharge = cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge maxcharge = itm ^?! itUse . leftConsumption . wpMaxCharge - -createHeldLight :: Item -> Creature -> World -> World -createHeldLight itm cr = id ---createHeldLight itm cr = createTorchLightOffset cr itm 0 diff --git a/src/Dodge/Item/Ammo.hs b/src/Dodge/Item/Ammo.hs index 671a6bed8..9871b7a3e 100644 --- a/src/Dodge/Item/Ammo.hs +++ b/src/Dodge/Item/Ammo.hs @@ -80,8 +80,8 @@ battery = , _amagType = ElectricalAmmo , _amagLoadStatus = ReloadStatus - { _iaMax = 100 - , _iaLoaded = 100 + { _iaMax = 10^ (9::Int) + , _iaLoaded = 10^ (9::Int) } } diff --git a/src/Dodge/Item/Grammar.hs b/src/Dodge/Item/Grammar.hs index 8e3f2ca1d..1bd9aebdb 100644 --- a/src/Dodge/Item/Grammar.hs +++ b/src/Dodge/Item/Grammar.hs @@ -24,7 +24,6 @@ useBreakL' :: [(ItemStructuralFunction, ComposeLinkType)] -> [(ItemStructuralFun useBreakL' x y = useBreakListsLinkTest (map (uncurry noa) x) (map (uncurry noa) y) where noa a b = (a, ILink b orientAttachment) - useBreakListsLinkTest :: [(ItemStructuralFunction, a)] -> [(ItemStructuralFunction, a)] -> LinkTest a useBreakListsLinkTest llist rlist = LTest ltest rtest diff --git a/src/Dodge/Item/Held/Utility.hs b/src/Dodge/Item/Held/Utility.hs index 7ef3656b6..09fec3454 100644 --- a/src/Dodge/Item/Held/Utility.hs +++ b/src/Dodge/Item/Held/Utility.hs @@ -26,7 +26,6 @@ latchkey _ = defaultHeldItem torch :: Item torch = defaultHeldItem - & itEffect . ieInv .~ EffectWhileAttached CreateHeldLight & itType .~ HELD TORCH & itUse . heldAim . aimMuzzles . ix 0 . mzPos . _x .~ 10 & itUse . heldAmmoTypes .~ singleAmmo ElectricalAmmo diff --git a/src/Dodge/Item/Orientation.hs b/src/Dodge/Item/Orientation.hs index b33d0a68c..48324aede 100644 --- a/src/Dodge/Item/Orientation.hs +++ b/src/Dodge/Item/Orientation.hs @@ -1,29 +1,29 @@ -module Dodge.Item.Orientation - ( orientAttachment - ) where +module Dodge.Item.Orientation ( + orientAttachment, +) where import Dodge.Data.ComposedItem -import Geometry.Data import Dodge.Data.Item +import Geometry.Data import qualified Quaternion as Q orientChild :: Item -> (Point3, Q.Quaternion Float) orientChild itm = case _itType itm of - HELD TORCH -> (V3 0 20 0,Q.qID) - _ -> (0,Q.qID) + HELD TORCH -> (V3 0 5 0, Q.qID) + _ -> (0, Q.qID) orientByLink :: Item -> ComposeLinkType -> (Point3, Q.Quaternion Float) -orientByLink itm lt = case (_itType itm,lt) of +orientByLink itm lt = case (_itType itm, lt) of (HELD FLAMETHROWER, AmmoInLink{}) -> (V3 4 (-6) 0, Q.qID) - (HELD _,AmmoInLink{}) -> (V3 7 (-2) 0, Q.qID) - (HELD _,WeaponScopeLink) -> (V3 5 0 5, Q.qID) - _ -> (0,Q.qID) + (HELD _, AmmoInLink{}) -> (V3 7 (-2) 0, Q.qID) + (HELD _, WeaponScopeLink) -> (V3 5 0 5, Q.qID) + _ -> (0, Q.qID) orientAttachment :: Item -> ComposeLinkType -> Item -> (Point3, Q.Quaternion Float) -orientAttachment par lnk ch = case (_itType par,lnk,_itType ch) of --- (HELD BURSTRIFLE,_,HELD TORCH) -> (V3 20 0 0, Q.qID) --- (HELD LAUNCHER,_,HELD TORCH) -> (V3 0 20 0, Q.qID) +orientAttachment par lnk ch = case (_itType par, lnk, _itType ch) of +-- (HELD BURSTRIFLE, _, HELD TORCH) -> (V3 20 0 0, Q.axisAngle (V3 0 0 1) (pi/2)) +-- (HELD LAUNCHER, _, HELD TORCH) -> (V3 0 20 0, Q.axisAngle (V3 0 0 1) (pi/4)) _ -> (t1 + Q.rotate q1 t2, q1 * q2) where - (t1,q1) = orientByLink par lnk - (t2,q2) = orientChild ch + (t1, q1) = orientByLink par lnk + (t2, q2) = orientChild ch