Working (but slow) shadow shapes

src/Dodge/Creature.hs

@@ -27,7 +27,6 @@ import Dodge.Creature.SpreadGunCrit
 import Dodge.Creature.AutoCrit
 import Dodge.Creature.ChaseCrit
 import Dodge.Creature.ArmourChase
-import Dodge.Creature.Silhouette
 import Dodge.Data
 import Dodge.Default
 import Dodge.Item.Weapon
@@ -149,7 +148,6 @@ startCr = defaultCreature
     , _crMvDir  = pi/2
     , _crID = 0
     , _crPict = basicCrPict black
-    , _crSilhouette = basicCrSilhouette
     , _crUpdate = stateUpdate yourControl
     , _crRad = 10
     , _crMass = 10

src/Dodge/Creature/Picture.hs

@@ -22,6 +22,8 @@ import Dodge.Item.Data
 import Dodge.Clock
 import Picture
 import Geometry
+import Shape
+import ShapePicture
 --import Geometry.Vector3D
 
 import Control.Lens
@@ -32,11 +34,10 @@ basicCrPict
     :: Color    -- ^ Creature color
     -> Creature 
     -> World
-    -> Picture
-basicCrPict col cr w = pictures $
+    -> SPic
+basicCrPict col cr w = SPic (basicCrShape col cr w) $ pictures $
     targetingPic ++
-    [ tr . dm . rotdir $ scalp cr
-    , tr . dm . rotdir $ upperBody col cr
+    [ tr . dm . rotdir $ upperBody col cr
     , tr . dm . rotmdir $ feet cr
     , tr . rotdir $ drawEquipment cr
     , creatureDisplayText w cr
@@ -51,6 +52,24 @@ basicCrPict col cr w = pictures $
         . setDepth 1 
         . color (greyN 0.3)
 
+basicCrShape 
+    :: Color    -- ^ Creature color
+    -> Creature 
+    -> World
+    -> Shape
+basicCrShape col cr w = mconcat
+    [ tr . translateSHz 25 . dm . rotdir $ scalp cr
+    ]
+  where 
+    dm = damageModSH cr
+    targetingPic = IM.elems $ IM.mapMaybeWithKey f $ _crInv cr
+    f invid it = fmap ((\g -> g invid it cr w) . snd) (it ^? itTargeting . _Just)
+    tr = uncurryV translateSHf (_crPos cr)
+    rotdir = rotateSH (_crDir cr)
+    rotmdir = rotate (_crMvDir cr)
+        . setDepth 1 
+        . color (greyN 0.3)
+
 creatureDisplayText :: World -> Creature -> Picture
 creatureDisplayText w cr 
     = setLayer 4 
@@ -109,6 +128,8 @@ damageMod cr pic = piercingMod $ bluntScale pic
     piercingMod = case fmap argV piercingDam of
         Just a -> rotate (a + cdir) . scale 0.8 1.2 . rotate (negate $ cdir + a)
         _   -> id
+damageModSH :: Creature -> Shape -> Shape
+damageModSH cr = id
 
 feet :: Creature -> Picture
 feet cr = case cr ^? crStance . carriage of
@@ -148,14 +169,14 @@ arms cr
     sLen = _strideLength $ _crStance cr
     f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
 
-scalp :: Creature -> Picture
+scalp :: Creature -> Shape
 scalp cr
-    | twists cr = translate 0 (0.5*crad) . rotate (-1) $ translate (negate 0.25 * crad) 0.25 fhead
-    | oneH   cr = rotate 0.5 $ translate (0.25 * crad) 0 fhead
-    | otherwise = translate (0.25 * crad) 0 fhead
+    | twists cr = translateSHf 0 (0.5*crad) . rotateSH (-1) $ translateSHf (negate 0.25 * crad) 0.25 fhead
+    | oneH   cr = rotateSH 0.5 $ translateSHf (0.25 * crad) 0 fhead
+    | otherwise = translateSHf (0.25 * crad) 0 fhead
     
   where
-    fhead = setDepth 22 $ circleSolid $ crad * 0.5
+    fhead = colorSH (greyN 0.9) . prismPoly 5 . polyCirc $ crad * 0.5
     crad = _crRad cr
 
 oneH :: Creature -> Bool
@@ -232,10 +253,10 @@ drawEquipment cr = pictures $ map f $ IM.toList (_crInv cr)
 circLine :: Float -> Picture
 circLine x = line [V2 0 0,V2 x 0]
 
-picAtCrPos :: Picture -> Creature -> World -> Picture
+picAtCrPos :: Picture -> Creature -> World -> SPic
 --{-# INLINE picAtCrPos #-}
-picAtCrPos thePic cr _ = tranRot (_crPos cr) (_crDir cr) thePic
+picAtCrPos thePic cr _ = SPic empty $ tranRot (_crPos cr) (_crDir cr) thePic
 
-picAtCrPosNoRot :: Picture -> Creature -> World -> Picture
+picAtCrPosNoRot :: Picture -> Creature -> World -> SPic
 --{-# INLINE picAtCrPos #-}
-picAtCrPosNoRot thePic cr _ = uncurryV translate (_crPos cr) thePic
+picAtCrPosNoRot thePic cr _ = SPic empty $ uncurryV translate (_crPos cr) thePic

src/Dodge/Creature/Silhouette.hs

@@ -1,21 +0,0 @@
-module Dodge.Creature.Silhouette
-    ( creatureSilhouettes
-    , basicCrSilhouette
-    )
-    where
-import Dodge.Data
-import Polyhedra
-import Geometry
-
-import qualified Data.IntMap as IM
-
-creatureSilhouettes :: World -> [Point3]
-creatureSilhouettes w = concatMap f . IM.elems $ _creatures w
-  where
-    f cr = _crSilhouette cr cr
-
-basicCrSilhouette :: Creature -> [Point3]
-basicCrSilhouette cr = constructEdgesList . map (map f . polyToTris) $ boxXYZ 12 12 15
-  where
-    f = (+ V3 (x-6) (y-6) 0)
-    V2 x y = _crPos cr

src/Dodge/Data.hs

@@ -25,6 +25,7 @@ import Dodge.World.Trigger.Data
 import Dodge.Bounds
 import Data.Preload
 import Picture.Data
+import ShapePicture
 import Geometry.Data
 import Polyhedra.Data
 import Sound.Data
@@ -193,8 +194,7 @@ data Creature = Creature
     , _crOldDir         :: Float
     , _crMvDir          :: Float
     , _crID             :: Int
-    , _crPict           :: Creature -> World -> Picture
-    , _crSilhouette     :: Creature -> [Point3]
+    , _crPict           :: Creature -> World -> SPic
     , _crUpdate     
         :: Creature 
         -> World 

src/Dodge/Default.hs

@@ -19,6 +19,8 @@ import Dodge.SoundLogic.LoadSound
 import Dodge.Picture.Layer
 import Geometry
 import Picture
+import ShapePicture
+import Shape
 
 import Control.Lens
 import qualified Data.IntMap.Strict as IM
@@ -34,8 +36,7 @@ defaultCreature = Creature
     , _crOldDir = 0
     , _crMvDir  = 0
     , _crID     = 1
-    , _crPict   = \_ _ -> setLayer 0 $ onLayer CrLayer $ circleSolid 10
-    , _crSilhouette = const []
+    , _crPict   = \_ _ -> SPic (flatCirc 10) blank
     , _crUpdate = \cr _ -> (Endo id , Just cr)
     , _crRad    = 10
     , _crMass   = 10

src/Dodge/Initialisation.hs

@@ -13,6 +13,8 @@ import Dodge.SoundLogic
 import Dodge.SoundLogic.LoadSound
 --import Dodge.Creature.Perception
 import Geometry.Data
+--import Shape.Data
+--import Dodge.Render.Shape
 --import Picture
 --import Dodge.GameRoom
 --import Geometry

src/Dodge/Render.hs

@@ -9,7 +9,6 @@ import Dodge.Config.Data
 import Dodge.Base.Window
 import Dodge.Render.Picture
 --import Dodge.Creature.ShadowBox
-import Dodge.Creature.Silhouette
 import Dodge.Render.Shape
 import Geometry
 import Render
@@ -57,11 +56,12 @@ doDrawing pdata w = do
     -- poke wall points and colors
     nWalls <- poke224s (shadVBOptr $ _wallTextureShader pdata) wallPointsCol
     nSils <- pokePoint3s (shadVBOptr $ _lightingLineShadowShader pdata) 
-        $ creatureSilhouettes w
+        $ (_shEdges $ worldShape w)
         ++ _foregroundEdgeVerx w
     -- poke foreground geometry for caps
     nCaps <- pokePoint3s (shadVBOptr $ _lightingCapShader pdata)
         $ concatMap polyToGeoRender (foregroundPics w)
+            ++ map _svPos (_shVertices $ worldShape w)
     -- bind wall points, silhouette data, surface geometry
     uncurry bindShaderBuffers $ unzip
         [ ( _wallTextureShader pdata, nWalls)

src/Dodge/Render/Picture.hs

@@ -15,6 +15,7 @@ import Sound.Data
 import Geometry
 import Picture
 import Polyhedra.Data
+import ShapePicture
 
 import Control.Lens
 import Data.Maybe
@@ -88,7 +89,7 @@ soundPic w s = fixedSizePicClampArrow 50 50 thePic p w
     f x = 1 - 0.5 * (1 - x)
 
 crDraw :: World -> Creature -> Picture
-crDraw w c = _crPict c c w
+crDraw w c = _spPicture $ _crPict c c w
 ppDraw :: PressPlate -> Picture
 ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
 btDraw :: Button -> Picture

src/Dodge/Render/Shape.hs

@@ -4,6 +4,11 @@ import Dodge.Data
 import Shape
 import Geometry
 import Color
+import ShapePicture
 
+import qualified Data.IntMap as IM
 worldShape :: World -> Shape
-worldShape _ = colorSh green . translateSh (V3 (-20) 200 50) . flatPoly $ rectNSWE 20 0 0 20
+worldShape w = mconcat (map (crShape w) (IM.elems (_creatures w)))
+
+crShape :: World -> Creature -> Shape
+crShape w c = _spShape $ _crPict c c w