scroll-1.20150313: Level/Random.hs

module Level.Random where

import System.Random

import Types
import Rand

data Chunk
	= Chunk String
	| ParaBreak

type Stream = [Chunk]

targetwidth :: Int
targetwidth = 70

formatLevel :: ([String] -> [String]) -> Int -> Stream -> Level
formatLevel f = go 0 [] [] 
  where
	go :: Int -> [String] -> [String] -> Int -> Stream -> [String]
	go _ currline ls _ [] = f (unwords currline:ls)
	go _ currline ls 0 _ = f (unwords currline:ls)
	go _ currline ls n (ParaBreak:ws) = go 0 [] (unwords currline:ls) (n-1) ws
	go currwidth currline ls n (c@(Chunk w):ws)
		| newwidth > targetwidth = go 0 [] (unwords currline:ls) (n-1) (c:ws)
		| otherwise = go newwidth (w:currline) ls n ws
		where
			newwidth = currwidth + length w + 1

data Feature
	= NoFeature
	| ElipsesFeature
	| EOLFeature
	| NewParaFeature Int
	| CorridorFeature Int
	deriving (Ord, Eq)

instance Random Feature where
	randomR _ g = random g
	random = go . randomR (1,100 :: Int)
	  where
		go (n, g)
			| n < 5 = (ElipsesFeature, g)
			| n < 8 = 
				let (l, g') = randomR (2,4) g
				in (NewParaFeature l, g')
			| n < 10 = (EOLFeature, g)
			| n < 12 =
				let (l, g') = randomR (10, targetwidth `div` 3) g
				in (CorridorFeature l, g')
			| otherwise = (NoFeature, g)

featureStream :: Rand -> [Feature]
featureStream r = withStdGen r (repeat NoFeature) randoms

addFeatures :: [(String, Feature)] -> Stream
addFeatures [] = []
addFeatures ((w, f):rest) = case f of
	NoFeature -> Chunk w : addFeatures rest
	ElipsesFeature -> Chunk ".." : cont
	NewParaFeature n -> ParaBreak : Chunk (replicate n ' ') : cont
	EOLFeature -> ParaBreak : cont
	CorridorFeature n -> Chunk (replicate n ' ') : cont
  where
	cont = addFeatures ((w, NoFeature):rest)