{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Imj.Graphics.Render.Delta.Env
( DeltaEnv
, newDefaultEnv
, newEnv
, ResizePolicy(..)
, defaultResizePolicy
, setResizePolicy
, ClearPolicy(..)
, defaultClearPolicy
, setClearPolicy
, defaultClearColor
, setClearColor
, defaultStdoutMode
, setStdoutBufferMode
, BufferMode(..)
) where
import Imj.Prelude
import System.IO(BufferMode(..), hSetBuffering, stdout)
import Control.Monad.IO.Class(liftIO)
import Data.IORef( IORef, readIORef, writeIORef )
import Data.Maybe( fromMaybe )
import Imj.Graphics.Class.Draw
import Imj.Graphics.Class.Render
import Imj.Graphics.Render.Delta.Buffers
import Imj.Graphics.Render.Delta.Console
import Imj.Graphics.Render.Delta.DefaultPolicies
import Imj.Graphics.Render.Delta.Draw
import Imj.Graphics.Render.Delta.Flush
import Imj.Graphics.Render.Delta.Types
newtype DeltaEnv = DeltaEnv (IORef Buffers)
instance Draw DeltaEnv where
drawChar' (DeltaEnv a) b c d = liftIO $ deltaDrawChar a b c d
drawChars' (DeltaEnv a) b c d e = liftIO $ deltaDrawChars a b c d e
drawTxt' (DeltaEnv a) b c d = liftIO $ deltaDrawTxt a b c d
drawStr' (DeltaEnv a) b c d = liftIO $ deltaDrawStr a b c d
{-# INLINABLE drawChar' #-}
{-# INLINABLE drawChars' #-}
{-# INLINABLE drawTxt' #-}
{-# INLINABLE drawStr' #-}
instance Render DeltaEnv where
renderToScreen' (DeltaEnv a) = liftIO $ deltaFlush a
{-# INLINABLE renderToScreen' #-}
newDefaultEnv :: IO DeltaEnv
newDefaultEnv = newEnv Nothing Nothing Nothing Nothing
newEnv :: Maybe ResizePolicy
-> Maybe ClearPolicy
-> Maybe (Color8 Background)
-> Maybe BufferMode
-> IO DeltaEnv
newEnv a b c mayBufferMode = do
let stdoutBufMode = fromMaybe defaultStdoutMode mayBufferMode
configureConsoleFor Gaming stdoutBufMode
DeltaEnv <$> newContext a b c
setResizePolicy :: Maybe ResizePolicy
-> DeltaEnv
-> IO ()
setResizePolicy mayResizePolicy (DeltaEnv ref) =
readIORef ref
>>= \(Buffers a b d e (Policies _ f g)) -> do
let resizePolicy = fromMaybe defaultResizePolicy mayResizePolicy
writeIORef ref $ Buffers a b d e (Policies resizePolicy f g)
setClearPolicy :: Maybe ClearPolicy
-> DeltaEnv
-> IO ()
setClearPolicy mayClearPolicy (DeltaEnv ref) =
readIORef ref
>>= \(Buffers a b d e (Policies f _ clearColor)) -> do
let clearPolicy = fromMaybe defaultClearPolicy mayClearPolicy
buffers = Buffers a b d e (Policies f clearPolicy clearColor)
writeIORef ref buffers
setClearColor :: Maybe (Color8 Background)
-> DeltaEnv
-> IO ()
setClearColor mayClearColor (DeltaEnv ref) =
readIORef ref
>>= \(Buffers a b d e (Policies f clearPolicy _)) -> do
let clearColor = fromMaybe defaultClearColor mayClearColor
buffers = Buffers a b d e (Policies f clearPolicy clearColor)
writeIORef ref buffers
setStdoutBufferMode :: Maybe BufferMode
-> IO ()
setStdoutBufferMode mayBufferMode =
hSetBuffering stdout (fromMaybe defaultStdoutMode mayBufferMode)