48 lines
1.6 KiB
Haskell
48 lines
1.6 KiB
Haskell
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
|
|
|
|
makeCorpse :: Creature -> SPic
|
|
makeCorpse cr = case cr ^. crType of
|
|
HoverCrit{} -> noPic $ drawHoverCrit cr
|
|
ChaseCrit{} -> noPic $ chaseCorpse 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 :: Creature -> Shape
|
|
chaseCorpse 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.qid)
|
|
cskin = crShape $ _crType cr -- this should be fixed
|
|
rotmdir = rotateSH (_crMvDir cr - _crDir cr)
|
|
headq = neckq `Q.comp` (V3 16 0 0, Q.qid )
|