diff --git a/Graphics/Win32/LayeredWindow.hsc b/Graphics/Win32/LayeredWindow.hsc index c8ec1e1e..bf2119ff 100644 --- a/Graphics/Win32/LayeredWindow.hsc +++ b/Graphics/Win32/LayeredWindow.hsc @@ -14,7 +14,6 @@ module Graphics.Win32.LayeredWindow (module Graphics.Win32.LayeredWindow, Graphi import Control.Monad ( void ) import Data.Bits ( (.|.) ) import Foreign.Ptr ( Ptr ) -import Foreign.Marshal.Utils ( with ) import Graphics.Win32.GDI.AlphaBlend ( BLENDFUNCTION ) import Graphics.Win32.GDI.Types ( COLORREF, HDC, SIZE, SIZE, POINT ) import Graphics.Win32.Window ( WindowStyleEx, c_GetWindowLongPtr, c_SetWindowLongPtr ) @@ -27,7 +26,7 @@ import System.Win32.Types ( DWORD, HANDLE, BYTE, BOOL, INT ) toLayeredWindow :: HANDLE -> IO () toLayeredWindow w = do flg <- c_GetWindowLongPtr w gWL_EXSTYLE - void $ with (fromIntegral $ flg .|. (fromIntegral wS_EX_LAYERED)) $ c_SetWindowLongPtr w gWL_EXSTYLE + void $ c_SetWindowLongPtr w gWL_EXSTYLE (flg .|. (fromIntegral wS_EX_LAYERED)) -- test w = c_SetLayeredWindowAttributes w 0 128 lWA_ALPHA diff --git a/Graphics/Win32/Window.hsc b/Graphics/Win32/Window.hsc index 23d8d0ec..9d2d60b7 100644 --- a/Graphics/Win32/Window.hsc +++ b/Graphics/Win32/Window.hsc @@ -23,8 +23,8 @@ import Foreign.ForeignPtr (withForeignPtr) import Foreign.Marshal.Utils (maybeWith) import Foreign.Marshal.Alloc (allocaBytes) import Foreign.Marshal.Array (allocaArray) -import Foreign.Ptr (FunPtr, Ptr, castFunPtrToPtr, castPtr, nullPtr) -import Foreign.Ptr (intPtrToPtr, castPtrToFunPtr, freeHaskellFunPtr) +import Foreign.Ptr (FunPtr, Ptr, castFunPtrToPtr, nullPtr) +import Foreign.Ptr (intPtrToPtr, castPtrToFunPtr, freeHaskellFunPtr,ptrToIntPtr) import Foreign.Storable (pokeByteOff) import Foreign.C.Types (CIntPtr(..)) import Graphics.Win32.GDI.Types (HBITMAP, HCURSOR, HDC, HDWP, HRGN, HWND, PRGN) @@ -204,6 +204,9 @@ type WindowClosure = HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT foreign import WINDOWS_CCONV "wrapper" mkWindowClosure :: WindowClosure -> IO (FunPtr WindowClosure) +mkCIntPtr :: FunPtr a -> CIntPtr +mkCIntPtr = fromIntegral . ptrToIntPtr . castFunPtrToPtr + -- | The standard C wndproc for every window class registered by -- 'registerClass' is a C function pointer provided with this library. It in -- turn delegates to a Haskell function pointer stored in 'gWLP_USERDATA'. @@ -218,10 +221,10 @@ setWindowClosure :: HWND -> WindowClosure -> IO (Maybe (FunPtr WindowClosure)) setWindowClosure wnd closure = do fp <- mkWindowClosure closure fpOld <- c_SetWindowLongPtr wnd (#{const GWLP_USERDATA}) - (castPtr (castFunPtrToPtr fp)) - if fpOld == nullPtr + (mkCIntPtr fp) + if fpOld == 0 then return Nothing - else return $ Just $ castPtrToFunPtr fpOld + else return $ Just $ castPtrToFunPtr $ intPtrToPtr $ fromIntegral fpOld {- Note [SetWindowLongPtrW] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -240,7 +243,7 @@ foreign import WINDOWS_CCONV unsafe "windows.h SetWindowLongPtrW" #else # error Unknown mingw32 arch #endif - c_SetWindowLongPtr :: HWND -> INT -> Ptr LONG -> IO (Ptr LONG) + c_SetWindowLongPtr :: HWND -> INT -> LONG_PTR -> IO (LONG_PTR) #if defined(i386_HOST_ARCH) foreign import WINDOWS_CCONV unsafe "windows.h GetWindowLongW" diff --git a/Win32.cabal b/Win32.cabal index 6a8279d7..9a8cb3be 100644 --- a/Win32.cabal +++ b/Win32.cabal @@ -1,5 +1,5 @@ name: Win32 -version: 2.12.0.1 +version: 2.13.0.0 license: BSD3 license-file: LICENSE author: Alastair Reid, shelarcy, Tamar Christina diff --git a/changelog.md b/changelog.md index 62af9332..fad0b008 100644 --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,9 @@ # Changelog for [`Win32` package](http://hackage.haskell.org/package/Win32) +## 2.13.0.0 August 2021 + +* Fix type of c_SetWindowLongPtr. See #180 + ## 2.12.0.1 June 2021 * A small fix for WinIO usage. See #177