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



{-# LINE 2 "System\\Win32\\Info.hsc" #-}

{-# LANGUAGE Safe #-}



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

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

-- |

-- Module      :  System.Win32.Info

-- Copyright   :  (c) Alastair Reid, 1997-2003

-- License     :  BSD-style (see the file libraries/base/LICENSE)

--

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

-- Stability   :  provisional

-- Portability :  portable

--

-- A collection of FFI declarations for interfacing with Win32.

--

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



module System.Win32.Info where



import Control.Exception (catch)

import Foreign.Marshal.Alloc (alloca)

import Foreign.Marshal.Utils (with, maybeWith)

import Foreign.Marshal.Array (allocaArray)

import Foreign.Ptr (Ptr, nullPtr)

import Foreign.Storable (Storable(..))

import System.IO.Error (isDoesNotExistError)

import System.Win32.Types (DWORD, LPDWORD, LPCTSTR, LPTSTR, LPVOID, UINT, WORD)

import System.Win32.Types (failIfFalse_, peekTStringLen, withTString, try)





{-# LINE 35 "System\\Win32\\Info.hsc" #-}



#include "windows_cconv.h"









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

-- Environment Strings

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



-- %fun ExpandEnvironmentStrings :: String -> IO String



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

-- Computer Name

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



-- %fun GetComputerName :: IO String

-- %fun SetComputerName :: String -> IO ()

-- %end free(arg1)



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

-- Hardware Profiles

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



-- %fun GetCurrentHwProfile :: IO HW_PROFILE_INFO



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

-- Keyboard Type

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



-- %fun GetKeyboardType :: KeyboardTypeKind -> IO KeyboardType



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

-- System Color

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



type SystemColor   = UINT



-- ToDo: This list is out of date.



cOLOR_SCROLLBAR       :: SystemColor

cOLOR_SCROLLBAR       =  0

cOLOR_BACKGROUND      :: SystemColor

cOLOR_BACKGROUND      =  1

cOLOR_ACTIVECAPTION   :: SystemColor

cOLOR_ACTIVECAPTION   =  2

cOLOR_INACTIVECAPTION  :: SystemColor

cOLOR_INACTIVECAPTION  =  3

cOLOR_MENU            :: SystemColor

cOLOR_MENU            =  4

cOLOR_WINDOW          :: SystemColor

cOLOR_WINDOW          =  5

cOLOR_WINDOWFRAME     :: SystemColor

cOLOR_WINDOWFRAME     =  6

cOLOR_MENUTEXT        :: SystemColor

cOLOR_MENUTEXT        =  7

cOLOR_WINDOWTEXT      :: SystemColor

cOLOR_WINDOWTEXT      =  8

cOLOR_CAPTIONTEXT     :: SystemColor

cOLOR_CAPTIONTEXT     =  9

cOLOR_ACTIVEBORDER    :: SystemColor

cOLOR_ACTIVEBORDER    =  10

cOLOR_INACTIVEBORDER  :: SystemColor

cOLOR_INACTIVEBORDER  =  11

cOLOR_APPWORKSPACE    :: SystemColor

cOLOR_APPWORKSPACE    =  12

cOLOR_HIGHLIGHT       :: SystemColor

cOLOR_HIGHLIGHT       =  13

cOLOR_HIGHLIGHTTEXT   :: SystemColor

cOLOR_HIGHLIGHTTEXT   =  14

cOLOR_BTNFACE         :: SystemColor

cOLOR_BTNFACE         =  15

cOLOR_BTNSHADOW       :: SystemColor

cOLOR_BTNSHADOW       =  16

cOLOR_GRAYTEXT        :: SystemColor

cOLOR_GRAYTEXT        =  17

cOLOR_BTNTEXT         :: SystemColor

cOLOR_BTNTEXT         =  18

cOLOR_INACTIVECAPTIONTEXT  :: SystemColor

cOLOR_INACTIVECAPTIONTEXT  =  19

cOLOR_BTNHIGHLIGHT    :: SystemColor

cOLOR_BTNHIGHLIGHT    =  20



{-# LINE 98 "System\\Win32\\Info.hsc" #-}



-- %fun GetSysColor :: SystemColor -> IO COLORREF

-- %fun SetSysColors :: [(SystemColor,COLORREF)] -> IO ()



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

-- Standard Directories

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



getSystemDirectory :: IO String

getSystemDirectory = try "GetSystemDirectory" c_getSystemDirectory 512



getWindowsDirectory :: IO String

getWindowsDirectory = try "GetWindowsDirectory" c_getWindowsDirectory 512



getCurrentDirectory :: IO String

getCurrentDirectory = try "GetCurrentDirectory" (flip c_getCurrentDirectory) 512

getTemporaryDirectory :: IO String

getTemporaryDirectory = try "GetTempPath" (flip c_getTempPath) 512



getFullPathName :: FilePath -> IO FilePath

getFullPathName name = do

  withTString name $ \ c_name ->

    try "getFullPathName"

      (\buf len -> c_GetFullPathName c_name len buf nullPtr) 512



getLongPathName :: FilePath -> IO FilePath

getLongPathName name = do

  withTString name $ \ c_name ->

    try "getLongPathName"

      (c_GetLongPathName c_name) 512



getShortPathName :: FilePath -> IO FilePath

getShortPathName name = do

  withTString name $ \ c_name ->

    try "getShortPathName"

      (c_GetShortPathName c_name) 512



searchPath :: Maybe String -> FilePath -> Maybe String -> IO (Maybe FilePath)

searchPath path filename ext =

  maybe ($ nullPtr) withTString path $ \p_path ->

  withTString filename $ \p_filename ->

  maybeWith withTString ext      $ \p_ext ->

  alloca $ \ppFilePart -> (do

    s <- try "searchPath" (\buf len -> c_SearchPath p_path p_filename p_ext

                          len buf ppFilePart) 512

    return (Just s))

     `catch` \e -> if isDoesNotExistError e

                       then return Nothing

                       else ioError e



foreign import WINDOWS_CCONV unsafe "GetWindowsDirectoryW"

  c_getWindowsDirectory :: LPTSTR -> UINT -> IO UINT



foreign import WINDOWS_CCONV unsafe "GetSystemDirectoryW"

  c_getSystemDirectory :: LPTSTR -> UINT -> IO UINT



foreign import WINDOWS_CCONV unsafe "GetCurrentDirectoryW"

  c_getCurrentDirectory :: DWORD -> LPTSTR -> IO UINT



foreign import WINDOWS_CCONV unsafe "GetTempPathW"

  c_getTempPath :: DWORD -> LPTSTR -> IO UINT



foreign import WINDOWS_CCONV unsafe "GetFullPathNameW"

  c_GetFullPathName :: LPCTSTR -> DWORD -> LPTSTR -> Ptr LPTSTR -> IO DWORD



foreign import WINDOWS_CCONV unsafe "GetLongPathNameW"

  c_GetLongPathName :: LPCTSTR -> LPTSTR -> DWORD -> IO DWORD



foreign import WINDOWS_CCONV unsafe "GetShortPathNameW"

  c_GetShortPathName :: LPCTSTR -> LPTSTR -> DWORD -> IO DWORD



foreign import WINDOWS_CCONV unsafe "SearchPathW"

  c_SearchPath :: LPCTSTR -> LPCTSTR -> LPCTSTR -> DWORD -> LPTSTR -> Ptr LPTSTR

               -> IO DWORD



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

-- System Info (Info about processor and memory subsystem)

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



data ProcessorArchitecture = PaUnknown WORD | PaIntel | PaMips | PaAlpha | PaPpc | PaIa64 | PaIa32OnIa64 | PaAmd64

    deriving (Show,Eq)



instance Storable ProcessorArchitecture where

    sizeOf _ = sizeOf (undefined::WORD)

    alignment _ = alignment (undefined::WORD)

    poke buf pa = pokeByteOff buf 0 $ case pa of

        PaUnknown w -> w

        PaIntel     -> 0

{-# LINE 186 "System\\Win32\\Info.hsc" #-}

        PaMips      -> 1

{-# LINE 187 "System\\Win32\\Info.hsc" #-}

        PaAlpha     -> 2

{-# LINE 188 "System\\Win32\\Info.hsc" #-}

        PaPpc       -> 3

{-# LINE 189 "System\\Win32\\Info.hsc" #-}

        PaIa64      -> 6

{-# LINE 190 "System\\Win32\\Info.hsc" #-}



{-# LINE 191 "System\\Win32\\Info.hsc" #-}

        PaIa32OnIa64 -> 10

{-# LINE 192 "System\\Win32\\Info.hsc" #-}



{-# LINE 193 "System\\Win32\\Info.hsc" #-}

        PaAmd64     -> 9

{-# LINE 194 "System\\Win32\\Info.hsc" #-}

    peek buf = do

        v <- (peekByteOff buf 0:: IO WORD)

        return $ case v of

            (0) -> PaIntel

{-# LINE 198 "System\\Win32\\Info.hsc" #-}

            (1)  -> PaMips

{-# LINE 199 "System\\Win32\\Info.hsc" #-}

            (2) -> PaAlpha

{-# LINE 200 "System\\Win32\\Info.hsc" #-}

            (3)   -> PaPpc

{-# LINE 201 "System\\Win32\\Info.hsc" #-}

            (6)  -> PaIa64

{-# LINE 202 "System\\Win32\\Info.hsc" #-}



{-# LINE 203 "System\\Win32\\Info.hsc" #-}

            (10) -> PaIa32OnIa64

{-# LINE 204 "System\\Win32\\Info.hsc" #-}



{-# LINE 205 "System\\Win32\\Info.hsc" #-}

            (9) -> PaAmd64

{-# LINE 206 "System\\Win32\\Info.hsc" #-}

            w                                   -> PaUnknown w



data SYSTEM_INFO = SYSTEM_INFO

    { siProcessorArchitecture :: ProcessorArchitecture

    , siPageSize :: DWORD

    , siMinimumApplicationAddress, siMaximumApplicationAddress :: LPVOID

    , siActiveProcessorMask :: DWORD

    , siNumberOfProcessors :: DWORD

    , siProcessorType :: DWORD

    , siAllocationGranularity :: DWORD

    , siProcessorLevel :: WORD

    , siProcessorRevision :: WORD

    } deriving (Show)



instance Storable SYSTEM_INFO where

    sizeOf = const (48)

{-# LINE 222 "System\\Win32\\Info.hsc" #-}

    alignment _ = 8

{-# LINE 223 "System\\Win32\\Info.hsc" #-}

    poke buf si = do

        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) buf (siProcessorArchitecture si)

{-# LINE 225 "System\\Win32\\Info.hsc" #-}

        ((\hsc_ptr -> pokeByteOff hsc_ptr 4))             buf (siPageSize si)

{-# LINE 226 "System\\Win32\\Info.hsc" #-}

        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) buf (siMinimumApplicationAddress si)

{-# LINE 227 "System\\Win32\\Info.hsc" #-}

        ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) buf (siMaximumApplicationAddress si)

{-# LINE 228 "System\\Win32\\Info.hsc" #-}

        ((\hsc_ptr -> pokeByteOff hsc_ptr 24))  buf (siActiveProcessorMask si)

{-# LINE 229 "System\\Win32\\Info.hsc" #-}

        ((\hsc_ptr -> pokeByteOff hsc_ptr 32))   buf (siNumberOfProcessors si)

{-# LINE 230 "System\\Win32\\Info.hsc" #-}

        ((\hsc_ptr -> pokeByteOff hsc_ptr 36))        buf (siProcessorType si)

{-# LINE 231 "System\\Win32\\Info.hsc" #-}

        ((\hsc_ptr -> pokeByteOff hsc_ptr 40)) buf (siAllocationGranularity si)

{-# LINE 232 "System\\Win32\\Info.hsc" #-}

        ((\hsc_ptr -> pokeByteOff hsc_ptr 44))        buf (siProcessorLevel si)

{-# LINE 233 "System\\Win32\\Info.hsc" #-}

        ((\hsc_ptr -> pokeByteOff hsc_ptr 46))     buf (siProcessorRevision si)

{-# LINE 234 "System\\Win32\\Info.hsc" #-}



    peek buf = do

        processorArchitecture <-

            ((\hsc_ptr -> peekByteOff hsc_ptr 0)) buf

{-# LINE 238 "System\\Win32\\Info.hsc" #-}

        pageSize            <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) buf

{-# LINE 239 "System\\Win32\\Info.hsc" #-}

        minimumApplicationAddress <-

            ((\hsc_ptr -> peekByteOff hsc_ptr 8)) buf

{-# LINE 241 "System\\Win32\\Info.hsc" #-}

        maximumApplicationAddress <-

            ((\hsc_ptr -> peekByteOff hsc_ptr 16)) buf

{-# LINE 243 "System\\Win32\\Info.hsc" #-}

        activeProcessorMask <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) buf

{-# LINE 244 "System\\Win32\\Info.hsc" #-}

        numberOfProcessors  <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) buf

{-# LINE 245 "System\\Win32\\Info.hsc" #-}

        processorType       <- ((\hsc_ptr -> peekByteOff hsc_ptr 36)) buf

{-# LINE 246 "System\\Win32\\Info.hsc" #-}

        allocationGranularity <-

            ((\hsc_ptr -> peekByteOff hsc_ptr 40)) buf

{-# LINE 248 "System\\Win32\\Info.hsc" #-}

        processorLevel      <- ((\hsc_ptr -> peekByteOff hsc_ptr 44)) buf

{-# LINE 249 "System\\Win32\\Info.hsc" #-}

        processorRevision   <- ((\hsc_ptr -> peekByteOff hsc_ptr 46)) buf

{-# LINE 250 "System\\Win32\\Info.hsc" #-}

        return $ SYSTEM_INFO {

            siProcessorArchitecture     = processorArchitecture,

            siPageSize                  = pageSize,

            siMinimumApplicationAddress = minimumApplicationAddress,

            siMaximumApplicationAddress = maximumApplicationAddress,

            siActiveProcessorMask       = activeProcessorMask,

            siNumberOfProcessors        = numberOfProcessors,

            siProcessorType             = processorType,

            siAllocationGranularity     = allocationGranularity,

            siProcessorLevel            = processorLevel,

            siProcessorRevision         = processorRevision

            }



foreign import WINDOWS_CCONV unsafe "windows.h GetSystemInfo"

    c_GetSystemInfo :: Ptr SYSTEM_INFO -> IO ()



getSystemInfo :: IO SYSTEM_INFO

getSystemInfo = alloca $ \ret -> do

    c_GetSystemInfo ret

    peek ret



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

-- System metrics

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



type SMSetting = UINT



sM_ARRANGE            :: SMSetting

sM_ARRANGE            =  56

sM_CLEANBOOT          :: SMSetting

sM_CLEANBOOT          =  67

sM_CMETRICS           :: SMSetting

sM_CMETRICS           =  97

sM_CMOUSEBUTTONS      :: SMSetting

sM_CMOUSEBUTTONS      =  43

sM_CXBORDER           :: SMSetting

sM_CXBORDER           =  5

sM_CYBORDER           :: SMSetting

sM_CYBORDER           =  6

sM_CXCURSOR           :: SMSetting

sM_CXCURSOR           =  13

sM_CYCURSOR           :: SMSetting

sM_CYCURSOR           =  14

sM_CXDLGFRAME         :: SMSetting

sM_CXDLGFRAME         =  7

sM_CYDLGFRAME         :: SMSetting

sM_CYDLGFRAME         =  8

sM_CXDOUBLECLK        :: SMSetting

sM_CXDOUBLECLK        =  36

sM_CYDOUBLECLK        :: SMSetting

sM_CYDOUBLECLK        =  37

sM_CXDRAG             :: SMSetting

sM_CXDRAG             =  68

sM_CYDRAG             :: SMSetting

sM_CYDRAG             =  69

sM_CXEDGE             :: SMSetting

sM_CXEDGE             =  45

sM_CYEDGE             :: SMSetting

sM_CYEDGE             =  46

sM_CXFRAME            :: SMSetting

sM_CXFRAME            =  32

sM_CYFRAME            :: SMSetting

sM_CYFRAME            =  33

sM_CXFULLSCREEN       :: SMSetting

sM_CXFULLSCREEN       =  16

sM_CYFULLSCREEN       :: SMSetting

sM_CYFULLSCREEN       =  17

sM_CXHSCROLL          :: SMSetting

sM_CXHSCROLL          =  21

sM_CYVSCROLL          :: SMSetting

sM_CYVSCROLL          =  20

sM_CXICON             :: SMSetting

sM_CXICON             =  11

sM_CYICON             :: SMSetting

sM_CYICON             =  12

sM_CXICONSPACING      :: SMSetting

sM_CXICONSPACING      =  38

sM_CYICONSPACING      :: SMSetting

sM_CYICONSPACING      =  39

sM_CXMAXIMIZED        :: SMSetting

sM_CXMAXIMIZED        =  61

sM_CYMAXIMIZED        :: SMSetting

sM_CYMAXIMIZED        =  62

sM_CXMENUCHECK        :: SMSetting

sM_CXMENUCHECK        =  71

sM_CYMENUCHECK        :: SMSetting

sM_CYMENUCHECK        =  72

sM_CXMENUSIZE         :: SMSetting

sM_CXMENUSIZE         =  54

sM_CYMENUSIZE         :: SMSetting

sM_CYMENUSIZE         =  55

sM_CXMIN              :: SMSetting

sM_CXMIN              =  28

sM_CYMIN              :: SMSetting

sM_CYMIN              =  29

sM_CXMINIMIZED        :: SMSetting

sM_CXMINIMIZED        =  57

sM_CYMINIMIZED        :: SMSetting

sM_CYMINIMIZED        =  58

sM_CXMINTRACK         :: SMSetting

sM_CXMINTRACK         =  34

sM_CYMINTRACK         :: SMSetting

sM_CYMINTRACK         =  35

sM_CXSCREEN           :: SMSetting

sM_CXSCREEN           =  0

sM_CYSCREEN           :: SMSetting

sM_CYSCREEN           =  1

sM_CXSIZE             :: SMSetting

sM_CXSIZE             =  30

sM_CYSIZE             :: SMSetting

sM_CYSIZE             =  31

sM_CXSIZEFRAME        :: SMSetting

sM_CXSIZEFRAME        =  32

sM_CYSIZEFRAME        :: SMSetting

sM_CYSIZEFRAME        =  33

sM_CXSMICON           :: SMSetting

sM_CXSMICON           =  49

sM_CYSMICON           :: SMSetting

sM_CYSMICON           =  50

sM_CXSMSIZE           :: SMSetting

sM_CXSMSIZE           =  52

sM_CYSMSIZE           :: SMSetting

sM_CYSMSIZE           =  53

sM_CXVSCROLL          :: SMSetting

sM_CXVSCROLL          =  2

sM_CYHSCROLL          :: SMSetting

sM_CYHSCROLL          =  3

sM_CYVTHUMB           :: SMSetting

sM_CYVTHUMB           =  9

sM_CYCAPTION          :: SMSetting

sM_CYCAPTION          =  4

sM_CYKANJIWINDOW      :: SMSetting

sM_CYKANJIWINDOW      =  18

sM_CYMENU             :: SMSetting

sM_CYMENU             =  15

sM_CYSMCAPTION        :: SMSetting

sM_CYSMCAPTION        =  51

sM_DBCSENABLED        :: SMSetting

sM_DBCSENABLED        =  42

sM_DEBUG              :: SMSetting

sM_DEBUG              =  22

sM_MENUDROPALIGNMENT  :: SMSetting

sM_MENUDROPALIGNMENT  =  40

sM_MIDEASTENABLED     :: SMSetting

sM_MIDEASTENABLED     =  74

sM_MOUSEPRESENT       :: SMSetting

sM_MOUSEPRESENT       =  19

sM_NETWORK            :: SMSetting

sM_NETWORK            =  63

sM_PENWINDOWS         :: SMSetting

sM_PENWINDOWS         =  41

sM_SECURE             :: SMSetting

sM_SECURE             =  44

sM_SHOWSOUNDS         :: SMSetting

sM_SHOWSOUNDS         =  70

sM_SLOWMACHINE        :: SMSetting

sM_SLOWMACHINE        =  73

sM_SWAPBUTTON         :: SMSetting

sM_SWAPBUTTON         =  23



{-# LINE 345 "System\\Win32\\Info.hsc" #-}



-- %fun GetSystemMetrics :: SMSetting -> IO Int



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

-- Thread Desktops

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



-- %fun GetThreadDesktop :: ThreadId -> IO HDESK

-- %fun SetThreadDesktop :: ThreadId -> HDESK -> IO ()



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

-- User name

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



-- %fun GetUserName :: IO String



foreign import WINDOWS_CCONV unsafe "windows.h GetUserNameW"

  c_GetUserName :: LPTSTR -> LPDWORD -> IO Bool

  

getUserName :: IO String

getUserName =     

  allocaArray 512 $ \ c_str -> 

    with 512 $ \ c_len -> do

        failIfFalse_ "GetUserName" $ c_GetUserName c_str c_len

        len <- peek c_len

        peekTStringLen (c_str, fromIntegral len - 1)



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

-- End

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