module Termbox.Banana
(
Inputs (..),
Outputs (..),
run,
InitError (..),
Scene,
image,
fill,
cursor,
Image,
char,
fg,
bg,
bold,
underline,
blink,
at,
atRow,
atCol,
Color,
defaultColor,
red,
green,
yellow,
blue,
magenta,
cyan,
white,
bright,
color,
gray,
Key (..),
Mouse (..),
MouseButton (..),
Pos (..),
posUp,
posDown,
posLeft,
posRight,
Size (..),
)
where
import Control.Concurrent.MVar
import Control.Monad.IO.Class (liftIO)
import Data.Void (Void)
import qualified Reactive.Banana as Banana
import qualified Reactive.Banana.Frameworks as Banana
import Termbox
( Color,
Image,
InitError (..),
Key (..),
Mouse (..),
MouseButton (..),
Pos (..),
Scene,
Size (..),
at,
atCol,
atRow,
bg,
blink,
blue,
bold,
bright,
char,
color,
cursor,
cyan,
defaultColor,
fg,
fill,
getSize,
gray,
green,
image,
magenta,
poll,
posDown,
posLeft,
posRight,
posUp,
red,
underline,
white,
yellow,
)
import qualified Termbox (Event (..), render, run)
data Inputs = Inputs
{
Inputs -> Size
initialSize :: !Size,
Inputs -> Event Key
keys :: !(Banana.Event Key),
Inputs -> Event Size
resizes :: !(Banana.Event Size),
Inputs -> Event Mouse
mouses :: !(Banana.Event Mouse)
}
data Outputs a = Outputs
{
forall a. Outputs a -> Behavior Scene
scene :: !(Banana.Behavior Scene),
forall a. Outputs a -> Event a
done :: !(Banana.Event a)
}
run ::
(Inputs -> Banana.MomentIO (Outputs a)) ->
IO (Either InitError a)
run :: forall a.
(Inputs -> MomentIO (Outputs a)) -> IO (Either InitError a)
run Inputs -> MomentIO (Outputs a)
program =
IO a -> IO (Either InitError a)
forall a. IO a -> IO (Either InitError a)
Termbox.run ((Inputs -> MomentIO (Outputs a)) -> IO a
forall a. (Inputs -> MomentIO (Outputs a)) -> IO a
run_ Inputs -> MomentIO (Outputs a)
program)
run_ :: (Inputs -> Banana.MomentIO (Outputs a)) -> IO a
run_ :: forall a. (Inputs -> MomentIO (Outputs a)) -> IO a
run_ Inputs -> MomentIO (Outputs a)
program = do
Size
initialSize <- IO Size
getSize
MVar a
doneVar <- IO (MVar a)
forall a. IO (MVar a)
newEmptyMVar
(AddHandler Key
keysAddHandler, Handler Key
fireKey) <- IO (AddHandler Key, Handler Key)
forall a. IO (AddHandler a, Handler a)
Banana.newAddHandler
(AddHandler Size
resizesAddHandler, Handler Size
fireResize) <- IO (AddHandler Size, Handler Size)
forall a. IO (AddHandler a, Handler a)
Banana.newAddHandler
(AddHandler Mouse
mousesAddHandler, Handler Mouse
fireMouse) <- IO (AddHandler Mouse, Handler Mouse)
forall a. IO (AddHandler a, Handler a)
Banana.newAddHandler
EventNetwork
network <-
MomentIO () -> IO EventNetwork
Banana.compile do
Event Key
keys <- AddHandler Key -> MomentIO (Event Key)
forall a. AddHandler a -> MomentIO (Event a)
Banana.fromAddHandler AddHandler Key
keysAddHandler
Event Size
resizes <- AddHandler Size -> MomentIO (Event Size)
forall a. AddHandler a -> MomentIO (Event a)
Banana.fromAddHandler AddHandler Size
resizesAddHandler
Event Mouse
mouses <- AddHandler Mouse -> MomentIO (Event Mouse)
forall a. AddHandler a -> MomentIO (Event a)
Banana.fromAddHandler AddHandler Mouse
mousesAddHandler
Outputs {Behavior Scene
scene :: forall a. Outputs a -> Behavior Scene
scene :: Behavior Scene
scene, Event a
done :: forall a. Outputs a -> Event a
done :: Event a
done} <- Inputs -> MomentIO (Outputs a)
program Inputs {Size
initialSize :: Size
initialSize :: Size
initialSize, Event Key
keys :: Event Key
keys :: Event Key
keys, Event Size
resizes :: Event Size
resizes :: Event Size
resizes, Event Mouse
mouses :: Event Mouse
mouses :: Event Mouse
mouses}
let render :: Behavior (IO ())
render = Scene -> IO ()
Termbox.render (Scene -> IO ()) -> Behavior Scene -> Behavior (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior Scene
scene
IO () -> MomentIO ()
forall a. IO a -> MomentIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MomentIO ()) -> MomentIO (IO ()) -> MomentIO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Behavior (IO ()) -> MomentIO (IO ())
forall (m :: * -> *) a. MonadMoment m => Behavior a -> m a
Banana.valueB Behavior (IO ())
render
Event (Future (IO ())) -> MomentIO ()
Banana.reactimate' (Event (Future (IO ())) -> MomentIO ())
-> MomentIO (Event (Future (IO ()))) -> MomentIO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Behavior (IO ()) -> MomentIO (Event (Future (IO ())))
forall a. Behavior a -> MomentIO (Event (Future a))
Banana.changes Behavior (IO ())
render
Event a
done1 <- Event a -> MomentIO (Event a)
forall (m :: * -> *) a. MonadMoment m => Event a -> m (Event a)
Banana.once Event a
done
Event (IO ()) -> MomentIO ()
Banana.reactimate (MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar a
doneVar (a -> IO ()) -> Event a -> Event (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event a
done1)
EventNetwork -> IO ()
Banana.actuate EventNetwork
network
let loop :: IO a
loop = do
forall e. IO (Event e)
poll @Void IO (Event Void) -> (Event Void -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Termbox.EventKey Key
key -> Handler Key
fireKey Key
key
Termbox.EventResize Size
size -> Handler Size
fireResize Size
size
Termbox.EventMouse Mouse
mouse -> Handler Mouse
fireMouse Mouse
mouse
MVar a -> IO (Maybe a)
forall a. MVar a -> IO (Maybe a)
tryReadMVar MVar a
doneVar IO (Maybe a) -> (Maybe a -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe a
Nothing -> IO a
loop
Just a
result -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result
IO a
loop