Work on crab corpse

2026-04-10 09:48:06 +01:00
parent 8faaf54f2c
commit a29cb8565a
4 changed files with 113 additions and 108 deletions
@@ -1,67 +0,0 @@
-module Dodge.Corpse.Make (makeCorpse) where
-
-import qualified Quaternion as Q
-import Linear
-import Control.Lens
-import Dodge.Creature.Picture
-import Dodge.Creature.Radius
-import Dodge.Creature.Shape
--import Dodge.Data.Corpse
-import Dodge.Data.Creature
-import Geometry
-import Shape
-import ShapePicture
-import RandomHelp
-
-makeCorpse :: StdGen -> Creature -> SPic
-makeCorpse g cr = case cr ^. crType of
-    HoverCrit{} -> noPic $ drawHoverCrit cr
-    ChaseCrit{} -> noPic $ chaseCorpse g cr
-    CrabCrit{} -> noPic $ crabCorpse g cr
-    _ ->
-        noPic
-            . scaleSH (V3 crsize crsize crsize)
-            $ mconcat
-                [ colorSH (_skinHead cskin) $ deadScalp cr
-                , colorSH (_skinUpper cskin) $ deadUpperBody cr
-                , rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
-                ]
-  where
-    cskin = crShape $ _crType cr -- this should be fixed
-    crsize = 0.1 * crRad (cr ^. crType)
-    rotmdir = rotateSH (_crMvDir cr - _crDir cr)
-
-chaseCorpse :: StdGen -> Creature -> Shape
-chaseCorpse g cr = mconcat
-            [colorSH (_skinUpper cskin) . upperPrismPolyHalfMI 0 $ polyCirc 3 12 
-                & each %~ vNormal
-                & each . _y *~ 0.6
-            , colorSH (_skinUpper cskin) . overPosSH (Q.apply neckq) $ 
-                upperPrismPolyHalfMI 3 ((+ V2 8 0) . vNormal <$> trapTBH 2 5 8)
-    , colorSH (_skinHead cskin)
-        (overPosSH (Q.apply headq) (upperBox Medium Important 2 [V2 0 (-4), V2 9 0, V2 0 4]))
-            , rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
-        ]
-  where
-    neckq = (V3 6 0 0, Q.qz a)
-    (a,g') = randomR (-2,2) g
-    b = fst $ randomR (-2,2) g'
-    cskin = crShape $ _crType cr -- this should be fixed
-    rotmdir = rotateSH (_crMvDir cr - _crDir cr)
-    headq = neckq `Q.comp` (V3 16 0 0, Q.qz b )
-
-crabCorpse :: StdGen -> Creature -> Shape
-crabCorpse g cr = mconcat
-    [ colorSH (_skinUpper cskin) $ overPosSH (Q.apply torsoq) (upperPrismPolyHalfMI 5 $ polyCirc 4 10 
-        & each . _x *~ 0.6) 
-    , colorSH (_skinUpper cskin) $ overPosSH (Q.apply lclawq) (upperPrismPolyHalfMI 4 $ rectNSWE 20 0 (-2) 2)
-    <> overPosSH (Q.apply rclawq) (upperPrismPolyHalfMI 4 $ rectNSWE 0 (-20) (-2) 2)
-        ]
-  where
-    torsoq = (V3 0 0 0,Q.qid)
-    -- not sure which rotation is done first
-    lclawq = torsoq `Q.comp` (V3 2 8 1, Q.axisAngle (V3 1 0 0) (-0.1) * Q.qz la)
-    (la,g') =  randomR (-2,2) g
-    ra = fst $ randomR (-2,2) g'
-    rclawq = torsoq `Q.comp` (V3 2 (-8) 1, Q.axisAngle (V3 1 0 0) (0.1) * Q.qz ra)
-    cskin = crShape $ _crType cr -- this should be fixed
@@ -10,8 +10,10 @@ module Dodge.Creature.Picture (
    drawChaseCrit,
    drawHoverCrit,
    drawCrabCrit,
+    makeCorpse,
 ) where

+import RandomHelp
 import Dodge.Base.Collide
 import Control.Monad
 import Data.Maybe
@@ -107,7 +109,7 @@ crabUpperBody _ cr =  colorSH (_skinUpper cskin)
    ratck = Q.axisAngle (V3 0 0 1) (0.5 * pi)
    rrest = Q.axisAngle (V3 1 0 0) (-1)
    rcool = 1 - min 10 (fromIntegral . _meleeCooldownR $ _crType cr) / 10
-    headq = torsoq `Q.comp` (V3 0 0 5, Q.qid)
+    headq = torsoq `Q.comp` (V3 3 0 4, Q.qid)
 --    headq = torsoq `Q.comp` (V3 0 0 5, (Q.qz aimrot ))
 --    cxy = cr ^. crPos . _xy
 --    aimrot = fromMaybe pi $ do
@@ -221,6 +223,75 @@ spiderJoint' p l1 l2 q = (f $ Q.axisAngle (V3 0 (-1) 0) (pi - (a+b)), f . Q.axis
    c = argV $ (p-q) ^. _xy
    f x = Q.qz c * x

+makeCorpse :: StdGen -> Creature -> SPic
+makeCorpse g cr = case cr ^. crType of
+    HoverCrit{} -> noPic $ drawHoverCrit cr
+    ChaseCrit{} -> noPic $ chaseCorpse g cr
+    CrabCrit{} -> noPic $ crabCorpse g cr
+    _ ->
+        noPic
+            . scaleSH (V3 crsize crsize crsize)
+            $ mconcat
+                [ colorSH (_skinHead cskin) $ deadScalp cr
+                , colorSH (_skinUpper cskin) $ deadUpperBody cr
+                , rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
+                ]
+  where
+    cskin = crShape $ _crType cr -- this should be fixed
+    crsize = 0.1 * crRad (cr ^. crType)
+    rotmdir = rotateSH (_crMvDir cr - _crDir cr)
+
+chaseCorpse :: StdGen -> Creature -> Shape
+chaseCorpse g cr = mconcat
+            [colorSH (_skinUpper cskin) . upperPrismPolyHalfMI 0 $ polyCirc 3 12 
+                & each %~ vNormal
+                & each . _y *~ 0.6
+            , colorSH (_skinUpper cskin) . overPosSH (Q.apply neckq) $ 
+                upperPrismPolyHalfMI 3 ((+ V2 8 0) . vNormal <$> trapTBH 2 5 8)
+    , colorSH (_skinHead cskin)
+        (overPosSH (Q.apply headq) (upperBox Medium Important 2 [V2 0 (-4), V2 9 0, V2 0 4]))
+            , rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
+        ]
+  where
+    neckq = (V3 6 0 0, Q.qz a)
+    (a,g') = randomR (-2,2) g
+    b = fst $ randomR (-2,2) g'
+    cskin = crShape $ _crType cr -- this should be fixed
+    rotmdir = rotateSH (_crMvDir cr - _crDir cr)
+    headq = neckq `Q.comp` (V3 16 0 0, Q.qz b )
+
+crabCorpse :: StdGen -> Creature -> Shape
+crabCorpse g cr = mconcat
+    [ colorSH (_skinUpper cskin) $ overPosSH (Q.apply torsoq) (upperPrismPolyHalfMI 5 $ polyCirc 4 10 
+        & each . _x *~ 0.6) 
+    , colorSH (_skinUpper cskin) $ overPosSH (Q.apply lclawq) (upperPrismPolyHalfMI 4 $ rectNSWE 20 0 (-2) 2)
+    <> overPosSH (Q.apply rclawq) (upperPrismPolyHalfMI 4 $ rectNSWE 0 (-20) (-2) 2)
+    , colorSH (cskin ^?! skinLower) $
+        (foldMap (mkfoot 5) [p1,p2])
+        <> (foldMap (mkfoot (-5)) [p3,p4])
+    , colorSH (_skinHead cskin)
+        --(overPosSH (Q.apply headq) (upperPrismPolyHalfMI 2 $ [V2 0 (-4), V2 2 (-2), 2, V2 0 4]))
+        (overPosSH (Q.apply headq) (upperPrismPolyHalfMI 1 $ square 2))
+        ]
+  where
+    headq = torsoq `Q.comp` (V3 3 0 4, Q.qid)
+    torsoq = (V3 0 0 0,Q.qid)
+    -- not sure which rotation is done first
+    lclawq = torsoq `Q.comp` (V3 2 8 1, Q.axisAngle (V3 1 0 0) (-0.1) * Q.qz la)
+    (la,g') =  randomR (-2,2) g
+    ra = fst $ randomR (-2,2) g'
+    p1 = 0 & _xy .~ p1' + V2 0 15
+    p2 = 0 & _xy .~ p2' + V2 0 15
+    p3 = 0 & _xy .~ p3' - V2 0 15
+    p4 = 0 & _xy .~ p4' - V2 0 15
+    (p1':p2':p3':p4':_) = evalState (replicateM 4 (randInCirc 9)) g
+    mkfoot y p = let (q1,q2) = spiderJoint (V3 0 y 0) p
+        in (afoot & each . sfVs . each %~ Q.apply (V3 0 y 0, q1))
+            <> (afoot & each . sfVs . each %~ Q.apply (p,q2))
+    afoot = upperPrismPolyST 10 $ polyCirc 3 2
+    rclawq = torsoq `Q.comp` (V3 2 (-8) 1, Q.axisAngle (V3 1 0 0) (0.1) * Q.qz ra)
+    cskin = crShape $ _crType cr -- this should be fixed
+
 deadFeet :: Creature -> Shape
 {-# INLINE deadFeet #-}
 deadFeet = feet
@@ -1,6 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
 module Dodge.Creature.Update (updateCreature) where

+import Dodge.Creature.Picture
 import Dodge.Base.You
 import Control.Monad
 import Color
@@ -8,7 +9,6 @@ import qualified Data.IntMap.Strict as IM
 import Data.Maybe
 import Dodge.Barreloid
 -- import Dodge.Base.NewID
-import Dodge.Corpse.Make
 import Dodge.Creature.Action
 import Dodge.Creature.State
 import Dodge.Creature.State.WalkCycle
@@ -56,7 +56,7 @@ updateLivingCreature cr =
                over (cWorld . lWorld . creatures . ix cid) (chaseCritInternal w) w
        CrabCrit{} -> \w ->
            crUpdate cid . performActions cid $
-                (crabCritInternal cid) w
+                crabCritInternal cid w
        AutoCrit {} -> crUpdate cid
        SwarmCrit {} -> crUpdate cid
        HoverCrit {} -> \w ->