Work on orienting positions for attachment items
This commit is contained in:
+81
-46
@@ -3,6 +3,13 @@ module Dodge.Creature.State (
|
||||
doDamage,
|
||||
) where
|
||||
|
||||
import Dodge.WorldEvent.Flash
|
||||
import Dodge.Data.DoubleTree
|
||||
import Dodge.Item.HeldOffset
|
||||
import Dodge.DoubleTree
|
||||
import Dodge.Data.ComposedItem
|
||||
import qualified Quaternion as Q
|
||||
import Dodge.Item.Grammar
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe
|
||||
import Data.Monoid
|
||||
@@ -236,12 +243,45 @@ equipmentEffects cr = alaf Endo foldMap (useEquipment cr) (IM.keys $ _crInvEquip
|
||||
-- a loop going over all inventory items
|
||||
invSideEff :: Creature -> World -> World
|
||||
invSideEff cr = alaf Endo foldMap f (_crInv cr)
|
||||
. updateRootItem cr
|
||||
where
|
||||
-- be careful with side effects that affect creature targeting
|
||||
f it =
|
||||
itemInvSideEffect cr it
|
||||
. maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
|
||||
|
||||
updateRootItem :: Creature -> World -> World
|
||||
updateRootItem cr = fromMaybe id $ do
|
||||
invid <- cr ^? crManipulation . manObject . imRootItem
|
||||
itmtree <- invTrees' (_crInv cr) ^? ix invid
|
||||
return $ updateRootItem' itmtree cr
|
||||
|
||||
-- need to check rotation
|
||||
chainLinkOrientation
|
||||
:: Maybe (Point3, Q.Quaternion Float)
|
||||
-> Item
|
||||
-> ItemLink
|
||||
-> Item
|
||||
-> Maybe (Point3,Q.Quaternion Float)
|
||||
chainLinkOrientation mo par (ILink lt f) child = do
|
||||
(p,q) <- mo
|
||||
(p1,q1) <- f par lt child
|
||||
return (p + Q.rotate q p1, q * q1)
|
||||
|
||||
updateRootItem' :: LabelDoubleTree ItemLink Item -> Creature -> World -> World
|
||||
updateRootItem' itmtree cr = ldtPropagateFold chainLinkOrientation chainLinkOrientation
|
||||
(updateItemWithOrientation cr)
|
||||
(Just (heldItemRelativeOrient (_ldtValue itmtree) cr (0,Q.qID)))
|
||||
itmtree
|
||||
|
||||
updateItemWithOrientation :: Creature -> Maybe (Point3, Q.Quaternion Float) -> Item -> World -> World
|
||||
updateItemWithOrientation cr m itm = case _itType itm of
|
||||
HELD TORCH -> testtorch cr m
|
||||
_ -> id
|
||||
|
||||
testtorch :: Creature -> Maybe (Point3, Q.Quaternion Float) -> World -> World
|
||||
testtorch cr = maybe id $ \(pos,_) -> muzFlareAt yellow (_crPos cr `v2z` 0 + rotate3z (_crDir cr) pos) (_crDir cr)
|
||||
|
||||
itemInvSideEffect :: Creature -> Item -> World -> World
|
||||
itemInvSideEffect cr itm = case _itType itm of
|
||||
TARGETING tt -> updateItemTargeting tt cr itm
|
||||
@@ -259,55 +299,50 @@ 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 ->
|
||||
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)
|
||||
. (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)
|
||||
)
|
||||
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
|
||||
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)
|
||||
|
||||
Reference in New Issue
Block a user