• API
• FAQ
• Tools
• Archive
SHARE
TWEET

a guest Jul 30th, 2013 83 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. {-# LANGUAGE BangPatterns #-}
2. module Main where
3.
4. import Random.Xorshift
6.
7. import Text.Printf
8. import Data.List.Split (chunksOf)
9. import Data.Ord (comparing)
10. import qualified Data.Vector as V
11.
12. import Debug.Trace
13.
14. type Pos = (Int, Int)
15.
16. data Tile = Wall | Space
17.           deriving (Show)
18.
19. data Room = Room { rPos :: !Pos
20.                  , rw, rh :: !Int
21.                  } deriving(Show)
22.
23. data Lev = Lev { lRooms :: !(V.Vector Room)
24.                , lTiles :: [Tile]
25.                  }
26.
27. levDim, minWid, maxWid :: Int
28. levDim = 50
29. minWid = 2
30. maxWid = 8
31.
32. checkBound :: Room -> Bool
33. checkBound Room { rPos = (x,y), rw = w, rh = h } =
34.     x<=0 || y<=0 || x+w >= levDim || y+h >= levDim
35.
36. checkColl :: Room -> V.Vector Room -> Bool
37. checkColl room = V.any (roomHitRoom room)
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 Xorshift
57.
58. genRandom :: MyRandomGen Int
59. genRandom = do
60.   gen <- get
61.   let (rv, gen') = next gen
62.  put gen'
63.   return rv
64.
65. myRandList :: Xorshift -> ([Int], Xorshift)
66. myRandList g =
67.   let (i, g') = next g
68.      (rest, g'') = myRandList g'
69.   in ((i : rest), g'')
70.
71. genRooms :: Int -> V.Vector Room -> MyRandomGen (V.Vector Room)
72. genRooms 0 done = return done
73. genRooms !n rsDone = do
74.   [r1,r2] <- sequence \$ replicate 2 genRandom
75.   let x = r1 `rem` levDim
76.       y = r2 `rem` levDim
77.       w = r1 `rem` maxWid + minWid
78.       h = r2 `rem` maxWid + minWid
79.       tr = Room {rPos=(x,y), rw= w, rh= h}
80.   if (checkBound tr) || (checkColl tr rsDone)
81.     then genRooms (n-1) rsDone
82.     else genRooms (n-1) (V.cons tr rsDone)
83.
84.
85. genLevs' :: Int -> V.Vector Lev -> MyRandomGen (V.Vector Lev)
86. genLevs' 0 done = return done
87. genLevs' n ldone = do
88.  rs <- genRooms 50000 V.empty
89.  let tiles = map (toTile rs) [1 .. levDim ^ 2] in
90.    genLevs' (n-1) ( V.cons Lev{lRooms = rs, lTiles = tiles} ldone)
91.   where
92.     toTile rs n = if (V.any (toPos n `inRoom`) rs) then Space else Wall
93.     toPos n = let (y, x) = quotRem n levDim in (x, y)
94.
95.
96. biggestLev :: V.Vector Lev -> Lev
97. biggestLev = V.maximumBy (comparing (V.length . lRooms))
98.
99. main :: IO ()
100. main = do
101.   gen <- newXorshift
102.   let levs = evalState (genLevs' 100 V.empty) gen
103.  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