initial XS interfaces to i_psamp()/i_psampf()
[imager.git] / typemap
1 #i_img *                        T_PTR_NULL
2 Imager::Color           T_PTROBJ
3 Imager::Color::Float    T_PTROBJ
4 Imager::ImgRaw          T_IMAGER_IMAGE
5 Imager::Font::TT        T_PTROBJ
6 Imager::IO              T_PTROBJ
7 Imager::FillHandle      T_PTROBJ
8 Imager::Internal::Hlines T_PTROBJ
9 const char *            T_PV
10 float                   T_FLOAT
11 float*                  T_ARRAY
12 undef_int               T_IV_U
13 undef_neg_int           T_IV_NEGU
14 HASH                    T_HVREF
15 utf8_str                T_UTF8_STR
16 i_img_dim               T_IV
17
18 # these types are for use by Inline, which can't handle types containing ::
19 Imager__Color           T_PTROBJ_INV
20 Imager__Color__Float    T_PTROBJ_INV
21 Imager__ImgRaw          T_IMAGER_IMAGE
22 Imager__FillHandle      T_PTROBJ_INV
23 Imager__IO              T_PTROBJ_INV
24
25 # mostly intended for non-Imager-core use
26 Imager                  T_IMAGER_FULL_IMAGE
27
28 off_t                   T_OFF_T
29
30 # STRLEN isn't in the default typemap in older perls
31 STRLEN                  T_UV
32
33 # internal types used in Imager.xs
34 i_channel_list          T_IM_CHANNEL_LIST
35 i_sample_list           T_IM_SAMPLE_LIST
36 i_fsample_list          T_IM_FSAMPLE_LIST
37
38 #############################################################################
39 INPUT
40 T_PTR_NULL
41         if (SvOK($arg)) $var = INT2PTR($type,SvIV($arg));
42         else $var = NULL
43
44 # the pre-5.8.0 T_AVREF input map was fixed in 5.8.0
45 T_AVREF
46         if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV)
47             $var = (AV*)SvRV($arg);
48         else
49             Perl_croak(aTHX_ \"$var is not an array reference\")
50
51 # handles Imager objects rather than just raw objects
52 T_IMAGER_IMAGE
53         if (sv_derived_from($arg, \"Imager::ImgRaw\")) {
54             IV tmp = SvIV((SV*)SvRV($arg));
55             $var = INT2PTR($type,tmp);
56         }
57         else if (sv_derived_from($arg, \"Imager\") && 
58                  SvTYPE(SvRV($arg)) == SVt_PVHV) {
59             HV *hv = (HV *)SvRV($arg);
60             SV **sv = hv_fetch(hv, \"IMG\", 3, 0);
61             if (sv && *sv && sv_derived_from(*sv, \"Imager::ImgRaw\")) {
62                 IV tmp = SvIV((SV*)SvRV(*sv));
63                 $var = INT2PTR($type,tmp);
64             }
65             else
66                 Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
67         }
68         else
69             Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
70
71 T_IMAGER_FULL_IMAGE
72         if (sv_derived_from($arg, \"Imager\") && 
73                  SvTYPE(SvRV($arg)) == SVt_PVHV) {
74             HV *hv = (HV *)SvRV($arg);
75             SV **sv = hv_fetch(hv, \"IMG\", 3, 0);
76             if (sv && *sv && sv_derived_from(*sv, \"Imager::ImgRaw\")) {
77                 IV tmp = SvIV((SV*)SvRV(*sv));
78                 $var = INT2PTR($type,tmp);
79             }
80             else
81                 Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
82         }
83         else
84             Perl_croak(aTHX_ \"$var is not of type Imager\");
85
86 # same as T_PTROBJ, but replace __ with ::, the opposite of the way
87 # xsubpp's processing works
88 # this is to compensate for Inline's problem with type names containing ::
89 T_PTROBJ_INV
90         if (sv_derived_from($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\")) {
91             IV tmp = SvIV((SV*)SvRV($arg));
92             $var = INT2PTR($type,tmp);
93         }
94         else
95             croak(\"$var is not of type ${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\");
96
97 T_OFF_T
98   $var = i_sv_off_t(aTHX_ $arg);
99
100 T_IM_CHANNEL_LIST
101         SvGETMAGIC($arg);
102         if (SvOK($arg)) {
103           AV *channels_av;
104           int i;
105           if (!SvROK($arg) || SvTYPE(SvRV($arg)) != SVt_PVAV) {
106             croak(\"$var is not an array ref\");
107           }
108           channels_av = (AV *)SvRV($arg);
109           $var.count = av_len(channels_av) + 1;
110           if ($var.count < 1) {
111             croak(\"$pname: no channels provided\");
112           }
113           $var.channels = malloc_temp(aTHX_ sizeof(int) * $var.count);
114           for (i = 0; i < $var.count; ++i) {
115             SV **entry = av_fetch(channels_av, i, 0);
116             $var.channels[i] = entry ? SvIV(*entry) : 0;
117           }
118         }
119         else {
120           /* assumes we have an image */
121           $var.count = im->channels;
122           $var.channels = NULL;
123         }
124
125 T_IM_SAMPLE_LIST
126         SvGETMAGIC($arg);
127         if (!SvOK($arg))
128           croak(\"$var must be a scalar or an arrayref\");
129         if (SvROK($arg)) {
130           i_img_dim i;
131           AV *av;
132           i_sample_t *s;
133           if (SvTYPE(SvRV($arg)) != SVt_PVAV)
134             croak(\"$var must be a scalar or an arrayref\");
135           av = (AV *)SvRV($arg);
136           $var.count = av_len(av) + 1;
137           if ($var.count < 1)
138             croak(\"$pname: no samples provided in $var\");
139           s = malloc_temp(aTHX_ sizeof(i_sample_t) * $var.count);
140           for (i = 0; i < $var.count; ++i) {
141             SV **entry = av_fetch(av, i, 0);
142             s[i] = entry ? SvIV(*entry) : 0;
143           }
144           $var.samples = s;
145         }
146         else {
147           /* non-magic would be preferable here */
148           $var.samples = (const i_sample_t *)SvPVbyte($arg, $var.count);
149           if ($var.count == 0)
150             croak(\"$pname: no samples provided in $var\");
151         }
152
153 T_IM_FSAMPLE_LIST
154         SvGETMAGIC($arg);
155         if (!SvOK($arg))
156           croak(\"$var must be a scalar or an arrayref\");
157         if (SvROK($arg)) {
158           i_img_dim i;
159           AV *av;
160           i_fsample_t *s;
161           if (SvTYPE(SvRV($arg)) != SVt_PVAV)
162             croak(\"$var must be a scalar or an arrayref\");
163           av = (AV *)SvRV($arg);
164           $var.count = av_len(av) + 1;
165           if ($var.count < 1)
166             croak(\"$pname: no samples provided in $var\");
167           s = malloc_temp(aTHX_ sizeof(i_fsample_t) * $var.count);
168           for (i = 0; i < $var.count; ++i) {
169             SV **entry = av_fetch(av, i, 0);
170             s[i] = entry ? SvNV(*entry) : 0;
171           }
172           $var.samples = s;
173         }
174         else {
175           /* non-magic would be preferable here */
176           $var.samples = (const i_fsample_t *)SvPVbyte($arg, $var.count);
177           if ($var.count % sizeof(double))
178             croak(\"$pname: $var doesn't not contain a integer number of samples\");
179           $var.count /= sizeof(double);
180           if ($var.count == 0)
181             croak(\"$pname: no samples provided in $var\");
182         }
183
184 #############################################################################
185 OUTPUT
186 T_IV_U
187         if ($var == 0) $arg=&PL_sv_undef;
188         else sv_setiv($arg, (IV)$var);
189 T_IV_NEGU
190         if ($var < 0) $arg=&PL_sv_undef;
191         else sv_setiv($arg, (IV)$var);
192 T_PTR_NULL
193         sv_setiv($arg, (IV)$var);
194
195 # same as T_PTROBJ
196 T_IMAGER_IMAGE
197         sv_setref_pv($arg, \"Imager::ImgRaw\", (void*)$var);
198
199 T_PTROBJ_INV
200         sv_setref_pv($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\", (void*)$var);
201
202 # ugh, the things we do for ease of use
203 # this isn't suitable in some cases
204 T_IMAGER_FULL_IMAGE
205         if ($var) {
206           SV *imobj = NEWSV(0, 0);
207           HV *hv = newHV();
208           sv_setref_pv(imobj, \"Imager::ImgRaw\", $var);
209           hv_store(hv, "IMG", 3, imobj, 0);
210           $arg = sv_2mortal(sv_bless(newRV_noinc((SV*)hv), gv_stashpv("Imager", 1)));
211         }
212         else {
213           $arg = &PL_sv_undef;
214         }
215 T_OFF_T
216         $arg = i_new_sv_off_t(aTHX_ $var);