brick/programs/LayerDemo.hs
2016-05-08 18:05:30 -07:00

69 lines
2.1 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Main where
import Lens.Micro ((^.), (&), (%~))
import Lens.Micro.TH (makeLenses)
import Control.Monad (void)
import Data.Default
import qualified Graphics.Vty as V
import qualified Brick.Types as T
import Brick.Types (rowL, columnL, Widget)
import qualified Brick.Main as M
import qualified Brick.Widgets.Border as B
import Brick.Widgets.Core
( translateBy
, str
)
data St =
St { _topLayerLocation :: T.Location
, _bottomLayerLocation :: T.Location
}
makeLenses ''St
drawUi :: St -> [Widget]
drawUi st =
[ topLayer st
, bottomLayer st
]
topLayer :: St -> Widget
topLayer st =
translateBy (st^.topLayerLocation) $
B.border $ str "Top layer\n(Arrow keys move)"
bottomLayer :: St -> Widget
bottomLayer st =
translateBy (st^.bottomLayerLocation) $
B.border $ str "Bottom layer\n(Ctrl-arrow keys move)"
appEvent :: St -> V.Event -> T.EventM (T.Next St)
appEvent st (V.EvKey V.KDown []) = M.continue $ st & topLayerLocation.rowL %~ (+ 1)
appEvent st (V.EvKey V.KUp []) = M.continue $ st & topLayerLocation.rowL %~ (subtract 1)
appEvent st (V.EvKey V.KRight []) = M.continue $ st & topLayerLocation.columnL %~ (+ 1)
appEvent st (V.EvKey V.KLeft []) = M.continue $ st & topLayerLocation.columnL %~ (subtract 1)
appEvent st (V.EvKey V.KDown [V.MCtrl]) = M.continue $ st & bottomLayerLocation.rowL %~ (+ 1)
appEvent st (V.EvKey V.KUp [V.MCtrl]) = M.continue $ st & bottomLayerLocation.rowL %~ (subtract 1)
appEvent st (V.EvKey V.KRight [V.MCtrl]) = M.continue $ st & bottomLayerLocation.columnL %~ (+ 1)
appEvent st (V.EvKey V.KLeft [V.MCtrl]) = M.continue $ st & bottomLayerLocation.columnL %~ (subtract 1)
appEvent st (V.EvKey V.KEsc []) = M.halt st
appEvent st _ = M.continue st
app :: M.App St V.Event
app =
M.App { M.appDraw = drawUi
, M.appStartEvent = return
, M.appHandleEvent = appEvent
, M.appAttrMap = const def
, M.appLiftVtyEvent = id
, M.appChooseCursor = M.neverShowCursor
}
main :: IO ()
main = void $ M.defaultMain app $ St (T.Location (0, 0)) (T.Location (0, 0))