9ebdc6fbb4
Add support for converting generated levels to walls, and merge one into the entity map at the beginning of the game. There's nothing here that guarantees the character ends up *inside* the level though (they almost always don't) so that'll have to be slotted into the level generation process.
62 lines
1.5 KiB
Haskell
62 lines
1.5 KiB
Haskell
module Xanthous.Monad
|
|
( AppT(..)
|
|
, runAppT
|
|
, continue
|
|
, halt
|
|
, say
|
|
, say_
|
|
) where
|
|
|
|
import Xanthous.Prelude
|
|
import Control.Monad.Random
|
|
import Control.Monad.State
|
|
import qualified Brick
|
|
import Brick (EventM, Next)
|
|
import Data.Aeson
|
|
|
|
import Xanthous.Game
|
|
import Xanthous.Messages (message)
|
|
|
|
newtype AppT m a
|
|
= AppT { unAppT :: StateT GameState m a }
|
|
deriving ( Functor
|
|
, Applicative
|
|
, Monad
|
|
, MonadState GameState
|
|
)
|
|
via (StateT GameState m)
|
|
|
|
instance MonadTrans AppT where
|
|
lift = AppT . lift
|
|
|
|
instance (Monad m) => MonadRandom (AppT m) where
|
|
getRandomR rng = randomGen %%= randomR rng
|
|
getRandom = randomGen %%= random
|
|
getRandomRs rng = uses randomGen $ randomRs rng
|
|
getRandoms = uses randomGen randoms
|
|
|
|
runAppT :: Monad m => AppT m a -> GameState -> m (a, GameState)
|
|
runAppT appt initialState = flip runStateT initialState . unAppT $ appt
|
|
|
|
halt :: AppT (EventM n) (Next GameState)
|
|
halt = lift . Brick.halt =<< get
|
|
|
|
continue :: AppT (EventM n) (Next GameState)
|
|
continue = lift . Brick.continue =<< get
|
|
|
|
-- say :: [Text] -> AppT m ()
|
|
-- say :: [Text] -> params -> AppT m ()
|
|
|
|
class SayR a where
|
|
say :: [Text] -> a
|
|
|
|
instance Monad m => SayR (AppT m ()) where
|
|
say msgPath = say msgPath $ object []
|
|
|
|
instance (Monad m, ToJSON params) => SayR (params -> AppT m ()) where
|
|
say msgPath params = do
|
|
msg <- message msgPath params
|
|
messageHistory %= pushMessage msg
|
|
|
|
say_ :: Monad m => [Text] -> AppT m ()
|
|
say_ = say
|