Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- module Main where
- import Random.Xorshift
- import Control.Monad.State
- import Data.List
- import Text.Printf
- import Data.List.Split (chunksOf)
- import Data.Ord (comparing)
- import Debug.Trace
- type Pos = (Int, Int)
- data Tile = Wall | Space
- deriving (Show)
- data Room = Room { rPos :: Pos
- , rw, rh :: Int
- } deriving(Show)
- data Lev = Lev { lRooms :: [Room]
- , lTiles :: [Tile]
- }
- levDim, minWid, maxWid :: Int
- levDim = 50
- minWid = 2
- maxWid = 8
- checkBound :: Room -> Bool
- checkBound Room { rPos = (x,y), rw = w, rh = h } =
- x<=0 || y<=0 || x+w >= levDim || y+h >= levDim
- checkColl :: Room -> [Room] -> Bool
- checkColl room = or . map (roomHitRoom room)
- roomHitRoom :: Room -> Room -> Bool
- roomHitRoom Room {rPos=(x,y), rw= w, rh= h} Room {rPos=( x2, y2), rw= w2, rh= h2}
- = not ((x2+w2+1) < x || x2 > (x+w+1)
- || (y2+h2+1) < y || y2 > (y+h+1))
- inRoom :: Pos -> Room -> Bool
- inRoom (x, y) (Room (rx, ry) rw rh) =
- (rx <= x) && (x < rx + rw)
- && (ry <= y) && (y < ry + rh)
- showTiles :: [Tile] -> String
- showTiles = unlines . chunksOf levDim . map toChar
- where
- toChar t = case t of
- Wall -> '0'
- Space -> '1'
- type MyRandomGen = State (Int, Xorshift)
- genRandom :: MyRandomGen Int
- genRandom = do
- (rnd, gen) <- get
- let (rv, gen') = next gen
- put (rv,gen')
- return rnd
- genRooms :: Int -> [Room] -> MyRandomGen [Room]
- genRooms 0 done = return done
- genRooms n rsDone = do
- r1 <- genRandom
- r2 <- genRandom
- let x = r1 `rem` levDim
- y = r2 `rem` levDim
- w = r1 `rem` maxWid + minWid
- h = r2 `rem` maxWid + minWid
- tr = Room {rPos=(x,y), rw= w, rh= h}
- if (checkBound tr) || (checkColl tr rsDone)
- then genRooms (n-1) rsDone
- else genRooms (n-1) (tr : rsDone)
- genLevs :: Int -> [Lev] -> MyRandomGen [Lev]
- genLevs 0 done = return done
- genLevs n ldone = do
- rs <- genRooms 50000 []
- let tiles = map (toTile rs)[1 .. levDim ^ 2] in
- genLevs (n-1) (Lev{lRooms = rs, lTiles = tiles} : ldone)
- where
- toTile rs n = if (any (toPos n `inRoom`) rs) then Space else Wall
- toPos n = let (y, x) = quotRem n levDim in (x, y)
- biggestLev :: [Lev] -> Lev
- biggestLev = maximumBy (comparing (length . lRooms))
- main :: IO ()
- main = do
- gen <- newXorshift
- let levs = evalState (genLevs 100 []) (next gen)
- putStr $ showTiles $ lTiles $ biggestLev levs
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement