re-work XS handling of channel lists
[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 i_channel_list          T_IM_CHANNEL_LIST
34
35 #############################################################################
36 INPUT
37 T_PTR_NULL
38         if (SvOK($arg)) $var = INT2PTR($type,SvIV($arg));
39         else $var = NULL
40
41 # the pre-5.8.0 T_AVREF input map was fixed in 5.8.0
42 T_AVREF
43         if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV)
44             $var = (AV*)SvRV($arg);
45         else
46             Perl_croak(aTHX_ \"$var is not an array reference\")
47
48 # handles Imager objects rather than just raw objects
49 T_IMAGER_IMAGE
50         if (sv_derived_from($arg, \"Imager::ImgRaw\")) {
51             IV tmp = SvIV((SV*)SvRV($arg));
52             $var = INT2PTR($type,tmp);
53         }
54         else if (sv_derived_from($arg, \"Imager\") && 
55                  SvTYPE(SvRV($arg)) == SVt_PVHV) {
56             HV *hv = (HV *)SvRV($arg);
57             SV **sv = hv_fetch(hv, \"IMG\", 3, 0);
58             if (sv && *sv && sv_derived_from(*sv, \"Imager::ImgRaw\")) {
59                 IV tmp = SvIV((SV*)SvRV(*sv));
60                 $var = INT2PTR($type,tmp);
61             }
62             else
63                 Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
64         }
65         else
66             Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
67
68 T_IMAGER_FULL_IMAGE
69         if (sv_derived_from($arg, \"Imager\") && 
70                  SvTYPE(SvRV($arg)) == SVt_PVHV) {
71             HV *hv = (HV *)SvRV($arg);
72             SV **sv = hv_fetch(hv, \"IMG\", 3, 0);
73             if (sv && *sv && sv_derived_from(*sv, \"Imager::ImgRaw\")) {
74                 IV tmp = SvIV((SV*)SvRV(*sv));
75                 $var = INT2PTR($type,tmp);
76             }
77             else
78                 Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
79         }
80         else
81             Perl_croak(aTHX_ \"$var is not of type Imager\");
82
83 # same as T_PTROBJ, but replace __ with ::, the opposite of the way
84 # xsubpp's processing works
85 # this is to compensate for Inline's problem with type names containing ::
86 T_PTROBJ_INV
87         if (sv_derived_from($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\")) {
88             IV tmp = SvIV((SV*)SvRV($arg));
89             $var = INT2PTR($type,tmp);
90         }
91         else
92             croak(\"$var is not of type ${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\");
93
94 T_OFF_T
95   $var = i_sv_off_t(aTHX_ $arg);
96
97 T_IM_CHANNEL_LIST
98         SvGETMAGIC($arg);
99         if (SvOK($arg)) {
100           AV *channels_av;
101           int i;
102           if (!SvROK($arg) || SvTYPE(SvRV($arg)) != SVt_PVAV) {
103             croak(\"$var is not an array ref\");
104           }
105           channels_av = (AV *)SvRV($arg);
106           $var.count = av_len(channels_av) + 1;
107           if ($var.count < 1) {
108             croak(\"$pname: no channels provided\");
109           }
110           $var.channels = malloc_temp(aTHX_ sizeof(int) * $var.count);
111           for (i = 0; i < $var.count; ++i) {
112             SV **entry = av_fetch(channels_av, i, 0);
113             $var.channels[i] = entry ? SvIV(*entry) : 0;
114           }
115         }
116         else {
117           /* assumes we have an image */
118           $var.count = im->channels;
119           $var.channels = NULL;
120         }
121
122
123 #############################################################################
124 OUTPUT
125 T_IV_U
126         if ($var == 0) $arg=&PL_sv_undef;
127         else sv_setiv($arg, (IV)$var);
128 T_IV_NEGU
129         if ($var < 0) $arg=&PL_sv_undef;
130         else sv_setiv($arg, (IV)$var);
131 T_PTR_NULL
132         sv_setiv($arg, (IV)$var);
133
134 # same as T_PTROBJ
135 T_IMAGER_IMAGE
136         sv_setref_pv($arg, \"Imager::ImgRaw\", (void*)$var);
137
138 T_PTROBJ_INV
139         sv_setref_pv($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\", (void*)$var);
140
141 # ugh, the things we do for ease of use
142 # this isn't suitable in some cases
143 T_IMAGER_FULL_IMAGE
144         if ($var) {
145           SV *imobj = NEWSV(0, 0);
146           HV *hv = newHV();
147           sv_setref_pv(imobj, \"Imager::ImgRaw\", $var);
148           hv_store(hv, "IMG", 3, imobj, 0);
149           $arg = sv_2mortal(sv_bless(newRV_noinc((SV*)hv), gv_stashpv("Imager", 1)));
150         }
151         else {
152           $arg = &PL_sv_undef;
153         }
154 T_OFF_T
155         $arg = i_new_sv_off_t(aTHX_ $var);