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

Continue to refactor body/equipment positionings

Browse Source
This commit is contained in:
justin
2025-08-27 14:40:13 +01:00
parent 9d2a2e6730
commit 86696deb56
14 changed files with 151 additions and 189 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Corpse/Make.hs
+4 -5
View File
@@ -9,10 +9,9 @@ import Dodge.Data.Creature
import Geometry
import Shape
import ShapePicture
import qualified Data.IntMap.Strict as IM
makeCorpse :: IM.IntMap Item -> Creature -> Corpse
makeCorpse m cr =
makeCorpse :: Creature -> Corpse
makeCorpse cr =
defaultCorpse
& cpPos .~ _crPos cr
& cpDir .~ _crDir cr
@@ -20,8 +19,8 @@ makeCorpse m cr =
.~ noPic
( scaleSH (V3 crsize crsize crsize) $
mconcat
[ colorSH (_skinHead cskin) $ deadScalp m cr
, colorSH (_skinUpper cskin) $ deadUpperBody m cr
[ colorSH (_skinHead cskin) $ deadScalp cr
, colorSH (_skinUpper cskin) $ deadUpperBody cr
, rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
]
)
src/Dodge/Creature/HandPos.hs
+8 -29
View File
@@ -1,14 +1,10 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Creature.HandPos (
equipSitePQ,
translatePointToLeftHand,
translatePointToRightHand,
translatePointToHead,
translateToLeftWrist,
translateToRightWrist,
translateToLeftLeg,
translateToRightLeg,
translateToHead,
translateToChest,
translateToLeftHand,
translateToRightHand,
backPQ,
@@ -17,7 +13,6 @@ module Dodge.Creature.HandPos (
) where
import Dodge.Data.Equipment.Misc
import qualified Data.IntMap.Strict as IM
import qualified Quaternion as Q
import Control.Lens
import Dodge.Creature.Test
@@ -35,11 +30,8 @@ equipSitePQ = \case
OnHead -> headPQ
OnChest -> chestPQ
OnBack -> backPQ
OnLegs -> legsPQ
legsPQ :: a
legsPQ = undefined
OnLeftLeg -> leftLegPQ
OnRightLeg -> rightLegPQ
translatePointToRightHand :: Creature -> Point3 -> Point3
translatePointToRightHand cr p = fst (rightHandPQ cr `Q.comp` (p,Q.qID))
@@ -70,10 +62,6 @@ rightHandPQ cr
translateToRightHand :: Creature -> SPic -> SPic
translateToRightHand = overPosSP . translatePointToRightHand
translateToRightWrist :: Creature -> SPic -> SPic
translateToRightWrist cr = overPosSP
(\p -> fst $ rightHandPQ cr `Q.comp` (V3 0 (-4) (-4)+p, Q.qID))
rightWristPQ :: Creature -> Point3Q
rightWristPQ cr = rightHandPQ cr `Q.comp` (V3 0 (-4) (-4), Q.qID)
@@ -95,13 +83,10 @@ leftHandPQ cr
translatePointToLeftHand :: Creature -> Point3 -> Point3
translatePointToLeftHand cr p = fst (leftHandPQ cr `Q.comp` (p,Q.qID))
translateToLeftHand :: IM.IntMap Item -> Creature -> SPic -> SPic
translateToLeftHand m = overPosSP . translatePointToLeftHand
translateToLeftWrist :: Creature -> SPic -> SPic
translateToLeftWrist cr = overPosSP
(\p -> fst $ leftHandPQ cr `Q.comp` (V3 0 4 (-4)+p, Q.qID))
translateToLeftHand :: Creature -> SPic -> SPic
translateToLeftHand = overPosSP . translatePointToLeftHand
leftWristPQ :: Creature -> Point3Q
leftWristPQ cr = leftHandPQ cr `Q.comp` (V3 0 4 (-4), Q.qID)
leftLegPQ :: Creature -> Point3Q
@@ -135,24 +120,18 @@ rightLegPQ cr = Q.comp (0,Q.qz (_crMvDir cr - _crDir cr))
translateToRightLeg :: Creature -> SPic -> SPic
translateToRightLeg cr = overPosSP (\p -> fst (rightLegPQ cr `Q.comp` (p,Q.qID)))
translateToHead :: IM.IntMap Item -> Creature -> SPic -> SPic
translateToHead m cr = overPosSP (\p -> fst (headPQ cr `Q.comp` (p,Q.qID)))
headPQ :: Creature -> Point3Q
headPQ cr
| twists cr = (V3 0 2 20, Q.qz (-1)) `Q.comp` (V3 (negate 2.5) 0.25 0, Q.qz 1)
| oneH cr = (V3 0 0 20, Q.qz 0.5) `Q.comp` (V3 2.5 0 0, Q.qz (-0.5))
| otherwise = (V3 2.5 0 20, Q.qID)
translatePointToHead :: IM.IntMap Item -> Creature -> Point3 -> Point3
translatePointToHead m cr p = fst (headPQ cr `Q.comp` (p,Q.qID))
--translatePointToHead :: IM.IntMap Item -> Creature -> Point3 -> Point3
--translatePointToHead m cr p = fst (headPQ cr `Q.comp` (p,Q.qID))
chestPQ :: Creature -> Point3Q
chestPQ cr = backPQ cr `Q.comp` (0,Q.qz pi)
translateToChest :: IM.IntMap Item -> Creature -> SPic -> SPic
translateToChest m cr = overPosSP (\p -> fst $ chestPQ cr `Q.comp` (p,Q.qID))
backPQ :: Creature -> Point3Q
backPQ cr
| oneH cr = (V3 0 0 10, Q.qz 0.5)
src/Dodge/Creature/Picture.hs
+19 -26
View File
@@ -9,6 +9,7 @@ module Dodge.Creature.Picture (
deadFeet,
) where
import Dodge.Data.Equipment.Misc
import Dodge.Creature.HandPos
import qualified Data.IntMap.Strict as IM
import Control.Lens
@@ -27,19 +28,19 @@ import Shape
import ShapePicture
basicCrPict :: IM.IntMap Item -> Creature -> SPic
basicCrPict m cr = drawEquipment m cr <> noPic (basicCrShape m cr)
basicCrPict m cr = drawEquipment m cr <> noPic (basicCrShape cr)
crCamouflage :: Creature -> CamouflageStatus
crCamouflage _ = FullyVisible
basicCrShape :: IM.IntMap Item -> Creature -> Shape
basicCrShape m cr
basicCrShape :: Creature -> Shape
basicCrShape cr
| crCamouflage cr == Invisible = mempty
| otherwise =
scaleSH (V3 crsize crsize crsize) $
mconcat
[ colorSH (_skinHead cskin) $ scalp m cr
, colorSH (_skinUpper cskin) $ upperBody m cr
[ colorSH (_skinHead cskin) $ scalp cr
, colorSH (_skinUpper cskin) $ upperBody cr
, rotmdir $ colorSH (_skinLower cskin) $ feet cr
]
where
@@ -68,17 +69,17 @@ deadFeet :: Creature -> Shape
{-# INLINE deadFeet #-}
deadFeet = feet
arms :: IM.IntMap Item -> Creature -> Shape
arms :: Creature -> Shape
{-# INLINE arms #-}
arms m cr =
arms cr =
(^. _1) $
translateToRightHand cr aHand
<> translateToLeftHand m cr aHand
<> translateToLeftHand cr aHand
where
aHand = noPic $ translateSHz (-4) . upperPrismPolyHalfST 4 $ polyCirc 3 4
deadScalp :: IM.IntMap Item -> Creature -> Shape
deadScalp m cr = deadRot cr . translateSHz 10 . scalp m $ cr
deadScalp :: Creature -> Shape
deadScalp cr = deadRot cr . translateSHz 10 . scalp $ cr
deadRot :: Creature -> Shape -> Shape
deadRot cr = overPosSH (Q.rotateToZ d)
@@ -89,9 +90,9 @@ deadRot cr = overPosSH (Q.rotateToZ d)
(addZ 0 . unitVectorAtAngle . subtract (_crDir cr + pi))
(damageDirection $ _crDamage cr)
scalp :: IM.IntMap Item -> Creature -> Shape
scalp :: Creature -> Shape
{-# INLINE scalp #-}
scalp m cr = overPosSH (\p -> fst (headPQ cr `Q.comp` (p,Q.qID))) fhead
scalp cr = overPosSH (translateToES cr OnHead) fhead
-- | twists cr = translateSHxy 0 5 . rotateSH (-1) $ translateSHxy (negate 2.5) 0.25 fhead
-- | oneH cr = rotateSH 0.5 $ translateSHxy 2.5 0 fhead
-- | otherwise = translateSHxy 2.5 0 fhead
@@ -100,15 +101,7 @@ scalp m cr = overPosSH (\p -> fst (headPQ cr `Q.comp` (p,Q.qID))) fhead
torso :: Creature -> Shape
{-# INLINE torso #-}
torso cr = overPosSH (\p -> fst (backPQ cr `Q.comp` (p,Q.qID))) tsh
-- | oneH cr = rotateSH 0.5 tsh
-- | twists cr =
-- translateSHxy 0 3 . rotateSH (-1.3) $ tsh
---- mconcat
---- [ rotateSH (negate 0.2) . translateSHxy 2 3 . rotateSH (negate 0.4) $ aShoulder
---- , rotateSH (negate 0.2) . translateSHxy 0 (negate 3) . rotateSH 0.2 $ aShoulder
---- ]
-- | otherwise = tsh
torso cr = overPosSH (translateToES cr OnBack) tsh
where
tsh =
mconcat
@@ -117,20 +110,20 @@ torso cr = overPosSH (\p -> fst (backPQ cr `Q.comp` (p,Q.qID))) tsh
]
aShoulder = scaleSH (V3 10 10 1) baseShoulder
deadUpperBody :: IM.IntMap Item -> Creature -> Shape
deadUpperBody m cr = deadRot cr . translateSHz (negate 10) . upperBody m $ cr
deadUpperBody :: Creature -> Shape
deadUpperBody cr = deadRot cr . translateSHz (negate 10) . upperBody $ cr
baseShoulder :: Shape
{-# INLINE baseShoulder #-}
baseShoulder = translateSHz (-20) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1
upperBody :: IM.IntMap Item -> Creature -> Shape
upperBody :: Creature -> Shape
{-# INLINE upperBody #-}
upperBody m cr = arms m cr <> shoulderSH (torso cr)
upperBody cr = arms cr <> shoulderSH (torso cr)
shoulderSH :: Shape -> Shape
shoulderSH = translateSHz 20
drawEquipment :: IM.IntMap Item -> Creature -> SPic
{-# INLINE drawEquipment #-}
drawEquipment m cr = foldMap (itemEquipPict m cr) (invDT . fmap (\i -> m ^?! ix i) $ _crInv cr)
drawEquipment m cr = foldMap (itemEquipPict cr) (invDT . fmap (\i -> m ^?! ix i) $ _crInv cr)
src/Dodge/Creature/Test.hs
-2
View File
@@ -26,11 +26,9 @@ module Dodge.Creature.Test (
import NewInt
import qualified Data.IntMap.Strict as IM
import Dodge.Item.Grammar
import Dodge.Creature.Radius
import Dodge.Data.Equipment.Misc
import Dodge.Data.AimStance
import Dodge.Item.AimStance
import Control.Lens
import Data.List (find)
import Data.Maybe
src/Dodge/Creature/Update.hs
+1 -1
View File
@@ -107,7 +107,7 @@ corpseOrGib cr w = w & case cr ^? crDamage . to maxDamageType . _Just . _1 of
_ -> addcorpse thecorpse
where
addcorpse ctype = plNew (cWorld . lWorld . corpses) cpID ctype
thecorpse = makeCorpse (w ^. cWorld . lWorld . items) cr
thecorpse = makeCorpse cr
scorchSPic :: SPic -> SPic
scorchSPic = _1 %~ overColSH (mixColors 0.9 0.1 black . normalizeColor)
src/Dodge/Data/EquipType.hs
+3 -3
View File
@@ -22,9 +22,9 @@ eitType = \case
BRAINHAT -> GoesOnHead
HAT -> GoesOnHead
HEADLAMP -> GoesOnHead
POWERLEGS -> GoesOnLegs
SPEEDLEGS -> GoesOnLegs
JUMPLEGS -> GoesOnLegs
POWERLEGS -> GoesOnLeg
SPEEDLEGS -> GoesOnLeg
JUMPLEGS -> GoesOnLeg
FUELPACK -> GoesOnBack
BULLETBELTPACK -> GoesOnBack
BULLETBELTBRACER -> GoesOnWrist
src/Dodge/Data/Equipment/Misc.hs
+3 -2
View File
@@ -13,7 +13,7 @@ data EquipType
| GoesOnChest
| GoesOnBack
| GoesOnWrist
| GoesOnLegs
| GoesOnLeg
deriving (Eq, Ord, Show, Read)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
@@ -24,7 +24,8 @@ data EquipSite
| OnBack
| OnLeftWrist
| OnRightWrist
| OnLegs
| OnLeftLeg
| OnRightLeg
-- | OnSpecial
deriving (Eq, Ord, Show, Read)
src/Dodge/Equipment.hs
+6 -9
View File
@@ -6,8 +6,6 @@ module Dodge.Equipment (
import Control.Lens
import Data.Maybe
import Dodge.Creature.HandPos
import Dodge.Creature.Test
import Dodge.Data.Equipment.Misc
import Dodge.Data.World
import Dodge.Item.Location
import Dodge.Wall.Delete
@@ -50,13 +48,12 @@ setWristShieldPos :: Item -> Creature -> World -> World
setWristShieldPos itm cr w = w & moveWallIDUnsafe i wlline
where
i = _itParamID $ _itParams itm
m = w ^. cWorld . lWorld . items
wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
invid = _ilInvID (_itLocation itm)
handtrans = case cr ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k . itLocation . ilEquipSite . _Just of
Just OnLeftWrist -> \cr' -> translatePointToLeftHand cr' . g
_ -> translatePointToRightHand
g
| twists cr = (+.+.+ V3 (-5) 10 0)
| otherwise = id
f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr
Just x -> translateToES cr x -- . g
_ -> undefined
-- g
-- | twists cr = (+.+.+ V3 (-5) 10 0)
-- | otherwise = id
f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans
src/Dodge/Equipment/Text.hs
+2 -3
View File
@@ -9,6 +9,5 @@ eqPosText ep = case ep of
OnBack -> "BACK"
OnLeftWrist -> "L.WRIST"
OnRightWrist -> "R.WRIST"
OnLegs -> "LEGS"
-- OnSpecial -> "EQUIPPED"
OnLeftLeg -> "L.LEG"
OnRightLeg -> "R.LEG"
src/Dodge/Euse.hs
+1 -2
View File
@@ -35,7 +35,6 @@ useMagShield mt _ cr w =
setWristShieldPos :: Item -> Creature -> EquipSite -> World -> World
setWristShieldPos itm cr x w = moveWallIDUnsafe i wlline w
where
m = w ^. cWorld . lWorld . items
i = _itParamID $ _itParams itm
wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
handtrans = case x of
@@ -58,6 +57,6 @@ createHeadLamp _ cr w = w &
cWorld . lWorld . lights
.:~ LSParam
((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr)
(translatePointToHead (w ^. cWorld . lWorld . items) cr (V3 5 0 3)))
(translateToES cr OnHead (V3 5 0 3)))
200
0.7
src/Dodge/Inventory/RBList.hs
+1 -1
View File
@@ -80,4 +80,4 @@ eqTypeToSites es = case es of
GoesOnChest -> [OnChest]
GoesOnBack -> [OnBack]
GoesOnWrist -> [OnLeftWrist, OnRightWrist]
GoesOnLegs -> [OnLegs]
GoesOnLeg -> [OnLeftLeg,OnRightLeg]
src/Dodge/Item/Draw.hs
+23 -22
View File
@@ -4,7 +4,6 @@ module Dodge.Item.Draw (
itemEquipPict,
) where
import qualified Data.IntMap.Strict as IM
import qualified Quaternion as Q
import Dodge.Data.Equipment.Misc
import Dodge.Data.ComposedItem
@@ -17,12 +16,12 @@ import Dodge.Item.Draw.SPic
import Dodge.Item.HeldOffset
import ShapePicture
itemEquipPict :: IM.IntMap Item -> Creature -> DTree CItem -> SPic
itemEquipPict m cr itmtree
itemEquipPict :: Creature -> DTree CItem -> SPic
itemEquipPict cr itmtree
| --Just i <- itm ^? itLocation . ilInvID
Just esite <- itm ^? itLocation . ilEquipSite . _Just
, Just attachpos <- equipAttachPos <$> itm ^? itType . ibtEquip
= equipPosition esite m cr attachpos (itemSPic itm)
= equipPosition esite cr attachpos (itemSPic itm)
| itm ^? itLocation . ilInvID == cr ^? crManipulation . manObject . imRootSelectedItem
= overPosSP (Q.prePos $ handHandleOrient loc cr) (itemTreeSPic itmtree)
| otherwise = mempty
@@ -30,23 +29,25 @@ itemEquipPict m cr itmtree
itm = itmtree ^. dtValue . _1
loc = LocDT TopDT itmtree
equipAttachPos :: EquipItemType -> Point3
equipAttachPos :: EquipItemType -> Point3Q
equipAttachPos = \case
BATTERYPACK -> V3 (-8) 0 10
FUELPACK -> V3 (-9) 0 10
BULLETBELTPACK -> V3 (-9) 0 10
BULLETBELTBRACER -> V3 (-9) 0 10
_ -> 0
BATTERYPACK -> (V3 (-8) 0 10, Q.qID)
FUELPACK -> (V3 (-9) 0 10, Q.qID)
BULLETBELTPACK -> (V3 (-9) 0 10, Q.qID)
BULLETBELTBRACER -> (V3 (-9) 0 10, Q.qID)
_ -> (0, Q.qID)
equipPosition :: EquipSite -> IM.IntMap Item -> Creature -> Point3 -> SPic -> SPic
equipPosition epos m cr p sh = case epos of
OnLeftWrist -> translateToLeftWrist cr sh
OnRightWrist -> translateToRightWrist cr sh
OnLegs ->
translateToLeftLeg cr sh
<> translateToRightLeg cr sh-- (mirrorSPxz sh)
OnHead -> translateToHead m cr sh
OnChest -> translateToChest m cr sh
--OnBack -> translateToBack cr p sh
OnBack -> overPosSP (\x -> fst $ backPQ cr `Q.comp` (p + x,Q.qID)) sh
-- OnSpecial -> sh
equipPosition :: EquipSite -> Creature -> Point3Q -> SPic -> SPic
equipPosition es cr q = overPosSP
(\x -> fst $ equipSitePQ es cr `Q.comp` q `Q.comp` (x,Q.qID))
-- case epos of
-- --OnLeftWrist -> translateToLeftWrist cr
-- --OnRightWrist -> translateToRightWrist cr
-- OnLeftWrist -> overPosSP (translateToES cr OnLeftWrist)
-- OnRightWrist -> overPosSP (translateToES cr OnRightWrist)
-- OnLegs ->
-- translateToLeftLeg cr
-- <> translateToRightLeg cr-- (mirrorSPxz sh)
-- OnHead -> overPosSP (translateToES cr OnHead)
-- OnChest -> overPosSP (translateToES cr OnChest)
-- OnBack -> overPosSP (\x -> fst $ backPQ cr `Q.comp` (p + x,Q.qID))
src/Dodge/Item/Info.hs
+1 -1
View File
@@ -257,7 +257,7 @@ equipSiteInfo es = case es of
GoesOnChest -> " on the chest"
GoesOnBack -> " on the back"
GoesOnWrist -> " on a wrist"
GoesOnLegs -> " on both legs"
GoesOnLeg -> " on a leg"
--makeCommaList :: [String] -> String
--makeCommaList [] = ""