[rt #69243] use T_AVARRAY for i_gradgen too
[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 const char *            T_PV
9 float                   T_FLOAT
10 float*                  T_ARRAY
11 undef_int               T_IV_U
12 undef_neg_int           T_IV_NEGU
13 HASH                    T_HVREF
14 utf8_str                T_UTF8_STR
15 i_img_dim               T_IV
16
17 double *                T_AVARRAY
18 int *                   T_AVARRAY
19 i_img_dim *             T_AVARRAY
20 i_color *               T_AVARRAY
21
22 # these types are for use by Inline, which can't handle types containing ::
23 Imager__Color           T_PTROBJ_INV
24 Imager__Color__Float    T_PTROBJ_INV
25 Imager__ImgRaw          T_IMAGER_IMAGE
26 Imager__FillHandle      T_PTROBJ_INV
27 Imager__IO              T_PTROBJ_INV
28
29 # mostly intended for non-Imager-core use
30 Imager                  T_IMAGER_FULL_IMAGE
31
32 #############################################################################
33 INPUT
34 T_PTR_NULL
35         if (SvOK($arg)) $var = INT2PTR($type,SvIV($arg));
36         else $var = NULL
37
38 # handles Imager objects rather than just raw objects
39 T_IMAGER_IMAGE
40         if (sv_derived_from($arg, \"Imager::ImgRaw\")) {
41             IV tmp = SvIV((SV*)SvRV($arg));
42             $var = INT2PTR($type,tmp);
43         }
44         else if (sv_derived_from($arg, \"Imager\") && 
45                  SvTYPE(SvRV($arg)) == SVt_PVHV) {
46             HV *hv = (HV *)SvRV($arg);
47             SV **sv = hv_fetch(hv, \"IMG\", 3, 0);
48             if (sv && *sv && sv_derived_from(*sv, \"Imager::ImgRaw\")) {
49                 IV tmp = SvIV((SV*)SvRV(*sv));
50                 $var = INT2PTR($type,tmp);
51             }
52             else
53                 Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
54         }
55         else
56             Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
57
58 T_IMAGER_FULL_IMAGE
59         if (sv_derived_from($arg, \"Imager\") && 
60                  SvTYPE(SvRV($arg)) == SVt_PVHV) {
61             HV *hv = (HV *)SvRV($arg);
62             SV **sv = hv_fetch(hv, \"IMG\", 3, 0);
63             if (sv && *sv && sv_derived_from(*sv, \"Imager::ImgRaw\")) {
64                 IV tmp = SvIV((SV*)SvRV(*sv));
65                 $var = INT2PTR($type,tmp);
66             }
67             else
68                 Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
69         }
70         else
71             Perl_croak(aTHX_ \"$var is not of type Imager\");
72
73 # same as T_PTROBJ, but replace __ with ::, the opposite of the way
74 # xsubpp's processing works
75 # this is to compensate for Inline's problem with type names containing ::
76 T_PTROBJ_INV
77         if (sv_derived_from($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\")) {
78             IV tmp = SvIV((SV*)SvRV($arg));
79             $var = INT2PTR($type,tmp);
80         }
81         else
82             croak(\"$var is not of type ${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\");
83
84 T_AVARRAY
85         STMT_START {
86                 SV* const xsub_tmp_sv = $arg;
87                 SvGETMAGIC(xsub_tmp_sv);
88                 if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVAV){
89                     AV *xsub_tmp_av = (AV*)SvRV(xsub_tmp_sv);
90                     STRLEN xsub_index;
91                     size_$var = av_len(xsub_tmp_av) + 1;
92                     $var = $ntype(size_$var);
93                     for (xsub_index = 0; xsub_index < size_$var; ++xsub_index) {
94                         SV **sv = av_fetch(xsub_tmp_av, xsub_index, 0);
95                         if (sv) {
96                           ${var}[xsub_index] = Sv${(my $ntt = $ntype) =~ s/Ptr$//; \(ucfirst $ntt)}(*sv, \"$pname\");
97                         }
98                     }
99                 }
100                 else{
101                     Perl_croak(aTHX_ \"%s: %s is not an ARRAY reference\",
102                                 ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
103                                 \"$var\");
104                 }
105         } STMT_END
106
107
108 #############################################################################
109 OUTPUT
110 T_IV_U
111         if ($var == 0) $arg=&PL_sv_undef;
112         else sv_setiv($arg, (IV)$var);
113 T_IV_NEGU
114         if ($var < 0) $arg=&PL_sv_undef;
115         else sv_setiv($arg, (IV)$var);
116 T_PTR_NULL
117         sv_setiv($arg, (IV)$var);
118
119 # same as T_PTROBJ
120 T_IMAGER_IMAGE
121         sv_setref_pv($arg, \"Imager::ImgRaw\", (void*)$var);
122
123 T_PTROBJ_INV
124         sv_setref_pv($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\", (void*)$var);
125
126 # ugh, the things we do for ease of use
127 # this isn't suitable in some cases
128 T_IMAGER_FULL_IMAGE
129         if ($var) {
130           SV *imobj = NEWSV(0, 0);
131           HV *hv = newHV();
132           sv_setref_pv(imobj, \"Imager::ImgRaw\", $var);
133           hv_store(hv, "IMG", 3, imobj, 0);
134           $arg = sv_2mortal(sv_bless(newRV_noinc((SV*)hv), gv_stashpv("Imager", 1)));
135         }
136         else {
137           $arg = &PL_sv_undef;
138         }