gtk-serialized-event-0.11.0: Graphics/UI/Gtk/Gdk/SerializedEvent.hsc
{-# LANGUAGE ScopedTypeVariables #-}
-- -*-haskell-*-
#include <gtk/gtk.h>
#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