Continue shape rendering improvements

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)