Work on grid point creation

src/Dodge/Room/Tutorial.hs

@@ -52,7 +52,7 @@ tutAnoTree = do
 --        , return $ tToBTree "cor" $ return $ cleatOnward corridor
 --        , return $ tToBTree "cor" $ return $ cleatOnward airlock0
         , return $ tToBTree "cor" $ return $ cleatOnward corridor
-        , return $ tToBTree "cor" $ return $ cleatOnward airlockCrystal
+        , tToBTree "cor" . return . cleatOnward <$> (zChasm 25)
 --        , tToBTree "x" . return . cleatOnward <$> airlockSimple
 --        , tToBTree "lastun" . return . cleatOnward <$> tanksRoom [] []
         , return $ tToBTree "cor" $ return $ cleatOnward corridor
@@ -159,10 +159,13 @@ lChasm = do
         <&> rmLinks %~ setInLinks (isCornerLink SouthEast)
         <&> rmPmnts <>~ [sps0 $ PutChasm (rectNSWE (y -50) 0 0 (x -50))]
 
+-- the Float is the width of the bridge
 zChasm :: Float -> State LayoutVars Room
 zChasm z = do
-    x <- state $ randomR (150, 300)
-    y <- state $ randomR (150, 300)
+--    x <- state $ randomR (150, 300)
+--    y <- state $ randomR (150, 300)
+    x <- return 250
+    y <- return 250
     roomRectAutoLinks x y
         <&> rmLinks %~ setOutLinks (isCornerLink NorthWest)
         <&> rmLinks %~ setInLinks (isCornerLink SouthEast)

src/Grid.hs

@@ -1,11 +1,14 @@
-module Grid where
+module Grid (
+    makeGrid,
+    gridInPolygon,
+    shiftedGrid,
+    gridPoints,
+    gridPoints'',
+) where
 
 import Bound
---import Data.Function (on)
-
-import Data.Bifunctor
+import Control.Lens
 import Data.List
---import Data.Maybe
 import qualified Data.Tuple.Extra as Tup
 import Geometry
 
@@ -41,8 +44,14 @@ shiftedGrid xmin xmax ymin ymax = grid
     shift p = bimap (p +.+) (p +.+)
     grid = map (shift (V2 (xmin + 20) (ymin + 20))) $ makeGrid 60 xsteps 60 ysteps
 
--- creates a rectangular grid starting at (0,0) in the positive orthant
--- needs fixing in degenerate (xstep or ystep == 0) cases
+-- creates a DAG
+gridXsYs :: [Float] -> [Float] -> [(Point2, Point2)]
+gridXsYs xs ys =
+    foldMap (\y -> mkpairs xs & each . each %~ (`V2` y)) ys
+        <> foldMap (\x -> mkpairs ys & each . each %~ V2 x) xs
+  where
+    mkpairs zs = zip zs $ tail zs
+
 makeGrid ::
     -- | horizontal step size
     Float ->
@@ -54,6 +63,22 @@ makeGrid ::
     Int ->
     [(Point2, Point2)]
 makeGrid x nx y ny =
+    foldMap doublePair $
+        gridXsYs (take (nx + 1) [0, x ..]) (take (ny + 1) [0, y ..])
+
+-- creates a rectangular grid starting at (0,0) in the positive orthant
+-- needs fixing in degenerate (xstep or ystep == 0) cases
+makeGrid' ::
+    -- | horizontal step size
+    Float ->
+    -- | number of horizontal steps
+    Int ->
+    -- | vertical step size
+    Float ->
+    -- | number of vertical steps
+    Int ->
+    [(Point2, Point2)]
+makeGrid' x nx y ny =
     nub
         . concatMap doublePair
         . concatMap (\p -> map (Tup.both (p +.+)) $ makeRect x y)