Cleanup
This commit is contained in:
+189
-158
@@ -7,32 +7,29 @@ module Dodge.Creature.Picture (
|
||||
drawCreature,
|
||||
) where
|
||||
|
||||
import Dodge.Creature.Slime
|
||||
import Geometry.Zone
|
||||
import Data.Foldable
|
||||
import qualified Data.Strict.Tuple as ST
|
||||
import RandomHelp
|
||||
import Dodge.Base.Collide
|
||||
import Control.Monad
|
||||
import Data.Maybe
|
||||
import Dodge.Data.World
|
||||
import Linear
|
||||
import Dodge.Data.Equipment.Misc
|
||||
import Dodge.Creature.HandPos
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import Control.Lens
|
||||
import Control.Monad
|
||||
import Data.Foldable
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import Data.Maybe
|
||||
import qualified Data.Strict.Tuple as ST
|
||||
import Dodge.Base.Collide
|
||||
import Dodge.Creature.HandPos
|
||||
import Dodge.Creature.Radius
|
||||
import Dodge.Creature.Shape
|
||||
--import Dodge.Creature.Test
|
||||
import Dodge.Creature.Slime
|
||||
import Dodge.Damage
|
||||
--import Dodge.Data.Creature
|
||||
import Dodge.Data.Equipment.Misc
|
||||
import Dodge.Data.World
|
||||
import Dodge.Item.Draw
|
||||
import Dodge.Item.Grammar
|
||||
import Geometry
|
||||
import Geometry.Zone
|
||||
import Linear
|
||||
import Picture
|
||||
import qualified Quaternion as Q
|
||||
import RandomHelp
|
||||
import Shape
|
||||
--import Shape
|
||||
import ShapePicture
|
||||
|
||||
drawCreature :: World -> IM.IntMap Item -> Creature -> SPic
|
||||
@@ -42,11 +39,11 @@ drawCreature w m cr = translateSP (_crPos cr) . fallrot . rotateSP (_crDir cr) $
|
||||
_ | null (cr ^? crHP . _HP) -> mempty
|
||||
BarrelCrit{} -> barrelShape
|
||||
LampCrit{_lampHeight = h} -> lampCrSPic h
|
||||
ChaseCrit {} -> noPic $ drawChaseCrit w cr
|
||||
Avatar {} -> basicCrPict m cr
|
||||
ChaseCrit{} -> noPic $ drawChaseCrit w cr
|
||||
Avatar{} -> basicCrPict m cr
|
||||
SwarmCrit -> basicCrPict m cr
|
||||
AutoCrit -> basicCrPict m cr
|
||||
CrabCrit {} -> noPic $ drawCrabCrit w cr
|
||||
CrabCrit{} -> noPic $ drawCrabCrit w cr
|
||||
HoverCrit{} -> noPic $ drawHoverCrit cr
|
||||
SlinkCrit{} -> noPic $ drawSlinkCrit cr
|
||||
SlimeCrit{} -> noPic $ drawSlimeCrit cr
|
||||
@@ -58,113 +55,125 @@ drawCreature w m cr = translateSP (_crPos cr) . fallrot . rotateSP (_crDir cr) $
|
||||
_ -> id
|
||||
|
||||
drawSlimeCrit :: Creature -> Shape
|
||||
drawSlimeCrit cr = colorSH green
|
||||
$ upperPrismPolyHalf Medium Typical (cr ^?! crType . slimeEngulfProgress + min 15 r) ps
|
||||
drawSlimeCrit cr =
|
||||
colorSH green $
|
||||
upperPrismPolyHalf Medium Typical (cr ^?! crType . slimeEngulfProgress + min 15 r) ps
|
||||
where
|
||||
r = slimeToRad $ cr ^?! crType . slimeSlime - cr ^?! crType . slimeSlimeChange
|
||||
so = slimeOutline cr
|
||||
ps = fromMaybe so $ do
|
||||
(x',qs) <- cr ^? crType . slimeSplitTimer . _Just
|
||||
(x', qs) <- cr ^? crType . slimeSplitTimer . _Just
|
||||
let x = fromIntegral x'
|
||||
guard $ length qs == 12
|
||||
return $ zipWith (+) (fmap (0.1*(10 - x) *^) so) (fmap (0.1*x*^) qs)
|
||||
return $ zipWith (+) (fmap (0.1 * (10 - x) *^) so) (fmap (0.1 * x *^) qs)
|
||||
|
||||
-- assumes d is a unit vector
|
||||
scaleAlong :: Point2 -> Float -> Point2 -> Point2
|
||||
scaleAlong d s p = ((s - 1) * dot d p) *^ d + p
|
||||
|
||||
|
||||
basicCrPict :: IM.IntMap Item -> Creature -> SPic
|
||||
basicCrPict m cr = drawEquipment m cr <> noPic (basicCrShape cr)
|
||||
|
||||
crCamouflage :: Creature -> CamouflageStatus
|
||||
crCamouflage _ = FullyVisible
|
||||
|
||||
basicCrShape :: Creature -> Shape
|
||||
basicCrShape cr
|
||||
| crCamouflage cr == Invisible = mempty
|
||||
| otherwise =
|
||||
scaleSH (V3 crsize crsize crsize) $
|
||||
mconcat
|
||||
[ colorSH (_skinHead cskin) . overPosSH (translateToES cr OnHead) $ scalp
|
||||
, colorSH (_skinUpper cskin) $ upperBody cr
|
||||
, rotmdir $ colorSH (_skinLower cskin) $ feet cr
|
||||
]
|
||||
basicCrShape cr =
|
||||
scaleSH (V3 crsize crsize crsize) $
|
||||
mconcat
|
||||
[ colorSH (_skinHead cskin) . overPosSH (translateToES cr OnHead) $ scalp
|
||||
, colorSH (_skinUpper cskin) $ upperBody cr
|
||||
, rotmdir $ colorSH (_skinLower cskin) $ feet cr
|
||||
]
|
||||
where
|
||||
cskin = crShape $ _crType cr
|
||||
crsize = 0.1 * crRad (cr ^. crType)
|
||||
rotmdir = rotateSH (_crMvDir cr - _crDir cr)
|
||||
|
||||
drawSlinkCrit :: Creature -> Shape
|
||||
drawSlinkCrit cr = snd (foldl' f ((V3 0 0 0,Q.qid), mempty) $ cr ^?! crType . slinkSpine)
|
||||
drawSlinkCrit cr =
|
||||
snd (foldl' f ((V3 0 0 0, Q.qid), mempty) $ cr ^?! crType . slinkSpine)
|
||||
<> shead
|
||||
& each . sfColor .~ cskin ^?! skinUpper
|
||||
& each . sfColor .~ cskin ^?! skinUpper
|
||||
where
|
||||
shead = polyCirc 6 15
|
||||
& upperPrismPoly Medium Important 10
|
||||
& each . sfVs . each %~ Q.apply (cr ^?! crType . slinkHeadPos)
|
||||
shead =
|
||||
polyCirc 6 15
|
||||
& upperPrismPoly Medium Important 10
|
||||
& each . sfVs . each %~ Q.apply (cr ^?! crType . slinkHeadPos)
|
||||
cskin = crShape $ _crType cr
|
||||
f ((p,q),sh) (p',q') = ((p,q) `Q.comp` (p',q'), sh <> (g p' & each . sfVs . each %~ Q.apply (p,q)))
|
||||
f ((p, q), sh) (p', q') = ((p, q) `Q.comp` (p', q'), sh <> (g p' & each . sfVs . each %~ Q.apply (p, q)))
|
||||
g _ = upperPrismPoly Medium Important 2 $ polyCirc 6 15
|
||||
|
||||
drawHoverCrit :: Creature -> Shape
|
||||
drawHoverCrit cr = colorSH (_skinHead cskin)
|
||||
(overPosSH (Q.apply tpq) $ upperBoxHalf Medium Typical 1 $ square 4)
|
||||
<> colorSH (_skinUpper cskin)
|
||||
(mconcat [overPosSH (Q.apply $ f a) $ upperBox Medium Typical 1 $ polyCirc 3 5 | a <- [0,pi/2,pi,1.5*pi]])
|
||||
drawHoverCrit cr =
|
||||
colorSH
|
||||
(_skinHead cskin)
|
||||
(overPosSH (Q.apply tpq) $ upperBoxHalf Medium Typical 1 $ square 4)
|
||||
<> colorSH
|
||||
(_skinUpper cskin)
|
||||
(mconcat [overPosSH (Q.apply $ f a) $ upperBox Medium Typical 1 $ polyCirc 3 5 | a <- [0, pi / 2, pi, 1.5 * pi]])
|
||||
where
|
||||
cskin = crShape $ _crType cr
|
||||
f a = tpq `Q.comp` (1 & _xy .~ rotateV a 5, Q.qid)
|
||||
tpq = (V3 0 0 0, Q.qid)
|
||||
|
||||
drawHive :: SPic
|
||||
drawHive = noPic $ upperPrismPolyHalfMI 25 $ polyCirc 6 20
|
||||
drawHive = noPic $ upperPrismPolyHalfMI 25 $ polyCirc 6 20
|
||||
|
||||
drawBeeCrit :: Creature -> Shape
|
||||
drawBeeCrit cr = colorSH col
|
||||
(f . upperPrismPolyHalfMI 3 $ polyCirc 6 r)
|
||||
<>
|
||||
colorSH (dark col) (overPosSH (Q.apply (beakpos)) $ upperPrismPolyHalfST 1 $ [V2 0 (-2), V2 4 0,V2 0 2])
|
||||
drawBeeCrit cr =
|
||||
colorSH
|
||||
col
|
||||
(f . upperPrismPolyHalfMI 3 $ polyCirc 6 r)
|
||||
<> colorSH (dark col) (overPosSH (Q.apply (beakpos)) $ upperPrismPolyHalfST 1 $ [V2 0 (-2), V2 4 0, V2 0 2])
|
||||
where
|
||||
r = cr ^. crType . to crRad
|
||||
beakpos = (V3 (r-1) 0 0, Q.qid)
|
||||
col | cr ^?! crType . beeAggro > 0 = red
|
||||
beakpos = (V3 (r - 1) 0 0, Q.qid)
|
||||
col
|
||||
| cr ^?! crType . beeAggro > 0 = red
|
||||
| otherwise = yellow
|
||||
f | Mounted {} <- cr ^. crStance . carriage
|
||||
= each . sfVs . each . _xy %~ scaleAlong (V2 0 1) (1 + g ( modTo 1 (cr ^?! crType . beeSlime . to ((/100) . fromIntegral))))
|
||||
f
|
||||
| Mounted{} <- cr ^. crStance . carriage =
|
||||
each . sfVs . each . _xy %~ scaleAlong (V2 0 1) (1 + g (modTo 1 (cr ^?! crType . beeSlime . to ((/ 100) . fromIntegral))))
|
||||
| otherwise = id
|
||||
g x | x > 0.5 = 1 - x
|
||||
g x
|
||||
| x > 0.5 = 1 - x
|
||||
| otherwise = x
|
||||
|
||||
drawCrabCrit :: World -> Creature -> Shape
|
||||
drawCrabCrit w cr = mconcat
|
||||
[ crabUpperBody w cr
|
||||
, colorSH (_skinLower cskin) $ crabFeet w cr
|
||||
]
|
||||
drawCrabCrit w cr =
|
||||
mconcat
|
||||
[ crabUpperBody w cr
|
||||
, colorSH (_skinLower cskin) $ crabFeet w cr
|
||||
]
|
||||
where
|
||||
cskin = crShape $ _crType cr
|
||||
|
||||
drawChaseCrit :: World -> Creature -> Shape
|
||||
drawChaseCrit w cr = mconcat
|
||||
[ chaseUpperBody w cr
|
||||
, rotmdir $ colorSH (_skinLower cskin) $ feet cr
|
||||
]
|
||||
drawChaseCrit w cr =
|
||||
mconcat
|
||||
[ chaseUpperBody w cr
|
||||
, rotmdir $ colorSH (_skinLower cskin) $ feet cr
|
||||
]
|
||||
where
|
||||
cskin = crShape $ _crType cr
|
||||
rotmdir = rotateSH (_crMvDir cr - _crDir cr)
|
||||
|
||||
crabUpperBody :: World -> Creature -> Shape
|
||||
crabUpperBody _ cr = colorSH (_skinUpper cskin)
|
||||
(
|
||||
overPosSH (Q.apply torsoq) (upperPrismPolyHalfMI 5 $ polyCirc 4 10
|
||||
& each . _x *~ 0.6)
|
||||
<> overPosSH (Q.apply lclawq) (upperPrismPolyHalfMI 4 $ rectNSWE 20 0 (-2) 2)
|
||||
<> overPosSH (Q.apply rclawq) (upperPrismPolyHalfMI 4 $ rectNSWE 0 (-20) (-2) 2)
|
||||
)
|
||||
<> colorSH (_skinHead cskin)
|
||||
(overPosSH (Q.apply headq) (upperPrismPolyHalfMI 1 $ square 2))
|
||||
crabUpperBody _ cr =
|
||||
colorSH
|
||||
(_skinUpper cskin)
|
||||
( overPosSH
|
||||
(Q.apply torsoq)
|
||||
( upperPrismPolyHalfMI 5 $
|
||||
polyCirc 4 10
|
||||
& each . _x *~ 0.6
|
||||
)
|
||||
<> overPosSH (Q.apply lclawq) (upperPrismPolyHalfMI 4 $ rectNSWE 20 0 (-2) 2)
|
||||
<> overPosSH (Q.apply rclawq) (upperPrismPolyHalfMI 4 $ rectNSWE 0 (-20) (-2) 2)
|
||||
)
|
||||
<> colorSH
|
||||
(_skinHead cskin)
|
||||
(overPosSH (Q.apply headq) (upperPrismPolyHalfMI 1 $ square 2))
|
||||
where
|
||||
torsoq = (V3 0 0 10,Q.qid)
|
||||
torsoq = (V3 0 0 10, Q.qid)
|
||||
lclawq = torsoq `Q.comp` (V3 2 8 1, Q.slerp latck lrest lcool)
|
||||
latck = Q.axisAngle (V3 0 0 1) (-0.5 * pi)
|
||||
lrest = Q.axisAngle (V3 1 0 0) 1
|
||||
@@ -175,105 +184,116 @@ crabUpperBody _ cr = colorSH (_skinUpper cskin)
|
||||
rrest = Q.axisAngle (V3 1 0 0) (-1)
|
||||
rcool = 1 - min 10 (fromIntegral . _meleeCooldownR $ _crType cr) / 10
|
||||
headq = torsoq `Q.comp` (V3 3 0 4, Q.qid)
|
||||
|
||||
|
||||
chaseUpperBody :: World -> Creature -> Shape
|
||||
chaseUpperBody w cr = colorSH (_skinUpper cskin)
|
||||
(overPosSH (Q.apply torsoq) (upperPrismPolyHalfMI tz $ polyCirc 3 12
|
||||
& each %~ vNormal
|
||||
& each . _y *~ 0.6)
|
||||
<> 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]))
|
||||
chaseUpperBody w cr =
|
||||
colorSH
|
||||
(_skinUpper cskin)
|
||||
( overPosSH
|
||||
(Q.apply torsoq)
|
||||
( upperPrismPolyHalfMI tz $
|
||||
polyCirc 3 12
|
||||
& each %~ vNormal
|
||||
& each . _y *~ 0.6
|
||||
)
|
||||
<> 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]))
|
||||
where
|
||||
-- time = fromIntegral (mod (w ^. unpauseClock) 100) / 5
|
||||
-- time = fromIntegral (mod (w ^. unpauseClock) 100) / 5
|
||||
tz = 4
|
||||
cskin = crShape $ _crType cr
|
||||
torsoq = (V3 0 0 (10 + tz + tbob),Q.qid)
|
||||
torsoq = (V3 0 0 (10 + tz + tbob), Q.qid)
|
||||
mcool = 1 - min 10 (fromIntegral . _meleeCooldown $ _crType cr) / 10
|
||||
neckq = torsoq `Q.comp` (V3 6 0 0, Q.qz aimrot * Q.axisAngle (V3 0 1 0) (-1.8*mcool))
|
||||
headq = neckq `Q.comp` (V3 16 0 0, Q.axisAngle (V3 0 1 0) (2*mcool+vocaltilt) * Q.qz aimrot )
|
||||
neckq = torsoq `Q.comp` (V3 6 0 0, Q.qz aimrot * Q.axisAngle (V3 0 1 0) (-1.8 * mcool))
|
||||
headq = neckq `Q.comp` (V3 16 0 0, Q.axisAngle (V3 0 1 0) (2 * mcool + vocaltilt) * Q.qz aimrot)
|
||||
vocaltilt = case cr ^? crVocalization . vcTime of
|
||||
Just x | x < 20 -> -pi * 0.05 * (10 - abs (fromIntegral x - 10))
|
||||
_ -> 0
|
||||
sLen = strideLength cr
|
||||
tbob = 5 * (1 - oneSmooth (abs llegpos))
|
||||
llegpos = case (cr ^? crType . strideAmount,cr ^? crType . footForward) of
|
||||
llegpos = case (cr ^? crType . strideAmount, cr ^? crType . footForward) of
|
||||
(Just sa, Just LeftForward) -> f sa
|
||||
(Just sa, Just RightForward) -> -f sa
|
||||
_ -> 0
|
||||
--tbob = 2 * oneSmooth ((sLen - 2*i) / sLen)
|
||||
f i = (sLen - 2*i) / sLen
|
||||
-- tbob = 2 * oneSmooth ((sLen - 2*i) / sLen)
|
||||
f i = (sLen - 2 * i) / sLen
|
||||
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 . (0.5*) . nearZeroAngle $ argV (tcxy - cxy) - cr ^. crDir
|
||||
return . (0.5 *) . nearZeroAngle $ argV (tcxy - cxy) - cr ^. crDir
|
||||
|
||||
oneSmooth :: Float -> Float
|
||||
oneSmooth x = sin (pi * x * 0.5)
|
||||
|
||||
feet :: Creature -> Shape
|
||||
{-# INLINE feet #-}
|
||||
feet cr = case (cr ^? crType . strideAmount,cr ^? crType . footForward) of
|
||||
(Just sa,Just LeftForward) -> sh (f sa)
|
||||
(Just sa,Just RightForward) -> sh (-f sa)
|
||||
feet cr = case (cr ^? crType . strideAmount, cr ^? crType . footForward) of
|
||||
(Just sa, Just LeftForward) -> sh (f sa)
|
||||
(Just sa, Just RightForward) -> sh (-f sa)
|
||||
_ -> sh 0
|
||||
where
|
||||
sh x = translateSHxy x off aFoot <> translateSHxy (- x) (- off) aFoot
|
||||
sh x = translateSHxy x off aFoot <> translateSHxy (-x) (-off) aFoot
|
||||
aFoot = upperPrismPolyST 10 $ polyCirc 3 4
|
||||
off = 5
|
||||
sLen = strideLength cr
|
||||
-- f i = 8 * (sLen - 2*i) / sLen
|
||||
f i = 8 * oneSmooth ((sLen - 2*i) / sLen)
|
||||
-- f i = 8 * (sLen - 2*i) / sLen
|
||||
f i = 8 * oneSmooth ((sLen - 2 * i) / sLen)
|
||||
|
||||
crabFeet :: World -> Creature -> Shape
|
||||
{-# INLINE crabFeet #-}
|
||||
crabFeet _ cr =
|
||||
crabFeet _ cr =
|
||||
uncurryV translateSHxy rpos (afoot & each . sfVs . each %~ Q.rotate r1)
|
||||
<> (afoot
|
||||
& each . sfVs . each %~ Q.rotate r2
|
||||
& each . sfVs . each +~ V3 0 2 5)
|
||||
<> uncurryV translateSHxy rpos' (afoot & each . sfVs . each %~ Q.rotate r1')
|
||||
<> (afoot
|
||||
& each . sfVs . each %~ Q.rotate r2'
|
||||
& each . sfVs . each +~ V3 0 2 5)
|
||||
<> uncurryV translateSHxy lpos (afoot & each . sfVs . each %~ Q.rotate l1)
|
||||
<> (afoot
|
||||
& each . sfVs . each %~ Q.rotate l2
|
||||
& each . sfVs . each +~ V3 0 (-2) 5)
|
||||
<> uncurryV translateSHxy lpos' (afoot & each . sfVs . each %~ Q.rotate l1')
|
||||
<> (afoot
|
||||
& each . sfVs . each %~ Q.rotate l2'
|
||||
& each . sfVs . each +~ V3 0 (-2) 5)
|
||||
<> ( afoot
|
||||
& each . sfVs . each %~ Q.rotate r2
|
||||
& each . sfVs . each +~ V3 0 2 5
|
||||
)
|
||||
<> uncurryV translateSHxy rpos' (afoot & each . sfVs . each %~ Q.rotate r1')
|
||||
<> ( afoot
|
||||
& each . sfVs . each %~ Q.rotate r2'
|
||||
& each . sfVs . each +~ V3 0 2 5
|
||||
)
|
||||
<> uncurryV translateSHxy lpos (afoot & each . sfVs . each %~ Q.rotate l1)
|
||||
<> ( afoot
|
||||
& each . sfVs . each %~ Q.rotate l2
|
||||
& each . sfVs . each +~ V3 0 (-2) 5
|
||||
)
|
||||
<> uncurryV translateSHxy lpos' (afoot & each . sfVs . each %~ Q.rotate l1')
|
||||
<> ( afoot
|
||||
& each . sfVs . each %~ Q.rotate l2'
|
||||
& each . sfVs . each +~ V3 0 (-2) 5
|
||||
)
|
||||
where
|
||||
rpos = rot (cr ^?! crType . rFootPos - cxy)
|
||||
rot = rotateV cdir
|
||||
lpos = rot ( cr ^?! crType . lFootPos - cxy)
|
||||
rot = rotateV cdir
|
||||
lpos = rot (cr ^?! crType . lFootPos - cxy)
|
||||
f p q = q + 2 *^ (p - q)
|
||||
cdir = -cr ^. crDir
|
||||
cxy = cr ^. crPos . _xy
|
||||
afoot = upperPrismPolyHalfST 10 $ polyCirc 3 2
|
||||
(r1,r2) = spiderJoint (0 & _xy .~ rpos) (V3 0 2 5)
|
||||
(r1, r2) = spiderJoint (0 & _xy .~ rpos) (V3 0 2 5)
|
||||
rpos' = f (V2 0 10) rpos
|
||||
(r1',r2') = spiderJoint (0 & _xy .~ rpos') (V3 0 2 5)
|
||||
(l1,l2) = spiderJoint (0 & _xy .~ lpos) (V3 0 (-2) 5)
|
||||
(r1', r2') = spiderJoint (0 & _xy .~ rpos') (V3 0 2 5)
|
||||
(l1, l2) = spiderJoint (0 & _xy .~ lpos) (V3 0 (-2) 5)
|
||||
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 p 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 = (f $ Q.axisAngle (V3 0 (-1) 0) (pi - (a + b)), f . Q.axisAngle (V3 0 (-1) 0) $ a - b)
|
||||
where
|
||||
-- spiderJoint p q = (Q.qz c, Q.axisAngle (V3 0 (-1) 0) $ a)
|
||||
|
||||
a = angleThreeSides 10 (distance p q) 10
|
||||
b = angleVV3 (q-p) (V3 0 0 (-1))
|
||||
c = argV $ (p-q) ^. _xy
|
||||
b = angleVV3 (q - p) (V3 0 0 (-1))
|
||||
c = argV $ (p - q) ^. _xy
|
||||
f x = Q.qz c * x
|
||||
|
||||
--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' :: 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 q = (Q.qz c, Q.axisAngle (V3 0 (-1) 0) $ a)
|
||||
-- where
|
||||
-- a = angleThreeSides 10 (distance p q) 10
|
||||
@@ -301,48 +321,59 @@ makeCorpse g cr = case cr ^. crType of
|
||||
rotmdir = rotateSH (_crMvDir cr - _crDir cr)
|
||||
|
||||
chaseCorpse :: StdGen -> Creature -> Shape
|
||||
chaseCorpse g cr = mconcat
|
||||
[colorSH (_skinUpper cskin) . upperPrismPolyHalfMI 0 $ polyCirc 3 12
|
||||
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
|
||||
, 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'
|
||||
(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 )
|
||||
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) (take 2 ps)
|
||||
<> foldMap (mkfoot (-5)) (take 2 $ drop 2 ps)
|
||||
, colorSH (_skinHead cskin)
|
||||
(overPosSH (Q.apply headq) (upperPrismPolyHalfMI 1 $ square 2))
|
||||
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) (take 2 ps)
|
||||
<> foldMap (mkfoot (-5)) (take 2 $ drop 2 ps)
|
||||
, colorSH
|
||||
(_skinHead cskin)
|
||||
(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)
|
||||
torsoq = (V3 0 0 0, Q.qid)
|
||||
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'
|
||||
(la, g') = randomR (-2, 2) g
|
||||
ra = fst $ randomR (-2, 2) g'
|
||||
ps = evalState (replicateM 4 (randInCirc 9)) g
|
||||
mkfoot y p =
|
||||
let p' = 0 & _xy .~ p + V2 0 (3*y)
|
||||
(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))
|
||||
mkfoot y p =
|
||||
let p' = 0 & _xy .~ p + V2 0 (3 * y)
|
||||
(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
|
||||
@@ -361,8 +392,8 @@ arms cr =
|
||||
aHand = noPic $ translateSHz (-2) . upperPrismPolyHalfST 2 $ polyCirc 3 4
|
||||
|
||||
deadScalp :: Creature -> Shape
|
||||
--deadScalp cr = deadRot cr . translateSHz 5 . scalp $ cr
|
||||
--deadScalp cr = deadRot cr . translateSHz (-5) . scalp $ cr
|
||||
-- deadScalp cr = deadRot cr . translateSHz 5 . scalp $ cr
|
||||
-- deadScalp cr = deadRot cr . translateSHz (-5) . scalp $ cr
|
||||
deadScalp _ = translateSH (V3 (-13) 0 0) scalp
|
||||
|
||||
deadRot :: Creature -> Shape -> Shape
|
||||
@@ -376,7 +407,8 @@ deadRot cr = overPosSH (Q.rotateToZ d)
|
||||
|
||||
scalp :: Shape
|
||||
{-# INLINE scalp #-}
|
||||
scalp = (colorSH (greyN 0.9) . upperPrismPolyHalfST 5 $ polyCirc 3 5)
|
||||
scalp =
|
||||
(colorSH (greyN 0.9) . upperPrismPolyHalfST 5 $ polyCirc 3 5)
|
||||
& each . sfShadowImportance .~ Unimportant
|
||||
|
||||
torso :: Creature -> Shape
|
||||
@@ -391,7 +423,7 @@ 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
|
||||
-- baseShoulder = translateSHz (-20) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1
|
||||
baseShoulder = scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1
|
||||
|
||||
upperBody :: Creature -> Shape
|
||||
@@ -411,4 +443,3 @@ lampCrSPic :: Float -> SPic
|
||||
lampCrSPic h =
|
||||
colorSH blue (upperBox Small Undesired h $ rectWH 5 5)
|
||||
ST.:!: setLayer BloomLayer (setDepth h . color white $ circleSolid 3)
|
||||
|
||||
|
||||
Reference in New Issue
Block a user