{-# LANGUAGE DeriveFunctor, RankNTypes, MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, StrictData #-}
{-# LANGUAGE ExistentialQuantification, BangPatterns, TypeFamilies #-}
{-# LANGUAGE ImplicitParams, ConstraintKinds #-}

module UI
  (
  -- UI
    UI
  , Action(..)
  , mount
  , BehaviorOf
  , behavior
  , Control.Comonad.Cofree.unwrap
  , Activity
  , modify
  , put
  , get
  , Event(..)
  -- Drawing utilities
  , glyphCode
  , blockGlyph
  , drawBlock
  , drawRect
  , screenBorder
  , centerText
  , statusText
  , width
  , height
  -- Remainder
  , Callback
  , Interface
  , Component
  , Console(..)
  , move
  , hoist
  -- Re-exports for convenience
  , Control.Comonad.Store.Store
  , Control.Comonad.Store.store
  , Control.Comonad.Store.runStore
  , Control.Monad.IO.Class.liftIO
  ) where

import Control.Exception (Exception(..), bracket_, throwIO)
import Control.Monad (forM_, forever)
import Data.Char (ord)
import Data.Functor ((<&>))
import Control.Comonad (Comonad(..), (=>>))
import Control.Comonad.Cofree (ComonadCofree(unwrap), Cofree, coiter)
import Control.Comonad.Store (ComonadStore(..), Store, store, runStore)
import Control.Concurrent.MonadIO (MVar, takeMVar, putMVar, newMVar)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.Class (MonadTrans(..))
import qualified Termbox2 as Tb2
import Tubes (Async, Generator, AsyncGenerator, (><), await, deliver, embed, yield)

-- Part 1: Components, actions, and spaces.

type Callback effect action = action effect () -> effect ()
type Interface effect action view = Callback effect action -> view
type Component effect space action view = space (Interface effect action view)

-- | Represents some action performed with or on a given component @space@.
-- These actions have side effects in a base monad.
newtype Action space effect a = Action {
  forall (space :: * -> *) (effect :: * -> *) a.
Action space effect a
-> forall r. space (a -> effect r) -> effect r
work :: forall r. space (a -> effect r) -> effect r
} deriving (forall a b. a -> Action space effect b -> Action space effect a
forall a b.
(a -> b) -> Action space effect a -> Action space effect b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (space :: * -> *) (effect :: * -> *) a b.
Functor space =>
a -> Action space effect b -> Action space effect a
forall (space :: * -> *) (effect :: * -> *) a b.
Functor space =>
(a -> b) -> Action space effect a -> Action space effect b
<$ :: forall a b. a -> Action space effect b -> Action space effect a
$c<$ :: forall (space :: * -> *) (effect :: * -> *) a b.
Functor space =>
a -> Action space effect b -> Action space effect a
fmap :: forall a b.
(a -> b) -> Action space effect a -> Action space effect b
$cfmap :: forall (space :: * -> *) (effect :: * -> *) a b.
Functor space =>
(a -> b) -> Action space effect a -> Action space effect b
Functor)

instance Comonad space => Applicative (Action space effect) where
  pure :: forall a. a -> Action space effect a
pure a
a = forall (space :: * -> *) (effect :: * -> *) a.
(forall r. space (a -> effect r) -> effect r)
-> Action space effect a
Action (forall (w :: * -> *) a. Comonad w => w a -> a
`extract` a
a)
  Action space effect (a -> b)
mf <*> :: forall a b.
Action space effect (a -> b)
-> Action space effect a -> Action space effect b
<*> Action space effect a
ma = Action space effect (a -> b)
mf forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a -> b
f -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Action space effect a
ma

instance Comonad space => Monad (Action space effect) where
  Action forall r. space (a -> effect r) -> effect r
k >>= :: forall a b.
Action space effect a
-> (a -> Action space effect b) -> Action space effect b
>>= a -> Action space effect b
f = forall (space :: * -> *) (effect :: * -> *) a.
(forall r. space (a -> effect r) -> effect r)
-> Action space effect a
Action (forall r. space (a -> effect r) -> effect r
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend (\space (b -> effect r)
wa a
a -> forall (space :: * -> *) (effect :: * -> *) a.
Action space effect a
-> forall r. space (a -> effect r) -> effect r
work (a -> Action space effect b
f a
a) space (b -> effect r)
wa))

instance Comonad space => MonadTrans (Action space) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> Action space m a
lift m a
m = forall (space :: * -> *) (effect :: * -> *) a.
(forall r. space (a -> effect r) -> effect r)
-> Action space effect a
Action (forall (w :: * -> *) a. Comonad w => w a -> a
extract forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (m a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=))

instance (Comonad space, MonadIO effect) => MonadIO (Action space effect) where
  liftIO :: forall a. IO a -> Action space effect a
liftIO = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-- | Carries out an 'Action' in a space yielding a result with side effects.
move
  :: (Functor space)
  => (a -> b -> effect r)
  -> Action space effect a
  -> space b
  -> effect r
move :: forall (space :: * -> *) a b (effect :: * -> *) r.
Functor space =>
(a -> b -> effect r)
-> Action space effect a -> space b -> effect r
move a -> b -> effect r
f Action space effect a
a space b
s = forall (space :: * -> *) (effect :: * -> *) a.
Action space effect a
-> forall r. space (a -> effect r) -> effect r
work Action space effect a
a (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> effect r
f) space b
s)

-- | Hoist an 'Action' for one space into a different space contravariantly.
hoist
  :: (forall x. w x -> v x)
  -> Action v effect a
  -> Action w effect a
hoist :: forall (w :: * -> *) (v :: * -> *) (effect :: * -> *) a.
(forall x. w x -> v x) -> Action v effect a -> Action w effect a
hoist forall x. w x -> v x
transform Action v effect a
action = forall (space :: * -> *) (effect :: * -> *) a.
(forall r. space (a -> effect r) -> effect r)
-> Action space effect a
Action forall a b. (a -> b) -> a -> b
$ forall (space :: * -> *) (effect :: * -> *) a.
Action space effect a
-> forall r. space (a -> effect r) -> effect r
work Action v effect a
action forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. w x -> v x
transform

-- | 'Action' for components built from a 'ComonadStore': modifies state.
modify :: (ComonadStore s w) => (s -> s) -> Action w effect ()
modify :: forall s (w :: * -> *) (effect :: * -> *).
ComonadStore s w =>
(s -> s) -> Action w effect ()
modify s -> s
fn = forall (space :: * -> *) (effect :: * -> *) a.
(forall r. space (a -> effect r) -> effect r)
-> Action space effect a
Action forall a b. (a -> b) -> a -> b
$ \(!w (() -> effect r)
st) ->
  let !st' :: w (() -> effect r)
st' = forall s (w :: * -> *) a.
ComonadStore s w =>
(s -> s) -> w a -> w a
seeks s -> s
fn w (() -> effect r)
st
      !v :: effect r
v = w (() -> effect r)
st' seq :: forall a b. a -> b -> b
`seq` forall (w :: * -> *) a. Comonad w => w a -> a
extract w (() -> effect r)
st' ()
  in effect r
v

-- | 'Action' for components built from a 'ComonadStore': overwrites state.
put :: (ComonadStore s w) => s -> Action w effect ()
put :: forall s (w :: * -> *) (effect :: * -> *).
ComonadStore s w =>
s -> Action w effect ()
put s
x = forall (space :: * -> *) (effect :: * -> *) a.
(forall r. space (a -> effect r) -> effect r)
-> Action space effect a
Action forall a b. (a -> b) -> a -> b
$ \w (() -> effect r)
st -> forall (w :: * -> *) a. Comonad w => w a -> a
extract (forall s (w :: * -> *) a. ComonadStore s w => s -> w a -> w a
seek s
x w (() -> effect r)
st) ()

-- | 'Action' for components built from a 'ComonadStore': loads state.
get :: (ComonadStore s w) => Action w effect s
get :: forall s (w :: * -> *) (effect :: * -> *).
ComonadStore s w =>
Action w effect s
get = forall (space :: * -> *) (effect :: * -> *) a.
(forall r. space (a -> effect r) -> effect r)
-> Action space effect a
Action forall a b. (a -> b) -> a -> b
$ \w (s -> effect r)
st -> forall (w :: * -> *) a. Comonad w => w a -> a
extract w (s -> effect r)
st (forall s (w :: * -> *) a. ComonadStore s w => w a -> s
pos w (s -> effect r)
st)

-- | Defines a space with the behavior of a given base functor.
type BehaviorOf = Cofree

-- | Constructs a space with the behavior of a given base functor.
behavior :: Functor f => (a -> f a) -> a -> BehaviorOf f a
behavior :: forall (f :: * -> *) a.
Functor f =>
(a -> f a) -> a -> BehaviorOf f a
behavior = forall (f :: * -> *) a.
Functor f =>
(a -> f a) -> a -> BehaviorOf f a
coiter

-- Part 2: Components in the terminal console.

-- | DSL based on 'Tb2.Termbox2' for UI drawing operations
-- The decisions to not derive 'MonadIO' or export the constructor are
-- deliberate.
newtype UI a = UI (Tb2.Termbox2 a) deriving ( forall a b. a -> UI b -> UI a
forall a b. (a -> b) -> UI a -> UI b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> UI b -> UI a
$c<$ :: forall a b. a -> UI b -> UI a
fmap :: forall a b. (a -> b) -> UI a -> UI b
$cfmap :: forall a b. (a -> b) -> UI a -> UI b
Functor, Functor UI
forall a. a -> UI a
forall a b. UI a -> UI b -> UI a
forall a b. UI a -> UI b -> UI b
forall a b. UI (a -> b) -> UI a -> UI b
forall a b c. (a -> b -> c) -> UI a -> UI b -> UI c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. UI a -> UI b -> UI a
$c<* :: forall a b. UI a -> UI b -> UI a
*> :: forall a b. UI a -> UI b -> UI b
$c*> :: forall a b. UI a -> UI b -> UI b
liftA2 :: forall a b c. (a -> b -> c) -> UI a -> UI b -> UI c
$cliftA2 :: forall a b c. (a -> b -> c) -> UI a -> UI b -> UI c
<*> :: forall a b. UI (a -> b) -> UI a -> UI b
$c<*> :: forall a b. UI (a -> b) -> UI a -> UI b
pure :: forall a. a -> UI a
$cpure :: forall a. a -> UI a
Applicative, Applicative UI
forall a. a -> UI a
forall a b. UI a -> UI b -> UI b
forall a b. UI a -> (a -> UI b) -> UI b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> UI a
$creturn :: forall a. a -> UI a
>> :: forall a b. UI a -> UI b -> UI b
$c>> :: forall a b. UI a -> UI b -> UI b
>>= :: forall a b. UI a -> (a -> UI b) -> UI b
$c>>= :: forall a b. UI a -> (a -> UI b) -> UI b
Monad )

-- | FIXME this newtype wrapper is purely due to laziness and a better Event
-- type should be created so the tb2 abstraction does not leak.
newtype Event = Event Tb2.Tb2Event deriving (Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show, Event -> Event -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq)

fromTb2Event :: Tb2.Tb2Event -> Maybe Event
fromTb2Event :: Tb2Event -> Maybe Event
fromTb2Event = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tb2Event -> Event
Event

-- | A console view.
data Console =
  Console
    (Event -> IO ()) -- ^ Awaits incoming events.
    (UI ())          -- ^ Renders output when called.

type Activity space effect = Component effect space (Action space) Console

data Shutdown = Shutdown deriving Int -> Shutdown -> ShowS
[Shutdown] -> ShowS
Shutdown -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Shutdown] -> ShowS
$cshowList :: [Shutdown] -> ShowS
show :: Shutdown -> String
$cshow :: Shutdown -> String
showsPrec :: Int -> Shutdown -> ShowS
$cshowsPrec :: Int -> Shutdown -> ShowS
Show
instance Exception Shutdown

quit :: MonadIO m => m a
quit :: forall (m :: * -> *) a. MonadIO m => m a
quit = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO Shutdown
Shutdown

setup, dispose :: Tb2.Termbox2 ()
setup :: Termbox2 ()
setup = Termbox2 ()
Tb2.init
dispose :: Termbox2 ()
dispose = Termbox2 ()
Tb2.shutdown

events :: Generator Tb2.Termbox2 Tb2.Tb2Event
events :: Generator (ReaderT (Ptr Tb2Event) IO) Tb2Event
events = forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
  !Maybe Tb2Event
event <- forall (t :: * -> *) a i o. Monad t => t a -> Series i o t a ()
embed Termbox2 (Maybe Tb2Event)
Tb2.pollEvent
  case Maybe Tb2Event
event of
    Maybe Tb2Event
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just !Tb2Event
event' -> forall o i (t :: * -> *) r. o -> Series i o t () r
yield Tb2Event
event'

loopOrQuit :: AsyncGenerator Tb2.Termbox2 Tb2.Tb2Event Event
loopOrQuit :: AsyncGenerator (ReaderT (Ptr Tb2Event) IO) Tb2Event Event
loopOrQuit = forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
  !Tb2Event
event <- forall i o (t :: * -> *) r. Series i o t i r
await
  if Tb2Event -> Tb2Key
Tb2._key Tb2Event
event forall a. Eq a => a -> a -> Bool
== Tb2Key
Tb2.keyCtrlQ
    then forall (t :: * -> *) a i o. Monad t => t a -> Series i o t a ()
embed forall (m :: * -> *) a. MonadIO m => m a
quit
    else forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\(!Event
v) -> forall o i (t :: * -> *) r. o -> Series i o t () r
yield Event
v) (Tb2Event -> Maybe Event
fromTb2Event Tb2Event
event)

display
  :: (Comonad space, ?ref :: MVar (Activity space IO))
  => Async Tb2.Termbox2 Event
display :: forall (space :: * -> *).
(Comonad space, ?ref::MVar (Activity space IO)) =>
Async (ReaderT (Ptr Tb2Event) IO) Event
display = forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
  ~(Console Event -> IO ()
handle ~(UI Termbox2 ()
render)) <- (forall (t :: * -> *) a i o. Monad t => t a -> Series i o t a ()
embed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$! forall (io :: * -> *) a. MonadIO io => MVar a -> io a
takeMVar ?ref::MVar (Activity space IO)
?ref) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
    (\(!Activity space IO
space) -> Activity space IO
space forall (w :: * -> *) a. Comonad w => w a -> a
`extract` (\(!Action space IO ()
action) -> do
      !Activity space IO
space' <- forall (space :: * -> *) a b (effect :: * -> *) r.
Functor space =>
(a -> b -> effect r)
-> Action space effect a -> space b -> effect r
move (forall a b. a -> b -> a
const forall a. a -> a
id) Action space IO ()
action (Activity space IO
space forall (w :: * -> *) a b. Comonad w => w a -> (w a -> b) -> w b
=>> forall (m :: * -> *) a. Monad m => a -> m a
return)
      forall (io :: * -> *) a. MonadIO io => MVar a -> a -> io ()
putMVar ?ref::MVar (Activity space IO)
?ref Activity space IO
space'))
  forall (t :: * -> *) a i o. Monad t => t a -> Series i o t a ()
embed forall a b. (a -> b) -> a -> b
$ Termbox2 ()
Tb2.clear forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Termbox2 ()
render forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Termbox2 ()
Tb2.present
  forall i o (t :: * -> *) r. Series i o t i r
await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) a i o. Monad t => t a -> Series i o t a ()
embed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> IO ()
handle

-- | Sets up a component for execution and catches exceptions.
mount :: Comonad space => Activity space IO -> IO ()
mount :: forall (space :: * -> *).
Comonad space =>
Activity space IO -> IO ()
mount !Activity space IO
component = do
  !MVar (Activity space IO)
ref <- forall (io :: * -> *) a. MonadIO io => a -> io (MVar a)
newMVar Activity space IO
component
  let ?ref = MVar (Activity space IO)
ref
  forall a b c. IO a -> IO b -> IO c -> IO c
bracket_
    (forall a. Termbox2 a -> IO a
Tb2.runTermbox2 Termbox2 ()
setup)
    (forall a. Termbox2 a -> IO a
Tb2.runTermbox2 Termbox2 ()
dispose)
    (forall a. Termbox2 a -> IO a
Tb2.runTermbox2 forall a b. (a -> b) -> a -> b
$! forall (t :: * -> *) i o r. Monad t => Series i o t r r -> t r
deliver forall a b. (a -> b) -> a -> b
$! Generator (ReaderT (Ptr Tb2Event) IO) Tb2Event
events forall i e a o (t :: * -> *).
Monad t =>
Series i e t () () -> Series e o t () () -> Series i o t a ()
>< AsyncGenerator (ReaderT (Ptr Tb2Event) IO) Tb2Event Event
loopOrQuit forall i e a o (t :: * -> *).
Monad t =>
Series i e t () () -> Series e o t () () -> Series i o t a ()
>< forall (space :: * -> *).
(Comonad space, ?ref::MVar (Activity space IO)) =>
Async (ReaderT (Ptr Tb2Event) IO) Event
display)

-- Part 3: Drawing utilities.

glyphCode :: Integral n => Char -> n
glyphCode :: forall n. Integral n => Char -> n
glyphCode = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord

blockGlyph :: Integral n => n
blockGlyph :: forall n. Integral n => n
blockGlyph = forall n. Integral n => Char -> n
glyphCode Char
'▄'

drawBlock :: Int -> Int -> UI ()
drawBlock :: Int -> Int -> UI ()
drawBlock Int
x Int
y = forall a. Termbox2 a -> UI a
UI forall a b. (a -> b) -> a -> b
$! Int -> Int -> Int32 -> Tb2ColorAttr -> Tb2ColorAttr -> Termbox2 ()
Tb2.setCell Int
x Int
y forall n. Integral n => n
blockGlyph Tb2ColorAttr
Tb2.colorWhite Tb2ColorAttr
Tb2.colorDefault

drawRect :: Int -> Int -> Int -> Int -> UI ()
drawRect :: Int -> Int -> Int -> Int -> UI ()
drawRect Int
left Int
top Int
w Int
h = forall a. Termbox2 a -> UI a
UI forall a b. (a -> b) -> a -> b
$! do
  let bottom :: Int
bottom = Int
topforall a. Num a => a -> a -> a
+Int
hforall a. Num a => a -> a -> a
-Int
1
  let right :: Int
right = Int
leftforall a. Num a => a -> a -> a
+Int
wforall a. Num a => a -> a -> a
-Int
1
  let setCell :: Int -> Int -> Int32 -> Termbox2 ()
setCell Int
x Int
y Int32
ch = Int -> Int -> Int32 -> Tb2ColorAttr -> Tb2ColorAttr -> Termbox2 ()
Tb2.setCell Int
x Int
y Int32
ch Tb2ColorAttr
Tb2.colorGreen Tb2ColorAttr
Tb2.colorBlack
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
left..Int
right] forall a b. (a -> b) -> a -> b
$ \Int
i -> do
    Int -> Int -> Int32 -> Termbox2 ()
setCell Int
i Int
top Int32
0x2500
    Int -> Int -> Int32 -> Termbox2 ()
setCell Int
i Int
bottom Int32
0x2500
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
top..Int
bottom] forall a b. (a -> b) -> a -> b
$ \Int
i -> do
    Int -> Int -> Int32 -> Termbox2 ()
setCell Int
left Int
i Int32
0x2502
    Int -> Int -> Int32 -> Termbox2 ()
setCell Int
right Int
i Int32
0x2502
  Int -> Int -> Int32 -> Termbox2 ()
setCell Int
left Int
top Int32
0x250C
  Int -> Int -> Int32 -> Termbox2 ()
setCell Int
right Int
top Int32
0x2510
  Int -> Int -> Int32 -> Termbox2 ()
setCell Int
left Int
bottom Int32
0x2514
  Int -> Int -> Int32 -> Termbox2 ()
setCell Int
right Int
bottom Int32
0x2518

screenBorder :: Int -> UI ()
screenBorder :: Int -> UI ()
screenBorder Int
border = do
  Int
w <- UI Int
width
  Int
h <- UI Int
height
  Int -> Int -> Int -> Int -> UI ()
drawRect Int
border Int
border (Int
wforall a. Num a => a -> a -> a
-Int
border) (Int
hforall a. Num a => a -> a -> a
-Int
border)

centerText :: String -> UI ()
centerText :: String -> UI ()
centerText String
msg = forall a. Termbox2 a -> UI a
UI forall a b. (a -> b) -> a -> b
$! do
  Int
w <- forall n. Integral n => Termbox2 n
Tb2.width
  Int
h <- forall n. Integral n => Termbox2 n
Tb2.height
  let cx :: Int
cx = (Int
w forall a. Integral a => a -> a -> a
`div` Int
2) forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
msg forall a. Integral a => a -> a -> a
`div` Int
2
  let cy :: Int
cy = Int
h forall a. Integral a => a -> a -> a
`div` Int
2
  let fgAttrs :: Tb2ColorAttr
fgAttrs = Tb2ColorAttr
Tb2.colorGreen forall a. Semigroup a => a -> a -> a
<> Tb2ColorAttr
Tb2.attrUnderline forall a. Semigroup a => a -> a -> a
<> Tb2ColorAttr
Tb2.attrBold
  let bgAttrs :: Tb2ColorAttr
bgAttrs = Tb2ColorAttr
Tb2.colorMagenta
  Int -> Int -> Tb2ColorAttr -> Tb2ColorAttr -> String -> Termbox2 ()
Tb2.print Int
cx Int
cy Tb2ColorAttr
fgAttrs Tb2ColorAttr
bgAttrs String
msg

statusText :: String -> UI ()
statusText :: String -> UI ()
statusText String
msg = forall a. Termbox2 a -> UI a
UI forall a b. (a -> b) -> a -> b
$! do
  Int
w <- forall n. Integral n => Termbox2 n
Tb2.width
  Int
h <- forall n. Integral n => Termbox2 n
Tb2.height
  let cx :: Int
cx = Int
w forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
msg forall a. Num a => a -> a -> a
- Int
2
  let cy :: Int
cy = Int
h forall a. Num a => a -> a -> a
- Int
2
  Int -> Int -> Tb2ColorAttr -> Tb2ColorAttr -> String -> Termbox2 ()
Tb2.print Int
cx Int
cy Tb2ColorAttr
Tb2.colorGreen Tb2ColorAttr
Tb2.colorDefault String
msg

width, height :: UI Int
width :: UI Int
width = forall a. Termbox2 a -> UI a
UI forall n. Integral n => Termbox2 n
Tb2.width
height :: UI Int
height = forall a. Termbox2 a -> UI a
UI forall n. Integral n => Termbox2 n
Tb2.height