• API
• FAQ
• Tools
• Archive
SHARE
TWEET

# lazy, State Monad, no vectors

a guest Jul 31st, 2013 45 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. module Main where
2.
3. import Random.Xorshift
5.
6. import Data.List
7. import Text.Printf
8. import Data.List.Split (chunksOf)
9. import Data.Ord (comparing)
10.
11. import Debug.Trace
12.
13. type Pos = (Int, Int)
14.
15. data Tile = Wall | Space
16.           deriving (Show)
17.
18. data Room = Room { rPos :: Pos
19.                  , rw, rh :: Int
20.                  } deriving(Show)
21.
22. data Lev = Lev { lRooms :: [Room]
23.                , lTiles :: [Tile]
24.                  }
25.
26. levDim, minWid, maxWid :: Int
27. levDim = 50
28. minWid = 2
29. maxWid = 8
30.
31. checkBound :: Room -> Bool
32. checkBound Room { rPos = (x,y), rw = w, rh = h } =
33.     x<=0 || y<=0 || x+w >= levDim || y+h >= levDim
34.
35. checkColl :: Room -> [Room] -> Bool
36. checkColl room = or . map (roomHitRoom room)
37.
38.
39. roomHitRoom :: Room -> Room -> Bool
40. roomHitRoom Room {rPos=(x,y), rw= w, rh= h} Room {rPos=( x2, y2), rw= w2, rh= h2}
41.     = not ((x2+w2+1) < x || x2 > (x+w+1)
42.         || (y2+h2+1) < y || y2 > (y+h+1))
43.
44. inRoom :: Pos -> Room -> Bool
45. inRoom (x, y) (Room (rx, ry) rw rh) =
46.         (rx <= x) && (x < rx + rw)
47.     &&  (ry <= y) && (y < ry + rh)
48.
49. showTiles :: [Tile] -> String
50. showTiles = unlines . chunksOf levDim . map toChar
51.   where
52.     toChar t = case t of
53.         Wall  -> '0'
54.         Space -> '1'
55.
56. type MyRandomGen = State (Int, Xorshift)
57.
58. genRandom :: MyRandomGen Int
59. genRandom = do
60.   (rnd, gen) <- get
61.   let (rv, gen') = next gen
62.  put (rv,gen')
63.   return rnd
64.
65. genRooms :: Int -> [Room] -> MyRandomGen [Room]
66. genRooms 0 done = return done
67. genRooms n rsDone = do
68.   r1 <- genRandom
69.   r2 <- genRandom
70.   let x = r1 `rem` levDim
71.       y = r2 `rem` levDim
72.       w = r1 `rem` maxWid + minWid
73.       h = r2 `rem` maxWid + minWid
74.       tr = Room {rPos=(x,y), rw= w, rh= h}
75.   if (checkBound tr) || (checkColl tr rsDone)
76.     then genRooms (n-1) rsDone
77.     else genRooms (n-1) (tr : rsDone)
78.
79.
80.
81. genLevs :: Int -> [Lev] -> MyRandomGen [Lev]
82. genLevs 0 done = return done
83. genLevs n ldone = do
84.   rs <- genRooms 50000 []
85.   let tiles = map (toTile rs)[1 .. levDim ^ 2] in
86.     genLevs (n-1) (Lev{lRooms = rs, lTiles = tiles} : ldone)
87.   where
88.     toTile rs n = if (any (toPos n `inRoom`) rs) then Space else Wall
89.     toPos n = let (y, x) = quotRem n levDim in (x, y)
90.
91.
92. biggestLev :: [Lev] -> Lev
93. biggestLev = maximumBy (comparing (length . lRooms))
94.
95. main :: IO ()
96. main = do
97.   gen <- newXorshift
98.   let levs = evalState (genLevs 100 []) (next gen)
99.   putStr \$ showTiles \$ lTiles \$ biggestLev levs
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.
Top