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
data Vty = Vty {
update :: Picture -> IO (),
getEvent :: IO Event,
getSize :: IO (Int,Int),
refresh :: IO (),
shutdown :: IO () }
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
, refresh = refr
, 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)
refr = modifyMVar_ rstate $ \(ts0,_,_,p) ->
fmap (\(_,ts1) -> (ts1,(1),(1),p)) (getwinsize ts0)
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 (EvResize _ _) -> inval
_ -> return k