{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
--  | Output interface.
--
--  Access to the current terminal or a specific terminal device.
--
--  See also:
--
--  1. "Graphics.Vty.Output": This instantiates an abtract interface to the terminal interface based
--  on the TERM and COLORTERM environment variables. 
--  
--  2. "Graphics.Vty.Output.Interface": Defines the generic interface all terminals need to implement.
--
--  3. "Graphics.Vty.Output.TerminfoBased": Defines a terminal instance that uses terminfo for all
--  control strings.  No attempt is made to change the character set to UTF-8 for these terminals.
--  I don't know a way to reliably determine if that is required or how to do so.
--
--  4. "Graphics.Vty.Output.XTermColor": This module contains an interface suitable for xterm-like
--  terminals. These are the terminals where TERM == xterm. This does use terminfo for as many
--  control codes as possible. 
module Graphics.Vty.Output ( module Graphics.Vty.Output
                           , Output(..) -- \todo hide constructors
                           , AssumedState(..)
                           , DisplayContext(..) -- \todo hide constructors
                           , outputPicture
                           , displayContext
                           )
    where


import Graphics.Vty.Prelude

import Graphics.Vty.Config

import Graphics.Vty.Output.Interface
import Graphics.Vty.Output.MacOSX as MacOSX
import Graphics.Vty.Output.XTermColor as XTermColor
import Graphics.Vty.Output.TerminfoBased as TerminfoBased

import Blaze.ByteString.Builder (writeToByteString)

import Control.Monad.Trans

import Data.Monoid (mappend)
import Data.List (isPrefixOf)

import System.Posix.Env (getEnv)

-- | Returns a `Output` for the terminal specified in `Config`
--
-- The specific Output implementation used is hidden from the API user. All terminal implementations
-- are assumed to perform more, or less, the same. Currently, all implementations use terminfo for at
-- least some terminal specific information.
--
-- Specifics about it being based on terminfo are hidden from the API user. If a terminal
-- implementation is developed for a terminal without terminfo support then Vty should work as
-- expected on that terminal.
--
-- Selection of a terminal is done as follows:
--
--      * If TERM == xterm
--          then the terminal might be one of the Mac OS X .app terminals. Check if that might be
--          the case and use MacOSX if so.
--          otherwise use XTermColor.
--
--      * for any other TERM value TerminfoBased is used.
--
-- To differentiate between Mac OS X terminals this uses the TERM_PROGRAM environment variable.
-- However, an xterm started by Terminal or iTerm *also* has TERM_PROGRAM defined since the
-- environment variable is not reset/cleared by xterm. However a Terminal.app or iTerm.app started
-- from an xterm under X11 on mac os x will likely be done via open. Since this does not propogate
-- environment variables (I think?) this assumes that XTERM_VERSION will never be set for a true
-- Terminal.app or iTerm.app session.
--
-- \todo add an implementation for windows that does not depend on terminfo. Should be installable
-- with only what is provided in the haskell platform. Use ansi-terminal
outputForConfig :: Config -> IO Output
outputForConfig Config{ outputFd = Just fd, termName = Just termName, .. } = do
    t <- if "xterm" `isPrefixOf` termName
        then do
            -- the explicit nature of the code below was nice for development, not needed anymore.
            maybeTerminalApp <- getEnv "TERM_PROGRAM"
            case maybeTerminalApp of
                Nothing
                    -> XTermColor.reserveTerminal termName fd
                Just v | v == "Apple_Terminal" || v == "iTerm.app" 
                    -> do
                        maybeXterm <- getEnv "XTERM_VERSION"
                        case maybeXterm of
                            Nothing -> MacOSX.reserveTerminal v fd
                            Just _  -> XTermColor.reserveTerminal termName fd
                -- Assume any other terminal that sets TERM_PROGRAM to not be an OS X terminal.app
                -- like terminal?
                _   -> XTermColor.reserveTerminal termName fd
        -- Not an xterm-like terminal. try for generic terminfo.
        else TerminfoBased.reserveTerminal termName fd
    return t
outputForConfig config = mappend config <$> standardIOConfig >>= outputForConfig

-- | Sets the cursor position to the given output column and row. 
--
-- This is not necessarially the same as the character position with the same coordinates.
-- Characters can be a variable number of columns in width.
--
-- Currently, the only way to set the cursor position to a given character coordinate is to specify
-- the coordinate in the Picture instance provided to outputPicture or refresh.
setCursorPos :: MonadIO m => Output -> Int -> Int -> m ()
setCursorPos t x y = do
    bounds <- displayBounds t
    when (x >= 0 && x < regionWidth bounds && y >= 0 && y < regionHeight bounds) $ do
        dc <- displayContext t bounds
        liftIO $ outputByteBuffer t $ writeToByteString $ writeMoveCursor dc x y

-- | Hides the cursor
hideCursor :: MonadIO m => Output -> m ()
hideCursor t = do
    bounds <- displayBounds t
    dc <- displayContext t bounds
    liftIO $ outputByteBuffer t $ writeToByteString $ writeHideCursor dc
    
-- | Shows the cursor
showCursor :: MonadIO m => Output -> m ()
showCursor t = do
    bounds <- displayBounds t
    dc <- displayContext t bounds
    liftIO $ outputByteBuffer t $ writeToByteString $ writeShowCursor dc