diff --git a/Graphics/Win32/LayeredWindow.hsc b/Graphics/Win32/LayeredWindow.hsc
index c8ec1e1e971d8bd53ca41048c1716929e4d0f1d7..bf2119ff5cf59112df3fa805cb4a0ab4fbe0e0ca 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 23d8d0ecb219871cf2b575f1a96463dd225adbef..9d2d60b7d9da00e7a87a236436dd3921f51a5077 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 6a8279d72b6c1b245f940848b370c7b8fcaa5daf..9a8cb3bef79e606e35f33642471227a3e2652922 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 62af9332ce8383e355a2f107cbf7c33f6d73a5c4..fad0b008e577043dd886213babddde792e0a4c84 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