----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32.Menu -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module Graphics.Win32.Menu {- ( MenuName , checkMenuItem , checkMenuRadioItem , createMenu , createPopupMenu , deleteMenu , destroyMenu , drawMenuBar , enableMenuItem , getMenu , getMenuDefaultItem , getMenuItemCount , getMenuItemID , getMenuItemInfo , getMenuItemRect , getMenuState , getSubMenu , getSystemMenu , hiliteMenuItem , insertMenuItem , isMenu , loadMenu , menuItemFromPoint , setMenu , setMenuDefaultItem , setMenuItemBitmaps , setMenuItemInfo , trackPopupMenu , trackPopupMenuEx , GMDIFlag , MenuItem , MenuFlag , MenuState , TrackMenuFlag , SystemMenuCommand -- Obsolete: , appendMenu , insertMenu , modifyMenu , removeMenu ) -} where import Graphics.Win32.GDI.Types import System.Win32.Types import Foreign import Control.Monad (liftM) #include type MenuName = LPCTSTR checkMenuItem :: HMENU -> MenuItem -> MenuFlag -> IO Bool checkMenuItem menu item check = do rv <- failIf (== -1) "CheckMenuItem" $ c_CheckMenuItem menu item check return (rv == mF_CHECKED) foreign import stdcall unsafe "windows.h CheckMenuItem" c_CheckMenuItem :: HMENU -> UINT -> UINT -> IO DWORD checkMenuRadioItem :: HMENU -> MenuItem -> MenuItem -> MenuItem -> MenuFlag -> IO () checkMenuRadioItem menu first_id last_id check flags = failIfFalse_ "CheckMenuRadioItem" $ c_CheckMenuRadioItem menu first_id last_id check flags foreign import stdcall unsafe "windows.h CheckMenuRadioItem" c_CheckMenuRadioItem :: HMENU -> UINT -> UINT -> UINT -> UINT -> IO Bool createMenu :: IO HMENU createMenu = failIfNull "CreateMenu" $ c_CreateMenu foreign import stdcall unsafe "windows.h CreateMenu" c_CreateMenu :: IO HMENU createPopupMenu :: IO HMENU createPopupMenu = failIfNull "CreatePopupMenu" $ c_CreatePopupMenu foreign import stdcall unsafe "windows.h CreatePopupMenu" c_CreatePopupMenu :: IO HMENU drawMenuBar :: HWND -> IO () drawMenuBar wnd = failIfFalse_ "DrawMenuBar" $ c_DrawMenuBar wnd foreign import stdcall unsafe "windows.h DrawMenuBar" c_DrawMenuBar :: HWND -> IO Bool type MenuState = MenuFlag enableMenuItem :: HMENU -> MenuItem -> MenuFlag -> IO MenuState enableMenuItem menu item flag = failIf (== 0xffffffff) "EnableMenuItem" $ c_EnableMenuItem menu item flag foreign import stdcall unsafe "windows.h EnableMenuItem" c_EnableMenuItem :: HMENU -> UINT -> UINT -> IO MenuState type GMDIFlag = UINT type MenuFlag = UINT #{enum GMDIFlag, , gMDI_USEDISABLED = GMDI_USEDISABLED , gMDI_GOINTOPOPUPS = GMDI_GOINTOPOPUPS } #{enum MenuFlag, , mF_BYCOMMAND = MF_BYCOMMAND , mF_BYPOSITION = MF_BYPOSITION , mF_CHECKED = MF_CHECKED } type MenuItem = UINT #{enum MenuItem, , mF_INSERT = MF_INSERT , mF_CHANGE = MF_CHANGE , mF_APPEND = MF_APPEND , mF_DELETE = MF_DELETE , mF_REMOVE = MF_REMOVE , mF_USECHECKBITMAPS = MF_USECHECKBITMAPS , mF_POPUP = MF_POPUP , mF_SYSMENU = MF_SYSMENU , mF_HELP = MF_HELP , mF_MOUSESELECT = MF_MOUSESELECT , mF_END = MF_END // Obsolete -- only used by old RES files } #{enum MenuFlag, , mFT_STRING = MFT_STRING , mFT_BITMAP = MFT_BITMAP , mFT_MENUBARBREAK = MFT_MENUBARBREAK , mFT_MENUBREAK = MFT_MENUBREAK , mFT_OWNERDRAW = MFT_OWNERDRAW , mFT_RADIOCHECK = MFT_RADIOCHECK , mFT_SEPARATOR = MFT_SEPARATOR , mFT_RIGHTORDER = MFT_RIGHTORDER , mFT_RIGHTJUSTIFY = MFT_RIGHTJUSTIFY } #{enum MenuState, , mFS_GRAYED = MFS_GRAYED , mFS_DISABLED = MFS_DISABLED // == MFS_GRAYED , mFS_CHECKED = MFS_CHECKED , mFS_HILITE = MFS_HILITE , mFS_ENABLED = MFS_ENABLED , mFS_UNCHECKED = MFS_UNCHECKED , mFS_UNHILITE = MFS_UNHILITE , mFS_DEFAULT = MFS_DEFAULT } type TrackMenuFlag = UINT #{enum TrackMenuFlag, , tPM_LEFTBUTTON = TPM_LEFTBUTTON , tPM_RIGHTBUTTON = TPM_RIGHTBUTTON , tPM_LEFTALIGN = TPM_LEFTALIGN , tPM_CENTERALIGN = TPM_CENTERALIGN , tPM_RIGHTALIGN = TPM_RIGHTALIGN , tPM_TOPALIGN = TPM_TOPALIGN , tPM_VCENTERALIGN = TPM_VCENTERALIGN , tPM_BOTTOMALIGN = TPM_BOTTOMALIGN , tPM_HORIZONTAL = TPM_HORIZONTAL // Horz alignment matters more , tPM_VERTICAL = TPM_VERTICAL // Vert alignment matters more , tPM_NONOTIFY = TPM_NONOTIFY // Don't send any notification msgs , tPM_RETURNCMD = TPM_RETURNCMD } type SystemMenuCommand = UINT #{enum SystemMenuCommand, , sC_SIZE = SC_SIZE , sC_MOVE = SC_MOVE , sC_MINIMIZE = SC_MINIMIZE , sC_MAXIMIZE = SC_MAXIMIZE , sC_NEXTWINDOW = SC_NEXTWINDOW , sC_PREVWINDOW = SC_PREVWINDOW , sC_CLOSE = SC_CLOSE , sC_VSCROLL = SC_VSCROLL , sC_HSCROLL = SC_HSCROLL , sC_MOUSEMENU = SC_MOUSEMENU , sC_KEYMENU = SC_KEYMENU , sC_ARRANGE = SC_ARRANGE , sC_RESTORE = SC_RESTORE , sC_TASKLIST = SC_TASKLIST , sC_SCREENSAVE = SC_SCREENSAVE , sC_HOTKEY = SC_HOTKEY , sC_DEFAULT = SC_DEFAULT , sC_MONITORPOWER = SC_MONITORPOWER , sC_CONTEXTHELP = SC_CONTEXTHELP , sC_SEPARATOR = SC_SEPARATOR } foreign import stdcall unsafe "windows.h IsMenu" isMenu :: HMENU -> IO Bool getSystemMenu :: HWND -> Bool -> IO (Maybe HMENU) getSystemMenu wnd revert = liftM ptrToMaybe $ c_GetSystemMenu wnd revert foreign import stdcall unsafe "windows.h GetSystemMenu" c_GetSystemMenu :: HWND -> Bool -> IO HMENU getMenu :: HWND -> IO (Maybe HMENU) getMenu wnd = liftM ptrToMaybe $ c_GetMenu wnd foreign import stdcall unsafe "windows.h GetMenu" c_GetMenu :: HWND -> IO HMENU getMenuDefaultItem :: HMENU -> Bool -> GMDIFlag -> IO MenuItem getMenuDefaultItem menu bypos flags = failIf (== -1) "GetMenuDefaultItem" $ c_GetMenuDefaultItem menu bypos flags foreign import stdcall unsafe "windows.h GetMenuDefaultItem" c_GetMenuDefaultItem :: HMENU -> Bool -> UINT -> IO UINT getMenuState :: HMENU -> MenuItem -> MenuFlag -> IO MenuState getMenuState menu item flags = failIf (== -1) "GetMenuState" $ c_GetMenuState menu item flags foreign import stdcall unsafe "windows.h GetMenuState" c_GetMenuState :: HMENU -> UINT -> UINT -> IO MenuState getSubMenu :: HMENU -> MenuItem -> IO (Maybe HMENU) getSubMenu menu pos = liftM ptrToMaybe $ c_GetSubMenu menu pos foreign import stdcall unsafe "windows.h GetSubMenu" c_GetSubMenu :: HMENU -> UINT -> IO HMENU setMenu :: HWND -> HMENU -> IO () setMenu wnd menu = failIfFalse_ "SetMenu" $ c_SetMenu wnd menu foreign import stdcall unsafe "windows.h SetMenu" c_SetMenu :: HWND -> HMENU -> IO Bool getMenuItemCount :: HMENU -> IO Int getMenuItemCount menu = failIf (== -1) "GetMenuItemCount" $ c_GetMenuItemCount menu foreign import stdcall unsafe "windows.h GetMenuItemCount" c_GetMenuItemCount :: HMENU -> IO Int type MenuID = UINT getMenuItemID :: HMENU -> MenuItem -> IO MenuID getMenuItemID menu item = failIf (== -1) "GetMenuItemID" $ c_GetMenuItemID menu item foreign import stdcall unsafe "windows.h GetMenuItemID" c_GetMenuItemID :: HMENU -> UINT -> IO MenuID data MenuItemInfo = MenuItemInfo { menuItemType :: MenuFlag, menuItemState :: MenuState, menuItemID :: UINT, menuItemSubMenu :: HMENU, menuItemBitmapChecked :: HBITMAP, menuItemBitmapUnchecked :: HBITMAP, menuItemData :: DWORD, menuItemTypeData :: String } -- Don't make this an instance of Storable, because poke isn't what we want. peekMenuItemInfo :: Ptr MenuItemInfo -> IO MenuItemInfo peekMenuItemInfo p = do itemType <- #{peek MENUITEMINFO,fType} p itemState <- #{peek MENUITEMINFO,fState} p itemID <- #{peek MENUITEMINFO,wID} p itemSubMenu <- #{peek MENUITEMINFO,hSubMenu} p itemBitmapChecked <- #{peek MENUITEMINFO,hbmpChecked} p itemBitmapUnchecked <- #{peek MENUITEMINFO,hbmpUnchecked} p itemData <- #{peek MENUITEMINFO,dwItemData} p nchars <- #{peek MENUITEMINFO,cch} p c_str <- #{peek MENUITEMINFO,dwTypeData} p itemTypeData <- peekTStringLen (c_str, fromIntegral (nchars::UINT)) return MenuItemInfo { menuItemType = itemType , menuItemState = itemState , menuItemID = itemID , menuItemSubMenu = itemSubMenu , menuItemBitmapChecked = itemBitmapChecked , menuItemBitmapUnchecked = itemBitmapUnchecked , menuItemData = itemData , menuItemTypeData = itemTypeData } allocaMenuItemInfo :: (Ptr MenuItemInfo -> IO a) -> IO a allocaMenuItemInfo f = let size = #{size MENUITEMINFO} in allocaBytes size $ \ p -> do #{poke MENUITEMINFO,cbSize} p (fromIntegral size::DWORD) f p withMenuItemInfo :: MenuItemInfo -> (Ptr MenuItemInfo -> IO a) -> IO a withMenuItemInfo info f = allocaMenuItemInfo $ \ p -> withTStringLen (menuItemTypeData info) $ \ (c_str, nchars) -> do #{poke MENUITEMINFO,fType} p (menuItemType info) #{poke MENUITEMINFO,fState} p (menuItemState info) #{poke MENUITEMINFO,wID} p (menuItemID info) #{poke MENUITEMINFO,hSubMenu} p (menuItemSubMenu info) #{poke MENUITEMINFO,hbmpChecked} p (menuItemBitmapChecked info) #{poke MENUITEMINFO,hbmpUnchecked} p (menuItemBitmapUnchecked info) #{poke MENUITEMINFO,dwItemData} p c_str #{poke MENUITEMINFO,cch} p (fromIntegral nchars::UINT) f p type MenuItemMask = UINT #{enum MenuItemMask, , mIIM_CHECKMARKS = MIIM_CHECKMARKS , mIIM_DATA = MIIM_DATA , mIIM_ID = MIIM_ID , mIIM_STATE = MIIM_STATE , mIIM_SUBMENU = MIIM_SUBMENU , mIIM_TYPE = MIIM_TYPE } pokeFMask :: Ptr MenuItemInfo -> MenuItemMask -> IO () pokeFMask p_info mask = #{poke MENUITEMINFO,fMask} p_info mask getMenuItemInfo :: HMENU -> MenuItem -> Bool -> MenuItemMask -> IO MenuItemInfo getMenuItemInfo menu item bypos mask = allocaMenuItemInfo $ \ p_info -> do pokeFMask p_info mask failIfFalse_ "GetMenuItemInfo" $ c_GetMenuItemInfo menu item bypos p_info peekMenuItemInfo p_info foreign import stdcall unsafe "windows.h GetMenuItemInfoW" c_GetMenuItemInfo :: HMENU -> UINT -> Bool -> Ptr MenuItemInfo -> IO Bool getMenuItemRect :: HWND -> HMENU -> MenuItem -> IO RECT getMenuItemRect wnd menu item = allocaRECT $ \ p_rect -> do failIfFalse_ "GetMenuItemRect" $ c_GetMenuItemRect wnd menu item p_rect peekRECT p_rect foreign import stdcall unsafe "windows.h GetMenuItemRect" c_GetMenuItemRect :: HWND -> HMENU -> UINT -> LPRECT -> IO Bool foreign import stdcall unsafe "windows.h HiliteMenuItem" hiliteMenuItem :: HWND -> HMENU -> MenuItem -> MenuFlag -> IO Bool insertMenuItem :: HMENU -> MenuItem -> Bool -> MenuItemInfo -> IO () insertMenuItem menu item bypos info = withMenuItemInfo info $ \ p_info -> failIfFalse_ "InsertMenuItem" $ c_InsertMenuItem menu item bypos p_info foreign import stdcall unsafe "windows.h InsertMenuItemW" c_InsertMenuItem :: HMENU -> UINT -> Bool -> Ptr MenuItemInfo -> IO Bool type Menu = LPCTSTR -- intToMenu :: Int -> Menu -- intToMenu i = makeIntResource (toWord i) loadMenu :: Maybe HINSTANCE -> Menu -> IO HMENU loadMenu mb_inst menu = failIfNull "LoadMenu" $ c_LoadMenu (maybePtr mb_inst) menu foreign import stdcall unsafe "windows.h LoadMenuW" c_LoadMenu :: HINSTANCE -> Menu -> IO HMENU -- Dealing with mappings to/from structs is a pain in GC, -- so we'll leave this one out for now. -- %fun LoadMenuIndirect :: MenuTemplate -> IO HMENU -- Can't pass structs with current FFI, so use a C wrapper (from Types) menuItemFromPoint :: HWND -> HMENU -> POINT -> IO UINT menuItemFromPoint wnd menu pt = withPOINT pt $ \ p_pt -> prim_MenuItemFromPoint wnd menu p_pt setMenuDefaultItem :: HMENU -> MenuItem -> Bool -> IO () setMenuDefaultItem menu item bypos = failIfFalse_ "SetMenuDefaultItem" $ c_SetMenuDefaultItem menu item bypos foreign import stdcall unsafe "windows.h SetMenuDefaultItem" c_SetMenuDefaultItem :: HMENU -> MenuItem -> Bool -> IO Bool setMenuItemBitmaps :: HMENU -> MenuItem -> MenuFlag -> HBITMAP -> HBITMAP -> IO () setMenuItemBitmaps menu pos flags bm_unchecked bm_checked = failIfFalse_ "SetMenuItemBitmaps" $ c_SetMenuItemBitmaps menu pos flags bm_unchecked bm_checked foreign import stdcall unsafe "windows.h SetMenuItemBitmaps" c_SetMenuItemBitmaps :: HMENU -> UINT -> UINT -> HBITMAP -> HBITMAP -> IO Bool destroyMenu :: HMENU -> IO () destroyMenu menu = failIfFalse_ "DestroyMenu" $ c_DestroyMenu menu foreign import stdcall unsafe "windows.h DestroyMenu" c_DestroyMenu :: HMENU -> IO Bool deleteMenu :: HMENU -> MenuItem -> MenuFlag -> IO () deleteMenu menu item flag = failIfFalse_ "DeleteMenu" $ c_DeleteMenu menu item flag foreign import stdcall unsafe "windows.h DeleteMenu" c_DeleteMenu :: HMENU -> UINT -> UINT -> IO Bool setMenuItemInfo :: HMENU -> MenuItem -> Bool -> MenuItemMask -> MenuItemInfo -> IO () setMenuItemInfo menu item bypos mask info = withMenuItemInfo info $ \ p_info -> do pokeFMask p_info mask failIfFalse_ "SetMenuItemInfo" $ c_SetMenuItemInfo menu item bypos p_info foreign import stdcall unsafe "windows.h SetMenuItemInfoW" c_SetMenuItemInfo :: HMENU -> UINT -> Bool -> Ptr MenuItemInfo -> IO Bool trackPopupMenu :: HMENU -> TrackMenuFlag -> Int -> Int -> HWND -> RECT -> IO () trackPopupMenu menu flags x y wnd rect = withRECT rect $ \ p_rect -> failIfFalse_ "TrackPopupMenu" $ c_TrackPopupMenu menu flags x y 0 wnd p_rect foreign import stdcall unsafe "windows.h TrackPopupMenu" c_TrackPopupMenu :: HMENU -> TrackMenuFlag -> Int -> Int -> Int -> HWND -> LPRECT -> IO Bool type TPMPARAMS = () withTPMPARAMS :: Ptr RECT -> (Ptr TPMPARAMS -> IO a) -> IO a withTPMPARAMS p_rect f = let size = #{size TPMPARAMS} in allocaBytes size $ \ p -> do #{poke TPMPARAMS,cbSize} p (fromIntegral size::UINT) copyBytes (#{ptr TPMPARAMS,rcExclude} p) p_rect size f p trackPopupMenuEx :: HMENU -> TrackMenuFlag -> Int -> Int -> HWND -> Maybe (Ptr RECT) -> IO () trackPopupMenuEx menu flags x y wnd mb_p_rect = maybeWith withTPMPARAMS mb_p_rect $ \ p_ptmp -> failIfFalse_ "TrackPopupMenuEx" $ c_TrackPopupMenuEx menu flags x y wnd p_ptmp foreign import stdcall unsafe "windows.h TrackPopupMenuEx" c_TrackPopupMenuEx :: HMENU -> TrackMenuFlag -> Int -> Int -> HWND -> Ptr TPMPARAMS -> IO Bool -- Note: these 3 assume the flags don't include MF_BITMAP or MF_OWNERDRAW -- (which are hidden by this interface) appendMenu :: HMENU -> MenuFlag -> MenuID -> String -> IO () appendMenu menu flags id_item name = withTString name $ \ c_name -> failIfFalse_ "AppendMenu" $ c_AppendMenu menu flags id_item c_name foreign import stdcall unsafe "windows.h AppendMenuW" c_AppendMenu :: HMENU -> UINT -> MenuID -> LPCTSTR -> IO Bool insertMenu :: HMENU -> MenuItem -> MenuFlag -> MenuID -> String -> IO () insertMenu menu item flags id_item name = withTString name $ \ c_name -> failIfFalse_ "InsertMenu" $ c_InsertMenu menu item flags id_item c_name foreign import stdcall unsafe "windows.h InsertMenuW" c_InsertMenu :: HMENU -> UINT -> UINT -> MenuID -> LPCTSTR -> IO Bool modifyMenu :: HMENU -> MenuItem -> MenuFlag -> MenuID -> String -> IO () modifyMenu menu item flags id_item name = withTString name $ \ c_name -> failIfFalse_ "ModifyMenu" $ c_ModifyMenu menu item flags id_item c_name foreign import stdcall unsafe "windows.h ModifyMenuW" c_ModifyMenu :: HMENU -> UINT -> UINT -> MenuID -> LPCTSTR -> IO Bool removeMenu :: HMENU -> MenuItem -> MenuFlag -> IO () removeMenu menu pos flags = failIfFalse_ "RemoveMenu" $ c_RemoveMenu menu pos flags foreign import stdcall unsafe "windows.h RemoveMenu" c_RemoveMenu :: HMENU -> UINT -> UINT -> IO Bool ---------------------------------------------------------------- -- End ----------------------------------------------------------------