Ivan Lazar Miljenovic <ivan.miljeno...@gmail.com> writes:
> Andy Stewart <lazycat.mana...@gmail.com> writes:
>
>> Hi all,
>>
>> I have some incorrect "Read instance" make i got error "Prelude.read: no
>> parse", and i don't know how to fix it.
>>
>>
>> newtype SerializedWindow = SerializedWindow (Maybe DrawWindow)
>>
>> instance Show SerializedWindow where
>> show _ = "SerializedWindow Nothing"
>>
>> instance Read SerializedWindow where
>> readsPrec _ str = [(SerializedWindow Nothing, idStr)
>> | (val :: String, idStr) <- reads str]
>
> Try using Derive or DrIFT to generate a proto-typical instance for you,
> and then hack that and make it neater. If you don't care about
> cross-compiler compatability, using ReadP rather than ReadS also results
> in nicer parsing code.
Sorry, i haven't explain my situation.
I'm try to serialized/derserialized Gtk+ Event C struct over the network.
Since DrawWindow is ForeignPtr to point C structure, and "deriving Read"
nothing help.
So i want build a "bogus value" -- "SerializedWindow Nothing" to fill
DrawWindow pointer field.
I just want got "SerializedWindow Nothing" and don't care the value
that return by *reads*.
Below are C struct that i want to serialized with Haskell data-type:
typedef struct {
GdkEventType type;
GdkWindow *window;
gint8 send_event;
guint32 time;
guint state;
guint keyval;
gint length;
gchar *string;
guint16 hardware_keycode;
guint8 group;
guint is_modifier : 1;
} GdkEventKey;
Below are my C binding that explain my purpose:
------------------------------> C binding start <------------------------------
{-# LANGUAGE ScopedTypeVariables #-}
-- -*-haskell-*-
#include <gtk/gtk.h>
#include "template-hsc-gtk2hs.h"
-- GIMP Toolkit (GTK) GDK Serializabled Event
--
-- Author : Andy Stewart
--
-- Created: 01 Jul 2010
--
-- Copyright (C) 2010 Andy Stewart
--
-- 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-use...@lists.sourceforge.net
-- Stability : deprecated
-- Portability : portable (depends on GHC)
--
module Graphics.UI.Gtk.Gdk.SerializedEvent (
-- * Types
SerializedEventKey (..),
-- * Methods
serializedEvent,
deserializeEventKey,
) where
import Control.Monad.Reader (ReaderT, ask, runReaderT )
import Control.Monad.Trans (liftIO)
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 SerializedEventKey =
SerializedEventKey {sEventType :: Int
,sEventWindow :: SerializedWindow
,sEventSent :: Bool
,sEventTime :: Word32
,sEventState :: Int
,sEventKeyval :: KeyVal
,sEventLength :: Int
,sEventString :: String
,sEventKeycode :: Word16
,sEventGroup :: Word8
,sEventIsModifier:: Int}
deriving (Show, Eq, Ord, Read)
newtype SerializedWindow = SerializedWindow (Maybe DrawWindow)
instance Eq SerializedWindow where
(==) _ _ = True
instance Ord SerializedWindow where
compare _ _ = EQ
instance Show SerializedWindow where
show _ = "SerializedWindow Nothing"
instance Read SerializedWindow where
readsPrec _ str = [(SerializedWindow Nothing, idStr)
| (val :: String, idStr) <- reads str]
instance Storable SerializedEventKey where
sizeOf _ = #{const sizeof (GdkEventKey)}
alignment _ = alignment (undefined:: #gtk2hs_type gint)
peek ptr = peekSerializedKey ptr
poke ptr event = pokeSerializedKey ptr event
serializedEvent :: EventM t SerializedEventKey
serializedEvent = do
ptr <- ask
eType <- liftIO $ do
(typ::#gtk2hs_type GdkEventType) <- #{peek GdkEventAny,type} ptr
return typ
case eType of
#{const GDK_KEY_PRESS} -> serializedKey
#{const GDK_KEY_RELEASE} -> serializedKey
ty -> error ("serializedEvent: haven't handle
event type " ++ show ty)
serializedKey :: EventM t SerializedEventKey
serializedKey = do
ptr <- ask
liftIO $ peekSerializedKey ptr
peekSerializedKey ptr = do
(typ_ ::#gtk2hs_type GdkEventType) <- #{peek GdkEventKey, type}
ptr
(sent_ ::#gtk2hs_type gint8) <- #{peek GdkEventKey,
send_event} ptr
(time_ ::#gtk2hs_type guint32) <- #{peek GdkEventKey, time}
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
(keycode_ ::#gtk2hs_type guint16) <- #{peek GdkEventKey,
hardware_keycode} ptr
(group_ ::#gtk2hs_type guint8) <- #{peek GdkEventKey, group}
ptr
-- (isModifier_ ::#gtk2hs_type guint) <- #{peek GdkEventKey,
is_modifier} ptr
return $ SerializedEventKey
{sEventType = fromIntegral typ_
,sEventWindow = SerializedWindow Nothing -- this field need
synthesize at client side
,sEventSent = toBool sent_
,sEventTime = fromIntegral time_ -- this field need
synthesize at client side
,sEventState = fromIntegral state_
,sEventKeyval = keyval_
,sEventLength = fromIntegral length_
,sEventString = "" -- this filed has deprecated and should
never be used
,sEventKeycode = keycode_
,sEventGroup = group_
-- ,sEventIsModifier = isModifier_
,sEventIsModifier = 0
}
pokeSerializedKey ptr (SerializedEventKey
{sEventType = typ_
,sEventWindow = SerializedWindow window_
,sEventSent = sent_
,sEventTime = time_
,sEventState = state_
,sEventKeyval = keyval_
,sEventLength = length_
,sEventString = string_
,sEventKeycode = keycode_
,sEventGroup = group_
,sEventIsModifier = isModifier_
}) = do
#{poke GdkEventKey, type} ptr ((fromIntegral typ_)
::#gtk2hs_type GdkEventType)
case (fromMaybe (DrawWindow nullForeignPtr) window_) of
win_ -> withForeignPtr (unDrawWindow win_) $ \winPtr ->
#{poke GdkEventKey, window} ptr winPtr
#{poke GdkEventKey, send_event} ptr ((fromBool sent_)
::#gtk2hs_type gint8)
#{poke GdkEventKey, time} ptr ((fromIntegral time_)
::#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, hardware_keycode} ptr (keycode_
::#gtk2hs_type guint16)
#{poke GdkEventKey, group} ptr (group_
::#gtk2hs_type guint8)
-- | Insert DrawWindow and TimeStamp field when deserialized SerializedEventKey.
deserializeEventKey :: SerializedEventKey -> DrawWindow -> (EventM t a) -> IO a
deserializeEventKey event drawWindow fun = do
-- We need use *client* value replace field of event.
let newEvent = event {sEventWindow = SerializedWindow $ Just drawWindow
,sEventTime = currentTime}
with newEvent $ \eventPtr -> runReaderT fun (castPtr eventPtr)
------------------------------> C binding end <------------------------------
-- Andy
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
