WxHaskell和DragAndDrop：如何创建自定义事件以触发dropTargetOnData，dropTargetOnDrop，dropTargetOnEnter，dropTargetOnDragOver

Question

WxHaskell和DragAndDrop

我想知道如何使用以下事件处理程序  ：dropTargetOnData，dropTargetOnDrop，dropTargetOnEnter，dropTargetOnDragOver .... [1]

你能检查一下我目前认为的是否有更正：

• 从wx Widgets / wxPython [2] / [3] / [4]看来，它们需要用于管理DragAndDrog以用于非常重要的示例。
• 它们不能通过现有事件（如“拖动”等）进行操作。
• 我尝试创建自己的活动。但它没有被“激活”。 [7]
• 此外，从签名[1]，这些看起来像是在DropTarget上激活，与Reactive / Windows / Controls上的其他事件不同。它是正确的吗？

• Heinrich创建了自己的事件“onText”，（在反应香蕉中），但这是在一个控制。 [6]

• 有人可以确认这些事件在WxHaskell中为他们有效地工作，并且可能暗示如何做到这一点

  [1]： from Graphics.UI.WXCore.Events , line 1933 onwards

  Set an event handler that is called when the drop target can be filled with data. This function require to use 'dropTargetGetData' in your event handler to fill data. dropTargetOnData :: DropTarget a -> (Point -> DragResult -> IO DragResult) -> IO () ...

  -- | Set an event handler for an drop command in a drop target. dropTargetOnDrop :: DropTarget a -> (Point -> IO Bool) -> IO ()

  -- | Set an event handler for an enter command in a drop target. dropTargetOnEnter :: DropTarget a -> (Point -> DragResult -> IO DragResult) -> IO ()

  -- | Set an event handler for a drag over command in a drop target. dropTargetOnDragOver :: DropTarget a -> (Point -> DragResult -> IO DragResult) -> IO ()

  -- | Set an event handler for a leave command in a drop target. dropTargetOnLeave :: DropTarget a -> (IO ()) -> IO ()

[2]：http://docs.wxwidgets.org/2.8/wx_wxdroptarget.html#wxdroptargetondrop

[3]：http://wiki.wxpython.org/DragAndDrop

[4]：http://www.blog.pythonlibrary.org/2012/06/20/wxpython-introduction-to-drag-and-drop/

[5]：http://wewantarock.wordpress.com/2011/06/17/how-does-wxhaskell-event-handling-work-part-1/

[6]：https://github.com/HeinrichApfelmus/reactive-banana/blob/master/reactive-banana-wx/src/Reactive/Banana/WX.hs L 88

[7]： module Main where

import Graphics.UI.WX hiding (empty)

import Data.Maybe
import Control.Monad
import Graphics.UI.WX.Events
import Graphics.UI.WXCore.WxcClassesMZ
--import Graphics.UI.WXCore.WxcClassesAL
import Graphics.UI.WXCore.DragAndDrop
import Graphics.UI.WXCore.Events   
main
  = start dndtest
dndtest
  = do
      f      <- frame  [text := "Drag And Drop test"]
      p      <- panel  f []
      ok     <- button p [text := "Ok"]
      xinput <- textEntry p [text := "here :"] --textEntry
      yinput <- staticText p [text := "drag me"]
      zinput <- staticText p [text := "result me"]

      set f [defaultButton := ok
             ,layout := container p $
                        margin 10 $
                        column 5 [boxed "coordinates" (grid 5 5 [[label "source:", hfill $ widget yinput]
                                                                ,[label "target(focus first):", hfill $ widget xinput]
                                                                ,[label "result:", hfill $ widget zinput]
                                                                ])
                                 ,floatBottomRight $ row 5 [widget ok]]
                                 ]

      set xinput [ on enter := onEnter]

      set yinput [ ]

---------------------------------------------------------
--- meaningful stuff starts here
---------------------------------------------------------

       -- prepare the drop source : create a DataObject and associate it with the source
      textdata' <- textDataObjectCreate "text dropped"
      src <- dropSource textdata' yinput



       -- prepare the drop target: create a DataObject (placeholder here) and associate it with the target
      textdata <- textDataObjectCreate ".."
      drop <- dropTarget xinput textdata
      set drop [ on onMyDrop := showMeDrop ]  ---- <<<< I am expecting this to get fired but no ...
      -- obj create a new event on drop invoking ..
      -- and see if it is invoked

      set yinput [ on drag := onDrag src ]
      set xinput [ ] ------ <<<< I am expecting the target to react when dropped  (Its DroopedTarget i fact)
      set zinput [ on mouse := showMeE]


      set ok [ on command := close f ]
      return ()

--- this is the custom event, just a setter to fire dropTargetOnDrop. not sure at all this is the correct way.

onMyDrop = newEvent "onmyDrop" (\w -> ioError (userError ("attribute '" ++ "onmyDrop" ++ "' is write-only.")))  dropTargetOnDrop
--dropTargetOnDrop :: DropTarget a -> (Point -> IO Bool) -> IO ()
--- the rest are jsut helper to see whats going on

showMeEo = putStr "showMeEo"
showMeDrop p = do
                putStr "showMeDrop"
                return True



onDrag s p  =  do

--    dragAndDrop :: DropSource a -> DragMode -> (DragResult -> IO ()) -> IO ()
    dragAndDrop s Default (\r -> do {putStr "DnD handler called: "; putStrLn(show r); return ()})
    putStrLn "on Drag activated:"



showMeE :: EventMouse -> IO ()
showMeE (MouseMotion point mod) = putStr ""  --- discard meaningless Motion event
showMeE  e = putStrLn $ show e

--
onEnter p = putStrLn $ "on Enter:" ++ show p