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