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

Check whether tests compile in ghcid

Browse Source
This commit is contained in:
justin
2026-03-29 15:50:58 +01:00
parent 7b9635fe53
commit d278083947
11 changed files with 95 additions and 84 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/HandPos.hs
+30 -38
View File
@@ -1,4 +1,5 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Creature.HandPos (
equipSitePQ,
translatePointToLeftHand,
@@ -13,16 +14,16 @@ module Dodge.Creature.HandPos (
rightHandPQ,
) where
import Dodge.Data.Equipment.Misc
import qualified Quaternion as Q
import Control.Lens
import Dodge.Creature.Test
import Dodge.Data.Creature
import Dodge.Data.Equipment.Misc
import Geometry
import qualified Quaternion as Q
import ShapePicture
translateToES :: Creature -> EquipSite -> Point3 -> Point3
translateToES cr es p = fst (equipSitePQ es cr `Q.comp` (p,Q.qID))
translateToES cr es p = fst (equipSitePQ es cr `Q.comp` (p, Q.qID))
equipSitePQ :: EquipSite -> Creature -> Point3Q
equipSitePQ = \case
@@ -31,24 +32,26 @@ equipSitePQ = \case
OnHead -> headPQ
OnChest -> chestPQ
OnBack -> backPQ
OnLeftLeg -> leftLegPQ
OnRightLeg -> rightLegPQ
OnLeftLeg -> legPQ LeftForward
OnRightLeg -> legPQ RightForward
translatePointToRightHand :: Creature -> Point3 -> Point3
translatePointToRightHand cr p = fst (rightHandPQ cr `Q.comp` (p,Q.qID))
translatePointToRightHand cr p = fst (rightHandPQ cr `Q.comp` (p, Q.qID))
handWalkingPos :: FootForward -> Float -> Creature -> Point3
handWalkingPos b off cr = case cr ^. crStance . carriage of
Walking sa ff ->
Walking sa ff ->
let slen = cr ^. crStance . strideLength
f i | ff == b = 8 * (slen - i) / slen
f i
| ff == b = 8 * (slen - i) / slen
| otherwise = 8 * i / slen
in V3 (f sa) off 12
in V3 (f sa) off 12
Falling sa ff ->
let slen = cr ^. crStance . strideLength
f i | ff == b = 8 * (slen - i) / slen
f i
| ff == b = 8 * (slen - i) / slen
| otherwise = 8 * i / slen
in V3 (f sa) off 20
in V3 (f sa) off 20
Floating -> V3 0 off 12
Flying -> V3 0 off 12
Boosting _ -> V3 0 off 12
@@ -56,7 +59,7 @@ handWalkingPos b off cr = case cr ^. crStance . carriage of
rightHandPQ :: Creature -> Point3Q
rightHandPQ cr
| oneH cr = (V3 11 (-3) 20, Q.qID)
| twists cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 4 (-10) 0,Q.qID)
| twists cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 4 (-10) 0, Q.qID)
| twoFlat cr = (V3 4 (-8) 12, Q.qID)
| otherwise = (handWalkingPos LeftForward (-8) cr, Q.qID)
@@ -74,7 +77,7 @@ leftHandPQ cr
| otherwise = (handWalkingPos RightForward 8 cr, Q.qID)
translatePointToLeftHand :: Creature -> Point3 -> Point3
translatePointToLeftHand cr p = fst (leftHandPQ cr `Q.comp` (p,Q.qID))
translatePointToLeftHand cr p = fst (leftHandPQ cr `Q.comp` (p, Q.qID))
translateToLeftHand :: Creature -> SPic -> SPic
translateToLeftHand = overPosSP . translatePointToLeftHand
@@ -82,27 +85,19 @@ translateToLeftHand = overPosSP . translatePointToLeftHand
leftWristPQ :: Creature -> Point3Q
leftWristPQ cr = leftHandPQ cr `Q.comp` (V3 0 4 (-4), Q.qID)
leftLegPQ :: Creature -> Point3Q
leftLegPQ cr = Q.comp (0,Q.qz (_crMvDir cr - _crDir cr))
(V3 x off 0,Q.qID)
where
x = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> f sa
Just (Walking sa RightForward) -> - f sa
Just (Falling sa LeftForward) -> f sa
Just (Falling sa RightForward) -> - f sa
_ -> 0
off = 5
sLen = _strideLength $ _crStance cr
f i = 8 * (sLen - i) / sLen
translateToLeftLeg :: Creature -> SPic -> SPic
translateToLeftLeg cr = overPosSP (\p -> fst (leftLegPQ cr `Q.comp` (p,Q.qID)))
translateToLeftLeg cr = overPosSP (\p -> fst (legPQ LeftForward cr `Q.comp` (p, Q.qID)))
rightLegPQ :: Creature -> Point3Q
rightLegPQ cr = Q.comp (0,Q.qz (_crMvDir cr - _crDir cr))
(V3 x off 0,Q.qID)
legPQ :: FootForward -> Creature -> Point3Q
legPQ ff = case ff of
LeftForward -> legPQ' id
RightForward -> legPQ' negate
legPQ' :: (Float -> Float) -> Creature -> Point3Q
legPQ' g cr =
Q.comp
(0, Q.qz (_crMvDir cr - _crDir cr))
(V3 x (g off) 0, Q.qID)
where
x = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> -f sa
@@ -112,10 +107,10 @@ rightLegPQ cr = Q.comp (0,Q.qz (_crMvDir cr - _crDir cr))
_ -> 0
off = -5
sLen = _strideLength $ _crStance cr
f i = 8 * (sLen - i) / sLen
f i = g 8 * (sLen - i) / sLen
translateToRightLeg :: Creature -> SPic -> SPic
translateToRightLeg cr = overPosSP (\p -> fst (rightLegPQ cr `Q.comp` (p,Q.qID)))
translateToRightLeg cr = overPosSP (\p -> fst (legPQ RightForward cr `Q.comp` (p, Q.qID)))
headPQ :: Creature -> Point3Q
headPQ cr
@@ -123,11 +118,8 @@ headPQ cr
| 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))
chestPQ :: Creature -> Point3Q
chestPQ cr = backPQ cr `Q.comp` (0,Q.qz pi)
chestPQ cr = backPQ cr `Q.comp` (0, Q.qz pi)
backPQ :: Creature -> Point3Q
backPQ cr
src/Dodge/Data/Creature/Stance.hs
+1 -1
View File
@@ -20,7 +20,7 @@ data Stance = Stance
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data Carriage
= Walking {_strideAmount :: Float, _currentFoot :: FootForward}
= Walking {_strideAmount :: Float, _footForward :: FootForward}
| Floating
| Flying
| Boosting Point2
src/Dodge/Door.hs
+1
View File
@@ -28,6 +28,7 @@ updateDoor dr w = case dr ^. drUpdate of
, foldl' (doDoorMount (doDoorLerp dr (dr ^. drLerp))) w (dr ^. drMounts)
)
-- could filter these HERE rather than later?
doDoorMount :: Point2A -> World -> MountedObject -> World
doDoorMount pa w = \case
MountedLight p r c ->
src/Dodge/Item/HeldOffset.hs
+4 -3
View File
@@ -7,6 +7,7 @@ module Dodge.Item.HeldOffset (
handHandleOrient,
) where
import Linear
import Dodge.Creature.HandPos
import Dodge.Data.AimStance
import Dodge.Data.ComposedItem
@@ -26,9 +27,7 @@ turretItemOffset it tu mc =
. transToHandle it
transToHandle :: Item -> Point3 -> Point3
transToHandle itm = (-.-.- V3 x y 0)
where
V2 x y = handlePos itm
transToHandle itm = (-.-.- (0 & _xy .~ handlePos itm))
handleOrient :: LocationDT CItem -> Point3Q
handleOrient loc = case loc ^. locDT . dtValue . _1 . itType of
@@ -68,6 +67,8 @@ strideRot :: Creature -> Float
strideRot cr = case cr ^? crStance . carriage of
Just (Walking x LeftForward) -> f x
Just (Walking x RightForward) -> - f x
Just (Falling x LeftForward) -> f x
Just (Falling x RightForward) -> - f x
_ -> 0
where
f i = 0.1 * (sLen - i) / sLen
src/Dodge/Room/Tutorial.hs
+3
View File
@@ -55,6 +55,9 @@ tutAnoTree = do
foldMTRS
[ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
, corDoor
, lasRunYinYang
, corDoor
, corDoor
, tToBTree "slowCrush" . return . cleatOnward <$> pushCaverns
, corDoor
, chasmSpitTerminal
src/Geometry/Vector.hs
+4 -2
View File
@@ -59,9 +59,11 @@ angleVV :: Point2 -> Point2 -> Float
{-# INLINE angleVV #-}
angleVV a b
| a == b = 0
| norm a == 0 = 0
| norm b == 0 = 0
| otherwise =
let ma = magV a
mb = magV b
let ma = norm a
mb = norm b
d = a `dotV` b
in acos $ d / (ma * mb)