Skip to content
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