{-# OPTIONS_GHC -fffi -Wall #-}
{-# CFILES gwinsz.c #-}
module Graphics.Vty.Cursor
    ( TermState, diffs, move, initTermOutput, clrscr, getwinsize, beep, flush,
      setCursorInvis, setCursorVis ) where

import Foreign.C.Types( CLong )
import Foreign.Ptr( Ptr )
import System.IO( stdout, hFlush )
import Foreign.Storable( peekElemOff, peek )
import Foreign.Marshal.Array( advancePtr )

import Control.Monad( when )

import Data.Bits( (.|.), (.&.), shiftR )

import Graphics.Vty.Types

-- | An object representing the current state of the terminal.
data TermState = TS {_tsRow :: !Int,  _tsColumn :: !Int, _tsAttr :: !Attr}

-- | Set up the terminal for output, and create an object representing the
-- initial state.  Also returns a function for shutting down the terminal access.
initTermOutput :: IO (TermState, IO ())
initTermOutput = do putStr reset
                    let uninit = do (_,sy) <- getwinsize_
                                    putStr (endterm sy)
                                    hFlush stdout
                    return (TS 0 0 attr, uninit)

-- | Force sent commands to be respected.
flush :: TermState -> IO TermState
flush ts = hFlush stdout >> return ts

-- | Move the cursor to (x,y); sx is the current width of the screen.
-- (this is a bit of a hack, forcing clients to cache that data)
move :: Int -> Int -> Int -> TermState -> IO TermState
move sx x y (TS ox oy at) = do movcsr y oy x ox sx
                               return (TS x y at)

-- | Put a (char,attr) at a given (x,y) cursor position; sx is the
-- current width of the screen. (this is a bit of a hack, forcing
-- clients to cache that data)
mvputch :: Int -> Int -> Int -> (Char,Attr) -> TermState -> IO TermState
mvputch sx x y (ch,att) ts | sx `seq` x `seq` y `seq` ch `seq` att `seq` ts `seq` False = undefined
mvputch sx x y (ch,att) (TS ox oy oat) = do movcsr y oy x ox sx
                                            when (att /= oat) $ chgatt att
                                            tputchar ch
                                            return (TS (x+1) y att)

-- | Reset the screen.
clrscr :: TermState -> IO TermState
clrscr _ts = do putStr reset
                return (TS 0 0 attr)

-- | Make the cursor invisible.
setCursorInvis :: TermState -> IO TermState
setCursorInvis ts = putStr civis >> return ts

-- | Make the cursor visible.
setCursorVis :: TermState -> IO TermState
setCursorVis ts = putStr cvis >> return ts

diffs :: Int -> Int -> Ptr Int -> Ptr Int -> TermState -> IO TermState
diffs w h old new state | w `seq` h `seq` old `seq` new `seq` state `seq` False = undefined
diffs w h old new state = diffs' 0 0 old new state
    where
      diffs' :: Int -> Int -> Ptr Int -> Ptr Int -> TermState -> IO TermState
      diffs' x y olp nwp stat
          | x `seq` y `seq` olp `seq` nwp `seq` stat `seq` False = undefined
          | y == h = return stat
          | x == w = diffs' 0 (y+1) olp nwp stat
          | otherwise = do ola <- peek olp
                           nwa <- peek nwp
                           olc <- peekElemOff olp 1
                           nwc <- peekElemOff nwp 1
                           stat' <- case (ola /= nwa || olc /= nwc) of
                                      False -> return stat
                                      True  -> mvputch w x y (toEnum nwc, Attr nwa) stat
                           diffs' (x+1) y (olp `advancePtr` 2) (nwp `advancePtr` 2) stat'

-- ANSI specific bits
chgatt :: Attr -> IO ()
chgatt (Attr bf)
      = putStr "\ESC[0;3" >> putShow (bf .&. 0xFF) >> putStr ";4" >> putShow ((bf `shiftR` 8) .&. 0xFF) >> 0x10000 ? ";1" >>
        0x20000 ? ";5" >> 0x40000 ? ";7" >> 0x80000 ? ";2" >> 0x100000 ? ";4" >> putStr "m"
    where
      {-# INLINE (?) #-}
      (?) :: Int -> [Char] -> IO ()
      field ? x | bf .&. field == 0 = return ()
                | otherwise         = putStr x

tputchar :: Char -> IO ()
tputchar ch | ich < 0x80    = pch ich
            | ich < 0x800   = pch (0xC0 .|. (ich `usr` 6)) >> pch (0x80 .|. (0x3F .&. ich))
            | ich < 0x10000 = pch (0xE0 .|. (ich `usr` 12)) >> pch (0x80 .|. (0x3F .&. (ich `usr` 6))) >>
                              pch (0x80 .|. (0x3F .&. ich))
            | otherwise     = pch (0xF0 .|. (ich `usr` 24)) >> pch (0x80 .|. (0x3F .&. (ich `usr` 12))) >>
                              pch (0x80 .|. (0x3F .&. (ich `usr` 6))) >> pch (0x80 .|. (0x3F .&. ich))
  where ich = fromEnum ch
        pch = putChar . toEnum
        usr = shiftR


-- we always use absolute motion between lines to work around diffs
movcsr :: Int -> Int -> Int -> Int -> Int -> IO ()
movcsr y oy x ox wid
  | y /= oy || ox == wid = putStr "\ESC[" >> putShow (y+1) >> putChar ';' >> putShow (x+1) >> putChar 'H'
  | x == ox              = return ()
  | x == (ox + 1)        = putStr "\ESC[C"
  | x > ox               = putStr "\ESC[" >> putShow (x - ox) >> putChar 'C'
  | otherwise            = putStr "\ESC[" >> putShow (ox - x) >> putChar 'D'
{-# INLINE movcsr #-}

putShow :: Int -> IO ()
putShow n = when (ini /= 0) (putShow ini) >> putChar (toEnum (lst + 48))
    where (ini, lst) = divMod n 10
-- {-# INLINE putShow #-}

foreign import ccall "gwinsz.h c_get_window_size" c_get_window_size :: IO CLong
getwinsize_ :: IO (Int,Int)
getwinsize_ = do (a,b) <- (`divMod` 65536) `fmap` c_get_window_size
                 return (fromIntegral b, fromIntegral a)
getwinsize :: TermState -> IO ((Int,Int), TermState)
getwinsize ts = do (a,b) <- (`divMod` 65536) `fmap` c_get_window_size
                   return ((fromIntegral b, fromIntegral a), ts)


csi, cvis, civis, reset :: String

csi = "\ESC["

reset =  "\ESCc"  ++ -- full reset
      utf8CharSet ++ 
      setCursorPosition 1 1 ++
      "\ESC[2J" -- erase all

setCursorPosition :: Int -> Int -> String
setCursorPosition row column = csi ++ show row ++ ";" ++ show column ++ "H"

-- | Make the terminal beep.
beep :: IO ()
beep = putStr "\BEL" 

-- | Show the cursor
cvis = csi ++ "?25h" 

-- | Hide the cursor
civis = csi ++ "?25l"

defaultCharSet, utf8CharSet :: String
defaultCharSet = "\ESC%@"
utf8CharSet    = "\ESC%G"

-- | Restore the terminal to a good state for the shell.
-- Parameter is the line where the cursor should appear.
endterm :: Int -> [Char]
endterm sy = setCursorPosition sy 1 ++
             "\ESC[0;39;49m" ++ -- graphic rendition
             defaultCharSet ++ 
             "\CR" ++ 
             cvis ++
             "\ESC[K" -- erase line