- start of external Imager API access:
[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::Font::FT2       T_PTROBJ
8 Imager::FillHandle      T_PTROBJ
9 Imager::Internal::Hlines T_PTROBJ
10 const char *            T_PV
11 float                   T_FLOAT
12 float*                  T_ARRAY
13 undef_int               T_IV_U
14 undef_neg_int           T_IV_NEGU
15 HASH                    T_HVREF
16 utf8_str                T_UTF8_STR
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 #############################################################################
29 INPUT
30 T_PTR_NULL
31         if (SvOK($arg)) $var = INT2PTR($type,SvIV($arg));
32         else $var = NULL
33
34 # the pre-5.8.0 T_AVREF input map was fixed in 5.8.0
35 T_AVREF
36         if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV)
37             $var = (AV*)SvRV($arg);
38         else
39             Perl_croak(aTHX_ \"$var is not an array reference\")
40
41 # handles Imager objects rather than just raw objects
42 T_IMAGER_IMAGE
43         if (sv_derived_from($arg, \"Imager::ImgRaw\")) {
44             IV tmp = SvIV((SV*)SvRV($arg));
45             $var = INT2PTR($type,tmp);
46         }
47         else if (sv_derived_from($arg, \"Imager\") && 
48                  SvTYPE(SvRV($arg)) == SVt_PVHV) {
49             HV *hv = (HV *)SvRV($arg);
50             SV **sv = hv_fetch(hv, \"IMG\", 3, 0);
51             if (sv && *sv && sv_derived_from(*sv, \"Imager::ImgRaw\")) {
52                 IV tmp = SvIV((SV*)SvRV(*sv));
53                 $var = INT2PTR($type,tmp);
54             }
55             else
56                 Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
57         }
58         else
59             Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
60
61 T_IMAGER_FULL_IMAGE
62         if (sv_derived_from($arg, \"Imager\") && 
63                  SvTYPE(SvRV($arg)) == SVt_PVHV) {
64             HV *hv = (HV *)SvRV($arg);
65             SV **sv = hv_fetch(hv, \"IMG\", 3, 0);
66             if (sv && *sv && sv_derived_from(*sv, \"Imager::ImgRaw\")) {
67                 IV tmp = SvIV((SV*)SvRV(*sv));
68                 $var = INT2PTR($type,tmp);
69             }
70             else
71                 Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
72         }
73         else
74             Perl_croak(aTHX_ \"$var is not of type Imager\");
75
76 # same as T_PTROBJ, but replace __ with ::, the opposite of the way
77 # xsubpp's processing works
78 # this is to compensate for Inline's problem with type names containing ::
79 T_PTROBJ_INV
80         if (sv_derived_from($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\")) {
81             IV tmp = SvIV((SV*)SvRV($arg));
82             $var = INT2PTR($type,tmp);
83         }
84         else
85             croak(\"$var is not of type ${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\");
86
87
88 #############################################################################
89 OUTPUT
90 T_IV_U
91         if ($var == 0) $arg=&PL_sv_undef;
92         else sv_setiv($arg, (IV)$var);
93 T_IV_NEGU
94         if ($var < 0) $arg=&PL_sv_undef;
95         else sv_setiv($arg, (IV)$var);
96 T_PTR_NULL
97         sv_setiv($arg, (IV)$var);
98
99 # same as T_PTROBJ
100 T_IMAGER_IMAGE
101         sv_setref_pv($arg, \"Imager::ImgRaw\", (void*)$var);
102
103 T_PTROBJ_INV
104         sv_setref_pv($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\", (void*)$var);
105
106 # ugh, the things we do for ease of use
107 # this isn't suitable in some cases
108 T_IMAGER_FULL_IMAGE
109         if ($var) {
110           SV *imobj = NEWSV(0, 0);
111           HV *hv = newHV();
112           SV *hvref;
113           SV *imgref;
114           sv_setref_pv(imobj, \"Imager::ImgRaw\", $var);
115           hv_store(hv, "IMG", 3, imobj, 0);
116           $arg = sv_2mortal(sv_bless(newRV((SV*)hv), gv_stashpv("Imager", 1)));
117         }
118         else {
119           $arg = &PL_sv_undef;
120         }