{-# OPTIONS_GHC -fffi #-}
{-# CFILES gwinsz.c #-}

-- Good sources of documentation for terminal programming are:
-- vt100 control sequences: http://vt100.net/docs/vt100-ug/chapter3.html#S3.3.3
-- Xterm control sequences: http://invisible-island.net/xterm/ctlseqs/ctlseqs.html

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),
                 -- |Refresh the display. Normally the library takes care of refreshing. 
                 -- Nonetheless, some other program might output to the terminal and mess the display.
                 -- In that case the user might want to force a refresh.
                 refresh :: IO (),
                 -- |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
           , 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)

 -- just refresh
 refr = modifyMVar_ rstate $ \(ts0,_,_,p) ->
         fmap (\(_,ts1) -> (ts1,(-1),(-1),p)) (getwinsize ts0)

 -- refresh and return a state event
 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