[rt #69243] add the T_AVARRAY typemap and use it
[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
20 # these types are for use by Inline, which can't handle types containing ::
21 Imager__Color           T_PTROBJ_INV
22 Imager__Color__Float    T_PTROBJ_INV
23 Imager__ImgRaw          T_IMAGER_IMAGE
24 Imager__FillHandle      T_PTROBJ_INV
25 Imager__IO              T_PTROBJ_INV
26
27 # mostly intended for non-Imager-core use
28 Imager                  T_IMAGER_FULL_IMAGE
29
30 #############################################################################
31 INPUT
32 T_PTR_NULL
33         if (SvOK($arg)) $var = INT2PTR($type,SvIV($arg));
34         else $var = NULL
35
36 # handles Imager objects rather than just raw objects
37 T_IMAGER_IMAGE
38         if (sv_derived_from($arg, \"Imager::ImgRaw\")) {
39             IV tmp = SvIV((SV*)SvRV($arg));
40             $var = INT2PTR($type,tmp);
41         }
42         else if (sv_derived_from($arg, \"Imager\") && 
43                  SvTYPE(SvRV($arg)) == SVt_PVHV) {
44             HV *hv = (HV *)SvRV($arg);
45             SV **sv = hv_fetch(hv, \"IMG\", 3, 0);
46             if (sv && *sv && sv_derived_from(*sv, \"Imager::ImgRaw\")) {
47                 IV tmp = SvIV((SV*)SvRV(*sv));
48                 $var = INT2PTR($type,tmp);
49             }
50             else
51                 Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
52         }
53         else
54             Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
55
56 T_IMAGER_FULL_IMAGE
57         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\");
70
71 # same as T_PTROBJ, but replace __ with ::, the opposite of the way
72 # xsubpp's processing works
73 # this is to compensate for Inline's problem with type names containing ::
74 T_PTROBJ_INV
75         if (sv_derived_from($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\")) {
76             IV tmp = SvIV((SV*)SvRV($arg));
77             $var = INT2PTR($type,tmp);
78         }
79         else
80             croak(\"$var is not of type ${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\");
81
82 T_AVARRAY
83         STMT_START {
84                 SV* const xsub_tmp_sv = $arg;
85                 SvGETMAGIC(xsub_tmp_sv);
86                 if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVAV){
87                     AV *xsub_tmp_av = (AV*)SvRV(xsub_tmp_sv);
88                     STRLEN xsub_index;
89                     size_$var = av_len(xsub_tmp_av) + 1;
90                     $var = $ntype(size_$var);
91                     for (xsub_index = 0; xsub_index < size_$var; ++xsub_index) {
92                         SV **sv = av_fetch(xsub_tmp_av, xsub_index, 0);
93                         if (sv) {
94                           ${var}[xsub_index] = Sv${(my $ntt = $ntype) =~ s/Ptr$//; \(ucfirst $ntt)}(*sv);
95                         }
96                         else
97                           ${var}[xsub_index] = 0;
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         }