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

Work on AttachUse -> UseAttach

Browse Source
This commit is contained in:
justin
2024-10-01 14:21:40 +01:00
parent 36238669f5
commit f90bbc1cd0
15 changed files with 436 additions and 374 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Picture.hs
+14 -49
View File
@@ -9,26 +9,24 @@ module Dodge.Creature.Picture (
deadFeet,
) where
import Dodge.Item.Grammar
import Shape
import Control.Lens
import Dodge.Creature.HandPos (translateToLeftHand, translateToRightHand)
import Dodge.Creature.Test
import Dodge.Damage
import Dodge.Data.Creature
import Dodge.Item.Draw
import Dodge.Item.Grammar
import Geometry
import Picture
import qualified Quaternion as Q
import Shape
--import Shape
import ShapePicture
basicCrPict :: Creature -> SPic
basicCrPict cr = uncurryV translateSPxy (_crPos cr) (rotateSP (_crDir cr) $ drawEquipment cr)
<> noPic (basicCrShape cr)
--testShape :: Shape
--testShape = translateSHz 10 . rotateSHx 1 . upperCylinder 20 $ polyCirc 2 10
basicCrPict cr =
uncurryV translateSPxy (_crPos cr) (rotateSP (_crDir cr) $ drawEquipment cr)
<> noPic (basicCrShape cr)
basicCrShape ::
Creature ->
@@ -53,22 +51,15 @@ feet :: Creature -> Shape
{-# INLINE feet #-}
feet cr = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) ->
mconcat
[ translateSHxy (f sa) off aFoot
, translateSHxy (- f sa) (- off) aFoot
]
translateSHxy (f sa) off aFoot
<> translateSHxy (- f sa) (- off) aFoot
Just (Walking sa RightForward) ->
mconcat
[ translateSHxy (- f sa) off aFoot
, translateSHxy (f sa) (- off) aFoot
]
translateSHxy (- f sa) off aFoot
<> translateSHxy (f sa) (- off) aFoot
_ ->
mconcat
[ translateSHxy 0 off aFoot
, translateSHxy 0 (- off) aFoot
]
translateSHxy 0 off aFoot
<> translateSHxy 0 (- off) aFoot
where
aFoot :: Shape
aFoot = upperPrismPolyST 10 $ polyCirc 3 4
off = 5
sLen = _strideLength $ _crStance cr
@@ -76,29 +67,7 @@ feet cr = case cr ^? crStance . carriage of
deadFeet :: Creature -> Shape
{-# INLINE deadFeet #-}
deadFeet = feet
--cr = case cr ^? crStance . carriage of
-- Just (Walking sa LeftForward) ->
-- mconcat
-- [ translateSHxy (f sa) off aFoot
-- , translateSHxy (- f sa) (- off) aFoot
-- ]
-- Just (Walking sa RightForward) ->
-- mconcat
-- [ translateSHxy (- f sa) off aFoot
-- , translateSHxy (f sa) (- off) aFoot
-- ]
-- _ ->
-- mconcat
-- [ translateSHxy 0 off aFoot
-- , translateSHxy 0 (- off) aFoot
-- ]
-- where
-- aFoot :: Shape
-- aFoot = upperPrismPolyT 3 $ polyCirc 3 4
-- off = 5
-- sLen = _strideLength $ _crStance cr
-- f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen
deadFeet = feet
arms :: Creature -> Shape
{-# INLINE arms #-}
@@ -162,15 +131,11 @@ baseShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI
upperBody :: Creature -> Shape
{-# INLINE upperBody #-}
upperBody cr =
mconcat
[ arms cr
, shoulderSH $ torso cr
]
upperBody cr = arms cr <> shoulderSH (torso cr)
shoulderSH :: Shape -> Shape
shoulderSH = translateSHz 20
drawEquipment :: Creature -> SPic
{-# INLINE drawEquipment #-}
drawEquipment cr = foldMap (itemEquipPict cr . fmap (\(a,b,_) -> (a,b))) (invLDT $ _crInv cr)
drawEquipment cr = foldMap (itemEquipPict cr . fmap (\(a, b, _) -> (a, b))) (invLDT $ _crInv cr)