diff --git a/src/Dodge/Room/Tutorial.hs b/src/Dodge/Room/Tutorial.hs index bedf1f7ed..9d5b9f5a8 100644 --- a/src/Dodge/Room/Tutorial.hs +++ b/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) diff --git a/src/Grid.hs b/src/Grid.hs index 7eb67ecdc..b29e8b73f 100644 --- a/src/Grid.hs +++ b/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)