{-# 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