Random tree structure generation of rooms

2021-04-20 02:01:24 +02:00
parent 38d67520cc
commit b911a013e0
14 changed files with 407 additions and 235 deletions
@@ -0,0 +1,67 @@
+module Dodge.Room.Corridor
+    where
+import Dodge.Room.Data
+import Geometry
+
+corridor :: Room
+corridor = Room
+    { _rmPolys = [rectNSWE 80 0 0 40
+                 ,[(0,80), (0,80) +.+ rotateV (pi/3) (40,0),(40,80)]
+                 ,[(40,0), (0,0) +.+ rotateV (0-pi/3) (40,0),( 0, 0)]
+                 ]
+    , _rmLinks = lnks
+    , _rmPath  = concatMap (doublePair . (,) (20,60)) $ map fst lnks
+    , _rmPS    = []
+    , _rmBound = [] -- rectNSWE 50 30 0 40
+    }
+  where 
+    lnks = 
+        [((20,70)  ,0)
+        ,((20,80) +.+ rotateV (0-pi/3) (-10,0),  pi/6)
+        ,((20,80) +.+ rotateV (  pi/3) ( 10,0),0-pi/6)
+        ,((20,10)    ,pi)
+        ]
+corridorN :: Room
+corridorN = Room
+    { _rmPolys = [rectNSWE 80 0 0 40
+                 ]
+    , _rmLinks = lnks
+    , _rmPath  = pth
+    , _rmPS    = []
+    , _rmBound = rectNSWE 50 30 0 40
+    }
+    where lnks = [((20,70)  ,0)
+                 ,((20,10)    ,pi)
+                 ]
+          pth = doublePair ((20,70),(20,10))
+
+tEast :: Room
+tEast = Room
+    { _rmPolys = [rectNSWE 80 0  (-20) (20)
+                 ,rectNSWE 80 40 (-40) 40
+                 ]
+    , _rmLinks = lnks
+    , _rmPath  = concatMap (doublePair . (,) (0,60)) $ map fst lnks
+    , _rmPS    = []
+    , _rmBound = rectNSWE 70 10 0 40
+    }
+    where lnks = [(( 30,60),-pi/2)
+                 ,((-30,60),pi/2)
+                 ,((0,10),pi)
+                 ]
+tWest :: Room
+tWest = Room
+    { _rmPolys = [rectNSWE 80 0  (-20) (20)
+                 ,rectNSWE 80 40 (-40) 40
+                 ]
+    , _rmLinks = lnks
+    , _rmPath  = concatMap (doublePair . (,) (0,60)) $ map fst lnks
+    , _rmPS    = []
+    , _rmBound = rectNSWE 70 10 0 40
+    }
+  where 
+    lnks = 
+        [((-30,60),pi/2)
+        ,(( 30,60),-pi/2)
+        ,((0,10),pi)
+        ]