about summary refs log tree commit diff
path: root/users/grfn/xanthous/src/Xanthous/Generators
diff options
context:
space:
mode:
Diffstat (limited to 'users/grfn/xanthous/src/Xanthous/Generators')
-rw-r--r--users/grfn/xanthous/src/Xanthous/Generators/Level.hs172
-rw-r--r--users/grfn/xanthous/src/Xanthous/Generators/Level/CaveAutomata.hs112
-rw-r--r--users/grfn/xanthous/src/Xanthous/Generators/Level/Dungeon.hs190
-rw-r--r--users/grfn/xanthous/src/Xanthous/Generators/Level/LevelContents.hs182
-rw-r--r--users/grfn/xanthous/src/Xanthous/Generators/Level/Util.hs236
-rw-r--r--users/grfn/xanthous/src/Xanthous/Generators/Level/Village.hs126
-rw-r--r--users/grfn/xanthous/src/Xanthous/Generators/Speech.hs181
7 files changed, 0 insertions, 1199 deletions
diff --git a/users/grfn/xanthous/src/Xanthous/Generators/Level.hs b/users/grfn/xanthous/src/Xanthous/Generators/Level.hs
deleted file mode 100644
index fc57402e7d8e..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Generators/Level.hs
+++ /dev/null
@@ -1,172 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE GADTs           #-}
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
-module Xanthous.Generators.Level
-  ( generate
-  , Generator(..)
-  , SGenerator(..)
-  , GeneratorInput(..)
-  , generateFromInput
-  , parseGeneratorInput
-  , showCells
-  , Level(..)
-  , levelWalls
-  , levelItems
-  , levelCreatures
-  , levelDoors
-  , levelCharacterPosition
-  , levelTutorialMessage
-  , levelExtra
-  , generateLevel
-  , levelToEntityMap
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
-import           Data.Array.Unboxed
-import qualified Options.Applicative as Opt
-import           Control.Monad.Random
---------------------------------------------------------------------------------
-import qualified Xanthous.Generators.Level.CaveAutomata as CaveAutomata
-import qualified Xanthous.Generators.Level.Dungeon as Dungeon
-import           Xanthous.Generators.Level.Util
-import           Xanthous.Generators.Level.LevelContents
-import           Xanthous.Generators.Level.Village as Village
-import           Xanthous.Data (Dimensions, Position'(Position), Position)
-import           Xanthous.Data.EntityMap (EntityMap, _EntityMap)
-import qualified Xanthous.Data.EntityMap as EntityMap
-import           Xanthous.Entities.Environment
-import           Xanthous.Entities.Item (Item)
-import           Xanthous.Entities.Creature (Creature)
-import           Xanthous.Game.State (SomeEntity(..))
-import           Linear.V2
---------------------------------------------------------------------------------
-
-data Generator
-  = CaveAutomata
-  | Dungeon
-  deriving stock (Show, Eq)
-
-data SGenerator (gen :: Generator) where
-  SCaveAutomata :: SGenerator 'CaveAutomata
-  SDungeon :: SGenerator 'Dungeon
-
-type family Params (gen :: Generator) :: Type where
-  Params 'CaveAutomata = CaveAutomata.Params
-  Params 'Dungeon = Dungeon.Params
-
-generate
-  :: RandomGen g
-  => SGenerator gen
-  -> Params gen
-  -> Dimensions
-  -> g
-  -> Cells
-generate SCaveAutomata = CaveAutomata.generate
-generate SDungeon = Dungeon.generate
-
-data GeneratorInput where
-  GeneratorInput :: forall gen. SGenerator gen -> Params gen -> GeneratorInput
-
-generateFromInput :: RandomGen g => GeneratorInput -> Dimensions -> g -> Cells
-generateFromInput (GeneratorInput sg ps) = generate sg ps
-
-parseGeneratorInput :: Opt.Parser GeneratorInput
-parseGeneratorInput = Opt.subparser
-  $ generatorCommand SCaveAutomata
-      "cave"
-      "Cellular-automata based cave generator"
-      CaveAutomata.parseParams
-  <> generatorCommand SDungeon
-      "dungeon"
-      "Classic dungeon map generator"
-      Dungeon.parseParams
-  where
-    generatorCommand sgen name desc parseParams =
-      Opt.command name
-        (Opt.info
-          (GeneratorInput sgen <$> parseParams)
-          (Opt.progDesc desc)
-        )
-
-
-showCells :: Cells -> Text
-showCells arr =
-  let (V2 minX minY, V2 maxX maxY) = bounds arr
-      showCellVal True = "x"
-      showCellVal False = " "
-      showCell = showCellVal . (arr !)
-      row r = foldMap (showCell . (`V2` r)) [minX..maxX]
-      rows = row <$> [minY..maxY]
-  in intercalate "\n" rows
-
-cellsToWalls :: Cells -> EntityMap Wall
-cellsToWalls cells = foldl' maybeInsertWall mempty . assocs $ cells
-  where
-    maybeInsertWall em (pos@(V2 x y), True)
-      | not (surroundedOnAllSides pos) =
-        let x' = fromIntegral x
-            y' = fromIntegral y
-        in EntityMap.insertAt (Position x' y') Wall em
-    maybeInsertWall em _ = em
-    surroundedOnAllSides pos = numAliveNeighbors cells pos == 8
-
---------------------------------------------------------------------------------
-
-data Level = Level
-  { _levelWalls             :: !(EntityMap Wall)
-  , _levelDoors             :: !(EntityMap Door)
-  , _levelItems             :: !(EntityMap Item)
-  , _levelCreatures         :: !(EntityMap Creature)
-  , _levelTutorialMessage   :: !(EntityMap GroundMessage)
-  , _levelStaircases        :: !(EntityMap Staircase)
-  , _levelExtra             :: !(EntityMap SomeEntity) -- ^ TODO this is a bit of a hack...
-  , _levelCharacterPosition :: !Position
-  }
-  deriving stock (Generic)
-  deriving anyclass (NFData)
-makeLenses ''Level
-
-generateLevel
-  :: MonadRandom m
-  => SGenerator gen
-  -> Params gen
-  -> Dimensions
-  -> Word -- ^ Level number, starting at 0
-  -> m Level
-generateLevel gen ps dims num = do
-  rand <- mkStdGen <$> getRandom
-  let cells = generate gen ps dims rand
-      _levelWalls = cellsToWalls cells
-  village <- generateVillage cells gen
-  let _levelExtra = village
-  _levelItems <- randomItems cells
-  _levelCreatures <- randomCreatures num cells
-  _levelDoors <- randomDoors cells
-  _levelCharacterPosition <- chooseCharacterPosition cells
-  let upStaircase = _EntityMap # [(_levelCharacterPosition, UpStaircase)]
-  downStaircase <- placeDownStaircase cells
-  let _levelStaircases = upStaircase <> downStaircase
-  _levelTutorialMessage <-
-    if num == 0
-    then tutorialMessage cells _levelCharacterPosition
-    else pure mempty
-  pure Level {..}
-
-levelToEntityMap :: Level -> EntityMap SomeEntity
-levelToEntityMap level
-  = (SomeEntity <$> level ^. levelWalls)
-  <> (SomeEntity <$> level ^. levelDoors)
-  <> (SomeEntity <$> level ^. levelItems)
-  <> (SomeEntity <$> level ^. levelCreatures)
-  <> (SomeEntity <$> level ^. levelTutorialMessage)
-  <> (SomeEntity <$> level ^. levelStaircases)
-  <> (level ^. levelExtra)
-
-generateVillage
-  :: MonadRandom m
-  => Cells -- ^ Wall positions
-  -> SGenerator gen
-  -> m (EntityMap SomeEntity)
-generateVillage wallPositions SCaveAutomata = Village.fromCave wallPositions
-generateVillage _ _ = pure mempty
diff --git a/users/grfn/xanthous/src/Xanthous/Generators/Level/CaveAutomata.hs b/users/grfn/xanthous/src/Xanthous/Generators/Level/CaveAutomata.hs
deleted file mode 100644
index 03d534ca39b3..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Generators/Level/CaveAutomata.hs
+++ /dev/null
@@ -1,112 +0,0 @@
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
-module Xanthous.Generators.Level.CaveAutomata
-  ( Params(..)
-  , defaultParams
-  , parseParams
-  , generate
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
-import           Control.Monad.Random (RandomGen, runRandT)
-import           Data.Array.ST
-import           Data.Array.Unboxed
-import qualified Options.Applicative as Opt
---------------------------------------------------------------------------------
-import           Xanthous.Util (between)
-import           Xanthous.Util.Optparse
-import           Xanthous.Data (Dimensions, width, height)
-import           Xanthous.Generators.Level.Util
-import           Linear.V2
---------------------------------------------------------------------------------
-
-data Params = Params
-  { _aliveStartChance :: Double
-  , _birthLimit :: Word
-  , _deathLimit :: Word
-  , _steps :: Word
-  }
-  deriving stock (Show, Eq, Generic)
-makeLenses ''Params
-
-defaultParams :: Params
-defaultParams = Params
-  { _aliveStartChance = 0.6
-  , _birthLimit = 3
-  , _deathLimit = 4
-  , _steps = 4
-  }
-
-parseParams :: Opt.Parser Params
-parseParams = Params
-  <$> Opt.option parseChance
-      ( Opt.long "alive-start-chance"
-      <> Opt.value (defaultParams ^. aliveStartChance)
-      <> Opt.showDefault
-      <> Opt.help ( "Chance for each cell to start alive at the beginning of "
-                 <> "the cellular automata"
-                 )
-      <> Opt.metavar "CHANCE"
-      )
-  <*> Opt.option parseNeighbors
-      ( Opt.long "birth-limit"
-      <> Opt.value (defaultParams ^. birthLimit)
-      <> Opt.showDefault
-      <> Opt.help "Minimum neighbor count required for birth of a cell"
-      <> Opt.metavar "NEIGHBORS"
-      )
-  <*> Opt.option parseNeighbors
-      ( Opt.long "death-limit"
-      <> Opt.value (defaultParams ^. deathLimit)
-      <> Opt.showDefault
-      <> Opt.help "Maximum neighbor count required for death of a cell"
-      <> Opt.metavar "NEIGHBORS"
-      )
-  <*> Opt.option Opt.auto
-      ( Opt.long "steps"
-      <> Opt.value (defaultParams ^. steps)
-      <> Opt.showDefault
-      <> Opt.help "Number of generations to run the automata for"
-      <> Opt.metavar "STEPS"
-      )
-  <**> Opt.helper
-  where
-    parseChance = readWithGuard
-      (between 0 1)
-      $ \res -> "Chance must be in the range [0,1], got: " <> show res
-
-    parseNeighbors = readWithGuard
-      (between 0 8)
-      $ \res -> "Neighbors must be in the range [0,8], got: " <> show res
-
-generate :: RandomGen g => Params -> Dimensions -> g -> Cells
-generate params dims gen
-  = runSTUArray
-  $ fmap fst
-  $ flip runRandT gen
-  $ generate' params dims
-
-generate' :: RandomGen g => Params -> Dimensions -> CellM g s (MCells s)
-generate' params dims = do
-  cells <- randInitialize dims $ params ^. aliveStartChance
-  let steps' = params ^. steps
-  when (steps' > 0)
-   $ for_ [0 .. pred steps'] . const $ stepAutomata cells dims params
-  -- Remove all but the largest contiguous region of unfilled space
-  (_: smallerRegions) <- lift $ regions @UArray . amap not <$> freeze cells
-  lift $ fillAllM (fold smallerRegions) cells
-  lift $ fillOuterEdgesM cells
-  pure cells
-
-stepAutomata :: forall s g. MCells s -> Dimensions -> Params -> CellM g s ()
-stepAutomata cells dims params = do
-  origCells <- lift $ cloneMArray @_ @(STUArray s) cells
-  for_ (range (0, V2 (dims ^. width) (dims ^. height))) $ \pos -> do
-    neighs <- lift $ numAliveNeighborsM origCells pos
-    origValue <- lift $ readArray origCells pos
-    lift . writeArray cells pos
-      $ if origValue
-        then neighs >= params ^. deathLimit
-        else neighs > params ^. birthLimit
diff --git a/users/grfn/xanthous/src/Xanthous/Generators/Level/Dungeon.hs b/users/grfn/xanthous/src/Xanthous/Generators/Level/Dungeon.hs
deleted file mode 100644
index 0be7c0435c5a..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Generators/Level/Dungeon.hs
+++ /dev/null
@@ -1,190 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
-module Xanthous.Generators.Level.Dungeon
-  ( Params(..)
-  , defaultParams
-  , parseParams
-  , generate
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding ((:>))
---------------------------------------------------------------------------------
-import           Control.Monad.Random
-import           Data.Array.ST
-import           Data.Array.IArray (amap)
-import           Data.Stream.Infinite (Stream(..))
-import qualified Data.Stream.Infinite as Stream
-import qualified Data.Graph.Inductive.Graph as Graph
-import           Data.Graph.Inductive.PatriciaTree
-import qualified Data.List.NonEmpty as NE
-import           Data.Maybe (fromJust)
-import           Linear.V2
-import           Linear.Metric
-import qualified Options.Applicative as Opt
---------------------------------------------------------------------------------
-import           Xanthous.Random
-import           Xanthous.Data hiding (x, y, _x, _y, edges, distance)
-import           Xanthous.Generators.Level.Util
-import           Xanthous.Util.Graphics (delaunay, straightLine)
-import           Xanthous.Util.Graph (mstSubGraph)
---------------------------------------------------------------------------------
-
-data Params = Params
-  { _numRoomsRange :: (Word, Word)
-  , _roomDimensionRange :: (Word, Word)
-  , _connectednessRatioRange :: (Double, Double)
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-makeLenses ''Params
-
-defaultParams :: Params
-defaultParams = Params
-  { _numRoomsRange = (6, 8)
-  , _roomDimensionRange = (3, 12)
-  , _connectednessRatioRange = (0.1, 0.15)
-  }
-
-parseParams :: Opt.Parser Params
-parseParams = Params
-  <$> parseRange
-        "num-rooms"
-        "number of rooms to generate in the dungeon"
-        "ROOMS"
-        (defaultParams ^. numRoomsRange)
-  <*> parseRange
-        "room-size"
-        "size in tiles of one of the sides of a room"
-        "TILES"
-        (defaultParams ^. roomDimensionRange)
-  <*> parseRange
-        "connectedness-ratio"
-        ( "ratio of edges from the delaunay triangulation to re-add to the "
-        <> "minimum-spanning-tree")
-        "RATIO"
-        (defaultParams ^. connectednessRatioRange)
-  <**> Opt.helper
-  where
-    parseRange name desc metavar (defMin, defMax) =
-      (,)
-      <$> Opt.option Opt.auto
-          ( Opt.long ("min-" <> name)
-          <> Opt.value defMin
-          <> Opt.showDefault
-          <> Opt.help ("Minimum " <> desc)
-          <> Opt.metavar metavar
-          )
-      <*> Opt.option Opt.auto
-          ( Opt.long ("max-" <> name)
-          <> Opt.value defMax
-          <> Opt.showDefault
-          <> Opt.help ("Maximum " <> desc)
-          <> Opt.metavar metavar
-          )
-
-generate :: RandomGen g => Params -> Dimensions -> g -> Cells
-generate params dims gen
-  = amap not
-  $ runSTUArray
-  $ fmap fst
-  $ flip runRandT gen
-  $ generate' params dims
-
---------------------------------------------------------------------------------
-
-generate' :: RandomGen g => Params -> Dimensions -> CellM g s (MCells s)
-generate' params dims = do
-  cells <- initializeEmpty dims
-  rooms <- genRooms params dims
-  for_ rooms $ fillRoom cells
-
-  let fullRoomGraph = delaunayRoomGraph rooms
-      mst = mstSubGraph fullRoomGraph
-      mstEdges = Graph.edges mst
-      nonMSTEdges = filter (\(n₁, n₂, _) -> (n₁, n₂) `notElem` mstEdges)
-                    $ Graph.labEdges fullRoomGraph
-
-  reintroEdgeCount <- floor . (* fromIntegral (length nonMSTEdges))
-                     <$> getRandomR (params ^. connectednessRatioRange)
-  let reintroEdges = take reintroEdgeCount nonMSTEdges
-      corridorGraph = Graph.insEdges reintroEdges mst
-
-  corridors <- traverse
-              ( uncurry corridorBetween
-              . over both (fromJust . Graph.lab corridorGraph)
-              ) $ Graph.edges corridorGraph
-
-  for_ (join corridors) $ \pt -> lift $ writeArray cells pt True
-
-  pure cells
-
-type Room = Box Word
-
-genRooms :: MonadRandom m => Params -> Dimensions -> m [Room]
-genRooms params dims = do
-  numRooms <- fromIntegral <$> getRandomR (params ^. numRoomsRange)
-  subRand . fmap (Stream.take numRooms . removeIntersecting []) . infinitely $ do
-    roomWidth <- getRandomR $ params ^. roomDimensionRange
-    roomHeight <- getRandomR $ params ^. roomDimensionRange
-    xPos <- getRandomR (0, dims ^. width - roomWidth)
-    yPos <- getRandomR (0, dims ^. height - roomHeight)
-    pure Box
-      { _topLeftCorner = V2 xPos yPos
-      , _dimensions = V2 roomWidth roomHeight
-      }
-  where
-    removeIntersecting seen (room :> rooms)
-      | any (boxIntersects room) seen
-      = removeIntersecting seen rooms
-      | otherwise
-      = room :> removeIntersecting (room : seen) rooms
-    streamRepeat x = x :> streamRepeat x
-    infinitely = sequence . streamRepeat
-
-delaunayRoomGraph :: [Room] -> Gr Room Double
-delaunayRoomGraph rooms =
-  Graph.insEdges edges . Graph.insNodes nodes $ Graph.empty
-  where
-    edges = map (\((n₁, room₁), (n₂, room₂)) -> (n₁, n₂, roomDist room₁ room₂))
-          . over (mapped . both) snd
-          . delaunay @Double
-          . NE.fromList
-          . map (\p@(_, room) -> (boxCenter $ fromIntegral <$> room, p))
-          $ nodes
-    nodes = zip [0..] rooms
-    roomDist = distance `on` (boxCenter . fmap fromIntegral)
-
-fillRoom :: MCells s -> Room -> CellM g s ()
-fillRoom cells room =
-  let V2 posx posy = room ^. topLeftCorner
-      V2 dimx dimy = room ^. dimensions
-  in for_ [posx .. posx + dimx] $ \x ->
-       for_ [posy .. posy + dimy] $ \y ->
-         lift $ writeArray cells (V2 x y) True
-
-corridorBetween :: MonadRandom m => Room -> Room -> m [V2 Word]
-corridorBetween originRoom destinationRoom
-  = straightLine <$> origin <*> destination
-  where
-    origin = choose . NE.fromList =<< originEdge
-    destination = choose . NE.fromList =<< destinationEdge
-    originEdge = pickEdge originRoom originCorner
-    destinationEdge = pickEdge destinationRoom destinationCorner
-    pickEdge room corner = choose . over both (boxEdge room) $ cornerEdges corner
-    originCorner =
-      case ( compare (originRoom ^. topLeftCorner . _x)
-                     (destinationRoom ^. topLeftCorner . _x)
-           , compare (originRoom ^. topLeftCorner . _y)
-                     (destinationRoom ^. topLeftCorner . _y)
-           ) of
-        (LT, LT) -> BottomRight
-        (LT, GT) -> TopRight
-        (GT, LT) -> BottomLeft
-        (GT, GT) -> TopLeft
-
-        (EQ, LT) -> BottomLeft
-        (EQ, GT) -> TopRight
-        (GT, EQ) -> TopLeft
-        (LT, EQ) -> BottomRight
-        (EQ, EQ) -> TopLeft -- should never happen
-
-    destinationCorner = opposite originCorner
diff --git a/users/grfn/xanthous/src/Xanthous/Generators/Level/LevelContents.hs b/users/grfn/xanthous/src/Xanthous/Generators/Level/LevelContents.hs
deleted file mode 100644
index 4f8a2f42ee16..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Generators/Level/LevelContents.hs
+++ /dev/null
@@ -1,182 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
---------------------------------------------------------------------------------
-module Xanthous.Generators.Level.LevelContents
-  ( chooseCharacterPosition
-  , randomItems
-  , randomCreatures
-  , randomDoors
-  , placeDownStaircase
-  , tutorialMessage
-  , entityFromRaw
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding (any, toList)
---------------------------------------------------------------------------------
-import           Control.Monad.Random
-import           Data.Array.IArray (amap, bounds, rangeSize, (!))
-import qualified Data.Array.IArray as Arr
-import           Data.Foldable (any, toList)
-import           Linear.V2
---------------------------------------------------------------------------------
-import           Xanthous.Generators.Level.Util
-import           Xanthous.Random hiding (chance)
-import qualified Xanthous.Random as Random
-import           Xanthous.Data
-                 ( positionFromV2,  Position, _Position
-                 , rotations, arrayNeighbors, Neighbors(..)
-                 , neighborPositions
-                 )
-import           Xanthous.Data.EntityMap (EntityMap, _EntityMap)
-import           Xanthous.Entities.Raws (rawsWithType, RawType, raw)
-import qualified Xanthous.Entities.Item as Item
-import           Xanthous.Entities.Item (Item)
-import qualified Xanthous.Entities.Creature as Creature
-import           Xanthous.Entities.Creature (Creature)
-import           Xanthous.Entities.Environment
-                 (GroundMessage(..), Door(..), unlockedDoor, Staircase(..))
-import           Xanthous.Messages (message_)
-import           Xanthous.Util.Graphics (circle)
-import           Xanthous.Entities.RawTypes
-import           Xanthous.Entities.Creature.Hippocampus (initialHippocampus)
-import           Xanthous.Entities.Common (inRightHand, asWieldedItem, wielded)
-import           Xanthous.Game.State (SomeEntity(SomeEntity))
---------------------------------------------------------------------------------
-
-chooseCharacterPosition :: MonadRandom m => Cells -> m Position
-chooseCharacterPosition = randomPosition
-
-randomItems :: MonadRandom m => Cells -> m (EntityMap Item)
-randomItems = randomEntities (fmap Identity . Item.newWithType) (0.0004, 0.001)
-
-placeDownStaircase :: MonadRandom m => Cells -> m (EntityMap Staircase)
-placeDownStaircase cells = do
-  pos <- randomPosition cells
-  pure $ _EntityMap # [(pos, DownStaircase)]
-
-randomDoors :: MonadRandom m => Cells -> m (EntityMap Door)
-randomDoors cells = do
-  doorRatio <- getRandomR subsetRange
-  let numDoors = floor $ doorRatio * fromIntegral (length candidateCells)
-      doorPositions =
-        removeAdjacent . fmap positionFromV2 . take numDoors $ candidateCells
-      doors = zip doorPositions $ repeat unlockedDoor
-  pure $ _EntityMap # doors
-  where
-    removeAdjacent =
-      foldr (\pos acc ->
-               if pos `elem` (acc >>= toList . neighborPositions)
-               then acc
-               else pos : acc
-            ) []
-    candidateCells = filter doorable $ Arr.indices cells
-    subsetRange = (0.8 :: Double, 1.0)
-    doorable pos =
-      not (fromMaybe True $ cells ^? ix pos)
-      && any (teeish . fmap (fromMaybe True))
-        (rotations $ arrayNeighbors cells pos)
-    -- only generate doors at the *ends* of hallways, eg (where O is walkable,
-    -- X is a wall, and D is a door):
-    --
-    -- O O O
-    -- X D X
-    --   O
-    teeish (fmap not -> (Neighbors tl t tr l r _ b _ )) =
-      and [tl, t, tr, b] && (and . fmap not) [l, r]
-
-randomCreatures
-  :: MonadRandom m
-  => Word -- ^ Level number, starting at 0
-  -> Cells
-  -> m (EntityMap Creature)
-randomCreatures levelNumber
-  = randomEntities maybeNewCreature (0.0007, 0.002)
-  where
-    maybeNewCreature cType
-      | maybe True (canGenerate levelNumber) $ cType ^. generateParams
-      = Just <$> newCreatureWithType cType
-      | otherwise
-      = pure Nothing
-
-newCreatureWithType :: MonadRandom m => CreatureType -> m Creature
-newCreatureWithType _creatureType = do
-  let _hitpoints = _creatureType ^. maxHitpoints
-      _hippocampus = initialHippocampus
-
-  equipped <- fmap join
-            . traverse genEquipped
-            $ _creatureType
-            ^.. generateParams . _Just . equippedItem . _Just
-  let _inventory = maybe id (\ei -> wielded .~ inRightHand ei) (headMay equipped) mempty
-  pure Creature.Creature {..}
-  where
-    genEquipped cei = do
-      doGen <- Random.chance $ cei ^. chance
-      let entName = cei ^. entityName
-          itemType =
-            fromMaybe (error $ "raw \"" <> unpack entName <> "\" not of type Item")
-            . preview _Item
-            . fromMaybe (error $ "Could not find raw: " <> unpack entName)
-            $ raw entName
-      item <- Item.newWithType itemType
-      if doGen
-        then pure [fromMaybe (error $ "raw \"" <> unpack entName <> "\" not wieldable")
-                  $ preview asWieldedItem item]
-        else pure []
-
-
-tutorialMessage :: MonadRandom m
-  => Cells
-  -> Position -- ^ CharacterPosition
-  -> m (EntityMap GroundMessage)
-tutorialMessage cells characterPosition = do
-  let distance = 2
-  pos <- fmap (fromMaybe (error "No valid positions for tutorial message?"))
-        . choose . ChooseElement
-        $ accessiblePositionsWithin distance cells characterPosition
-  msg <- message_ ["tutorial", "message1"]
-  pure $ _EntityMap # [(pos, GroundMessage msg)]
-  where
-    accessiblePositionsWithin :: Int -> Cells -> Position -> [Position]
-    accessiblePositionsWithin dist valid pos =
-      review _Position
-      <$> filter
-            (\pt -> not $ valid ! (fromIntegral <$> pt))
-            (circle (pos ^. _Position) dist)
-
-randomEntities
-  :: forall entity raw m t. (MonadRandom m, RawType raw, Functor t, Foldable t)
-  => (raw -> m (t entity))
-  -> (Float, Float)
-  -> Cells
-  -> m (EntityMap entity)
-randomEntities newWithType sizeRange cells =
-  case fromNullable $ rawsWithType @raw of
-    Nothing -> pure mempty
-    Just raws -> do
-      let len = rangeSize $ bounds cells
-      (numEntities :: Int) <-
-        floor . (* fromIntegral len) <$> getRandomR sizeRange
-      entities <- for [0..numEntities] $ const $ do
-        pos <- randomPosition cells
-        r <- choose raws
-        entities <- newWithType r
-        pure $ (pos, ) <$> entities
-      pure $ _EntityMap # (entities >>= toList)
-
-randomPosition :: MonadRandom m => Cells -> m Position
-randomPosition = fmap positionFromV2 . choose . impureNonNull . cellCandidates
-
--- cellCandidates :: Cells -> Cells
-cellCandidates :: Cells -> Set (V2 Word)
-cellCandidates
-  -- find the largest contiguous region of cells in the cave.
-  = maximumBy (compare `on` length)
-  . fromMaybe (error "No regions generated! this should never happen.")
-  . fromNullable
-  . regions
-  -- cells ends up with true = wall, we want true = can put an item here
-  . amap not
-
-entityFromRaw :: MonadRandom m => EntityRaw -> m SomeEntity
-entityFromRaw (Creature ct) = SomeEntity <$> newCreatureWithType ct
-entityFromRaw (Item it) = SomeEntity <$> Item.newWithType it
diff --git a/users/grfn/xanthous/src/Xanthous/Generators/Level/Util.hs b/users/grfn/xanthous/src/Xanthous/Generators/Level/Util.hs
deleted file mode 100644
index 0008eb965c42..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Generators/Level/Util.hs
+++ /dev/null
@@ -1,236 +0,0 @@
-{-# LANGUAGE QuantifiedConstraints #-}
-{-# LANGUAGE AllowAmbiguousTypes #-}
---------------------------------------------------------------------------------
-module Xanthous.Generators.Level.Util
-  ( MCells
-  , Cells
-  , CellM
-  , randInitialize
-  , initializeEmpty
-  , numAliveNeighborsM
-  , numAliveNeighbors
-  , fillOuterEdgesM
-  , cloneMArray
-  , floodFill
-  , regions
-  , fillAll
-  , fillAllM
-  , fromPoints
-  , fromPointsM
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding (Foldable, toList, for_)
---------------------------------------------------------------------------------
-import           Data.Array.ST
-import           Data.Array.Unboxed
-import           Control.Monad.ST
-import           Control.Monad.Random
-import           Data.Monoid
-import           Data.Foldable (Foldable, toList, for_)
-import qualified Data.Set as Set
-import           Data.Semigroup.Foldable
-import           Linear.V2
---------------------------------------------------------------------------------
-import           Xanthous.Util (foldlMapM', maximum1, minimum1)
-import           Xanthous.Data (Dimensions, width, height)
---------------------------------------------------------------------------------
-
-type MCells s = STUArray s (V2 Word) Bool
-type Cells = UArray (V2 Word) Bool
-type CellM g s a = RandT g (ST s) a
-
-randInitialize :: RandomGen g => Dimensions -> Double -> CellM g s (MCells s)
-randInitialize dims aliveChance = do
-  res <- initializeEmpty dims
-  for_ [0..dims ^. width] $ \i ->
-    for_ [0..dims ^. height] $ \j -> do
-      val <- (>= aliveChance) <$> getRandomR (0, 1)
-      lift $ writeArray res (V2 i j) val
-  pure res
-
-initializeEmpty :: RandomGen g => Dimensions -> CellM g s (MCells s)
-initializeEmpty dims =
-  lift $ newArray (0, V2 (dims ^. width) (dims ^. height)) False
-
--- | Returns the number of neighbors of the given point in the given array that
--- are True.
---
--- Behavior if point is out-of-bounds for the array is undefined, but will not
--- error
-numAliveNeighborsM
-  :: forall a i m
-  . (MArray a Bool m, Ix i, Integral i)
-  => a (V2 i) Bool
-  -> V2 i
-  -> m Word
-numAliveNeighborsM cells pt@(V2 x y) = do
-  cellBounds <- getBounds cells
-  getSum <$> foldlMapM'
-    (fmap (Sum . fromIntegral . fromEnum) . boundedGet cellBounds)
-    neighborPositions
-
-  where
-    boundedGet :: (V2 i, V2 i) -> (Int, Int) -> m Bool
-    boundedGet bnds _
-      | not (inRange bnds pt)
-      = pure True
-    boundedGet (V2 minX minY, V2 maxX maxY) (i, j)
-      | (x <= minX && i < 0)
-      || (y <= minY && j < 0)
-      || (x >= maxX && i > 0)
-      || (y >= maxY && j > 0)
-      = pure True
-      | otherwise =
-        let nx = fromIntegral $ fromIntegral x + i
-            ny = fromIntegral $ fromIntegral y + j
-        in readArray cells $ V2 nx ny
-
--- | Returns the number of neighbors of the given point in the given array that
--- are True.
---
--- Behavior if point is out-of-bounds for the array is undefined, but will not
--- error
-numAliveNeighbors
-  :: forall a i
-  . (IArray a Bool, Ix i, Integral i)
-  => a (V2 i) Bool
-  -> V2 i
-  -> Word
-numAliveNeighbors cells pt@(V2 x y) =
-  let cellBounds = bounds cells
-  in getSum $ foldMap
-      (Sum . fromIntegral . fromEnum . boundedGet cellBounds)
-      neighborPositions
-
-  where
-    boundedGet :: (V2 i, V2 i) -> (Int, Int) -> Bool
-    boundedGet bnds _
-      | not (inRange bnds pt)
-      = True
-    boundedGet (V2 minX minY, V2 maxX maxY) (i, j)
-      | (x <= minX && i < 0)
-      || (y <= minY && j < 0)
-      || (x >= maxX && i > 0)
-      || (y >= maxY && j > 0)
-      = True
-      | otherwise =
-        let nx = fromIntegral $ fromIntegral x + i
-            ny = fromIntegral $ fromIntegral y + j
-        in cells ! V2 nx ny
-
-neighborPositions :: [(Int, Int)]
-neighborPositions = [(i, j) | i <- [-1..1], j <- [-1..1], (i, j) /= (0, 0)]
-
-fillOuterEdgesM :: (MArray a Bool m, Ix i) => a (V2 i) Bool -> m ()
-fillOuterEdgesM arr = do
-  (V2 minX minY, V2 maxX maxY) <- getBounds arr
-  for_ (range (minX, maxX)) $ \x -> do
-    writeArray arr (V2 x minY) True
-    writeArray arr (V2 x maxY) True
-  for_ (range (minY, maxY)) $ \y -> do
-    writeArray arr (V2 minX y) True
-    writeArray arr (V2 maxX y) True
-
-cloneMArray
-  :: forall a a' i e m.
-  ( Ix i
-  , MArray a e m
-  , MArray a' e m
-  , IArray UArray e
-  )
-  => a i e
-  -> m (a' i e)
-cloneMArray = thaw @_ @UArray <=< freeze
-
---------------------------------------------------------------------------------
-
--- | Flood fill a cell array starting at a point, returning a list of all the
--- (true) cell locations reachable from that point
-floodFill :: forall a i.
-            ( IArray a Bool
-            , Ix i
-            , Enum i
-            , Bounded i
-            , Eq i
-            )
-          => a (V2 i) Bool -- ^ array
-          -> (V2 i)        -- ^ position
-          -> Set (V2 i)
-floodFill = go mempty
-  where
-    go :: Set (V2 i) -> a (V2 i) Bool -> (V2 i) -> Set (V2 i)
-    go res arr@(bounds -> arrBounds) idx@(V2 x y)
-      | not (inRange arrBounds idx) =  res
-      | not (arr ! idx) =  res
-      | otherwise =
-        let neighbors
-              = filter (inRange arrBounds)
-              . filter (/= idx)
-              . filter (`notMember` res)
-              $ V2
-              <$> [(if x == minBound then x else pred x)
-                   ..
-                   (if x == maxBound then x else succ x)]
-              <*> [(if y == minBound then y else pred y)
-                   ..
-                   (if y == maxBound then y else succ y)]
-        in foldl' (\r idx' ->
-                     if arr ! idx'
-                     then r <> (let r' = r & contains idx' .~ True
-                               in r' `seq` go r' arr idx')
-                     else r)
-           (res & contains idx .~ True) neighbors
-{-# SPECIALIZE floodFill :: UArray (V2 Word) Bool -> (V2 Word) -> Set (V2 Word) #-}
-
--- | Gives a list of all the disconnected regions in a cell array, represented
--- each as lists of points
-regions :: forall a i.
-          ( IArray a Bool
-          , Ix i
-          , Enum i
-          , Bounded i
-          , Eq i
-          )
-        => a (V2 i) Bool
-        -> [Set (V2 i)]
-regions arr
-  | Just firstPoint <- findFirstPoint arr =
-      let region = floodFill arr firstPoint
-          arr' = fillAll region arr
-      in region : regions arr'
-  | otherwise = []
-  where
-    findFirstPoint :: a (V2 i) Bool -> Maybe (V2 i)
-    findFirstPoint = fmap fst . headMay . filter snd . assocs
-{-# SPECIALIZE regions :: UArray (V2 Word) Bool -> [Set (V2 Word)] #-}
-
-fillAll :: (IArray a Bool, Ix i, Foldable f) => f i -> a i Bool -> a i Bool
-fillAll ixes a = accum (const fst) a $ (, (False, ())) <$> toList ixes
-
-fillAllM :: (MArray a Bool m, Ix i, Foldable f) => f i -> a i Bool -> m ()
-fillAllM ixes a = for_ ixes $ \i -> writeArray a i False
-
-fromPoints
-  :: forall a f i.
-    ( IArray a Bool
-    , Ix i
-    , Functor f
-    , Foldable1 f
-    )
-  => f (i, i)
-  -> a (i, i) Bool
-fromPoints points =
-  let pts = Set.fromList $ toList points
-      dims = ( (minimum1 $ fst <$> points, minimum1 $ snd <$> points)
-             , (maximum1 $ fst <$> points, maximum1 $ snd <$> points)
-             )
-  in array dims $ range dims <&> \i -> (i, i `member` pts)
-
-fromPointsM
-  :: (MArray a Bool m, Ix i, Element f ~ i, MonoFoldable f)
-  => NonNull f
-  -> m (a i Bool)
-fromPointsM points = do
-  arr <- newArray (minimum points, maximum points) False
-  fillAllM (otoList points) arr
-  pure arr
diff --git a/users/grfn/xanthous/src/Xanthous/Generators/Level/Village.hs b/users/grfn/xanthous/src/Xanthous/Generators/Level/Village.hs
deleted file mode 100644
index ab7de95e6806..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Generators/Level/Village.hs
+++ /dev/null
@@ -1,126 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Generators.Level.Village
-  ( fromCave
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding (any, failing, toList)
---------------------------------------------------------------------------------
-import           Control.Monad.Random (MonadRandom)
-import           Control.Monad.State (execStateT, MonadState, modify)
-import           Control.Monad.Trans.Maybe
-import           Control.Parallel.Strategies
-import           Data.Array.IArray
-import           Data.Foldable (any, toList)
---------------------------------------------------------------------------------
-import           Xanthous.Data
-import           Xanthous.Data.EntityMap (EntityMap)
-import qualified Xanthous.Data.EntityMap as EntityMap
-import           Xanthous.Entities.Environment
-import           Xanthous.Generators.Level.Util
-import           Xanthous.Game.State (SomeEntity(..))
-import           Xanthous.Random
---------------------------------------------------------------------------------
-
-fromCave :: MonadRandom m
-         => Cells -- ^ The positions of all the walls
-         -> m (EntityMap SomeEntity)
-fromCave wallPositions = execStateT (fromCave' wallPositions) mempty
-
-fromCave' :: forall m. (MonadRandom m, MonadState (EntityMap SomeEntity) m)
-          => Cells
-          -> m ()
-fromCave' wallPositions = failing (pure ()) $ do
-  Just villageRegion <-
-    choose
-    . (`using` parTraversable rdeepseq)
-    . weightedBy (\reg -> let circSize = length $ circumference reg
-                         in if circSize == 50
-                            then (1.0 :: Double)
-                            else 1.0 / (fromIntegral . abs $ circSize - 50))
-    $ regions closedHallways
-
-  let circ = setFromList . circumference $ villageRegion
-
-  centerPoints <- chooseSubset (0.1 :: Double) $ toList circ
-
-  roomTiles <- foldM
-              (flip $ const $ stepOut circ)
-              (map pure centerPoints)
-              [0 :: Int ..2]
-
-  let roomWalls = circumference . setFromList @(Set _) <$> roomTiles
-      allWalls = join roomWalls
-
-  doorPositions <- fmap join . for roomWalls $ \room ->
-    let candidates = filter (`notMember` circ) room
-    in fmap toList . choose $ ChooseElement candidates
-
-  let entryways =
-        filter (\pt ->
-                  let ncs = neighborCells pt
-                  in any ((&&) <$> (not . (wallPositions !))
-                              <*> (`notMember` villageRegion)) ncs
-                   && any ((&&) <$> (`member` villageRegion)
-                              <*> (`notElem` allWalls)) ncs)
-                  $ toList villageRegion
-
-  Just entryway <- choose $ ChooseElement entryways
-
-  for_ (filter ((&&) <$> (`notElem` doorPositions) <*> (/= entryway)) allWalls)
-    $ insertEntity Wall
-  for_ (filter (/= entryway) doorPositions) $ insertEntity unlockedDoor
-  insertEntity unlockedDoor entryway
-
-
-  where
-    insertEntity e pt = modify $ EntityMap.insertAt (ptToPos pt) $ SomeEntity e
-    ptToPos pt = _Position # (fromIntegral <$> pt)
-
-    stepOut :: Set (V2 Word) -> [[V2 Word]] -> MaybeT m [[V2 Word]]
-    stepOut circ rooms = for rooms $ \room ->
-      let nextLevels = hashNub $ toList . neighborCells =<< room
-      in pure
-         . (<> room)
-         $ filter ((&&) <$> (`notMember` circ) <*> (`notElem` join rooms))
-         nextLevels
-
-    circumference pts =
-      filter (any (`notMember` pts) . neighborCells) $ toList pts
-    closedHallways = closeHallways livePositions
-    livePositions = amap not wallPositions
-
---------------------------------------------------------------------------------
-
-closeHallways :: Cells -> Cells
-closeHallways livePositions =
-  livePositions // mapMaybe closeHallway (assocs livePositions)
-  where
-    closeHallway (_, False) = Nothing
-    closeHallway (pos, _)
-      | isHallway pos = Just (pos, False)
-      | otherwise     = Nothing
-    isHallway pos = any ((&&) <$> not . view left <*> not . view right)
-      . rotations
-      . fmap (fromMaybe False)
-      $ arrayNeighbors livePositions pos
-
-failing :: Monad m => m a -> MaybeT m a -> m a
-failing result = (maybe result pure =<<) . runMaybeT
-
-{-
-
-import Xanthous.Generators.Village
-import Xanthous.Generators
-import Xanthous.Data
-import System.Random
-import qualified Data.Text
-import qualified Xanthous.Generators.CaveAutomata as CA
-let gi = GeneratorInput SCaveAutomata CA.defaultParams
-wallPositions <- generateFromInput gi (Dimensions 80 50) <$> getStdGen
-putStrLn . Data.Text.unpack $ showCells wallPositions
-
-import Data.Array.IArray
-let closedHallways = closeHallways . amap not $ wallPositions
-putStrLn . Data.Text.unpack . showCells $ amap not closedHallways
-
--}
diff --git a/users/grfn/xanthous/src/Xanthous/Generators/Speech.hs b/users/grfn/xanthous/src/Xanthous/Generators/Speech.hs
deleted file mode 100644
index 8abc00b6a2fc..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Generators/Speech.hs
+++ /dev/null
@@ -1,181 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE OverloadedLists #-}
---------------------------------------------------------------------------------
-module Xanthous.Generators.Speech
-  ( -- * Language definition
-    Language(..)
-    -- ** Lenses
-  , phonotactics
-  , syllablesPerWord
-
-    -- ** Phonotactics
-  , Phonotactics(..)
-    -- *** Lenses
-  , onsets
-  , nuclei
-  , codas
-  , numOnsets
-  , numNuclei
-  , numCodas
-
-    -- * Language generation
-  , syllable
-  , word
-
-    -- * Languages
-  , english
-  , gormlak
-
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding (replicateM)
-import           Data.Interval (Interval, (<=..<=))
-import qualified Data.Interval as Interval
-import           Control.Monad.Random.Class (MonadRandom)
-import           Xanthous.Random (chooseRange, choose, ChooseElement (..), Weighted (Weighted))
-import           Control.Monad (replicateM)
-import           Test.QuickCheck (Arbitrary, CoArbitrary, Function)
-import           Test.QuickCheck.Instances.Text ()
-import           Data.List.NonEmpty (NonEmpty)
---------------------------------------------------------------------------------
-
-newtype Phoneme = Phoneme Text
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving newtype (IsString, Semigroup, Monoid, Arbitrary)
-
--- | The phonotactics of a language
---
--- The phonotactics of a language represent the restriction on the phonemes in
--- the syllables of a language.
---
--- Syllables in a language consist of an onset, a nucleus, and a coda (the
--- nucleus and the coda together representing the "rhyme" of the syllable).
-data Phonotactics = Phonotactics
-  { _onsets    :: [Phoneme] -- ^ The permissible onsets, or consonant clusters
-                           --   at the beginning of a syllable
-  , _nuclei    :: [Phoneme] -- ^ The permissible nuclei, or vowel clusters in
-                           --   the middle of a syllable
-  , _codas     :: [Phoneme] -- ^ The permissible codas, or consonant clusters at
-                           --   the end of a syllable
-  , _numOnsets :: Interval Word -- ^ The range of number of allowable onsets
-  , _numNuclei :: Interval Word -- ^ The range of number of allowable nuclei
-  , _numCodas  :: Interval Word -- ^ The range of number of allowable codas
-  }
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData)
-makeLenses ''Phonotactics
-
--- | Randomly generate a syllable with the given 'Phonotactics'
-syllable :: MonadRandom m => Phonotactics -> m Text
-syllable phonotactics = do
-  let genPart num choices = do
-        n <- fromIntegral . fromMaybe 0 <$> chooseRange (phonotactics ^. num)
-        fmap (fromMaybe mempty . mconcat)
-          . replicateM n
-          . choose . ChooseElement
-          $ phonotactics ^. choices
-
-  (Phoneme onset) <- genPart numOnsets onsets
-  (Phoneme nucleus) <- genPart numNuclei nuclei
-  (Phoneme coda) <- genPart numCodas codas
-
-  pure $ onset <> nucleus <> coda
-
--- | A definition for a language
---
--- Currently this provides enough information to generate multi-syllabic words,
--- but in the future will likely also include grammar-related things.
-data Language = Language
-  { _phonotactics :: Phonotactics
-  , _syllablesPerWord :: Weighted Int NonEmpty Int
-  }
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData)
-makeLenses ''Language
-
-word :: MonadRandom m => Language -> m Text
-word lang = do
-  numSyllables <- choose $ lang ^. syllablesPerWord
-  mconcat <$> replicateM numSyllables (syllable $ lang ^. phonotactics)
-
---------------------------------------------------------------------------------
-
--- <https://en.wikipedia.org/wiki/English_phonology#Phonotactics>
-englishPhonotactics :: Phonotactics
-englishPhonotactics = Phonotactics
-  { _onsets = [ "pl" , "bl" , "kl" , "gl" , "pr" , "br" , "tr" , "dr" , "kr"
-              , "gr" , "tw" , "dw" , "gw" , "kw" , "pw"
-
-              , "fl" , "sl" , {- "thl", -} "shl" {- , "vl" -}
-              , "p", "b", "t", "d", "k", "ɡ", "m", "n", "f", "v", "th", "s"
-              , "z", "h", "l", "w"
-
-              , "sp", "st", "sk"
-
-              , "sm", "sn"
-
-              , "sf", "sth"
-
-              , "spl", "skl", "spr", "str", "skr", "skw", "sm", "sp", "st", "sk"
-              ]
-  , _nuclei = [ "a", "e", "i", "o", "u", "ur", "ar", "or", "ear", "are", "ure"
-              , "oa", "ee", "oo", "ei", "ie", "oi", "ou"
-              ]
-  , _codas = [ "m", "n", "ng", "p", "t", "tsh", "k", "f", "sh", "s", "th", "x"
-             , "v", "z", "zh", "l", "r", "w"
-
-             , "lk", "lb", "lt", "ld", "ltsh", "ldsh", "lk"
-             , "rp", "rb", "rt", "rd", "rtsh", "rdsh", "rk", "rɡ"
-             , "lf", "lv", "lth", "ls", "lz", "lsh", "lth"
-             , "rf", "rv", "rth", "rs", "rz", "rth"
-             , "lm", "ln"
-             , "rm", "rn", "rl"
-             , "mp", "nt", "nd", "nth", "nsh", "nk"
-             , "mf", "ms", "mth", "nf", "nth", "ns", "nz", "nth"
-             , "ft", "sp", "st", "sk"
-             , "fth"
-             , "pt", "kt"
-             , "pth", "ps", "th", "ts", "dth", "dz", "ks"
-             , "lpt", "lps", "lfth", "lts", "lst", "lkt", "lks"
-             , "rmth", "rpt", "rps", "rts", "rst", "rkt"
-             , "mpt", "mps", "ndth", "nkt", "nks", "nkth"
-             , "ksth", "kst"
-             ]
-  , _numOnsets = 0 <=..<= 1
-  , _numNuclei = Interval.singleton 1
-  , _numCodas  = 0 <=..<= 1
-  }
-
-english :: Language
-english = Language
-  { _phonotactics = englishPhonotactics
-  , _syllablesPerWord = Weighted [(20, 1),
-                                  (7,  2),
-                                  (2,  3),
-                                  (1,  4)]
-  }
-
-gormlakPhonotactics :: Phonotactics
-gormlakPhonotactics = Phonotactics
- { _onsets = [ "h", "l", "g", "b", "m", "n", "ng"
-             , "gl", "bl", "fl"
-             ]
- , _numOnsets = Interval.singleton 1
- , _nuclei = [ "a", "o", "aa", "u" ]
- , _numNuclei = Interval.singleton 1
- , _codas = [ "r", "l", "g", "m", "n"
-            , "rl", "gl", "ml", "rm"
-            , "n", "k"
-            ]
- , _numCodas = Interval.singleton 1
- }
-
-gormlak :: Language
-gormlak = Language
-  { _phonotactics = gormlakPhonotactics
-  , _syllablesPerWord = Weighted [ (5, 2)
-                                 , (5, 1)
-                                 , (1, 3)
-                                 ]
-  }