on ffe6de2 help sign in
vty/src/Graphics/Vty.hs
150 lines 6.1 kB history raw
1-- Copyright 2009-2010 Corey O'Connor
2{-# LANGUAGE ForeignFunctionInterface, BangPatterns, UnboxedTuples #-}
3{-# CFILES gwinsz.c #-}
5-- Good sources of documentation for terminal programming are:
6-- vt100 control sequences: http://vt100.net/docs/vt100-ug/chapter3.html#S3.3.3
7-- Xterm control sequences: http://invisible-island.net/xterm/ctlseqs/ctlseqs.html
9module Graphics.Vty ( Vty(..)
10 , mkVty
11 , mkVtyEscDelay
12 , module Graphics.Vty.Terminal
13 , module Graphics.Vty.Picture
14 , module Graphics.Vty.DisplayRegion
15 , Key(..)
16 , Modifier(..)
17 , Button(..)
18 , Event(..)
19 )
20 where
23import Graphics.Vty.Terminal
24import Graphics.Vty.Picture
25import Graphics.Vty.DisplayRegion
26import Graphics.Vty.Input
28import Data.IORef
30import qualified System.Console.Terminfo as Terminfo
32-- | The main object. At most one should be created.
33-- An alternative is to use unsafePerformIO to automatically create a singleton Vty instance when
34-- required.
35--
36-- This does not assure any thread safety. In theory, as long as an update action is not executed
37-- when another update action is already then it's safe to call this on multiple threads.
38--
39-- todo: Once the Terminal interface encompasses input this interface will be deprecated.
40-- Currently, just using the Terminal interface there is no support for input events.
41data Vty = Vty
42 { -- | Outputs the given Picture. Equivalent to output_picture applied to a display context
43 -- implicitly managed by Vty.
44 update :: Picture -> IO ()
45 -- | Get one Event object, blocking if necessary.
46 , next_event :: IO Event
47 -- | The terminal device interface. See `Interface`
48 --
49 -- The use of Vty typically follows this process:
50 --
51 -- 0. initialize vty
52 --
53 -- 1. use the update equation of Vty to display a picture
54 --
55 -- 2. repeat
56 --
57 -- 3. shutdown vty.
58 --
59 -- todo: provide a similar abstraction to Graphics.Vty.Terminal for input. Use haskeline's
60 -- input backend for implementation.
61 --
62 -- todo: remove explicit `shutdown` requirement.
63 , terminal :: Terminal
64 -- | Refresh the display. Normally the library takes care of refreshing. Nonetheless, some
65 -- other program might output to the terminal and mess the display. In that case the user
66 -- might want to force a refresh.
67 , refresh :: IO ()
68 -- | Clean up after vty.
69 -- The above methods will throw an exception if executed after this is executed.
70 , shutdown :: IO ()
71 }
73-- | Set up the state object for using vty. At most one state object should be
74-- created at a time.
75mkVty :: IO Vty
76mkVty = mkVtyEscDelay defaultEscDelay
78-- | Set up the state object for using vty. At most one state object should be
79-- created at a time. The delay, in microseconds, specifies the period of time to wait for a key
80-- following reading ESC from the terminal before considering the ESC key press as a discrete event.
81-- \todo move input init into terminal interface
82mkVtyEscDelay :: Int -> IO Vty
83mkVtyEscDelay escDelay = do
84 term_info <- Terminfo.setupTermFromEnv
85 t <- current_terminal
86 reserve_display t
87 (kvar, endi) <- initTermInput escDelay term_info
88 intMkVty kvar ( endi >> release_display t >> release_terminal t ) t
90intMkVty :: IO Event -> IO () -> Terminal -> IO Vty
91intMkVty kvar fend t = do
92 last_pic_ref <- newIORef Nothing
93 last_update_ref <- newIORef Nothing
95 let inner_update in_pic = do
96 b <- display_bounds t
97 let DisplayRegion w h = b
98 cursor = pic_cursor in_pic
99 in_pic' = case cursor of
100 Cursor x y ->
101 let
102 x' = case x of
103 _ | x >= 0x80000000 -> 0
104 | x >= w -> w - 1
105 | otherwise -> x
106 y' = case y of
107 _ | y >= 0x80000000 -> 0
108 | y >= h -> h - 1
109 | otherwise -> y
110 in in_pic { pic_cursor = Cursor x' y' }
111 _ -> in_pic
112 mlast_update <- readIORef last_update_ref
113 update_data <- case mlast_update of
114 Nothing -> do
115 dc <- display_context t b
116 output_picture dc in_pic'
117 return (b, dc)
118 Just (last_bounds, last_context) -> do
119 if b /= last_bounds
120 then do
121 dc <- display_context t b
122 output_picture dc in_pic'
123 return (b, dc)
124 else do
125 output_picture last_context in_pic'
126 return (b, last_context)
127 writeIORef last_update_ref $ Just update_data
128 writeIORef last_pic_ref $ Just in_pic'
130 let inner_refresh
131 = writeIORef last_update_ref Nothing
132 >> readIORef last_pic_ref
133 >>= maybe ( return () ) ( \pic -> inner_update pic )
135 let gkey = do k <- kvar
136 case k of
137 (EvResize _ _) -> inner_refresh
138 >> display_bounds t
139 >>= return . ( \(DisplayRegion w h)
140 -> EvResize (fromEnum w) (fromEnum h)
141 )
142 _ -> return k
144 return $ Vty { update = inner_update
145 , next_event = gkey
146 , terminal = t
147 , refresh = inner_refresh
148 , shutdown = fend
149 }