Win32 2.2.0.0 → 2.2.0.1

raw patch · 14 files changed

+277/−92 lines, 14 filesdep ~base

Dependency ranges changed: base

Files

Graphics/Win32/Dialogue.hsc +2/−2
Graphics/Win32/GDI/Graphics2D.hs +0/−1
Graphics/Win32/Window.hsc +2/−3
System/Win32.hs +2/−0
System/Win32/File.hsc +66/−13
System/Win32/Info.hsc +41/−0
System/Win32/NLS.hsc +1/−1
System/Win32/Registry.hsc +1/−1
System/Win32/Shell.hsc +78/−0
System/Win32/SimpleMAPI.hsc +3/−3
System/Win32/Time.hsc +9/−10
System/Win32/Types.hs +4/−2
Win32.cabal +66/−55
cbits/dumpBMP.c +2/−1

Graphics/Win32/Dialogue.hsc view

@@ -179,7 +179,7 @@ 				dia_id) = do    prim_text  <- marshall_res mb_text    prim_class <- marshall_res mb_class-   addDiaControl dtemp prim_text dia_id prim_class style+   _ <- addDiaControl dtemp prim_text dia_id prim_class style   		 x y cx cy exstyle    return () @@ -255,7 +255,7 @@ getDlgItemText :: HWND -> Int -> Int -> IO String getDlgItemText dlg item size =   allocaArray size $ \ p_buf -> do-  failIfZero "GetDlgItemInt" $ c_GetDlgItemText dlg item p_buf size+  _ <- failIfZero "GetDlgItemInt" $ c_GetDlgItemText dlg item p_buf size   peekTString p_buf foreign import stdcall "windows.h GetDlgItemTextW"   c_GetDlgItemText :: HWND -> Int -> LPTSTR -> Int -> IO Int

Graphics/Win32/GDI/Graphics2D.hs view

@@ -17,7 +17,6 @@  import System.Win32.Types import Graphics.Win32.GDI.Types-import Graphics.Win32.GDI.Bitmap  import Foreign

Graphics/Win32/Window.hsc view

@@ -182,7 +182,7 @@ setWindowClosure :: HWND -> WindowClosure -> IO () setWindowClosure wnd closure = do   fp <- mkWindowClosure closure-  c_SetWindowLong wnd (#{const GWL_USERDATA}) (castFunPtrToLONG fp)+  _ <- c_SetWindowLong wnd (#{const GWL_USERDATA}) (castFunPtrToLONG fp)   return () foreign import stdcall unsafe "windows.h SetWindowLongW"   c_SetWindowLong :: HWND -> INT -> LONG -> IO LONG@@ -648,9 +648,8 @@  peekMessage :: LPMSG -> Maybe HWND -> UINT -> UINT -> UINT -> IO () peekMessage msg mb_wnd filterMin filterMax remove = do-  failIf (== -1) "PeekMessage" $+  failIf_ (== -1) "PeekMessage" $     c_PeekMessage msg (maybePtr mb_wnd) filterMin filterMax remove-  return () foreign import stdcall "windows.h PeekMessageW"   c_PeekMessage :: LPMSG -> HWND -> UINT -> UINT -> UINT -> IO LONG

System/Win32.hs view

@@ -25,6 +25,7 @@ 	, module System.Win32.Console 	, module System.Win32.Security 	, module System.Win32.Types+	, module System.Win32.Shell 	) where  import System.Win32.DLL@@ -42,6 +43,7 @@ import System.Win32.Console import System.Win32.Types import System.Win32.Security+import System.Win32.Shell  ---------------------------------------------------------------- -- End

System/Win32/File.hsc view

@@ -255,7 +255,8 @@ deleteFile :: String -> IO () deleteFile name =   withTString name $ \ c_name ->-  failIfFalse_ "DeleteFile" $ c_DeleteFile c_name+  failIfFalse_ (unwords ["DeleteFile",show name]) $+    c_DeleteFile c_name foreign import stdcall unsafe "windows.h DeleteFileW"   c_DeleteFile :: LPCTSTR -> IO Bool @@ -263,7 +264,8 @@ copyFile src dest over =   withTString src $ \ c_src ->   withTString dest $ \ c_dest ->-  failIfFalse_ "CopyFile" $ c_CopyFile c_src c_dest over+  failIfFalse_ (unwords ["CopyFile",show src,show dest]) $+    c_CopyFile c_src c_dest over foreign import stdcall unsafe "windows.h CopyFileW"   c_CopyFile :: LPCTSTR -> LPCTSTR -> Bool -> IO Bool @@ -271,7 +273,8 @@ moveFile src dest =   withTString src $ \ c_src ->   withTString dest $ \ c_dest ->-  failIfFalse_ "MoveFile" $ c_MoveFile c_src c_dest+  failIfFalse_ (unwords ["MoveFile",show src,show dest]) $+    c_MoveFile c_src c_dest foreign import stdcall unsafe "windows.h MoveFileW"   c_MoveFile :: LPCTSTR -> LPCTSTR -> IO Bool @@ -279,21 +282,24 @@ moveFileEx src dest flags =   withTString src $ \ c_src ->   withTString dest $ \ c_dest ->-  failIfFalse_ "MoveFileEx" $ c_MoveFileEx c_src c_dest flags+  failIfFalse_ (unwords ["MoveFileEx",show src,show dest]) $+    c_MoveFileEx c_src c_dest flags foreign import stdcall unsafe "windows.h MoveFileExW"   c_MoveFileEx :: LPCTSTR -> LPCTSTR -> MoveFileFlag -> IO Bool  setCurrentDirectory :: String -> IO () setCurrentDirectory name =   withTString name $ \ c_name ->-  failIfFalse_ "SetCurrentDirectory" $ c_SetCurrentDirectory c_name+  failIfFalse_ (unwords ["SetCurrentDirectory",show name]) $+    c_SetCurrentDirectory c_name foreign import stdcall unsafe "windows.h SetCurrentDirectoryW"   c_SetCurrentDirectory :: LPCTSTR -> IO Bool  createDirectory :: String -> Maybe LPSECURITY_ATTRIBUTES -> IO () createDirectory name mb_attr =   withTString name $ \ c_name ->-  failIfFalse_ "CreateDirectory" $ c_CreateDirectory c_name (maybePtr mb_attr)+  failIfFalse_ (unwords ["CreateDirectory",show name]) $+    c_CreateDirectory c_name (maybePtr mb_attr) foreign import stdcall unsafe "windows.h CreateDirectoryW"   c_CreateDirectory :: LPCTSTR -> LPSECURITY_ATTRIBUTES -> IO Bool @@ -301,7 +307,7 @@ createDirectoryEx template name mb_attr =   withTString template $ \ c_template ->   withTString name $ \ c_name ->-  failIfFalse_ "CreateDirectoryEx" $+  failIfFalse_ (unwords ["CreateDirectoryEx",show template,show name]) $     c_CreateDirectoryEx c_template c_name (maybePtr mb_attr) foreign import stdcall unsafe "windows.h CreateDirectoryExW"   c_CreateDirectoryEx :: LPCTSTR -> LPCTSTR -> LPSECURITY_ATTRIBUTES -> IO Bool@@ -309,7 +315,8 @@ removeDirectory :: String -> IO () removeDirectory name =   withTString name $ \ c_name ->-  failIfFalse_ "RemoveDirectory" $ c_RemoveDirectory c_name+  failIfFalse_ (unwords ["RemoveDirectory",show name]) $+    c_RemoveDirectory c_name foreign import stdcall unsafe "windows.h RemoveDirectoryW"   c_RemoveDirectory :: LPCTSTR -> IO Bool @@ -317,7 +324,8 @@ getBinaryType name =   withTString name $ \ c_name ->   alloca $ \ p_btype -> do-  failIfFalse_ "GetBinaryType" $ c_GetBinaryType c_name p_btype+  failIfFalse_ (unwords ["GetBinaryType",show name]) $+    c_GetBinaryType c_name p_btype   peek p_btype foreign import stdcall unsafe "windows.h GetBinaryTypeW"   c_GetBinaryType :: LPCTSTR -> Ptr DWORD -> IO Bool@@ -329,7 +337,7 @@ createFile :: String -> AccessMode -> ShareMode -> Maybe LPSECURITY_ATTRIBUTES -> CreateMode -> FileAttributeOrFlag -> Maybe HANDLE -> IO HANDLE createFile name access share mb_attr mode flag mb_h =   withTString name $ \ c_name ->-  failIf (==iNVALID_HANDLE_VALUE) "CreateFile" $+  failIf (==iNVALID_HANDLE_VALUE) (unwords ["CreateFile",show name]) $     c_CreateFile c_name access share (maybePtr mb_attr) mode flag (maybePtr mb_h) foreign import stdcall unsafe "windows.h CreateFileW"   c_CreateFile :: LPCTSTR -> AccessMode -> ShareMode -> LPSECURITY_ATTRIBUTES -> CreateMode -> FileAttributeOrFlag -> HANDLE -> IO HANDLE@@ -363,14 +371,16 @@ setFileAttributes :: String -> FileAttributeOrFlag -> IO () setFileAttributes name attr =   withTString name $ \ c_name ->-  failIfFalse_ "SetFileAttributes" $ c_SetFileAttributes c_name attr+  failIfFalse_ (unwords ["SetFileAttributes",show name])+    $ c_SetFileAttributes c_name attr foreign import stdcall unsafe "windows.h SetFileAttributesW"   c_SetFileAttributes :: LPCTSTR -> FileAttributeOrFlag -> IO Bool  getFileAttributes :: String -> IO FileAttributeOrFlag getFileAttributes name =   withTString name $ \ c_name ->-  failIf (== 0xFFFFFFFF) "GetFileAttributes" $ c_GetFileAttributes c_name+  failIf (== 0xFFFFFFFF) (unwords ["GetFileAttributes",show name]) $+    c_GetFileAttributes c_name foreign import stdcall unsafe "windows.h GetFileAttributesW"   c_GetFileAttributes :: LPCTSTR -> IO FileAttributeOrFlag @@ -428,7 +438,7 @@ findFirstChangeNotification :: String -> Bool -> FileNotificationFlag -> IO HANDLE findFirstChangeNotification path watch flag =   withTString path $ \ c_path ->-  failIfNull "FindFirstChangeNotification" $+  failIfNull (unwords ["FindFirstChangeNotification",show path]) $     c_FindFirstChangeNotification c_path watch flag foreign import stdcall unsafe "windows.h FindFirstChangeNotificationW"   c_FindFirstChangeNotification :: LPCTSTR -> Bool -> FileNotificationFlag -> IO HANDLE@@ -444,6 +454,49 @@   failIfFalse_ "FindCloseChangeNotification" $ c_FindCloseChangeNotification h foreign import stdcall unsafe "windows.h FindCloseChangeNotification"   c_FindCloseChangeNotification :: HANDLE -> IO Bool++----------------------------------------------------------------+-- Directories+----------------------------------------------------------------++type WIN32_FIND_DATA = ()++newtype FindData = FindData (ForeignPtr WIN32_FIND_DATA)++getFindDataFileName :: FindData -> IO FilePath+getFindDataFileName (FindData fp) = +  withForeignPtr fp $ \p -> +    peekTString ((# ptr WIN32_FIND_DATAW, cFileName ) p)++findFirstFile :: String -> IO (HANDLE, FindData)+findFirstFile str = do+  fp_finddata <- mallocForeignPtrBytes (# const sizeof(WIN32_FIND_DATAW) )+  withForeignPtr fp_finddata $ \p_finddata -> do+    handle <- withTString str $ \tstr -> do+                failIf (== iNVALID_HANDLE_VALUE) "findFirstFile" $ +                  c_FindFirstFile tstr p_finddata+    return (handle, FindData fp_finddata)+foreign import stdcall unsafe "windows.h FindFirstFileW"+  c_FindFirstFile :: LPCTSTR -> Ptr WIN32_FIND_DATA -> IO HANDLE++findNextFile :: HANDLE -> FindData -> IO Bool -- False -> no more files+findNextFile h (FindData finddata) = do+  withForeignPtr finddata $ \p_finddata -> do+    b <- c_FindNextFile h p_finddata+    if b+       then return True+       else do+             err_code <- getLastError+             if err_code == (# const ERROR_NO_MORE_FILES )+                then return False+                else failWith "findNextFile" err_code+foreign import stdcall unsafe "windows.h FindNextFileW"+  c_FindNextFile :: HANDLE -> Ptr WIN32_FIND_DATA -> IO BOOL++findClose :: HANDLE -> IO ()+findClose h = failIfFalse_ "findClose" $ c_FindClose h+foreign import stdcall unsafe "windows.h FindClose"+  c_FindClose :: HANDLE -> IO BOOL  ---------------------------------------------------------------- -- DOS Device flags

System/Win32/Info.hsc view

@@ -16,6 +16,7 @@  import System.Win32.Types +import System.IO.Error hiding (try) import Foreign      ( Storable(sizeOf, alignment, peekByteOff, pokeByteOff,                                peek, poke)                     , Ptr, alloca, allocaArray )@@ -93,6 +94,33 @@ 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++searchPath :: Maybe String -> FilePath -> String -> IO (Maybe FilePath)+searchPath path filename ext =+  maybe ($ nullPtr) withTString path $ \p_path ->+  withTString filename $ \p_filename ->+  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++-- Support for API calls that are passed a fixed-size buffer and tell+-- you via the return value if the buffer was too small.  In that+-- case, we double the buffer size and try again. try :: String -> (LPTSTR -> UINT -> IO UINT) -> UINT -> IO String try loc f n = do    e <- allocaArray (fromIntegral n) $ \lptstr -> do@@ -109,6 +137,19 @@  foreign import stdcall unsafe "GetSystemDirectoryW"   c_getSystemDirectory :: LPTSTR -> UINT -> IO UINT++foreign import stdcall unsafe "GetCurrentDirectoryW"+  c_getCurrentDirectory :: DWORD -> LPTSTR -> IO UINT++foreign import stdcall unsafe "GetTempPathW"+  c_getTempPath :: DWORD -> LPTSTR -> IO UINT++foreign import stdcall unsafe "GetFullPathNameW"+  c_GetFullPathName :: LPCTSTR -> DWORD -> LPTSTR -> Ptr LPTSTR -> IO DWORD++foreign import stdcall unsafe "SearchPathW"+  c_SearchPath :: LPCTSTR -> LPCTSTR -> LPCTSTR -> DWORD -> LPTSTR -> Ptr LPTSTR+               -> IO DWORD  ---------------------------------------------------------------- -- System Info (Info about processor and memory subsystem)

System/Win32/NLS.hsc view

@@ -121,7 +121,7 @@ lCMapString locale flags src dest_size =   withTStringLen src $ \ (c_src, src_len) ->   allocaArray dest_size $ \ c_dest -> do-  failIfZero "LCMapString" $+  _ <- failIfZero "LCMapString" $     c_LCMapString locale flags c_src src_len c_dest dest_size   peekTString c_dest foreign import stdcall unsafe "windows.h LCMapStringW"

System/Win32/Registry.hsc view

@@ -491,7 +491,7 @@ regSetStringValue :: HKEY -> String -> String -> IO () regSetStringValue hk key val =   withTString val $ \ v ->-  regSetValueEx hk key rEG_SZ v (length val)+  regSetValueEx hk key rEG_SZ v (length val * sizeOf (undefined::TCHAR))  regSetValueEx :: HKEY -> String -> RegValueType -> LPTSTR -> Int -> IO () regSetValueEx key subkey ty value value_len =

+ System/Win32/Shell.hsc view

@@ -0,0 +1,78 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Win32.Shell
+-- Copyright   :  (c) The University of Glasgow 2009
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  Esa Ilari Vuokko <ei@vuokko.info>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Win32 stuff from shell32.dll
+--
+-----------------------------------------------------------------------------
+
+module System.Win32.Shell (
+  sHGetFolderPath,
+  CSIDL,
+  cSIDL_PROFILE,
+  cSIDL_APPDATA,
+  cSIDL_WINDOWS,
+  cSIDL_PERSONAL,
+  cSIDL_PROGRAM_FILES,
+  SHGetFolderPathFlags,
+  sHGFP_TYPE_CURRENT,
+  sHGFP_TYPE_DEFAULT
+ ) where
+
+import System.Win32.Types
+import Graphics.Win32.GDI.Types (HWND)
+
+import Foreign
+import Foreign.C
+import Control.Monad
+import System.IO.Error
+
+-- for SHGetFolderPath stuff
+#define _WIN32_IE 0x500
+#include <windows.h>
+#include <shlobj.h>
+
+----------------------------------------------------------------
+-- SHGetFolderPath
+--
+-- XXX: this is deprecated in Vista and later
+----------------------------------------------------------------
+
+type CSIDL = CInt
+
+#{enum CSIDL,
+ , cSIDL_PROFILE  = CSIDL_PROFILE
+ , cSIDL_APPDATA  = CSIDL_APPDATA
+ , cSIDL_WINDOWS  = CSIDL_WINDOWS
+ , cSIDL_PERSONAL = CSIDL_PERSONAL
+ , cSIDL_PROGRAM_FILES = CSIDL_PROGRAM_FILES
+ }
+-- XXX there are lots more of these
+
+type SHGetFolderPathFlags = DWORD
+
+#{enum SHGetFolderPathFlags,
+ , sHGFP_TYPE_CURRENT = SHGFP_TYPE_CURRENT
+ , sHGFP_TYPE_DEFAULT = SHGFP_TYPE_DEFAULT
+ }
+
+sHGetFolderPath :: HWND -> CSIDL -> HANDLE -> SHGetFolderPathFlags -> IO String
+sHGetFolderPath hwnd csidl hdl flags =
+  allocaBytes ((#const MAX_PATH) * (#size TCHAR)) $ \pstr -> do
+    r <- c_SHGetFolderPath hwnd csidl hdl flags pstr
+    when (r < 0) $ raiseUnsupported "sHGetFolderPath"
+    peekTString pstr
+
+raiseUnsupported :: String -> IO ()
+raiseUnsupported loc = 
+   ioError (ioeSetErrorString (mkIOError illegalOperationErrorType loc Nothing Nothing) "unsupported operation")
+
+foreign import stdcall unsafe "SHGetFolderPathW"
+  c_SHGetFolderPath :: HWND -> CInt -> HANDLE -> DWORD -> LPTSTR
+                    -> IO HRESULT

System/Win32/SimpleMAPI.hsc view

@@ -13,7 +13,7 @@ ----------------------------------------------------------------------------- module System.Win32.SimpleMAPI where-import Control.Exception    ( bracket, handle, throw, finally, onException+import Control.Exception    ( bracket, handle, finally, onException                             , IOException ) import Control.Monad        ( liftM5 ) import Foreign              ( FunPtr, newForeignPtr, pokeByteOff, maybeWith@@ -192,7 +192,7 @@     maybeWith withCString ses   $ \ses  ->     maybeWith withCString pw    $ \pw   ->     alloca                      $ \out  -> do-        mapiFail "MAPILogon: " $ mapifLogon+        mapiFail_ "MAPILogon: " $ mapifLogon             f (maybeHWND hwnd)              ses pw flags 0 out         peek out@@ -259,7 +259,7 @@                                 then do                                     buf <- peek res                                     v <- a buf-                                    mapifFreeBuffer f $ castPtr buf+                                    _ <- mapifFreeBuffer f $ castPtr buf                                     return $ Right v                                 else return $ Left                                     $ err ++ ", "

System/Win32/Time.hsc view

@@ -155,7 +155,7 @@     c_GetSystemTimeAdjustment :: Ptr DWORD -> Ptr DWORD -> Ptr BOOL -> IO BOOL getSystemTimeAdjustment :: IO (Maybe (Int, Int)) getSystemTimeAdjustment = alloca $ \ta -> alloca $ \ti -> alloca $ \enabled -> do-    failIf not "getSystemTimeAdjustment: GetSystemTimeAdjustment" $+    failIf_ not "getSystemTimeAdjustment: GetSystemTimeAdjustment" $         c_GetSystemTimeAdjustment ta ti enabled     enabled <- peek enabled     if enabled@@ -195,7 +195,7 @@     c_SystemTimeToFileTime :: Ptr SYSTEMTIME -> Ptr FILETIME -> IO BOOL systemTimeToFileTime :: SYSTEMTIME -> IO FILETIME systemTimeToFileTime s = with s $ \s -> alloca $ \ret -> do-    failIf not "systemTimeToFileTime: SystemTimeToFileTime" $+    failIf_ not "systemTimeToFileTime: SystemTimeToFileTime" $         c_SystemTimeToFileTime s ret     peek ret @@ -203,7 +203,7 @@     c_FileTimeToSystemTime :: Ptr FILETIME -> Ptr SYSTEMTIME -> IO BOOL fileTimeToSystemTime :: FILETIME -> IO SYSTEMTIME fileTimeToSystemTime s = with s $ \s -> alloca $ \ret -> do-    failIf not "fileTimeToSystemTime: FileTimeToSystemTime" $+    failIf_ not "fileTimeToSystemTime: FileTimeToSystemTime" $         c_FileTimeToSystemTime s ret     peek ret @@ -211,21 +211,20 @@     c_GetFileTime :: HANDLE -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> IO BOOL getFileTime :: HANDLE -> IO (FILETIME,FILETIME,FILETIME) getFileTime h = alloca $ \crt -> alloca $ \acc -> alloca $ \wrt -> do-    failIf not "getFileTime: GetFileTime" $ c_GetFileTime h crt acc wrt+    failIf_ not "getFileTime: GetFileTime" $ c_GetFileTime h crt acc wrt     liftM3 (,,) (peek crt) (peek acc) (peek wrt)  foreign import stdcall "windows.h SetFileTime"     c_SetFileTime :: HANDLE -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> IO BOOL setFileTime :: HANDLE -> FILETIME -> FILETIME -> FILETIME -> IO () setFileTime h crt acc wrt = with crt $ \crt -> with acc $ \acc -> with wrt $ \wrt -> do-    failIf not "setFileTime: SetFileTime" $ c_SetFileTime h crt acc wrt-    return ()+    failIf_ not "setFileTime: SetFileTime" $ c_SetFileTime h crt acc wrt  foreign import stdcall "windows.h FileTimeToLocalFileTime"     c_FileTimeToLocalFileTime :: Ptr FILETIME -> Ptr FILETIME -> IO BOOL fileTimeToLocalFileTime :: FILETIME -> IO FILETIME fileTimeToLocalFileTime ft = with ft $ \ft -> alloca $ \res -> do-    failIf not "fileTimeToLocalFileTime: FileTimeToLocalFileTime"+    failIf_ not "fileTimeToLocalFileTime: FileTimeToLocalFileTime"         $ c_FileTimeToLocalFileTime ft res     peek res @@ -233,7 +232,7 @@     c_LocalFileTimeToFileTime :: Ptr FILETIME -> Ptr FILETIME -> IO BOOL localFileTimeToFileTime :: FILETIME -> IO FILETIME localFileTimeToFileTime ft = with ft $ \ft -> alloca $ \res -> do-    failIf not "localFileTimeToFileTime: LocalFileTimeToFileTime"+    failIf_ not "localFileTimeToFileTime: LocalFileTimeToFileTime"         $ c_LocalFileTimeToFileTime ft res     peek res @@ -270,7 +269,7 @@     c_QueryPerformanceFrequency :: Ptr LARGE_INTEGER -> IO BOOL queryPerformanceFrequency :: IO Integer queryPerformanceFrequency = alloca $ \res -> do-    failIf not "queryPerformanceFrequency: QueryPerformanceFrequency" $+    failIf_ not "queryPerformanceFrequency: QueryPerformanceFrequency" $         c_QueryPerformanceFrequency res     liftM fromIntegral $ peek res @@ -278,7 +277,7 @@     c_QueryPerformanceCounter:: Ptr LARGE_INTEGER -> IO BOOL queryPerformanceCounter:: IO Integer queryPerformanceCounter= alloca $ \res -> do-    failIf not "queryPerformanceCounter: QueryPerformanceCounter" $+    failIf_ not "queryPerformanceCounter: QueryPerformanceCounter" $         c_QueryPerformanceCounter res     liftM fromIntegral $ peek res

System/Win32/Types.hs view

@@ -20,7 +20,6 @@ import Data.Maybe import Foreign import Foreign.C-import Numeric (showHex) import Control.Exception import System.IO.Error import Data.Char@@ -61,6 +60,8 @@  type MbATOM        = Maybe ATOM +type HRESULT       = LONG+ ---------------------------------------------------------------- -- Pointers ----------------------------------------------------------------@@ -204,7 +205,8 @@ failWith fn_name err_code = do   c_msg <- getErrorMessage err_code   msg <- peekTString c_msg-  localFree c_msg+  -- We ignore failure of freeing c_msg, given we're already failing+  _ <- localFree c_msg   c_maperrno -- turn GetLastError() into errno, which errnoToIOError knows              -- how to convert to an IOException we can throw.              -- XXX we should really do this directly.

Win32.cabal view

@@ -1,67 +1,78 @@ name:		Win32-version:	2.2.0.0+version:	2.2.0.1 license:	BSD3 license-file:	LICENSE author:		Alastair Reid copyright:	Alastair Reid, 1999-2003 maintainer:	Esa Ilari Vuokko <ei@vuokko.info>+bug-reports: http://hackage.haskell.org/trac/ghc/newticket?component=libraries%20%28other%29 category:	System, Graphics synopsis:	A binding to part of the Win32 library build-type:     Simple+cabal-version:  >=1.6 extra-source-files: 	include/diatemp.h include/dumpBMP.h include/ellipse.h include/errors.h 	include/gettime.h include/Win32Aux.h include/win32debug.h-build-depends:	base, bytestring-ghc-options:    -Wall -fno-warn-name-shadowing-exposed-modules:-	Graphics.Win32.GDI,-	Graphics.Win32.GDI.Bitmap,-	Graphics.Win32.GDI.Brush,-	Graphics.Win32.GDI.Clip,-	Graphics.Win32.GDI.Font,-	Graphics.Win32.GDI.Graphics2D,-	Graphics.Win32.GDI.HDC,-	Graphics.Win32.GDI.Palette,-	Graphics.Win32.GDI.Path,-	Graphics.Win32.GDI.Pen,-	Graphics.Win32.GDI.Region,-	Graphics.Win32.GDI.Types,-	Graphics.Win32,-	Graphics.Win32.Control,-	Graphics.Win32.Dialogue,-	Graphics.Win32.Icon,-	Graphics.Win32.Key,-	Graphics.Win32.Menu,-	Graphics.Win32.Message,-	Graphics.Win32.Misc,-	Graphics.Win32.Resource,-	Graphics.Win32.Window,-	System.Win32,-	System.Win32.DebugApi,-	System.Win32.DLL,-	System.Win32.File,-	System.Win32.FileMapping,-	System.Win32.Info,-	System.Win32.Mem,-	System.Win32.NLS,-	System.Win32.Process,-	System.Win32.Registry,-	System.Win32.SimpleMAPI,-	System.Win32.Time,-	System.Win32.Console,-	System.Win32.Security,-	System.Win32.Types-extensions: ForeignFunctionInterface-extra-libraries:-	"user32", "gdi32", "winmm", "kernel32", "advapi32"-include-dirs: 	include-includes:	"HsWin32.h", "HsGDI.h", "WndProc.h"-install-includes:	"HsWin32.h", "HsGDI.h", "WndProc.h"-c-sources:-	cbits/HsGDI.c,-	cbits/HsWin32.c,-	cbits/WndProc.c,-	cbits/diatemp.c,-	cbits/dumpBMP.c,-	cbits/ellipse.c,-	cbits/errors.c++Library+    build-depends:	base >= 3 && < 5, bytestring+    ghc-options:    -Wall -fno-warn-name-shadowing+    cc-options:     -fno-strict-aliasing+    exposed-modules:+        Graphics.Win32.GDI+        Graphics.Win32.GDI.Bitmap+        Graphics.Win32.GDI.Brush+        Graphics.Win32.GDI.Clip+        Graphics.Win32.GDI.Font+        Graphics.Win32.GDI.Graphics2D+        Graphics.Win32.GDI.HDC+        Graphics.Win32.GDI.Palette+        Graphics.Win32.GDI.Path+        Graphics.Win32.GDI.Pen+        Graphics.Win32.GDI.Region+        Graphics.Win32.GDI.Types+        Graphics.Win32+        Graphics.Win32.Control+        Graphics.Win32.Dialogue+        Graphics.Win32.Icon+        Graphics.Win32.Key+        Graphics.Win32.Menu+        Graphics.Win32.Message+        Graphics.Win32.Misc+        Graphics.Win32.Resource+        Graphics.Win32.Window+        System.Win32+        System.Win32.DebugApi+        System.Win32.DLL+        System.Win32.File+        System.Win32.FileMapping+        System.Win32.Info+        System.Win32.Mem+        System.Win32.NLS+        System.Win32.Process+        System.Win32.Registry+        System.Win32.SimpleMAPI+        System.Win32.Time+        System.Win32.Console+        System.Win32.Security+        System.Win32.Types+        System.Win32.Shell+    extensions: ForeignFunctionInterface+    extra-libraries:+        "user32", "gdi32", "winmm", "advapi32", "shell32", "shfolder"+    include-dirs: 	include+    includes:	"HsWin32.h", "HsGDI.h", "WndProc.h"+    install-includes:	"HsWin32.h", "HsGDI.h", "WndProc.h"+    c-sources:+        cbits/HsGDI.c+        cbits/HsWin32.c+        cbits/WndProc.c+        cbits/diatemp.c+        cbits/dumpBMP.c+        cbits/ellipse.c+        cbits/errors.c++source-repository head+    type:     darcs+    location: http://darcs.haskell.org/packages/Win32/+

cbits/dumpBMP.c view

@@ -162,7 +162,8 @@     // Assume that the hDC is the DC where the bitmap would have been selected     // if indeed it has been selected     //-    if (hTmpBmp = CreateCompatibleBitmap(hDC, pbmi->bmiHeader.biWidth, pbmi->bmiHeader.biHeight)) {+    hTmpBmp = CreateCompatibleBitmap(hDC, pbmi->bmiHeader.biWidth, pbmi->bmiHeader.biHeight);+    if (hTmpBmp) {         hBmpOld = SelectObject(hDC, hTmpBmp);         if ((GetDIBits(hDC, hBmp, 0, pbmi->bmiHeader.biHeight, (LPSTR)pBits, pbmi, DIB_RGB_COLORS))==0){             fprintf(stderr, "Failed in GetDIBits!");