Skip to content

@monoidal /mapgen.hs forked from splinterofchaos/mapgen.hs
Created

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
A simple roguelike map generator. Uses naiive splatter pattern to create rooms.
-- based on https://gist.github.com/2874811
import System.Random
import System.Console.GetOpt
import System.Environment(getArgs, getProgName)
import Control.Monad.State
type Rand = State StdGen
rand m = do a <- state next
return (a `mod` m)
type Coord = (Int,Int)
type Range = (Int,Int)
type Area = (Coord,Coord) -- Upper-left and lower-right bounds.
data Tile = TFloor | TWall
instance Show Tile where
show TFloor = "."
show TWall = "#"
type MRow = [Tile]
type RMap = [MRow]
showMap :: RMap -> String
showMap = unlines . map (>>= show)
makeMap :: Coord -> RMap
makeMap (x,y) = replicate y (replicate x TWall)
splitGap :: Int -> Int -> [a] -> ([a],[a],[a])
splitGap start size lst = (before, middle, after)
where
(before,rest) = splitAt start lst
(middle,after) = splitAt (abs size) rest
digRow :: Range -> MRow -> MRow
digRow (start,end) row =
before ++ replicate size TFloor ++ after
where
size = end - start + 1
(before,_,after) = splitGap start size row
digRoom :: RMap -> Area -> RMap
digRoom rmap ((x,y),(u,v)) =
ybefore ++ map (digRow (x,u)) rows ++ yend
where
(ybefore,rows,yend) = splitGap y (v-y+1) rmap
randomRoom :: Coord -> Rand Area
randomRoom (w,h) = do
(x,u) <- gen_range w
(y,v) <- gen_range h
return ((x,y),(u,v)) -- Note the reordering of xuyv to xyuv.
where
minlen = 3
gen_range m = do
a <- rand (m-minlen-1)
let a' = a + 1
brange = m - a' - minlen
b <- rand (max 1 brange)
let b' = b + a' + minlen - 1
return (a',b')
randomPoint :: Area -> Rand Coord
randomPoint ((x,y),(u,v)) =
do x' <- rand (u-x+1)
y' <- rand (v-y+1)
return (x' + x, y' + y)
digHallway :: RMap -> Area -> RMap
digHallway m ((x,y),(u,v)) = foldl digRoom m
-- Dig from (x,y) to (u,y) to (u,v).
[((u,min y v),(u,max y v)),((min x u,y),(max x u,y))]
digRandomHallways :: RMap -> [Area] -> Rand RMap
digRandomHallways m rooms
| length rooms < 2 = return m
| otherwise =
do n <- rand (length $ tail rooms)
end1 <- randomPoint (head rooms)
end2 <- randomPoint (tail rooms!!n)
let m' = digHallway m (end1, end2)
digRandomHallways m' (tail rooms)
splatter :: Int -> RMap -> Rand RMap
-- Splatter n random rooms onto m.
splatter n m =
do rooms <- replicateM n $ randomRoom (length (head m),length m)
digRandomHallways (foldl digRoom m rooms) rooms
where
center ((x,y),(u,v)) = ((x+u) `quot` 2, (y+v) `quot` 2)
data Options = Options {optRooms::Int,optDimensions::Coord}
defaults :: Options
defaults = Options {optRooms=5,optDimensions=(80,60)}
options =
[Option "n" ["rooms"]
(ReqArg (\s op-> return op{optRooms=read s::Int}) "ROOMS")
"Number of rooms to dig.",
Option "d" ["dimensions"]
(ReqArg (\s op-> case reads s :: [(Coord,String)] of
((dims,_):_) ->
return op { optDimensions = dims }
_ -> error "Dimensions must be in format (width,height)")
"DIMENSIONS")
"Dimensions of map."]
main = do
-- Parse command line.
argv <- getArgs
let (actions,noops,msgs) = getOpt RequireOrder options argv
ops <- foldl (>>=) (return defaults) actions
let Options { optRooms=rooms, optDimensions=dimensions } = ops
gen <- newStdGen
putStrLn . showMap $ evalState (splatter rooms $ makeMap dimensions) gen
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.