The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
/* Clutter.
 *
 * Perl bindings for the OpenGL based 'interactive canvas' library.
 *
 * Clutter Authored By Matthew Allum  <mallum@openedhand.com>
 * Perl bindings by Emmanuele Bassi  <ebassi@openedhand.com>
 * 
 * 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"

static void
clutterperl_entry_paint_cursor (ClutterEntry *entry)
{
  HV *stash = gperl_object_stash_from_type (G_OBJECT_TYPE (entry));
  GV *slot = gv_fetchmethod (stash, "PAINT_CURSOR");

  if (slot && GvCV (slot))
    {
      dSP;

      ENTER;
      SAVETMPS;
      PUSHMARK (SP);

      PUSHs (newSVClutterEntry (entry));

      PUTBACK;

      call_sv ((SV *) GvCV (slot), G_VOID | G_DISCARD);

      SPAGAIN;

      FREETMPS;
      LEAVE;
    }
}

static void
clutterperl_entry_class_init (ClutterEntryClass *klass)
{
  klass->paint_cursor = clutterperl_entry_paint_cursor;
}

MODULE = Clutter::Entry PACKAGE = Clutter::Entry        PREFIX = clutter_entry_

ClutterActor *
clutter_entry_new (class, font_name=NULL, text=NULL, color=NULL)
        const gchar_ornull *font_name
        const gchar_ornull *text
        ClutterColor_ornull *color
    CODE:
        RETVAL = clutter_entry_new ();
        if (font_name)
          clutter_entry_set_font_name (CLUTTER_ENTRY (RETVAL), font_name);
        if (text)
          clutter_entry_set_text (CLUTTER_ENTRY (RETVAL), text);
        if (color)
          clutter_entry_set_color (CLUTTER_ENTRY (RETVAL), color);
    OUTPUT:
        RETVAL

void
clutter_entry_set_text (ClutterEntry *entry, const gchar_ornull *text)

const gchar_ornull *
clutter_entry_get_text (ClutterEntry *entry)

void
clutter_entry_set_font_name (ClutterEntry *entry, const gchar *font_name)

const gchar *
clutter_entry_get_font_name (ClutterEntry *entry)

void
clutter_entry_set_color (ClutterEntry *entry, const ClutterColor *color)

ClutterColor_copy *
clutter_entry_get_color (ClutterEntry *entry)
    PREINIT:
        ClutterColor color;
    CODE:
        clutter_entry_get_color (entry, &color);
        RETVAL = &color;
    OUTPUT:
        RETVAL

PangoLayout *
clutter_entry_get_layout (ClutterEntry *entry)

void
clutter_entry_set_alignment (ClutterEntry *entry, PangoAlignment alignment)

PangoAlignment
clutter_entry_get_alignment (ClutterEntry *entry)

void
clutter_entry_set_cursor_position (ClutterEntry *entry, gint position)

gint
clutter_entry_get_cursor_position (ClutterEntry *entry)

void
clutter_entry_insert_unichar (ClutterEntry *entry, gunichar wc)

void
clutter_entry_delete_chars (ClutterEntry *entry, guint len)

void
clutter_entry_insert_text (ClutterEntry *entry, const gchar *text)
    CODE:
        clutter_entry_insert_text (entry, text, -1);

void
clutter_entry_delete_text (ClutterEntry *entry, gint start_pos, gint end_pos)

void
clutter_entry_set_visible_cursor (ClutterEntry *entry, gboolean visible)

gboolean
clutter_entry_get_visible_cursor (ClutterEntry *entry)

void
clutter_entry_set_visibility (ClutterEntry *entry, gboolean visible)

gboolean
clutter_entry_get_visibility (ClutterEntry *entry)

void
clutter_entry_set_invisible_char (ClutterEntry *entry, gunichar wc)

gunichar
clutter_entry_get_invisible_char (ClutterEntry *entry)

void
clutter_entry_set_max_length (ClutterEntry *entry, gint max)

gint
clutter_entry_get_max_length (ClutterEntry *entry)

=for apidoc Clutter::Entry::_INSTALL_OVERRIDES __hide__
=cut

void
_INSTALL_OVERRIDES (const char *package)
    PREINIT:
        GType gtype;
        ClutterEntryClass *klass;
    CODE:
        gtype = gperl_object_type_from_package (package);
        if (!gtype) {
                croak("package `%s' is not registered with Clutter-Perl", package);
        }
        if (!g_type_is_a (gtype, CLUTTER_TYPE_ENTRY)) {
                croak("package `%s' (%s) is not a Clutter::Entry",
                      package,
                      g_type_name (gtype));
        }
        klass = g_type_class_peek (gtype);
        if (!klass) {
                croak("INTERNAL ERROR: can't peek a type class for `%s' (%d)",
                      g_type_name (gtype), gtype);
        }
        clutterperl_entry_class_init (klass);

## allow chaining up to the parent's methods from a perl subclass

=for apidoc Clutter::Entry::PAINT_CURSOR __hide__
=cut

void
PAINT_CURSOR (ClutterEntry *entry)
    PREINIT:
        ClutterEntryClass *klass;
        GType this_class, parent_class;
        SV *saveddefssv;
    CODE:
        saveddefssv = newSVsv (DEFSV);
        eval_pv ("$_ = caller;", 0);
        this_class = gperl_type_from_package (SvPV_nolen (DEFSV));
        SvSetSV (DEFSV, saveddefssv);
        if (!this_class) {
                this_class = G_OBJECT_TYPE (entry);
        }
        parent_class = g_type_parent (this_class);
        if (!g_type_is_a (parent_class, CLUTTER_TYPE_ENTRY)) {
                croak("parent of %s is not a Clutter::Entry",
                      g_type_name (this_class));
        }
        klass = g_type_class_peek (parent_class);
        if (klass->paint_cursor) {
                klass->paint_cursor (entry);
        }