Skip to content

win32: fix type of SetWindowLongPtr #183

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Aug 30, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 1 addition & 2 deletions Graphics/Win32/LayeredWindow.hsc
Original file line number Diff line number Diff line change
Expand Up @@ -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 )
Expand All @@ -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

Expand Down
15 changes: 9 additions & 6 deletions Graphics/Win32/Window.hsc
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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'.
Expand All @@ -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]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Expand All @@ -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"
Expand Down
2 changes: 1 addition & 1 deletion Win32.cabal
Original file line number Diff line number Diff line change
@@ -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
Expand Down
4 changes: 4 additions & 0 deletions changelog.md
Original file line number Diff line number Diff line change
@@ -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
Expand Down