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
  4. import Control.Monad.State
  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. OK, I Understand
Top