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

Work on orienting and drawing attachments

Browse Source
This commit is contained in:
justin
2024-09-30 23:02:22 +01:00
parent 48b8cfe7ef
commit 752b568a86
13 changed files with 340 additions and 229 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Impulse/UseItem.hs
+2 -2
View File
@@ -42,7 +42,7 @@ itemUseEffect cr it w = case it ^. ldtValue . itUse of
CraftUse{} -> w
AttachUse{} -> selectUse it cr w
TargetingUse {} -> w
AmmoMagUse{} -> w
UseAmmoMag{} -> w
ScopeUse{} -> w
BulletModUse{} -> w
where
@@ -107,7 +107,7 @@ useItemLeftClick cr w = fromMaybe w $ do
ConsumeUse{} -> return $ useItemLeftClick' cr w
EquipUse{} -> return $ useItemLeftClick' cr w
UseHotkey{} -> return $ useItemLeftClick' cr w
AmmoMagUse{} -> return w
UseAmmoMag{} -> return w
_ -> Nothing
useItemLeftClick' :: Creature -> World -> World
src/Dodge/Creature/State.hs
+77 -65
View File
@@ -3,39 +3,32 @@ module Dodge.Creature.State (
doDamage,
) where
import Dodge.Zoning.Creature
import FoldableHelp
import Data.Maybe
import qualified Data.Map.Strict as M
import qualified SDL
import Dodge.Creature.Test
--import Dodge.Item.Display -- this should not really be imported... TODO move canAttachTargetingBelow
--import Control.Applicative
--import Data.Foldable
--import Data.Maybe
import Data.Maybe
import Data.Monoid
import Dodge.Base
import Dodge.Corpse.Make
import Dodge.Creature.Action
import Dodge.Creature.Damage
import Dodge.Creature.Impulse.Movement
import Dodge.Creature.State.WalkCycle
--import Dodge.Creature.Test
import Dodge.Creature.Test
import Dodge.Damage
import Dodge.Data.World
import Dodge.EnergyBall
--import Dodge.Equipment
import Dodge.Euse
import Dodge.Hammer
import Dodge.ItEffect
--import Dodge.LightSource.Torch
import Dodge.Prop.Gib
import Dodge.SoundLogic
--import Dodge.Targeting
import Dodge.Zoning.Creature
import FoldableHelp
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import Picture
import RandomHelp
import qualified SDL
import Shape
import ShapePicture
@@ -68,8 +61,8 @@ stateUpdate f =
, updateInv -- upInv must be called before invSideEff 22.05.23
, invSideEff
, equipmentEffects
-- , heldItemEffects
-- , heldAimEffects
-- , heldItemEffects
-- , heldAimEffects
]
--heldItemEffects :: Creature -> World -> World
@@ -85,8 +78,9 @@ stateUpdate f =
checkDeath :: Creature -> World -> World
checkDeath cr w
| _crHP cr > 0 = w
& cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .~ []
| _crHP cr > 0 =
w
& cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .~ []
| otherwise =
w
-- & creatures . at (_crID cr) .~ Nothing
@@ -154,7 +148,7 @@ internalHammerUpdate :: Creature -> World -> World
internalHammerUpdate cr =
cWorld . lWorld . creatures . ix (_crID cr)
%~ ( (crHammerPosition %~ moveHammerUp)
-- . stepReloading
-- . stepReloading
. updateMovement
)
@@ -236,25 +230,23 @@ updateInv cr = cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ IM.map ite
-- a loop going over equipped items
equipmentEffects :: Creature -> World -> World
equipmentEffects cr = flip (foldl' $ flip $ useEquipment cr) (IM.keys $ _crInvEquipped cr)
--equipmentEffects cr = flip (foldl' $ flip $ useEquipment cr) (IM.keys $ _crInvEquipped cr)
equipmentEffects cr = alaf Endo foldMap (useEquipment cr) (IM.keys $ _crInvEquipped cr)
-- a loop going over all inventory items
invSideEff :: Creature -> World -> World
invSideEff cr w =
-- updateTargeting (crGetTargeting cr) cr $
-- weaponReloadSounds cr $
IM.foldl' f w (_crInv cr)
invSideEff cr = alaf Endo foldMap f (_crInv cr)
where
-- be careful with side effects that affect creature targeting
f w' it =
itemInvSideEffect cr it $
--doItemTargeting i cr w' & maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
w' & maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
f it =
itemInvSideEffect cr it
. maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
itemInvSideEffect :: Creature -> Item -> World -> World
itemInvSideEffect cr itm = case _itType itm of
TARGETING tt -> updateItemTargeting tt cr itm
_ -> id
_ -> id
--itemInvSideEffect cr it
-- | hastorchattach = createAttachLight cr it
-- | otherwise = id
@@ -267,39 +259,57 @@ itemInvSideEffect cr itm = case _itType itm of
-- attachoff = it ^?! itDimension . dimAttachPos
updateItemTargeting :: TargetingType -> Creature -> Item -> World -> World
updateItemTargeting tt cr itm w = w & case tt of
_ | not isattached
-> cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse %~
( (tgPos .~ Nothing)
. (tgActive .~ False)
)
TARGETLASER | crIsAiming cr -> cWorld . lWorld . lasers
.:~ LaserStart
{ _lpPhaseV = 1
, _lpDir = _crDir cr
, _lpPos = sp
, _lpColor = col
, _lpType = TargetingLaser (_itID itm)
}
TARGETLASER -> cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm)
. itUse . tgPos .~ Nothing
TargetRBPress | rbpressed
-> cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse %~
( (tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just)
. (tgActive .~ True)
)
TargetRBPress
-> cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse %~
( (tgPos .~ Nothing)
. (tgActive .~ False)
)
TargetRBCreature -> cWorld . lWorld . creatures . ix (_crID cr)
. crInv . ix (_ilInvID $ _itLocation itm) . itUse %~ setRBCreatureTargeting cr w
TargetCursor -> cWorld . lWorld . creatures . ix (_crID cr)
. crInv . ix (_ilInvID $ _itLocation itm) . itUse .~ TargetingUse
(Just (mouseWorldPos (w ^. input) (w ^. wCam))) Nothing True
where
isattached = itm ^?! itLocation . ilIsAttached
updateItemTargeting tt cr itm w =
w & case tt of
_
| not isattached ->
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse
%~ ( (tgPos .~ Nothing)
. (tgActive .~ False)
)
TARGETLASER
| crIsAiming cr ->
cWorld . lWorld . lasers
.:~ LaserStart
{ _lpPhaseV = 1
, _lpDir = _crDir cr
, _lpPos = sp
, _lpColor = col
, _lpType = TargetingLaser (_itID itm)
}
TARGETLASER ->
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm)
. itUse
. tgPos
.~ Nothing
TargetRBPress
| rbpressed ->
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse
%~ ( (tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just)
. (tgActive .~ True)
)
TargetRBPress ->
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse
%~ ( (tgPos .~ Nothing)
. (tgActive .~ False)
)
TargetRBCreature ->
cWorld . lWorld . creatures . ix (_crID cr)
. crInv
. ix (_ilInvID $ _itLocation itm)
. itUse
%~ setRBCreatureTargeting cr w
TargetCursor ->
cWorld . lWorld . creatures . ix (_crID cr)
. crInv
. ix (_ilInvID $ _itLocation itm)
. itUse
.~ TargetingUse
(Just (mouseWorldPos (w ^. input) (w ^. wCam)))
Nothing
True
where
isattached = itm ^?! itLocation . ilIsAttached
rbpressed = SDL.ButtonRight `M.member` _mouseButtons (_input w)
sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
col = blue -- mixColors reloadFrac (1-reloadFrac) blue red
@@ -307,7 +317,8 @@ updateItemTargeting tt cr itm w = w & case tt of
setRBCreatureTargeting :: Creature -> World -> ItemUse -> ItemUse
setRBCreatureTargeting cr w ituse
| SDL.ButtonRight `M.member` _mouseButtons (_input w) && isJust (ituse ^? tgID . _Just)
&& canSeeTarget = ituse & updatePos & tgActive .~ True
&& canSeeTarget =
ituse & updatePos & tgActive .~ True
| otherwise = ituse & tgID .~ fmap _crID newtarg & updatePos & tgActive .~ False
where
newtarg =
@@ -328,6 +339,7 @@ itemUpdate :: Item -> Item
itemUpdate =
updateAutoRecharge
. (itUse %~ useUpdate)
-- . (itLocation .~ InInv (_crID cr) i itmisselected itmisroot)
-- where
-- itmisroot = Just i == (cr ^? crManipulation . manObject . inInventory . imRootItem)
@@ -340,7 +352,7 @@ updateAutoRecharge it = case it ^? itUse . leftConsumption of
| l < m -> it & itUse . leftConsumption . arProgress -~ 1
_ -> it
--itemGetTargeting :: LabelDoubleTree ComposeLinkType Item
--itemGetTargeting :: LabelDoubleTree ComposeLinkType Item
-- I feel like there should be a centralised function that supersumes this
-- i.e. a function that deals with all states that depend upon item positioning
@@ -352,11 +364,11 @@ updateAutoRecharge it = case it ^? itUse . leftConsumption of
-- itm ^? itType . iyModules . ix ModTarget . imtTargetType
-- <|> do
-- tt <- cr ^? crInv . ix (i-1) . itType . iyBase . ibtTargeting
-- guard (canAttachTargeting tt itm)
-- guard (canAttachTargeting tt itm)
-- return tt
-- <|> do
-- tt <- cr ^? crInv . ix (i+1) . itUse . equipTargeting . _Just
-- guard (canAttachTargeting tt itm)
-- guard (canAttachTargeting tt itm)
-- return tt
--weaponReloadSounds :: Creature -> World -> World
src/Dodge/Data/ComposedItem.hs
+1 -1
View File
@@ -44,7 +44,7 @@ type ComposedItem = (Item, ItemStructuralFunction)
data ItemLink = ILink
{ _iatType :: ComposeLinkType
, _iatOrient :: Item -> Item -> Maybe (Point3, Quaternion Float)
, _iatOrient :: Item -> ComposeLinkType -> Item -> Maybe (Point3, Quaternion Float)
}
data LinkTest lt = LTest
src/Dodge/Data/Item/Use.hs
+1 -1
View File
@@ -62,7 +62,7 @@ data ItemUse
AttachUse
{_atLinkedProjectile :: Maybe Int}
| -- {_attachParams :: AttachParams}
AmmoMagUse
UseAmmoMag
{ _amagLoadStatus :: ReloadStatus
, _amagParams :: AmmoParams
, _amagType :: AmmoType
src/Dodge/Item/Ammo.hs
+4 -4
View File
@@ -14,7 +14,7 @@ tinMag :: Item
tinMag =
defaultHeldItem & itType .~ AMMOMAG TINMAG
& itUse
.~ AmmoMagUse
.~ UseAmmoMag
{ _amagParams = BulletParams defaultBullet
, _amagType = BulletAmmo
, _amagLoadStatus =
@@ -53,7 +53,7 @@ shellMag :: Item
shellMag =
defaultHeldItem & itType .~ AMMOMAG SHELLMAG
& itUse
.~ AmmoMagUse
.~ UseAmmoMag
{ _amagParams = ProjectileParams
{ _ampPayload = ExplosionPayload
}
@@ -73,7 +73,7 @@ battery :: Item
battery =
defaultHeldItem & itType .~ AMMOMAG BATTERY
& itUse
.~ AmmoMagUse
.~ UseAmmoMag
{ _amagParams = BulletParams defaultBullet
, _amagType = ElectricalAmmo
, _amagLoadStatus =
@@ -87,7 +87,7 @@ chemFuelPouch :: Item
chemFuelPouch =
defaultHeldItem & itType .~ AMMOMAG CHEMFUELPOUCH
& itUse
.~ AmmoMagUse
.~ UseAmmoMag
{ _amagParams = GasParams ChemFuel
, _amagType = GasAmmo
, _amagLoadStatus =
src/Dodge/Item/AmmoPosition.hs
-12
View File
@@ -1,12 +0,0 @@
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Item.AmmoPosition where
import Linear.Quaternion (Quaternion (..))
import Control.Lens
import Geometry.Data
data AmmoPosition
= Magazine {_amposPos :: Point3, _amposDir :: Quaternion Float}
| Bullets {_amPosDirs :: [(Point3,Quaternion Float)]}
| NoAmmoPosition
makeLenses ''AmmoPosition
src/Dodge/Item/Display.hs
+1 -1
View File
@@ -115,7 +115,7 @@ itemNumberDisplay cr itm = case iu of
CraftUse -> []
ConsumeUse {} -> []
AttachUse {} -> []
AmmoMagUse {} -> [maybe "" shortShow $ itm ^? itUse . amagLoadStatus . iaLoaded]
UseAmmoMag {} -> [maybe "" shortShow $ itm ^? itUse . amagLoadStatus . iaLoaded]
ScopeUse OpticScope {_opticZoom = x} -> [shortShow x]
ScopeUse {} -> []
TargetingUse {_tgPos = mp} -> [maybe "" shortShow mp]
src/Dodge/Item/Draw/SPic.hs
+20 -5
View File
@@ -1,3 +1,5 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Item.Draw.SPic (
itemSPic,
itemTreeSPic,
@@ -35,7 +37,7 @@ itemTreeSPic (LDT (itm,_) l r) = itemSPic itm
itemRotTreeSPic :: Item -> (ItemLink,LabelDoubleTree ItemLink ComposedItem) -> SPic
itemRotTreeSPic par (il,t) = fromMaybe mempty $ do
(p,q) <- _iatOrient il par itm
(p,q) <- _iatOrient il par (_iatType il) itm
return $ (translateSP p $ overPosSP (Q.rotate q) $ itemTreeSPic t)
where
itm = t ^. ldtValue . _1
@@ -48,10 +50,21 @@ itemSPic it = case it ^. itType of
EQUIP et -> equipItemSPic et it
CONSUMABLE{} -> defSPic
ATTACH {} -> defSPic
AMMOMAG {} -> defSPic
AMMOMAG amt -> ammoMagSPic it amt
TARGETING {} -> defSPic
BULLETMOD {} -> defSPic
ammoMagSPic :: Item -> AmmoMagType -> SPic
ammoMagSPic it = \case
TINMAG -> noPic $ upperPrismPolyTS 1 (reverse $ rectNSWE 0 (- y) (-1) 1)
DRUMMAG -> noPic $ upperPrismPolyTS 1 (reverse $ rectNSWE 0 (- y) (-1) 1)
CHEMFUELPOUCH -> (colorSH yellow (upperPrismPolyST 3 $ polyCirc 3 5)
, mempty)
_ -> noPic $ upperPrismPolyTS 1 (reverse $ rectNSWE 0 (- y) (-1) 1)
where
y = fromIntegral y' * 0.3
y' = fromMaybe 0 $ it ^? itUse . amagLoadStatus . iaLoaded
equipItemSPic :: EquipItemType -> Item -> SPic
equipItemSPic et _ = case et of
MAGSHIELD -> defSPic
@@ -432,10 +445,12 @@ flamerPic :: Item -> SPic
--flamerPic it =
flamerPic _ =
( colorSH yellow $
translateSHxy tx ty (upperPrismPolyST tz $ polyCirc 3 r)
<> xCylinderST 5 18
-- translateSHxy tx ty (upperPrismPolyST tz $ polyCirc 3 r)
-- <>
xCylinderST 5 18
, mempty
--, color black $ translate3 (V3 tx ty (tz + 0.01)) $ circleSolid (r * am)
, color black $ translate3 (V3 tx ty (tz + 0.01)) $ circleSolid (r * 0.5)
-- , color black $ translate3 (V3 tx ty (tz + 0.01)) $ circleSolid (r * 0.5)
)
where
tx = 4
src/Dodge/Item/Grammar.hs
+7 -6
View File
@@ -7,6 +7,7 @@ module Dodge.Item.Grammar (
invRootMap,
) where
import Dodge.Item.Orientation
import qualified Linear.Quaternion as Q
import Geometry.Data
import Control.Applicative
@@ -38,8 +39,8 @@ useBreakListsLinkTest llist rlist = LTest ltest rtest
basePartiallyComposedItem' :: Item -> PartiallyComposedItem ItemLink
basePartiallyComposedItem' itm = case itm ^. itType of
HELD _ -> (itm, WeaponPlatformSF, useBreakListsLinkTest
(map (\(i,a) -> (AmmoMagSF a, ILink (AmmoInLink i a) (c (V3 7 (-2) 0) rhs
)
--(map (\(i,a) -> (AmmoMagSF a, ILink (AmmoInLink i a) (c (V3 7 (-2) 0) rhs
(map (\(i,a) -> (AmmoMagSF a, ILink (AmmoInLink i a) orientAttachment
))
(IM.toList $ itm ^. itUse . heldAmmoTypes))
[noa WeaponTargetingSF WeaponTargetingLink, noa WeaponScopeSF WeaponScopeLink]
@@ -60,9 +61,9 @@ basePartiallyComposedItem' itm = case itm ^. itType of
CRAFT {} -> isolate
-- _ ->
where
noa x y = (x, ILink y (const (const Nothing)))
c x y _ _ = Just (x,y)
rhs = Q.axisAngle (V3 1 0 0) 0
noa x y = (x, ILink y orientAttachment)
c x y _ _ _ = Just (x,y)
-- rhs = Q.axisAngle (V3 1 0 0) 0
nolinks x = (itm,x, LTest (const Nothing) (const Nothing))
isolate = (itm,UncomposableIsolateSF, LTest (const Nothing) (const Nothing))
@@ -81,7 +82,7 @@ ammoComposedItem' itm = fromMaybe (error "in ammoComposedItem, wrong item") $ do
[]
)
where
noa x y = (x, ILink y (const (const Nothing)))
noa x y = (x, ILink y orientAttachment)
type LDTComb a b = LabelDoubleTree b a -> LabelDoubleTree b a -> Maybe (LabelDoubleTree b a)
src/Dodge/Item/Orientation.hs
+14 -4
View File
@@ -8,9 +8,19 @@ import qualified Linear.Quaternion as Q
orientChild :: Item -> (Point3, Q.Quaternion Float)
orientChild itm = case _itType itm of
HELD {} -> (0,0)
_ -> (0,0)
HELD {} -> (0,Q.axisAngle (V3 1 0 0) 0)
_ -> (0,Q.axisAngle (V3 1 0 0) 0)
orientByLink :: Item -> ComposeLinkType -> (Point3, Q.Quaternion Float)
orientByLink itm _ = case _itType itm of
_ -> (0,0)
orientByLink itm lt = case (_itType itm,lt) of
--(HELD FLAMETHROWER, AmmoInLink{}) -> undefined --(V3 4 (-6) 0,0)
(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)
_ -> (0,Q.axisAngle (V3 1 0 0) 0)
orientAttachment :: Item -> ComposeLinkType -> Item -> Maybe (Point3, Q.Quaternion Float)
orientAttachment par lnk ch = Just (t1 + (Q.rotate q1 t2), q1 * q2)
--orientAttachment par lnk ch = Just (t1 , q1 )
where
(t1,q1) = orientByLink par lnk
(t2,q2) = orientChild ch
src/Dodge/Render/ShapePicture.hs
-5
View File
@@ -84,11 +84,6 @@ anyTargeting w = fromMaybe mempty $ do
<|> lookup AugmentedHUDLink (ttree ^. ldtRight)
return (mempty , drawTargeting (ttree ^. ldtValue) w)
-- tt <- cr ^? crTargeting . ctType . _Just
-- return $ noShape $ drawTargeting tt cr cfig w
-- where
-- cr = you w
drawCreature :: Creature -> SPic
drawCreature cr = case _crType cr of
Humanoid{} -> basicCrPict cr