Skip to content

Program hangs when I use trackPopupMenuEx #149

Open
@xafizoff

Description

Current Behavior

Program hangs with trackPopupMenu(Ex).

Steps to Reproduce (for bugs)

My code is based on https://github.com/haskell/win32/blob/v2.6.1.0/examples/hello.lhs, except I do not do painting.

wndProc ::
       Graphics.Win32.HWND
    -> Graphics.Win32.WindowMessage
    -> Graphics.Win32.WPARAM
    -> Graphics.Win32.LPARAM
    -> IO Graphics.Win32.LRESULT
wndProc hwnd wmsg wParam lParam
    | wmsg == Graphics.Win32.wM_COMMAND && wParam == fromIntegral iDM_QUIT = do
        Graphics.Win32.destroyWindow hwnd
        return 0
    | wmsg == 0x007B = do
        showContextMenu hwnd
        return 0
    | wmsg == Graphics.Win32.wM_DESTROY = do
        Graphics.Win32.sendMessage hwnd Graphics.Win32.wM_QUIT 1 0
        return 0
    | otherwise = do
        Graphics.Win32.defWindowProc (Just hwnd) wmsg wParam lParam

showContextMenu :: Graphics.Win32.HWND -> IO ()
showContextMenu hwnd = do
    hMenu <- createPopupMenu
    pt <- Graphics.Win32.Misc.getCursorPos
    appendMenu hMenu mFT_STRING iDM_Exit (Just "&Exit")
    trackPopupMenuEx hMenu tPM_RIGHTBUTTON (fromIntegral $ fst pt) (fromIntegral $ snd pt) hwnd Nothing
    destroyMenu hMenu

A pop-up menu appears, but the program ends up freezing after that. I've tried to remove WM_COMMAND branch from wndProc, but this does not help.

Your Environment

  • I'm using stack, tried resolvers lts-6.2, lts-16.8
  • Versions used: 2.3.1.1, 2.6.1.0
  • Operating System and version: Windows 10 Home

Metadata

Assignees

No one assigned

    Labels

    No labels
    No labels

    Type

    No type

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions