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 $