module Graphics.UI.Gtk.Gdk.SerializedEvent (
SerializedEvent (..),
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 :: Int32) <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
(case eType of
8 -> peekEventKey
9 -> peekEventKey
4 -> peekEventButton
5 -> peekEventButton
6 -> peekEventButton
7 -> 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
8 -> withEventKey
9 -> withEventKey
4 -> withEventButton
5 -> withEventButton
6 -> withEventButton
7 -> withEventButton
ty -> error ("deserializeEvent: haven't support event type " ++ show ty)
execFun drawWindow event $ runReaderT fun
peekEventKey ptr = do
(typ_ :: Int32) <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
(sent_ :: Int8) <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
(state_ :: Word32) <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
(keyval_ :: Word32) <- (\hsc_ptr -> peekByteOff hsc_ptr 20) ptr
(length_ :: Int32) <- (\hsc_ptr -> peekByteOff hsc_ptr 24) ptr
(string_ :: CString) <- (\hsc_ptr -> peekByteOff hsc_ptr 28) ptr
(keycode_ :: Word16) <- (\hsc_ptr -> peekByteOff hsc_ptr 32) ptr
(group_ :: Word8) <- (\hsc_ptr -> peekByteOff hsc_ptr 34) 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_ :: Int32) <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
(sent_ :: Int8) <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
(x_ :: Double) <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
(y_ :: Double) <- (\hsc_ptr -> peekByteOff hsc_ptr 24) ptr
(state_ :: Word32) <- (\hsc_ptr -> peekByteOff hsc_ptr 36) ptr
(button_ :: Word32) <- (\hsc_ptr -> peekByteOff hsc_ptr 40) ptr
(xRoot_ :: Double) <- (\hsc_ptr -> peekByteOff hsc_ptr 48) ptr
(yRoot_ :: Double) <- (\hsc_ptr -> peekByteOff hsc_ptr 56) 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 36 $ \ptr -> do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr ((fromIntegral typ_) :: Int32)
withForeignPtr (unDrawWindow window_) $ \winPtr ->
(\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr winPtr
(\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr ((fromBool sent_) :: Int8)
(\hsc_ptr -> pokeByteOff hsc_ptr 12) ptr ((fromIntegral currentTime) :: Word32)
(\hsc_ptr -> pokeByteOff hsc_ptr 16) ptr ((fromIntegral state_) :: Word32)
(\hsc_ptr -> pokeByteOff hsc_ptr 20) ptr (keyval_ :: Word32)
(\hsc_ptr -> pokeByteOff hsc_ptr 24) ptr ((fromIntegral length_) :: Int32)
(\hsc_ptr -> pokeByteOff hsc_ptr 28) ptr str
(\hsc_ptr -> pokeByteOff hsc_ptr 32) ptr (keycode_ :: Word16)
(\hsc_ptr -> pokeByteOff hsc_ptr 34) ptr (group_ :: Word8)
act ptr
withEventButton window_ (SerializedEventButton
{sEventType = typ_
,sEventSent = sent_
,sEventX = x_
,sEventY = y_
,sEventState = state_
,sEventButton = button_
,sEventXRoot = xRoot_
,sEventYRoot = yRoot_
}) act =
allocaBytes 64 $ \ptr -> do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr ((fromIntegral typ_) :: Int32)
withForeignPtr (unDrawWindow window_) $ \winPtr ->
(\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr winPtr
(\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr ((fromBool sent_) :: Int8)
(\hsc_ptr -> pokeByteOff hsc_ptr 12) ptr ((fromIntegral currentTime) :: Word32)
(\hsc_ptr -> pokeByteOff hsc_ptr 16) ptr ((realToFrac x_) :: Double)
(\hsc_ptr -> pokeByteOff hsc_ptr 24) ptr ((realToFrac y_) :: Double)
(\hsc_ptr -> pokeByteOff hsc_ptr 36) ptr ((fromIntegral state_) :: Word32)
(\hsc_ptr -> pokeByteOff hsc_ptr 40) ptr ((fromIntegral button_) :: Word32)
(\hsc_ptr -> pokeByteOff hsc_ptr 48) ptr ((realToFrac xRoot_) :: Double)
(\hsc_ptr -> pokeByteOff hsc_ptr 56) ptr ((realToFrac yRoot_) :: Double)
act ptr