clutterhs-0.1: Graphics/UI/Clutter/Types.chs
-- -*-haskell-*-
-- Clutter Types
--
-- Author : Matthew Arsenault
--
-- Created: 5 Sep 2009
--
-- Copyright (C) 2009 Matthew Arsenault
--
-- 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 3 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.
--
{-# LANGUAGE ForeignFunctionInterface,
TypeSynonymInstances,
MultiParamTypeClasses,
ScopedTypeVariables,
FlexibleInstances #-}
#include <clutter/clutter.h>
{# context lib="clutter" prefix="clutter" #}
--CHECKME: gtk2hs change broke everything. I need to double check what
--they are doing to get the referencing right, but I just want it to
--compile right now.
module Graphics.UI.Clutter.Types (
withGObject,
newGObject,
withGValue,
constrGObject,
makeNewActor,
--TODO: Exports need organizing and stuff
GSSize,
GUnichar,
Word,
GID,
Timestamp,
DeviceID,
Color(..),
ColorPtr,
withColor,
Actor,
ActorClass,
withActor,
withActorClass,
toActor,
newActor,
newActorList,
Rectangle,
RectangleClass,
toRectangle,
withRectangle,
newRectangle,
Text,
TextClass,
toText,
withText,
withTextClass,
newText,
Stage,
StageClass,
withStage,
withStageClass,
newStage,
Container,
ContainerClass,
toContainer,
withContainer,
withContainerClass,
Perspective(..),
PerspectivePtr,
withPerspective,
PickMode(..),
Gravity(..),
RequestMode(..),
ActorFlags(..),
AllocationFlags(..),
RotateAxis(..),
InitError(..),
Event,
EventType(..),
EventFlags(..),
ModifierType(..),
StageState(..),
ScrollDirection(..),
Animation,
AnimationRaw,
AnimationRawClass,
toAnimation,
withAnimation,
mkAnimation,
newAnimationRaw,
getAnimationRaw,
Timeline,
TimelineClass,
withTimeline,
newTimeline,
newTimelineList,
Alpha,
AlphaClass,
withAlpha,
newAlpha,
AnimationMode(..),
TimelineDirection(..),
Interval,
IntervalRaw,
mkInterval,
withInterval,
newIntervalRaw,
Fog(..),
FogPtr,
withFog,
CairoTexture,
CairoTextureClass,
withCairoTexture,
newCairoTexture,
Media,
MediaClass,
withMedia,
withMediaClass,
ChildMeta,
ChildMetaClass,
newChildMeta,
Clone,
CloneRaw,
mkClone,
newCloneRaw,
withClone,
BehaviourClass,
Behaviour,
withBehaviour,
withBehaviourClass,
newBehaviour,
BehaviourForeachFunc,
CBehaviourForeachFunc,
newBehaviourForeachFunc,
BehaviourScaleClass,
BehaviourScale,
withBehaviourScale,
newBehaviourScale,
BehaviourDepthClass,
BehaviourDepth,
withBehaviourDepth,
newBehaviourDepth,
BehaviourEllipseClass,
BehaviourEllipse,
withBehaviourEllipse,
newBehaviourEllipse,
BehaviourOpacityClass,
BehaviourOpacity,
withBehaviourOpacity,
newBehaviourOpacity,
BehaviourRotateClass,
BehaviourRotate,
withBehaviourRotate,
newBehaviourRotate,
BehaviourPathClass,
BehaviourPath,
withBehaviourPath,
newBehaviourPath,
PathClass,
Path,
withPath,
newPath,
Group,
GroupClass,
newGroup,
withGroup,
AlphaFunc,
newAlphaFunc,
RotateDirection(..),
TextureQuality(..),
Texture,
TextureClass,
newTexture,
withTexture,
withTextureClass,
TextureFlags(..),
Shader,
ShaderClass,
withShader,
newShader,
ShaderError(..),
Model,
ModelClass,
withModel,
withModelClass,
newModel,
ModelIter,
ModelIterClass,
withModelIter,
newModelIter,
ListModel,
ListModelClass,
withListModel,
newListModel,
Script,
ScriptClass,
withScript,
newScript,
PathNodeType(..),
PathNode,
PathNodePtr,
Knot,
withPathNode,
newPathNodes,
PathCallback,
CPathCallback,
newPathCallback,
Score,
ScoreClass,
withScore,
newScore,
UnitType(..),
ScriptableClass,
Scriptable,
withScriptableClass,
BindingPool,
newBindingPool,
withBindingPool,
InputDeviceType(..),
GCallback,
CGCallback,
newGCallback,
Geometry,
GeometryPtr,
withGeometry,
Vertex,
VertexPtr,
withVertex,
vertexX,
vertexY,
vertexZ,
ActorBox,
actorBoxX1,
actorBoxY1,
actorBoxX2,
actorBoxY2,
ActorBoxPtr,
withActorBox,
--Units,
--unUnits
ScriptError(..),
FontFlags(..),
Animatable,
AnimatableClass,
withAnimatable,
withAnimatableClass,
Callback,
CCallback,
newCallback,
ModelForeachFunc,
CModelForeachFunc,
newModelForeachFunc,
RGBData,
mkRGBData,
rgbDataHasAlpha,
rgbDataData,
Activatable(..),
Playable(..)
) where
--FIXME: Conflict with EventType Nothing
import Prelude hiding (Nothing)
import Data.Word
--RGBData stuff
import Data.Ix
-- internal module of GHC
import Data.Array.Base ( MArray, newArray, newArray_, unsafeRead, unsafeWrite,
getBounds,
getNumElements
)
import C2HS hiding (newForeignPtr)
import System.Glib.GObject
import System.Glib.Signals
import System.Glib.GValue (GValue(GValue))
import System.Glib.GList
import System.Glib.Flags
import System.Glib.FFI
import Control.Monad (when, liftM2, join)
import Control.Exception (bracket)
-- gtk2hs changed mkGObject to be a tuple (GObject, objectUnref)
--TODO: Move this
constrGObject = fst mkGObject
--also why the flipped newForeignPtr there?
--from foreign.concurrent or something, and also flipped in System.Glib.FFI
--The name makeNewActor is unfortunate since Path technically isn't an
-- actor but has a floating reference
-- Get rid of the floating
-- reference to get a normal reference clutter actors and gtk widgets
-- have floating references
-- This is a convenience function to generate a new actor. (not to
-- be confused with 'newActor'. It adds the finalizer with the method
-- described under objectSink. It is basically the same thing as
-- 'makeNewObject' for GtkWidgets, since clutter actors are nearly the
-- same. The only difference is the class constraint, since Actors, etc.
-- shouldn't be Gtk's Object.
--
-- * The constr argument is the contructor of the specific object.
--
makeNewActor :: GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewActor (constr, objectUnref) generator = do
objPtr <- generator
when (objPtr == nullPtr) (fail "makeNewActorObject: object is NULL")
objectRefSink objPtr
obj <- newForeignPtr objPtr objectUnref
return $! constr obj
withGObject::GObjectClass o => o -> (Ptr () -> IO b) -> IO b
withGObject obj act = (withForeignPtr . unGObject . toGObject) obj $ \ptr -> act (castPtr ptr)
newGObject a = makeNewGObject (constrGObject, objectUnref) $ return (castPtr a)
--TODO: Make this castPtr go away
withGValue (GValue gval) = castPtr gval
--this doesn't seem to work since GObjectClass is not here
--I'm not sure if I can work around this. Oh well, I don't think it's that important
-- {# pointer *GObject newtype nocode #}
-- {# class GObjectClass GObject #}
--TODO: Make this go away.
type GSSize = {# type gssize #}
type GUnichar = {# type gunichar #}
-- *** Misc
{# enum ClutterInitError as InitError {underscoreToCase} deriving (Show, Eq) #}
{# enum ClutterPickMode as PickMode {underscoreToCase} deriving (Show, Eq) #}
{# enum ClutterAllocationFlags as AllocationFlags {underscoreToCase} deriving (Show, Eq, Bounded) #}
{# enum ClutterGravity as Gravity {underscoreToCase} deriving (Show, Eq) #}
{# enum ClutterActorFlags as ActorFlags {underscoreToCase} deriving (Show, Eq, Bounded) #}
{# enum ClutterRequestMode as RequestMode {underscoreToCase} deriving (Show, Eq) #}
{# enum ClutterRotateAxis as RotateAxis {underscoreToCase} deriving (Show, Eq) #}
{# enum ClutterEventType as EventType {underscoreToCase} deriving (Show, Eq) #}
{# enum ClutterEventFlags as EventFlags {underscoreToCase} deriving (Show, Eq, Bounded) #}
{# enum ClutterModifierType as ModifierType {underscoreToCase} deriving (Show, Eq) #}
{# enum ClutterStageState as StageState {underscoreToCase} deriving (Show, Eq) #}
{# enum ClutterScrollDirection as ScrollDirection {underscoreToCase} deriving (Show, Eq) #}
{# enum ClutterTimelineDirection as TimelineDirection {underscoreToCase} deriving (Show, Eq) #}
{# enum ClutterAnimationMode as AnimationMode {underscoreToCase} deriving (Show, Eq) #}
{# enum ClutterRotateDirection as RotateDirection {underscoreToCase} deriving (Show, Eq) #}
{# enum ClutterTextureQuality as TextureQuality {underscoreToCase} deriving (Show, Eq) #}
{# enum ClutterTextureFlags as TextureFlags {underscoreToCase} deriving (Show, Eq, Bounded) #}
{# enum ClutterShaderError as ShaderError {underscoreToCase} deriving (Show, Eq) #}
{# enum ClutterPathNodeType as PathNodeType {underscoreToCase} deriving (Show, Eq) #}
{# enum ClutterUnitType as UnitType {underscoreToCase} deriving (Show, Eq) #}
{# enum ClutterInputDeviceType as InputDeviceType {underscoreToCase} deriving (Show, Eq) #}
{# enum ClutterScriptError as ScriptError {underscoreToCase} deriving (Show, Eq) #}
{# enum ClutterFontFlags as FontFlags {underscoreToCase} deriving (Show, Eq, Bounded) #}
instance Flags EventFlags
instance Flags ActorFlags
instance Flags TextureFlags
instance Flags AllocationFlags
instance Flags FontFlags
type GID = Word32
type Timestamp = Word
type DeviceID = Int
--CHECKME: I'm not sure how to deal with this opaque type
-- {# pointer *ClutterUnits as Units newtype #}
-- unUnits (Units ptr) = ptr
-- *** Color
{# pointer *ClutterColor as ColorPtr -> Color #}
data Color = Color { red :: Word8,
green :: Word8,
blue :: Word8,
alpha :: Word8
} deriving (Eq, Show)
instance Storable Color where
sizeOf _ = {# sizeof ClutterColor #}
alignment _ = alignment (undefined :: Word8)
peek p = do
red <- {# get ClutterColor->red #} p
blue <- {# get ClutterColor->blue #} p
green <- {# get ClutterColor->green #} p
alpha <- {# get ClutterColor->alpha #} p
return $ Color (cIntConv red) (cIntConv green) (cIntConv blue) (cIntConv alpha)
poke p (Color r g b a) = do
{# set ClutterColor->red #} p (cIntConv r) --FIXME: cIntConv is wrong?
{# set ClutterColor->green #} p (cIntConv g)
{# set ClutterColor->blue #} p (cIntConv b)
{# set ClutterColor->alpha #} p (cIntConv a)
--This seems not right. But it seems to work.
mkColor :: Color -> IO ColorPtr
mkColor col = do cptr <- (malloc :: IO ColorPtr)
poke cptr col
return cptr
withColor :: Color -> (ColorPtr -> IO a) -> IO a
withColor col = bracket (mkColor col) free
-- *** Actor
{# pointer *ClutterActor as Actor foreign newtype #}
class GObjectClass o => ActorClass o
toActor::ActorClass o => o -> Actor
toActor = unsafeCastGObject . toGObject
withActorClass::ActorClass o => o -> (Ptr Actor -> IO b) -> IO b
withActorClass o = (withActor . toActor) o
newActor :: (ActorClass actor) => Ptr actor -> IO Actor
newActor a = makeNewActor (Actor, objectUnref) $ return (castPtr a)
--TODO: this should also go somewhere else??
--CHECKME: Does this actually work?
newActorList :: GSList -> IO [Actor]
newActorList gsl = (fromGSList gsl :: IO [Ptr Actor]) >>= mapM newActor
instance ActorClass Actor
instance ScriptableClass Actor
instance GObjectClass Actor where
toGObject (Actor a) = constrGObject (castForeignPtr a)
unsafeCastGObject (GObject o) = Actor (castForeignPtr o)
-- *** Rectangle
{# pointer *ClutterRectangle as Rectangle foreign newtype #}
class GObjectClass o => RectangleClass o
toRectangle::RectangleClass o => o -> Rectangle
toRectangle = unsafeCastGObject . toGObject
newRectangle :: Ptr Actor -> IO Rectangle
newRectangle a = makeNewActor (Rectangle, objectUnref) $ return (castPtr a)
instance RectangleClass Rectangle
instance ActorClass Rectangle
instance GObjectClass Rectangle where
toGObject (Rectangle r) = constrGObject (castForeignPtr r)
unsafeCastGObject (GObject o) = Rectangle (castForeignPtr o)
-- *** Text
{# pointer *ClutterText as Text foreign newtype #}
class GObjectClass o => TextClass o
toText::TextClass o => o -> Text
toText = unsafeCastGObject . toGObject
newText :: Ptr Actor -> IO Text
newText a = makeNewActor (Text, objectUnref) $ return (castPtr a)
withTextClass::TextClass o => o -> (Ptr Text -> IO b) -> IO b
withTextClass o = (withText . toText) o
instance TextClass Text
instance ActorClass Text
instance ScriptableClass Text
instance GObjectClass Text where
toGObject (Text a) = constrGObject (castForeignPtr a)
unsafeCastGObject (GObject o) = Text (castForeignPtr o)
-- *** Group
{#pointer *ClutterGroup as Group foreign newtype #}
class ActorClass o => GroupClass o
toGroup :: GroupClass o => o -> Group
toGroup = unsafeCastGObject . toGObject
newGroup :: Ptr Actor -> IO Group
newGroup a = makeNewActor (Group, objectUnref) $ return (castPtr a)
instance GroupClass Group
instance ScriptableClass Group
instance ContainerClass Group
instance ActorClass Group
instance GObjectClass Group where
toGObject (Group g) = constrGObject (castForeignPtr g)
unsafeCastGObject (GObject o) = Group (castForeignPtr o)
-- *** Container
{# pointer *ClutterContainer as Container foreign newtype #}
class GObjectClass o => ContainerClass o
toContainer :: ContainerClass o => o -> Container
toContainer = unsafeCastGObject . toGObject
withContainerClass::ContainerClass o => o -> (Ptr Container -> IO b) -> IO b
withContainerClass o = (withContainer . toContainer) o
instance ContainerClass Container
instance GObjectClass Container where
toGObject (Container c) = constrGObject (castForeignPtr c)
unsafeCastGObject (GObject o) = Container (castForeignPtr o)
-- *** Stage
{# pointer *ClutterStage as Stage foreign newtype #}
class GroupClass o => StageClass o
toStage :: StageClass o => o -> Stage
toStage = unsafeCastGObject . toGObject
withStageClass::StageClass o => o -> (Ptr Stage -> IO b) -> IO b
withStageClass o = (withStage . toStage) o
--Actor class?
newStage :: (ActorClass actor) => Ptr actor -> IO Stage
newStage a = makeNewActor (Stage, objectUnref) $ return (castPtr a)
instance StageClass Stage
instance ContainerClass Stage
instance GroupClass Stage
instance ActorClass Stage
instance ScriptableClass Stage
instance GObjectClass Stage where
toGObject (Stage s) = constrGObject (castForeignPtr s)
unsafeCastGObject (GObject o) = Stage (castForeignPtr o)
-- *** Perspective
data Perspective = Perspective {
perspectiveFovy :: !Float,
perspectiveAspect :: !Float,
perspectiveZNear :: !Float,
perspectiveZFar :: !Float
} deriving (Show, Eq)
{# pointer *ClutterPerspective as PerspectivePtr -> Perspective #}
instance Storable Perspective where
sizeOf _ = {# sizeof ClutterPerspective #}
alignment _ = alignment (undefined :: CFloat)
peek p = do
fovy <- {# get ClutterPerspective->fovy #} p
aspect <- {# get ClutterPerspective->aspect #} p
z_near <- {# get ClutterPerspective->z_near #} p
z_far <- {# get ClutterPerspective->z_far #} p
return $ Perspective (cFloatConv fovy) (cFloatConv aspect) (cFloatConv z_near) (cFloatConv z_far)
poke p (Perspective fovy aspect z_near z_far) = do
{# set ClutterPerspective->fovy #} p (cFloatConv fovy)
{# set ClutterPerspective->aspect #} p (cFloatConv aspect)
{# set ClutterPerspective->z_near #} p (cFloatConv z_near)
{# set ClutterPerspective->z_far #} p (cFloatConv z_far)
--This seems not right. But it seems to work.
mkPerspective :: Perspective -> IO PerspectivePtr
mkPerspective pst = do pptr <- (malloc :: IO PerspectivePtr)
poke pptr pst
return pptr
withPerspective :: Perspective -> (PerspectivePtr -> IO a) -> IO a
withPerspective pst = bracket (mkPerspective pst) free
-- *** ClutterEvent
{# pointer *ClutterEvent as Event foreign newtype #}
-- *** Animation
{# pointer *ClutterAnimation as AnimationRaw foreign newtype #}
data Animation a = Animation a AnimationRaw
withAnimation (Animation _ raw) = withAnimationRaw raw
--CHECKME: does animationraw class make sense to have?
class GObjectClass o => AnimationRawClass o
toAnimation :: AnimationRawClass o => o -> AnimationRaw
toAnimation = unsafeCastGObject . toGObject
mkAnimation :: a -> AnimationRaw -> Animation a
mkAnimation _ raw = Animation (undefined :: a) raw
--CHECKME: Do I actually need this and does it break things?
getAnimationRaw :: Animation a -> AnimationRaw
getAnimationRaw (Animation _ raw) = raw
newAnimationRaw:: Ptr AnimationRaw -> IO AnimationRaw
newAnimationRaw a = makeNewGObject (AnimationRaw, objectUnref) $ return (castPtr a)
instance AnimationRawClass AnimationRaw
instance GObjectClass AnimationRaw where
toGObject (AnimationRaw a) = constrGObject (castForeignPtr a)
unsafeCastGObject (GObject o) = AnimationRaw (castForeignPtr o)
--CHECKME:
instance (GObjectClass a) => GObjectClass (Animation a) where
toGObject (Animation _ (AnimationRaw p)) = constrGObject (castForeignPtr p)
unsafeCastGObject (GObject o) = Animation (undefined :: a) (AnimationRaw (castForeignPtr o))
-- *** Timeline
--FIXME: DO animations and timelines etc. have floating references or not?
--They don't derive from actor, so I'm going to go with no
{# pointer *ClutterTimeline as Timeline foreign newtype #}
class GObjectClass o => TimelineClass o
toTimeline :: TimelineClass o => o -> Timeline
toTimeline = unsafeCastGObject . toGObject
newTimeline:: Ptr Timeline -> IO Timeline
newTimeline a = makeNewGObject (Timeline, objectUnref) $ return a
newTimelineList :: GSList -> IO [Timeline]
newTimelineList gsl = (fromGSList gsl :: IO [Ptr Timeline]) >>= mapM newTimeline
instance TimelineClass Timeline
instance GObjectClass Timeline where
toGObject (Timeline t) = constrGObject (castForeignPtr t)
unsafeCastGObject (GObject o) = Timeline (castForeignPtr o)
-- *** Score
{# pointer *ClutterScore as Score foreign newtype #}
class GObjectClass o => ScoreClass o
toScore::ScoreClass o => o -> Score
toScore = unsafeCastGObject . toGObject
--CHECKME: doesn't derive from Actor, so using makeNewGObject
newScore :: Ptr Score -> IO Score
newScore a = makeNewGObject (Score, objectUnref) $ return (castPtr a)
instance ScoreClass Score
instance GObjectClass Score where
toGObject (Score r) = constrGObject (castForeignPtr r)
unsafeCastGObject (GObject o) = Score (castForeignPtr o)
-- *** Alpha
{# pointer *ClutterAlpha as Alpha foreign newtype #}
class GObjectClass o => AlphaClass o
toAlpha :: AlphaClass o => o -> Alpha
toAlpha = unsafeCastGObject . toGObject
newAlpha:: Ptr Alpha -> IO Alpha
newAlpha a = makeNewGObject (Alpha, objectUnref) $ return a
instance AlphaClass Alpha
instance GObjectClass Alpha where
toGObject (Alpha a) = constrGObject (castForeignPtr a)
unsafeCastGObject (GObject o) = Alpha (castForeignPtr o)
-- *** AlphaFunc
type AlphaFunc = Alpha -> IO Double
type CAlphaFunc = FunPtr (Ptr Alpha -> Ptr () -> IO CDouble)
newAlphaFunc :: AlphaFunc -> IO CAlphaFunc
newAlphaFunc userfunc = mkAlphaFunc (newAlphaFunc' userfunc)
where
newAlphaFunc' :: (Alpha -> IO Double) -> Ptr Alpha -> IO Double
newAlphaFunc' userfunc aptr = newAlpha aptr >>= userfunc
foreign import ccall "wrapper"
mkAlphaFunc :: (Ptr Alpha -> IO Double) -> IO CAlphaFunc
-- *** Interval
{# pointer *ClutterInterval as IntervalRaw foreign newtype #}
-- Track the type of the interval with the 1st field
data Interval a = Interval a IntervalRaw
mkInterval :: a -> IntervalRaw -> Interval a
mkInterval _ raw = Interval (undefined :: a) raw
withInterval (Interval _ raw) = withIntervalRaw raw
newIntervalRaw a = makeNewGObject (IntervalRaw, objectUnref) $ return (castPtr a)
instance GObjectClass IntervalRaw where
toGObject (IntervalRaw i) = constrGObject (castForeignPtr i)
unsafeCastGObject (GObject o) = IntervalRaw (castForeignPtr o)
-- *** Fog
{# pointer *ClutterFog as FogPtr -> Fog #}
data Fog = Fog { z_near :: Float,
z_far :: Float
} deriving (Eq, Show)
instance Storable Fog where
sizeOf _ = {# sizeof ClutterFog #}
alignment _ = alignment (undefined :: Float)
peek p = do
znear <- {# get ClutterFog->z_near #} p
zfar <- {# get ClutterFog->z_far #} p
return $ Fog (cFloatConv znear) (cFloatConv zfar)
poke p (Fog zn zf) = do
{# set ClutterFog->z_near #} p (cFloatConv zn)
{# set ClutterFog->z_far #} p (cFloatConv zf)
--This seems not right. But it seems to work.
mkFog :: Fog -> IO FogPtr
mkFog col = do cptr <- (malloc :: IO FogPtr)
poke cptr col
return cptr
withFog :: Fog -> (FogPtr -> IO a) -> IO a
withFog col = bracket (mkFog col) free
-- *** CairoTexture
{# pointer *ClutterCairoTexture as CairoTexture foreign newtype #}
class GObjectClass o => CairoTextureClass o
toCairoTexture :: CairoTextureClass o => o -> CairoTexture
toCairoTexture = unsafeCastGObject . toGObject
newCairoTexture a = makeNewGObject (CairoTexture, objectUnref) $ return (castPtr a)
instance CairoTextureClass CairoTexture
instance GObjectClass CairoTexture where
toGObject (CairoTexture i) = constrGObject (castForeignPtr i)
unsafeCastGObject (GObject o) = CairoTexture (castForeignPtr o)
-- *** Media
{# pointer *ClutterMedia as Media foreign newtype #}
withMediaClass::MediaClass o => o -> (Ptr Media -> IO b) -> IO b
withMediaClass o = (withMedia . toMedia) o
class GObjectClass o => MediaClass o
toMedia :: MediaClass o => o -> Media
toMedia = unsafeCastGObject . toGObject
newMedia a = makeNewGObject (Media, objectUnref) $ return (castPtr a)
instance MediaClass Media
instance GObjectClass Media where
toGObject (Media i) = constrGObject (castForeignPtr i)
unsafeCastGObject (GObject o) = Media (castForeignPtr o)
-- *** ChildMeta
{# pointer *ClutterChildMeta as ChildMeta foreign newtype #}
class GObjectClass o => ChildMetaClass o
toChildMeta :: ChildMetaClass o => o -> Media
toChildMeta = unsafeCastGObject . toGObject
newChildMeta a = makeNewGObject (ChildMeta, objectUnref) $ return (castPtr a)
instance ChildMetaClass ChildMeta
instance GObjectClass ChildMeta where
toGObject (ChildMeta i) = constrGObject (castForeignPtr i)
unsafeCastGObject (GObject o) = ChildMeta (castForeignPtr o)
-- *** Clone
{# pointer *ClutterClone as CloneRaw foreign newtype #}
data Clone a = Clone a CloneRaw
newCloneRaw a = makeNewActor (CloneRaw, objectUnref) $ return (castPtr a)
mkClone :: (ActorClass a) => a -> CloneRaw -> Clone a
mkClone _ raw = Clone (undefined :: a) raw
withClone (Clone _ raw) = withCloneRaw raw
class GObjectClass o => CloneRawClass o
toCloneRaw :: CloneRawClass o => o -> CloneRaw
toCloneRaw = unsafeCastGObject . toGObject
instance (ActorClass a) => ScriptableClass (Clone a)
instance (ActorClass a) => ActorClass (Clone a)
instance (ActorClass a) => GObjectClass (Clone a) where
toGObject (Clone _ (CloneRaw i)) = constrGObject (castForeignPtr i)
unsafeCastGObject (GObject o) = Clone (undefined::a) (CloneRaw (castForeignPtr o))
instance GObjectClass CloneRaw where
toGObject (CloneRaw i) = constrGObject (castForeignPtr i)
unsafeCastGObject (GObject o) = CloneRaw (castForeignPtr o)
-- *** Behaviour
{# pointer *ClutterBehaviour as Behaviour foreign newtype #}
class GObjectClass o => BehaviourClass o
toBehaviour :: BehaviourClass o => o -> Behaviour
toBehaviour = unsafeCastGObject . toGObject
withBehaviourClass::BehaviourClass o => o -> (Ptr Behaviour -> IO b) -> IO b
withBehaviourClass o = (withBehaviour . toBehaviour) o
newBehaviour a = makeNewGObject (Behaviour, objectUnref) $ return (castPtr a)
instance BehaviourClass Behaviour
instance ScriptableClass Behaviour
instance GObjectClass Behaviour where
toGObject (Behaviour i) = constrGObject (castForeignPtr i)
unsafeCastGObject (GObject o) = Behaviour (castForeignPtr o)
-- *** BehaviourForeachFunc
type BehaviourForeachFunc = Behaviour -> Actor -> IO ()
type CBehaviourForeachFunc = FunPtr (Ptr Behaviour -> Ptr Actor -> Ptr () -> IO ())
newBehaviourForeachFunc :: BehaviourForeachFunc -> IO CBehaviourForeachFunc
newBehaviourForeachFunc userfunc = mkBehaviourForeachFunc (newBehaviourForeachFunc' userfunc)
where
newBehaviourForeachFunc' :: BehaviourForeachFunc -> Ptr Behaviour -> Ptr Actor -> IO ()
newBehaviourForeachFunc' userfunc bptr aptr = newBehaviour bptr >>= \behave ->
newActor aptr >>= \actor ->
userfunc behave actor
foreign import ccall "wrapper"
mkBehaviourForeachFunc :: (Ptr Behaviour -> Ptr Actor -> IO ()) -> IO CBehaviourForeachFunc
-- *** BehaviourScale
{# pointer *ClutterBehaviourScale as BehaviourScale foreign newtype #}
class GObjectClass o => BehaviourScaleClass o
toBehaviourScale :: BehaviourScaleClass o => o -> Behaviour
toBehaviourScale = unsafeCastGObject . toGObject
newBehaviourScale a = makeNewGObject (BehaviourScale, objectUnref) $ return (castPtr a)
instance BehaviourScaleClass BehaviourScale
instance BehaviourClass BehaviourScale
instance ScriptableClass BehaviourScale
instance GObjectClass BehaviourScale where
toGObject (BehaviourScale i) = constrGObject (castForeignPtr i)
unsafeCastGObject (GObject o) = BehaviourScale (castForeignPtr o)
-- *** BehaviourDepth
{# pointer *ClutterBehaviourDepth as BehaviourDepth foreign newtype #}
class GObjectClass o => BehaviourDepthClass o
toBehaviourDepth :: BehaviourDepthClass o => o -> BehaviourDepth
toBehaviourDepth = unsafeCastGObject . toGObject
newBehaviourDepth a = makeNewGObject (BehaviourDepth, objectUnref) $ return (castPtr a)
instance BehaviourDepthClass BehaviourDepth
instance BehaviourClass BehaviourDepth
instance ScriptableClass BehaviourDepth
instance GObjectClass BehaviourDepth where
toGObject (BehaviourDepth i) = constrGObject (castForeignPtr i)
unsafeCastGObject (GObject o) = BehaviourDepth (castForeignPtr o)
-- *** BehaviourEllipse
{# pointer *ClutterBehaviourEllipse as BehaviourEllipse foreign newtype #}
class GObjectClass o => BehaviourEllipseClass o
toBehaviourEllipse :: BehaviourEllipseClass o => o -> BehaviourEllipse
toBehaviourEllipse = unsafeCastGObject . toGObject
newBehaviourEllipse a = makeNewGObject (BehaviourEllipse, objectUnref) $ return (castPtr a)
instance BehaviourEllipseClass BehaviourEllipse
instance BehaviourClass BehaviourEllipse
instance ScriptableClass BehaviourEllipse
instance GObjectClass BehaviourEllipse where
toGObject (BehaviourEllipse i) = constrGObject (castForeignPtr i)
unsafeCastGObject (GObject o) = BehaviourEllipse (castForeignPtr o)
-- *** BehaviourOpacity
{# pointer *ClutterBehaviourOpacity as BehaviourOpacity foreign newtype #}
class GObjectClass o => BehaviourOpacityClass o
toBehaviourOpacity :: BehaviourOpacityClass o => o -> BehaviourOpacity
toBehaviourOpacity = unsafeCastGObject . toGObject
newBehaviourOpacity a = makeNewGObject (BehaviourOpacity, objectUnref) $ return (castPtr a)
instance BehaviourOpacityClass BehaviourOpacity
instance BehaviourClass BehaviourOpacity
instance ScriptableClass BehaviourOpacity
instance GObjectClass BehaviourOpacity where
toGObject (BehaviourOpacity i) = constrGObject (castForeignPtr i)
unsafeCastGObject (GObject o) = BehaviourOpacity (castForeignPtr o)
-- *** BehaviourRotate
{# pointer *ClutterBehaviourRotate as BehaviourRotate foreign newtype #}
class GObjectClass o => BehaviourRotateClass o
toBehaviourRotate :: BehaviourRotateClass o => o -> BehaviourRotate
toBehaviourRotate = unsafeCastGObject . toGObject
newBehaviourRotate a = makeNewGObject (BehaviourRotate, objectUnref) $ return (castPtr a)
instance BehaviourRotateClass BehaviourRotate
instance BehaviourClass BehaviourRotate
instance ScriptableClass BehaviourRotate
instance GObjectClass BehaviourRotate where
toGObject (BehaviourRotate i) = constrGObject (castForeignPtr i)
unsafeCastGObject (GObject o) = BehaviourRotate (castForeignPtr o)
-- *** BehaviourPath
{# pointer *ClutterBehaviourPath as BehaviourPath foreign newtype #}
class GObjectClass o => BehaviourPathClass o
toBehaviourPath :: BehaviourPathClass o => o -> BehaviourPath
toBehaviourPath = unsafeCastGObject . toGObject
newBehaviourPath a = makeNewGObject (BehaviourPath, objectUnref) $ return (castPtr a)
instance BehaviourPathClass BehaviourPath
instance BehaviourClass BehaviourPath
instance ScriptableClass BehaviourPath
instance GObjectClass BehaviourPath where
toGObject (BehaviourPath i) = constrGObject (castForeignPtr i)
unsafeCastGObject (GObject o) = BehaviourPath (castForeignPtr o)
-- *** Path
{# pointer *ClutterPath as Path foreign newtype #}
class GObjectClass o => PathClass o
toPath :: PathClass o => o -> Path
toPath = unsafeCastGObject . toGObject
--CHECKME: Path has a floating reference, but I don't remember
-- which one you use and I'm really lazy so I'm not going to check now
newPath a = makeNewActor (Path, objectUnref) $ return (castPtr a)
instance PathClass Path
instance GObjectClass Path where
toGObject (Path i) = constrGObject (castForeignPtr i)
unsafeCastGObject (GObject o) = Path (castForeignPtr o)
-- *** Texture
{# pointer *ClutterTexture as Texture foreign newtype #}
class GObjectClass o => TextureClass o
toTexture :: TextureClass o => o -> Texture
toTexture = unsafeCastGObject . toGObject
newTexture :: Ptr Actor -> IO Texture
newTexture a = makeNewActor (Texture, objectUnref) $ return (castPtr a)
withTextureClass :: TextureClass o => o -> (Ptr Texture -> IO b) -> IO b
withTextureClass o = (withTexture . toTexture) o
instance TextureClass Texture
instance ActorClass Texture
instance ScriptableClass Texture
instance GObjectClass Texture where
toGObject (Texture i) = constrGObject (castForeignPtr i)
unsafeCastGObject (GObject o) = Texture (castForeignPtr o)
-- *** Shader
{# pointer *ClutterShader as Shader foreign newtype #}
class GObjectClass o => ShaderClass o
toShader :: ShaderClass o => o -> Shader
toShader = unsafeCastGObject . toGObject
newShader a = makeNewGObject (Shader, objectUnref) $ return (castPtr a)
instance ShaderClass Shader
instance GObjectClass Shader where
toGObject (Shader i) = constrGObject (castForeignPtr i)
unsafeCastGObject (GObject o) = Shader (castForeignPtr o)
-- *** Model
{# pointer *ClutterModel as Model foreign newtype #}
class GObjectClass o => ModelClass o
toModel :: ModelClass o => o -> Model
toModel = unsafeCastGObject . toGObject
withModelClass::ModelClass o => o -> (Ptr Model -> IO b) -> IO b
withModelClass o = (withModel . toModel) o
newModel a = makeNewGObject (Model, objectUnref) $ return (castPtr a)
instance ModelClass Model
instance GObjectClass Model where
toGObject (Model i) = constrGObject (castForeignPtr i)
unsafeCastGObject (GObject o) = Model (castForeignPtr o)
-- *** ListModel
{# pointer *ClutterListModel as ListModel foreign newtype #}
class GObjectClass o => ListModelClass o
toListModel :: ListModelClass o => o -> ListModel
toListModel = unsafeCastGObject . toGObject
newListModel a = makeNewGObject (ListModel, objectUnref) $ return (castPtr a)
instance ModelClass ListModel
instance ListModelClass ListModel
instance GObjectClass ListModel where
toGObject (ListModel i) = constrGObject (castForeignPtr i)
unsafeCastGObject (GObject o) = ListModel (castForeignPtr o)
-- *** ModelIter
{# pointer *ClutterModelIter as ModelIter foreign newtype #}
class GObjectClass o => ModelIterClass o
toModelIter :: ModelIterClass o => o -> ModelIter
toModelIter = unsafeCastGObject . toGObject
newModelIter a = makeNewGObject (ModelIter, objectUnref) $ return (castPtr a)
instance ModelIterClass ModelIter
instance GObjectClass ModelIter where
toGObject (ModelIter i) = constrGObject (castForeignPtr i)
unsafeCastGObject (GObject o) = ModelIter (castForeignPtr o)
-- *** Script
{# pointer *ClutterScript as Script foreign newtype #}
class GObjectClass o => ScriptClass o
toScript :: ScriptClass o => o -> Script
toScript = unsafeCastGObject . toGObject
withScriptClass::ScriptClass o => o -> (Ptr Script -> IO b) -> IO b
withScriptClass o = (withScript . toScript) o
newScript a = makeNewActor (Script, objectUnref) $ return (castPtr a)
instance ScriptClass Script
instance ActorClass Script
instance GObjectClass Script where
toGObject (Script i) = constrGObject (castForeignPtr i)
unsafeCastGObject (GObject o) = Script (castForeignPtr o)
-- *** Knot
type Knot = (Int, Int)
--TypeSynonymInstance
instance Storable Knot where
sizeOf _ = {# sizeof ClutterKnot #}
alignment _ = alignment (undefined :: Int)
peek p = do
x <- {# get ClutterKnot->x #} p
y <- {# get ClutterKnot->y #} p
return (cIntConv x, cIntConv y)
poke p (x,y) = do
{# set ClutterKnot->x #} p (cIntConv x)
{# set ClutterKnot->y #} p (cIntConv y)
-- *** PathNode
{# pointer *ClutterPathNode as PathNodePtr -> PathNode #}
data PathNode = PathNode { pathNodeType :: !PathNodeType,
pathNodePoints :: !(Knot, Knot, Knot)
} deriving (Eq, Show)
instance Storable PathNode where
sizeOf _ = {# sizeof ClutterPathNode #}
alignment _ = alignment (undefined :: Word8)
peek p = do
tp <- {# get ClutterPathNode->type #} p
[p3, p2, p1] <- peekArray 3 (plusPtr p {# sizeof ClutterPathNodeType #})
--peekArray gets out backwards
return $ PathNode (cToEnum tp) (p1, p2, p3)
poke p (PathNode tp (p1, p2, p3)) = do
{# set ClutterPathNode->type #} p (cFromEnum tp)
pokeArray (plusPtr p {# sizeof ClutterPathNodeType #}) [p1, p2, p3]
--This seems not right. But it seems to work.
mkPathNode :: PathNode -> IO PathNodePtr
mkPathNode col = do cptr <- (malloc :: IO PathNodePtr)
poke cptr col
return cptr
withPathNode :: PathNode -> (PathNodePtr -> IO a) -> IO a
withPathNode col = bracket (mkPathNode col) free
newPathNodes :: GSList -> IO [PathNode]
newPathNodes gsl = (fromGSList gsl :: IO [PathNodePtr]) >>= mapM peek
-- *** PathCallback
type PathCallback = PathNode -> IO ()
type CPathCallback = FunPtr (PathNodePtr -> Ptr () -> IO ())
newPathCallback :: PathCallback -> IO CPathCallback
newPathCallback userfunc = mkPathCallback (newPathCallback' userfunc)
where
newPathCallback' :: PathCallback -> PathNodePtr -> IO ()
newPathCallback' userfunc pnPtr = peek pnPtr >>= userfunc
foreign import ccall "wrapper"
mkPathCallback :: (PathNodePtr -> IO ()) -> IO CPathCallback
-- *** ParamSpecUnits
{# pointer *ClutterParamSpecUnits as ParamSpecUnitsPtr -> ParamSpecUnits #}
--TODO: Prefix the names of the fields of this
data ParamSpecUnits = ParamSpecUnits { defaultType :: !UnitType,
defaultValue :: !Float,
minimum :: !Float,
maximum :: !Float
} deriving (Eq, Show)
--FIXME: Type for alignment
instance Storable ParamSpecUnits where
sizeOf _ = {# sizeof ClutterParamSpecUnits #}
alignment _ = alignment (undefined :: Word64)
peek p = do
dt <- {# get ClutterParamSpecUnits->default_type #} p
dval <- {# get ClutterParamSpecUnits->default_value #} p
min <- {# get ClutterParamSpecUnits->minimum #} p
max <- {# get ClutterParamSpecUnits->maximum #} p
return $ ParamSpecUnits (cToEnum dt) (cFloatConv dval) (cFloatConv min) (cFloatConv max)
poke p (ParamSpecUnits dt dval min max) = do
{# set ClutterParamSpecUnits->default_type #} p (cFromEnum dt)
{# set ClutterParamSpecUnits->default_value #} p (cFloatConv dval)
{# set ClutterParamSpecUnits->minimum #} p (cFloatConv min)
{# set ClutterParamSpecUnits->maximum #} p (cFloatConv max)
--This seems not right. But it seems to work.
mkParamSpecUnits :: ParamSpecUnits -> IO ParamSpecUnitsPtr
mkParamSpecUnits col = do cptr <- (malloc :: IO ParamSpecUnitsPtr)
poke cptr col
return cptr
withParamSpecUnits :: ParamSpecUnits -> (ParamSpecUnitsPtr -> IO a) -> IO a
withParamSpecUnits col = bracket (mkParamSpecUnits col) free
newParamSpecUnits :: GSList -> IO [ParamSpecUnits]
newParamSpecUnits gsl = (fromGSList gsl :: IO [ParamSpecUnitsPtr]) >>= mapM peek
-- *** Scriptable
{# pointer *ClutterScriptable as Scriptable foreign newtype #}
class GObjectClass o => ScriptableClass o
toScriptable :: ScriptableClass o => o -> Scriptable
toScriptable = unsafeCastGObject . toGObject
withScriptableClass::ScriptableClass o => o -> (Ptr Scriptable -> IO b) -> IO b
withScriptableClass o = (withScriptable . toScriptable) o
instance ScriptableClass Scriptable
instance GObjectClass Scriptable where
toGObject (Scriptable i) = constrGObject (castForeignPtr i)
unsafeCastGObject (GObject o) = Scriptable (castForeignPtr o)
-- *** BindingPool
{# pointer *ClutterBindingPool as BindingPool foreign newtype #}
class GObjectClass o => BindingPoolClass o
toBindingPool :: BindingPoolClass o => o -> BindingPool
toBindingPool = unsafeCastGObject . toGObject
newBindingPool a = makeNewGObject (BindingPool, objectUnref) $ return (castPtr a)
instance BindingPoolClass BindingPool
instance GObjectClass BindingPool where
toGObject (BindingPool i) = constrGObject (castForeignPtr i)
unsafeCastGObject (GObject o) = BindingPool (castForeignPtr o)
-- *** GCallback
type GCallback = IO ()
type CGCallback = FunPtr (IO ())
foreign import ccall "wrapper"
newGCallback :: IO () -> IO CGCallback
-- *** Geometry
data Geometry = Geometry {
geometryX :: !Int,
geometryY :: !Int,
geometryWidth :: !Word,
geometryHeight :: !Word
} deriving (Show, Eq)
{# pointer *ClutterGeometry as GeometryPtr -> Geometry #}
instance Storable Geometry where
sizeOf _ = {# sizeof ClutterGeometry #}
alignment _ = alignment (undefined :: Int)
peek p = do
x <- {# get ClutterGeometry->x #} p
y <- {# get ClutterGeometry->y #} p
width <- {# get ClutterGeometry->width #} p
height <- {# get ClutterGeometry->height #} p
return $ Geometry (cIntConv x) (cIntConv y) (cIntConv width) (cIntConv height)
poke p (Geometry x y width height) = do
{# set ClutterGeometry->x #} p (cIntConv x)
{# set ClutterGeometry->y #} p (cIntConv y)
{# set ClutterGeometry->width #} p (cIntConv width)
{# set ClutterGeometry->height #} p (cIntConv height)
mkGeometry :: Geometry -> IO GeometryPtr
mkGeometry pst = do pptr <- (malloc :: IO GeometryPtr)
poke pptr pst
return pptr
withGeometry :: Geometry -> (GeometryPtr -> IO a) -> IO a
withGeometry pst = bracket (mkGeometry pst) free
-- *** Vertex
data Vertex = Vertex {
vertexX :: !Float,
vertexY :: !Float,
vertexZ :: !Float
} deriving (Show, Eq)
{# pointer *ClutterVertex as VertexPtr -> Vertex #}
instance Storable Vertex where
sizeOf _ = {# sizeof ClutterVertex #}
alignment _ = alignment (undefined :: Float)
peek p = do
x <- {# get ClutterVertex->x #} p
y <- {# get ClutterVertex->y #} p
z <- {# get ClutterVertex->z #} p
return $ Vertex (cFloatConv x) (cFloatConv y) (cFloatConv z)
poke p (Vertex x y z) = do
{# set ClutterVertex->x #} p (cFloatConv x)
{# set ClutterVertex->y #} p (cFloatConv y)
{# set ClutterVertex->z #} p (cFloatConv z)
mkVertex :: Vertex -> IO VertexPtr
mkVertex pst = do pptr <- (malloc :: IO VertexPtr)
poke pptr pst
return pptr
withVertex :: Vertex -> (VertexPtr -> IO a) -> IO a
withVertex pst = bracket (mkVertex pst) free
-- *** ActorBox
data ActorBox = ActorBox {
actorBoxX1 :: !Float,
actorBoxY1 :: !Float,
actorBoxX2 :: !Float,
actorBoxY2 :: !Float
} deriving (Show, Eq)
{# pointer *ClutterActorBox as ActorBoxPtr -> ActorBox #}
instance Storable ActorBox where
sizeOf _ = {# sizeof ClutterActorBox #}
alignment _ = alignment (undefined :: Float)
peek p = do
x1 <- {# get ClutterActorBox->x1 #} p
y1 <- {# get ClutterActorBox->y1 #} p
x2 <- {# get ClutterActorBox->x2 #} p
y2 <- {# get ClutterActorBox->y2 #} p
return $ ActorBox (cFloatConv x1) (cFloatConv y1) (cFloatConv x2) (cFloatConv y2)
poke p (ActorBox x1 y1 x2 y2) = do
{# set ClutterActorBox->x1 #} p (cFloatConv x1)
{# set ClutterActorBox->y1 #} p (cFloatConv y1)
{# set ClutterActorBox->x2 #} p (cFloatConv x2)
{# set ClutterActorBox->y2 #} p (cFloatConv y2)
--This seems not right. But it seems to work.
mkActorBox :: ActorBox -> IO ActorBoxPtr
mkActorBox pst = do pptr <- (malloc :: IO ActorBoxPtr)
poke pptr pst
return pptr
withActorBox :: ActorBox -> (ActorBoxPtr -> IO a) -> IO a
withActorBox pst = bracket (mkActorBox pst) free
-- *** Animatable
{# pointer *ClutterAnimatable as Animatable foreign newtype #}
class GObjectClass o => AnimatableClass o
toAnimatable::AnimatableClass o => o -> Animatable
toAnimatable = unsafeCastGObject . toGObject
withAnimatableClass::AnimatableClass o => o -> (Ptr Animatable -> IO b) -> IO b
withAnimatableClass o = (withAnimatable . toAnimatable) o
--CHECKME: makeNewActor or makeNewGObject? Is is always some kind of
--actor? does it always have a floating reference or what?
newAnimatable :: (AnimatableClass actor) => Ptr actor -> IO Animatable
newAnimatable a = makeNewGObject (Animatable, objectUnref) $ return (castPtr a)
instance AnimatableClass Animatable
instance GObjectClass Animatable where
toGObject (Animatable a) = constrGObject (castForeignPtr a)
unsafeCastGObject (GObject o) = Animatable (castForeignPtr o)
-- *** Callback
type Callback = Actor -> IO ()
type CCallback = FunPtr (Ptr Actor -> Ptr () -> IO ())
newCallback :: Callback -> IO CCallback
newCallback userfunc = mkCallback (newCallback' userfunc)
where
newCallback' :: (Actor -> IO ()) -> Ptr Actor -> IO ()
newCallback' userfunc aptr = newActor aptr >>= userfunc
foreign import ccall "wrapper"
mkCallback :: (Ptr Actor -> IO ()) -> IO CCallback
-- *** ModelForeachFunc
type ModelForeachFunc = Model -> ModelIter -> IO Bool
type CModelForeachFunc = FunPtr (Ptr Model -> Ptr ModelIter -> Ptr () -> IO CInt)
newModelForeachFunc :: ModelForeachFunc -> IO CModelForeachFunc
newModelForeachFunc userfunc = mkModelForeachFunc (newModelForeachFunc' userfunc)
where
newModelForeachFunc' :: ModelForeachFunc -> Ptr Model -> Ptr ModelIter -> IO Bool
newModelForeachFunc' userfunc modPtr miPtr = join $ liftM2 userfunc (newModel modPtr) (newModelIter miPtr)
foreign import ccall "wrapper"
mkModelForeachFunc :: (Ptr Model -> Ptr ModelIter -> IO Bool) -> IO CModelForeachFunc
-- *** TimeoutPool
{# pointer *ClutterTimeoutPool as TimeoutPool foreign newtype #}
-- *** RGBData
--FIXME/CHECKME: Not really sure best way to deal with this
--This is basically PixbufData without the pixbuf.
-- | An array that stored the raw pixel data in RGB Format.
--
data Ix i => RGBData i e = RGBData {-# UNPACK #-} !(ForeignPtr e)
!Bool
!(i,i)
{-# UNPACK #-} !Int
rgbDataHasAlpha :: (Storable e, Ix i) => RGBData i e -> Bool
rgbDataHasAlpha (RGBData _ hasA _ _) = hasA
--FIXME: Bad bad bad
rgbDataData (RGBData ptr _ _ _) = ptr
mkRGBData :: Storable e => ForeignPtr e -> Bool -> Int -> RGBData Int e
mkRGBData (ptr :: ForeignPtr e) hasA size =
RGBData ptr hasA (0, count) count
where count = fromIntegral (size `div` sizeOf (undefined :: e))
--CHECKME: Touching things?
-- | 'RGBData' is a mutable array.
instance Storable e => MArray RGBData e IO where
newArray (l,u) e = error "Clutter.Texture.RGBData.newArray: not implemented"
newArray_ (l,u) = error "Clutter.Texture.RGBData.newArray_: not implemented"
{-# INLINE unsafeRead #-}
unsafeRead (RGBData pixPtr _ _ _) idx = withForeignPtr pixPtr (flip peekElemOff idx)
{-# INLINE unsafeWrite #-}
unsafeWrite (RGBData pixPtr _ _ _) idx elem = withForeignPtr pixPtr (\p -> pokeElemOff p idx elem)
{-# INLINE getBounds #-}
getBounds (RGBData _ _ bd _) = return bd
{-# INLINE getNumElements #-}
getNumElements (RGBData _ _ _ count) = return count
-- Since some things have the same signal names, classes for them. Not
-- sure if I want to fix things this way Alternatively, rename things
-- to include the name such as timelineActivate and scoreActivate or
-- whatever
--
-- CHECKME: There are multiple
-- actors which have the "activate" signal. They all can't be exported
-- from the one Clutter module. I don't really want to require
-- qualified importing of the different modules and such
-- (e.g. Timeline and Score).
--
-- Also everything deals with the *Class, e.g. StageClass, however you
-- can't instance (StageClass stage) => Activatable stage without
-- undecidable instances which is bad, so I'm just doing instance
-- Activatable Stage. I think this would only be an issue if there was
-- a subclass of Stage (which doesn't exist as far as I know.) If
-- there were one to exist, there would have to be this instance for
-- it (which actually isn't much of a problem, just something to
-- remember if such a class existed). I don't think this is an issue,
-- but I don't know what I'm doing.
--FIXME: This is ugly and confusing, and haddock apparently can't
--document instances. Probably don't do this madness with Activatable
--Documentation for Text's activate
-- | The ::'activate' signal is emitted each time a Text actor is
-- 'activated' by the user, normally by pressing the 'Enter'
-- key. The signal is emitted only if "activatable" is set to
-- @True@.
--
-- | The ::'activate' signal is emitted when the stage receives key
-- focus from the underlying window system.
--
-- * Since 0.6
--
class Activatable a where
onActivate :: a -> IO () -> IO (ConnectId a)
afterActivate :: a -> IO () -> IO (ConnectId a)
activate :: Signal a (IO ())
-- | Class of things that have signals related to starting, pausing
-- etc.
--
class (GObjectClass a) => Playable a where
started :: Signal a (IO ())
onStarted :: a -> IO () -> IO (ConnectId a)
afterStarted :: a -> IO () -> IO (ConnectId a)
completed :: Signal a (IO ())
onCompleted :: a -> IO () -> IO (ConnectId a)
afterCompleted :: a -> IO () -> IO (ConnectId a)
paused :: Signal a (IO ())
onPaused :: a -> IO () -> IO (ConnectId a)
afterPaused :: a -> IO () -> IO (ConnectId a)