git.iko.soy/vty
on afa2cb0 help sign in
vty/src/Graphics/Vty.hs
182 lines 6.2 kB history raw
1{-# LANGUAGE CPP #-}
3-- | Vty provides interfaces for both terminal input and terminal
4-- output.
5--
6-- - Input to the terminal is provided to the Vty application as a
7-- sequence of 'Event's.
8--
9-- - Output is provided to Vty by the application in the form of a
10-- 'Picture'. A 'Picture' is one or more layers of 'Image's.
11-- 'Image' values can be built by the various constructors in
12-- "Graphics.Vty.Image". Output can be syled using 'Attr' (attribute)
13-- values in the "Graphics.Vty.Attributes" module.
14--
15-- Vty uses threads internally, so programs made with Vty need to be
16-- compiled with the threaded runtime using the GHC `-threaded` option.
17--
18-- @
19-- import "Graphics.Vty"
20--
21-- main = do
22-- cfg <- 'standardIOConfig'
23-- vty <- 'mkVty' cfg
24-- let line0 = 'string' ('defAttr' ` 'withForeColor' ` 'green') \"first line\"
25-- line1 = 'string' ('defAttr' ` 'withBackColor' ` 'blue') \"second line\"
26-- img = line0 '<->' line1
27-- pic = 'picForImage' img
28-- 'update' vty pic
29-- e <- 'nextEvent' vty
30-- 'shutdown' vty
31-- 'print' (\"Last event was: \" '++' 'show' e)
32-- @
33module Graphics.Vty
34 ( Vty(..)
35 , mkVty
36 , Mode(..)
37 , module Graphics.Vty.Config
38 , module Graphics.Vty.Input
39 , module Graphics.Vty.Output
40 , module Graphics.Vty.Output.Interface
41 , module Graphics.Vty.Picture
42 , module Graphics.Vty.Image
43 , module Graphics.Vty.Attributes
44 )
45where
47import Graphics.Vty.Config
48import Graphics.Vty.Input
49import Graphics.Vty.Output
50import Graphics.Vty.Output.Interface
51import Graphics.Vty.Picture
52import Graphics.Vty.Image
53import Graphics.Vty.Attributes
55import Control.Monad (when)
56import Control.Concurrent.STM
58import Data.IORef
59#if !(MIN_VERSION_base(4,11,0))
60import Data.Semigroup ((<>))
61#endif
63-- | A Vty value represents a handle to the Vty library that the
64-- application must create in order to use Vty.
65--
66-- The use of Vty typically follows this process:
67--
68-- 1. Initialize vty
69--
70-- 2. Use 'update' to display a picture.
71--
72-- 3. Use 'nextEvent' to get the next input event.
73--
74-- 4. Depending on the event, go to 2 or 5.
75--
76-- 5. Shutdown vty.
77--
78-- Operations on Vty handles are not thread-safe.
79data Vty = Vty
80 { -- | Outputs the given 'Picture'.
81 update :: Picture -> IO ()
82 -- | Return the next 'Event' or block until one becomes available.
83 , nextEvent :: IO Event
84 -- | Non-blocking version of 'nextEvent'.
85 , nextEventNonblocking :: IO (Maybe Event)
86 -- | The input interface. See 'Input'.
87 , inputIface :: Input
88 -- | The output interface. See 'Output'.
89 , outputIface :: Output
90 -- | Refresh the display. If other programs output to the terminal
91 -- and mess up the display then the application might want to
92 -- force a refresh using this function.
93 , refresh :: IO ()
94 -- | Clean up after vty. A call to this function is necessary to
95 -- cleanly restore the terminal state before application exit. The
96 -- above methods will throw an exception if executed after this is
97 -- executed. Idempotent.
98 , shutdown :: IO ()
99 , isShutdown :: IO Bool
100 }
102-- | Create a Vty handle. At most one handle should be created at a time
103-- for a given terminal device.
104--
105-- The specified configuration is added to the the configuration
106-- loaded by 'userConfig' with the 'userConfig' configuration taking
107-- precedence. See "Graphics.Vty.Config".
108--
109-- For most applications @mkVty defaultConfig@ is sufficient.
110mkVty :: Config -> IO Vty
111mkVty appConfig = do
112 config <- (<> appConfig) <$> userConfig
113 input <- inputForConfig config
114 out <- outputForConfig config
115 intMkVty input out
117intMkVty :: Input -> Output -> IO Vty
118intMkVty input out = do
119 reserveDisplay out
121 shutdownVar <- atomically $ newTVar False
122 let shutdownIo = do
123 alreadyShutdown <- atomically $ swapTVar shutdownVar True
124 when (not alreadyShutdown) $ do
125 shutdownInput input
126 releaseDisplay out
127 releaseTerminal out
129 let shutdownStatus = atomically $ readTVar shutdownVar
131 lastPicRef <- newIORef Nothing
132 lastUpdateRef <- newIORef Nothing
134 let innerUpdate inPic = do
135 b <- displayBounds out
136 mlastUpdate <- readIORef lastUpdateRef
137 updateData <- case mlastUpdate of
138 Nothing -> do
139 dc <- displayContext out b
140 outputPicture dc inPic
141 return (b, dc)
142 Just (lastBounds, lastContext) -> do
143 if b /= lastBounds
144 then do
145 dc <- displayContext out b
146 outputPicture dc inPic
147 return (b, dc)
148 else do
149 outputPicture lastContext inPic
150 return (b, lastContext)
151 writeIORef lastUpdateRef $ Just updateData
152 writeIORef lastPicRef $ Just inPic
154 let innerRefresh = do
155 writeIORef lastUpdateRef Nothing
156 bounds <- displayBounds out
157 dc <- displayContext out bounds
158 writeIORef (assumedStateRef $ contextDevice dc) initialAssumedState
159 mPic <- readIORef lastPicRef
160 maybe (return ()) innerUpdate mPic
162 let mkResize = uncurry EvResize <$> displayBounds out
163 gkey = do
164 k <- atomically $ readTChan $ _eventChannel input
165 case k of
166 (EvResize _ _) -> mkResize
167 _ -> return k
168 gkey' = do
169 k <- atomically $ tryReadTChan $ _eventChannel input
170 case k of
171 (Just (EvResize _ _)) -> Just <$> mkResize
172 _ -> return k
174 return $ Vty { update = innerUpdate
175 , nextEvent = gkey
176 , nextEventNonblocking = gkey'
177 , inputIface = input
178 , outputIface = out
179 , refresh = innerRefresh
180 , shutdown = shutdownIo
181 , isShutdown = shutdownStatus
182 }