Initial pass at shadows from level geometry

src/Dodge/Data.hs

@@ -30,6 +30,7 @@ import Dodge.World.Trigger.Data
 import Data.Preload
 import Picture.Data
 import Geometry.Data
+import Polyhedra.Data
 import Sound.Data
 import qualified DoubleStack as DS
 
@@ -74,7 +75,7 @@ data World = World
     , _soundQueue           :: [(Int,Int16)]
     , _sounds               :: M.Map SoundOrigin Sound
     , _decorations          :: IM.IntMap Picture
-    , _foregroundDecorations :: [Picture]
+    , _foregroundDecorations :: [Polyhedra]
     , _corpses              :: IM.IntMap (IM.IntMap [Corpse])
     , _clickMousePos        :: (Float,Float)
     , _pathGraph            :: ~(Gr Point2 Float)

src/Dodge/LevelGen.hs

@@ -21,6 +21,7 @@ import Dodge.LevelGen.Data
 import Geometry
 import Geometry.Data
 import Picture
+import Polyhedra
 import qualified IntMapHelp as IM
 
 --import System.Random
@@ -93,7 +94,7 @@ placeSpot ps w = case _psType ps of
       where 
         (q:qs) = map (shiftPointBy (p,rot)) ps'
         rmCrossPaths w' = foldr (uncurry removePathsCrossing) w' $ zip (q:qs) (qs++[q])
-    PutForeground pic -> w & foregroundDecorations %~ (uncurry translate p (rotate rot pic) :)
+    PutForeground poly -> w & foregroundDecorations %~ (map (uncurry translateXY p . rotateXY rot) poly ++)
     PutNothing -> w
     PutID _ -> w
     --_   -> w

src/Dodge/LevelGen/Data.hs

@@ -4,6 +4,7 @@ module Dodge.LevelGen.Data
     where
 import Dodge.Data
 import Picture
+import Polyhedra.Data
 
 import Control.Lens
 import Control.Monad.State
@@ -22,7 +23,7 @@ data PSType = PutCrit {_unPutCrit :: Creature}
     | PutBtDoor Color Point2 Float Point2 Point2
     | PutSwitchDoor Color Point2 Float Point2 Point2
     | RandPS (State StdGen PSType)
-    | PutForeground Picture
+    | PutForeground [Polyhedra]
     | PutNothing
     | PutID { _putID :: Int}
 data PlacementSpot = PS

src/Dodge/Render.hs

@@ -14,7 +14,7 @@ import Dodge.Render.Picture
 import Geometry
 import Geometry.Data
 --import Picture
-import Picture.Render
+import Render
 import Data.Preload.Render
 import Picture.Data
 import Picture.Tree
@@ -22,6 +22,8 @@ import Shader
 import Shader.Data
 import Shader.Poke
 import MatrixHelper
+--import Polyhedra.Data
+import Polyhedra
 
 import Foreign
 --import Control.Applicative
@@ -102,7 +104,8 @@ doDrawing pdata w = do
 
     depthMask $= Enabled
     depthFunc $= Just Lequal
-    _ <- renderFoldable pdata $ picToLTree (Just 0) (foregroundPics w)
+    _ <- renderFoldable pdata $ picToLTree (Just 0) (polysToPic $ foregroundPics w)
+            --(Pictures $ concatmap (Poly3D 0 . _pyFaces) (foregroundPics w))
 
     -- draw the fbo to the screen
     -- allows for post-processing

src/Dodge/Render/Picture.hs

@@ -9,6 +9,7 @@ import Dodge.Render.MenuScreen
 import Geometry
 import Geometry.Data
 import Picture
+import Polyhedra.Data
 
 --import Dodge.Creature.YourControl
 
@@ -29,8 +30,8 @@ worldPictures w = pictures $ concat
     , map drawWallFloor (wallFloorsToDraw w)
     , testPic w
     ]
-foregroundPics :: World -> Picture
-foregroundPics = pictures . _foregroundDecorations
+foregroundPics :: World -> [Polyhedra]
+foregroundPics = _foregroundDecorations
 
 fixedCoordPictures :: World -> Picture
 fixedCoordPictures w = case _menuLayers w of 

src/Dodge/Room/Foreground.hs

@@ -8,6 +8,7 @@ import Geometry
 import Geometry.Data
 import Geometry.Vector3D
 import Polyhedra
+import Polyhedra.Data
 
 import Data.List
 import Data.Maybe
@@ -47,14 +48,13 @@ diagonalLinesRect pa pb w d ang = zip lhsPoints $ map findDiPoint lhsPoints
         ]
     yN = d * 0.5 *.* normalizeV (pa -.- pb)
 
-highPipe :: Point2 -> Point2 -> Picture
-highPipe x@(xx,xy) y = pictures 
-    --[color orange . pictures . map (poly3D . map ( ( , black) . ( +.+.+ (x,y,50)))) $ boxXYZ 
-    [ color orange . pictures . map (poly3D . map ( (,black) . (+.+.+ (xx,xy,50)))) 
+highPipe :: Point2 -> Point2 -> [Polyhedra]
+highPipe x@(xx,xy) y = 
+    [ Polyhedron . map (map ( (,orange) . (+.+.+ (xx,xy,50)))) 
         $ boxABC (a,b,0) (a',b',0) (0,0,10)
-    ,verticalPipe 5 orange x 0 100 
-    ,verticalPipe 5 orange y 0 100 
-    ,verticalPipe 5 orange (0.5 *.* (x +.+ y)) 50 100 
+--    ,verticalPipe 5 orange x 0 100 
+--    ,verticalPipe 5 orange y 0 100 
+--    ,verticalPipe 5 orange (0.5 *.* (x +.+ y)) 50 100 
     ]
   where
     (a,b) = y -.- x

src/Dodge/Room/Start.hs

@@ -7,7 +7,7 @@ import Dodge.Room.Procedural
 import Dodge.Room.Foreground
 import Dodge.Layout.Tree.Polymorphic
 import Dodge.LevelGen.Data
-import Picture
+--import Picture
 --import Geometry
 
 import Data.Tree
@@ -22,12 +22,10 @@ startRoom :: RandomGen g => State g (Tree (Either Room Room))
 startRoom = do
     w <- state $ randomR (100,400)
     h <- state $ randomR (200,400)
-    let fground = sPS (0,0) 0 $ PutForeground $ pictures
-            [ highPipe (0,h/3) (w, h/3)
-            , girderV cola 10 (0,3*h/4) (w, 3*h/4)
-            , girder colb 5 (0,5*h/8) (w, 5*h/8)
-            ]
+    let fground = sPS (0,0) 0 $ PutForeground $ highPipe (0,h/3) (w, h/3)
+--            , girderV cola 10 (0,3*h/4) (w, 3*h/4)
+--            , girder colb 5 (0,5*h/8) (w, 5*h/8)
     treeFromPost [Left rezBox, Left door] . Right <$> randomiseOutLinks (shiftRoomBy ((-20,-20),0) $ roomRectAutoLinks w h & rmPS %~ (fground :))
-  where
-    cola = dark . dark . light . light $ light red
-    colb = dark . dark . light . light $ light blue
+--  where
+--    cola = dark . dark . light . light $ light red
+--    colb = dark . dark . light . light $ light blue