jtdaugherty/brick
1
1
Fork 0
mirror of https://github.com/jtdaugherty/brick.git synced 2024-12-02 01:45:50 +03:00
Code Issues Projects Releases Wiki Activity

Use lenses in rendering internals to access result fields

Browse Source
This commit is contained in:
Jonathan Daugherty 2015-05-29 21:03:00 -07:00
parent b409e7f4a8
commit f19764e65a
1 changed files with 39 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
src/Brick/Render/Internal.hs
View File

@ -5,6 +5,9 @@
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Brick.Render.Internal module Brick.Render.Internal
( Result(..) ( Result(..)
, image
, cursors
, Priority(..) , Priority(..)
, renderFinal , renderFinal
, Render , Render
@ -36,7 +39,7 @@ module Brick.Render.Internal
where where
import Control.Applicative import Control.Applicative
import Control.Lens (makeLenses, (^.), (.=), (.~), (&)) import Control.Lens (makeLenses, (^.), (.=), (.~), (&), (%~), to, _2)
import Control.Monad.Trans.State.Lazy import Control.Monad.Trans.State.Lazy
import Control.Monad.Trans.Reader import Control.Monad.Trans.Reader
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
@ -51,8 +54,8 @@ import Brick.Core (Location(..), CursorLocation(..), CursorName(..))
import Brick.Util (clOffset, for) import Brick.Util (clOffset, for)
data Result = data Result =
Result { image :: V.Image Result { _image :: V.Image
, cursors :: [CursorLocation] , _cursors :: [CursorLocation]
} }
deriving Show deriving Show
@ -62,6 +65,7 @@ data Context =
, _h :: Int , _h :: Int
} }
makeLenses ''Result
makeLenses ''Context makeLenses ''Context
data Priority = High | Low data Priority = High | Low
@ -84,19 +88,15 @@ renderFinal layerRenders sz chooseCursor st = (newState, pic, theCursor)
where where
(layerResults, newState) = flip runState st $ sequence $ (\p -> runReaderT p ctx) <$> layerRenders (layerResults, newState) = flip runState st $ sequence $ (\p -> runReaderT p ctx) <$> layerRenders
ctx = Context V.defAttr (fst sz) (snd sz) ctx = Context V.defAttr (fst sz) (snd sz)
pic = V.picForLayers $ uncurry V.resize sz <$> image <$> layerResults pic = V.picForLayers $ uncurry V.resize sz <$> (^.image) <$> layerResults
layerCursors = cursors <$> layerResults layerCursors = (^.cursors) <$> layerResults
theCursor = chooseCursor $ concat layerCursors theCursor = chooseCursor $ concat layerCursors
addCursorOffset :: Location -> Result -> Result addCursorOffset :: Location -> Result -> Result
addCursorOffset off r = addCursorOffset off r =
let onlyVisible = filter isVisible let onlyVisible = filter isVisible
isVisible (CursorLocation (Location (width, height)) _) = width >= 0 && height >= 0 isVisible (CursorLocation (Location (width, height)) _) = width >= 0 && height >= 0
in r { cursors = onlyVisible $ (`clOffset` off) <$> cursors r in r & cursors %~ (\cs -> onlyVisible $ (`clOffset` off) <$> cs)
}
setImage :: V.Image -> Result -> Result
setImage i r = r { image = i }
unrestricted :: Int unrestricted :: Int
unrestricted = 1000 unrestricted = 1000
@ -105,28 +105,28 @@ txt :: String -> Render a
txt s = do txt s = do
c <- ask c <- ask
return $ if c^.w > 0 && c^.h > 0 return $ if c^.w > 0 && c^.h > 0
then setImage (V.crop (c^.w) (c^.h) $ V.string (c^.attr) s) def then def & image .~ (V.crop (c^.w) (c^.h) $ V.string (c^.attr) s)
else def else def
hPad :: Char -> Render a hPad :: Char -> Render a
hPad ch = do hPad ch = do
c <- ask c <- ask
return $ setImage (V.charFill (c^.attr) ch (c^.w) (max 1 (c^.h))) def return $ def & image .~ (V.charFill (c^.attr) ch (c^.w) (max 1 (c^.h)))
vPad :: Char -> Render a vPad :: Char -> Render a
vPad ch = do vPad ch = do
c <- ask c <- ask
return $ setImage (V.charFill (c^.attr) ch (max 1 (c^.w)) (c^.h)) def return $ def & image .~ (V.charFill (c^.attr) ch (max 1 (c^.w)) (c^.h))
hFill :: Char -> Render a hFill :: Char -> Render a
hFill ch = do hFill ch = do
c <- ask c <- ask
return $ setImage (V.charFill (c^.attr) ch (c^.w) (min (c^.h) 1)) def return $ def & image .~ (V.charFill (c^.attr) ch (c^.w) (min (c^.h) 1))
vFill :: Char -> Render a vFill :: Char -> Render a
vFill ch = do vFill ch = do
c <- ask c <- ask
return $ setImage (V.charFill (c^.attr) ch (min (c^.w) 1) (c^.h)) def return $ def & image .~ (V.charFill (c^.attr) ch (min (c^.w) 1) (c^.h))
hBox :: [(Render a, Priority)] -> Render a hBox :: [(Render a, Priority)] -> Render a
hBox pairs = do hBox pairs = do
@ -138,12 +138,12 @@ hBox pairs = do
renderedHis <- mapM (\(i, (prim, _)) -> (i,) <$> prim) his renderedHis <- mapM (\(i, (prim, _)) -> (i,) <$> prim) his
let remainingWidth = c^.w - (sum $ (V.imageWidth . image . snd) <$> renderedHis) let remainingWidth = c^.w - (sum $ (^._2.image.(to V.imageWidth)) <$> renderedHis)
widthPerLow = remainingWidth `div` length lows widthPerLow = remainingWidth `div` length lows
padFirst = if widthPerLow * length lows < remainingWidth padFirst = if widthPerLow * length lows < remainingWidth
then remainingWidth - widthPerLow * length lows then remainingWidth - widthPerLow * length lows
else 0 else 0
heightPerLow = maximum $ (V.imageHeight . image . snd) <$> renderedHis heightPerLow = maximum $ (^._2.image.(to V.imageHeight)) <$> renderedHis
renderLow (i, (prim, _)) = renderLow (i, (prim, _)) =
let padding = (if i == 0 then padFirst else 0) let padding = (if i == 0 then padFirst else 0)
in (i,) <$> (withReaderT (\v -> v & w .~ widthPerLow + padding in (i,) <$> (withReaderT (\v -> v & w .~ widthPerLow + padding
@ -153,12 +153,12 @@ hBox pairs = do
let rendered = sortBy (compare `DF.on` fst) $ renderedHis ++ renderedLows let rendered = sortBy (compare `DF.on` fst) $ renderedHis ++ renderedLows
allResults = snd <$> rendered allResults = snd <$> rendered
allImages = image <$> allResults allImages = (^.image) <$> allResults
allWidths = V.imageWidth <$> allImages allWidths = V.imageWidth <$> allImages
allTranslatedCursors = for (zip [0..] allResults) $ \(i, result) -> allTranslatedCursors = for (zip [0..] allResults) $ \(i, result) ->
let off = Location (offWidth, 0) let off = Location (offWidth, 0)
offWidth = sum $ take i allWidths offWidth = sum $ take i allWidths
in cursors $ addCursorOffset off result in (addCursorOffset off result)^.cursors
return $ Result (V.horizCat allImages) (concat allTranslatedCursors) return $ Result (V.horizCat allImages) (concat allTranslatedCursors)
@ -172,12 +172,12 @@ vBox pairs = do
renderedHis <- mapM (\(i, (prim, _)) -> (i,) <$> prim) his renderedHis <- mapM (\(i, (prim, _)) -> (i,) <$> prim) his
let remainingHeight = c^.h - (sum $ (V.imageHeight . image . snd) <$> renderedHis) let remainingHeight = c^.h - (sum $ (^._2.image.(to V.imageHeight)) <$> renderedHis)
heightPerLow = remainingHeight `div` length lows heightPerLow = remainingHeight `div` length lows
padFirst = if heightPerLow * length lows < remainingHeight padFirst = if heightPerLow * length lows < remainingHeight
then remainingHeight - heightPerLow * length lows then remainingHeight - heightPerLow * length lows
else 0 else 0
widthPerLow = maximum $ (V.imageWidth . image . snd) <$> renderedHis widthPerLow = maximum $ (^._2.image.(to V.imageWidth)) <$> renderedHis
renderLow (i, (prim, _)) = renderLow (i, (prim, _)) =
let padding = if i == 0 then padFirst else 0 let padding = if i == 0 then padFirst else 0
in (i,) <$> (withReaderT (\v -> v & w .~ widthPerLow in (i,) <$> (withReaderT (\v -> v & w .~ widthPerLow
@ -187,12 +187,12 @@ vBox pairs = do
let rendered = sortBy (compare `DF.on` fst) $ renderedHis ++ renderedLows let rendered = sortBy (compare `DF.on` fst) $ renderedHis ++ renderedLows
allResults = snd <$> rendered allResults = snd <$> rendered
allImages = image <$> allResults allImages = (^.image) <$> allResults
allHeights = V.imageHeight <$> allImages allHeights = V.imageHeight <$> allImages
allTranslatedCursors = for (zip [0..] allResults) $ \(i, result) -> allTranslatedCursors = for (zip [0..] allResults) $ \(i, result) ->
let off = Location (0, offHeight) let off = Location (0, offHeight)
offHeight = sum $ take i allHeights offHeight = sum $ take i allHeights
in cursors $ addCursorOffset off result in (addCursorOffset off result)^.cursors
return $ Result (V.vertCat allImages) (concat allTranslatedCursors) return $ Result (V.vertCat allImages) (concat allTranslatedCursors)
@ -211,62 +211,55 @@ raw :: V.Image -> Render a
raw img = do raw img = do
c <- ask c <- ask
return $ if c^.w > 0 && c^.h > 0 return $ if c^.w > 0 && c^.h > 0
then setImage (V.crop (c^.w) (c^.h) img) def then def & image .~ (V.crop (c^.w) (c^.h) img)
else def else def
translate :: Location -> Render a -> Render a translate :: Location -> Render a -> Render a
translate (Location (tw,th)) p = do translate (Location (tw,th)) p = do
result <- p result <- p
c <- ask c <- ask
let img = image result
return $ addCursorOffset (Location (tw, th)) $ return $ addCursorOffset (Location (tw, th)) $
setImage (V.crop (c^.w) (c^.h) $ V.translate tw th img) result result & image %~ (V.crop (c^.w) (c^.h) . V.translate tw th)
cropLeftBy :: Int -> Render a -> Render a cropLeftBy :: Int -> Render a -> Render a
cropLeftBy cols p = do cropLeftBy cols p = do
result <- p result <- p
let img = image result let amt = V.imageWidth (result^.image) - cols
amt = V.imageWidth img - cols cropped img = if amt < 0 then V.emptyImage else V.cropLeft amt img
cropped = if amt < 0 then V.emptyImage else V.cropLeft amt img return $ addCursorOffset (Location (-1 * cols, 0)) $ result & image %~ cropped
return $ addCursorOffset (Location (-1 * cols, 0)) $
setImage cropped result
cropRightBy :: Int -> Render a -> Render a cropRightBy :: Int -> Render a -> Render a
cropRightBy cols p = do cropRightBy cols p = do
result <- p result <- p
let img = image result let amt = V.imageWidth (result^.image) - cols
amt = V.imageWidth img - cols cropped img = if amt < 0 then V.emptyImage else V.cropRight amt img
cropped = if amt < 0 then V.emptyImage else V.cropRight amt img
-- xxx cursors -- xxx cursors
return $ setImage cropped result return $ result & image %~ cropped
cropTopBy :: Int -> Render a -> Render a cropTopBy :: Int -> Render a -> Render a
cropTopBy rows p = do cropTopBy rows p = do
result <- p result <- p
let img = image result let amt = V.imageHeight (result^.image) - rows
amt = V.imageHeight img - rows cropped img = if amt < 0 then V.emptyImage else V.cropTop amt img
cropped = if amt < 0 then V.emptyImage else V.cropTop amt img return $ addCursorOffset (Location (0, -1 * rows)) $ result & image %~ cropped
return $ addCursorOffset (Location (0, -1 * rows)) $
setImage cropped result
cropBottomBy :: Int -> Render a -> Render a cropBottomBy :: Int -> Render a -> Render a
cropBottomBy rows p = do cropBottomBy rows p = do
result <- p result <- p
let img = image result let amt = V.imageHeight (result^.image) - rows
amt = V.imageHeight img - rows cropped img = if amt < 0 then V.emptyImage else V.cropBottom amt img
cropped = if amt < 0 then V.emptyImage else V.cropBottom amt img
-- xxx crop cursors -- xxx crop cursors
return $ setImage cropped result return $ result & image %~ cropped
showCursor :: CursorName -> Location -> Render a -> Render a showCursor :: CursorName -> Location -> Render a -> Render a
showCursor n loc p = do showCursor n loc p = do
result <- p result <- p
return $ result { cursors = (CursorLocation loc (Just n)):cursors result } return $ result & cursors %~ (CursorLocation loc (Just n):)
saveSize :: (V.DisplayRegion -> a -> a) -> Render a -> Render a saveSize :: (V.DisplayRegion -> a -> a) -> Render a -> Render a
saveSize sizeSetter p = do saveSize sizeSetter p = do
result <- p result <- p
let img = image result let img = result^.image
imgSz = (V.imageWidth img, V.imageHeight img) imgSz = (V.imageWidth img, V.imageHeight img)
lift $ modify (sizeSetter imgSz) lift $ modify (sizeSetter imgSz)
return result return result