on c5331bf help sign in
reflex-vty/src-bin/example.hs
54 lines 1.7 kB history raw
1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE GADTs #-}
3{-# LANGUAGE LambdaCase #-}
4{-# LANGUAGE OverloadedStrings #-}
5{-# LANGUAGE RankNTypes #-}
6{-# LANGUAGE ScopedTypeVariables #-}
7{-# OPTIONS_GHC -threaded #-}
9import Control.Monad.Fix
10import qualified Data.Text as T
11import qualified Graphics.Vty as V
12import Reflex
13import Reflex.Vty
15main :: IO ()
16main =
17 mainWidget $ do
18 inp <- input
19 tellShutdown . fforMaybe inp $ \case
20 V.EvKey V.KEsc _ -> Just ()
21 _ -> Nothing
23 debugInput
24 testBoxes
25 return ()
27testBoxes :: (Reflex t, MonadHold t m, MonadFix m) => VtyWidget t m ()
28testBoxes = do
29 size <- displaySize
30 let region1 = fmap (\(w,h) -> Region (w `div` 6) (h `div` 6) (w `div` 2) (h `div` 2)) size
31 region2 = fmap (\(w,h) -> Region (w `div` 4) (h `div` 4) (2 * (w `div` 3)) (2*(h `div` 3))) size
32 pane region1 (constDyn False) . box singleBoxStyle $ debugInput
33 _ <- pane region2 (constDyn True) . box singleBoxStyle $
34 splitVDrag (hRule doubleBoxStyle) (box roundedBoxStyle $ multilineTextInput def) (box roundedBoxStyle dragTest)
35 return ()
37debugFocus :: (Reflex t, Monad m) => VtyWidget t m ()
38debugFocus = do
39 f <- focus
40 text $ T.pack . show <$> current f
42debugInput :: (Reflex t, MonadHold t m) => VtyWidget t m ()
43debugInput = do
44 lastEvent <- hold "No event yet" . fmap show =<< input
45 text $ T.pack <$> lastEvent
47dragTest :: (Reflex t, MonadHold t m, MonadFix m) => VtyWidget t m ()
48dragTest = do
49 lastEvent <- hold "No event yet" . fmap show =<< drag V.BLeft
50 text $ T.pack <$> lastEvent
52testStringBox :: (Reflex t, Monad m) => VtyWidget t m ()
53testStringBox = box singleBoxStyle .
54 text . pure . T.pack . take 500 $ cycle ('\n' : ['a'..'z'])