git.iko.soy/reflex-vty
on 953a56b help sign in
reflex-vty/src-bin/example.hs
58 lines 1.8 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
10import Control.Monad.Fix
11import Control.Monad.IO.Class
12import Control.Monad.Trans.Reader
13import Data.Time
14import qualified Graphics.Vty as V
15import Reflex
16import Reflex.Vty
17import Reflex.Vty.Widget
19main :: IO ()
20main =
21 mainWidget $ do
22 inp <- input
23 tellShutdown . fforMaybe inp $ \case
24 V.EvKey V.KEsc _ -> Just ()
25 _ -> Nothing
27 debugInput
28 testBoxes
29 return ()
31testBoxes :: (Reflex t, MonadHold t m, MonadFix m) => VtyWidget t m ()
32testBoxes = do
33 size <- displaySize
34 let region1 = fmap (\(w,h) -> Region (w `div` 6) (h `div` 6) (w `div` 2) (h `div` 2)) size
35 region2 = fmap (\(w,h) -> Region (w `div` 4) (h `div` 4) (2 * (w `div` 3)) (2*(h `div` 3))) size
36 pane region1 (constDyn False) . box singleBoxStyle $ debugInput
37 pane region2 (constDyn True) . box singleBoxStyle $
38 splitVDrag (hRule doubleBoxStyle) (box roundedBoxStyle debugInput) (box roundedBoxStyle dragTest)
39 return ()
41debugFocus :: (Reflex t, Monad m) => VtyWidget t m ()
42debugFocus = do
43 f <- focus
44 string $ show <$> current f
46debugInput :: (Reflex t, MonadHold t m) => VtyWidget t m ()
47debugInput = do
48 lastEvent <- hold "No event yet" . fmap show =<< input
49 string lastEvent
51dragTest :: (Reflex t, MonadHold t m, MonadFix m) => VtyWidget t m ()
52dragTest = do
53 lastEvent <- hold "No event yet" . fmap show =<< drag V.BLeft
54 string lastEvent
56testStringBox :: (Reflex t, Monad m) => VtyWidget t m ()
57testStringBox = box singleBoxStyle .
58 string . pure . take 500 $ cycle ('\n' : ['a'..'z'])