@@ -0,0 +1,42 @@
1+module Main where
2+
3+import Graphics.Vty
4+
5+import Control.Applicative
6+import Control.Arrow
7+import Control.Monad.RWS
8+
9+import Data.Sequence (Seq, (<|) )
10+import qualified Data.Sequence as Seq
11+import Data.Foldable
12+
13+event_buffer_size = 1000
14+
15+type App = RWST Vty () (Seq String) IO
16+
17+main = do
18+ vty <- mkVty
19+ _ <- execRWST vty_interact vty Seq.empty
20+ shutdown vty
21+
22+vty_interact :: App ()
23+vty_interact = do
24+ update_display
25+ done <- handle_next_event
26+ unless done vty_interact
27+
28+update_display :: App ()
29+update_display = do
30+ let info = string def_attr "Press ESC to exit."
31+ event_log <- foldMap (string def_attr) <$> get
32+ let pic = pic_for_layers [info,event_log]
33+ vty <- ask
34+ liftIO $ update vty pic
35+
36+handle_next_event = ask >>= liftIO . next_event >>= handle_event
37+ where
38+ handle_event (EvKey KEsc []) = return True
39+ handle_event e = do
40+ modify $ (<|) (show e) >>> Seq.take event_buffer_size
41+ return False
42+