diff options
Diffstat (limited to 'plug/src/Config.hs')
| -rw-r--r-- | plug/src/Config.hs | 24 |
1 files changed, 12 insertions, 12 deletions
diff --git a/plug/src/Config.hs b/plug/src/Config.hs index e80f360..5cf616f 100644 --- a/plug/src/Config.hs +++ b/plug/src/Config.hs @@ -50,6 +50,14 @@ instance StateExtension Dragging where marshalExtension _ = Nothing demarshalExtension _ = Nothing +newtype CursorPosition = CursorPosition (Double, Double) + deriving (Typeable) + +instance StateExtension CursorPosition where + initialValue = CursorPosition (0, 0) + marshalExtension _ = Nothing + demarshalExtension _ = Nothing + leftButton :: Word32 leftButton = 272 -- BTN_LEFT @@ -58,8 +66,8 @@ onButton ev | buttonEvent_button ev /= leftButton = return () | buttonEvent_state ev == ButtonPressed = do self <- getSelfPtr + CursorPosition (x, y) <- fromMaybe (CursorPosition (0, 0)) <$> xStateGet newDrag <- liftIO $ do - (x, y) <- getCursorPosition self tl <- foreign_toplevelAt (unwrapSelf self) (realToFrac x) (realToFrac y) if tl == nullPtr then return (Dragging Nothing) @@ -74,13 +82,13 @@ onButton ev | otherwise = return () onMotion :: MotionEvent -> Montis () -onMotion _ev = do +onMotion ev = do + let (x, y) = motionEvent_absolute ev + xStatePut (CursorPosition (x, y)) Dragging mdrag <- fromMaybe (Dragging Nothing) <$> xStateGet case mdrag of Nothing -> return () Just (DragState tl dx dy) -> do - self <- getSelfPtr - (x, y) <- liftIO $ getCursorPosition self liftIO $ foreign_setToplevelPosition tl @@ -90,14 +98,6 @@ onMotion _ev = do unwrapSelf :: SelfPtr -> Ptr Void unwrapSelf (SelfPtr p) = p -getCursorPosition :: SelfPtr -> IO (Double, Double) -getCursorPosition self = - alloca $ \xPtr -> alloca $ \yPtr -> do - foreign_getCursorPosition (unwrapSelf self) xPtr yPtr - x <- peek xPtr - y <- peek yPtr - return (realToFrac (x :: CDouble), realToFrac (y :: CDouble)) - getToplevelPosition :: Ptr ForeignMontisToplevel -> IO (Double, Double) getToplevelPosition tl = alloca $ \xPtr -> alloca $ \yPtr -> do |