diff options
Diffstat (limited to 'src/Gtk/Widgets/Sheet')
-rw-r--r-- | src/Gtk/Widgets/Sheet/Signal.dcl | 11 | ||||
-rw-r--r-- | src/Gtk/Widgets/Sheet/Signal.icl | 24 |
2 files changed, 35 insertions, 0 deletions
diff --git a/src/Gtk/Widgets/Sheet/Signal.dcl b/src/Gtk/Widgets/Sheet/Signal.dcl new file mode 100644 index 0000000..32f5383 --- /dev/null +++ b/src/Gtk/Widgets/Sheet/Signal.dcl @@ -0,0 +1,11 @@ +definition module Gtk.Widgets.Sheet.Signal + +from StdMaybe import :: Maybe + +from Gtk.Signal import class signalHandler, :: SignalHandlerInternal +from Gtk.State import :: GtkM + +:: GtkSheetSignalHandler + = TraverseHandler !((Maybe (Int,Int)) (Int,Int) -> GtkM (Maybe (Int, Int))) + +instance signalHandler GtkSheetSignalHandler diff --git a/src/Gtk/Widgets/Sheet/Signal.icl b/src/Gtk/Widgets/Sheet/Signal.icl new file mode 100644 index 0000000..562f806 --- /dev/null +++ b/src/Gtk/Widgets/Sheet/Signal.icl @@ -0,0 +1,24 @@ +implementation module Gtk.Widgets.Sheet.Signal + +import StdEnv +import StdMaybe + +import Control.Monad +import System._Pointer + +import Gtk + +instance signalHandler GtkSheetSignalHandler +where + signalName handler = case handler of + TraverseHandler _ -> "traverse" + signalHandler handler = case handler of + TraverseHandler f -> SHI_Int_Int_Pointer_Pointer_Bool \oldrow oldcol newrowp newcolp -> + let newrow = readInt4S newrowp 0; newcol = readInt4S newcolp 0 in + f (if (oldrow<0) Nothing (Just (oldrow,oldcol))) (newrow,newcol) >>= \r -> case r of + Nothing -> + pure False + Just (row,col) -> + appWorld (forceEval (writeInt4 newrowp 0 row)) >>| + appWorld (forceEval (writeInt4 newcolp 0 col)) >>| + pure True |