Work toward adding wiring

src/Dodge/Layout.hs

@@ -1,8 +1,6 @@
 --{-# LANGUAGE TupleSections #-}
 module Dodge.Layout 
     ( generateLevelFromRoomList
---    , doPartialPlacements
---    , doExtendedPlacements
     ) where
 import Dodge.Data
 import Dodge.LevelGen
@@ -12,30 +10,30 @@ import Dodge.LevelGen.Pathing
 import Dodge.Wall.Zone
 import Dodge.GameRoom
 import Dodge.Bounds
-import Dodge.Room.Data
-import Dodge.Room.AddTile
+--import Dodge.LevelGen.Data
+import Dodge.Room.Foreground
 import Dodge.Default.Wall
 import Geometry
---import Geometry.Data
 import qualified IntMapHelp as IM
---import Dodge.Debug.LinkDecoration
 import Tile
 
 import Data.List (nubBy)
---import Control.Monad.State
+import Data.Traversable
 import Control.Lens
 import System.Random
 import Data.Foldable
 import qualified Control.Foldl as L
 import Data.Maybe
+import Data.Function
 
 generateLevelFromRoomList :: [Room] -> World -> World
 generateLevelFromRoomList gr w 
     = initWallZoning 
     . setupWorldBounds
-    . doPartialPlacements rs
-    . doExtendedPlacements rs
-    . flip (foldl' doRoomPlacements) rs
+    . placeWires
+    . doPartialPlacements
+    . doExtendedPlacements
+    . flip (mapAccumR doRoomPlacements) rs
     $ w { _walls        = wallsFromRooms rs
         , _floorTiles   = floorsFromRooms rs
         , _gameRooms    = gameRoomsFromRooms rs
@@ -48,29 +46,40 @@ generateLevelFromRoomList gr w
     rs = zipWith addTile zs gr
     zs = map fromIntegral $ randomRs (0,63::Int) $ _randGen w
 
-doPartialPlacements :: [Room] -> (IM.IntMap [Placement],World) -> World
-doPartialPlacements rms (im,w) = foldr (doPartialPlacement im) w rms
+placeWires :: (World,[Room])-> World
+placeWires (w,rms) = foldr placeRoomWires w rms
 
-doPartialPlacement :: IM.IntMap [Placement] -> Room -> World -> World
-doPartialPlacement im rm w = case _rmPartialPmnt rm of
-    Nothing -> w
+placeRoomWires :: Room -> World -> World
+placeRoomWires rm w = foldr placeWire w (_rmWires rm)
+
+placeWire :: RoomWire -> World -> World
+placeWire rw w = case rw of
+    RoomWire (p,_) (q,_) -> w & foregroundShape %~ (thinHighBar 40 p q <>)
+
+doPartialPlacements :: ( (IM.IntMap [Placement],World) , [Room] ) -> (World,[Room])
+doPartialPlacements ((im,w),rms) = mapAccumR (doPartialPlacement im) w rms
+
+doPartialPlacement :: IM.IntMap [Placement] -> World -> Room -> (World, Room)
+doPartialPlacement im w rm = case _rmPartPmnt rm of
+    Nothing -> (w, rm)
     Just fi -> case _rmTakeFrom rm of
-        Nothing -> w
-        Just i  -> fst $ fst $ placeSpot (w,rm) (fi (im IM.! i))
+        Nothing -> (w, rm)
+        Just i  -> fst $ placeSpot (w,rm) (fi (im IM.! i))
 
-doExtendedPlacements :: [Room] -> World -> (IM.IntMap [Placement], World)
-doExtendedPlacements rms w = foldr doExtendedPlacement (IM.empty,w) rms
+doExtendedPlacements :: (World,[Room]) -> ( (IM.IntMap [Placement], World) , [Room] )
+doExtendedPlacements (w,rms) = mapAccumR doExtendedPlacement (IM.empty,w) rms
 
-doExtendedPlacement :: Room -> (IM.IntMap [Placement], World) -> (IM.IntMap [Placement], World)
-doExtendedPlacement rm (im,w) = case _rmExtendedPmnt rm of
-    Nothing -> (im,w)
+doExtendedPlacement :: (IM.IntMap [Placement], World) -> Room 
+    -> ( (IM.IntMap [Placement], World) , Room )
+doExtendedPlacement (im,w) rm = case _rmExtPmnt rm of
+    Nothing -> ( (im,w) , rm )
     Just plmnt -> case _rmLabel rm of
-        Nothing -> (im,w)
-        Just i  -> let ((neww,_),plmnts) = placeSpot (w,rm) plmnt
-            in (IM.insert i plmnts im, neww)
+        Nothing -> ( (im,w) , rm )
+        Just i  -> let ((neww,newrm),plmnts) = placeSpot (w,rm) plmnt
+            in ( (IM.insert i plmnts im, neww) , newrm )
 
-doRoomPlacements :: World -> Room -> World
-doRoomPlacements w rm = fst $ foldl' (\wr -> fst . placeSpot wr) (w,rm) $ _rmPmnts rm
+doRoomPlacements :: World -> Room -> (World, Room)
+doRoomPlacements w rm = foldl' (\wr -> fst . placeSpot wr) (w,rm) $ _rmPmnts rm
 
 setupWorldBounds :: World -> World
 setupWorldBounds w = w
@@ -93,9 +102,6 @@ setupWorldBounds w = w
 
 initWallZoning :: World -> World
 initWallZoning w = foldl' (flip insertWallInZones) (w & wallsZone . znObjects .~ IM.empty) (_walls w)
---initWallZoning w = set (wallsZone . znObjects) (foldl' (flip wallInZone) IM.empty (_walls w)) w
---  where
---    wallInZone wl = flip (foldl' (flip $ \(a,b) -> insertIMInZone a b (_wlID wl) wl)) (zoneOfWall wl)
 
 --makePath :: Tree Room -> [(Point2,Point2)]
 --makePath = concatMap _rmPath . flatten
@@ -168,3 +174,11 @@ floorsFromRooms = concatMap (concatMap tToRender . _rmFloor)
 --    f r = shiftRoomBy ( V2 0 0 -.- rotateV (pi-a) p , 0) $ shiftRoomBy (V2 0 0,pi-a)  r
 --      where 
 --        (p,a) = last $ _rmLinks r
+
+addTile :: Float -> Room -> Room
+addTile z r
+    | not (null (_rmFloor r)) || null rp = r
+    | otherwise = r & rmFloor .~ [makeTileFromPoly poly z]
+  where
+    rp = _rmPolys r
+    poly = orderPolygon . convexHullSafe . nubBy ((==) `on` roundPoint2) $ concat rp