Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 86 lines (74 sloc) 2.589 kb
93bec3e Style fixes
Mihai Maruseac authored
1 module Maze.Maze (genMaze)
65ae38e Reorganized tree
Mihai Maruseac authored
2 where
3
93bec3e Style fixes
Mihai Maruseac authored
4 import Control.Arrow (first, second)
5 import Control.Monad.State (state, State)
6 import Data.Array.ST (runSTArray, newListArray, readArray, writeArray)
7 import System.Random (StdGen, randomR)
65ae38e Reorganized tree
Mihai Maruseac authored
8
9e05baf GUI complete (almost, config dialog missing and some more tweakings need...
Mihai Maruseac authored
9 import Maze.Types
65ae38e Reorganized tree
Mihai Maruseac authored
10
11 {-
12 Generates the entire maze.
13 -}
14 genMaze :: Size -> State StdGen Maze
15 genMaze s@(sx, sy) = do
16 (ews, ups) <- gMP s
17 return $ build sx sy ews ups
18
19 {-
20 Builds the maze using Sidewinder's algorithm.
21 -}
22 build :: Length -> Length -> [Point] -> [Point] -> Maze
23 build sx sy ews ups = runSTArray $ do
24 m <- newListArray ((1, 1), (sy, sx)) $ repeat $ C [E, W]
25 -- 1. Block eastern walls (including first row's end)
93bec3e Style fixes
Mihai Maruseac authored
26 mapM_ (blockCell m E) $ (sx, 1) : ews
65ae38e Reorganized tree
Mihai Maruseac authored
27 -- 2. Block western walls of corridors
93bec3e Style fixes
Mihai Maruseac authored
28 mapM_ (blockCell m W . first (+1)) $ filter (fst . first (/= sx)) ews
65ae38e Reorganized tree
Mihai Maruseac authored
29 -- 3. Block starts of rows.
93bec3e Style fixes
Mihai Maruseac authored
30 mapM_ (blockCell m W . (\y -> (1, y))) [1 .. sy]
65ae38e Reorganized tree
Mihai Maruseac authored
31 -- 4. Open northwards.
93bec3e Style fixes
Mihai Maruseac authored
32 mapM_ (openCell m N) ups
65ae38e Reorganized tree
Mihai Maruseac authored
33 -- 5. Open southwards
93bec3e Style fixes
Mihai Maruseac authored
34 mapM_ (openCell m S . second (subtract 1)) ups
65ae38e Reorganized tree
Mihai Maruseac authored
35 return m
36
37 {-
38 Generates all the important points in the maze. Receives size of maze and
39 returns a tuple with cells where the eastern corridor ends and where the
40 northwards openings are placed.
41 -}
42 gMP :: Size -> State StdGen ([Point], [Point])
43 gMP (sx, sy) = do
44 points <- mapM (gRP 0 sx) [2..sy]
45 return $ foldl (\(x, y) (a, b) -> (x ++ a, y ++ b)) ([], []) points
46
47 {-
48 Generates the important point for a row. Receives current position, length of
49 row and row order and returns a tuple containing a list of cells where the
50 eastern corridor should end and a list of cells where northwards openings
51 should be placed.
52 -}
53 gRP :: Coord -> Length -> Coord -> State StdGen ([Point], [Point])
54 gRP c sx y
55 | sx <= 0 = return ([], [])
56 | otherwise = do
57 len <- state $ randomR (1, sx)
58 up <- state $ randomR (1, len)
59 (rx, ry) <- gRP (c + len) (sx - len) y
60 return ((len + c, y):rx, (up + c, y):ry)
61
62 {-
63 Block one cell from the maze, represented as an array.
64 -}
93bec3e Style fixes
Mihai Maruseac authored
65 -- blockCell :: Data.Array.MArray Size Cell -> Cardinal -> Size -> m ()
65ae38e Reorganized tree
Mihai Maruseac authored
66 blockCell m d (x, y) = do
67 e <- readArray m (y, x)
68 writeArray m (y, x) $ block e d
69
70 {-
71 Open one cell from the maze, represented as an array.
72 -}
73 -- openCell :: (MArray a Cell m) => a Size Cell -> Cardinal -> Size -> m ()
74 openCell m d (x, y) = do
75 e <- readArray m (y, x)
76 writeArray m (y, x) $ open e d
77
78 {- Block a cell from one direction. -}
79 block :: Cell -> Cardinal -> Cell
80 block (C l) x = C $ filter (/= x) l
81
82 {- Open a cell to one direction. -}
83 open :: Cell -> Cardinal -> Cell
84 open (C l) x = C $ if x `elem` l then l else x : l
85
Something went wrong with that request. Please try again.