1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
{-# OPTIONS_GHC -fffi #-}
{-# CFILES gwinsz.c #-}
module Graphics.Vty (Vty(..), beep, mkVty, module Graphics.Vty.Types, Key(..), Modifier(..), Button(..), Event(..)) where
import Control.Concurrent
import Graphics.Vty.Types hiding (Color, Attr, Image, fillSeg)
import Graphics.Vty.Types (Color(), Attr(), Image())
import qualified Graphics.Vty.Types as T(Color(..), Attr(..), Image(..), fillSeg)
import Graphics.Vty.Cursor
import Graphics.Vty.LLInput
import Foreign.Marshal.Array
import Foreign.Marshal.Alloc
import Foreign.Marshal.Error
import Foreign.Storable
import Foreign.Ptr
-- |The main object. At most one should be created.
data Vty = Vty { -- |Update the screen to reflect the contents of a 'Picture'.
-- This is not currently threadsafe.
update :: Picture -> IO (),
-- |Get one Event object, blocking if necessary.
getEvent :: IO Event,
-- |Get the size of the display.
getSize :: IO (Int,Int),
-- |Clean up after vty.
shutdown :: IO () }
-- |Set up the state object for using vty. At most one state object should be
-- created at a time.
mkVty :: IO Vty
mkVty = do (tstate, endo) <- initTermOutput
(kvar, endi) <- initTermInput
state <- newMVar =<< fmap ((,,,) tstate (-1) (-1)) (mallocArray 2)
intMkVty kvar (endi >> endo) state
intMkVty :: IO Event -> IO () -> MVar (TermState, Int, Int, Ptr Int) -> IO Vty
intMkVty kvar fend rstate = return rec where
ulift :: (TermState -> IO (a, TermState)) -> IO a
ulift f = modifyMVar rstate (\(v,a,b,c) -> fmap (\(x,y) -> ((y,a,b,c),x)) (f v))
rec = Vty { update = update' , getEvent = gkey , getSize = ulift getwinsize ,
shutdown = fend }
update' (Pic nc (T.Image wr w h)) = modifyMVar_ rstate $ \(ts0, fbw, fbh, oldptr) -> do
(shd,ts1) <- case (fbw,fbh) == (w,h) of
True -> return (oldptr,ts0)
False -> do new <- throwIfNull "clrscr realloc" $ reallocArray oldptr (w * h * 2)
T.fillSeg attr ' ' new (new `advancePtr` (w * h * 2))
fmap ((,) new) (clrscr ts0)
fb <- throwIfNull "update alloc" $ mallocArray (w * h * 2)
wr (w * 2 * sizeOf (undefined :: Int)) fb
ts2 <- diffs w h shd fb ts1
ts3 <- case nc of NoCursor -> setCursorInvis ts2
Cursor x y -> move w x y ts2 >>= setCursorVis
ts4 <- flush ts3
free shd
return (ts4, w, h, fb)
inval = modifyMVar rstate $ \(ts0,_,_,p) ->
fmap (\((x,y),ts1) -> ((ts1,(-1),(-1),p),EvResize x y)) (getwinsize ts0)
gkey = do k <- kvar
case k of (EvKey (KASCII 'l') [MCtrl]) -> inval
(EvResize _ _) -> inval
_ -> return k
|
