Move toward indexed external placements

src/Dodge/Layout.hs

@@ -14,9 +14,13 @@ import Dodge.Bounds
 import Dodge.Default.Wall
 import Dodge.Room.Link
 import Geometry
+import Geometry.ConvexPoly
 import qualified IntMapHelp as IM
 import Tile
 import Dodge.RandomHelp
+import Color
+import Shape
+--import Padding
 
 import Data.List (nubBy)
 import Data.Traversable
@@ -62,11 +66,22 @@ placeRoomWires rm w = IM.foldr ($) w
     $ IM.intersectionWith (placeWire rm) (_rmStartWires rm) (_rmEndWires rm)
 
 placeWire :: Room -> RoomWire -> RoomWire -> World -> World
-placeWire rm (RoomWire p' _) (RoomWire q' _) w = w & foregroundShape %~ (thinHighBar 80 p q <>)
+placeWire rm (RoomWire p _) (RoomWire q _) = foregroundShape 
+    %~ ((col $ thinHighBarChain 80 $ map (shiftPointBy rs) doOrdering) <>)
   where
+    --TODO use rmWalls for non convex rooms
+    --rmWalls = foldr cutWalls [] (_rmPolys rm)
+    doOrdering = orderPolygonAround rmcen (p:q:ps)
+    col | clockwise = colorSH red
+        | otherwise = colorSH orange
+    rmps = concat $ _rmPolys rm
+    rmcen = centroid rmps
+    clockwise = isLHS rmcen p q
+    ps  | clockwise = filter leftprightq rmps
+        | otherwise = filter rightpleftq rmps
+    leftprightq x = isLHS rmcen p x && isRHS rmcen q x
+    rightpleftq x = isRHS rmcen p x && isLHS rmcen q x
     rs = _rmShift rm
-    p = shiftPointBy rs p'
-    q = shiftPointBy rs q'
 
 doPartialPlacements :: ( (IM.IntMap [Placement],World) , [Room] ) -> (World,[Room])
 doPartialPlacements ((im,w),rms) = mapAccumR (doPartialPlacement im) w rms