Add visuals for wrist equipment

This commit is contained in:
2022-05-22 23:23:29 +01:00
parent b83392d441
commit 1c038b79be
8 changed files with 108 additions and 22 deletions
+49 -1
View File
@@ -1,6 +1,10 @@
module Dodge.Creature.HandPos where
import Dodge.Data
--import Geometry
import Dodge.Creature.Test
import Shape
import ShapePicture
import Geometry
import Control.Lens
import Data.Maybe
@@ -18,3 +22,47 @@ aimingWeaponZeroPos cr it = aimingWeaponHandlePos cr it
aimingMuzzlePos :: Creature -> Item -> Float
aimingMuzzlePos cr it = aimingWeaponZeroPos cr it
+ fromMaybe 0 (it ^? itDimension . dimPortage . muzPos)
translateToRightHand :: Creature -> SPic -> SPic
translateToRightHand cr
| oneH cr = shoulderSP . translateSPf 11 (-3) . rotateSP (-0.5)-- . scaleSH (V3 1 1.5 1)
| twists cr = shoulderSP . translateSPf 0 5 . rotateSP (-1) . translateSPf 4 (-10)
| twoFlat cr = waistSP . translateSPf 4 (-8)
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> waistSP . translateSPf (-f sa) (-off)
_ -> waistSP . translateSPf 0 (-off)
where
off = 8
sLen = _strideLength $ _crStance cr
f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
translateToLeftHand :: Creature -> SPic -> SPic
translateToLeftHand cr
| oneH cr = waistSP . rotateSP 0.4 . translateSPf 0 off
| twists cr = shoulderSP . translateSPf 0 5 . rotateSP (-1) . translateSPf 12 4
| twoFlat cr = waistSP . translateSPf 4 8
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa RightForward) -> waistSP . translateSPf (-f sa) off
_ -> waistSP . translateSPf 0 off
where
off = 8
sLen = _strideLength $ _crStance cr
f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
oneH :: Creature -> Bool
oneH = crInStance OneHand
twoFlat :: Creature -> Bool
twoFlat = crInStance TwoHandFlat
twists :: Creature -> Bool
twists = crInStance TwoHandTwist
shoulderSP :: SPic -> SPic
shoulderSP = translateSPz 20
waistSP :: SPic -> SPic
waistSP = translateSPz 10
crInStance :: AimStance -> Creature -> Bool
crInStance as cr = crIsAiming' cr -- || (_posture (_crStance cr) == Reloading && hasAmmo cr)
&& cr ^? crInv . ix (_crInvSel cr) . itUse . useAim . aimStance == Just as
+18 -14
View File
@@ -18,6 +18,7 @@ import Dodge.Creature.Test
--import Dodge.Creature.AlertLevel.Data
--import Dodge.Picture.Layer
import Dodge.Clock
import Dodge.Creature.HandPos (translateToRightHand,translateToLeftHand)
--import Dodge.Debug.Picture
import Picture
import Geometry
@@ -166,21 +167,23 @@ feet cr = case cr ^? crStance . carriage of
arms :: Creature -> Shape
{-# INLINE arms #-}
arms cr
| oneH cr = shoulderSH . translateSHf 11 (-3) . rotateSH (-0.5) $ scaleSH (V3 1 1.5 1) aHand
| twists cr = shoulderSH . translateSHf 0 5 . rotateSH (-1) $ mconcat
[ translateSHf 12 4 aHand
, translateSHf 4 (-10) aHand
]
| twoFlat cr = waistSH $ translateSHf 4 8 aHand
<> translateSHf 4 (-8) aHand
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> waistSH $ translateSHf (-f sa) (-off) aHand
Just (Walking sa RightForward) -> waistSH $ translateSHf (-f sa) off aHand
_ -> emptySH
arms cr = fst $ translateToRightHand cr aHand
<> translateToLeftHand cr aHand
--arms cr
-- | oneH cr = shoulderSH . translateSHf 11 (-3) . rotateSH (-0.5) $ scaleSH (V3 1 1.5 1) aHand
-- | twists cr = shoulderSH . translateSHf 0 5 . rotateSH (-1) $ mconcat
-- [ translateSHf 12 4 aHand
-- , translateSHf 4 (-10) aHand
-- ]
-- | twoFlat cr = waistSH $ translateSHf 4 8 aHand
-- <> translateSHf 4 (-8) aHand
-- | otherwise = case cr ^? crStance . carriage of
-- Just (Walking sa LeftForward) -> waistSH $ translateSHf (-f sa) (-off) aHand
-- Just (Walking sa RightForward) -> waistSH $ translateSHf (-f sa) off aHand
-- _ -> emptySH
where
aHand :: Shape
aHand = translateSHz (-4) . upperPrismPolyHalf 4 $ polyCirc 3 4
aHand :: SPic
aHand = noPic $ translateSHz (-4) . upperPrismPolyHalf 4 $ polyCirc 3 4
off = 8
sLen = _strideLength $ _crStance cr
f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
@@ -237,6 +240,7 @@ baseShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalf 10
upperBody :: Color -> Creature -> Shape
{-# INLINE upperBody #-}
--upperBody col cr = colorSH (light4 col) $ mconcat
upperBody col cr = colorSH (light4 col) $ mconcat
[ arms cr
, shoulderSH $ torso cr
-1
View File
@@ -377,7 +377,6 @@ data ItemUse
{ _lUse :: Creature -> Int -> World -> World
, _useDelay :: UseDelay
, _useHammer :: HammerType
, _eqSite :: EquipSite
}
| ConsumeUse
{ _cUse :: Item -> Creature -> World -> World
-2
View File
@@ -65,7 +65,6 @@ defaultlUse = LeftUse
{ _lUse = \_ _ -> id
, _useDelay = FixedRate {_rateMax = 8, _rateTime = 0}
, _useHammer = NoHammer
, _eqSite = GoesOnWrist
}
luseInstantNoH :: (Creature -> Int -> World -> World) -> ItemUse
@@ -73,7 +72,6 @@ luseInstantNoH f = LeftUse
{ _lUse = f
, _useDelay = NoDelay
, _useHammer = NoHammer
, _eqSite = GoesOnWrist
}
defaultAimParams :: AimParams
defaultAimParams = AimParams
+10 -3
View File
@@ -5,6 +5,7 @@ import Dodge.Item.Weapon.InventoryDisplay
import Dodge.Default
import Dodge.Default.Wall
import Dodge.Creature.Test
import Dodge.Creature.HandPos
import Dodge.Wall
import Dodge.Magnet
import Picture
@@ -66,9 +67,15 @@ frontArmour = defaultEquipment
, _itID = Nothing
}
pictureOnEquip :: SPic -> Creature -> Item -> SPic
pictureOnEquip sp cr itm = case _itInvPos itm of
Just i | isJust (cr ^? crInvEquipped . ix i) -> sp
_ -> mempty
pictureOnEquip sp cr itm = fromMaybe mempty $ do
i <- _itInvPos itm
epos <- cr^? crInvEquipped . ix i
return $ equipPosition epos cr sp
equipPosition :: EquipPosition -> Creature -> SPic -> SPic
equipPosition epos cr sh = case epos of
OnLeftWrist -> translateToLeftHand cr sh
OnRightWrist -> translateToRightHand cr $ mirrorSPxz sh
_ -> sh
flatShield :: Item
flatShield = defaultEquipment
+7 -1
View File
@@ -3,6 +3,7 @@ import Dodge.Data
--import Dodge.Picture.Layer
import Dodge.Default
import Dodge.Item.Draw
import Dodge.Item.Equipment
import Dodge.Item.Weapon.TriggerType
import Dodge.Item.Weapon.ExtraEffect
import Dodge.Item.Weapon.UseEffect
@@ -12,6 +13,7 @@ import Dodge.Default.Weapon
import Geometry
import Picture
import Shape
import ShapePicture
import Control.Lens
@@ -68,7 +70,11 @@ autoRadar :: Item
autoRadar = defaultEquipment
{ _itType = RADAR
, _itName = "AUTORADAR"
, _itEquipPict = \_ _ -> (,) emptySH blank
, _itEquipPict = pictureOnEquip $ noPic (colorSH yellow $ translateSH (V3 0 4 (-4)) $ upperPrismPoly 3
$ rectWH 2 2)
, _itEffect = autoRadarEffect
, _itID = Nothing
} & itUse . eqSite .~ GoesOnWrist
shapeForWrist :: Shape -> Creature -> Item -> SPic
shapeForWrist = pictureOnEquip . noPic . translateSH (V3 0 4 (-4))
+12
View File
@@ -39,6 +39,8 @@ module Picture
, setDepth
, addDepth
, setLayer
, mirroryz
, mirrorxz
)
where
import Geometry
@@ -358,3 +360,13 @@ charToTuple x c =
]
where
offset = fromIntegral (fromEnum c) - 32
mirrorxz :: Picture -> Picture
mirrorxz = map (overPos flipy)
where
flipy (V3 x y z) = V3 x (negate y) z
mirroryz :: Picture -> Picture
mirroryz = map (overPos flipx)
where
flipx (V3 x y z) = V3 (negate x) y z
+12
View File
@@ -9,6 +9,8 @@ module ShapePicture
, noShape
, _spShape
, _spPicture
, mirrorSPyz
, mirrorSPxz
) where
import Shape
import Picture
@@ -41,3 +43,13 @@ translateSPz z = bimap (translateSH (V3 0 0 z)) (translate3 (V3 0 0 z))
rotateSP :: Float -> SPic -> SPic
rotateSP a = bimap (rotateSH a) (rotate a)
mirrorSPxz :: SPic -> SPic
mirrorSPxz = bimap (reverse . overPosSH flipy) (mirrorxz)
where
flipy (V3 x y z) = V3 x (negate y) z
mirrorSPyz :: SPic -> SPic
mirrorSPyz = bimap (reverse . overPosSH flipx) (mirroryz)
where
flipx (V3 x y z) = V3 (negate x) y z