なんか できてしまった・・・
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Main(main) where import Lens.Micro ((^.)) import Lens.Micro.TH (makeLenses) import Lens.Micro.Mtl ((%=),zoom,use) import Control.Monad (void, forever) import Control.Concurrent (threadDelay, forkIO) import qualified Graphics.Vty as V import Brick.BChan (newBChan, writeBChan) import Brick.Main (App(..), showFirstCursor, customMain, halt, vScrollBy ,ViewportScroll, viewportScroll) import Brick.AttrMap (attrMap) import Brick.Types (Widget, EventM, BrickEvent(..), ViewportType(..)) import Brick.Widgets.Core (str, (<+>), (<=>), hLimit, vLimit, viewport) import Brick.Widgets.Edit as E import Brick.Widgets.Center as C data Name = Edit | View deriving (Ord, Show, Eq) data CustomEvent = Counter deriving Show data St = St { _counter :: Int , _stlog :: String , _edit :: E.Editor String Name } makeLenses ''St drawUI :: St -> [Brick.Types.Widget Name] drawUI st = [ui] where a = (str $ st^.stlog) v = viewport View Vertical a e1 = E.renderEditor (str.unlines) True (st^.edit) ui = C.center $ (str "Input : " <+> (hLimit 50 $ vLimit 5 e1)) <=> str " " <=> (str "Log : " <+> (hLimit 50 $ vLimit 5 v)) <=> str " " <=> str "Esc to quit." vpScroll :: ViewportScroll Name vpScroll = viewportScroll View appEvent :: BrickEvent Name CustomEvent -> EventM Name St () appEvent e = case e of VtyEvent (V.EvKey V.KEsc []) -> halt AppEvent Counter -> do counter %= (+1) i <- use counter stlog %= (++"Count is: "++(show i)++"\n") vScrollBy vpScroll 1 ev -> zoom edit $ E.handleEditorEvent ev initialState :: St initialState = St { _counter = 0 , _stlog = "" , _edit = E.editor Edit Nothing "" } theApp :: App St CustomEvent Name theApp = App { appDraw = drawUI , appChooseCursor = showFirstCursor , appHandleEvent = appEvent , appStartEvent = return () , appAttrMap = const $ attrMap V.defAttr [] } main :: IO () main = do chan <- newBChan 1 void $ forkIO $ forever $ do writeBChan chan Counter threadDelay 1000000 let buildVty = V.mkVty V.defaultConfig initialVty <- buildVty void $ customMain initialVty buildVty (Just chan) theApp initialState
ふう・・・