| 1 | import System.IO |
|---|
| 2 | import Graphics.UI.Gtk as Gtk |
|---|
| 3 | import Graphics.UI.Gtk.Gdk.EventM as GdkE |
|---|
| 4 | import Graphics.UI.Gtk.Glade as Glade |
|---|
| 5 | import Graphics.UI.Gtk.ModelView as MV |
|---|
| 6 | import Control.Monad.Trans ( liftIO ) |
|---|
| 7 | |
|---|
| 8 | _STRING_COLUMN :: MV.ColumnId String String |
|---|
| 9 | _STRING_COLUMN = MV.makeColumnIdString 1 |
|---|
| 10 | |
|---|
| 11 | |
|---|
| 12 | defaultDrag :: Gtk.SelectionTypeTag -- ^ Selection to set data with. |
|---|
| 13 | -> Maybe ( Gtk.DragSourceIface model row ) |
|---|
| 14 | defaultDrag tag = (Just Gtk.DragSourceIface |
|---|
| 15 | { |
|---|
| 16 | treeDragSourceRowDraggable = \_ _ -> return True, |
|---|
| 17 | treeDragSourceDragDataGet = \_ (i:_) -> do |
|---|
| 18 | Gtk.selectionDataSet tag [i] |
|---|
| 19 | return True, |
|---|
| 20 | treeDragSourceDragDataDelete = \_ _ -> return False |
|---|
| 21 | }) |
|---|
| 22 | |
|---|
| 23 | defaultDrop tag sourceStore = |
|---|
| 24 | (Just Gtk.DragDestIface |
|---|
| 25 | { |
|---|
| 26 | treeDragDestRowDropPossible = \_ _ -> do liftIO $ putStrLn "checking if ListStore drop is possible" |
|---|
| 27 | return True, |
|---|
| 28 | treeDragDestDragDataReceived = \destStore _ -> do |
|---|
| 29 | liftIO $ MV.listStorePrepend destStore "world" |
|---|
| 30 | liftIO $ putStrLn "prepending to ListStore" |
|---|
| 31 | return True |
|---|
| 32 | }) |
|---|
| 33 | |
|---|
| 34 | main = do |
|---|
| 35 | Gtk.initGUI |
|---|
| 36 | |
|---|
| 37 | win <- Gtk.windowNew |
|---|
| 38 | Gtk.onDestroy win Gtk.mainQuit |
|---|
| 39 | hbox <- Gtk.hBoxNew True 10 |
|---|
| 40 | |
|---|
| 41 | targetl <- Gtk.targetListNew |
|---|
| 42 | Gtk.targetListAdd targetl MV.targetTreeModelRow [TargetSameApp] 0 |
|---|
| 43 | |
|---|
| 44 | |
|---|
| 45 | tvSource <- Gtk.treeViewNew |
|---|
| 46 | storeSource <- MV.listStoreNewDND ["world"] (defaultDrag Gtk.selectionTypeInteger) Nothing |
|---|
| 47 | MV.treeModelSetColumn storeSource _STRING_COLUMN id |
|---|
| 48 | MV.treeViewSetModel tvSource storeSource |
|---|
| 49 | |
|---|
| 50 | columnA <- MV.treeViewColumnNew |
|---|
| 51 | MV.treeViewColumnSetTitle columnA "Sources" |
|---|
| 52 | rendererA <- MV.cellRendererTextNew |
|---|
| 53 | MV.cellLayoutPackStart columnA rendererA True |
|---|
| 54 | MV.cellLayoutSetAttributes columnA rendererA storeSource $ \e -> [MV.cellText := e] |
|---|
| 55 | MV.treeViewAppendColumn tvSource columnA |
|---|
| 56 | MV.treeViewEnableModelDragSource tvSource [GdkE.Button1] targetl [Gtk.ActionCopy] |
|---|
| 57 | |
|---|
| 58 | |
|---|
| 59 | tvDest <- Gtk.treeViewNew |
|---|
| 60 | |
|---|
| 61 | |
|---|
| 62 | storeDest <- MV.listStoreNewDND [] Nothing (defaultDrop Gtk.selectionTypeInteger storeSource) |
|---|
| 63 | MV.treeModelSetColumn storeDest _STRING_COLUMN id |
|---|
| 64 | MV.treeViewSetModel tvDest storeDest |
|---|
| 65 | |
|---|
| 66 | columnDest <- MV.treeViewColumnNew |
|---|
| 67 | MV.treeViewColumnSetTitle columnDest "Destination" |
|---|
| 68 | rendererDest <- MV.cellRendererTextNew |
|---|
| 69 | MV.cellLayoutPackStart columnDest rendererDest True |
|---|
| 70 | MV.cellLayoutSetAttributes columnDest rendererDest storeDest $ \e -> [MV.cellText := e] |
|---|
| 71 | MV.treeViewAppendColumn tvDest columnDest |
|---|
| 72 | MV.treeViewEnableModelDragDest tvDest targetl [Gtk.ActionCopy] |
|---|
| 73 | |
|---|
| 74 | hbox `Gtk.containerAdd` tvSource |
|---|
| 75 | hbox `Gtk.containerAdd` tvDest |
|---|
| 76 | win `Gtk.containerAdd` hbox |
|---|
| 77 | Gtk.widgetShowAll win |
|---|
| 78 | Gtk.mainGUI |
|---|
