Andy Stewart <lazycat.mana...@gmail.com> writes:
> 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.
No matter, i found better way:
Just skip ForeginPtr value when i do
Show, then i use "SerializedWindow Nothing" fill in Read instance.
-- Andy
> 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:
>
> {-# 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)
>
> -- Andy
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
