| Copyright | (c) Anton Gushcha, 2016 |
|---|---|
| License | BSD3 |
| Maintainer | ncrashed@gmail.com |
| Stability | experimental |
| Portability | POSIX |
| Safe Haskell | None |
| Language | Haskell2010 |
Game.GoreAndAsh.LambdaCube
Contents
Description
The core module contains API for something into main game loop for Gore&Ash.
The module does not depend on any other core modules, so LambdaCubeT could be placed at any place in monad stack.
The module is not pure within first phase (see ModuleStack docs), therefore only IO can be used as end monad.
Example of embedding:
-- | Application monad is monad stack build from given list of modules over base monad (IO)
type AppStack = ModuleStack [LambdaCubeT ... other modules ... ] IO
newtype AppState = AppState (ModuleState AppStack)
deriving (Generic)
instance NFData AppState
-- | Wrapper around type family
newtype AppMonad a = AppMonad (AppStack a)
deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadThrow, MonadCatch, MonadLambdaCube ... other modules monads ... )
instance GameModule AppMonad AppState where
type ModuleState AppMonad = AppState
runModule (AppMonad m) (AppState s) = do
(a, s') <- runModule m s
return (a, AppState s')
newModuleState = AppState $ newModuleState
withModule _ = withModule (Proxy :: Proxy AppStack)
cleanupModule (AppState s) = cleanupModule s
-- | Arrow that is build over the monad stack
type AppWire a b = GameWire AppMonad a b
- data LambdaCubeState s
- data LambdaCubeT s m a
- class (MonadIO m, MonadThrow m) => MonadLambdaCube m where
- data LambdaCubeException
- type PipelineId = Text
- data StorageId
Low-level
data LambdaCubeState s Source #
Internal state of core module
s- - state of next module, they are chained until bottom, that is usually an empty data type.
Instances
| Generic (LambdaCubeState s) Source # | |
| NFData s => NFData (LambdaCubeState s) Source # | |
| Monad m => MonadState (LambdaCubeState s) (LambdaCubeT s m) | |
| type Rep (LambdaCubeState s) Source # | |
data LambdaCubeT s m a Source #
Monad transformer of the core module.
s- - State of next core module in modules chain;
m- - Next monad in modules monad stack;
a- - Type of result value;
How to embed module:
type AppStack = ModuleStack [LambdaCubeT, ... other modules ... ] IO newtype AppMonad a = AppMonad (AppStack a) deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadThrow, MonadCatch, MonadLambdaCube)
The module is not pure within first phase (see ModuleStack docs), therefore only IO can be used as end monad.
Instances
| MonadTrans (LambdaCubeT s) Source # | |
| Monad m => MonadState (LambdaCubeState s) (LambdaCubeT s m) Source # | |
| Monad m => Monad (LambdaCubeT s m) Source # | |
| Functor m => Functor (LambdaCubeT s m) Source # | |
| MonadFix m => MonadFix (LambdaCubeT s m) Source # | |
| Monad m => Applicative (LambdaCubeT s m) Source # | |
| MonadIO m => MonadIO (LambdaCubeT s m) Source # | |
| MonadMask m => MonadMask (LambdaCubeT s m) Source # | |
| MonadThrow m => MonadThrow (LambdaCubeT s m) Source # | |
| MonadCatch m => MonadCatch (LambdaCubeT s m) Source # | |
| (MonadIO m, MonadThrow m) => MonadLambdaCube (LambdaCubeT s m) Source # | |
| type ModuleState (LambdaCubeT s m) Source # | |
class (MonadIO m, MonadThrow m) => MonadLambdaCube m where Source #
Low level monadic API for module.
Minimal complete definition
lambdacubeUpdateSize, lambdacubeAddPipeline, lambdacubeDeletePipeline, lambdacubeCreateStorage, lambdacubeDeleteStorage, lambdacubeGetStorage, lambdacubeRenderStorageLast, lambdacubeRenderStorageFirst, lambdacubeStopRendering
Methods
lambdacubeUpdateSize :: Word -> Word -> m () Source #
Update viewport size for rendering engine Should be called when window size is changed (or every frame)
lambdacubeAddPipeline :: [FilePath] -> String -> PipelineId -> Writer PipelineSchema a -> m () Source #
Compile and register new pipeline.
Throws: PipeLineCompileFailed or PipeLineAlreadyRegistered when failed.
lambdacubeDeletePipeline :: PipelineId -> m () Source #
Removes pipeline from engine, deallocates all storages for rendering storages
Note: if pipeline with the name doesn't exists, do nothing.
lambdacubeCreateStorage :: PipelineId -> m (StorageId, GLStorage) Source #
Creates new storage (corresponding to one game object)
Note: if pipeline not found, throws PipeLineNotFound
lambdacubeDeleteStorage :: StorageId -> m () Source #
Removes storage for pipeline, deallocates it
Note: if storage with the id doesn't exists, do nothing
lambdacubeGetStorage :: StorageId -> m GLStorage Source #
Getting storage by ID
Throws StorageNotFound if no storage found
lambdacubeRenderStorageLast :: StorageId -> m () Source #
Adds storage to rendering queue
lambdacubeRenderStorageFirst :: StorageId -> m () Source #
Adds storage to rendering queue
lambdacubeStopRendering :: StorageId -> m () Source #
Removes storage from rendering queue
Instances
| (MonadIO (mt m), MonadThrow (mt m), MonadLambdaCube m, MonadTrans mt) => MonadLambdaCube (mt m) Source # | |
| (MonadIO m, MonadThrow m) => MonadLambdaCube (LambdaCubeT s m) Source # | |
data LambdaCubeException Source #
Exception type that could be thrown by the module
Constructors
| PipeLineCompileFailed String PipelineId String | Thrown when a pipeline compilation failed, first is pipeline main module, last is error message |
| PipeLineAlreadyRegistered PipelineId | Thrown when tries to register the same pipeline twice |
| PipeLineNotFound PipelineId | Trhown when tries to create storage for unregistered pipeline |
| StorageNotFound StorageId | Thrown when tries to get unregistered storage |
| PipeLineIncompatible StorageId String | Thrown when failed to bind pipeline to context, contains pipeline name and error message |
type PipelineId = Text Source #
ID to uniquely identify LambdaCube rednering pipeline