Add simple high pipes

src/Dodge/Picture.hs

@@ -40,3 +40,17 @@ wedgeOfThickness t x y
         ]
   where 
     n a b = (t*0.5) *.* errorNormalizeV 4200 (vNormal (a -.- b))
+
+verticalPipe :: Float -> Color -> Point2 -> Float -> Float -> Picture
+verticalPipe w col (xx,xy) za zb = pictures $ map (poly3D . f) ps
+  where
+    x = (xx,xy,0)
+    xs = map (\(a,b) -> x +.+.+ (a,b,za)) [(w,0),(0,w),(-w,0),(0,-w)]
+    ps = zip xs (tail xs ++ [head xs])
+    f (a,b) = map f' [a,b,g b,g a]
+    g :: Point3 -> Point3
+    g (a,b,_) = (a,b,zb)
+    f' a = (a,col)
+
+thickLinePlane :: Float -> Point3 -> Point3 -> Point3 -> [Point3]
+thickLinePlane = undefined

src/Dodge/Room/Foreground.hs

@@ -1,5 +1,6 @@
 module Dodge.Room.Foreground
     where
+import Dodge.Picture
 import Picture
 import Geometry
 import Geometry.Data
@@ -14,11 +15,11 @@ highDiagonalMesh
     -> Float    -- ^ vertical distance between lines
     -> Picture
 highDiagonalMesh pa pb w d = setDepth (-0.2) $ pictures $
-    (map (flip thickLine 1 . flat2) $ diagonalLinesRect pb pa w d (pi/4))
+    (map (flip thickLine 3 . flat2) $ diagonalLinesRect pb pa w d (3*pi/4))
     ++ 
-    (map (flip thickLine 1 . flat2) $ diagonalLinesRect pa pc h d (3* pi/4))
+    (map (flip thickLine 3 . flat2) $ diagonalLinesRect pb pc (negate h) d (pi/4))
   where
-    pc = pa +.+ w *.* normalizeV (vNormal (pb -.- pa))
+    pc = pb +.+ w *.* normalizeV (vNormal (pb -.- pa))
     h = dist pa pb
 
 diagonalLinesRect 
@@ -34,10 +35,22 @@ diagonalLinesRect pa pb w d ang = zip lhsPoints $ map findDiPoint lhsPoints
     diVec = rotateV ang xVec
     pax = pa +.+ xVec
     pbx = pb +.+ xVec
-    lhsPoints = divideLine d (pa -.- yN) (pb +.+ yN)
+    lhsPoints = divideLineExact d (pa -.- yN) (pb +.+ yN)
     findDiPoint p = head . sortOn (dist p) $ catMaybes 
         [intersectLineLine' p (p +.+ diVec) pax pbx
         ,intersectSegLine' pa pax p (p +.+ diVec)
         ,intersectSegLine' pb pbx p (p +.+ diVec)
         ]
     yN = d * 0.5 *.* (normalizeV $ pa -.- pb)
+
+highPipe :: Point2 -> Point2 -> Picture
+highPipe x y = pictures 
+    [setDepth (-0.2) $ thickLine [x,y] 10
+    ,setDepth (-0.19) $ color orange $ thickLine [x,y] 10
+    ,verticalPipe 5 orange x 0 (-0.2) 
+    ,verticalPipe 5 orange y 0 (-0.2) 
+    ,verticalPipe 5 orange (0.5 *.* (x +.+ y)) (-0.1) (-0.2) 
+    ]
+
+--highGirder :: Point2 -> Point2 -> Picture
+--highGirder x y = 

src/Dodge/Room/Start.hs

@@ -18,12 +18,13 @@ startRoom = do
     w <- state $ randomR (100,400)
     h <- state $ randomR (200,400)
     let fground = sPS (0,0) 0 $ PutForeground $ pictures
-            [ highDiagonalMesh (0,0) (0,h) w 25
-            --, setDepth (-0.1) $ color orange $ pictures
-            --    [ polygon $ rectNSEW 50 40 140 (-20)
-            --    , translate 60 45 $ scale 0.5 1 $  thickArc 0 pi 75 10
-            --    , translate (-20) 300 $ polygon $ rectNSEW 10 0 40 0
-            --    ]
-            , highDiagonalMesh (w,0) (0,0) h 25
+            --[ highDiagonalMesh (0,0) (0,h) w 50
+            ----, setDepth (-0.1) $ color orange $ pictures
+            ----    [ polygon $ rectNSEW 50 40 140 (-20)
+            ----    , translate 60 45 $ scale 0.5 1 $  thickArc 0 pi 75 10
+            ----    , translate (-20) 300 $ polygon $ rectNSEW 10 0 40 0
+            ----    ]
+            --, highDiagonalMesh (w,0) (0,0) h 50
+            [ highPipe (0,h/2) (w, h/2)
             ]
     pure . Right <$> randomiseOutLinks (shiftRoomBy ((-20,-20),0) $ roomRectAutoLinks w h & rmPS %~ (fground :))