Skip to content

Commit

Permalink
win32: fix type of SetWindowLongPtr
Browse files Browse the repository at this point in the history
  • Loading branch information
Mistuke committed Aug 30, 2021
1 parent 628bf1d commit 7c9f36c
Show file tree
Hide file tree
Showing 4 changed files with 15 additions and 9 deletions.
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

0 comments on commit 7c9f36c

Please sign in to comment.