lazy, State Monad, no vectors

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