{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Brick.Types.Internal
( ScrollRequest(..)
, VisibilityRequest(..)
, vrPositionL
, vrSizeL
, Location(..)
, locL
, origin
, TerminalLocation(..)
, Viewport(..)
, ViewportType(..)
, RenderState(..)
, Direction(..)
, CursorLocation(..)
, cursorLocationL
, cursorLocationNameL
, Context(..)
, EventState(..)
, EventRO(..)
, Next(..)
, Result(..)
, Extent(..)
, CacheInvalidateRequest(..)
, BrickEvent(..)
, rsScrollRequestsL
, viewportMapL
, clickableNamesL
, renderCacheL
, observedNamesL
, vpSize
, vpLeft
, vpTop
, imageL
, cursorsL
, extentsL
, visibilityRequestsL
)
where
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid
#endif
import Lens.Micro (_1, _2, Lens')
import Lens.Micro.TH (makeLenses)
import Lens.Micro.Internal (Field1, Field2)
import qualified Data.Set as S
import qualified Data.Map as M
import Graphics.Vty (Vty, Event, Button, Modifier, DisplayRegion, Image, emptyImage)
import Data.Default (Default(..))
import Brick.Types.TH
import Brick.AttrMap (AttrName, AttrMap)
import Brick.Widgets.Border.Style (BorderStyle)
data ScrollRequest = HScrollBy Int
| HScrollPage Direction
| HScrollToBeginning
| HScrollToEnd
| VScrollBy Int
| VScrollPage Direction
| VScrollToBeginning
| VScrollToEnd
| SetTop Int
| SetLeft Int
data VisibilityRequest =
VR { vrPosition :: Location
, vrSize :: DisplayRegion
}
deriving (Show, Eq)
data Viewport =
VP { _vpLeft :: Int
, _vpTop :: Int
, _vpSize :: DisplayRegion
}
deriving Show
data ViewportType = Vertical
| Horizontal
| Both
deriving (Show, Eq)
data CacheInvalidateRequest n = InvalidateSingle n
| InvalidateEntire
data EventState n = ES { esScrollRequests :: [(n, ScrollRequest)]
, cacheInvalidateRequests :: [CacheInvalidateRequest n]
}
data Extent n = Extent { extentName :: n
, extentUpperLeft :: Location
, extentSize :: (Int, Int)
, extentOffset :: Location
}
deriving (Show)
data EventRO n = EventRO { eventViewportMap :: M.Map n Viewport
, eventVtyHandle :: Maybe Vty
, latestExtents :: [Extent n]
}
data Next a = Continue a
| SuspendAndResume (IO a)
| Halt a
deriving Functor
data Direction = Up
| Down
deriving (Show, Eq)
data Location = Location { loc :: (Int, Int)
}
deriving (Show, Eq)
suffixLenses ''Location
instance Field1 Location Location Int Int where
_1 = locL._1
instance Field2 Location Location Int Int where
_2 = locL._2
-- | The class of types that behave like terminal locations.
class TerminalLocation a where
-- | Get the column out of the value
locationColumnL :: Lens' a Int
locationColumn :: a -> Int
-- | Get the row out of the value
locationRowL :: Lens' a Int
locationRow :: a -> Int
instance TerminalLocation Location where
locationColumnL = _1
locationColumn (Location t) = fst t
locationRowL = _2
locationRow (Location t) = snd t
-- | The origin (upper-left corner).
origin :: Location
origin = Location (0, 0)
instance Monoid Location where
mempty = origin
mappend (Location (w1, h1)) (Location (w2, h2)) = Location (w1+w2, h1+h2)
-- | A cursor location. These are returned by the rendering process.
data CursorLocation n =
CursorLocation { cursorLocation :: !Location
-- ^ The location
, cursorLocationName :: !(Maybe n)
-- ^ The name of the widget associated with the location
}
deriving Show
-- | The type of result returned by a widget's rendering function. The
-- result provides the image, cursor positions, and visibility requests
-- that resulted from the rendering process.
data Result n =
Result { image :: Image
-- ^ The final rendered image for a widget
, cursors :: [CursorLocation n]
-- ^ The list of reported cursor positions for the
-- application to choose from
, visibilityRequests :: [VisibilityRequest]
-- ^ The list of visibility requests made by widgets rendered
-- while rendering this one (used by viewports)
, extents :: [Extent n]
}
deriving Show
suffixLenses ''Result
instance Default (Result n) where
def = Result emptyImage [] [] []
-- | The type of events.
data BrickEvent n e = VtyEvent Event
-- ^ The event was a Vty event.
| AppEvent e
-- ^ The event was an application event.
| MouseDown n Button [Modifier] Location
-- ^ A mouse-down event on the specified region was
-- received.
| MouseUp n (Maybe Button) Location
-- ^ A mouse-down event on the specified region was
-- received.
deriving (Show, Eq)
data RenderState n =
RS { viewportMap :: M.Map n Viewport
, rsScrollRequests :: [(n, ScrollRequest)]
, observedNames :: !(S.Set n)
, renderCache :: M.Map n (Result n)
, clickableNames :: [n]
}
-- | The rendering context. This tells widgets how to render: how much
-- space they have in which to render, which attribute they should use
-- to render, which bordering style should be used, and the attribute map
-- available for rendering.
data Context =
Context { ctxAttrName :: AttrName
, availWidth :: Int
, availHeight :: Int
, ctxBorderStyle :: BorderStyle
, ctxAttrMap :: AttrMap
}
deriving Show
suffixLenses ''RenderState
suffixLenses ''VisibilityRequest
suffixLenses ''CursorLocation
makeLenses ''Viewport