{-# LINE 1 "System\\Win32\\Console.hsc" #-}

{-# LINE 2 "System\\Win32\\Console.hsc" #-}
{-# LANGUAGE Safe #-}

{-# LINE 6 "System\\Win32\\Console.hsc" #-}
-----------------------------------------------------------------------------

-- |

-- Module      :  System.Win32.Console

-- Copyright   :  (c) University of Glasgow 2006

-- License     :  BSD-style (see the file LICENSE)

--

-- Maintainer  :  Esa Ilari Vuokko <ei@vuokko.info>

-- Stability   :  provisional

-- Portability :  portable

--

-- A collection of FFI declarations for interfacing with Win32 Console API

--

-----------------------------------------------------------------------------


module System.Win32.Console (
        -- * Console code pages

        getConsoleCP,
        setConsoleCP,
        getConsoleOutputCP,
        setConsoleOutputCP,
        -- * Ctrl events

        CtrlEvent, cTRL_C_EVENT, cTRL_BREAK_EVENT,
        generateConsoleCtrlEvent,
        -- * Command line

        commandLineToArgv,
        -- * Screen buffer

        CONSOLE_SCREEN_BUFFER_INFO(..),
        COORD(..),
        SMALL_RECT(..),
        getConsoleScreenBufferInfo,
        getCurrentConsoleScreenBufferInfo
  ) where



#include "windows_cconv.h"


import System.Win32.Types
import Graphics.Win32.Misc

import Foreign.C.Types (CInt(..))
import Foreign.C.String (withCWString, CWString)
import Foreign.Ptr (Ptr)
import Foreign.Storable (Storable(..))
import Foreign.Marshal.Array (peekArray)
import Foreign.Marshal.Alloc (alloca)

foreign import WINDOWS_CCONV unsafe "windows.h GetConsoleCP"
        getConsoleCP :: IO UINT

foreign import WINDOWS_CCONV unsafe "windows.h SetConsoleCP"
        setConsoleCP :: UINT -> IO ()

foreign import WINDOWS_CCONV unsafe "windows.h GetConsoleOutputCP"
        getConsoleOutputCP :: IO UINT

foreign import WINDOWS_CCONV unsafe "windows.h SetConsoleOutputCP"
        setConsoleOutputCP :: UINT -> IO ()

type CtrlEvent = DWORD
cTRL_C_EVENT       :: CtrlEvent
cTRL_C_EVENT       =  0
cTRL_BREAK_EVENT   :: CtrlEvent
cTRL_BREAK_EVENT   =  1

{-# LINE 70 "System\\Win32\\Console.hsc" #-}

generateConsoleCtrlEvent :: CtrlEvent -> DWORD -> IO ()
generateConsoleCtrlEvent e p
    = failIfFalse_
        "generateConsoleCtrlEvent"
        $ c_GenerateConsoleCtrlEvent e p

foreign import WINDOWS_CCONV safe "windows.h GenerateConsoleCtrlEvent"
    c_GenerateConsoleCtrlEvent :: CtrlEvent -> DWORD -> IO BOOL

foreign import WINDOWS_CCONV unsafe "Shellapi.h CommandLineToArgvW"
     c_CommandLineToArgvW :: CWString -> Ptr CInt -> IO (Ptr CWString)

-- | This function can be used to parse commandline arguments and return

--   the split up arguments as elements in a list.

commandLineToArgv :: String -> IO [String]
commandLineToArgv []  = return []
commandLineToArgv arg =
  do withCWString arg $ \c_arg -> do
       alloca $ \c_size -> do
         res <- c_CommandLineToArgvW c_arg c_size
         size <- peek c_size
         args <- peekArray (fromIntegral size) res
         _ <- localFree res
         mapM peekTString args

data CONSOLE_SCREEN_BUFFER_INFO = CONSOLE_SCREEN_BUFFER_INFO
    { dwSize              :: COORD
    , dwCursorPosition    :: COORD
    , wAttributes         :: WORD
    , srWindow            :: SMALL_RECT
    , dwMaximumWindowSize :: COORD
    } deriving (Show, Eq)

instance Storable CONSOLE_SCREEN_BUFFER_INFO where
    sizeOf = const (22)
{-# LINE 106 "System\\Win32\\Console.hsc" #-}
    alignment _ = 2
{-# LINE 107 "System\\Win32\\Console.hsc" #-}
    peek buf = do
        dwSize'              <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) buf
{-# LINE 109 "System\\Win32\\Console.hsc" #-}
        dwCursorPosition'    <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) buf
{-# LINE 110 "System\\Win32\\Console.hsc" #-}
        wAttributes'         <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) buf
{-# LINE 111 "System\\Win32\\Console.hsc" #-}
        srWindow'            <- ((\hsc_ptr -> peekByteOff hsc_ptr 10)) buf
{-# LINE 112 "System\\Win32\\Console.hsc" #-}
        dwMaximumWindowSize' <- ((\hsc_ptr -> peekByteOff hsc_ptr 18)) buf
{-# LINE 113 "System\\Win32\\Console.hsc" #-}
        return $ CONSOLE_SCREEN_BUFFER_INFO dwSize' dwCursorPosition' wAttributes' srWindow' dwMaximumWindowSize'
    poke buf info = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) buf (dwSize info)
{-# LINE 116 "System\\Win32\\Console.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) buf (dwCursorPosition info)
{-# LINE 117 "System\\Win32\\Console.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) buf (wAttributes info)
{-# LINE 118 "System\\Win32\\Console.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 10)) buf (srWindow info)
{-# LINE 119 "System\\Win32\\Console.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 18)) buf (dwMaximumWindowSize info)
{-# LINE 120 "System\\Win32\\Console.hsc" #-}

data COORD = COORD
    { x :: SHORT
    , y :: SHORT
    } deriving (Show, Eq)

instance Storable COORD where
    sizeOf = const (4)
{-# LINE 128 "System\\Win32\\Console.hsc" #-}
    alignment _ = 2
{-# LINE 129 "System\\Win32\\Console.hsc" #-}
    peek buf = do
        x' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) buf
{-# LINE 131 "System\\Win32\\Console.hsc" #-}
        y' <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) buf
{-# LINE 132 "System\\Win32\\Console.hsc" #-}
        return $ COORD x' y'
    poke buf coord = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) buf (x coord)
{-# LINE 135 "System\\Win32\\Console.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 2)) buf (y coord)
{-# LINE 136 "System\\Win32\\Console.hsc" #-}

data SMALL_RECT = SMALL_RECT
    { left   :: SHORT
    , top    :: SHORT
    , right  :: SHORT
    , bottom :: SHORT
    } deriving (Show, Eq)

instance Storable SMALL_RECT where
    sizeOf _ = (8)
{-# LINE 146 "System\\Win32\\Console.hsc" #-}
    alignment _ = 2
{-# LINE 147 "System\\Win32\\Console.hsc" #-}
    peek buf = do
        left'   <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) buf
{-# LINE 149 "System\\Win32\\Console.hsc" #-}
        top'    <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) buf
{-# LINE 150 "System\\Win32\\Console.hsc" #-}
        right'  <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) buf
{-# LINE 151 "System\\Win32\\Console.hsc" #-}
        bottom' <- ((\hsc_ptr -> peekByteOff hsc_ptr 6)) buf
{-# LINE 152 "System\\Win32\\Console.hsc" #-}
        return $ SMALL_RECT left' top' right' bottom'
    poke buf small_rect = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) buf (left small_rect)
{-# LINE 155 "System\\Win32\\Console.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 2)) buf (top small_rect)
{-# LINE 156 "System\\Win32\\Console.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) buf (right small_rect)
{-# LINE 157 "System\\Win32\\Console.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 6)) buf (bottom small_rect)
{-# LINE 158 "System\\Win32\\Console.hsc" #-}

foreign import WINDOWS_CCONV safe "windows.h GetConsoleScreenBufferInfo"
    c_GetConsoleScreenBufferInfo :: HANDLE -> Ptr CONSOLE_SCREEN_BUFFER_INFO -> IO BOOL

getConsoleScreenBufferInfo :: HANDLE -> IO CONSOLE_SCREEN_BUFFER_INFO
getConsoleScreenBufferInfo h = alloca $ \ptr -> do
    failIfFalse_ "GetConsoleScreenBufferInfo" $ c_GetConsoleScreenBufferInfo h ptr
    peek ptr

getCurrentConsoleScreenBufferInfo :: IO CONSOLE_SCREEN_BUFFER_INFO
getCurrentConsoleScreenBufferInfo = do
    h <- failIf (== nullHANDLE) "getStdHandle" $ getStdHandle sTD_OUTPUT_HANDLE
    getConsoleScreenBufferInfo h