42 lines
1.2 KiB
Haskell
42 lines
1.2 KiB
Haskell
module Dodge.Prop.Draw (
|
|
propSPic,
|
|
debrisSPic,
|
|
) where
|
|
|
|
import Control.Lens
|
|
import Dodge.Block.Debris
|
|
import Dodge.Data.Prop
|
|
import Geometry.Data
|
|
import Geometry.Polygon
|
|
import Picture
|
|
import qualified Quaternion as Q
|
|
import Shape
|
|
import ShapePicture
|
|
import Linear
|
|
|
|
debrisSPic :: Debris -> SPic
|
|
debrisSPic db = translateSP (_dbPos db & _z +~ 1) . overPosSP (Q.rotate (_dbRot db)) $
|
|
case db ^. dbType of
|
|
Gib x col -> noPic $ drawGib x col
|
|
BlockDebris m -> noPic . colorSH m $ cubeShape 4
|
|
MetalDebris c -> noPic . colorSH c $ upperBox Small Undesired 1 jagshape
|
|
GlassDebris -> noPic . colorSH azure $ upperPrismPoly Small Undesired 1 jagshape
|
|
where
|
|
jagshape = [0, V2 8 0, V2 6 3] & each -~ V2 4 1.5
|
|
|
|
propSPic :: Prop -> SPic
|
|
propSPic pr =
|
|
uncurryV translateSPxy (_prPos pr) $ rotateSP (_prRot pr) $ pr ^. prDraw
|
|
|
|
drawGib :: Float -> Color -> Shape
|
|
drawGib x col = flesh <> skin
|
|
where
|
|
flesh =
|
|
colorSH (dark $ dark red) $
|
|
translateSHz (negate x) (baseCube & each . sfShadowImportance .~ Superfluous)
|
|
skin =
|
|
colorSH col $
|
|
translateSH (V3 1 1 (1 - x)) baseCube
|
|
baseCube = upperPrismPoly Small Typical (2 * x) $ square x
|
|
|