/* Clutter. * * Perl bindings for the OpenGL based 'interactive canvas' library. * * Clutter Authored By Matthew Allum * Perl bindings by Emmanuele Bassi * * Copyright (C) 2006 OpenedHand * * 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 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. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 59 Temple Place - Suite 330, * Boston, MA 02111-1307, USA. */ #include "clutterperl.h" /* * GInterface support */ #define GET_METHOD(obj, name) \ HV * stash = gperl_object_stash_from_type (G_OBJECT_TYPE (obj)); \ GV * slot = gv_fetchmethod (stash, name); #define METHOD_EXISTS (slot && GvCV (slot)) #define PREP(obj) \ dSP; \ ENTER; \ SAVETMPS; \ PUSHMARK (SP) ; \ PUSHs (sv_2mortal (newSVGObject (G_OBJECT (obj)))); #define CALL \ PUTBACK; \ call_sv ((SV *) GvCV (slot), G_VOID | G_DISCARD); #define FINISH \ FREETMPS; \ LEAVE; static void clutterperl_container_add (ClutterContainer *container, ClutterActor *actor) { GET_METHOD (container, "ADD"); if (METHOD_EXISTS) { PREP (container); XPUSHs (sv_2mortal (newSVClutterActor (actor))); CALL; FINISH; } } static void init_child_property_value (GObject *object, const gchar *name, GValue *value) { GParamSpec * pspec; pspec = clutter_container_class_find_child_property (G_OBJECT_GET_CLASS (object), name); if (!pspec) croak ("Child property %s not found in object class %s", name, G_OBJECT_TYPE_NAME (object)); g_value_init (value, G_PARAM_SPEC_VALUE_TYPE (pspec)); } typedef struct { ClutterCallback func; gpointer data; } ClutterPerlContainerForeachFunc; static void create_callback (ClutterCallback func, gpointer data, SV **code_return, SV **data_return) { HV *stash; gchar *sub; CV *dummy = NULL; SV *code, *my_data; ClutterPerlContainerForeachFunc *stuff; stash = gv_stashpv ("Clutter::Container::ForeachFunc", TRUE); sub = g_strdup_printf ("__clutterperl_container_foreach_func_%p", data); dummy = newCONSTSUB (stash, sub, NULL); g_free (sub); code = sv_bless (newRV_noinc ((SV *) dummy), stash); stuff = g_new0 (ClutterPerlContainerForeachFunc, 1); stuff->func = func; stuff->data = data; my_data = newSViv (PTR2IV (stuff)); sv_magic ((SV *) dummy, 0, PERL_MAGIC_ext, (const char *) my_data, 0); *code_return = code; *data_return = my_data; } static void clutterperl_container_remove (ClutterContainer *container, ClutterActor *actor) { GET_METHOD (container, "REMOVE"); if (METHOD_EXISTS) { PREP (container); XPUSHs (sv_2mortal (newSVClutterActor (actor))); CALL; FINISH; } } static void clutterperl_container_foreach (ClutterContainer *container, ClutterCallback callback, gpointer callback_data) { GET_METHOD (container, "FOREACH"); if (METHOD_EXISTS) { SV *code, *data; PREP (container); create_callback (callback, callback_data, &code, &data); XPUSHs (sv_2mortal (newSVsv (code))); XPUSHs (sv_2mortal (newSVsv (data))); CALL; FINISH; } } static void clutterperl_container_raise (ClutterContainer *container, ClutterActor *child, ClutterActor *sibling) { GET_METHOD (container, "RAISE"); if (METHOD_EXISTS) { PREP (container); XPUSHs (sv_2mortal (newSVClutterActor (child))); if (sibling) XPUSHs (sv_2mortal (newSVClutterActor (sibling))); CALL; FINISH; } } static void clutterperl_container_lower (ClutterContainer *container, ClutterActor *child, ClutterActor *sibling) { GET_METHOD (container, "LOWER"); if (METHOD_EXISTS) { PREP (container); XPUSHs (sv_2mortal (newSVClutterActor (child))); if (sibling) XPUSHs (sv_2mortal (newSVClutterActor (sibling))); CALL; FINISH; } } static void clutterperl_container_sort_depth_order (ClutterContainer *container) { GET_METHOD (container, "SORT_DEPTH_ORDER"); if (METHOD_EXISTS) { PREP (container); CALL; FINISH; } } static void clutterperl_container_create_child_meta (ClutterContainer *container, ClutterActor *child) { GET_METHOD (container, "CREATE_CHILD_META"); if (METHOD_EXISTS) { PREP (container); XPUSHs (sv_2mortal (newSVClutterActor (child))); CALL; FINISH; } } static void clutterperl_container_destroy_child_meta (ClutterContainer *container, ClutterActor *child) { GET_METHOD (container, "DESTROY_CHILD_META"); if (METHOD_EXISTS) { PREP (container); XPUSHs (sv_2mortal (newSVClutterActor (child))); CALL; FINISH; } } static ClutterChildMeta * clutterperl_container_get_child_meta (ClutterContainer *container, ClutterActor *child) { GET_METHOD (container, "GET_CHILD_META"); if (METHOD_EXISTS) { ClutterChildMeta *meta; int count; PREP (container); XPUSHs (sv_2mortal (newSVClutterActor (child))); PUTBACK; count = call_sv ((SV *) GvCV (slot), G_SCALAR); SPAGAIN; if (count == 1) { meta = SvClutterChildMeta (POPs); if (!g_type_is_a (G_OBJECT_TYPE (meta), CLUTTER_TYPE_CHILD_META)) croak ("Object of type `%s' is not a Clutter::ChildMeta", G_OBJECT_TYPE_NAME (meta)); } else croak ("GET_CHILD_META must return a subclass of " "Clutter::ChildMeta"); FINISH; return meta; } return NULL; } static void clutterperl_container_init (ClutterContainerIface *iface) { iface->add = clutterperl_container_add; iface->remove = clutterperl_container_remove; iface->foreach = clutterperl_container_foreach; iface->raise = clutterperl_container_raise; iface->lower = clutterperl_container_lower; iface->sort_depth_order = clutterperl_container_sort_depth_order; iface->create_child_meta = clutterperl_container_create_child_meta; iface->destroy_child_meta = clutterperl_container_destroy_child_meta; iface->get_child_meta = clutterperl_container_get_child_meta; } static void clutterperl_container_foreach_callback (ClutterActor *actor, gpointer user_data) { GPerlCallback *callback = user_data; gperl_callback_invoke (callback, NULL, actor); } MODULE = Clutter::Container PACKAGE = Clutter::Container PREFIX = clutter_container_ =for position DESCRIPTION =head1 DESCRIPTION B is an interface for Ls that provides a common API for adding, removing and iterating over children. By implementing the Clutter::Container interface with the usual L subclassing methods it is possible to use the Clutter::Container API for managing children. =cut =for position post_methods =head1 CHILD PROPERTIES Clutter::Container allows the management of properties that exist only when an actor is contained inside a container. For instance, it is possible to add a property like I to a child actor when inside a container; such property might only be useful when adding any actor to a specific container implementation, and might be desirable not to have it inside the actor class itself. In order to create child properties for a container it is needed to subclass the L object class using the usual L mechanisms, like: package My::ChildMeta; use Glib::Object::Subclass 'Clutter::ChildMeta', properties => [ ... ]; The L class is the class that stores and handles the child properties. A ChildMeta instance also stores references to the container that handles it, and to the actor it is wrapping. The container implementation should set the package name of the ChildMeta subclass it will use; the most convenient place is inside the INIT_INSTANCE sub: sub INIT_INSTANCE { my ($self) = @_; # instance set up $self->set_child_meta_type('My::ChildMeta'); } This is enough for start using the Clutter::Container::child_set() and Clutter::Container::child_get() methods to store and retrieve values for the properties specified inside the ChildMeta subclass, like: $container->child_set($child, 'padding', [ 0, 10, 0, 10 ]); When the child is removed from the container, the ChildMeta instance bound to it will simply disappear. It is also possible to exercise a higher degree of control on the creation and destruction of the ChildMeta instances by using the CREATE_CHILD_META, GET_CHILD_META and DESTROY_CHILD_META functions. =head1 CREATING A CUSTOM CONTAINER ACTOR package MyContainer; use Clutter; use Glib::Object::Subclass 'Clutter::Actor', interfaces => [ qw( Clutter::Container ) ]; =head2 Virtual Methods In order to create a Clutter::Container actor, an implementation of the following methods is required: =over =item B<< ADD ($container, $actor) >> =over =item o $container (Clutter::Container) =item o $actor (Clutter::Actor) =back Called to add I to I. The implementation should emit the B<::actor-added> signal once the actor has been added. =item B<< REMOVE ($container, $actor) >> =over =item o $container (Clutter::Container) =item o $actor (Clutter::Actor) =back Called to remove I from I. The implementation should emit the B<::actor-removed> signal once the actor has been removed. =item B<< RAISE ($container, $child, $sibling) >> =over =item o $container (Clutter::Container) =item o $child (Clutter::Actor) =item o $sibling (Clutter::Actor) =back Called when raising I above I. If I is undefined, then I should be raised above every other child of I. =item B<< LOWER ($container, $child, $sibling) >> =over =item o $container (Clutter::Container) =item o $child (Clutter::Actor) =item o $sibling (Clutter::Actor) =back Called when lowering I below I. If I is undefined, then I should be lowered below every other child of I. =item B<< SORT_DEPTH_ORDER ($container) >> =over =item o $container (Clutter::Container) Called when resorting the list of children depending on their depth. =back =item B<< FOREACH ($container, $function, $data) >> =over =item o $container (Clutter::Container) =item o $function (code reference) =item o $data (scalar) data to pass to the function =back Called when iterating over every child of I. For each child the I must be called with the actor and the passed I, for instance: foreach my $child (@{$container->{children}}) { &$function ($child, $data); } This function will also be called by the B method. =item B<< CREATE_CHILD_META ($container, $actor) >> =over =item o $container (Clutter::Container) =item o $actor (Clutter::Actor) =back Called when creating a new L instance wrapping I inside I. This function should be overridden only if the metadata class used to implement child properties needs special code or needs to be stored inside a different data structure within I. This function is called before Clutter::Container::ADD_ACTOR. =item B<< DESTROY_CHILD_META ($container, $actor) >> =over =item o $container (Clutter::Container) =item o $actor (Clutter::Actor) =back Called when destroying a L instance for I. This function is called before Clutter::Actor::REMOVE_ACTOR =item B<< childmeta = GET_CHILD_META ($container, $actor) >> =over =item o $container (Clutter::Container) =item o $actor (Clutter::Actor) =back Called when retrieving a L instance for I. =back =cut =for apidoc __hide__ =cut void _ADD_INTERFACE (class, const char *target_class) CODE: { static const GInterfaceInfo iface_info = { (GInterfaceInitFunc) clutterperl_container_init, NULL, NULL }; GType gtype = gperl_object_type_from_package (target_class); g_type_add_interface_static (gtype, CLUTTER_TYPE_CONTAINER, &iface_info); } =for apidoc =for arg actor __hide__ =for arg ... list of actors Adds a list of actors to I =cut void clutter_container_add (ClutterContainer *container, ClutterActor *actor, ...) PREINIT: int i; CODE: clutter_container_add_actor (container, actor); for (i = 2; i < items; i++) clutter_container_add_actor (container, SvClutterActor (ST (i))); =for apidoc =for arg actor __hide__ =for arg ... list of actors Removes a list of actors from I =cut void clutter_container_remove (ClutterContainer *container, ClutterActor *actor, ...) PREINIT: int i; CODE: clutter_container_remove_actor (container, actor); for (i = 2; i < items; i++) clutter_container_remove_actor (container, SvClutterActor (ST (i))); =for apidoc =for signature actors = $container->get_children =cut void clutter_container_get_children (ClutterContainer *container) PREINIT: GList *children = NULL, *l; PPCODE: children = clutter_container_get_children (container); if (children) { EXTEND (SP, (int) g_list_length (children)); for (l = children; l != NULL; l = l->next) { PUSHs (sv_2mortal (newSVClutterActor_noinc (l->data))); } g_list_free (children); } void clutter_container_foreach (container, callback, callback_data=NULL) ClutterContainer *container SV *callback SV *callback_data PREINIT: GPerlCallback *real_callback; GType param_types [1]; CODE: param_types[0] = CLUTTER_TYPE_ACTOR; real_callback = gperl_callback_new (callback, callback_data, 1, param_types, G_TYPE_NONE); clutter_container_foreach (container, clutterperl_container_foreach_callback, real_callback); gperl_callback_destroy (real_callback); ClutterActor_ornull * clutter_container_find_child_by_name (container, name) ClutterContainer *container const gchar *name void clutter_container_raise_child (container, actor, sibling) ClutterContainer *container ClutterActor *actor ClutterActor *sibling void clutter_container_lower_child (container, actor, sibling) ClutterContainer *container ClutterActor *actor ClutterActor *sibling =for apidoc =for arg ... list of property names Returns a list of values of properties of the child =cut void clutter_container_child_get (ClutterContainer *container, ClutterActor *child, ...) ALIAS: Clutter::Container::child_get_property = 1 PREINIT: GValue value = { 0, }; gint i; PPCODE: PERL_UNUSED_VAR (ix); EXTEND (SP, items - 1); for (i = 2; i < items; i++) { char *name = SvPV_nolen (ST (i)); init_child_property_value (G_OBJECT (container), name, &value); clutter_container_child_get_property (container, child, name, &value); PUSHs (sv_2mortal (gperl_sv_from_value (&value))); g_value_unset (&value); } =for apidoc =for arg ... list of property names Sets a list of properties of the child =cut void clutter_container_child_set (ClutterContainer *container, ClutterActor *child, ...) ALIAS: Clutter::Container::child_set_property = 1 PREINIT: GValue value = { 0, }; gint i; CODE: PERL_UNUSED_VAR (ix); if (0 != ((items - 2) % 2)) croak ("set method expects name => value pairs " "(odd number of arguments detected)"); for (i = 2; i < items; i += 2) { char *name = SvPV_nolen (ST (i)); SV *newval = ST (i + 1); init_child_property_value (G_OBJECT (container), name, &value); gperl_value_from_sv (&value, newval); clutter_container_child_set_property (container, child, name, &value); g_value_unset (&value); } =for apidoc Retrieves the ChildMeta type used by I =cut const gchar * clutter_container_get_child_meta_type (ClutterContainer *container) PREINIT: GType gtype = G_TYPE_INVALID; CODE: gtype = CLUTTER_CONTAINER_GET_IFACE (container)->child_meta_type; if (gtype == G_TYPE_INVALID) XSRETURN_UNDEF; RETVAL = NULL; /* ClutterChildMeta are GObjects, so we should always get back * a valid type; however, we might get back a type the bindings * know nothing about, so we have to stop when we hit an * unknown type. Glib::Object is always known, so this loop * cannot go on forever */ while (gtype && (NULL == (RETVAL = gperl_object_package_from_type (gtype)))) gtype = g_type_parent (gtype); OUTPUT: RETVAL =for apidoc Sets the ChildMeta type used by I. This type can only be set once and only if the container implementation does not have any ChildMeta type set already. If you try to set the ChildMeta type on an instance with a type already set, this function will croak. =cut void clutter_container_set_child_meta_type (ClutterContainer *container, const gchar *type_name) PREINIT: GType gtype = G_TYPE_INVALID; CODE: gtype = CLUTTER_CONTAINER_GET_IFACE (container)->child_meta_type; if (gtype != G_TYPE_INVALID) croak ("Container implementation of type `%s' already has " "child meta type of `%s'. You should subclass `%s' " "in order to change it", G_OBJECT_TYPE_NAME (container), g_type_name (gtype), G_OBJECT_TYPE_NAME (container)); gtype = gperl_object_type_from_package (type_name); if (gtype == G_TYPE_INVALID) croak ("Invalid GType `%s'", type_name); if (!g_type_is_a (gtype, CLUTTER_TYPE_CHILD_META)) croak ("GType `%s' is not a Clutter::ChildMeta", type_name); CLUTTER_CONTAINER_GET_IFACE (container)->child_meta_type = gtype; =for apidoc Retrieves the L instance for I =cut ClutterChildMeta * clutter_container_get_child_meta (ClutterContainer *container, ClutterActor *actor) MODULE = Clutter::Container PACKAGE = Clutter::Container::ForeachFunc void invoke (ClutterActor *actor, SV *data) PREINIT: ClutterPerlContainerForeachFunc *stuff; CODE: stuff = INT2PTR (ClutterPerlContainerForeachFunc*, SvIV (data)); if (!stuff | !stuff->func) croak("Invalid data passed to the foreach function"); stuff->func (actor, stuff->data); void DESTROY (SV *code) PREINIT: MAGIC *mg; ClutterPerlContainerForeachFunc *stuff; CODE: if (!gperl_sv_is_defined (code) || !SvROK (code) || !(mg = mg_find (SvRV (code), PERL_MAGIC_ext))) return; stuff = INT2PTR (ClutterPerlContainerForeachFunc*, SvIV ((SV *) mg->mg_ptr)); sv_unmagic (SvRV (code), PERL_MAGIC_ext); g_free (stuff);