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

Make torch use battery power

Browse Source
This commit is contained in:
justin
2024-10-02 23:53:38 +01:00
parent 49ffbfafc2
commit 844bb486e6
13 changed files with 72 additions and 76 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ghcidOutput
+1 -15
View File
@@ -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)
src/Dodge/Creature.hs
+1
View File
@@ -280,6 +280,7 @@ testInventory =
stackedInventory :: [Item]
stackedInventory =
[ torch
, torch
, remoteScreen
, megaShellMag
, targetingScope TARGETLASER
src/Dodge/Creature/State.hs
+23 -14
View File
@@ -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)
src/Dodge/Data/Item/Effect.hs
-5
View File
@@ -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
src/Dodge/Default/Item.hs
+7 -2
View File
@@ -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
}
src/Dodge/Default/Item/Effect.hs
-11
View File
@@ -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
}
src/Dodge/Default/Item/Use/AimParams.hs
+4 -1
View File
@@ -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
src/Dodge/DoubleTree.hs
+16
View File
@@ -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
src/Dodge/ItEffect.hs
+3 -9
View File
@@ -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
src/Dodge/Item/Ammo.hs
+2 -2
View File
@@ -80,8 +80,8 @@ battery =
, _amagType = ElectricalAmmo
, _amagLoadStatus =
ReloadStatus
{ _iaMax = 100
, _iaLoaded = 100
{ _iaMax = 10^ (9::Int)
, _iaLoaded = 10^ (9::Int)
}
}
src/Dodge/Item/Grammar.hs
-1
View File
@@ -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
src/Dodge/Item/Held/Utility.hs
-1
View File
@@ -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
src/Dodge/Item/Orientation.hs
+15 -15
View File
@@ -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