Continue shape rendering improvements

src/Dodge/Data.hs

@@ -27,7 +27,6 @@ import Data.Preload
 import Picture.Data
 import ShapePicture
 import Geometry.Data
-import Polyhedra.Data
 import Sound.Data
 import qualified DoubleStack as DS
 import Dodge.GameRoom
@@ -76,7 +75,8 @@ data World = World
     , _playingSounds        :: M.Map SoundOrigin Sound
     , _decorations          :: IM.IntMap Picture
     , _foregroundShape      :: Shape
-    , _foregroundDecorations :: [Polyhedra]
+    --, _foregroundDecorations :: [Polyhedra]
+    , _foregroundDecorations :: Shape
     , _foregroundEdgeVerx   :: [Point3]
     , _corpses              :: Zone [Corpse]
     , _clickMousePos        :: !Point2

src/Dodge/Default/World.hs

@@ -80,7 +80,7 @@ defaultWorld = World
     , _inventoryMode = TopInventory
     , _lClickHammer = HammerUp
     , _foregroundShape = mempty
-    , _foregroundDecorations = []
+    , _foregroundDecorations = mempty
     , _foregroundEdgeVerx = []
     , _radDistortion = []
     , _gameRooms = []

src/Dodge/Layout.hs

@@ -24,7 +24,6 @@ import Picture.Data
 import Tile
 import Polyhedra
 import Polyhedra.Data
-import Shape
 
 import Control.Monad.State
 import Control.Lens
@@ -78,11 +77,7 @@ setupWorldBounds w = w
         ) ps
 
 setupForegroundEdgeVerxs :: World -> World
-setupForegroundEdgeVerxs w = w & foregroundEdgeVerx .~ polyhedrasToEdges (_foregroundDecorations w)
-    & foregroundShape .~ ([ShapeObj ListV vs],es)
-  where
-    vs = shVfromList $ map pairToSV $ concatMap polyToTris $ concatMap _pyFaces $ _foregroundDecorations w
-    es = shEfromList $ polyhedrasToEdges (_foregroundDecorations w)
+setupForegroundEdgeVerxs w = w & foregroundShape .~ (_foregroundDecorations w)
 
 polyhedrasToEdges :: [Polyhedra] -> [Point3]
 polyhedrasToEdges = concatMap tflat4 . concatMap polyToEdges

src/Dodge/LevelGen.hs

@@ -19,9 +19,9 @@ import Dodge.LevelGen.TriggerDoor
 import Dodge.LevelGen.Switch
 import Dodge.LevelGen.Data
 import Geometry
+import Shape
 --import Geometry.Data
 import Picture
-import Polyhedra
 import qualified IntMapHelp as IM
 
 --import System.Random
@@ -99,7 +99,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 poly -> w & foregroundDecorations %~ (map (uncurryV translateXY p . rotateXY rot) poly ++)
+    PutForeground sh -> w & foregroundDecorations %~ ((uncurryV translateSHf p . rotateSH rot) sh <>)
     PutNothing -> w
     PutID _ -> w
     --_   -> w

src/Dodge/LevelGen/Data.hs

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

src/Dodge/Render.hs

@@ -19,7 +19,6 @@ import Shader.Bind
 import Shader.Data
 import MatrixHelper
 --import Polyhedra.Data
-import Polyhedra
 import Shader.ExtraPrimitive
 import Shader.Parameters
 
@@ -98,8 +97,6 @@ doDrawing pdata w = do
     if w ^. config . wall_textured
         then renderTextureWalls pdata nWalls
         else renderBlankWalls pdata nWalls
-    ---draw foreground geometry onto base buffer
-    renderFoldable shadV $ polysToPic $ foregroundPics w
     --draw objects onto base buffer
     layerCounts <- UMV.replicate (6*6) 0
     pokeBindFoldableLayer shadV layerCounts $ worldPictures w

src/Dodge/Render/Picture.hs

@@ -14,7 +14,6 @@ import Dodge.SoundLogic.LoadSound
 import Sound.Data
 import Geometry
 import Picture
-import Polyhedra.Data
 import ShapePicture
 
 import Control.Lens
@@ -42,9 +41,6 @@ worldPictures w = pictures
     winSize = 30 + max (getWindowX w) (getWindowY w)
     camCen = _cameraCenter w
     
-foregroundPics :: World -> [Polyhedra]
-foregroundPics = _foregroundDecorations
-
 fixedCoordPictures :: World -> Picture
 fixedCoordPictures w = case _menuLayers w of 
     [] -> pictures

src/Dodge/Room/Foreground.hs

@@ -6,9 +6,8 @@ import Dodge.Base
 import Picture
 import Geometry
 --import Geometry.Data
-import Geometry.Vector3D
-import Polyhedra
-import Polyhedra.Data
+--import Geometry.Vector3D
+import Shape
 
 import Data.List
 import Data.Maybe
@@ -48,14 +47,11 @@ diagonalLinesRect pa pb w d ang = zip lhsPoints $ map findDiPoint lhsPoints
         ]
     yN = d * 0.5 *.* normalizeV (pa -.- pb)
 
-highPipe :: Float -> Point2 -> Point2 -> [Polyhedra]
-highPipe h x@(V2 xx xy) y = 
-    [ Polyhedron . map (map ( (,orange) . (+.+.+ V3 xx xy h))) 
-        $ boxABC (V3 a b 0) (V3 a' b' 0) (V3 0 0 5)
-    ]
+highPipe :: Float -> Point2 -> Point2 -> Shape
+highPipe h x y = translateSHz h $ colorSH orange $ upperPrismPoly 5
+    [x +.+ n, y +.+ n, y -.- n, x -.- n]
   where
-    (V2 a b) = y -.- x
-    (V2 a' b') = 10 *.* normalizeV (vNormal (V2 a b))
+    n = 2.5 *.* normalizeV (vNormal (y -.- x))
 
 girderZ :: Float -> Point2 -> Point2 -> Picture
 girderZ w x y = setDepth 50 $ color red $ pictures $

src/Dodge/Room/Start.hs

@@ -25,8 +25,8 @@ startRoom = do
     h <- state $ randomR (200,400)
     let fground = sPS (V2 0 0) 0 $ PutForeground $ 
                highPipe 80 (V2  0    (h/3)) (V2  w    (h/2))
-            ++ highPipe 40 (V2  0    (h/2)) (V2  w    (h/3))
-            ++ highPipe 60 (V2 (w/3)    0 ) (V2 (w/3)  h   )
+            <> highPipe 40 (V2  0    (h/2)) (V2  w    (h/3))
+            <> highPipe 60 (V2 (w/3)    0 ) (V2 (w/3)  h   )
         theLamp = sPS (V2 (w/2) (h/2)) 0 $ putColorLamp (V3 0.75 0.75 0.75)
     treeFromPost [Left rezBox, Left door] . Right 
         <$> randomiseOutLinks (shiftRoomBy (V2 (-20) (-20),0)