Generalise path generation for arbitrary rooms

src/Dodge/Room/Boss.hs

@@ -10,6 +10,7 @@ import Dodge.Room.Procedural
 import Dodge.Room.Placement
 import Dodge.Room.Link
 import Dodge.Room.Corridor
+import Dodge.Room.Path
 import Dodge.LevelGen.Data
 import Dodge.Creature
 import Dodge.Creature.State.Data
@@ -24,16 +25,17 @@ import System.Random
 roomGlassOctogon
     :: Float    -- ^ Size
     -> Room
-roomGlassOctogon x = defaultRoom
-    { _rmPolys = [rectNSWE x (-x) (-x) x
-                 ,rectNSWE 0 (-(x + 40)) (-20) 20
-                 ]
-    , _rmLinks = 
-        [(V2 0 x,0)
-        ,(V2 0 (-(x+40)),pi)
+roomGlassOctogon x = createPathGrid $ defaultRoom
+--roomGlassOctogon x = defaultRoom
+    { _rmPolys = 
+        [rectNSWE x (-x) (-x) x
+        ,rectNSWE 0 (-(x + 40)) (-20) 20
+        ]
+    , _rmLinks = lnks
+    , _rmPath  = linksAndPath lnks  
+        [ ( V2 0 x        , V2 0 (-(x+40)))
+        , ( V2 0 (-(x+40)), V2 0 x)
         ]
-    , _rmPath  = [(V2 0 x,V2 0 (-(x+40)))
-                 ,(V2 0 (-(x+40)),V2 0 x)]
     , _rmPS = 
         [sPS (V2 fx fx)   0 putLamp
         ,sPS (V2 (-fx) fx)  0 putLamp
@@ -43,12 +45,16 @@ roomGlassOctogon x = defaultRoom
         ,crystalLine (V2 x (x/2))  (V2 (x/2)  x)
         ,crystalLine (V2 (x/2) (-x)) (V2 x (negate (x/2)))
         ,crystalLine (V2 (negate $ x/2) (-x)) (V2 (-x) (negate (x/2)))
-        ,blockLine (V2 (-40) (40-x)) (V2 40 (40-x))
+        ,blockLine (V2 (-40) (50-x)) (V2 40 (50-x))
         ]
     , _rmBound = [rectNSWE x (-x) (-x) x]
     }
   where
     fx = 4 * x / 5
+    lnks = 
+        [ (V2 0 x,0)
+        , (V2 0 (-(x+40)),pi)
+        ]
 
 bossRoom :: RandomGen g => Creature -> State g Room
 bossRoom cr = randomMediumRoom <&> rmPS %~ ( sPS (V2 0 100) (negate $ pi/2) (PutCrit cr) :)

src/Dodge/Room/Procedural.hs

@@ -13,6 +13,7 @@ import Dodge.Data
 import Dodge.Room.Data
 import Dodge.Room.Placement
 import Dodge.Room.Link
+import Dodge.Room.Path
 import Dodge.Default.Room
 import Dodge.Item.Consumable
 import Dodge.Item.Equipment
@@ -26,9 +27,9 @@ import Geometry
 import Picture
 import Data.Tile
 
-import Data.List
-import Data.Function (on)
-import qualified Data.Tuple.Extra as Tup
+--import Data.List
+--import Data.Function (on)
+--import qualified Data.Tuple.Extra as Tup
 import qualified Data.Map as M
 import Control.Lens
 import Control.Monad
@@ -73,29 +74,7 @@ Creates a rectangular room, automatically creates links and pathfinding graph at
 roomRectAutoLinks :: Float -> Float -> Room
 roomRectAutoLinks x y = roomRect x y ((ceiling x - 40) `div` 60) ((ceiling y - 40) `div` 60)
 
-makeGrid :: Float -> Int -> Float -> Int -> [(Point2,Point2)]
-makeGrid x nx y ny 
-    = nub 
-    . concatMap doublePair 
-    . concatMap (\p -> map (Tup.both (p +.+)) $ makeRect x y)
-    $ gridPoints x nx y ny
 
-gridPoints :: Float -> Int -> Float -> Int -> [Point2]
-gridPoints x nx y ny = [V2 a b | a <- take nx $ scanl (+) 0 $ repeat x
-                              , b <- take ny $ scanl (+) 0 $ repeat y
-                       ]
-
-makeRect :: Float -> Float -> [(Point2,Point2)]
-makeRect x y = map (bimap toV2 toV2) [((0,0),(x,0))
-               ,((0,0),(0,y))
-               ,((x,y),(x,0))
-               ,((x,y),(0,y))
-               ]
-
-linksAndPath :: [(Point2,Float)] -> [(Point2,Point2)] -> [(Point2,Point2)]
-linksAndPath lnks subpth = subpth ++ concatMap linkClosest lnks
-  where 
-    linkClosest (p,_) = doublePair (p, minimumBy (compare `on` dist p) $ map fst subpth)
 {- Combines two rooms into one room.
 Combines into one big bound, concatenates the rest.  -}
 combineRooms :: Room -> Room -> Room