Skip to content

Commit

Permalink
[project @ 2005-02-02 13:55:44 by ross]
Browse files Browse the repository at this point in the history 
more safe foreign imports.  Not sure if these are all necessary or
if more are needed, but at least they match the old win32 package.
  • Loading branch information
ross committed Feb 2, 2005
1 parent 6d300fa commit ba87712
Show file tree
Hide file tree
Showing 2 changed files with 21 additions and 23 deletions.
22 changes: 11 additions & 11 deletions Graphics/Win32/Dialogue.hsc
View file
Original file line number Original file line Diff line number Diff line change
Expand Up @@ -64,7 +64,7 @@ dialogBoxParam inst template mb_parent dia_fn init_val = do
c_dia_fn <- mkDialogClosure dia_fn c_dia_fn <- mkDialogClosure dia_fn
failIf (== -1) "DialogBoxParam" $ failIf (== -1) "DialogBoxParam" $
c_DialogBoxParam inst template (maybePtr mb_parent) c_dia_fn init_val c_DialogBoxParam inst template (maybePtr mb_parent) c_dia_fn init_val
foreign import stdcall unsafe "windows.h DialogBoxParamW" foreign import stdcall "windows.h DialogBoxParamW"
c_DialogBoxParam :: HINSTANCE -> DTemplate -> HWND -> FunPtr DialogProc -> LPARAM -> IO Int c_DialogBoxParam :: HINSTANCE -> DTemplate -> HWND -> FunPtr DialogProc -> LPARAM -> IO Int


dialogBoxIndirect :: HINSTANCE -> DTemplateMem -> Maybe HWND -> DialogProc -> IO Int dialogBoxIndirect :: HINSTANCE -> DTemplateMem -> Maybe HWND -> DialogProc -> IO Int
Expand All @@ -76,7 +76,7 @@ dialogBoxIndirectParam inst template mb_parent dia_fn init_val = do
c_dia_fn <- mkDialogClosure dia_fn c_dia_fn <- mkDialogClosure dia_fn
failIf (== -1) "DialogBoxIndirectParam" $ failIf (== -1) "DialogBoxIndirectParam" $
c_DialogBoxIndirectParam inst template (maybePtr mb_parent) c_dia_fn init_val c_DialogBoxIndirectParam inst template (maybePtr mb_parent) c_dia_fn init_val
foreign import stdcall unsafe "windows.h DialogBoxIndirectParamW" foreign import stdcall "windows.h DialogBoxIndirectParamW"
c_DialogBoxIndirectParam :: HINSTANCE -> DTemplateMem -> HWND -> FunPtr DialogProc -> LPARAM -> IO Int c_DialogBoxIndirectParam :: HINSTANCE -> DTemplateMem -> HWND -> FunPtr DialogProc -> LPARAM -> IO Int




Expand Down Expand Up @@ -204,7 +204,7 @@ createDialogParam inst template mb_parent dia_fn init_val = do
c_dia_fn <- mkDialogClosure dia_fn c_dia_fn <- mkDialogClosure dia_fn
failIfNull "CreateDialogParam" $ failIfNull "CreateDialogParam" $
c_CreateDialogParam inst template (maybePtr mb_parent) c_dia_fn init_val c_CreateDialogParam inst template (maybePtr mb_parent) c_dia_fn init_val
foreign import stdcall unsafe "windows.h CreateDialogParamW" foreign import stdcall "windows.h CreateDialogParamW"
c_CreateDialogParam :: HINSTANCE -> DTemplate -> HWND -> FunPtr DialogProc -> LPARAM -> IO HWND c_CreateDialogParam :: HINSTANCE -> DTemplate -> HWND -> FunPtr DialogProc -> LPARAM -> IO HWND


createDialogIndirect :: HINSTANCE -> DTemplateMem -> Maybe HWND -> DialogProc -> IO HWND createDialogIndirect :: HINSTANCE -> DTemplateMem -> Maybe HWND -> DialogProc -> IO HWND
Expand All @@ -216,16 +216,16 @@ createDialogIndirectParam inst template mb_parent dia_fn init_val = do
c_dia_fn <- mkDialogClosure dia_fn c_dia_fn <- mkDialogClosure dia_fn
failIfNull "CreateDialogIndirectParam" $ failIfNull "CreateDialogIndirectParam" $
c_CreateDialogIndirectParam inst template (maybePtr mb_parent) c_dia_fn init_val c_CreateDialogIndirectParam inst template (maybePtr mb_parent) c_dia_fn init_val
foreign import stdcall unsafe "windows.h CreateDialogIndirectParamW" foreign import stdcall "windows.h CreateDialogIndirectParamW"
c_CreateDialogIndirectParam :: HINSTANCE -> DTemplateMem -> HWND -> FunPtr DialogProc -> LPARAM -> IO HWND c_CreateDialogIndirectParam :: HINSTANCE -> DTemplateMem -> HWND -> FunPtr DialogProc -> LPARAM -> IO HWND


foreign import stdcall unsafe "windows.h DefDlgProcW" foreign import stdcall "windows.h DefDlgProcW"
defDlgProc :: HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT defDlgProc :: HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT


endDialog :: HWND -> Int -> IO () endDialog :: HWND -> Int -> IO ()
endDialog dlg res = endDialog dlg res =
failIfFalse_ "EndDialog" $ c_EndDialog dlg res failIfFalse_ "EndDialog" $ c_EndDialog dlg res
foreign import stdcall unsafe "windows.h EndDialog" foreign import stdcall "windows.h EndDialog"
c_EndDialog :: HWND -> Int -> IO BOOL c_EndDialog :: HWND -> Int -> IO BOOL


foreign import stdcall unsafe "windows.h GetDialogBaseUnits" foreign import stdcall unsafe "windows.h GetDialogBaseUnits"
Expand All @@ -249,15 +249,15 @@ getDlgItemInt dlg item signed =
res <- c_GetDlgItemInt dlg item p_trans signed res <- c_GetDlgItemInt dlg item p_trans signed
failIfFalse_ "GetDlgItemInt" $ peek p_trans failIfFalse_ "GetDlgItemInt" $ peek p_trans
return (fromIntegral res) return (fromIntegral res)
foreign import stdcall unsafe "windows.h GetDlgItemInt" foreign import stdcall "windows.h GetDlgItemInt"
c_GetDlgItemInt :: HWND -> Int -> Ptr Bool -> Bool -> IO UINT c_GetDlgItemInt :: HWND -> Int -> Ptr Bool -> Bool -> IO UINT


getDlgItemText :: HWND -> Int -> Int -> IO String getDlgItemText :: HWND -> Int -> Int -> IO String
getDlgItemText dlg item size = getDlgItemText dlg item size =
allocaArray size $ \ p_buf -> do allocaArray size $ \ p_buf -> do
failIfZero "GetDlgItemInt" $ c_GetDlgItemText dlg item p_buf size failIfZero "GetDlgItemInt" $ c_GetDlgItemText dlg item p_buf size
peekTString p_buf peekTString p_buf
foreign import stdcall unsafe "windows.h GetDlgItemTextW" foreign import stdcall "windows.h GetDlgItemTextW"
c_GetDlgItemText :: HWND -> Int -> LPTSTR -> Int -> IO Int c_GetDlgItemText :: HWND -> Int -> LPTSTR -> Int -> IO Int


getNextDlgGroupItem :: HWND -> HWND -> BOOL -> IO HWND getNextDlgGroupItem :: HWND -> HWND -> BOOL -> IO HWND
Expand All @@ -272,7 +272,7 @@ getNextDlgTabItem dlg ctl previous =
foreign import stdcall unsafe "windows.h GetNextDlgTabItem" foreign import stdcall unsafe "windows.h GetNextDlgTabItem"
c_GetNextDlgTabItem :: HWND -> HWND -> BOOL -> IO HWND c_GetNextDlgTabItem :: HWND -> HWND -> BOOL -> IO HWND


foreign import stdcall unsafe "windows.h IsDialogMessageW" foreign import stdcall "windows.h IsDialogMessageW"
isDialogMessage :: HWND -> LPMSG -> IO BOOL isDialogMessage :: HWND -> LPMSG -> IO BOOL


mapDialogRect :: HWND -> LPRECT -> IO () mapDialogRect :: HWND -> LPRECT -> IO ()
Expand All @@ -283,7 +283,7 @@ foreign import stdcall unsafe "windows.h MapDialogRect"


-- No MessageBox* funs in here just yet. -- No MessageBox* funs in here just yet.


foreign import stdcall unsafe "windows.h SendDlgItemMessageW" foreign import stdcall "windows.h SendDlgItemMessageW"
sendDlgItemMessage :: HWND -> Int -> WindowMessage -> WPARAM -> LPARAM -> IO LONG sendDlgItemMessage :: HWND -> Int -> WindowMessage -> WPARAM -> LPARAM -> IO LONG


setDlgItemInt :: HWND -> Int -> UINT -> BOOL -> IO () setDlgItemInt :: HWND -> Int -> UINT -> BOOL -> IO ()
Expand All @@ -296,7 +296,7 @@ setDlgItemText :: HWND -> Int -> String -> IO ()
setDlgItemText dlg item str = setDlgItemText dlg item str =
withTString str $ \ c_str -> withTString str $ \ c_str ->
failIfFalse_ "SetDlgItemText" $ c_SetDlgItemText dlg item c_str failIfFalse_ "SetDlgItemText" $ c_SetDlgItemText dlg item c_str
foreign import stdcall unsafe "windows.h SetDlgItemTextW" foreign import stdcall "windows.h SetDlgItemTextW"
c_SetDlgItemText :: HWND -> Int -> LPCTSTR -> IO Bool c_SetDlgItemText :: HWND -> Int -> LPCTSTR -> IO Bool


#{enum WindowStyle, #{enum WindowStyle,
Expand Down
22 changes: 10 additions & 12 deletions Graphics/Win32/Window.hsc
View file
Original file line number Original file line Diff line number Diff line change
Expand Up @@ -250,7 +250,7 @@ invalidateRect :: Maybe HWND -> Maybe LPRECT -> Bool -> IO ()
invalidateRect wnd p_mb_rect erase = invalidateRect wnd p_mb_rect erase =
failIfFalse_ "InvalidateRect" $ failIfFalse_ "InvalidateRect" $
c_InvalidateRect (maybePtr wnd) (maybePtr p_mb_rect) erase c_InvalidateRect (maybePtr wnd) (maybePtr p_mb_rect) erase
foreign import stdcall unsafe "windows.h InvalidateRect" foreign import stdcall "windows.h InvalidateRect"
c_InvalidateRect :: HWND -> LPRECT -> Bool -> IO Bool c_InvalidateRect :: HWND -> LPRECT -> Bool -> IO Bool


screenToClient :: HWND -> POINT -> IO POINT screenToClient :: HWND -> POINT -> IO POINT
Expand Down Expand Up @@ -278,7 +278,7 @@ setWindowText :: HWND -> String -> IO ()
setWindowText wnd text = setWindowText wnd text =
withTString text $ \ c_text -> withTString text $ \ c_text ->
failIfFalse_ "SetWindowText" $ c_SetWindowText wnd c_text failIfFalse_ "SetWindowText" $ c_SetWindowText wnd c_text
foreign import stdcall unsafe "windows.h SetWindowTextW" foreign import stdcall "windows.h SetWindowTextW"
c_SetWindowText :: HWND -> LPCTSTR -> IO Bool c_SetWindowText :: HWND -> LPCTSTR -> IO Bool


---------------------------------------------------------------- ----------------------------------------------------------------
Expand All @@ -302,10 +302,10 @@ allocaPAINTSTRUCT = allocaBytes #{size PAINTSTRUCT}
beginPaint :: HWND -> LPPAINTSTRUCT -> IO HDC beginPaint :: HWND -> LPPAINTSTRUCT -> IO HDC
beginPaint wnd paint = beginPaint wnd paint =
failIfNull "BeginPaint" $ c_BeginPaint wnd paint failIfNull "BeginPaint" $ c_BeginPaint wnd paint
foreign import stdcall unsafe "windows.h BeginPaint" foreign import stdcall "windows.h BeginPaint"
c_BeginPaint :: HWND -> LPPAINTSTRUCT -> IO HDC c_BeginPaint :: HWND -> LPPAINTSTRUCT -> IO HDC


foreign import stdcall unsafe "windows.h EndPaint" foreign import stdcall "windows.h EndPaint"
endPaint :: HWND -> LPPAINTSTRUCT -> IO () endPaint :: HWND -> LPPAINTSTRUCT -> IO ()
-- Apparently always succeeds (return non-zero) -- Apparently always succeeds (return non-zero)


Expand Down Expand Up @@ -395,7 +395,7 @@ foreign import stdcall unsafe "windows.h BeginDeferWindowPos"
bringWindowToTop :: HWND -> IO () bringWindowToTop :: HWND -> IO ()
bringWindowToTop wnd = bringWindowToTop wnd =
failIfFalse_ "BringWindowToTop" $ c_BringWindowToTop wnd failIfFalse_ "BringWindowToTop" $ c_BringWindowToTop wnd
foreign import stdcall unsafe "windows.h BringWindowToTop" foreign import stdcall "windows.h BringWindowToTop"
c_BringWindowToTop :: HWND -> IO Bool c_BringWindowToTop :: HWND -> IO Bool


-- Can't pass structs with current FFI, so use a C wrapper (in Types) -- Can't pass structs with current FFI, so use a C wrapper (in Types)
Expand All @@ -412,9 +412,7 @@ childWindowFromPointEx parent pt flags =


closeWindow :: HWND -> IO () closeWindow :: HWND -> IO ()
closeWindow wnd = closeWindow wnd =
failIfFalse_ "CloseWindow" $ c_CloseWindow wnd failIfFalse_ "CloseWindow" $ c_DestroyWindow wnd
foreign import stdcall unsafe "windows.h DestroyWindow"
c_CloseWindow :: HWND -> IO Bool


deferWindowPos :: HDWP -> HWND -> HWND -> Int -> Int -> Int -> Int -> SetWindowPosFlags -> IO HDWP deferWindowPos :: HDWP -> HWND -> HWND -> Int -> Int -> Int -> Int -> SetWindowPosFlags -> IO HDWP
deferWindowPos wp wnd after x y cx cy flags = deferWindowPos wp wnd after x y cx cy flags =
Expand All @@ -425,7 +423,7 @@ foreign import stdcall unsafe "windows.h DeferWindowPos"
destroyWindow :: HWND -> IO () destroyWindow :: HWND -> IO ()
destroyWindow wnd = destroyWindow wnd =
failIfFalse_ "DestroyWindow" $ c_DestroyWindow wnd failIfFalse_ "DestroyWindow" $ c_DestroyWindow wnd
foreign import stdcall unsafe "windows.h DestroyWindow" foreign import stdcall "windows.h DestroyWindow"
c_DestroyWindow :: HWND -> IO Bool c_DestroyWindow :: HWND -> IO Bool


endDeferWindowPos :: HDWP -> IO () endDeferWindowPos :: HDWP -> IO ()
Expand Down Expand Up @@ -457,7 +455,7 @@ foreign import stdcall unsafe "windows.h FlashWindow"
moveWindow :: HWND -> Int -> Int -> Int -> Int -> Bool -> IO () moveWindow :: HWND -> Int -> Int -> Int -> Int -> Bool -> IO ()
moveWindow wnd x y w h repaint = moveWindow wnd x y w h repaint =
failIfFalse_ "MoveWindow" $ c_MoveWindow wnd x y w h repaint failIfFalse_ "MoveWindow" $ c_MoveWindow wnd x y w h repaint
foreign import stdcall unsafe "windows.h MoveWindow" foreign import stdcall "windows.h MoveWindow"
c_MoveWindow :: HWND -> Int -> Int -> Int -> Int -> Bool -> IO Bool c_MoveWindow :: HWND -> Int -> Int -> Int -> Int -> Bool -> IO Bool


foreign import stdcall unsafe "windows.h GetDesktopWindow" foreign import stdcall unsafe "windows.h GetDesktopWindow"
Expand Down Expand Up @@ -653,12 +651,12 @@ peekMessage msg mb_wnd filterMin filterMax remove = do
failIf (== -1) "PeekMessage" $ failIf (== -1) "PeekMessage" $
c_PeekMessage msg (maybePtr mb_wnd) filterMin filterMax remove c_PeekMessage msg (maybePtr mb_wnd) filterMin filterMax remove
return () return ()
foreign import stdcall unsafe "windows.h PeekMessageW" foreign import stdcall "windows.h PeekMessageW"
c_PeekMessage :: LPMSG -> HWND -> UINT -> UINT -> UINT -> IO LONG c_PeekMessage :: LPMSG -> HWND -> UINT -> UINT -> UINT -> IO LONG


-- Note: you're not supposed to call this if you're using accelerators -- Note: you're not supposed to call this if you're using accelerators


foreign import stdcall unsafe "windows.h TranslateMessage" foreign import stdcall "windows.h TranslateMessage"
translateMessage :: LPMSG -> IO BOOL translateMessage :: LPMSG -> IO BOOL


updateWindow :: HWND -> IO () updateWindow :: HWND -> IO ()
Expand Down

0 comments on commit ba87712

Please sign in to comment.