git.iko.soy/reflex-vty
on ef1b495 help sign in
reflex-vty/src-bin/example.hs
87 lines 2.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
19{-
20guest :: forall t m. VtyApp t m
21guest e = do
22 dr0@(w, h) <- displaySize
23 dr <- holdDyn dr0 $ fforMaybe (e :: Event t VtyEvent) $ \case
24 V.EvResize w h -> Just (w, h)
25 _ -> Nothing
26 let region = fmap (\(w,h) -> Region 0 0 w h) dr
27 region1 = fmap (\(w,h) -> Region (w `div` 5) (h `div` 5) (w `div` 2) (h `div` 2)) dr
28 region2 = fmap (\(w,h) -> Region (w `div` 4) (h `div` 4) (2 * (w `div` 3)) (2*(h `div` 3))) dr
29 debugRegion = fmap (\(w, _) -> Region 0 0 w 3) dr
30 events <- holdDyn "" $ show <$> e
31 let debugOut = ffor (zipDyn events debugRegion) $ \(ev, r) ->
32 box r $ \(w, _) -> wrapString w mempty ev
34 let shutdown = fforMaybe e $ \case
35 V.EvKey V.KEsc _ -> Just ()
36 _ -> Nothing
37 output = fmap V.picForLayers $
38 current $ ffor ((,,) <$> region1 <*> region2 <*> debugOut) $ \(r1, r2, d) ->
39 let b1 = box r1 (\(w, _) -> wrapString w mempty $ take 500 $ cycle ('\n' : ['a'..'z']))
40 b2 = box r2 (\(w, _) -> wrapString w mempty $ take 500 $ cycle ('\n' : ['a'..'z']))
41 in d ++ b2 ++ b1
42 return $ VtyResult
43 { _vtyResult_picture = output
44 , _vtyResult_shutdown = shutdown
45 }
46-}
48main :: IO ()
49main =
50 mainWidget $ do
51 inp <- input
52 tellShutdown . fforMaybe inp $ \case
53 V.EvKey V.KEsc _ -> Just ()
54 _ -> Nothing
56 debugInput
57 testBoxes
58 return ()
60testBoxes :: (Reflex t, MonadHold t m, MonadFix m) => VtyWidget t m ()
61testBoxes = do
62 size <- displaySize
63 let region1 = fmap (\(w,h) -> Region (w `div` 6) (h `div` 6) (w `div` 2) (h `div` 2)) size
64 region2 = fmap (\(w,h) -> Region (w `div` 4) (h `div` 4) (2 * (w `div` 3)) (2*(h `div` 3))) size
65 pane region1 (constDyn False) . box $ debugInput
66 pane region2 (constDyn True) . box $
67 splitVDrag (box debugInput) (box dragTest)
68 return ()
70debugFocus :: (Reflex t, Monad m) => VtyWidget t m ()
71debugFocus = do
72 f <- focus
73 string $ show <$> current f
75debugInput :: (Reflex t, MonadHold t m) => VtyWidget t m ()
76debugInput = do
77 lastEvent <- hold "No event yet" . fmap show =<< input
78 string lastEvent
80dragTest :: (Reflex t, MonadHold t m, MonadFix m) => VtyWidget t m ()
81dragTest = do
82 lastEvent <- hold "No event yet" . fmap show =<< drag V.BLeft
83 string lastEvent
85testStringBox :: (Reflex t, Monad m) => VtyWidget t m ()
86testStringBox = box .
87 string . pure . take 500 $ cycle ('\n' : ['a'..'z'])