{-|
Module: Reflex.Vty.Widget
Description: Basic set of widgets and building blocks for reflex-vty applications
-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Reflex.Vty.Widget
  ( VtyWidgetCtx(..)
  , VtyWidget(..)
  , VtyWidgetOut(..)
  , ImageWriter(..)
  , runVtyWidget
  , mainWidget
  , mainWidgetWithHandle
  , HasDisplaySize(..)
  , HasFocus(..)
  , HasVtyInput(..)
  , DynRegion(..)
  , currentRegion
  , Region(..)
  , regionSize
  , regionBlankImage
  , Drag(..)
  , drag
  , MouseDown(..)
  , MouseUp(..)
  , mouseDown
  , mouseUp
  , ScrollDirection(..)
  , mouseScroll
  , pane
  , splitV
  , splitH
  , splitVDrag
  , boxTitle
  , box
  , boxStatic
  , RichTextConfig(..)
  , richText
  , text
  , scrollableText
  , display
  , BoxStyle(..)
  , hyphenBoxStyle
  , singleBoxStyle
  , roundedBoxStyle
  , thickBoxStyle
  , doubleBoxStyle
  , fill
  , hRule
  , KeyCombo
  , key
  , keys
  , keyCombo
  , keyCombos
  , blank
  ) where

import Control.Applicative (liftA2)
import Control.Monad.Fix (MonadFix)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Reader (ReaderT, ask, asks, runReaderT)
import Control.Monad.Trans (MonadTrans, lift)
import Data.Default (Default(..))
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Zipper as TZ
import Graphics.Vty (Image)
import qualified Graphics.Vty as V
import Reflex
import Reflex.Class ()
import Reflex.Host.Class (MonadReflexCreateTrigger)

import Reflex.Vty.Host

import Control.Monad.NodeId

-- | The context within which a 'VtyWidget' runs
data VtyWidgetCtx t = VtyWidgetCtx
  { VtyWidgetCtx t -> Dynamic t Int
_vtyWidgetCtx_width :: Dynamic t Int
    -- ^ The width of the region allocated to the widget.
  , VtyWidgetCtx t -> Dynamic t Int
_vtyWidgetCtx_height :: Dynamic t Int
    -- ^ The height of the region allocated to the widget.
  , VtyWidgetCtx t -> Dynamic t Bool
_vtyWidgetCtx_focus :: Dynamic t Bool
    -- ^ Whether the widget should behave as if it has focus for keyboard input.
  , VtyWidgetCtx t -> Event t VtyEvent
_vtyWidgetCtx_input :: Event t VtyEvent
    -- ^ User input events that the widget's parent chooses to share. These will generally
    -- be filtered for relevance:
    --  * Keyboard inputs are restricted to focused widgets
    --  * Mouse inputs are restricted to the region in which the widget resides and are
    --  translated into its internal coordinates.
  }

-- | The output of a 'VtyWidget'
data VtyWidgetOut t = VtyWidgetOut
  { VtyWidgetOut t -> Event t ()
_vtyWidgetOut_shutdown :: Event t ()
  }

instance (Adjustable t m, MonadHold t m, Reflex t) => Adjustable t (VtyWidget t m) where
  runWithReplace :: VtyWidget t m a
-> Event t (VtyWidget t m b) -> VtyWidget t m (a, Event t b)
runWithReplace a0 :: VtyWidget t m a
a0 a' :: Event t (VtyWidget t m b)
a' = BehaviorWriterT
  t [Image] (ReaderT (VtyWidgetCtx t) m) (a, Event t b)
-> VtyWidget t m (a, Event t b)
forall t (m :: * -> *) a.
BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
-> VtyWidget t m a
VtyWidget (BehaviorWriterT
   t [Image] (ReaderT (VtyWidgetCtx t) m) (a, Event t b)
 -> VtyWidget t m (a, Event t b))
-> BehaviorWriterT
     t [Image] (ReaderT (VtyWidgetCtx t) m) (a, Event t b)
-> VtyWidget t m (a, Event t b)
forall a b. (a -> b) -> a -> b
$ BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
-> Event
     t (BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) b)
-> BehaviorWriterT
     t [Image] (ReaderT (VtyWidgetCtx t) m) (a, Event t b)
forall t (m :: * -> *) a b.
Adjustable t m =>
m a -> Event t (m b) -> m (a, Event t b)
runWithReplace (VtyWidget t m a
-> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
forall t (m :: * -> *) a.
VtyWidget t m a
-> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
unVtyWidget VtyWidget t m a
a0) (Event t (BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) b)
 -> BehaviorWriterT
      t [Image] (ReaderT (VtyWidgetCtx t) m) (a, Event t b))
-> Event
     t (BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) b)
-> BehaviorWriterT
     t [Image] (ReaderT (VtyWidgetCtx t) m) (a, Event t b)
forall a b. (a -> b) -> a -> b
$ (VtyWidget t m b
 -> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) b)
-> Event t (VtyWidget t m b)
-> Event
     t (BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VtyWidget t m b
-> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) b
forall t (m :: * -> *) a.
VtyWidget t m a
-> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
unVtyWidget Event t (VtyWidget t m b)
a'
  traverseIntMapWithKeyWithAdjust :: (Int -> v -> VtyWidget t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> VtyWidget t m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust f :: Int -> v -> VtyWidget t m v'
f dm0 :: IntMap v
dm0 dm' :: Event t (PatchIntMap v)
dm' = BehaviorWriterT
  t
  [Image]
  (ReaderT (VtyWidgetCtx t) m)
  (IntMap v', Event t (PatchIntMap v'))
-> VtyWidget t m (IntMap v', Event t (PatchIntMap v'))
forall t (m :: * -> *) a.
BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
-> VtyWidget t m a
VtyWidget (BehaviorWriterT
   t
   [Image]
   (ReaderT (VtyWidgetCtx t) m)
   (IntMap v', Event t (PatchIntMap v'))
 -> VtyWidget t m (IntMap v', Event t (PatchIntMap v')))
-> BehaviorWriterT
     t
     [Image]
     (ReaderT (VtyWidgetCtx t) m)
     (IntMap v', Event t (PatchIntMap v'))
-> VtyWidget t m (IntMap v', Event t (PatchIntMap v'))
forall a b. (a -> b) -> a -> b
$
    (Int
 -> v -> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) v')
-> IntMap v
-> Event t (PatchIntMap v)
-> BehaviorWriterT
     t
     [Image]
     (ReaderT (VtyWidgetCtx t) m)
     (IntMap v', Event t (PatchIntMap v'))
forall t (m :: * -> *) v v'.
Adjustable t m =>
(Int -> v -> m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust (\k :: Int
k v :: v
v -> VtyWidget t m v'
-> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) v'
forall t (m :: * -> *) a.
VtyWidget t m a
-> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
unVtyWidget (Int -> v -> VtyWidget t m v'
f Int
k v
v)) IntMap v
dm0 Event t (PatchIntMap v)
dm'
  traverseDMapWithKeyWithAdjust :: (forall a. k a -> v a -> VtyWidget t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> VtyWidget t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust f :: forall a. k a -> v a -> VtyWidget t m (v' a)
f dm0 :: DMap k v
dm0 dm' :: Event t (PatchDMap k v)
dm' = BehaviorWriterT
  t
  [Image]
  (ReaderT (VtyWidgetCtx t) m)
  (DMap k v', Event t (PatchDMap k v'))
-> VtyWidget t m (DMap k v', Event t (PatchDMap k v'))
forall t (m :: * -> *) a.
BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
-> VtyWidget t m a
VtyWidget (BehaviorWriterT
   t
   [Image]
   (ReaderT (VtyWidgetCtx t) m)
   (DMap k v', Event t (PatchDMap k v'))
 -> VtyWidget t m (DMap k v', Event t (PatchDMap k v')))
-> BehaviorWriterT
     t
     [Image]
     (ReaderT (VtyWidgetCtx t) m)
     (DMap k v', Event t (PatchDMap k v'))
-> VtyWidget t m (DMap k v', Event t (PatchDMap k v'))
forall a b. (a -> b) -> a -> b
$ do
    (forall a.
 k a
 -> v a
 -> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> BehaviorWriterT
     t
     [Image]
     (ReaderT (VtyWidgetCtx t) m)
     (DMap k v', Event t (PatchDMap k v'))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust (\k :: k a
k v :: v a
v -> VtyWidget t m (v' a)
-> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) (v' a)
forall t (m :: * -> *) a.
VtyWidget t m a
-> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
unVtyWidget (k a -> v a -> VtyWidget t m (v' a)
forall a. k a -> v a -> VtyWidget t m (v' a)
f k a
k v a
v)) DMap k v
dm0 Event t (PatchDMap k v)
dm'
  traverseDMapWithKeyWithAdjustWithMove :: (forall a. k a -> v a -> VtyWidget t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> VtyWidget t m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove f :: forall a. k a -> v a -> VtyWidget t m (v' a)
f dm0 :: DMap k v
dm0 dm' :: Event t (PatchDMapWithMove k v)
dm' = BehaviorWriterT
  t
  [Image]
  (ReaderT (VtyWidgetCtx t) m)
  (DMap k v', Event t (PatchDMapWithMove k v'))
-> VtyWidget t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall t (m :: * -> *) a.
BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
-> VtyWidget t m a
VtyWidget (BehaviorWriterT
   t
   [Image]
   (ReaderT (VtyWidgetCtx t) m)
   (DMap k v', Event t (PatchDMapWithMove k v'))
 -> VtyWidget t m (DMap k v', Event t (PatchDMapWithMove k v')))
-> BehaviorWriterT
     t
     [Image]
     (ReaderT (VtyWidgetCtx t) m)
     (DMap k v', Event t (PatchDMapWithMove k v'))
-> VtyWidget t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall a b. (a -> b) -> a -> b
$ do
    (forall a.
 k a
 -> v a
 -> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> BehaviorWriterT
     t
     [Image]
     (ReaderT (VtyWidgetCtx t) m)
     (DMap k v', Event t (PatchDMapWithMove k v'))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove (\k :: k a
k v :: v a
v -> VtyWidget t m (v' a)
-> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) (v' a)
forall t (m :: * -> *) a.
VtyWidget t m a
-> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
unVtyWidget (k a -> v a -> VtyWidget t m (v' a)
forall a. k a -> v a -> VtyWidget t m (v' a)
f k a
k v a
v)) DMap k v
dm0 Event t (PatchDMapWithMove k v)
dm'

-- | A widget that can read its context and produce image output
newtype VtyWidget t m a = VtyWidget
  { VtyWidget t m a
-> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
unVtyWidget :: BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
  } deriving
    ( a -> VtyWidget t m b -> VtyWidget t m a
(a -> b) -> VtyWidget t m a -> VtyWidget t m b
(forall a b. (a -> b) -> VtyWidget t m a -> VtyWidget t m b)
-> (forall a b. a -> VtyWidget t m b -> VtyWidget t m a)
-> Functor (VtyWidget t m)
forall a b. a -> VtyWidget t m b -> VtyWidget t m a
forall a b. (a -> b) -> VtyWidget t m a -> VtyWidget t m b
forall t (m :: * -> *) a b.
Functor m =>
a -> VtyWidget t m b -> VtyWidget t m a
forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> VtyWidget t m a -> VtyWidget t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> VtyWidget t m b -> VtyWidget t m a
$c<$ :: forall t (m :: * -> *) a b.
Functor m =>
a -> VtyWidget t m b -> VtyWidget t m a
fmap :: (a -> b) -> VtyWidget t m a -> VtyWidget t m b
$cfmap :: forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> VtyWidget t m a -> VtyWidget t m b
Functor
    , Functor (VtyWidget t m)
a -> VtyWidget t m a
Functor (VtyWidget t m) =>
(forall a. a -> VtyWidget t m a)
-> (forall a b.
    VtyWidget t m (a -> b) -> VtyWidget t m a -> VtyWidget t m b)
-> (forall a b c.
    (a -> b -> c)
    -> VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m c)
-> (forall a b.
    VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m b)
-> (forall a b.
    VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m a)
-> Applicative (VtyWidget t m)
VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m b
VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m a
VtyWidget t m (a -> b) -> VtyWidget t m a -> VtyWidget t m b
(a -> b -> c)
-> VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m c
forall a. a -> VtyWidget t m a
forall a b. VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m a
forall a b. VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m b
forall a b.
VtyWidget t m (a -> b) -> VtyWidget t m a -> VtyWidget t m b
forall a b c.
(a -> b -> c)
-> VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m c
forall t (m :: * -> *). Monad m => Functor (VtyWidget t m)
forall t (m :: * -> *) a. Monad m => a -> VtyWidget t m a
forall t (m :: * -> *) a b.
Monad m =>
VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m a
forall t (m :: * -> *) a b.
Monad m =>
VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m b
forall t (m :: * -> *) a b.
Monad m =>
VtyWidget t m (a -> b) -> VtyWidget t m a -> VtyWidget t m b
forall t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m 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
<* :: VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m a
$c<* :: forall t (m :: * -> *) a b.
Monad m =>
VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m a
*> :: VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m b
$c*> :: forall t (m :: * -> *) a b.
Monad m =>
VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m b
liftA2 :: (a -> b -> c)
-> VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m c
$cliftA2 :: forall t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m c
<*> :: VtyWidget t m (a -> b) -> VtyWidget t m a -> VtyWidget t m b
$c<*> :: forall t (m :: * -> *) a b.
Monad m =>
VtyWidget t m (a -> b) -> VtyWidget t m a -> VtyWidget t m b
pure :: a -> VtyWidget t m a
$cpure :: forall t (m :: * -> *) a. Monad m => a -> VtyWidget t m a
$cp1Applicative :: forall t (m :: * -> *). Monad m => Functor (VtyWidget t m)
Applicative
    , Applicative (VtyWidget t m)
a -> VtyWidget t m a
Applicative (VtyWidget t m) =>
(forall a b.
 VtyWidget t m a -> (a -> VtyWidget t m b) -> VtyWidget t m b)
-> (forall a b.
    VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m b)
-> (forall a. a -> VtyWidget t m a)
-> Monad (VtyWidget t m)
VtyWidget t m a -> (a -> VtyWidget t m b) -> VtyWidget t m b
VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m b
forall a. a -> VtyWidget t m a
forall a b. VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m b
forall a b.
VtyWidget t m a -> (a -> VtyWidget t m b) -> VtyWidget t m b
forall t (m :: * -> *). Monad m => Applicative (VtyWidget t m)
forall t (m :: * -> *) a. Monad m => a -> VtyWidget t m a
forall t (m :: * -> *) a b.
Monad m =>
VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m b
forall t (m :: * -> *) a b.
Monad m =>
VtyWidget t m a -> (a -> VtyWidget t m b) -> VtyWidget t m 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 :: a -> VtyWidget t m a
$creturn :: forall t (m :: * -> *) a. Monad m => a -> VtyWidget t m a
>> :: VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m b
$c>> :: forall t (m :: * -> *) a b.
Monad m =>
VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m b
>>= :: VtyWidget t m a -> (a -> VtyWidget t m b) -> VtyWidget t m b
$c>>= :: forall t (m :: * -> *) a b.
Monad m =>
VtyWidget t m a -> (a -> VtyWidget t m b) -> VtyWidget t m b
$cp1Monad :: forall t (m :: * -> *). Monad m => Applicative (VtyWidget t m)
Monad
    , MonadSample t
    , MonadHold t
    , Monad (VtyWidget t m)
Monad (VtyWidget t m) =>
(forall a. (a -> VtyWidget t m a) -> VtyWidget t m a)
-> MonadFix (VtyWidget t m)
(a -> VtyWidget t m a) -> VtyWidget t m a
forall a. (a -> VtyWidget t m a) -> VtyWidget t m a
forall t (m :: * -> *). MonadFix m => Monad (VtyWidget t m)
forall t (m :: * -> *) a.
MonadFix m =>
(a -> VtyWidget t m a) -> VtyWidget t m a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> VtyWidget t m a) -> VtyWidget t m a
$cmfix :: forall t (m :: * -> *) a.
MonadFix m =>
(a -> VtyWidget t m a) -> VtyWidget t m a
$cp1MonadFix :: forall t (m :: * -> *). MonadFix m => Monad (VtyWidget t m)
MonadFix
    , NotReady t
    , ImageWriter t
    , PostBuild t
    , TriggerEvent t
    , MonadReflexCreateTrigger t
    , Monad (VtyWidget t m)
Monad (VtyWidget t m) =>
(forall a. IO a -> VtyWidget t m a) -> MonadIO (VtyWidget t m)
IO a -> VtyWidget t m a
forall a. IO a -> VtyWidget t m a
forall t (m :: * -> *). MonadIO m => Monad (VtyWidget t m)
forall t (m :: * -> *) a. MonadIO m => IO a -> VtyWidget t m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> VtyWidget t m a
$cliftIO :: forall t (m :: * -> *) a. MonadIO m => IO a -> VtyWidget t m a
$cp1MonadIO :: forall t (m :: * -> *). MonadIO m => Monad (VtyWidget t m)
MonadIO
    )

deriving instance PerformEvent t m => PerformEvent t (VtyWidget t m)
instance MonadTrans (VtyWidget t) where
  lift :: m a -> VtyWidget t m a
lift f :: m a
f = BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
-> VtyWidget t m a
forall t (m :: * -> *) a.
BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
-> VtyWidget t m a
VtyWidget (BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
 -> VtyWidget t m a)
-> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
-> VtyWidget t m a
forall a b. (a -> b) -> a -> b
$ ReaderT (VtyWidgetCtx t) m a
-> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (VtyWidgetCtx t) m a
 -> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a)
-> ReaderT (VtyWidgetCtx t) m a
-> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
forall a b. (a -> b) -> a -> b
$ m a -> ReaderT (VtyWidgetCtx t) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
f

instance MonadNodeId m => MonadNodeId (VtyWidget t m) where
  getNextNodeId :: VtyWidget t m NodeId
getNextNodeId = BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) NodeId
-> VtyWidget t m NodeId
forall t (m :: * -> *) a.
BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
-> VtyWidget t m a
VtyWidget (BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) NodeId
 -> VtyWidget t m NodeId)
-> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) NodeId
-> VtyWidget t m NodeId
forall a b. (a -> b) -> a -> b
$ do
    ReaderT (VtyWidgetCtx t) m NodeId
-> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) NodeId
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (VtyWidgetCtx t) m NodeId
 -> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) NodeId)
-> ReaderT (VtyWidgetCtx t) m NodeId
-> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) NodeId
forall a b. (a -> b) -> a -> b
$ m NodeId -> ReaderT (VtyWidgetCtx t) m NodeId
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m NodeId
forall (m :: * -> *). MonadNodeId m => m NodeId
getNextNodeId

-- | Runs a 'VtyWidget' with a given context
runVtyWidget
  :: (Reflex t, MonadNodeId m)
  => VtyWidgetCtx t
  -> VtyWidget t m a
  -> m (a, Behavior t [Image])
runVtyWidget :: VtyWidgetCtx t -> VtyWidget t m a -> m (a, Behavior t [Image])
runVtyWidget ctx :: VtyWidgetCtx t
ctx w :: VtyWidget t m a
w = ReaderT (VtyWidgetCtx t) m (a, Behavior t [Image])
-> VtyWidgetCtx t -> m (a, Behavior t [Image])
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
-> ReaderT (VtyWidgetCtx t) m (a, Behavior t [Image])
forall (m :: * -> *) t w a.
(Monad m, Reflex t, Monoid w) =>
BehaviorWriterT t w m a -> m (a, Behavior t w)
runBehaviorWriterT (VtyWidget t m a
-> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
forall t (m :: * -> *) a.
VtyWidget t m a
-> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
unVtyWidget VtyWidget t m a
w)) VtyWidgetCtx t
ctx

-- | Sets up the top-level context for a 'VtyWidget' and runs it with that context
mainWidgetWithHandle
  :: V.Vty
  -> (forall t m. (MonadVtyApp t m, MonadNodeId m) => VtyWidget t m (Event t ()))
  -> IO ()
mainWidgetWithHandle :: Vty
-> (forall t (m :: * -> *).
    (MonadVtyApp t m, MonadNodeId m) =>
    VtyWidget t m (Event t ()))
-> IO ()
mainWidgetWithHandle vty :: Vty
vty child :: forall t (m :: * -> *).
(MonadVtyApp t m, MonadNodeId m) =>
VtyWidget t m (Event t ())
child =
  Vty -> (forall t (m :: * -> *). VtyApp t m) -> IO ()
runVtyAppWithHandle Vty
vty ((forall t (m :: * -> *). VtyApp t m) -> IO ())
-> (forall t (m :: * -> *). VtyApp t m) -> IO ()
forall a b. (a -> b) -> a -> b
$ \dr0 :: DisplayRegion
dr0 inp :: Event t VtyEvent
inp -> do
    Dynamic t DisplayRegion
size <- DisplayRegion
-> Event t DisplayRegion -> m (Dynamic t DisplayRegion)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn DisplayRegion
dr0 (Event t DisplayRegion -> m (Dynamic t DisplayRegion))
-> Event t DisplayRegion -> m (Dynamic t DisplayRegion)
forall a b. (a -> b) -> a -> b
$ Event t VtyEvent
-> (VtyEvent -> Maybe DisplayRegion) -> Event t DisplayRegion
forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe Event t VtyEvent
inp ((VtyEvent -> Maybe DisplayRegion) -> Event t DisplayRegion)
-> (VtyEvent -> Maybe DisplayRegion) -> Event t DisplayRegion
forall a b. (a -> b) -> a -> b
$ \case
      V.EvResize w :: Int
w h :: Int
h -> DisplayRegion -> Maybe DisplayRegion
forall a. a -> Maybe a
Just (Int
w, Int
h)
      _ -> Maybe DisplayRegion
forall a. Maybe a
Nothing
    let inp' :: Event t VtyEvent
inp' = Event t VtyEvent
-> (VtyEvent -> Maybe VtyEvent) -> Event t VtyEvent
forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe Event t VtyEvent
inp ((VtyEvent -> Maybe VtyEvent) -> Event t VtyEvent)
-> (VtyEvent -> Maybe VtyEvent) -> Event t VtyEvent
forall a b. (a -> b) -> a -> b
$ \case
          V.EvResize {} -> Maybe VtyEvent
forall a. Maybe a
Nothing
          x :: VtyEvent
x -> VtyEvent -> Maybe VtyEvent
forall a. a -> Maybe a
Just VtyEvent
x
    let ctx :: VtyWidgetCtx t
ctx = VtyWidgetCtx :: forall t.
Dynamic t Int
-> Dynamic t Int
-> Dynamic t Bool
-> Event t VtyEvent
-> VtyWidgetCtx t
VtyWidgetCtx
          { _vtyWidgetCtx_width :: Dynamic t Int
_vtyWidgetCtx_width = (DisplayRegion -> Int) -> Dynamic t DisplayRegion -> Dynamic t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DisplayRegion -> Int
forall a b. (a, b) -> a
fst Dynamic t DisplayRegion
size
          , _vtyWidgetCtx_height :: Dynamic t Int
_vtyWidgetCtx_height = (DisplayRegion -> Int) -> Dynamic t DisplayRegion -> Dynamic t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DisplayRegion -> Int
forall a b. (a, b) -> b
snd Dynamic t DisplayRegion
size
          , _vtyWidgetCtx_input :: Event t VtyEvent
_vtyWidgetCtx_input = Event t VtyEvent
inp'
          , _vtyWidgetCtx_focus :: Dynamic t Bool
_vtyWidgetCtx_focus = Bool -> Dynamic t Bool
forall k (t :: k) a. Reflex t => a -> Dynamic t a
constDyn Bool
True
          }
    (shutdown :: Event t ()
shutdown, images :: Behavior t [Image]
images) <- NodeIdT m (Event t (), Behavior t [Image])
-> m (Event t (), Behavior t [Image])
forall (m :: * -> *) a. MonadIO m => NodeIdT m a -> m a
runNodeIdT (NodeIdT m (Event t (), Behavior t [Image])
 -> m (Event t (), Behavior t [Image]))
-> NodeIdT m (Event t (), Behavior t [Image])
-> m (Event t (), Behavior t [Image])
forall a b. (a -> b) -> a -> b
$ VtyWidgetCtx t
-> VtyWidget t (NodeIdT m) (Event t ())
-> NodeIdT m (Event t (), Behavior t [Image])
forall t (m :: * -> *) a.
(Reflex t, MonadNodeId m) =>
VtyWidgetCtx t -> VtyWidget t m a -> m (a, Behavior t [Image])
runVtyWidget VtyWidgetCtx t
ctx (VtyWidget t (NodeIdT m) (Event t ())
 -> NodeIdT m (Event t (), Behavior t [Image]))
-> VtyWidget t (NodeIdT m) (Event t ())
-> NodeIdT m (Event t (), Behavior t [Image])
forall a b. (a -> b) -> a -> b
$ do
      Behavior t [Image] -> VtyWidget t (NodeIdT m) ()
forall t (m :: * -> *).
ImageWriter t m =>
Behavior t [Image] -> m ()
tellImages (Behavior t [Image] -> VtyWidget t (NodeIdT m) ())
-> ((DisplayRegion -> [Image]) -> Behavior t [Image])
-> (DisplayRegion -> [Image])
-> VtyWidget t (NodeIdT m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior t DisplayRegion
-> (DisplayRegion -> [Image]) -> Behavior t [Image]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (Dynamic t DisplayRegion -> Behavior t DisplayRegion
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t DisplayRegion
size) ((DisplayRegion -> [Image]) -> VtyWidget t (NodeIdT m) ())
-> (DisplayRegion -> [Image]) -> VtyWidget t (NodeIdT m) ()
forall a b. (a -> b) -> a -> b
$ \(w :: Int
w, h :: Int
h) -> [Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
V.charFill Attr
V.defAttr ' ' Int
w Int
h]
      VtyWidget t (NodeIdT m) (Event t ())
forall t (m :: * -> *).
(MonadVtyApp t m, MonadNodeId m) =>
VtyWidget t m (Event t ())
child
    VtyResult t -> m (VtyResult t)
forall (m :: * -> *) a. Monad m => a -> m a
return (VtyResult t -> m (VtyResult t)) -> VtyResult t -> m (VtyResult t)
forall a b. (a -> b) -> a -> b
$ VtyResult :: forall t. Behavior t Picture -> Event t () -> VtyResult t
VtyResult
      { _vtyResult_picture :: Behavior t Picture
_vtyResult_picture = ([Image] -> Picture) -> Behavior t [Image] -> Behavior t Picture
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Image] -> Picture
V.picForLayers ([Image] -> Picture) -> ([Image] -> [Image]) -> [Image] -> Picture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Image] -> [Image]
forall a. [a] -> [a]
reverse) Behavior t [Image]
images
      , _vtyResult_shutdown :: Event t ()
_vtyResult_shutdown = Event t ()
shutdown
      }

-- | Like 'mainWidgetWithHandle', but uses a default vty configuration
mainWidget
  :: (forall t m. (MonadVtyApp t m, MonadNodeId m) => VtyWidget t m (Event t ()))
  -> IO ()
mainWidget :: (forall t (m :: * -> *).
 (MonadVtyApp t m, MonadNodeId m) =>
 VtyWidget t m (Event t ()))
-> IO ()
mainWidget child :: forall t (m :: * -> *).
(MonadVtyApp t m, MonadNodeId m) =>
VtyWidget t m (Event t ())
child = do
  Vty
vty <- IO Vty
getDefaultVty
  Vty
-> (forall t (m :: * -> *).
    (MonadVtyApp t m, MonadNodeId m) =>
    VtyWidget t m (Event t ()))
-> IO ()
mainWidgetWithHandle Vty
vty forall t (m :: * -> *).
(MonadVtyApp t m, MonadNodeId m) =>
VtyWidget t m (Event t ())
child

-- | A class for things that know their own display size dimensions
class (Reflex t, Monad m) => HasDisplaySize t m | m -> t where
  -- | Retrieve the display width (columns)
  displayWidth :: m (Dynamic t Int)
  default displayWidth :: (f m' ~ m, MonadTrans f, HasDisplaySize t m') => m (Dynamic t Int)
  displayWidth = m' (Dynamic t Int) -> f m' (Dynamic t Int)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m' (Dynamic t Int)
forall t (m :: * -> *). HasDisplaySize t m => m (Dynamic t Int)
displayWidth
  -- | Retrieve the display height (rows)
  displayHeight :: m (Dynamic t Int)
  default displayHeight :: (f m' ~ m, MonadTrans f, HasDisplaySize t m') => m (Dynamic t Int)
  displayHeight = m' (Dynamic t Int) -> f m' (Dynamic t Int)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m' (Dynamic t Int)
forall t (m :: * -> *). HasDisplaySize t m => m (Dynamic t Int)
displayHeight

instance (Reflex t, Monad m) => HasDisplaySize t (VtyWidget t m) where
  displayWidth :: VtyWidget t m (Dynamic t Int)
displayWidth = BehaviorWriterT
  t [Image] (ReaderT (VtyWidgetCtx t) m) (Dynamic t Int)
-> VtyWidget t m (Dynamic t Int)
forall t (m :: * -> *) a.
BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
-> VtyWidget t m a
VtyWidget (BehaviorWriterT
   t [Image] (ReaderT (VtyWidgetCtx t) m) (Dynamic t Int)
 -> VtyWidget t m (Dynamic t Int))
-> (ReaderT (VtyWidgetCtx t) m (Dynamic t Int)
    -> BehaviorWriterT
         t [Image] (ReaderT (VtyWidgetCtx t) m) (Dynamic t Int))
-> ReaderT (VtyWidgetCtx t) m (Dynamic t Int)
-> VtyWidget t m (Dynamic t Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT (VtyWidgetCtx t) m (Dynamic t Int)
-> BehaviorWriterT
     t [Image] (ReaderT (VtyWidgetCtx t) m) (Dynamic t Int)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (VtyWidgetCtx t) m (Dynamic t Int)
 -> VtyWidget t m (Dynamic t Int))
-> ReaderT (VtyWidgetCtx t) m (Dynamic t Int)
-> VtyWidget t m (Dynamic t Int)
forall a b. (a -> b) -> a -> b
$ (VtyWidgetCtx t -> Dynamic t Int)
-> ReaderT (VtyWidgetCtx t) m (Dynamic t Int)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks VtyWidgetCtx t -> Dynamic t Int
forall t. VtyWidgetCtx t -> Dynamic t Int
_vtyWidgetCtx_width
  displayHeight :: VtyWidget t m (Dynamic t Int)
displayHeight = BehaviorWriterT
  t [Image] (ReaderT (VtyWidgetCtx t) m) (Dynamic t Int)
-> VtyWidget t m (Dynamic t Int)
forall t (m :: * -> *) a.
BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
-> VtyWidget t m a
VtyWidget (BehaviorWriterT
   t [Image] (ReaderT (VtyWidgetCtx t) m) (Dynamic t Int)
 -> VtyWidget t m (Dynamic t Int))
-> (ReaderT (VtyWidgetCtx t) m (Dynamic t Int)
    -> BehaviorWriterT
         t [Image] (ReaderT (VtyWidgetCtx t) m) (Dynamic t Int))
-> ReaderT (VtyWidgetCtx t) m (Dynamic t Int)
-> VtyWidget t m (Dynamic t Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT (VtyWidgetCtx t) m (Dynamic t Int)
-> BehaviorWriterT
     t [Image] (ReaderT (VtyWidgetCtx t) m) (Dynamic t Int)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (VtyWidgetCtx t) m (Dynamic t Int)
 -> VtyWidget t m (Dynamic t Int))
-> ReaderT (VtyWidgetCtx t) m (Dynamic t Int)
-> VtyWidget t m (Dynamic t Int)
forall a b. (a -> b) -> a -> b
$ (VtyWidgetCtx t -> Dynamic t Int)
-> ReaderT (VtyWidgetCtx t) m (Dynamic t Int)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks VtyWidgetCtx t -> Dynamic t Int
forall t. VtyWidgetCtx t -> Dynamic t Int
_vtyWidgetCtx_height

instance HasDisplaySize t m => HasDisplaySize t (ReaderT x m)
instance HasDisplaySize t m => HasDisplaySize t (BehaviorWriterT t x m)
instance HasDisplaySize t m => HasDisplaySize t (DynamicWriterT t x m)
instance HasDisplaySize t m => HasDisplaySize t (EventWriterT t x m)

instance HasDisplaySize t m => HasDisplaySize t (NodeIdT m)

-- | A class for things that can receive vty events as input
class HasVtyInput t m | m -> t where
  input :: m (Event t VtyEvent)

instance (Reflex t, Monad m) => HasVtyInput t (VtyWidget t m) where
  input :: VtyWidget t m (Event t VtyEvent)
input = BehaviorWriterT
  t [Image] (ReaderT (VtyWidgetCtx t) m) (Event t VtyEvent)
-> VtyWidget t m (Event t VtyEvent)
forall t (m :: * -> *) a.
BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
-> VtyWidget t m a
VtyWidget (BehaviorWriterT
   t [Image] (ReaderT (VtyWidgetCtx t) m) (Event t VtyEvent)
 -> VtyWidget t m (Event t VtyEvent))
-> (ReaderT (VtyWidgetCtx t) m (Event t VtyEvent)
    -> BehaviorWriterT
         t [Image] (ReaderT (VtyWidgetCtx t) m) (Event t VtyEvent))
-> ReaderT (VtyWidgetCtx t) m (Event t VtyEvent)
-> VtyWidget t m (Event t VtyEvent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT (VtyWidgetCtx t) m (Event t VtyEvent)
-> BehaviorWriterT
     t [Image] (ReaderT (VtyWidgetCtx t) m) (Event t VtyEvent)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (VtyWidgetCtx t) m (Event t VtyEvent)
 -> VtyWidget t m (Event t VtyEvent))
-> ReaderT (VtyWidgetCtx t) m (Event t VtyEvent)
-> VtyWidget t m (Event t VtyEvent)
forall a b. (a -> b) -> a -> b
$ (VtyWidgetCtx t -> Event t VtyEvent)
-> ReaderT (VtyWidgetCtx t) m (Event t VtyEvent)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks VtyWidgetCtx t -> Event t VtyEvent
forall t. VtyWidgetCtx t -> Event t VtyEvent
_vtyWidgetCtx_input

-- | A class for things that can dynamically gain and lose focus
class HasFocus t m | m -> t where
  focus :: m (Dynamic t Bool)

instance (Reflex t, Monad m) => HasFocus t (VtyWidget t m) where
  focus :: VtyWidget t m (Dynamic t Bool)
focus = BehaviorWriterT
  t [Image] (ReaderT (VtyWidgetCtx t) m) (Dynamic t Bool)
-> VtyWidget t m (Dynamic t Bool)
forall t (m :: * -> *) a.
BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
-> VtyWidget t m a
VtyWidget (BehaviorWriterT
   t [Image] (ReaderT (VtyWidgetCtx t) m) (Dynamic t Bool)
 -> VtyWidget t m (Dynamic t Bool))
-> (ReaderT (VtyWidgetCtx t) m (Dynamic t Bool)
    -> BehaviorWriterT
         t [Image] (ReaderT (VtyWidgetCtx t) m) (Dynamic t Bool))
-> ReaderT (VtyWidgetCtx t) m (Dynamic t Bool)
-> VtyWidget t m (Dynamic t Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT (VtyWidgetCtx t) m (Dynamic t Bool)
-> BehaviorWriterT
     t [Image] (ReaderT (VtyWidgetCtx t) m) (Dynamic t Bool)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (VtyWidgetCtx t) m (Dynamic t Bool)
 -> VtyWidget t m (Dynamic t Bool))
-> ReaderT (VtyWidgetCtx t) m (Dynamic t Bool)
-> VtyWidget t m (Dynamic t Bool)
forall a b. (a -> b) -> a -> b
$ (VtyWidgetCtx t -> Dynamic t Bool)
-> ReaderT (VtyWidgetCtx t) m (Dynamic t Bool)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks VtyWidgetCtx t -> Dynamic t Bool
forall t. VtyWidgetCtx t -> Dynamic t Bool
_vtyWidgetCtx_focus

-- | A class for widgets that can produce images to draw to the display
class (Reflex t, Monad m) => ImageWriter t m | m -> t where
  -- | Send images upstream for rendering
  tellImages :: Behavior t [Image] -> m ()

instance (Monad m, Reflex t) => ImageWriter t (BehaviorWriterT t [Image] m) where
  tellImages :: Behavior t [Image] -> BehaviorWriterT t [Image] m ()
tellImages = Behavior t [Image] -> BehaviorWriterT t [Image] m ()
forall t w (m :: * -> *).
BehaviorWriter t w m =>
Behavior t w -> m ()
tellBehavior

-- | A chunk of the display area
data Region = Region
  { Region -> Int
_region_left :: Int
  , Region -> Int
_region_top :: Int
  , Region -> Int
_region_width :: Int
  , Region -> Int
_region_height :: Int
  }
  deriving (Int -> Region -> ShowS
[Region] -> ShowS
Region -> String
(Int -> Region -> ShowS)
-> (Region -> String) -> ([Region] -> ShowS) -> Show Region
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Region] -> ShowS
$cshowList :: [Region] -> ShowS
show :: Region -> String
$cshow :: Region -> String
showsPrec :: Int -> Region -> ShowS
$cshowsPrec :: Int -> Region -> ShowS
Show, ReadPrec [Region]
ReadPrec Region
Int -> ReadS Region
ReadS [Region]
(Int -> ReadS Region)
-> ReadS [Region]
-> ReadPrec Region
-> ReadPrec [Region]
-> Read Region
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Region]
$creadListPrec :: ReadPrec [Region]
readPrec :: ReadPrec Region
$creadPrec :: ReadPrec Region
readList :: ReadS [Region]
$creadList :: ReadS [Region]
readsPrec :: Int -> ReadS Region
$creadsPrec :: Int -> ReadS Region
Read, Region -> Region -> Bool
(Region -> Region -> Bool)
-> (Region -> Region -> Bool) -> Eq Region
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Region -> Region -> Bool
$c/= :: Region -> Region -> Bool
== :: Region -> Region -> Bool
$c== :: Region -> Region -> Bool
Eq, Eq Region
Eq Region =>
(Region -> Region -> Ordering)
-> (Region -> Region -> Bool)
-> (Region -> Region -> Bool)
-> (Region -> Region -> Bool)
-> (Region -> Region -> Bool)
-> (Region -> Region -> Region)
-> (Region -> Region -> Region)
-> Ord Region
Region -> Region -> Bool
Region -> Region -> Ordering
Region -> Region -> Region
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Region -> Region -> Region
$cmin :: Region -> Region -> Region
max :: Region -> Region -> Region
$cmax :: Region -> Region -> Region
>= :: Region -> Region -> Bool
$c>= :: Region -> Region -> Bool
> :: Region -> Region -> Bool
$c> :: Region -> Region -> Bool
<= :: Region -> Region -> Bool
$c<= :: Region -> Region -> Bool
< :: Region -> Region -> Bool
$c< :: Region -> Region -> Bool
compare :: Region -> Region -> Ordering
$ccompare :: Region -> Region -> Ordering
$cp1Ord :: Eq Region
Ord)

-- | A dynamic chunk of the display area
data DynRegion t = DynRegion
  { DynRegion t -> Dynamic t Int
_dynRegion_left :: Dynamic t Int
  , DynRegion t -> Dynamic t Int
_dynRegion_top :: Dynamic t Int
  , DynRegion t -> Dynamic t Int
_dynRegion_width :: Dynamic t Int
  , DynRegion t -> Dynamic t Int
_dynRegion_height :: Dynamic t Int
  }

-- | The width and height of a 'Region'
regionSize :: Region -> (Int, Int)
regionSize :: Region -> DisplayRegion
regionSize (Region _ _ w :: Int
w h :: Int
h) = (Int
w, Int
h)

-- | Produces an 'Image' that fills a region with space characters
regionBlankImage :: Region -> Image
regionBlankImage :: Region -> Image
regionBlankImage r :: Region
r@(Region _ _ width :: Int
width height :: Int
height) =
  Region -> Image -> Image
withinImage Region
r (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$ Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
V.charFill Attr
V.defAttr ' ' Int
width Int
height

-- | A behavior of the current display area represented by a 'DynRegion'
currentRegion :: Reflex t => DynRegion t -> Behavior t Region
currentRegion :: DynRegion t -> Behavior t Region
currentRegion (DynRegion l :: Dynamic t Int
l t :: Dynamic t Int
t w :: Dynamic t Int
w h :: Dynamic t Int
h) = Int -> Int -> Int -> Int -> Region
Region (Int -> Int -> Int -> Int -> Region)
-> Behavior t Int -> Behavior t (Int -> Int -> Int -> Region)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Int -> Behavior t Int
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Int
l Behavior t (Int -> Int -> Int -> Region)
-> Behavior t Int -> Behavior t (Int -> Int -> Region)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Int -> Behavior t Int
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Int
t Behavior t (Int -> Int -> Region)
-> Behavior t Int -> Behavior t (Int -> Region)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Int -> Behavior t Int
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Int
w Behavior t (Int -> Region) -> Behavior t Int -> Behavior t Region
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Int -> Behavior t Int
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Int
h

-- | Translates and crops an 'Image' so that it is contained by
-- the given 'Region'.
withinImage
  :: Region
  -> Image
  -> Image
withinImage :: Region -> Image -> Image
withinImage (Region left :: Int
left top :: Int
top width :: Int
width height :: Int
height)
  | Int
width Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
|| Int
height Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = Region -> Image -> Image
withinImage (Int -> Int -> Int -> Int -> Region
Region Int
left Int
top 0 0)
  | Bool
otherwise = Int -> Int -> Image -> Image
V.translate Int
left Int
top (Image -> Image) -> (Image -> Image) -> Image -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Image -> Image
V.crop Int
width Int
height

-- | Low-level widget combinator that runs a child 'VtyWidget' within
-- a given region and context. This widget filters and modifies the input
-- that the child widget receives such that:
-- * unfocused widgets receive no key events
-- * mouse inputs outside the region are ignored
-- * mouse inputs inside the region have their coordinates translated such
--   that (0,0) is the top-left corner of the region
pane
  :: (Reflex t, Monad m, MonadNodeId m)
  => DynRegion t
  -> Dynamic t Bool -- ^ Whether the widget should be focused when the parent is.
  -> VtyWidget t m a
  -> VtyWidget t m a
pane :: DynRegion t -> Dynamic t Bool -> VtyWidget t m a -> VtyWidget t m a
pane dr :: DynRegion t
dr foc :: Dynamic t Bool
foc child :: VtyWidget t m a
child = BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
-> VtyWidget t m a
forall t (m :: * -> *) a.
BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
-> VtyWidget t m a
VtyWidget (BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
 -> VtyWidget t m a)
-> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
-> VtyWidget t m a
forall a b. (a -> b) -> a -> b
$ do
  VtyWidgetCtx t
ctx <- ReaderT (VtyWidgetCtx t) m (VtyWidgetCtx t)
-> BehaviorWriterT
     t [Image] (ReaderT (VtyWidgetCtx t) m) (VtyWidgetCtx t)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT (VtyWidgetCtx t) m (VtyWidgetCtx t)
forall r (m :: * -> *). MonadReader r m => m r
ask
  let reg :: Behavior t Region
reg = DynRegion t -> Behavior t Region
forall t. Reflex t => DynRegion t -> Behavior t Region
currentRegion DynRegion t
dr
  let ctx' :: VtyWidgetCtx t
ctx' = VtyWidgetCtx :: forall t.
Dynamic t Int
-> Dynamic t Int
-> Dynamic t Bool
-> Event t VtyEvent
-> VtyWidgetCtx t
VtyWidgetCtx
        { _vtyWidgetCtx_input :: Event t VtyEvent
_vtyWidgetCtx_input = [Event t VtyEvent] -> Event t VtyEvent
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost -- TODO: think about this leftmost more.
            [ (Maybe VtyEvent -> Maybe VtyEvent)
-> Event t (Maybe VtyEvent) -> Event t VtyEvent
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe Maybe VtyEvent -> Maybe VtyEvent
forall a. a -> a
id (Event t (Maybe VtyEvent) -> Event t VtyEvent)
-> Event t (Maybe VtyEvent) -> Event t VtyEvent
forall a b. (a -> b) -> a -> b
$
                ((Region, Bool) -> VtyEvent -> Maybe VtyEvent)
-> Behavior t (Region, Bool)
-> Event t VtyEvent
-> Event t (Maybe VtyEvent)
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> c) -> Behavior t a -> Event t b -> Event t c
attachWith (\(r :: Region
r,f :: Bool
f) e :: VtyEvent
e -> Region -> Bool -> VtyEvent -> Maybe VtyEvent
filterInput Region
r Bool
f VtyEvent
e)
                  ((Region -> Bool -> (Region, Bool))
-> Behavior t Region
-> Behavior t Bool
-> Behavior t (Region, Bool)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) Behavior t Region
reg (Dynamic t Bool -> Behavior t Bool
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Bool
foc))
                  (VtyWidgetCtx t -> Event t VtyEvent
forall t. VtyWidgetCtx t -> Event t VtyEvent
_vtyWidgetCtx_input VtyWidgetCtx t
ctx)
            ]
        , _vtyWidgetCtx_focus :: Dynamic t Bool
_vtyWidgetCtx_focus = (Bool -> Bool -> Bool)
-> Dynamic t Bool -> Dynamic t Bool -> Dynamic t Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) (VtyWidgetCtx t -> Dynamic t Bool
forall t. VtyWidgetCtx t -> Dynamic t Bool
_vtyWidgetCtx_focus VtyWidgetCtx t
ctx) Dynamic t Bool
foc
        , _vtyWidgetCtx_width :: Dynamic t Int
_vtyWidgetCtx_width = DynRegion t -> Dynamic t Int
forall t. DynRegion t -> Dynamic t Int
_dynRegion_width DynRegion t
dr
        , _vtyWidgetCtx_height :: Dynamic t Int
_vtyWidgetCtx_height = DynRegion t -> Dynamic t Int
forall t. DynRegion t -> Dynamic t Int
_dynRegion_height DynRegion t
dr
        }
  (result :: a
result, images :: Behavior t [Image]
images) <- ReaderT (VtyWidgetCtx t) m (a, Behavior t [Image])
-> BehaviorWriterT
     t [Image] (ReaderT (VtyWidgetCtx t) m) (a, Behavior t [Image])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (VtyWidgetCtx t) m (a, Behavior t [Image])
 -> BehaviorWriterT
      t [Image] (ReaderT (VtyWidgetCtx t) m) (a, Behavior t [Image]))
-> (m (a, Behavior t [Image])
    -> ReaderT (VtyWidgetCtx t) m (a, Behavior t [Image]))
-> m (a, Behavior t [Image])
-> BehaviorWriterT
     t [Image] (ReaderT (VtyWidgetCtx t) m) (a, Behavior t [Image])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (a, Behavior t [Image])
-> ReaderT (VtyWidgetCtx t) m (a, Behavior t [Image])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (a, Behavior t [Image])
 -> BehaviorWriterT
      t [Image] (ReaderT (VtyWidgetCtx t) m) (a, Behavior t [Image]))
-> m (a, Behavior t [Image])
-> BehaviorWriterT
     t [Image] (ReaderT (VtyWidgetCtx t) m) (a, Behavior t [Image])
forall a b. (a -> b) -> a -> b
$ VtyWidgetCtx t -> VtyWidget t m a -> m (a, Behavior t [Image])
forall t (m :: * -> *) a.
(Reflex t, MonadNodeId m) =>
VtyWidgetCtx t -> VtyWidget t m a -> m (a, Behavior t [Image])
runVtyWidget VtyWidgetCtx t
ctx' VtyWidget t m a
child
  let images' :: Behavior t [Image]
images' = (Region -> [Image] -> [Image])
-> Behavior t Region -> Behavior t [Image] -> Behavior t [Image]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\r :: Region
r is :: [Image]
is -> (Image -> Image) -> [Image] -> [Image]
forall a b. (a -> b) -> [a] -> [b]
map (Region -> Image -> Image
withinImage Region
r) [Image]
is) Behavior t Region
reg Behavior t [Image]
images
  Behavior t [Image]
-> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) ()
forall t (m :: * -> *).
ImageWriter t m =>
Behavior t [Image] -> m ()
tellImages Behavior t [Image]
images'
  a -> BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
  where
    filterInput :: Region -> Bool -> VtyEvent -> Maybe VtyEvent
    filterInput :: Region -> Bool -> VtyEvent -> Maybe VtyEvent
filterInput (Region l :: Int
l t :: Int
t w :: Int
w h :: Int
h) focused :: Bool
focused e :: VtyEvent
e = case VtyEvent
e of
      V.EvKey _ _ | Bool -> Bool
not Bool
focused -> Maybe VtyEvent
forall a. Maybe a
Nothing
      V.EvMouseDown x :: Int
x y :: Int
y btn :: Button
btn m :: [Modifier]
m -> (Int -> Int -> VtyEvent) -> Int -> Int -> Maybe VtyEvent
mouse (\u :: Int
u v :: Int
v -> Int -> Int -> Button -> [Modifier] -> VtyEvent
V.EvMouseDown Int
u Int
v Button
btn [Modifier]
m) Int
x Int
y
      V.EvMouseUp x :: Int
x y :: Int
y btn :: Maybe Button
btn -> (Int -> Int -> VtyEvent) -> Int -> Int -> Maybe VtyEvent
mouse (\u :: Int
u v :: Int
v -> Int -> Int -> Maybe Button -> VtyEvent
V.EvMouseUp Int
u Int
v Maybe Button
btn) Int
x Int
y
      _ -> VtyEvent -> Maybe VtyEvent
forall a. a -> Maybe a
Just VtyEvent
e
      where
        mouse :: (Int -> Int -> VtyEvent) -> Int -> Int -> Maybe VtyEvent
mouse con :: Int -> Int -> VtyEvent
con x :: Int
x y :: Int
y
          | [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [ Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l
               , Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
t
               , Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w
               , Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
h ] = Maybe VtyEvent
forall a. Maybe a
Nothing
          | Bool
otherwise =
            VtyEvent -> Maybe VtyEvent
forall a. a -> Maybe a
Just (Int -> Int -> VtyEvent
con (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
t))

-- | Information about a drag operation
data Drag = Drag
  { Drag -> DisplayRegion
_drag_from :: (Int, Int) -- ^ Where the drag began
  , Drag -> DisplayRegion
_drag_to :: (Int, Int) -- ^ Where the mouse currently is
  , Drag -> Button
_drag_button :: V.Button -- ^ Which mouse button is dragging
  , Drag -> [Modifier]
_drag_modifiers :: [V.Modifier] -- ^ What modifiers are held
  , Drag -> Bool
_drag_end :: Bool -- ^ Whether the drag ended (the mouse button was released)
  }
  deriving (Drag -> Drag -> Bool
(Drag -> Drag -> Bool) -> (Drag -> Drag -> Bool) -> Eq Drag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Drag -> Drag -> Bool
$c/= :: Drag -> Drag -> Bool
== :: Drag -> Drag -> Bool
$c== :: Drag -> Drag -> Bool
Eq, Eq Drag
Eq Drag =>
(Drag -> Drag -> Ordering)
-> (Drag -> Drag -> Bool)
-> (Drag -> Drag -> Bool)
-> (Drag -> Drag -> Bool)
-> (Drag -> Drag -> Bool)
-> (Drag -> Drag -> Drag)
-> (Drag -> Drag -> Drag)
-> Ord Drag
Drag -> Drag -> Bool
Drag -> Drag -> Ordering
Drag -> Drag -> Drag
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Drag -> Drag -> Drag
$cmin :: Drag -> Drag -> Drag
max :: Drag -> Drag -> Drag
$cmax :: Drag -> Drag -> Drag
>= :: Drag -> Drag -> Bool
$c>= :: Drag -> Drag -> Bool
> :: Drag -> Drag -> Bool
$c> :: Drag -> Drag -> Bool
<= :: Drag -> Drag -> Bool
$c<= :: Drag -> Drag -> Bool
< :: Drag -> Drag -> Bool
$c< :: Drag -> Drag -> Bool
compare :: Drag -> Drag -> Ordering
$ccompare :: Drag -> Drag -> Ordering
$cp1Ord :: Eq Drag
Ord, Int -> Drag -> ShowS
[Drag] -> ShowS
Drag -> String
(Int -> Drag -> ShowS)
-> (Drag -> String) -> ([Drag] -> ShowS) -> Show Drag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Drag] -> ShowS
$cshowList :: [Drag] -> ShowS
show :: Drag -> String
$cshow :: Drag -> String
showsPrec :: Int -> Drag -> ShowS
$cshowsPrec :: Int -> Drag -> ShowS
Show)

-- | Converts raw vty mouse drag events into an event stream of 'Drag's
drag
  :: (Reflex t, MonadFix m, MonadHold t m)
  => V.Button
  -> VtyWidget t m (Event t Drag)
drag :: Button -> VtyWidget t m (Event t Drag)
drag btn :: Button
btn = do
  Event t VtyEvent
inp <- VtyWidget t m (Event t VtyEvent)
forall t (m :: * -> *). HasVtyInput t m => m (Event t VtyEvent)
input
  let f :: Maybe Drag -> V.Event -> Maybe Drag
      f :: Maybe Drag -> VtyEvent -> Maybe Drag
f Nothing = \case
        V.EvMouseDown x :: Int
x y :: Int
y btn' :: Button
btn' mods :: [Modifier]
mods
          | Button
btn Button -> Button -> Bool
forall a. Eq a => a -> a -> Bool
== Button
btn' -> Drag -> Maybe Drag
forall a. a -> Maybe a
Just (Drag -> Maybe Drag) -> Drag -> Maybe Drag
forall a b. (a -> b) -> a -> b
$ DisplayRegion
-> DisplayRegion -> Button -> [Modifier] -> Bool -> Drag
Drag (Int
x,Int
y) (Int
x,Int
y) Button
btn' [Modifier]
mods Bool
False
          | Bool
otherwise   -> Maybe Drag
forall a. Maybe a
Nothing
        _ -> Maybe Drag
forall a. Maybe a
Nothing
      f (Just (Drag from :: DisplayRegion
from _ _ mods :: [Modifier]
mods end :: Bool
end)) = \case
        V.EvMouseDown x :: Int
x y :: Int
y btn' :: Button
btn' mods' :: [Modifier]
mods'
          | Bool
end Bool -> Bool -> Bool
&& Button
btn Button -> Button -> Bool
forall a. Eq a => a -> a -> Bool
== Button
btn'  -> Drag -> Maybe Drag
forall a. a -> Maybe a
Just (Drag -> Maybe Drag) -> Drag -> Maybe Drag
forall a b. (a -> b) -> a -> b
$ DisplayRegion
-> DisplayRegion -> Button -> [Modifier] -> Bool -> Drag
Drag (Int
x,Int
y) (Int
x,Int
y) Button
btn' [Modifier]
mods' Bool
False
          | Button
btn Button -> Button -> Bool
forall a. Eq a => a -> a -> Bool
== Button
btn'         -> Drag -> Maybe Drag
forall a. a -> Maybe a
Just (Drag -> Maybe Drag) -> Drag -> Maybe Drag
forall a b. (a -> b) -> a -> b
$ DisplayRegion
-> DisplayRegion -> Button -> [Modifier] -> Bool -> Drag
Drag DisplayRegion
from (Int
x,Int
y) Button
btn [Modifier]
mods' Bool
False
          | Bool
otherwise           -> Maybe Drag
forall a. Maybe a
Nothing -- Ignore other buttons.
        V.EvMouseUp x :: Int
x y :: Int
y (Just btn' :: Button
btn')
          | Bool
end         -> Maybe Drag
forall a. Maybe a
Nothing
          | Button
btn Button -> Button -> Bool
forall a. Eq a => a -> a -> Bool
== Button
btn' -> Drag -> Maybe Drag
forall a. a -> Maybe a
Just (Drag -> Maybe Drag) -> Drag -> Maybe Drag
forall a b. (a -> b) -> a -> b
$ DisplayRegion
-> DisplayRegion -> Button -> [Modifier] -> Bool -> Drag
Drag DisplayRegion
from (Int
x,Int
y) Button
btn [Modifier]
mods Bool
True
          | Bool
otherwise   -> Maybe Drag
forall a. Maybe a
Nothing
        V.EvMouseUp x :: Int
x y :: Int
y Nothing -- Terminal doesn't specify mouse up button,
                                -- assume it's the right one.
          | Bool
end       -> Maybe Drag
forall a. Maybe a
Nothing
          | Bool
otherwise -> Drag -> Maybe Drag
forall a. a -> Maybe a
Just (Drag -> Maybe Drag) -> Drag -> Maybe Drag
forall a b. (a -> b) -> a -> b
$ DisplayRegion
-> DisplayRegion -> Button -> [Modifier] -> Bool -> Drag
Drag DisplayRegion
from (Int
x,Int
y) Button
btn [Modifier]
mods Bool
True
        _ -> Maybe Drag
forall a. Maybe a
Nothing
  rec let newDrag :: Event t Drag
newDrag = (Maybe Drag -> VtyEvent -> Maybe Drag)
-> Behavior t (Maybe Drag) -> Event t VtyEvent -> Event t Drag
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
attachWithMaybe Maybe Drag -> VtyEvent -> Maybe Drag
f (Dynamic t (Maybe Drag) -> Behavior t (Maybe Drag)
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (Maybe Drag)
dragD) Event t VtyEvent
inp
      Dynamic t (Maybe Drag)
dragD <- Maybe Drag
-> Event t (Maybe Drag) -> VtyWidget t m (Dynamic t (Maybe Drag))
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Maybe Drag
forall a. Maybe a
Nothing (Event t (Maybe Drag) -> VtyWidget t m (Dynamic t (Maybe Drag)))
-> Event t (Maybe Drag) -> VtyWidget t m (Dynamic t (Maybe Drag))
forall a b. (a -> b) -> a -> b
$ Drag -> Maybe Drag
forall a. a -> Maybe a
Just (Drag -> Maybe Drag) -> Event t Drag -> Event t (Maybe Drag)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t Drag
newDrag
  Event t Drag -> VtyWidget t m (Event t Drag)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe Drag -> Maybe Drag) -> Event t (Maybe Drag) -> Event t Drag
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe Maybe Drag -> Maybe Drag
forall a. a -> a
id (Event t (Maybe Drag) -> Event t Drag)
-> Event t (Maybe Drag) -> Event t Drag
forall a b. (a -> b) -> a -> b
$ Dynamic t (Maybe Drag) -> Event t (Maybe Drag)
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (Maybe Drag)
dragD)

-- | Mouse down events for a particular mouse button
mouseDown
  :: (Reflex t, Monad m)
  => V.Button
  -> VtyWidget t m (Event t MouseDown)
mouseDown :: Button -> VtyWidget t m (Event t MouseDown)
mouseDown btn :: Button
btn = do
  Event t VtyEvent
i <- VtyWidget t m (Event t VtyEvent)
forall t (m :: * -> *). HasVtyInput t m => m (Event t VtyEvent)
input
  Event t MouseDown -> VtyWidget t m (Event t MouseDown)
forall (m :: * -> *) a. Monad m => a -> m a
return (Event t MouseDown -> VtyWidget t m (Event t MouseDown))
-> Event t MouseDown -> VtyWidget t m (Event t MouseDown)
forall a b. (a -> b) -> a -> b
$ Event t VtyEvent
-> (VtyEvent -> Maybe MouseDown) -> Event t MouseDown
forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe Event t VtyEvent
i ((VtyEvent -> Maybe MouseDown) -> Event t MouseDown)
-> (VtyEvent -> Maybe MouseDown) -> Event t MouseDown
forall a b. (a -> b) -> a -> b
$ \case
    V.EvMouseDown x :: Int
x y :: Int
y btn' :: Button
btn' mods :: [Modifier]
mods -> if Button
btn Button -> Button -> Bool
forall a. Eq a => a -> a -> Bool
== Button
btn'
      then MouseDown -> Maybe MouseDown
forall a. a -> Maybe a
Just (MouseDown -> Maybe MouseDown) -> MouseDown -> Maybe MouseDown
forall a b. (a -> b) -> a -> b
$ Button -> DisplayRegion -> [Modifier] -> MouseDown
MouseDown Button
btn' (Int
x, Int
y) [Modifier]
mods
      else Maybe MouseDown
forall a. Maybe a
Nothing
    _ -> Maybe MouseDown
forall a. Maybe a
Nothing

-- | Mouse up events for a particular mouse button
mouseUp
  :: (Reflex t, Monad m)
  => VtyWidget t m (Event t MouseUp)
mouseUp :: VtyWidget t m (Event t MouseUp)
mouseUp = do
  Event t VtyEvent
i <- VtyWidget t m (Event t VtyEvent)
forall t (m :: * -> *). HasVtyInput t m => m (Event t VtyEvent)
input
  Event t MouseUp -> VtyWidget t m (Event t MouseUp)
forall (m :: * -> *) a. Monad m => a -> m a
return (Event t MouseUp -> VtyWidget t m (Event t MouseUp))
-> Event t MouseUp -> VtyWidget t m (Event t MouseUp)
forall a b. (a -> b) -> a -> b
$ Event t VtyEvent -> (VtyEvent -> Maybe MouseUp) -> Event t MouseUp
forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe Event t VtyEvent
i ((VtyEvent -> Maybe MouseUp) -> Event t MouseUp)
-> (VtyEvent -> Maybe MouseUp) -> Event t MouseUp
forall a b. (a -> b) -> a -> b
$ \case
    V.EvMouseUp x :: Int
x y :: Int
y btn' :: Maybe Button
btn' -> MouseUp -> Maybe MouseUp
forall a. a -> Maybe a
Just (MouseUp -> Maybe MouseUp) -> MouseUp -> Maybe MouseUp
forall a b. (a -> b) -> a -> b
$ Maybe Button -> DisplayRegion -> MouseUp
MouseUp Maybe Button
btn' (Int
x, Int
y)
    _ -> Maybe MouseUp
forall a. Maybe a
Nothing

-- | Information about a mouse down event
data MouseDown = MouseDown
  { MouseDown -> Button
_mouseDown_button :: V.Button
  , MouseDown -> DisplayRegion
_mouseDown_coordinates :: (Int, Int)
  , MouseDown -> [Modifier]
_mouseDown_modifiers :: [V.Modifier]
  }
  deriving (MouseDown -> MouseDown -> Bool
(MouseDown -> MouseDown -> Bool)
-> (MouseDown -> MouseDown -> Bool) -> Eq MouseDown
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MouseDown -> MouseDown -> Bool
$c/= :: MouseDown -> MouseDown -> Bool
== :: MouseDown -> MouseDown -> Bool
$c== :: MouseDown -> MouseDown -> Bool
Eq, Eq MouseDown
Eq MouseDown =>
(MouseDown -> MouseDown -> Ordering)
-> (MouseDown -> MouseDown -> Bool)
-> (MouseDown -> MouseDown -> Bool)
-> (MouseDown -> MouseDown -> Bool)
-> (MouseDown -> MouseDown -> Bool)
-> (MouseDown -> MouseDown -> MouseDown)
-> (MouseDown -> MouseDown -> MouseDown)
-> Ord MouseDown
MouseDown -> MouseDown -> Bool
MouseDown -> MouseDown -> Ordering
MouseDown -> MouseDown -> MouseDown
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MouseDown -> MouseDown -> MouseDown
$cmin :: MouseDown -> MouseDown -> MouseDown
max :: MouseDown -> MouseDown -> MouseDown
$cmax :: MouseDown -> MouseDown -> MouseDown
>= :: MouseDown -> MouseDown -> Bool
$c>= :: MouseDown -> MouseDown -> Bool
> :: MouseDown -> MouseDown -> Bool
$c> :: MouseDown -> MouseDown -> Bool
<= :: MouseDown -> MouseDown -> Bool
$c<= :: MouseDown -> MouseDown -> Bool
< :: MouseDown -> MouseDown -> Bool
$c< :: MouseDown -> MouseDown -> Bool
compare :: MouseDown -> MouseDown -> Ordering
$ccompare :: MouseDown -> MouseDown -> Ordering
$cp1Ord :: Eq MouseDown
Ord, Int -> MouseDown -> ShowS
[MouseDown] -> ShowS
MouseDown -> String
(Int -> MouseDown -> ShowS)
-> (MouseDown -> String)
-> ([MouseDown] -> ShowS)
-> Show MouseDown
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MouseDown] -> ShowS
$cshowList :: [MouseDown] -> ShowS
show :: MouseDown -> String
$cshow :: MouseDown -> String
showsPrec :: Int -> MouseDown -> ShowS
$cshowsPrec :: Int -> MouseDown -> ShowS
Show)

-- | Information about a mouse up event
data MouseUp = MouseUp
  { MouseUp -> Maybe Button
_mouseUp_button :: Maybe V.Button
  , MouseUp -> DisplayRegion
_mouseUp_coordinates :: (Int, Int)
  }
  deriving (MouseUp -> MouseUp -> Bool
(MouseUp -> MouseUp -> Bool)
-> (MouseUp -> MouseUp -> Bool) -> Eq MouseUp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MouseUp -> MouseUp -> Bool
$c/= :: MouseUp -> MouseUp -> Bool
== :: MouseUp -> MouseUp -> Bool
$c== :: MouseUp -> MouseUp -> Bool
Eq, Eq MouseUp
Eq MouseUp =>
(MouseUp -> MouseUp -> Ordering)
-> (MouseUp -> MouseUp -> Bool)
-> (MouseUp -> MouseUp -> Bool)
-> (MouseUp -> MouseUp -> Bool)
-> (MouseUp -> MouseUp -> Bool)
-> (MouseUp -> MouseUp -> MouseUp)
-> (MouseUp -> MouseUp -> MouseUp)
-> Ord MouseUp
MouseUp -> MouseUp -> Bool
MouseUp -> MouseUp -> Ordering
MouseUp -> MouseUp -> MouseUp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MouseUp -> MouseUp -> MouseUp
$cmin :: MouseUp -> MouseUp -> MouseUp
max :: MouseUp -> MouseUp -> MouseUp
$cmax :: MouseUp -> MouseUp -> MouseUp
>= :: MouseUp -> MouseUp -> Bool
$c>= :: MouseUp -> MouseUp -> Bool
> :: MouseUp -> MouseUp -> Bool
$c> :: MouseUp -> MouseUp -> Bool
<= :: MouseUp -> MouseUp -> Bool
$c<= :: MouseUp -> MouseUp -> Bool
< :: MouseUp -> MouseUp -> Bool
$c< :: MouseUp -> MouseUp -> Bool
compare :: MouseUp -> MouseUp -> Ordering
$ccompare :: MouseUp -> MouseUp -> Ordering
$cp1Ord :: Eq MouseUp
Ord, Int -> MouseUp -> ShowS
[MouseUp] -> ShowS
MouseUp -> String
(Int -> MouseUp -> ShowS)
-> (MouseUp -> String) -> ([MouseUp] -> ShowS) -> Show MouseUp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MouseUp] -> ShowS
$cshowList :: [MouseUp] -> ShowS
show :: MouseUp -> String
$cshow :: MouseUp -> String
showsPrec :: Int -> MouseUp -> ShowS
$cshowsPrec :: Int -> MouseUp -> ShowS
Show)

-- | Mouse scroll direction
data ScrollDirection = ScrollDirection_Up | ScrollDirection_Down
  deriving (ScrollDirection -> ScrollDirection -> Bool
(ScrollDirection -> ScrollDirection -> Bool)
-> (ScrollDirection -> ScrollDirection -> Bool)
-> Eq ScrollDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScrollDirection -> ScrollDirection -> Bool
$c/= :: ScrollDirection -> ScrollDirection -> Bool
== :: ScrollDirection -> ScrollDirection -> Bool
$c== :: ScrollDirection -> ScrollDirection -> Bool
Eq, Eq ScrollDirection
Eq ScrollDirection =>
(ScrollDirection -> ScrollDirection -> Ordering)
-> (ScrollDirection -> ScrollDirection -> Bool)
-> (ScrollDirection -> ScrollDirection -> Bool)
-> (ScrollDirection -> ScrollDirection -> Bool)
-> (ScrollDirection -> ScrollDirection -> Bool)
-> (ScrollDirection -> ScrollDirection -> ScrollDirection)
-> (ScrollDirection -> ScrollDirection -> ScrollDirection)
-> Ord ScrollDirection
ScrollDirection -> ScrollDirection -> Bool
ScrollDirection -> ScrollDirection -> Ordering
ScrollDirection -> ScrollDirection -> ScrollDirection
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ScrollDirection -> ScrollDirection -> ScrollDirection
$cmin :: ScrollDirection -> ScrollDirection -> ScrollDirection
max :: ScrollDirection -> ScrollDirection -> ScrollDirection
$cmax :: ScrollDirection -> ScrollDirection -> ScrollDirection
>= :: ScrollDirection -> ScrollDirection -> Bool
$c>= :: ScrollDirection -> ScrollDirection -> Bool
> :: ScrollDirection -> ScrollDirection -> Bool
$c> :: ScrollDirection -> ScrollDirection -> Bool
<= :: ScrollDirection -> ScrollDirection -> Bool
$c<= :: ScrollDirection -> ScrollDirection -> Bool
< :: ScrollDirection -> ScrollDirection -> Bool
$c< :: ScrollDirection -> ScrollDirection -> Bool
compare :: ScrollDirection -> ScrollDirection -> Ordering
$ccompare :: ScrollDirection -> ScrollDirection -> Ordering
$cp1Ord :: Eq ScrollDirection
Ord, Int -> ScrollDirection -> ShowS
[ScrollDirection] -> ShowS
ScrollDirection -> String
(Int -> ScrollDirection -> ShowS)
-> (ScrollDirection -> String)
-> ([ScrollDirection] -> ShowS)
-> Show ScrollDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScrollDirection] -> ShowS
$cshowList :: [ScrollDirection] -> ShowS
show :: ScrollDirection -> String
$cshow :: ScrollDirection -> String
showsPrec :: Int -> ScrollDirection -> ShowS
$cshowsPrec :: Int -> ScrollDirection -> ShowS
Show)

-- | Produce an event that fires when the mouse wheel is scrolled
mouseScroll
  :: (Reflex t, Monad m)
  => VtyWidget t m (Event t ScrollDirection)
mouseScroll :: VtyWidget t m (Event t ScrollDirection)
mouseScroll = do
  Event t MouseDown
up <- Button -> VtyWidget t m (Event t MouseDown)
forall t (m :: * -> *).
(Reflex t, Monad m) =>
Button -> VtyWidget t m (Event t MouseDown)
mouseDown Button
V.BScrollUp
  Event t MouseDown
down <- Button -> VtyWidget t m (Event t MouseDown)
forall t (m :: * -> *).
(Reflex t, Monad m) =>
Button -> VtyWidget t m (Event t MouseDown)
mouseDown Button
V.BScrollDown
  Event t ScrollDirection -> VtyWidget t m (Event t ScrollDirection)
forall (m :: * -> *) a. Monad m => a -> m a
return (Event t ScrollDirection
 -> VtyWidget t m (Event t ScrollDirection))
-> Event t ScrollDirection
-> VtyWidget t m (Event t ScrollDirection)
forall a b. (a -> b) -> a -> b
$ [Event t ScrollDirection] -> Event t ScrollDirection
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
    [ ScrollDirection
ScrollDirection_Up ScrollDirection -> Event t MouseDown -> Event t ScrollDirection
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t MouseDown
up
    , ScrollDirection
ScrollDirection_Down ScrollDirection -> Event t MouseDown -> Event t ScrollDirection
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t MouseDown
down
    ]

-- | Type synonym for a key and modifier combination
type KeyCombo = (V.Key, [V.Modifier])

-- | Emits an event that fires on a particular key press (without modifiers)
key :: (Monad m, Reflex t) => V.Key -> VtyWidget t m (Event t KeyCombo)
key :: Key -> VtyWidget t m (Event t KeyCombo)
key = Set KeyCombo -> VtyWidget t m (Event t KeyCombo)
forall t (m :: * -> *).
(Reflex t, Monad m) =>
Set KeyCombo -> VtyWidget t m (Event t KeyCombo)
keyCombos (Set KeyCombo -> VtyWidget t m (Event t KeyCombo))
-> (Key -> Set KeyCombo) -> Key -> VtyWidget t m (Event t KeyCombo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyCombo -> Set KeyCombo
forall a. a -> Set a
Set.singleton (KeyCombo -> Set KeyCombo)
-> (Key -> KeyCombo) -> Key -> Set KeyCombo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,[])

-- | Emits an event that fires on particular key presses (without modifiers)
keys :: (Monad m, Reflex t) => [V.Key] -> VtyWidget t m (Event t KeyCombo)
keys :: [Key] -> VtyWidget t m (Event t KeyCombo)
keys = Set KeyCombo -> VtyWidget t m (Event t KeyCombo)
forall t (m :: * -> *).
(Reflex t, Monad m) =>
Set KeyCombo -> VtyWidget t m (Event t KeyCombo)
keyCombos (Set KeyCombo -> VtyWidget t m (Event t KeyCombo))
-> ([Key] -> Set KeyCombo)
-> [Key]
-> VtyWidget t m (Event t KeyCombo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [KeyCombo] -> Set KeyCombo
forall a. Ord a => [a] -> Set a
Set.fromList ([KeyCombo] -> Set KeyCombo)
-> ([Key] -> [KeyCombo]) -> [Key] -> Set KeyCombo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key -> KeyCombo) -> [Key] -> [KeyCombo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,[])

-- | Emit an event that fires whenever the provided key combination occurs
keyCombo
  :: (Reflex t, Monad m)
  => KeyCombo
  -> VtyWidget t m (Event t KeyCombo)
keyCombo :: KeyCombo -> VtyWidget t m (Event t KeyCombo)
keyCombo = Set KeyCombo -> VtyWidget t m (Event t KeyCombo)
forall t (m :: * -> *).
(Reflex t, Monad m) =>
Set KeyCombo -> VtyWidget t m (Event t KeyCombo)
keyCombos (Set KeyCombo -> VtyWidget t m (Event t KeyCombo))
-> (KeyCombo -> Set KeyCombo)
-> KeyCombo
-> VtyWidget t m (Event t KeyCombo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyCombo -> Set KeyCombo
forall a. a -> Set a
Set.singleton

-- | Emit an event that fires whenever any of the provided key combinations occur
keyCombos
  :: (Reflex t, Monad m)
  => Set KeyCombo
  -> VtyWidget t m (Event t KeyCombo)
keyCombos :: Set KeyCombo -> VtyWidget t m (Event t KeyCombo)
keyCombos ks :: Set KeyCombo
ks = do
  Event t VtyEvent
i <- VtyWidget t m (Event t VtyEvent)
forall t (m :: * -> *). HasVtyInput t m => m (Event t VtyEvent)
input
  Event t KeyCombo -> VtyWidget t m (Event t KeyCombo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Event t KeyCombo -> VtyWidget t m (Event t KeyCombo))
-> Event t KeyCombo -> VtyWidget t m (Event t KeyCombo)
forall a b. (a -> b) -> a -> b
$ Event t VtyEvent
-> (VtyEvent -> Maybe KeyCombo) -> Event t KeyCombo
forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe Event t VtyEvent
i ((VtyEvent -> Maybe KeyCombo) -> Event t KeyCombo)
-> (VtyEvent -> Maybe KeyCombo) -> Event t KeyCombo
forall a b. (a -> b) -> a -> b
$ \case
    V.EvKey k :: Key
k m :: [Modifier]
m -> if KeyCombo -> Set KeyCombo -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (Key
k, [Modifier]
m) Set KeyCombo
ks
      then KeyCombo -> Maybe KeyCombo
forall a. a -> Maybe a
Just (Key
k, [Modifier]
m)
      else Maybe KeyCombo
forall a. Maybe a
Nothing
    _ -> Maybe KeyCombo
forall a. Maybe a
Nothing

-- | A plain split of the available space into vertically stacked panes.
-- No visual separator is built in here.
splitV :: (Reflex t, Monad m, MonadNodeId m)
       => Dynamic t (Int -> Int)
       -- ^ Function used to determine size of first pane based on available size
       -> Dynamic t (Bool, Bool)
       -- ^ How to focus the two sub-panes, given that we are focused.
       -> VtyWidget t m a
       -- ^ Widget for first pane
       -> VtyWidget t m b
       -- ^ Widget for second pane
       -> VtyWidget t m (a,b)
splitV :: Dynamic t (Int -> Int)
-> Dynamic t (Bool, Bool)
-> VtyWidget t m a
-> VtyWidget t m b
-> VtyWidget t m (a, b)
splitV sizeFunD :: Dynamic t (Int -> Int)
sizeFunD focD :: Dynamic t (Bool, Bool)
focD wA :: VtyWidget t m a
wA wB :: VtyWidget t m b
wB = do
  Dynamic t Int
dw <- VtyWidget t m (Dynamic t Int)
forall t (m :: * -> *). HasDisplaySize t m => m (Dynamic t Int)
displayWidth
  Dynamic t Int
dh <- VtyWidget t m (Dynamic t Int)
forall t (m :: * -> *). HasDisplaySize t m => m (Dynamic t Int)
displayHeight
  let regA :: DynRegion t
regA = DynRegion :: forall t.
Dynamic t Int
-> Dynamic t Int -> Dynamic t Int -> Dynamic t Int -> DynRegion t
DynRegion
        { _dynRegion_left :: Dynamic t Int
_dynRegion_left = Int -> Dynamic t Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure 0
        , _dynRegion_top :: Dynamic t Int
_dynRegion_top = Int -> Dynamic t Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure 0
        , _dynRegion_width :: Dynamic t Int
_dynRegion_width = Dynamic t Int
dw
        , _dynRegion_height :: Dynamic t Int
_dynRegion_height = Dynamic t (Int -> Int)
sizeFunD Dynamic t (Int -> Int) -> Dynamic t Int -> Dynamic t Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Int
dh
        }
      regB :: DynRegion t
regB = DynRegion :: forall t.
Dynamic t Int
-> Dynamic t Int -> Dynamic t Int -> Dynamic t Int -> DynRegion t
DynRegion
        { _dynRegion_left :: Dynamic t Int
_dynRegion_left = Int -> Dynamic t Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure 0
        , _dynRegion_top :: Dynamic t Int
_dynRegion_top = DynRegion t -> Dynamic t Int
forall t. DynRegion t -> Dynamic t Int
_dynRegion_height DynRegion t
regA
        , _dynRegion_width :: Dynamic t Int
_dynRegion_width = Dynamic t Int
dw
        , _dynRegion_height :: Dynamic t Int
_dynRegion_height = (Int -> Int -> Int)
-> Dynamic t Int -> Dynamic t Int -> Dynamic t Int
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-) Dynamic t Int
dh (DynRegion t -> Dynamic t Int
forall t. DynRegion t -> Dynamic t Int
_dynRegion_height DynRegion t
regA)
        }
  a
ra <- DynRegion t -> Dynamic t Bool -> VtyWidget t m a -> VtyWidget t m a
forall t (m :: * -> *) a.
(Reflex t, Monad m, MonadNodeId m) =>
DynRegion t -> Dynamic t Bool -> VtyWidget t m a -> VtyWidget t m a
pane DynRegion t
regA ((Bool, Bool) -> Bool
forall a b. (a, b) -> a
fst ((Bool, Bool) -> Bool) -> Dynamic t (Bool, Bool) -> Dynamic t Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (Bool, Bool)
focD) VtyWidget t m a
wA
  b
rb <- DynRegion t -> Dynamic t Bool -> VtyWidget t m b -> VtyWidget t m b
forall t (m :: * -> *) a.
(Reflex t, Monad m, MonadNodeId m) =>
DynRegion t -> Dynamic t Bool -> VtyWidget t m a -> VtyWidget t m a
pane DynRegion t
regB ((Bool, Bool) -> Bool
forall a b. (a, b) -> b
snd ((Bool, Bool) -> Bool) -> Dynamic t (Bool, Bool) -> Dynamic t Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (Bool, Bool)
focD) VtyWidget t m b
wB
  (a, b) -> VtyWidget t m (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
ra,b
rb)

-- | A plain split of the available space into horizontally stacked panes.
-- No visual separator is built in here.
splitH :: (Reflex t, Monad m, MonadNodeId m)
       => Dynamic t (Int -> Int)
       -- ^ Function used to determine size of first pane based on available size
       -> Dynamic t (Bool, Bool)
       -- ^ How to focus the two sub-panes, given that we are focused.
       -> VtyWidget t m a
       -- ^ Widget for first pane
       -> VtyWidget t m b
       -- ^ Widget for second pane
       -> VtyWidget t m (a,b)
splitH :: Dynamic t (Int -> Int)
-> Dynamic t (Bool, Bool)
-> VtyWidget t m a
-> VtyWidget t m b
-> VtyWidget t m (a, b)
splitH sizeFunD :: Dynamic t (Int -> Int)
sizeFunD focD :: Dynamic t (Bool, Bool)
focD wA :: VtyWidget t m a
wA wB :: VtyWidget t m b
wB = do
  Dynamic t Int
dw <- VtyWidget t m (Dynamic t Int)
forall t (m :: * -> *). HasDisplaySize t m => m (Dynamic t Int)
displayWidth
  Dynamic t Int
dh <- VtyWidget t m (Dynamic t Int)
forall t (m :: * -> *). HasDisplaySize t m => m (Dynamic t Int)
displayHeight
  let regA :: DynRegion t
regA = DynRegion :: forall t.
Dynamic t Int
-> Dynamic t Int -> Dynamic t Int -> Dynamic t Int -> DynRegion t
DynRegion
        { _dynRegion_left :: Dynamic t Int
_dynRegion_left   = Int -> Dynamic t Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure 0
        , _dynRegion_top :: Dynamic t Int
_dynRegion_top    = Int -> Dynamic t Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure 0
        , _dynRegion_width :: Dynamic t Int
_dynRegion_width  = Dynamic t (Int -> Int)
sizeFunD Dynamic t (Int -> Int) -> Dynamic t Int -> Dynamic t Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Int
dw
        , _dynRegion_height :: Dynamic t Int
_dynRegion_height = Dynamic t Int
dh
        }
      regB :: DynRegion t
regB = DynRegion :: forall t.
Dynamic t Int
-> Dynamic t Int -> Dynamic t Int -> Dynamic t Int -> DynRegion t
DynRegion
        { _dynRegion_left :: Dynamic t Int
_dynRegion_left   = DynRegion t -> Dynamic t Int
forall t. DynRegion t -> Dynamic t Int
_dynRegion_width DynRegion t
regA
        , _dynRegion_top :: Dynamic t Int
_dynRegion_top    = Int -> Dynamic t Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure 0
        , _dynRegion_width :: Dynamic t Int
_dynRegion_width  = (Int -> Int -> Int)
-> Dynamic t Int -> Dynamic t Int -> Dynamic t Int
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-) Dynamic t Int
dw (DynRegion t -> Dynamic t Int
forall t. DynRegion t -> Dynamic t Int
_dynRegion_width DynRegion t
regA)
        , _dynRegion_height :: Dynamic t Int
_dynRegion_height = Dynamic t Int
dh
        }
  (a -> b -> (a, b))
-> VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m (a, b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (DynRegion t -> Dynamic t Bool -> VtyWidget t m a -> VtyWidget t m a
forall t (m :: * -> *) a.
(Reflex t, Monad m, MonadNodeId m) =>
DynRegion t -> Dynamic t Bool -> VtyWidget t m a -> VtyWidget t m a
pane DynRegion t
regA (((Bool, Bool) -> Bool) -> Dynamic t (Bool, Bool) -> Dynamic t Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool, Bool) -> Bool
forall a b. (a, b) -> a
fst Dynamic t (Bool, Bool)
focD) VtyWidget t m a
wA) (DynRegion t -> Dynamic t Bool -> VtyWidget t m b -> VtyWidget t m b
forall t (m :: * -> *) a.
(Reflex t, Monad m, MonadNodeId m) =>
DynRegion t -> Dynamic t Bool -> VtyWidget t m a -> VtyWidget t m a
pane DynRegion t
regB (((Bool, Bool) -> Bool) -> Dynamic t (Bool, Bool) -> Dynamic t Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool, Bool) -> Bool
forall a b. (a, b) -> b
snd Dynamic t (Bool, Bool)
focD) VtyWidget t m b
wB)

-- | A split of the available space into two parts with a draggable separator.
-- Starts with half the space allocated to each, and the first pane has focus.
-- Clicking in a pane switches focus.
splitVDrag :: (Reflex t, MonadFix m, MonadHold t m, MonadNodeId m)
  => VtyWidget t m ()
  -> VtyWidget t m a
  -> VtyWidget t m b
  -> VtyWidget t m (a,b)
splitVDrag :: VtyWidget t m ()
-> VtyWidget t m a -> VtyWidget t m b -> VtyWidget t m (a, b)
splitVDrag wS :: VtyWidget t m ()
wS wA :: VtyWidget t m a
wA wB :: VtyWidget t m b
wB = do
  Dynamic t Int
dh <- VtyWidget t m (Dynamic t Int)
forall t (m :: * -> *). HasDisplaySize t m => m (Dynamic t Int)
displayHeight
  Dynamic t Int
dw <- VtyWidget t m (Dynamic t Int)
forall t (m :: * -> *). HasDisplaySize t m => m (Dynamic t Int)
displayWidth
  Int
h0 <- Behavior t Int -> VtyWidget t m Int
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Behavior t Int -> VtyWidget t m Int)
-> Behavior t Int -> VtyWidget t m Int
forall a b. (a -> b) -> a -> b
$ Dynamic t Int -> Behavior t Int
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Int
dh -- TODO
  Event t Drag
dragE <- Button -> VtyWidget t m (Event t Drag)
forall t (m :: * -> *).
(Reflex t, MonadFix m, MonadHold t m) =>
Button -> VtyWidget t m (Event t Drag)
drag Button
V.BLeft
  let splitter0 :: Int
splitter0 = Int
h0 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2
  rec Dynamic t Int
splitterCheckpoint <- Int -> Event t Int -> VtyWidget t m (Dynamic t Int)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Int
splitter0 (Event t Int -> VtyWidget t m (Dynamic t Int))
-> Event t Int -> VtyWidget t m (Dynamic t Int)
forall a b. (a -> b) -> a -> b
$ [Event t Int] -> Event t Int
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [(Int, Bool) -> Int
forall a b. (a, b) -> a
fst ((Int, Bool) -> Int) -> Event t (Int, Bool) -> Event t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Int, Bool) -> Bool) -> Event t (Int, Bool) -> Event t (Int, Bool)
forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
ffilter (Int, Bool) -> Bool
forall a b. (a, b) -> b
snd Event t (Int, Bool)
dragSplitter, Event t Int
resizeSplitter]
      Dynamic t Int
splitterPos <- Int -> Event t Int -> VtyWidget t m (Dynamic t Int)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Int
splitter0 (Event t Int -> VtyWidget t m (Dynamic t Int))
-> Event t Int -> VtyWidget t m (Dynamic t Int)
forall a b. (a -> b) -> a -> b
$ [Event t Int] -> Event t Int
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [(Int, Bool) -> Int
forall a b. (a, b) -> a
fst ((Int, Bool) -> Int) -> Event t (Int, Bool) -> Event t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t (Int, Bool)
dragSplitter, Event t Int
resizeSplitter]
      Dynamic t Double
splitterFrac <- Double -> Event t Double -> VtyWidget t m (Dynamic t Double)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn ((1::Double) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 2) (Event t Double -> VtyWidget t m (Dynamic t Double))
-> Event t Double -> VtyWidget t m (Dynamic t Double)
forall a b. (a -> b) -> a -> b
$ Event t DisplayRegion
-> (DisplayRegion -> Double) -> Event t Double
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (Behavior t Int -> Event t Int -> Event t DisplayRegion
forall k (t :: k) a b.
Reflex t =>
Behavior t a -> Event t b -> Event t (a, b)
attach (Dynamic t Int -> Behavior t Int
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Int
dh) ((Int, Bool) -> Int
forall a b. (a, b) -> a
fst ((Int, Bool) -> Int) -> Event t (Int, Bool) -> Event t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t (Int, Bool)
dragSplitter)) ((DisplayRegion -> Double) -> Event t Double)
-> (DisplayRegion -> Double) -> Event t Double
forall a b. (a -> b) -> a -> b
$ \(h :: Int
h, x :: Int
x) ->
        Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double -> Double
forall a. Ord a => a -> a -> a
max 1 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
      let dragSplitter :: Event t (Int, Bool)
dragSplitter = Event t (Int, Drag)
-> ((Int, Drag) -> Maybe (Int, Bool)) -> Event t (Int, Bool)
forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe (Behavior t Int -> Event t Drag -> Event t (Int, Drag)
forall k (t :: k) a b.
Reflex t =>
Behavior t a -> Event t b -> Event t (a, b)
attach (Dynamic t Int -> Behavior t Int
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Int
splitterCheckpoint) Event t Drag
dragE) (((Int, Drag) -> Maybe (Int, Bool)) -> Event t (Int, Bool))
-> ((Int, Drag) -> Maybe (Int, Bool)) -> Event t (Int, Bool)
forall a b. (a -> b) -> a -> b
$
            \(splitterY :: Int
splitterY, Drag (_, fromY :: Int
fromY) (_, toY :: Int
toY) _ _ end :: Bool
end) ->
              if Int
splitterY Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
fromY then (Int, Bool) -> Maybe (Int, Bool)
forall a. a -> Maybe a
Just (Int
toY, Bool
end) else Maybe (Int, Bool)
forall a. Maybe a
Nothing
          regA :: DynRegion t
regA = Dynamic t Int
-> Dynamic t Int -> Dynamic t Int -> Dynamic t Int -> DynRegion t
forall t.
Dynamic t Int
-> Dynamic t Int -> Dynamic t Int -> Dynamic t Int -> DynRegion t
DynRegion 0 0 Dynamic t Int
dw Dynamic t Int
splitterPos
          regS :: DynRegion t
regS = Dynamic t Int
-> Dynamic t Int -> Dynamic t Int -> Dynamic t Int -> DynRegion t
forall t.
Dynamic t Int
-> Dynamic t Int -> Dynamic t Int -> Dynamic t Int -> DynRegion t
DynRegion 0 Dynamic t Int
splitterPos Dynamic t Int
dw 1
          regB :: DynRegion t
regB = Dynamic t Int
-> Dynamic t Int -> Dynamic t Int -> Dynamic t Int -> DynRegion t
forall t.
Dynamic t Int
-> Dynamic t Int -> Dynamic t Int -> Dynamic t Int -> DynRegion t
DynRegion 0 (Dynamic t Int
splitterPos Dynamic t Int -> Dynamic t Int -> Dynamic t Int
forall a. Num a => a -> a -> a
+ 1) Dynamic t Int
dw (Dynamic t Int
dh Dynamic t Int -> Dynamic t Int -> Dynamic t Int
forall a. Num a => a -> a -> a
- Dynamic t Int
splitterPos Dynamic t Int -> Dynamic t Int -> Dynamic t Int
forall a. Num a => a -> a -> a
- 1)
          resizeSplitter :: Event t Int
resizeSplitter = Event t (Double, Int) -> ((Double, Int) -> Int) -> Event t Int
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (Behavior t Double -> Event t Int -> Event t (Double, Int)
forall k (t :: k) a b.
Reflex t =>
Behavior t a -> Event t b -> Event t (a, b)
attach (Dynamic t Double -> Behavior t Double
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Double
splitterFrac) (Dynamic t Int -> Event t Int
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t Int
dh)) (((Double, Int) -> Int) -> Event t Int)
-> ((Double, Int) -> Int) -> Event t Int
forall a b. (a -> b) -> a -> b
$
            \(frac :: Double
frac, h :: Int
h) -> Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
frac Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
      Dynamic t Bool
focA <- Bool -> Event t Bool -> VtyWidget t m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Bool
True (Event t Bool -> VtyWidget t m (Dynamic t Bool))
-> Event t Bool -> VtyWidget t m (Dynamic t Bool)
forall a b. (a -> b) -> a -> b
$ [Event t Bool] -> Event t Bool
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
        [ Bool
True Bool -> Event t MouseDown -> Event t Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t MouseDown
mA
        , Bool
False Bool -> Event t MouseDown -> Event t Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t MouseDown
mB
        ]
      (mA :: Event t MouseDown
mA, rA :: a
rA) <- DynRegion t
-> Dynamic t Bool
-> VtyWidget t m (Event t MouseDown, a)
-> VtyWidget t m (Event t MouseDown, a)
forall t (m :: * -> *) a.
(Reflex t, Monad m, MonadNodeId m) =>
DynRegion t -> Dynamic t Bool -> VtyWidget t m a -> VtyWidget t m a
pane DynRegion t
regA Dynamic t Bool
focA (VtyWidget t m (Event t MouseDown, a)
 -> VtyWidget t m (Event t MouseDown, a))
-> VtyWidget t m (Event t MouseDown, a)
-> VtyWidget t m (Event t MouseDown, a)
forall a b. (a -> b) -> a -> b
$ VtyWidget t m a -> VtyWidget t m (Event t MouseDown, a)
forall t (m :: * -> *) b.
(Reflex t, Monad m) =>
VtyWidget t m b -> VtyWidget t m (Event t MouseDown, b)
withMouseDown VtyWidget t m a
wA
      DynRegion t
-> Dynamic t Bool -> VtyWidget t m () -> VtyWidget t m ()
forall t (m :: * -> *) a.
(Reflex t, Monad m, MonadNodeId m) =>
DynRegion t -> Dynamic t Bool -> VtyWidget t m a -> VtyWidget t m a
pane DynRegion t
regS (Bool -> Dynamic t Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) VtyWidget t m ()
wS
      (mB :: Event t MouseDown
mB, rB :: b
rB) <- DynRegion t
-> Dynamic t Bool
-> VtyWidget t m (Event t MouseDown, b)
-> VtyWidget t m (Event t MouseDown, b)
forall t (m :: * -> *) a.
(Reflex t, Monad m, MonadNodeId m) =>
DynRegion t -> Dynamic t Bool -> VtyWidget t m a -> VtyWidget t m a
pane DynRegion t
regB (Bool -> Bool
not (Bool -> Bool) -> Dynamic t Bool -> Dynamic t Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Bool
focA) (VtyWidget t m (Event t MouseDown, b)
 -> VtyWidget t m (Event t MouseDown, b))
-> VtyWidget t m (Event t MouseDown, b)
-> VtyWidget t m (Event t MouseDown, b)
forall a b. (a -> b) -> a -> b
$ VtyWidget t m b -> VtyWidget t m (Event t MouseDown, b)
forall t (m :: * -> *) b.
(Reflex t, Monad m) =>
VtyWidget t m b -> VtyWidget t m (Event t MouseDown, b)
withMouseDown VtyWidget t m b
wB
  (a, b) -> VtyWidget t m (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
rA, b
rB)
  where
    withMouseDown :: VtyWidget t m b -> VtyWidget t m (Event t MouseDown, b)
withMouseDown x :: VtyWidget t m b
x = do
      Event t MouseDown
m <- Button -> VtyWidget t m (Event t MouseDown)
forall t (m :: * -> *).
(Reflex t, Monad m) =>
Button -> VtyWidget t m (Event t MouseDown)
mouseDown Button
V.BLeft
      b
x' <- VtyWidget t m b
x
      (Event t MouseDown, b) -> VtyWidget t m (Event t MouseDown, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Event t MouseDown
m, b
x')

-- | Fill the background with a particular character.
fill :: (Reflex t, Monad m) => Char -> VtyWidget t m ()
fill :: Char -> VtyWidget t m ()
fill c :: Char
c = do
  Dynamic t Int
dw <- VtyWidget t m (Dynamic t Int)
forall t (m :: * -> *). HasDisplaySize t m => m (Dynamic t Int)
displayWidth
  Dynamic t Int
dh <- VtyWidget t m (Dynamic t Int)
forall t (m :: * -> *). HasDisplaySize t m => m (Dynamic t Int)
displayHeight
  let fillImg :: Behavior t [Image]
fillImg = Dynamic t [Image] -> Behavior t [Image]
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current (Dynamic t [Image] -> Behavior t [Image])
-> Dynamic t [Image] -> Behavior t [Image]
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> [Image])
-> Dynamic t Int -> Dynamic t Int -> Dynamic t [Image]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\w :: Int
w h :: Int
h -> [Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
V.charFill Attr
V.defAttr Char
c Int
w Int
h]) Dynamic t Int
dw Dynamic t Int
dh
  Behavior t [Image] -> VtyWidget t m ()
forall t (m :: * -> *).
ImageWriter t m =>
Behavior t [Image] -> m ()
tellImages Behavior t [Image]
fillImg

-- | Fill the background with the bottom
hRule :: (Reflex t, Monad m) => BoxStyle -> VtyWidget t m ()
hRule :: BoxStyle -> VtyWidget t m ()
hRule boxStyle :: BoxStyle
boxStyle = Char -> VtyWidget t m ()
forall t (m :: * -> *).
(Reflex t, Monad m) =>
Char -> VtyWidget t m ()
fill (BoxStyle -> Char
_boxStyle_s BoxStyle
boxStyle)

-- | Defines a set of symbols to use to draw the outlines of boxes
-- C.f. https://en.wikipedia.org/wiki/Box-drawing_character
data BoxStyle = BoxStyle
  { BoxStyle -> Char
_boxStyle_nw :: Char
  , BoxStyle -> Char
_boxStyle_n :: Char
  , BoxStyle -> Char
_boxStyle_ne :: Char
  , BoxStyle -> Char
_boxStyle_e :: Char
  , BoxStyle -> Char
_boxStyle_se :: Char
  , BoxStyle -> Char
_boxStyle_s :: Char
  , BoxStyle -> Char
_boxStyle_sw :: Char
  , BoxStyle -> Char
_boxStyle_w :: Char
  }

instance Default BoxStyle where
  def :: BoxStyle
def = BoxStyle
singleBoxStyle

-- | A box style that uses hyphens and pipe characters. Doesn't handle
-- corners very well.
hyphenBoxStyle :: BoxStyle
hyphenBoxStyle :: BoxStyle
hyphenBoxStyle = Char
-> Char -> Char -> Char -> Char -> Char -> Char -> Char -> BoxStyle
BoxStyle '-' '-' '-' '|' '-' '-' '-' '|'

-- | A single line box style
singleBoxStyle :: BoxStyle
singleBoxStyle :: BoxStyle
singleBoxStyle = Char
-> Char -> Char -> Char -> Char -> Char -> Char -> Char -> BoxStyle
BoxStyle '┌' '─' '┐' '│' '┘' '─' '└' '│'

-- | A thick single line box style
thickBoxStyle :: BoxStyle
thickBoxStyle :: BoxStyle
thickBoxStyle = Char
-> Char -> Char -> Char -> Char -> Char -> Char -> Char -> BoxStyle
BoxStyle '┏' '━' '┓' '┃' '┛' '━' '┗' '┃'

-- | A double line box style
doubleBoxStyle :: BoxStyle
doubleBoxStyle :: BoxStyle
doubleBoxStyle = Char
-> Char -> Char -> Char -> Char -> Char -> Char -> Char -> BoxStyle
BoxStyle '╔' '═' '╗' '║' '╝' '═' '╚' '║'

-- | A single line box style with rounded corners
roundedBoxStyle :: BoxStyle
roundedBoxStyle :: BoxStyle
roundedBoxStyle = Char
-> Char -> Char -> Char -> Char -> Char -> Char -> Char -> BoxStyle
BoxStyle '╭' '─' '╮' '│' '╯' '─' '╰' '│'

-- | Draws a titled box in the provided style and a child widget inside of that box
boxTitle :: (Monad m, Reflex t, MonadNodeId m)
    => Behavior t BoxStyle
    -> Text
    -> VtyWidget t m a
    -> VtyWidget t m a
boxTitle :: Behavior t BoxStyle -> Text -> VtyWidget t m a -> VtyWidget t m a
boxTitle boxStyle :: Behavior t BoxStyle
boxStyle title :: Text
title child :: VtyWidget t m a
child = do
  Dynamic t Int
dh <- VtyWidget t m (Dynamic t Int)
forall t (m :: * -> *). HasDisplaySize t m => m (Dynamic t Int)
displayHeight
  Dynamic t Int
dw <- VtyWidget t m (Dynamic t Int)
forall t (m :: * -> *). HasDisplaySize t m => m (Dynamic t Int)
displayWidth
  let boxReg :: DynRegion t
boxReg = Dynamic t Int
-> Dynamic t Int -> Dynamic t Int -> Dynamic t Int -> DynRegion t
forall t.
Dynamic t Int
-> Dynamic t Int -> Dynamic t Int -> Dynamic t Int -> DynRegion t
DynRegion (Int -> Dynamic t Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure 0) (Int -> Dynamic t Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure 0) Dynamic t Int
dw Dynamic t Int
dh
      innerReg :: DynRegion t
innerReg = Dynamic t Int
-> Dynamic t Int -> Dynamic t Int -> Dynamic t Int -> DynRegion t
forall t.
Dynamic t Int
-> Dynamic t Int -> Dynamic t Int -> Dynamic t Int -> DynRegion t
DynRegion (Int -> Dynamic t Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure 1) (Int -> Dynamic t Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure 1) (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract 2 (Int -> Int) -> Dynamic t Int -> Dynamic t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Int
dw) (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract 2 (Int -> Int) -> Dynamic t Int -> Dynamic t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Int
dh)
  Behavior t [Image] -> VtyWidget t m ()
forall t (m :: * -> *).
ImageWriter t m =>
Behavior t [Image] -> m ()
tellImages (BoxStyle -> Region -> [Image]
boxImages (BoxStyle -> Region -> [Image])
-> Behavior t BoxStyle -> Behavior t (Region -> [Image])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t BoxStyle
boxStyle Behavior t (Region -> [Image])
-> Behavior t Region -> Behavior t [Image]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DynRegion t -> Behavior t Region
forall t. Reflex t => DynRegion t -> Behavior t Region
currentRegion DynRegion t
boxReg)
  Behavior t [Image] -> VtyWidget t m ()
forall t (m :: * -> *).
ImageWriter t m =>
Behavior t [Image] -> m ()
tellImages ((Region -> [Image]) -> Behavior t Region -> Behavior t [Image]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\r :: Region
r -> [Region -> Image
regionBlankImage Region
r]) (DynRegion t -> Behavior t Region
forall t. Reflex t => DynRegion t -> Behavior t Region
currentRegion DynRegion t
innerReg))
  DynRegion t -> Dynamic t Bool -> VtyWidget t m a -> VtyWidget t m a
forall t (m :: * -> *) a.
(Reflex t, Monad m, MonadNodeId m) =>
DynRegion t -> Dynamic t Bool -> VtyWidget t m a -> VtyWidget t m a
pane DynRegion t
innerReg (Bool -> Dynamic t Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) VtyWidget t m a
child
  where
    boxImages :: BoxStyle -> Region -> [Image]
    boxImages :: BoxStyle -> Region -> [Image]
boxImages style :: BoxStyle
style (Region left :: Int
left top :: Int
top width :: Int
width height :: Int
height) =
      let right :: Int
right = Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
          bottom :: Int
bottom = Int
top Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
          sides :: [Image]
sides =
            [ Region -> Image -> Image
withinImage (Int -> Int -> Int -> Int -> Region
Region (Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Int
top (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) 1) (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$
                Attr -> Text -> Image
V.text' Attr
V.defAttr (Text -> Image) -> Text -> Image
forall a b. (a -> b) -> a -> b
$
                  Text -> Char -> Int -> Text
hPadText Text
title (BoxStyle -> Char
_boxStyle_n BoxStyle
style) (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2)
            , Region -> Image -> Image
withinImage (Int -> Int -> Int -> Int -> Region
Region Int
right (Int
top Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) 1 (Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2)) (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$
                Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
V.charFill Attr
V.defAttr (BoxStyle -> Char
_boxStyle_e BoxStyle
style) 1 (Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2)
            , Region -> Image -> Image
withinImage (Int -> Int -> Int -> Int -> Region
Region (Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Int
bottom (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) 1) (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$
                Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
V.charFill Attr
V.defAttr (BoxStyle -> Char
_boxStyle_s BoxStyle
style) (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) 1
            , Region -> Image -> Image
withinImage (Int -> Int -> Int -> Int -> Region
Region Int
left (Int
top Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) 1 (Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2)) (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$
                Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
V.charFill Attr
V.defAttr (BoxStyle -> Char
_boxStyle_w BoxStyle
style) 1 (Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2)
            ]
          corners :: [Image]
corners =
            [ Region -> Image -> Image
withinImage (Int -> Int -> Int -> Int -> Region
Region Int
left Int
top 1 1) (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$
                Attr -> Char -> Image
V.char Attr
V.defAttr (BoxStyle -> Char
_boxStyle_nw BoxStyle
style)
            , Region -> Image -> Image
withinImage (Int -> Int -> Int -> Int -> Region
Region Int
right Int
top 1 1) (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$
                Attr -> Char -> Image
V.char Attr
V.defAttr (BoxStyle -> Char
_boxStyle_ne BoxStyle
style)
            , Region -> Image -> Image
withinImage (Int -> Int -> Int -> Int -> Region
Region Int
right Int
bottom 1 1) (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$
                Attr -> Char -> Image
V.char Attr
V.defAttr (BoxStyle -> Char
_boxStyle_se BoxStyle
style)
            , Region -> Image -> Image
withinImage (Int -> Int -> Int -> Int -> Region
Region Int
left Int
bottom 1 1) (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$
                Attr -> Char -> Image
V.char Attr
V.defAttr (BoxStyle -> Char
_boxStyle_sw BoxStyle
style)
            ]
      in [Image]
sides [Image] -> [Image] -> [Image]
forall a. [a] -> [a] -> [a]
++ if Int
width Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 Bool -> Bool -> Bool
&& Int
height Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 then [Image]
corners else []
    hPadText :: T.Text -> Char -> Int -> T.Text
    hPadText :: Text -> Char -> Int -> Text
hPadText t :: Text
t c :: Char
c l :: Int
l = if Int
lt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l
                     then Text
t
                     else Text
left Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
right
      where
        lt :: Int
lt = Text -> Int
T.length Text
t
        delta :: Int
delta = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lt
        mkHalf :: Int -> Text
mkHalf n :: Int
n = Int -> Text -> Text
T.replicate (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2) (Char -> Text
T.singleton Char
c)
        left :: Text
left = Int -> Text
mkHalf (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
delta Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
        right :: Text
right = Int -> Text
mkHalf Int
delta

-- | A box without a title
box :: (Monad m, Reflex t, MonadNodeId m)
    => Behavior t BoxStyle
    -> VtyWidget t m a
    -> VtyWidget t m a
box :: Behavior t BoxStyle -> VtyWidget t m a -> VtyWidget t m a
box boxStyle :: Behavior t BoxStyle
boxStyle = Behavior t BoxStyle -> Text -> VtyWidget t m a -> VtyWidget t m a
forall (m :: * -> *) t a.
(Monad m, Reflex t, MonadNodeId m) =>
Behavior t BoxStyle -> Text -> VtyWidget t m a -> VtyWidget t m a
boxTitle Behavior t BoxStyle
boxStyle Text
forall a. Monoid a => a
mempty

-- | A box whose style is static
boxStatic
  :: (Reflex t, Monad m, MonadNodeId m)
  => BoxStyle
  -> VtyWidget t m a
  -> VtyWidget t m a
boxStatic :: BoxStyle -> VtyWidget t m a -> VtyWidget t m a
boxStatic = Behavior t BoxStyle -> VtyWidget t m a -> VtyWidget t m a
forall (m :: * -> *) t a.
(Monad m, Reflex t, MonadNodeId m) =>
Behavior t BoxStyle -> VtyWidget t m a -> VtyWidget t m a
box (Behavior t BoxStyle -> VtyWidget t m a -> VtyWidget t m a)
-> (BoxStyle -> Behavior t BoxStyle)
-> BoxStyle
-> VtyWidget t m a
-> VtyWidget t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoxStyle -> Behavior t BoxStyle
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Configuration options for displaying "rich" text
data RichTextConfig t = RichTextConfig
  { RichTextConfig t -> Behavior t Attr
_richTextConfig_attributes :: Behavior t V.Attr
  }

instance Reflex t => Default (RichTextConfig t) where
  def :: RichTextConfig t
def = Behavior t Attr -> RichTextConfig t
forall t. Behavior t Attr -> RichTextConfig t
RichTextConfig (Behavior t Attr -> RichTextConfig t)
-> Behavior t Attr -> RichTextConfig t
forall a b. (a -> b) -> a -> b
$ Attr -> Behavior t Attr
forall (f :: * -> *) a. Applicative f => a -> f a
pure Attr
V.defAttr

-- | A widget that displays text with custom time-varying attributes
richText
  :: (Reflex t, Monad m)
  => RichTextConfig t
  -> Behavior t Text
  -> VtyWidget t m ()
richText :: RichTextConfig t -> Behavior t Text -> VtyWidget t m ()
richText cfg :: RichTextConfig t
cfg t :: Behavior t Text
t = do
  Dynamic t Int
dw <- VtyWidget t m (Dynamic t Int)
forall t (m :: * -> *). HasDisplaySize t m => m (Dynamic t Int)
displayWidth
  let img :: Behavior t [Image]
img = (\w :: Int
w a :: Attr
a s :: Text
s -> [Int -> Attr -> Text -> Image
wrapText Int
w Attr
a Text
s])
        (Int -> Attr -> Text -> [Image])
-> Behavior t Int -> Behavior t (Attr -> Text -> [Image])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Int -> Behavior t Int
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Int
dw
        Behavior t (Attr -> Text -> [Image])
-> Behavior t Attr -> Behavior t (Text -> [Image])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RichTextConfig t -> Behavior t Attr
forall t. RichTextConfig t -> Behavior t Attr
_richTextConfig_attributes RichTextConfig t
cfg
        Behavior t (Text -> [Image])
-> Behavior t Text -> Behavior t [Image]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Behavior t Text
t
  Behavior t [Image] -> VtyWidget t m ()
forall t (m :: * -> *).
ImageWriter t m =>
Behavior t [Image] -> m ()
tellImages Behavior t [Image]
img
  where
    wrapText :: Int -> Attr -> Text -> Image
wrapText maxWidth :: Int
maxWidth attrs :: Attr
attrs = [Image] -> Image
V.vertCat
      ([Image] -> Image) -> (Text -> [Image]) -> Text -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Image]) -> [Text] -> [Image]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Text -> Image) -> [Text] -> [Image]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attr -> String -> Image
V.string Attr
attrs (String -> Image) -> (Text -> String) -> Text -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) ([Text] -> [Image]) -> (Text -> [Text]) -> Text -> [Image]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Text -> [Text]
TZ.wrapWithOffset Int
maxWidth 0)
      ([Text] -> [Image]) -> (Text -> [Text]) -> Text -> [Image]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='\n')

-- | Renders text, wrapped to the container width
text
  :: (Reflex t, Monad m)
  => Behavior t Text
  -> VtyWidget t m ()
text :: Behavior t Text -> VtyWidget t m ()
text = RichTextConfig t -> Behavior t Text -> VtyWidget t m ()
forall t (m :: * -> *).
(Reflex t, Monad m) =>
RichTextConfig t -> Behavior t Text -> VtyWidget t m ()
richText RichTextConfig t
forall a. Default a => a
def

-- | Scrollable text widget. The output pair exposes the current scroll position and total number of lines (including those
-- that are hidden)
scrollableText
  :: forall t m. (Reflex t, MonadHold t m, MonadFix m)
  => Event t Int
  -- ^ Number of lines to scroll by
  -> Behavior t Text
  -> VtyWidget t m (Behavior t (Int, Int))
  -- ^ (Current scroll position, total number of lines)
scrollableText :: Event t Int
-> Behavior t Text -> VtyWidget t m (Behavior t DisplayRegion)
scrollableText scrollBy :: Event t Int
scrollBy t :: Behavior t Text
t = do
  Dynamic t Int
dw <- VtyWidget t m (Dynamic t Int)
forall t (m :: * -> *). HasDisplaySize t m => m (Dynamic t Int)
displayWidth
  let imgs :: Behavior t [Image]
imgs = Int -> Text -> [Image]
wrap (Int -> Text -> [Image])
-> Behavior t Int -> Behavior t (Text -> [Image])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Int -> Behavior t Int
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Int
dw Behavior t (Text -> [Image])
-> Behavior t Text -> Behavior t [Image]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Behavior t Text
t
  Event t KeyCombo
kup <- Key -> VtyWidget t m (Event t KeyCombo)
forall (m :: * -> *) t.
(Monad m, Reflex t) =>
Key -> VtyWidget t m (Event t KeyCombo)
key Key
V.KUp
  Event t KeyCombo
kdown <- Key -> VtyWidget t m (Event t KeyCombo)
forall (m :: * -> *) t.
(Monad m, Reflex t) =>
Key -> VtyWidget t m (Event t KeyCombo)
key Key
V.KDown
  Event t ScrollDirection
m <- VtyWidget t m (Event t ScrollDirection)
forall t (m :: * -> *).
(Reflex t, Monad m) =>
VtyWidget t m (Event t ScrollDirection)
mouseScroll
  let requestedScroll :: Event t Int
      requestedScroll :: Event t Int
requestedScroll = [Event t Int] -> Event t Int
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
        [ 1 Int -> Event t KeyCombo -> Event t Int
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t KeyCombo
kdown
        , (-1) Int -> Event t KeyCombo -> Event t Int
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t KeyCombo
kup
        , Event t ScrollDirection -> (ScrollDirection -> Int) -> Event t Int
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t ScrollDirection
m ((ScrollDirection -> Int) -> Event t Int)
-> (ScrollDirection -> Int) -> Event t Int
forall a b. (a -> b) -> a -> b
$ \case
            ScrollDirection_Up -> (-1)
            ScrollDirection_Down -> 1
        , Event t Int
scrollBy
        ]
      updateLine :: a -> a -> a -> a
updateLine maxN :: a
maxN delta :: a
delta ix :: a
ix = a -> a -> a
forall a. Ord a => a -> a -> a
min (a -> a -> a
forall a. Ord a => a -> a -> a
max 0 (a
ix a -> a -> a
forall a. Num a => a -> a -> a
+ a
delta)) a
maxN
  Dynamic t Int
lineIndex :: Dynamic t Int <- (DisplayRegion -> Int -> Int)
-> Int -> Event t DisplayRegion -> VtyWidget t m (Dynamic t Int)
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn (\(maxN :: Int
maxN, delta :: Int
delta) ix :: Int
ix -> Int -> Int -> Int -> Int
forall a. (Ord a, Num a) => a -> a -> a -> a
updateLine (Int
maxN Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int
delta Int
ix) 0 (Event t DisplayRegion -> VtyWidget t m (Dynamic t Int))
-> Event t DisplayRegion -> VtyWidget t m (Dynamic t Int)
forall a b. (a -> b) -> a -> b
$
    Behavior t Int -> Event t Int -> Event t DisplayRegion
forall k (t :: k) a b.
Reflex t =>
Behavior t a -> Event t b -> Event t (a, b)
attach ([Image] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Image] -> Int) -> Behavior t [Image] -> Behavior t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t [Image]
imgs) Event t Int
requestedScroll
  Behavior t [Image] -> VtyWidget t m ()
forall t (m :: * -> *).
ImageWriter t m =>
Behavior t [Image] -> m ()
tellImages (Behavior t [Image] -> VtyWidget t m ())
-> Behavior t [Image] -> VtyWidget t m ()
forall a b. (a -> b) -> a -> b
$ ([Image] -> [Image]) -> Behavior t [Image] -> Behavior t [Image]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Image -> [Image] -> [Image]
forall a. a -> [a] -> [a]
:[]) (Image -> [Image]) -> ([Image] -> Image) -> [Image] -> [Image]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Image] -> Image
V.vertCat) (Behavior t [Image] -> Behavior t [Image])
-> Behavior t [Image] -> Behavior t [Image]
forall a b. (a -> b) -> a -> b
$ Int -> [Image] -> [Image]
forall a. Int -> [a] -> [a]
drop (Int -> [Image] -> [Image])
-> Behavior t Int -> Behavior t ([Image] -> [Image])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Int -> Behavior t Int
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Int
lineIndex Behavior t ([Image] -> [Image])
-> Behavior t [Image] -> Behavior t [Image]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Behavior t [Image]
imgs
  Behavior t DisplayRegion
-> VtyWidget t m (Behavior t DisplayRegion)
forall (m :: * -> *) a. Monad m => a -> m a
return (Behavior t DisplayRegion
 -> VtyWidget t m (Behavior t DisplayRegion))
-> Behavior t DisplayRegion
-> VtyWidget t m (Behavior t DisplayRegion)
forall a b. (a -> b) -> a -> b
$ (,) (Int -> Int -> DisplayRegion)
-> Behavior t Int -> Behavior t (Int -> DisplayRegion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int -> Int -> Int) -> Behavior t Int -> Behavior t (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Int -> Behavior t Int
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Int
lineIndex Behavior t (Int -> Int) -> Behavior t Int -> Behavior t Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Behavior t Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure 1) Behavior t (Int -> DisplayRegion)
-> Behavior t Int -> Behavior t DisplayRegion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Image] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Image] -> Int) -> Behavior t [Image] -> Behavior t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t [Image]
imgs)
  where
    wrap :: Int -> Text -> [Image]
wrap maxWidth :: Int
maxWidth = (Text -> [Image]) -> [Text] -> [Image]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Text -> Image) -> [Text] -> [Image]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attr -> String -> Image
V.string Attr
V.defAttr (String -> Image) -> (Text -> String) -> Text -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) ([Text] -> [Image]) -> (Text -> [Text]) -> Text -> [Image]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Text -> [Text]
TZ.wrapWithOffset Int
maxWidth 0) ([Text] -> [Image]) -> (Text -> [Text]) -> Text -> [Image]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='\n')

-- | Renders any behavior whose value can be converted to
-- 'String' as text
display
  :: (Reflex t, Monad m, Show a)
  => Behavior t a
  -> VtyWidget t m ()
display :: Behavior t a -> VtyWidget t m ()
display a :: Behavior t a
a = Behavior t Text -> VtyWidget t m ()
forall t (m :: * -> *).
(Reflex t, Monad m) =>
Behavior t Text -> VtyWidget t m ()
text (Behavior t Text -> VtyWidget t m ())
-> Behavior t Text -> VtyWidget t m ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show (a -> Text) -> Behavior t a -> Behavior t Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t a
a

-- | A widget that draws nothing
blank :: Monad m => VtyWidget t m ()
blank :: VtyWidget t m ()
blank = () -> VtyWidget t m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()