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

Cleanup

Browse Source
This commit is contained in:
justin
2026-04-10 09:57:45 +01:00
parent a29cb8565a
commit c861de8981
1 changed files with 17 additions and 31 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Picture.hs
+17 -31
View File
@@ -94,12 +94,9 @@ crabUpperBody _ cr = colorSH (_skinUpper cskin)
<> overPosSH (Q.apply rclawq) (upperPrismPolyHalfMI 4 $ rectNSWE 0 (-20) (-2) 2) <> overPosSH (Q.apply rclawq) (upperPrismPolyHalfMI 4 $ rectNSWE 0 (-20) (-2) 2)
) )
<> colorSH (_skinHead cskin) <> 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)) (overPosSH (Q.apply headq) (upperPrismPolyHalfMI 1 $ square 2))
where where
-- i = fromIntegral (mod (w ^. cWorld . cClock) 100) / 100
torsoq = (V3 0 0 10,Q.qid) torsoq = (V3 0 0 10,Q.qid)
--lclawq = torsoq `Q.comp` (V3 0 9 0, Q.axisAngle (V3 1 0 0) 1)
lclawq = torsoq `Q.comp` (V3 2 8 1, Q.slerp latck lrest lcool) lclawq = torsoq `Q.comp` (V3 2 8 1, Q.slerp latck lrest lcool)
latck = Q.axisAngle (V3 0 0 1) (-0.5 * pi) latck = Q.axisAngle (V3 0 0 1) (-0.5 * pi)
lrest = Q.axisAngle (V3 1 0 0) 1 lrest = Q.axisAngle (V3 1 0 0) 1
@@ -110,13 +107,6 @@ crabUpperBody _ cr = colorSH (_skinUpper cskin)
rrest = Q.axisAngle (V3 1 0 0) (-1) rrest = Q.axisAngle (V3 1 0 0) (-1)
rcool = 1 - min 10 (fromIntegral . _meleeCooldownR $ _crType cr) / 10 rcool = 1 - min 10 (fromIntegral . _meleeCooldownR $ _crType cr) / 10
headq = torsoq `Q.comp` (V3 3 0 4, 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
-- i <- cr ^. crIntention . targetCr
-- tcxy <- w ^? cWorld . lWorld . creatures . ix i . crPos . _xy
-- guard $ hasLOSIndirect cxy tcxy w
-- return $ argV (tcxy - cxy) - cr ^. crDir
chaseUpperBody :: World -> Creature -> Shape chaseUpperBody :: World -> Creature -> Shape
@@ -202,7 +192,7 @@ crabFeet _ cr =
rpos' = f (V2 0 10) rpos rpos' = f (V2 0 10) rpos
(r1',r2') = spiderJoint (0 & _xy .~ rpos') (V3 0 2 5) (r1',r2') = spiderJoint (0 & _xy .~ rpos') (V3 0 2 5)
(l1,l2) = spiderJoint (0 & _xy .~ lpos) (V3 0 (-2) 5) (l1,l2) = spiderJoint (0 & _xy .~ lpos) (V3 0 (-2) 5)
lpos' = (f (V2 0 (-10)) lpos) lpos' = f (V2 0 (-10)) lpos
(l1',l2') = spiderJoint (0 & _xy .~ lpos') (V3 0 (-2) 5) (l1',l2') = spiderJoint (0 & _xy .~ lpos') (V3 0 (-2) 5)
spiderJoint :: Point3 -> Point3 -> (Q.Quaternion Float, Q.Quaternion Float) spiderJoint :: Point3 -> Point3 -> (Q.Quaternion Float, Q.Quaternion Float)
@@ -214,14 +204,14 @@ spiderJoint p q = (f $ Q.axisAngle (V3 0 (-1) 0) (pi - (a+b)), f . Q.axisAngle (
c = argV $ (p-q) ^. _xy c = argV $ (p-q) ^. _xy
f x = Q.qz c * x f x = Q.qz c * x
spiderJoint' :: Point3 -> Float -> Float -> Point3 -> (Q.Quaternion Float, Q.Quaternion Float) --spiderJoint' :: Point3 -> Float -> Float -> Point3 -> (Q.Quaternion Float, Q.Quaternion Float)
spiderJoint' p l1 l2 q = (f $ Q.axisAngle (V3 0 (-1) 0) (pi - (a+b)), f . Q.axisAngle (V3 0 (-1) 0) $ a - b) --spiderJoint' p l1 l2 q = (f $ Q.axisAngle (V3 0 (-1) 0) (pi - (a+b)), f . Q.axisAngle (V3 0 (-1) 0) $ a - b)
--spiderJoint p q = (Q.qz c, Q.axisAngle (V3 0 (-1) 0) $ a) ----spiderJoint p q = (Q.qz c, Q.axisAngle (V3 0 (-1) 0) $ a)
where -- where
a = angleThreeSides 10 (distance p q) 10 -- a = angleThreeSides 10 (distance p q) 10
b = angleVV3 (q-p) (V3 0 0 (-1)) -- b = angleVV3 (q-p) (V3 0 0 (-1))
c = argV $ (p-q) ^. _xy -- c = argV $ (p-q) ^. _xy
f x = Q.qz c * x -- f x = Q.qz c * x
makeCorpse :: StdGen -> Creature -> SPic makeCorpse :: StdGen -> Creature -> SPic
makeCorpse g cr = case cr ^. crType of makeCorpse g cr = case cr ^. crType of
@@ -267,29 +257,25 @@ crabCorpse g cr = mconcat
, colorSH (_skinUpper cskin) $ overPosSH (Q.apply lclawq) (upperPrismPolyHalfMI 4 $ rectNSWE 20 0 (-2) 2) , 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) <> overPosSH (Q.apply rclawq) (upperPrismPolyHalfMI 4 $ rectNSWE 0 (-20) (-2) 2)
, colorSH (cskin ^?! skinLower) $ , colorSH (cskin ^?! skinLower) $
(foldMap (mkfoot 5) [p1,p2]) foldMap (mkfoot 5) (take 2 ps)
<> (foldMap (mkfoot (-5)) [p3,p4]) <> foldMap (mkfoot (-5)) (take 2 $ drop 2 ps)
, colorSH (_skinHead cskin) , 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)) (overPosSH (Q.apply headq) (upperPrismPolyHalfMI 1 $ square 2))
] ]
where where
headq = torsoq `Q.comp` (V3 3 0 4, Q.qid) headq = torsoq `Q.comp` (V3 3 0 4, Q.qid)
torsoq = (V3 0 0 0,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) 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 (la,g') = randomR (-2,2) g
ra = fst $ randomR (-2,2) g' ra = fst $ randomR (-2,2) g'
p1 = 0 & _xy .~ p1' + V2 0 15 ps = evalState (replicateM 4 (randInCirc 9)) g
p2 = 0 & _xy .~ p2' + V2 0 15 mkfoot y p =
p3 = 0 & _xy .~ p3' - V2 0 15 let p' = 0 & _xy .~ p + V2 0 (3*y)
p4 = 0 & _xy .~ p4' - V2 0 15 (q1,q2) = spiderJoint (V3 0 y 0) p'
(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)) in (afoot & each . sfVs . each %~ Q.apply (V3 0 y 0, q1))
<> (afoot & each . sfVs . each %~ Q.apply (p,q2)) <> (afoot & each . sfVs . each %~ Q.apply (p',q2))
afoot = upperPrismPolyST 10 $ polyCirc 3 2 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) 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 cskin = crShape $ _crType cr -- this should be fixed
deadFeet :: Creature -> Shape deadFeet :: Creature -> Shape