Further strictifying

src/Dodge/Room/Corridor.hs

@@ -3,21 +3,24 @@ module Dodge.Room.Corridor
 import Dodge.Room.Data
 import Dodge.Default.Room
 import Geometry
+import Geometry.Data
 import Tile
+
+import Data.Bifunctor
 {- | First exit due north, two other exits at angles next to this.
  Entrance from south.  -}
 corridor :: Room
 corridor = defaultRoom
     { _rmPolys = [poly]
     , _rmLinks = lnks
-    , _rmPath  = concatMap (doublePair . (,) (20,60) . fst) lnks
+    , _rmPath  = concatMap (doublePair . (,) (V2 20 60) . fst) lnks
     , _rmPS    = []
     , _rmBound = [ rectNSWE 50 30 0 40 ]
     , _rmFloor = [oTile poly 2]  
     }
   where 
     poly = rectNSWE 80 0 0 40
-    lnks = 
+    lnks = map (first toV2)
         [((20,70)  ,0)
         ,((20,70), pi/6)
         ,((20,70), negate $ pi/6)
@@ -32,12 +35,12 @@ corridorDebug = defaultRoom
         --,   [ (0,0), (0,20) , (20,10)]
         ]
     , _rmLinks = lnks
-    , _rmPath  = concatMap (doublePair . (,) (20,60) . fst) lnks
+    , _rmPath  = concatMap (doublePair . (,) (V2 20 60) . fst) lnks
     , _rmPS    = []
     , _rmBound = [ rectNSWE 50 30 0 40 ]
     }
   where 
-    lnks = 
+    lnks = map (first toV2)
         [((20,70)  ,0)
         ,((20,70), pi/6)
         ,((20,70), negate $ pi/6)
@@ -52,10 +55,10 @@ corridorN = defaultRoom
     , _rmPS    = []
     , _rmBound = [ rectNSWE 50 30 0 40 ]
     }
-    where lnks = [((20,70)  ,0)
-                 ,((20,10)    ,pi)
+    where lnks = [((V2 20 70)  ,0)
+                 ,((V2 20 10)    ,pi)
                  ]
-          pth = doublePair ((20,70),(20,10))
+          pth = doublePair ((V2 20 70),(V2 20 10))
 
 tEast :: Room
 tEast = defaultRoom
@@ -63,26 +66,28 @@ tEast = defaultRoom
                  ,rectNSWE 80 40 (-40) 40
                  ]
     , _rmLinks = lnks
-    , _rmPath  = concatMap (doublePair . (,) (0,60) . fst) lnks
+    , _rmPath  = concatMap (doublePair . (,) (V2 0 60) . fst) lnks
     , _rmPS    = []
     , _rmBound = [ rectNSWE 70 10 0 40 ]
     }
-    where lnks = [(( 30,60),-pi/2)
-                 ,((-30,60),pi/2)
-                 ,((0,10),pi)
-                 ]
+  where 
+    lnks = map (first toV2) 
+        [(( 30,60),-pi/2)
+        ,((-30,60),pi/2)
+        ,((0,10),pi)
+        ]
 tWest :: Room
 tWest = defaultRoom
     { _rmPolys = [rectNSWE 80 0  (-20) 20
                  ,rectNSWE 80 40 (-40) 40
                  ]
     , _rmLinks = lnks
-    , _rmPath  = concatMap (doublePair . (,) (0,60) . fst) lnks
+    , _rmPath  = concatMap (doublePair . (,) (V2 0 60) . fst) lnks
     , _rmPS    = []
     , _rmBound = [ rectNSWE 70 10 0 40 ]
     }
   where 
-    lnks = 
+    lnks = map (first toV2)
         [((-30,60),pi/2)
         ,(( 30,60),-pi/2)
         ,((0,10),pi)

src/Dodge/Room/Door.hs

@@ -15,13 +15,13 @@ door :: Room
 door = defaultRoom
     { _rmPolys = [rectNSWE 40 0 0 40]
     , _rmLinks = lnks
-    , _rmPath  = [((20,35),(20,5))]
+    , _rmPath  = [((V2 20 35),(V2 20 5))]
 -- door extends into side walls (for shadows as rendered 12/03)
-    , _rmPS    = [sPS (0,20) 0 $ PutAutoDoor (0,0) (40,0)]
+    , _rmPS    = [sPS (V2 0 20) 0 $ PutAutoDoor (V2 0 0) (V2 40 0)]
     , _rmBound = [] 
     }
-    where lnks = [((20,35),0)
-                 ,((20, 5),pi)
+    where lnks = [((V2 20 35),0)
+                 ,((V2 20  5),pi)
                  ]
 
 

src/Dodge/Room/Foreground.hs

@@ -20,9 +20,9 @@ highDiagonalMesh
     -> Float    -- ^ vertical distance between lines
     -> Picture
 highDiagonalMesh pa pb w d = setDepth (-0.2) $ pictures $
-    map (flip thickLine 3 . flat2) (diagonalLinesRect pb pa w d (3*pi/4))
+    map (flip thickLine 3 . tflat2) (diagonalLinesRect pb pa w d (3*pi/4))
     ++ 
-    map (flip thickLine 3 . flat2) (diagonalLinesRect pb pc (negate h) d (pi/4))
+    map (flip thickLine 3 . tflat2) (diagonalLinesRect pb pc (negate h) d (pi/4))
   where
     pc = pb +.+ w *.* normalizeV (vNormal (pb -.- pa))
     h = dist pa pb
@@ -49,20 +49,20 @@ 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@(xx,xy) y = 
-    [ Polyhedron . map (map ( (,orange) . (+.+.+ (xx,xy,h)))) 
-        $ boxABC (a,b,0) (a',b',0) (0,0,5)
+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)
     ]
   where
-    (a,b) = y -.- x
-    (a',b') = 10 *.* normalizeV (vNormal (a,b))
+    (V2 a b) = y -.- x
+    (V2 a' b') = 10 *.* normalizeV (vNormal (V2 a b))
 
 girderZ :: Float -> Point2 -> Point2 -> Picture
 girderZ w x y = setDepth 50 $ color red $ pictures $
     [ thickLine [xt,yt] 3 
     , thickLine [xb,yb] 3
     ]
-    ++ map (flip thickLine 3 . flat2) ls
+    ++ map (flip thickLine 3 . tflat2) ls
   where
     n = w *.* normalizeV (vNormal $ y -.- x)
     xb = x +.+ n
@@ -78,8 +78,8 @@ girderV col w x y = setDepth 50 $ color col $ pictures $
     [ thickLine [xt,yt] 3 
     , thickLine [xb,yb] 3
     ]
-    ++ map (flip thickLine 3 . flat2) as'
-    ++ map (flip thickLine 3 . flat2) bs'
+    ++ map (flip thickLine 3 . tflat2) as'
+    ++ map (flip thickLine 3 . tflat2) bs'
   where
     n = w *.* normalizeV (vNormal $ y -.- x)
     xb = x +.+ n
@@ -97,7 +97,7 @@ girder col w x y = pictures $
         [ thickLine [xt,yt] 3 
         , thickLine [xb,yb] 3
         ]
-        ++ map (flip thickLine 3 . flat2) ls
+        ++ map (flip thickLine 3 . tflat2) ls
     )
     : map (\p -> verticalPipe 1.5 col p 0 (-0.1)) [xb,xt,yb,yt]
   where

src/Dodge/Room/Link.hs

@@ -59,8 +59,8 @@ This is intended to work when the external point is an outgoing link from anothe
 shiftRoomToLink :: (Point2,Float) -> Room -> Room
 shiftRoomToLink l r 
     = shiftRoomBy l 
-    . shiftRoomBy ((0,0) -.- rotateV (pi-a) p , 0) 
-    $ shiftRoomBy ((0,0)                      ,pi-a)  
+    . shiftRoomBy ((V2 0 0) -.- rotateV (pi-a) p , 0) 
+    $ shiftRoomBy ((V2 0 0)                      ,pi-a)  
     r
   where 
     (p,a) = last $ _rmLinks r