File: ClutterEntry.xs

package info (click to toggle)
clutter-perl 0.8.0.1-1
  • links: PTS
  • area: main
  • in suites: lenny
  • size: 652 kB
  • ctags: 42
  • sloc: perl: 645; ansic: 30; makefile: 3
file content (210 lines) | stat: -rw-r--r-- 5,798 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
/* 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);
        }