feat(xan): Generate random villages

This algorithm is a little rough around the edges right now, but
generally the idea is we find a relatively closed-off region of the map,
and place rooms randomly on it, expanding them until they run into each
other, then we put doors in the walls of the rooms and a single door
opening into the region. Later on, we'll generate friendly (or
unfriendly!) NPCs to put in those rooms.

Change-Id: Ic989b9905f55ad92a01fdf6db11aa57afb4ce383
Reviewed-on: https://cl.tvl.fyi/c/depot/+/726
Reviewed-by: glittershark <grfn@gws.fyi>
This commit is contained in:
Griffin Smith 2020-06-28 19:33:27 -04:00 committed by glittershark
parent 6c7e14d2dc
commit bf9b09bd8c
12 changed files with 302 additions and 22 deletions

View file

@ -10,6 +10,7 @@ module Xanthous.Random
, weightedBy
, subRand
, chance
, chooseSubset
) where
--------------------------------------------------------------------------------
import Xanthous.Prelude
@ -17,6 +18,7 @@ import Xanthous.Prelude
import Data.List.NonEmpty (NonEmpty(..))
import Control.Monad.Random.Class (MonadRandom(getRandomR, getRandom))
import Control.Monad.Random (Rand, evalRand, mkStdGen, StdGen)
import Data.Functor.Compose
import Data.Random.Shuffle.Weighted
import Data.Random.Distribution
import Data.Random.Distribution.Uniform
@ -66,10 +68,16 @@ instance Choose (a, a) where
choose (x, y) = choose (x :| [y])
newtype Weighted w t a = Weighted (t (w, a))
deriving (Functor, Foldable) via (t `Compose` (,) w)
instance Traversable t => Traversable (Weighted w t) where
traverse f (Weighted twa) = Weighted <$> (traverse . traverse) f twa
evenlyWeighted :: [a] -> Weighted Int [] a
evenlyWeighted = Weighted . itoList
-- | Weight the elements of some functor by a function. Larger values of 'w' per
-- its 'Ord' instance will be more likely to be generated
weightedBy :: Functor t => (a -> w) -> t a -> Weighted w t a
weightedBy weighting xs = Weighted $ (weighting &&& id) <$> xs
@ -96,6 +104,14 @@ chance
-> m Bool
chance n = choose $ weightedBy (bool 1 (n * 2)) bools
-- | Choose a random subset of *about* @w@ of the elements of the given
-- 'Witherable' structure
chooseSubset :: ( Num w, Ord w, Distribution Uniform w, Excludable w
, Witherable t
, MonadRandom m
) => w -> t a -> m (t a)
chooseSubset = filterA . const . chance
--------------------------------------------------------------------------------
bools :: NonEmpty Bool