refactor(xanthous): Generators -> Generators.Level
I'm going to start adding generators for things like text soon, so it makes sense to specifically sequester level generators as their own thing Change-Id: I175025375204fab7d75eba67dd06dab9bd2939d3 Reviewed-on: https://cl.tvl.fyi/c/depot/+/3201 Reviewed-by: grfn <grfn@gws.fyi> Tested-by: BuildkiteCI
This commit is contained in:
parent
6f238c1c90
commit
006e5231e5
11 changed files with 40 additions and 39 deletions
|
@ -13,15 +13,15 @@ import System.Exit (die)
|
|||
import qualified Xanthous.Game as Game
|
||||
import Xanthous.Game.Env (GameEnv(..))
|
||||
import Xanthous.App
|
||||
import Xanthous.Generators
|
||||
import Xanthous.Generators.Level
|
||||
( GeneratorInput
|
||||
, parseGeneratorInput
|
||||
, generateFromInput
|
||||
, showCells
|
||||
)
|
||||
import qualified Xanthous.Entities.Character as Character
|
||||
import Xanthous.Generators.Util (regions)
|
||||
import Xanthous.Generators.LevelContents
|
||||
import Xanthous.Generators.Level.Util (regions)
|
||||
import Xanthous.Generators.Level.LevelContents
|
||||
import Xanthous.Data (Dimensions, Dimensions'(Dimensions))
|
||||
import Data.Array.IArray ( amap )
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
|
@ -60,9 +60,9 @@ import Xanthous.Entities.RawTypes
|
|||
( edible, eatMessage, hitpointsHealed
|
||||
, attackMessage
|
||||
)
|
||||
import Xanthous.Generators
|
||||
import qualified Xanthous.Generators.CaveAutomata as CaveAutomata
|
||||
import qualified Xanthous.Generators.Dungeon as Dungeon
|
||||
import Xanthous.Generators.Level
|
||||
import qualified Xanthous.Generators.Level.CaveAutomata as CaveAutomata
|
||||
import qualified Xanthous.Generators.Level.Dungeon as Dungeon
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
type App = Brick.App GameState AppEvent ResourceName
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module Xanthous.Generators
|
||||
module Xanthous.Generators.Level
|
||||
( generate
|
||||
, Generator(..)
|
||||
, SGenerator(..)
|
||||
|
@ -27,11 +27,11 @@ import Data.Array.Unboxed
|
|||
import qualified Options.Applicative as Opt
|
||||
import Control.Monad.Random
|
||||
--------------------------------------------------------------------------------
|
||||
import qualified Xanthous.Generators.CaveAutomata as CaveAutomata
|
||||
import qualified Xanthous.Generators.Dungeon as Dungeon
|
||||
import Xanthous.Generators.Util
|
||||
import Xanthous.Generators.LevelContents
|
||||
import Xanthous.Generators.Village as Village
|
||||
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
|
|
@ -2,7 +2,7 @@
|
|||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module Xanthous.Generators.CaveAutomata
|
||||
module Xanthous.Generators.Level.CaveAutomata
|
||||
( Params(..)
|
||||
, defaultParams
|
||||
, parseParams
|
||||
|
@ -18,7 +18,7 @@ import qualified Options.Applicative as Opt
|
|||
import Xanthous.Util (between)
|
||||
import Xanthous.Util.Optparse
|
||||
import Xanthous.Data (Dimensions, width, height)
|
||||
import Xanthous.Generators.Util
|
||||
import Xanthous.Generators.Level.Util
|
||||
import Linear.V2
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
{-# LANGUAGE TemplateHaskell #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module Xanthous.Generators.Dungeon
|
||||
module Xanthous.Generators.Level.Dungeon
|
||||
( Params(..)
|
||||
, defaultParams
|
||||
, parseParams
|
||||
|
@ -24,7 +24,7 @@ import qualified Options.Applicative as Opt
|
|||
--------------------------------------------------------------------------------
|
||||
import Xanthous.Random
|
||||
import Xanthous.Data hiding (x, y, _x, _y, edges)
|
||||
import Xanthous.Generators.Util
|
||||
import Xanthous.Generators.Level.Util
|
||||
import Xanthous.Util.Graphics (delaunay, straightLine)
|
||||
import Xanthous.Util.Graph (mstSubGraph)
|
||||
--------------------------------------------------------------------------------
|
|
@ -1,5 +1,5 @@
|
|||
--------------------------------------------------------------------------------
|
||||
module Xanthous.Generators.LevelContents
|
||||
module Xanthous.Generators.Level.LevelContents
|
||||
( chooseCharacterPosition
|
||||
, randomItems
|
||||
, randomCreatures
|
||||
|
@ -16,7 +16,7 @@ import qualified Data.Array.IArray as Arr
|
|||
import Data.Foldable (any, toList)
|
||||
import Linear.V2
|
||||
--------------------------------------------------------------------------------
|
||||
import Xanthous.Generators.Util
|
||||
import Xanthous.Generators.Level.Util
|
||||
import Xanthous.Random
|
||||
import Xanthous.Data
|
||||
( positionFromV2, Position, _Position
|
|
@ -1,7 +1,7 @@
|
|||
{-# LANGUAGE QuantifiedConstraints #-}
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module Xanthous.Generators.Util
|
||||
module Xanthous.Generators.Level.Util
|
||||
( MCells
|
||||
, Cells
|
||||
, CellM
|
|
@ -1,4 +1,5 @@
|
|||
module Xanthous.Generators.Village
|
||||
--------------------------------------------------------------------------------
|
||||
module Xanthous.Generators.Level.Village
|
||||
( fromCave
|
||||
) where
|
||||
--------------------------------------------------------------------------------
|
||||
|
@ -15,7 +16,7 @@ import Xanthous.Data
|
|||
import Xanthous.Data.EntityMap (EntityMap)
|
||||
import qualified Xanthous.Data.EntityMap as EntityMap
|
||||
import Xanthous.Entities.Environment
|
||||
import Xanthous.Generators.Util
|
||||
import Xanthous.Generators.Level.Util
|
||||
import Xanthous.Game.State (SomeEntity(..))
|
||||
import Xanthous.Random
|
||||
--------------------------------------------------------------------------------
|
|
@ -11,7 +11,7 @@ import qualified Xanthous.Data.NestedMapSpec
|
|||
import qualified Xanthous.DataSpec
|
||||
import qualified Xanthous.Entities.RawsSpec
|
||||
import qualified Xanthous.GameSpec
|
||||
import qualified Xanthous.Generators.UtilSpec
|
||||
import qualified Xanthous.Generators.Level.UtilSpec
|
||||
import qualified Xanthous.MessageSpec
|
||||
import qualified Xanthous.Messages.TemplateSpec
|
||||
import qualified Xanthous.OrphansSpec
|
||||
|
@ -36,7 +36,7 @@ test = testGroup "Xanthous"
|
|||
, Xanthous.DataSpec.test
|
||||
, Xanthous.Entities.RawsSpec.test
|
||||
, Xanthous.GameSpec.test
|
||||
, Xanthous.Generators.UtilSpec.test
|
||||
, Xanthous.Generators.Level.UtilSpec.test
|
||||
, Xanthous.MessageSpec.test
|
||||
, Xanthous.Messages.TemplateSpec.test
|
||||
, Xanthous.OrphansSpec.test
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
{-# LANGUAGE PackageImports #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module Xanthous.Generators.UtilSpec (main, test) where
|
||||
module Xanthous.Generators.Level.UtilSpec (main, test) where
|
||||
--------------------------------------------------------------------------------
|
||||
import Test.Prelude
|
||||
import System.Random (mkStdGen)
|
||||
|
@ -15,7 +15,7 @@ import Linear.V2
|
|||
--------------------------------------------------------------------------------
|
||||
import Xanthous.Util
|
||||
import Xanthous.Data (width, height)
|
||||
import Xanthous.Generators.Util
|
||||
import Xanthous.Generators.Level.Util
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
main :: IO ()
|
|
@ -4,7 +4,7 @@ cabal-version: 1.12
|
|||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: f642cb264ff0785d5883884fa8db14adb92ce3d897cfc22e69555089dbc8dfd2
|
||||
-- hash: bba18b2b297d73ddcb0a2c365e597a183e6b612ad336e97ca06d9ce87b989656
|
||||
|
||||
name: xanthous
|
||||
version: 0.1.0.0
|
||||
|
@ -65,12 +65,12 @@ library
|
|||
Xanthous.Game.Memo
|
||||
Xanthous.Game.Prompt
|
||||
Xanthous.Game.State
|
||||
Xanthous.Generators
|
||||
Xanthous.Generators.CaveAutomata
|
||||
Xanthous.Generators.Dungeon
|
||||
Xanthous.Generators.LevelContents
|
||||
Xanthous.Generators.Util
|
||||
Xanthous.Generators.Village
|
||||
Xanthous.Generators.Level
|
||||
Xanthous.Generators.Level.CaveAutomata
|
||||
Xanthous.Generators.Level.Dungeon
|
||||
Xanthous.Generators.Level.LevelContents
|
||||
Xanthous.Generators.Level.Util
|
||||
Xanthous.Generators.Level.Village
|
||||
Xanthous.Messages
|
||||
Xanthous.Messages.Template
|
||||
Xanthous.Monad
|
||||
|
@ -221,12 +221,12 @@ executable xanthous
|
|||
Xanthous.Game.Memo
|
||||
Xanthous.Game.Prompt
|
||||
Xanthous.Game.State
|
||||
Xanthous.Generators
|
||||
Xanthous.Generators.CaveAutomata
|
||||
Xanthous.Generators.Dungeon
|
||||
Xanthous.Generators.LevelContents
|
||||
Xanthous.Generators.Util
|
||||
Xanthous.Generators.Village
|
||||
Xanthous.Generators.Level
|
||||
Xanthous.Generators.Level.CaveAutomata
|
||||
Xanthous.Generators.Level.Dungeon
|
||||
Xanthous.Generators.Level.LevelContents
|
||||
Xanthous.Generators.Level.Util
|
||||
Xanthous.Generators.Level.Village
|
||||
Xanthous.Messages
|
||||
Xanthous.Messages.Template
|
||||
Xanthous.Monad
|
||||
|
@ -353,7 +353,7 @@ test-suite test
|
|||
Xanthous.DataSpec
|
||||
Xanthous.Entities.RawsSpec
|
||||
Xanthous.GameSpec
|
||||
Xanthous.Generators.UtilSpec
|
||||
Xanthous.Generators.Level.UtilSpec
|
||||
Xanthous.Messages.TemplateSpec
|
||||
Xanthous.MessageSpec
|
||||
Xanthous.OrphansSpec
|
||||
|
|
Loading…
Reference in a new issue