Add support for vty translation

This commit is contained in:
Jonathan Daugherty 2015-05-09 14:37:27 -07:00
parent 458bc3fbe1
commit 642dee8d4f
2 changed files with 18 additions and 1 deletions

View File

@ -10,6 +10,7 @@ import Brick
data St =
St { focus :: FocusRing
, stEditor :: Editor
, trans :: Location
}
eName :: Name
@ -18,7 +19,9 @@ eName = Name "edit"
drawUI :: St -> [Widget]
drawUI st = [top]
where
top = vBox [ "Top"
top = translated (trans st) $
hLimit 40 $
vBox [ "Top"
, hBorder '-'
, hBox [ " Edit: "
, hLimit 20 $ edit (stEditor st) `withAttr` (cyan `on` blue)
@ -30,12 +33,17 @@ handleEvent e st =
case e of
EvKey KEsc [] -> exitSuccess
EvKey KEnter [] -> error $ editStr $ stEditor st
EvKey KLeft [MCtrl] -> return $ st { trans = trans st `locOffset` (Location (-1, 0)) }
EvKey KRight [MCtrl] -> return $ st { trans = trans st `locOffset` (Location (1, 0)) }
EvKey KUp [MCtrl] -> return $ st { trans = trans st `locOffset` (Location (0, -1)) }
EvKey KDown [MCtrl] -> return $ st { trans = trans st `locOffset` (Location (0, 1)) }
ev -> return $ st { stEditor = editEvent ev (stEditor st) }
initialState :: St
initialState =
St { focus = focusRing [eName]
, stEditor = editor eName ""
, trans = Location (0, 0)
}
app :: App St

View File

@ -238,6 +238,15 @@ vLimit height w =
def { render = \(width, _) attr -> render w (width, height) attr
}
translated :: Location -> Widget -> Widget
translated off@(Location (wOff, hOff)) w =
def { render = \sz attr ->
let result = render w sz attr
in result { renderImage = translate wOff hOff $ renderImage result
, renderCursors = (`clOffset` off) <$> renderCursors result
}
}
render_ :: Widget -> Location -> DisplayRegion -> Attr -> Render
render_ w loc sz attr =
def { renderImage = uncurry crop sz img