{-# LANGUAGE ScopedTypeVariables #-} -- -*-haskell-*- #include #include "template-hsc-gtk2hs.h" -- GIMP Toolkit (GTK) GDK Serializabled Event -- -- Author : Andy Stewart, Axel Simon -- -- Created: 01 Jul 2010 -- -- Copyright (C) 2010 Andy Stewart -- Copyright (C) 2010 Axel Simon -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 of the License, or (at your option) any later version. -- -- This library is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- Lesser General Public License for more details. -- -- | -- Maintainer : gtk2hs-users\@lists.sourceforge.net -- Stability : stable -- Portability : portable (depends on GHC) -- module Graphics.UI.Gtk.Gdk.SerializedEvent ( -- * Types SerializedEvent (..), -- * Methods serializedEvent, deserializeEvent, ) where import Control.Monad (liftM) import Control.Monad.Reader (ask, runReaderT ) import Control.Monad.Trans (liftIO) import Data.Function import Data.Maybe import Data.Ord import Graphics.UI.Gtk.Gdk.DrawWindow import Graphics.UI.Gtk.Gdk.EventM import Graphics.UI.Gtk.Gdk.Keys (KeyVal) import Graphics.UI.GtkInternals import System.Glib.FFI import System.Glib.Flags data SerializedEvent = SerializedEventKey {sEventType :: Int ,sEventSent :: Bool ,sEventState :: Int ,sEventKeyval :: KeyVal ,sEventLength :: Int ,sEventString :: String ,sEventKeycode :: Word16 ,sEventGroup :: Word8} | SerializedEventButton {sEventType :: Int ,sEventSent :: Bool ,sEventX :: Double ,sEventY :: Double ,sEventState :: Int ,sEventButton :: Int ,sEventXRoot :: Double ,sEventYRoot :: Double} deriving (Show, Read, Eq, Ord) serializedEvent :: EventM t SerializedEvent serializedEvent = do ptr <- ask liftIO $ do (eType :: #gtk2hs_type GdkEventType) <- #{peek GdkEventAny,type} ptr (case eType of #{const GDK_KEY_PRESS} -> peekEventKey #{const GDK_KEY_RELEASE} -> peekEventKey #{const GDK_BUTTON_PRESS} -> peekEventButton #{const GDK_2BUTTON_PRESS} -> peekEventButton #{const GDK_3BUTTON_PRESS} -> peekEventButton #{const GDK_BUTTON_RELEASE} -> peekEventButton ty -> error ("serializedEvent: haven't support event type " ++ show ty)) ptr deserializeEvent :: SerializedEvent -> DrawWindow -> (EventM t a) -> IO a deserializeEvent event drawWindow fun = do let execFun = case fromIntegral $ sEventType event of #{const GDK_KEY_PRESS} -> withEventKey #{const GDK_KEY_RELEASE} -> withEventKey #{const GDK_BUTTON_PRESS} -> withEventButton #{const GDK_2BUTTON_PRESS} -> withEventButton #{const GDK_3BUTTON_PRESS} -> withEventButton #{const GDK_BUTTON_RELEASE} -> withEventButton ty -> error ("deserializeEvent: haven't support event type " ++ show ty) execFun drawWindow event $ runReaderT fun peekEventKey ptr = do (typ_ :: #gtk2hs_type GdkEventType) <- #{peek GdkEventKey, type} ptr (sent_ :: #gtk2hs_type gint8) <- #{peek GdkEventKey, send_event} ptr (state_ :: #gtk2hs_type guint) <- #{peek GdkEventKey, state} ptr (keyval_ :: #gtk2hs_type guint) <- #{peek GdkEventKey, keyval} ptr (length_ :: #gtk2hs_type gint) <- #{peek GdkEventKey, length} ptr (string_ :: CString) <- #{peek GdkEventKey, string} ptr (keycode_ :: #gtk2hs_type guint16) <- #{peek GdkEventKey, hardware_keycode} ptr (group_ :: #gtk2hs_type guint8) <- #{peek GdkEventKey, group} ptr return $ SerializedEventKey {sEventType = fromIntegral typ_ ,sEventSent = toBool sent_ ,sEventState = fromIntegral state_ ,sEventKeyval = keyval_ ,sEventLength = fromIntegral length_ ,sEventString = unsafePerformIO $ peekCString' string_ ,sEventKeycode = keycode_ ,sEventGroup = group_ } where peekCString' :: CString -> IO String peekCString' strPtr | strPtr == nullPtr = return "" | otherwise = peekCString strPtr peekEventButton ptr = do (typ_ :: #gtk2hs_type GdkEventType) <- #{peek GdkEventButton, type} ptr (sent_ :: #gtk2hs_type gint8) <- #{peek GdkEventButton, send_event} ptr (x_ :: #gtk2hs_type gdouble) <- #{peek GdkEventButton, x} ptr (y_ :: #gtk2hs_type gdouble) <- #{peek GdkEventButton, y} ptr (state_ :: #gtk2hs_type guint) <- #{peek GdkEventButton, state} ptr (button_ :: #gtk2hs_type guint) <- #{peek GdkEventButton, button} ptr (xRoot_ :: #gtk2hs_type gdouble) <- #{peek GdkEventButton, x_root} ptr (yRoot_ :: #gtk2hs_type gdouble) <- #{peek GdkEventButton, y_root} ptr return $ SerializedEventButton {sEventType = fromIntegral typ_ ,sEventSent = toBool sent_ ,sEventX = realToFrac x_ ,sEventY = realToFrac y_ ,sEventState = fromIntegral state_ ,sEventButton = fromIntegral button_ ,sEventXRoot = realToFrac xRoot_ ,sEventYRoot = realToFrac yRoot_ } withEventKey window_ (SerializedEventKey {sEventType = typ_ ,sEventSent = sent_ ,sEventState = state_ ,sEventKeyval = keyval_ ,sEventLength = length_ ,sEventString = string_ ,sEventKeycode = keycode_ ,sEventGroup = group_ }) act = withCString string_ $ \str -> allocaBytes #{const sizeof (GdkEventKey)} $ \ptr -> do #{poke GdkEventKey, type} ptr ((fromIntegral typ_) :: #gtk2hs_type GdkEventType) withForeignPtr (unDrawWindow window_) $ \winPtr -> #{poke GdkEventKey, window} ptr winPtr #{poke GdkEventKey, send_event} ptr ((fromBool sent_) :: #gtk2hs_type gint8) #{poke GdkEventKey, time} ptr ((fromIntegral currentTime) :: #gtk2hs_type guint32) #{poke GdkEventKey, state} ptr ((fromIntegral state_) :: #gtk2hs_type guint) #{poke GdkEventKey, keyval} ptr (keyval_ :: #gtk2hs_type guint) #{poke GdkEventKey, length} ptr ((fromIntegral length_) :: #gtk2hs_type gint) #{poke GdkEventKey, string} ptr str #{poke GdkEventKey, hardware_keycode} ptr (keycode_ :: #gtk2hs_type guint16) #{poke GdkEventKey, group} ptr (group_ :: #gtk2hs_type guint8) act ptr withEventButton window_ (SerializedEventButton {sEventType = typ_ ,sEventSent = sent_ ,sEventX = x_ ,sEventY = y_ ,sEventState = state_ ,sEventButton = button_ ,sEventXRoot = xRoot_ ,sEventYRoot = yRoot_ }) act = allocaBytes #{const sizeof (GdkEventButton)} $ \ptr -> do #{poke GdkEventButton, type} ptr ((fromIntegral typ_) :: #gtk2hs_type GdkEventType) withForeignPtr (unDrawWindow window_) $ \winPtr -> #{poke GdkEventButton, window} ptr winPtr #{poke GdkEventButton, send_event} ptr ((fromBool sent_) :: #gtk2hs_type gint8) #{poke GdkEventButton, time} ptr ((fromIntegral currentTime) :: #gtk2hs_type guint32) #{poke GdkEventButton, x} ptr ((realToFrac x_) :: #gtk2hs_type gdouble) #{poke GdkEventButton, y} ptr ((realToFrac y_) :: #gtk2hs_type gdouble) #{poke GdkEventButton, state} ptr ((fromIntegral state_) :: #gtk2hs_type guint) #{poke GdkEventButton, button} ptr ((fromIntegral button_) :: #gtk2hs_type guint) #{poke GdkEventButton, x_root} ptr ((realToFrac xRoot_) :: #gtk2hs_type gdouble) #{poke GdkEventButton, y_root} ptr ((realToFrac yRoot_) :: #gtk2hs_type gdouble) act ptr