haskell - WxHaskell と DragAndDrop: dropTargetOnData、dropTargetOnDrop、dropTargetOnEnter、dropTargetOnDragOver をトリガーするカスタム イベントを作成する方法

Question

WxHaskell と DragAndDrop

次のイベント ハンドラーの使用方法を知りたい: dropTargetOnData、dropTargetOnDrop、dropTargetOnEnter、dropTargetOnDragOver….[1]

私の現在の信念が正しいかどうかを確認していただけますか:

• wx Widgets/ wxPython [2] / [3] / [4] から、重要な例の DragAndDrog を管理するために使用する必要があるようです。
• 「ドラッグ中」などの既存のイベントを介して実行することはできません。
• 独自のイベントを作成してみました。しかし、それは「アクティブ化」されません。[7]
• さらに、シグネチャ [1] から、これらは Reactive/ Windows/Controls の他のイベントとは異なり、DropTarget でアクティブ化されているように見えます。それが正しいか ？

• 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